Google
 

Trailing-Edge - PDP-10 Archives - BB-4157F-BM_1983 - fortran/compiler/gnrcfn.bli
There are 26 other files named gnrcfn.bli in the archive. Click here to see a list.
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
!  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

!COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1983
!AUTHOR: S. MURPHY/DCE/TFV/EGM/CDM/AHM/RVM

MODULE GNRCFN(SREG=#17,VREG=#15,FREG=#16,DREGS=4,RESERVE(0,1,2,3)) =
BEGIN


GLOBAL BIND GNRCFV = 7^24 + 0^18 + #1567;	! Version Date: 24-Jun-82

%(

***** Begin Revision History *****

30	-----	-----	MAKE DOTTEDNAMES A GLOBAL SO THAT EXPRES CAN ACCESS
			IT TO RESOLVE LIBRARY FUNCTION ACTUAL PARAMETERS

			DO NOT ALLOW TYPED FUNCTION NAMES TO BE GENERIC.

31	312	16668	FOR THE VARIABLE NUMBER OF ARGUMENTS FUNCTIONS,
			CHECK TO MAKE SURE THAT THERE ARE AT LEAST 2., (JNT)

***** Begin Version 5A *****

32	563	22541	GIVE CORRECT ERROR MESSAGES FOR BAD ARGUMENT
			TYPES TO LIBRARY ROUTINES., (DCE)
***** Begin Version 6 *****

33	761	TFV	1-Mar-80	-----
	Add dotted names of new library routines into tables.
	Choose name based on /GFLOATING

34	1004	TFV	1-Jul-80	------
	Only choose gdottednames for DP functions
				
35	1075	EGM	28-May-81	--------
	Add GFL equivalents to IDINT (IGINT) and SNGL (GSNGL).

***** Begin Version 7 *****

36	1241	CDM	29-Jul-81		----
	Add intrinsic functions (ANINT, DDIM, DINT, DNINT, DPROD, IDNINT,
	NINT) and their G-Floating counterparts (GDIM, GINT, GNINT, GPROD,
	IGNINT) and change MAKLIBFN to always look in the GDOTTEDNAMES
	table whenever /GFL is specified.

37	1252	CDM	10-Aug-81
	Add names for inline generic functions for which 77-standard gives
	no specific names.  Also change MAKLIBFN so that when it finds CMPLX
	called with only 1 argument, it changes the function name to CMP1.R,
	since CMPLX may now have 1 or 2 arguments.

40	1264	CDM	25-Sept-81
	Add CMPL.C, MAX, MIN, LOG10, CHAR, ICHAR, INDEX, LEN, LGE, LGT,
	LLE, LLT, NOP's to function tables.
	In MAKLIBFN, make character data arguments illegal for generic
	functions.

41	1270	CDM	6-Oct-81
	Changes to MAKLIBFN;
	-Added one more argument to the call,
	-Added error for octal and literal argments to non-specific generic
		function,
	-Added warning for declaration of function to something other
		than the value found in LIBATTRIBUTES.

42	1275	CDM	20-Oct-81
	Added code to MAKLIBFN to check if a function with no (or less)
	arguments is called.  SIN() is illegal for a library function!

43	1434	CDM	14-Dec-81
	Add length for character library functions (CHAR in particular).

44	1436	SRM	16-Dec-81
	Set CHARUSED if call an intrinsic function that takes a character
	arg or returns a character value

1505	AHM	12-Mar-82
	Make MAKELIBFN set the psect index of symbol table entries for
	dotted function names to .CODE.

1513	RVM	22-Mar-82
	Take the code that forms the symbol table entry for the dotted
	names of library functions out of MAKLIBFN and make it into a
	new global routine MAKDOTTEDNAME.  Also, have MAKDOTTEDNAME set
	INEXTERN for the dotted name if the undotted name has INEXTERN
	set.  (HSCHD in OUTMOD uses INEXTERN to determine if a descriptor
	needs to be created for a character routine.)  Also set the global
	flag CHDECL if MAKDOTTEDNAME sees a intrinsic character.  CHDECL
	is used to signal that HSCHD needs to be called at all!

1543	RVM	25-May-82
	Under /GFLOATING, the function CMPL.G should be used to convert
	two DOUBLE PRECISION numbers to COMPLEX.

1535	CDM	1-June-82
	Error message for ICHAR with character constant of length > 1.

1551	AHM	4-Jun-82
	Remove edit 1505  because external references  no longer  have
	their psect index set.

1567	CDM	24-Jun-82
	Set IDFNFOLD in symbol table if function could be folded into
	a constant.

***** End Revision History *****

)%

SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
SWITCHES LIST;

EXTERNAL
%1436%	CHARUSED,	! Flag for character operator used in prog
%1513%	CHDECL,		! Flag for character identifier used in prog
%1434%	CGERR,		! Internal compiler error routine
%1252%	?CMP1.RENT,	! Pointer into table for 1 arg 'CMPL1.R'.
%1252%	CMPLXENT,	! Pointer to 2 argument complex 'CMPLX'.
	E80,		! Illegal argument type
%1275%	E81,		! Not correct number of arguments
%1270%	E169,		! Error this argument illegal
%1270%	E170,		! Warning - ingoring declaration 
%1535%	E203,		! ICHAR - char const len longer than 1
	ERROUT,
%1270%	FATLERR,	! Error routine.
	FATLEX,		! Fatal error routine.
	LIBFUNTAB,
	LIBATTRIBUTES,
	TBLSEARCH,
	WARNERR;

	MAP LIBATTSTR LIBATTRIBUTES;


%(***Make a table of dotted function names. The index into this table for
	a given function should be the same as the index for that function in
	the function attribute table (which is in
	GLOBALS )*****)%
BIND DUMMM= PLIT( DOTTEDNAMES GLOBALLY NAMES
	SIXBIT'ABS.',
	SIXBIT'ACOS.',
	SIXBIT'AIMAG.',
	SIXBIT'AINT.',
	SIXBIT'ALOG.',
	SIXBIT'ALG10.',
	SIXBIT'AMAX0.',
	SIXBIT'AMAX1.',
	SIXBIT'AMIN0.',
	SIXBIT'AMIN1.',
	SIXBIT'AMOD.',
%1241%	SIXBIT'ANINT.',
	SIXBIT'ASIN.',
	SIXBIT'ATAN.',
	SIXBIT'ATAN2.',
	SIXBIT'CABS.',
	SIXBIT'CCOS.',
%[761]%	SIXBIT'CDABS.',
	SIXBIT'CEXP.',
%1264%	SIXBIT'CHAR.',
	SIXBIT'CLOG.',
%1252%	SIXBIT'CMP1.D',
%1252%	SIXBIT'CMP1.I',
%1252%	SIXBIT'CMP1.R',
%1264%	SIXBIT'CMPL.C',
%1252%	SIXBIT'CMPL.D',
%1252%	SIXBIT'CMPL.I',
	SIXBIT'CMPLX.',
	SIXBIT'CONJG.',
	SIXBIT'COS.',
	SIXBIT'COSD.',
	SIXBIT'COSH.',
%[761]%	SIXBIT'COTAN.',
	SIXBIT'CSIN.',
	SIXBIT'CSQRT.',
	SIXBIT'DABS.',
%[761]%	SIXBIT'DACOS.',
%[761]%	SIXBIT'DASIN.',
	SIXBIT'DATAN.',
	SIXBIT'DATN2.',
	SIXBIT'DBLE.',
%1252%	SIXBIT'DBLE.C',
%1252%	SIXBIT'DBLE.I',
	SIXBIT'DCOS.',
%[761]%	SIXBIT'DCOSH.',
%[761]%	SIXBIT'DCOTN.',
%1241%	SIXBIT'DDIM.',
	SIXBIT'DEXP.',
	SIXBIT'DFLOT.',
	SIXBIT'DIM.',
%1241%	SIXBIT'DINT.',
	SIXBIT'DLOG.',
	SIXBIT'DLG10.',
	SIXBIT'DMAX1.',
	SIXBIT'DMIN1.',
	SIXBIT'DMOD.',
%1241%	SIXBIT'DNINT.',
%1241%	SIXBIT'DPROD.',
	SIXBIT'DSIGN.',
	SIXBIT'DSIN.',
%[761]%	SIXBIT'DSINH.',
	SIXBIT'DSQRT.',
%[761]%	SIXBIT'DTAN.',
%[761]%	SIXBIT'DTANH.',
	SIXBIT'EXP.',
	SIXBIT'FLOAT.',
	SIXBIT'IABS.',
%1264%	SIXBIT'ICHAR.',
	SIXBIT'IDIM.',
	SIXBIT'IDINT.',
%1241%	SIXBIT'IDNIN.',
	SIXBIT'IFIX.',
%1264%	SIXBIT'INDEX.',
	SIXBIT'INT.',
%1252%	SIXBIT'INT.C',
	SIXBIT'ISIGN.',
%1264%	SIXBIT'LEN.',
%1264%	SIXBIT'LGE.',
%1264%	SIXBIT'LGT.',
%1264%	SIXBIT'LLE.',
%1264%	SIXBIT'LLT.',
%1241%	SIXBIT'LOG.',
%1264%	SIXBIT'LOG10.',
%1264%	SIXBIT'MAX.',
	SIXBIT'MAX0.',
	SIXBIT'MAX1.',
%1264%	SIXBIT'MIN.',
	SIXBIT'MIN0.',
	SIXBIT'MIN1.',
	SIXBIT'MOD.',
%1241%	SIXBIT'NINT.',
%1264%	SIXBIT'NOP.',		!Should not be called.
%1264%	SIXBIT'NOP.',		!Should not be called.
%1264%	SIXBIT'NOP.',		!Should not be called.
%1264%	SIXBIT'NOP.',		!Should not be called.
	SIXBIT'REAL.',
%1252%	SIXBIT'REAL.C',
	SIXBIT'SIGN.',
	SIXBIT'SIN.',
	SIXBIT'SIND.',
	SIXBIT'SINH.',
	SIXBIT'SNGL.',
	SIXBIT'SQRT.',
%[761]%	SIXBIT'TAN.',
	SIXBIT'TANH.');

![761] Table for dotted names under /GFLOATING
%[761]% BIND GDUMMM= PLIT( GDOTTEDNAMES GLOBALLY NAMES

%[761]%	SIXBIT'ABS.',
%[761]%	SIXBIT'ACOS.',
%[761]%	SIXBIT'AIMAG.',
%[761]%	SIXBIT'AINT.',
%[761]%	SIXBIT'ALOG.',
%[761]%	SIXBIT'ALG10.',
%[761]%	SIXBIT'AMAX0.',
%[761]%	SIXBIT'AMAX1.',
%[761]%	SIXBIT'AMIN0.',
%[761]%	SIXBIT'AMIN1.',
%[761]%	SIXBIT'AMOD.',
%1241%	SIXBIT'ANINT.',
%[761]%	SIXBIT'ASIN.',
%[761]%	SIXBIT'ATAN.',
%[761]%	SIXBIT'ATAN2.',
%[761]%	SIXBIT'CABS.',
%[761]%	SIXBIT'CCOS.',
%[761]%	SIXBIT'CGABS.',
%[761]%	SIXBIT'CEXP.',
%1264%	SIXBIT'CHAR.',
%[761]%	SIXBIT'CLOG.',
%1252%	SIXBIT'CMP1.D',
%1252%	SIXBIT'CMP1.I',
%1252%	SIXBIT'CMP1.R',
%1264%	SIXBIT'CMPL.C',
%1543%	SIXBIT'CMPL.G',
%1252%	SIXBIT'CMPL.I',
%[761]%	SIXBIT'CMPLX.',
%[761]%	SIXBIT'CONJG.',
%[761]%	SIXBIT'COS.',
%[761]%	SIXBIT'COSD.',
%[761]%	SIXBIT'COSH.',
%[761]%	SIXBIT'COTAN.',
%[761]%	SIXBIT'CSIN.',
%[761]%	SIXBIT'CSQRT.',
%[761]%	SIXBIT'GABS.',
%[761]%	SIXBIT'GACOS.',
%[761]%	SIXBIT'GASIN.',
%[761]%	SIXBIT'GATAN.',
%[761]%	SIXBIT'GATN2.',
%[761]%	SIXBIT'GBLE.',
%1252%	SIXBIT'DBLE.C',
%1252%	SIXBIT'DBLE.I',
%[761]%	SIXBIT'GCOS.',
%[761]%	SIXBIT'GCOSH.',
%[761]%	SIXBIT'GCOTN.',
%1241%	SIXBIT'GDIM.',
%[761]%	SIXBIT'GEXP.',
%[761]%	SIXBIT'GFLOT.',
%[761]%	SIXBIT'DIM.',
%1241%	SIXBIT'GINT.',
%[761]%	SIXBIT'GLOG.',
%[761]%	SIXBIT'GLG10.',
%[761]%	SIXBIT'GMAX1.',
%[761]%	SIXBIT'GMIN1.',
%[761]%	SIXBIT'GMOD.',
%1241%	SIXBIT'GNINT.',
%1241%	SIXBIT'GPROD.',
%[761]%	SIXBIT'GSIGN.',
%[761]%	SIXBIT'GSIN.',
%[761]%	SIXBIT'GSINH.',
%[761]%	SIXBIT'GSQRT.',
%[761]%	SIXBIT'GTAN.',
%[761]%	SIXBIT'GTANH.',
%[761]%	SIXBIT'EXP.',
%[761]%	SIXBIT'FLOAT.',
%[761]%	SIXBIT'IABS.',
%1264%	SIXBIT'ICHAR.',
%[761]%	SIXBIT'IDIM.',
%[1075]% SIXBIT'IGINT.',
%1241%	SIXBIT'IGNIN.',
%[761]%	SIXBIT'IFIX.',
%1264%	SIXBIT'INDEX.',
%[761]%	SIXBIT'INT.',
%1252%	SIXBIT'INT.C',
%[761]%	SIXBIT'ISIGN.',
%1264%	SIXBIT'LEN.',
%1264%	SIXBIT'LGE.',
%1264%	SIXBIT'LGT.',
%1264%	SIXBIT'LLE.',
%1264%	SIXBIT'LLT.',
%1241%	SIXBIT'LOG.',
%1264%	SIXBIT'LOG10.',
%1264%	SIXBIT'MAX.',
%[761]%	SIXBIT'MAX0.',
%[761]%	SIXBIT'MAX1.',
%1264%	SIXBIT'MIN.',
%[761]%	SIXBIT'MIN0.',
%[761]%	SIXBIT'MIN1.',
%[761]%	SIXBIT'MOD.',
%1241%	SIXBIT'NINT.',
%1264%	SIXBIT'NOP.',		!Should not be called.
%1264%	SIXBIT'NOP.',		!Should not be called.
%1264%	SIXBIT'NOP.',		!Should not be called.
%1264%	SIXBIT'NOP.',		!Should not be called.
%[761]%	SIXBIT'REAL.',
%1252%	SIXBIT'REAL.C',
%[761]%	SIXBIT'SIGN.',
%[761]%	SIXBIT'SIN.',
%[761]%	SIXBIT'SIND.',
%[761]%	SIXBIT'SINH.',
%[1075]% SIXBIT'GSNGL.',
%[761]%	SIXBIT'SQRT.',
%[761]%	SIXBIT'TAN.',
%[761]%	SIXBIT'TANH.');
GLOBAL ROUTINE MAKDOTTEDNAME(FNIX,SYMTABPTR) =  ![1513] Created from MAKLIBFN
%(***************************************************************************

	This routine substitutes a dotted function name for the name
	used by the original program.  It makes a symbol table entry for
	the dotted function name to be used.  It sets the "function
	attribute" and value-type fields of the symbol table entry
	created from the values found in the "library function attribute
	table" entry for the function.

	This routine returns a pointer to the STE it created for the
	dotted name.

	The arg "FNIX" is the index for the function name in the
	LIBATTRIBUTES table.
 
	The arg "SYMTABPTR" is a pointer to the STE for the function name
	used in the original program (the undotted, possibly generic, name).

***************************************************************************)%
BEGIN

%1270%	MAP PEXPRNODE SYMTABPTR;	!Pointer into symbol table for origonal

	OWN PEXPRNODE FNSYMENTRY;   !Symbol table entry created for the fn name


	NAME = IDTAB;

![1004] Choose dotted names based on /GFLOATING.

%1241%	IF .GFLOAT
%1004%	THEN ENTRY[0] = .GDOTTEDNAMES[.FNIX]
%1004%	ELSE ENTRY[0] = .DOTTEDNAMES[.FNIX];

%1505%	FNSYMENTRY = TBLSEARCH();

	! Set the value-type and function attribute fields of the symbol
	! table entry, and set the value type field of the function-call
	! node.
	FNSYMENTRY[VALTYPE] = .LIBATTRIBUTES[.FNIX,ATTRESTYPE];
	FNSYMENTRY[IDFNATTRIB] = .LIBATTRIBUTES[.FNIX,ATTFNATTRIB];
	FNSYMENTRY[OPERSP] = FNNAME;

%1513%	! Get the INEXTERN bit from  the original STE.  If this  routine
%1513%	! is character, HSCHD will use this  bit to decide if it  should
%1513%	! allocate a descriptor.
%1513%	FNSYMENTRY[IDATTRIBUT(INEXTERN)] = .SYMTABPTR[IDATTRIBUT(INEXTERN)];


%1567%	! Mark whether there's any chance  of folding the function  call
%1567%	! into a constant.
%1567%	FNSYMENTRY[IDFNFOLD] = .LIBATTRIBUTES[.FNIX,ATTFNFOLD];


%1434%	! If this is the character  function CHAR() then set the  length
%1434%	! in the symbol table  to 1.  If it  is not CHAR, then  complain
%1434%	! with an ?ICE since we'll have a new function that must be set.

%1434%	IF .FNSYMENTRY[VALTYPE] EQL CHARACTER
%1434%	THEN
%1434%	BEGIN

%1513%		! Using a INTRINSIC character function declare a character
%1513%		! identifier--the name of the character function.
%1513%		CHDECL = TRUE;

%1434%		IF .FNSYMENTRY[IDSYMBOL] EQL SIXBIT 'CHAR.'
%1434%		THEN	FNSYMENTRY[IDCHLEN] = 1
%1434%		ELSE	CGERR();! Error, must figure out what length
%1434%				! we need for this new function
%1434%	END;

%1270%	! Check if the function has been declared in a type statement and
%1270%	! it is not of the type of the original call.  If so, it's ignored.	

%1270%	IF .SYMTABPTR[IDATTRIBUT(INTYPE)] AND 
%1270%		(.FNSYMENTRY[VALTYPE] NEQ .SYMTABPTR[VALTYPE])
%1270%	THEN WARNERR(SYMTABPTR[IDSYMBOL],.ISN,E170<0,0>);

	RETURN .FNSYMENTRY

END;	! of MAKDOTTEDNAME
GLOBAL ROUTINE MAKLIBFN(FNNAMENTRY,FNCALLNODE,SYMTABPTR)=
%(***************************************************************************
	This routine is called for every call to a library Function.

	The arg "FNNAMENTRY" is a pointer to the entry in the function name
	table for this function.

	The arg "FNCALLNODE" is a pointer to the expression node for the
	function call being processed. ARG2PTR of this expression node points 
	to the argument list for this call. All args on this list should
	already have been processed by EXPRTYPER.

	The arg "SYMTABPTR" is a pointer to the STE for the function name
	used in the original program (the undotted, possibly generic, name).

	This routine checks for whether the function is a generic one and
	if so, replaces the function name by the actual function name to be
	used.

	This routine calls MAKDOTTEDNAME to substitute a dotted function
	name for the function name used by the original program.  This
	routine also sets ARG1PTR of the function call node to point to
	the STE of the dotted name.

	If the Fn is not generic and the arg is not of the expected type, it
	prints an error message. Also if the Fn is generic but the Arg is of
	a type not handled, it prints an error message.

	If the number of args does not agree with the required number, prints
	an error message.
***************************************************************************)%
BEGIN
	OWN BASE  SYMENTRY;		! Un dotted symbol table entry pointer
	OWN PEXPRNODE FNSYMENTRY;   	! Function symbol table entry
	MAP PEXPRNODE FNCALLNODE;
%1270%	MAP PEXPRNODE SYMTABPTR;	! Pointer into symbol table  for
					! origonal
OWN	ARGUMENTLIST ARGLST,	! The argument list  under the node  for
				! this fn-call
	FNIX,			! Index for  the  function-name  in  the
				! LIBATTRIBUTES table
	ARG1TYPE,		! Type of first fn argument (type of fn)
	PEXPRNODE ARG1NODE;	! Expression node for  the first arg  on
				! the arglist


	SYMENTRY = .FNCALLNODE[ARG1PTR];	!SET SYMBOL TABLE POINTER

	ARGLST = .FNCALLNODE[ARG2PTR];	!PTR TO THE ARGUMENT LIST
	ARG1NODE = .ARGLST[1,ARGNPTR];	!PTR TO THE FIRST ARGUMENT


%1275%	!If there are less than 1 argument (no arg or the compiler put
%1275%	! trash in the count) complain that this is illegal.

%1275%	IF .ARGLST[ARGCOUNT] LSS 1
%1275%	THEN
%1275%	BEGIN
%1275%		WARNERR(.FNNAMENTRY,.ISN,E81<0,0>);
%1275%		RETURN;		!No use continuing
%1275%	END;


%1252%	! If function is CMPLX and has only one argument, change the
%1252%	! function to CMP1.R.

%1252%	IF .FNNAMENTRY EQL CMPLXENT<0,0> AND
%1252%		.ARGLST[ARGCOUNT] EQL 1 THEN
%1252%		FNNAMENTRY = ?CMP1.RENT;	!Set to CMPL.R

	FNIX = .FNNAMENTRY-LIBFUNTAB<0,0>;	!Diplacement off table.

	%(*** Check that the Args are of the expected type 
		- If not give an error message ***)%

	ARG1TYPE = .ARG1NODE[VALTYPE];
	IF .ARG1TYPE EQL OCTAL 
		OR .ARG1TYPE EQL LOGICAL 
%1270%		OR .ARG1TYPE EQL DOUBLOCT
	THEN
	BEGIN
	%(***For the arg of type OCTAL or LOGICAL - accept the argument unless
		generic function has no name in standard so that the 
		interpretation of how to treat the argument is unclear.
		Do no type checking and do not call some other fn in the case
		of a generic fn.
	*******)%
%1270%		IF .LIBATTRIBUTES[.FNIX,ATTSPGEN]
%1270%		THEN FATLERR(.ISN,E169<0,0>);
	END

	ELSE
	%(***If the fn is generic, get a ptr to the actual fn to use***)%
	IF .LIBATTRIBUTES[.FNIX,ATTGENERFLG]
	THEN
	BEGIN
		OWN ACTFN;	!Ptr to the entry in the library fn name table
				! for the actual fn to be used when the fn
				! name used by the orig prog was a generic one
		ACTFN = .LIBATTRIBUTES[.FNIX,ATTACTFN,.ARG1NODE[VALTP1]];

		! If there is no function corresponding to the ARGTYPE
		! used, then give an error message and use the original
		! function name.  Also if the function is generic, the
		! value type CAN NOT be character!  To allow character
		! arguments, the table to decide which function under
		! the generic is really being called would have to be
		! re-worked.

		IF .ACTFN EQL ILGARGTYPE 
%1270%			OR .ARG1TYPE EQL CHARACTER
%1270%			OR .ARG1TYPE EQL HOLLERITH
%1270%		THEN WARNERR(SYMTABPTR[IDSYMBOL],.ISN,E80<0,0>)
		ELSE	!*** If have changed the function name to be referred
			! to, change the value of the index into the function
			! name table ***
			FNIX = (.ACTFN)<0,0>-LIBFUNTAB<0,0>;
	END
	ELSE
	BEGIN

		! For non generic fns - Check that the first arg has the
		! type indicated by the library-fn attribute table - if
		! not, give an error message.

		! Make sure that for a non-generic function, the type being
		! compared against for later arguments is the type of the 
		! function rather than the type of the first argument.
		ARG1TYPE = .LIBATTRIBUTES[.FNIX,ATTARGTYP];
		IF .ARG1NODE[VALTYPE] NEQ .ARG1TYPE
		THEN WARNERR(.FNNAMENTRY,.ISN,E80<0,0>)
	END;

%1513%	! Get dotted name of the intrinsic routine
%1513%	FNCALLNODE[ARG1PTR] = FNSYMENTRY = MAKDOTTEDNAME(.FNIX,.SYMTABPTR);
%1513%	FNCALLNODE[VALTYPE] = .FNSYMENTRY[VALTYPE];


%1535%	! If  function  ICHAR  with  constant  argument,  check  if  the
%1535%	! argument is over 1 character long.
%1535%
%1535%	IF .FNSYMENTRY[IDSYMBOL] EQL SIXBIT 'ICHAR.'
%1535%	THEN
%1535%	BEGIN
%1535%		IF .ARG1NODE[OPR1] EQL CONSTFL THEN
%1535%		IF .ARG1NODE[LITLEN] NEQ 1
%1535%		THEN	FATLERR(.ISN,E203<0,0>);
%1535%	END;

	! Check that  the number  of arguments  agrees with  the  number
	! specified for the fn by the library fn attribute table.
	IF ((.LIBATTRIBUTES[.FNIX,ATTARGCT] NEQ VARGCTFLG) AND
		.ARGLST[ARGCOUNT] NEQ .LIBATTRIBUTES[.FNIX,ATTARGCT])
		OR ((.LIBATTRIBUTES[.FNIX,ATTARGCT] EQL VARGCTFLG) AND 
		.ARGLST[ARGCOUNT] LSS 2)
	THEN WARNERR(.FNNAMENTRY,.ISN,E81<0,0>)


	ELSE
	%(*** If the function has more than one arg, successive args must have
		the same type as the first arg ***)%
	BEGIN
		!Only need to test the rest of the argument list
		INCR I FROM 2 TO .ARGLST[ARGCOUNT]
		DO
		BEGIN
			OWN PEXPRNODE ARGNODE;
			ARGNODE = .ARGLST[.I,ARGNPTR];
			IF .ARGNODE[VALTYPE] NEQ .ARG1TYPE
			THEN WARNERR(.FNNAMENTRY,.ISN,E80<0,0>)
		END
	END;
	%(****** Set OPERSP in the function call node
		to indicate library function **************)%
	FNCALLNODE[OPERSP] = LIBARY;

%1436%	! Set CHARUSED if the prog contains calls to intrinsic
%1436%	! character functions.
%1436%	IF .FNCALLNODE[VALTYPE] EQL CHARACTER
%1436%		OR .ARG1TYPE EQL CHARACTER
%1436%	THEN
%1436%	CHARUSED = TRUE;


END;	! of MAKLIBFN

END
ELUDOM