Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/ftncsr/gnrcfn.bli
There are 26 other files named gnrcfn.bli in the archive. Click here to see a list.
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1972, 1988
!ALL RIGHTS RESERVED.
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
!ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
!INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
!COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
!OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
!TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
!AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
!CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
!SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

!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 = #11^24 + 0^18 + #4604;	! Version Date:	26-Sep-88

%(

***** 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.


***** Begin Version 10 *****

2301	RVM	28-Jan-84
	Make the compiler know about the MIL SPEC/VAX FORTRAN bit
	manipulation functions.  They are new INTRINSIC functions.

***** End V10 Development *****

2577	MEM	17-Sep-86
	Under FLAGANSI, check ATTFLAGANSI bit of LIBATTRIBUTES for
	intrinsic functions and give warning if necessary.

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

***** Begin Version 11 *****

4516	CDM	2-Oct-85
	Phase I.I for VMS long symbols.  Pass Sixbit to all error message
	routines, do not pass addresses of Sixbit anymore.  In later edits
	this will pass [length,,pointer to symbol] instead of a pointer to
	this to the error message routines.

4527	CDM	1-Jan-86
	VMS Long symbols phase II.  Convert all internal symbols from
	one word of Sixbit to [length,,pointer].

***** End V11 Development *****

***** Begin Version 11A *****

4604	DCE	26-Sep-88
	Correct edit 2577 so that the name gets passed correctly (instead
	of a pointer to the name).

***** End Version 11A *****

ENDV11
)%

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
%2577%	E294,		! non F77 function or subroutine
	ERROUT,
%1270%	FATLERR,	! Error routine.
	FATLEX,		! Fatal error routine.
	LIBFUNTAB,
	LIBATTRIBUTES,
%4516%	ONEWPTR,	! Returns [1,,pointer] for sixbit passed to it
	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.',
%2301%	SIXBIT'BTEST.',
	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.',
%2301%	SIXBIT'IAND.',
%2301%	SIXBIT'IBCLR.',
%2301%	SIXBIT'IBITS.',
%2301%	SIXBIT'IBSET.',
%1264%	SIXBIT'ICHAR.',
	SIXBIT'IDIM.',
	SIXBIT'IDINT.',
%1241%	SIXBIT'IDNIN.',
%2301%	SIXBIT'IEOR.',
	SIXBIT'IFIX.',
%1264%	SIXBIT'INDEX.',
	SIXBIT'INT.',
%1252%	SIXBIT'INT.C',
%2301%	SIXBIT'IOR.',
%2301%	SIXBIT'ISHFT.',
%2301%	SIXBIT'ISHFC.',
	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.
%2301%	SIXBIT'NOT.',
	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.',
%2301%	SIXBIT'BTEST.',
%[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.',
%2301%	SIXBIT'IAND.',
%2301%	SIXBIT'IBCLR.',
%2301%	SIXBIT'IBITS.',
%2301%	SIXBIT'IBSET.',
%1264%	SIXBIT'ICHAR.',
%[761]%	SIXBIT'IDIM.',
%[1075]% SIXBIT'IGINT.',
%1241%	SIXBIT'IGNIN.',
%2301%	SIXBIT'IEOR.',
%[761]%	SIXBIT'IFIX.',
%1264%	SIXBIT'INDEX.',
%[761]%	SIXBIT'INT.',
%1252%	SIXBIT'INT.C',
%2301%	SIXBIT'IOR.',
%2301%	SIXBIT'ISHFT.',
%2301%	SIXBIT'ISHFC.',
%[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.
%2301%	SIXBIT'NOT.',
%[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

%4527%	REGISTER BASE FNSYMENTRY;   !Symbol table entry created for the fn name

%2577%	! Ansi flagging for functions (all functions are vms compatible)
%2577%	IF FLAGANSI
%2577%	THEN IF .LIBATTRIBUTES[.FNIX,ATTFLAGANSI]
!**;[4604], MAKDOTTEDNAME,5425, DCE, 26-Sep-88
%4604%	THEN WARNERR(.SYMTABPTR[IDSYMBOL],.ISN,E294<0,0>);

	NAME = IDTAB;

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

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

%4516%	ENTRY = ONEWPTR(.ENTRY[0]);

%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	! Character function

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

%4527%		IF .FNSYMENTRY[ID1ST6CHAR] 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;	! Character function

%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)=
!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine is called for every call to a library Function.
!
!	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.
!
! FORMAL PARAMETERS:
!
!	FNNAMENTRY is a pointer to the entry in the function name table for
!		this function.
!
!	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.
!
!	SYMTABPTR is a pointer to the STE for the function name used in the
!		original program (the undotted, possibly generic, name).
!
! IMPLICIT INPUTS:
!
!	Unknown
!
! IMPLICIT OUTPUTS:
!
!	Unknown
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	Unknown
!
!--


BEGIN

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

%4527% LOCAL
	ARG1TYPE,		! Type of first fn argument (type of fn)
%4527%	BASE ARG1NODE,		! Expression node for  the first arg  on
				! the arglist
	ARGUMENTLIST ARGLST,	! The argument list  under the node  for
				! this fn-call
	FNIX,			! Index for  the  function-name  in  the
				! LIBATTRIBUTES table
%4527%	BASE FNSYMENTRY,   	! Function symbol table entry
				! original
	BASE SYMENTRY;		! Un dotted symbol table entry pointer


	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
%4527%		WARNERR(ONEWPTR(@@FNNAMENTRY<SYMPOINTER>),.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
		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
%4527%		THEN WARNERR(ONEWPTR(@@FNNAMENTRY<SYMPOINTER>),.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%
%4527%	IF .FNSYMENTRY[ID1ST6CHAR] 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)
%4527%	THEN WARNERR(ONEWPTR(@@FNNAMENTRY<SYMPOINTER>),.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
%4527%			LOCAL PEXPRNODE ARGNODE;
			ARGNODE = .ARGLST[.I,ARGNPTR];
			IF .ARGNODE[VALTYPE] NEQ .ARG1TYPE
%4527%			THEN WARNERR(ONEWPTR(@@FNNAMENTRY<SYMPOINTER>),
					.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