Trailing-Edge
-
PDP-10 Archives
-
BB-D480C-SB_1981
-
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) 1972,1981 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: S. MURPHY/DCE/TFV/EGM
MODULE GNRCFN(SREG=#17,VREG=#15,FREG=#16,DREGS=4,RESERVE(0,1,2,3)) =
BEGIN
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
SWITCHES LIST;
GLOBAL BIND GNRCFV = 6^24 + 0^18 + 35; ! Version Date: 22-Jul-81
%(
***** 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).
***** End Revision History *****
)%
EXTERNAL
TBLSEARCH,
ERROUT;
%(***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.',
SIXBIT'ASIN.',
SIXBIT'ATAN.',
SIXBIT'ATAN2.',
SIXBIT'CABS.',
SIXBIT'CCOS.',
%[761]% SIXBIT'CDABS.',
SIXBIT'CEXP.',
SIXBIT'CLOG.',
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.',
SIXBIT'DCOS.',
%[761]% SIXBIT'DCOSH.',
%[761]% SIXBIT'DCOTN.',
SIXBIT'DEXP.',
SIXBIT'DFLOT.',
SIXBIT'DIM.',
SIXBIT'DLOG.',
SIXBIT'DLG10.',
SIXBIT'DMAX1.',
SIXBIT'DMIN1.',
SIXBIT'DMOD.',
SIXBIT'DSIGN.',
SIXBIT'DSIN.',
%[761]% SIXBIT'DSINH.',
SIXBIT'DSQRT.',
%[761]% SIXBIT'DTAN.',
%[761]% SIXBIT'DTANH.',
SIXBIT'EXP.',
SIXBIT'FLOAT.',
SIXBIT'IABS.',
SIXBIT'IDIM.',
SIXBIT'IDINT.',
SIXBIT'IFIX.',
SIXBIT'INT.',
SIXBIT'ISIGN.',
SIXBIT'MAX0.',
SIXBIT'MAX1.',
SIXBIT'MIN0.',
SIXBIT'MIN1.',
SIXBIT'MOD.',
SIXBIT'REAL.',
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.',
%[761]% SIXBIT'ASIN.',
%[761]% SIXBIT'ATAN.',
%[761]% SIXBIT'ATAN2.',
%[761]% SIXBIT'CABS.',
%[761]% SIXBIT'CCOS.',
%[761]% SIXBIT'CGABS.',
%[761]% SIXBIT'CEXP.',
%[761]% SIXBIT'CLOG.',
%[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.',
%[761]% SIXBIT'GCOS.',
%[761]% SIXBIT'GCOSH.',
%[761]% SIXBIT'GCOTN.',
%[761]% SIXBIT'GEXP.',
%[761]% SIXBIT'GFLOT.',
%[761]% SIXBIT'DIM.',
%[761]% SIXBIT'GLOG.',
%[761]% SIXBIT'GLG10.',
%[761]% SIXBIT'GMAX1.',
%[761]% SIXBIT'GMIN1.',
%[761]% SIXBIT'GMOD.',
%[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.',
%[761]% SIXBIT'IDIM.',
%[1075]% SIXBIT'IGINT.',
%[761]% SIXBIT'IFIX.',
%[761]% SIXBIT'INT.',
%[761]% SIXBIT'ISIGN.',
%[761]% SIXBIT'MAX0.',
%[761]% SIXBIT'MAX1.',
%[761]% SIXBIT'MIN0.',
%[761]% SIXBIT'MIN1.',
%[761]% SIXBIT'MOD.',
%[761]% SIXBIT'REAL.',
%[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 MAKLIBFN(FNNAMENTRY,FNCALLNODE)=
%(***************************************************************************
THIS ROUTINE IS CALLED FOR EVERY CALL TO A LIBRARY FN.
THE ARG "FNNAMENTRY" IS A PTR TO THE ENTRY IN THE FUNCTION NAME
TABLE FOR THIS FUNCTION.
THE ARG "FNCALLNODE" IS A PTR 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.
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 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.
AND SETS ARG1PTR OF THE FUNCTION CALL NODE TO POINT TO
THAT SYMBOL TABLE ENTRY. 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.
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
MAP PEXPRNODE FNCALLNODE;
OWN PEXPRNODE FNSYMENTRY; !SYMBOL TABLE ENTRY CREATED FOR THE FN NAME
OWN ARGUMENTLIST ARGLST; !THE ARGUMENT LIST UNDER THE NODE FOR THIS FN-CALL
EXTERNAL LIBFUNTAB,LIBATTRIBUTES;
EXTERNAL FATLEX,WARNERR;
MAP LIBATTSTR LIBATTRIBUTES;
OWN FNIX; !INDEX FOR THE FUNCTION-NAME IN THE LIBATTRIBUTES TABLE
OWN ARG1TYPE; !TYPE OF FIRST FN ARGUMENT (TYPE OF FN)
OWN PEXPRNODE ARG1NODE; !EXPRESSION NODE FOR THE FIRST ARG ON THE ARGLIST
FNIX_.FNNAMENTRY-LIBFUNTAB<0,0>;
SYMENTRY _ .FNCALLNODE[ARG1PTR]; !SET SYMBOL TABLE POINTER
ARGLST_.FNCALLNODE[ARG2PTR]; !PTR TO THE ARGUMENT LIST
ARG1NODE_.ARGLST[1,ARGNPTR]; !PTR TO THE FIRST ARGUMENT
%(***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
THEN
%(***FOR THE ARG OF TYPE OCTAL OR LOGICAL - ALWAYS ACCEPT IT AS IS.
DO NO TYPE CHECKING AND DO NOT CALL SOME OTHER FN IN THE CASE
OF A GENERIC FN
*******)%
BEGIN END
ELSE
%(***IF THE FN IS GENERIC, GET A PTR TO THE ACTUAL FN TO USE***)%
IF .LIBATTRIBUTES[.FNIX,ATTGENERFLG]
AND NOT .SYMENTRY[IDATTRIBUT(INTYPE)] %EXPLICITLY TYPED FUNCTIONS CANNOT BE GENERIC%
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 FN NAME***)%
IF .ACTFN EQL ILGARGTYPE
THEN
BEGIN
EXTERNAL E80;
WARNERR(.FNNAMENTRY,.ISN,E80<0,0>);
END
%(***IF HAVE CHNGED THE FUNCTION NAME TO BE REFERRED TO***)%
ELSE
%(*** 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
BEGIN
EXTERNAL E80;
WARNERR(.FNNAMENTRY,.ISN,E80<0,0>);
END;
END;
%(***MAKE A SYMBOL TABLE ENTRY FOR THE DOTTED NAME FOR THIS FN***)%
NAME_IDTAB;
![1004] Choose dotted names based on /GFLOATING for DP functions
%[1004]% IF .GFLOAT AND .LIBATTRIBUTES[.FNIX,ATTRESTYPE] EQL DOUBLPREC
%[1004]% THEN ENTRY[0]_.GDOTTEDNAMES[.FNIX]
%[1004]% ELSE ENTRY[0]_.DOTTEDNAMES[.FNIX];
FNCALLNODE[ARG1PTR]_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_.FNCALLNODE[ARG1PTR];
FNSYMENTRY[VALTYPE]_.LIBATTRIBUTES[.FNIX,ATTRESTYPE];
FNCALLNODE[VALTYPE]_.FNSYMENTRY[VALTYPE];
FNSYMENTRY[IDFNATTRIB]_.LIBATTRIBUTES[.FNIX,ATTFNATTRIB];
FNSYMENTRY[OPERSP]_FNNAME;
%(***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
BEGIN
EXTERNAL E81;
WARNERR(.FNNAMENTRY,.ISN,E81<0,0>);
END
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
BEGIN
EXTERNAL E80;
WARNERR(.FNNAMENTRY,.ISN,E80<0,0>);
END
END
END;
%(******SET OPERSP IN THE FUNCTION CALL NODE
TO INDICATE LIBRARY FUNCTION**************)%
FNCALLNODE[OPERSP]_LIBARY;
END;