*DECK     ASFPRO
          IDENT  ASFPRO 
          TITLE              ASFPRO - ARITHMETIC STMT FUNCTION PROCESSOR
*CALL     SSTCALL 
*** 
*         ASFPRO - ASF DEFINITION AND REFERENCE PROCESSING
* 
  
 B=ASFPR  RPVDEF             DEFINE ROUTINE FWA FOR REPRIEVE UTILITY
          EXT    ERPRO,RSELECT,PH2RETN,IDORDL,NAMFWA,PSYM,RSELECT 
          EXT    FWAWORK,LWAWORK,S.SCR
          TABLES ASF,SCR
  
 SELIST   EQU    32B
 LELIST   EQU    34B               FWA OF STMT FOLLOWING LOGICAL IF 
  
 EL.PC    EQU    77B               E-LIST PARAMETER CODE
 M.FP     EQU    63                MAX NUMBER OF ARGS IN AN ASF DEFINITI
  
 LEFT(    EQU    2000B+EL.( 
 RIGHT(   EQU    2000B+EL.) 
  
*         ERROR NUMBERS 
  
 E.DDP    EQU    50                DOUBLY DEFINED PARAMETER 
 E.TMP    EQU    51                TOO MANY PARAMETERS
 E.PLE    EQU    52                ASF PARAMETER LIST ERROR 
 E.RSE    EQU    53                MEMORY OVERFLOW ON ASF EXPANSION 
 E.BADA   EQU    216               BAD STMT FUNCTION ARG
  
 E.UBP    EQU    63                UNBALENCED PARENS
 E.UML    EQU    64                N.ACT PARAMS .NE. N.PARAMS IN DEF
 E.EAP    EQU    199               EMPTY ACTUAL PARAMETER 
  
*         LOCAL STORAGE 
  
 ASFT     BSS    4                 TEMPORARY STORAGE FOR ASFPRO 
  
 WORDB    EQU    ASFT              SYMTAB ADDRESS OF WORD B OF ASF NAME 
 N.PAR    EQU    ASFT+1            NUMBER OF PARAMS 
 FWA      EQU    ASFT+2            FWA AND LENGTH OF TEXT OF ASF DEF
 CLEN     EQU    ASFT+2            LENGTH AND NUMBER OF CONSTANTS IN DEF
  
 IASF     EQU    ASFT              INDEX TO ASF DEF IN ASFTAB 
 O.REM    EQU    ASFT+2            FWA OF REMAINDER OF STMT 
 L.REM    EQU    O.REM+1           LENGTH 
  
 DMASK    DATA   144BS51           MASK FOR ( ) , DELIMITERS
*CALL     PARSEM
          TITLE              ASFDEF - PROCESS ASF DEFINITION
*** 
*         ASFDEF- PROCESS ASF DEFINITION
* 
*         SAVES RIGHT HAND SIDE OF ASF STMT IN ASFTAB 
*         IN E-LIST FORMAT WITH DUMMY PARAMETERS REPLACED BY
*         SUBSTITUTION FLAGS OF THE FORM:  12/2000B+EL.PC,48/PARAM NUM
*         AND ALL CONSTANTS APPEARING IN THE DEFINITION ARE MOVED 
*         FROM CONSTOR AREA TO ASFTAB, ABOVE THE DEFINITION.
* 
*         THE NUMBER OF PARAMETERS AND AN INDEX TO ASFTAB ARE 
*         PLACED IN WORD B OF THE SYMTAB ENTRY FOR THE ASF NAME.
* 
  
          ENTRY  ASFDEF 
 ASFDEF   SX6    B1 
          SX7    A2 
          SA6    IDORDL            SYMORD 
          SA7    WORDB             ADDRESS OF WORD B
          SB3    EL.COMMA 
          SA5    SELIST 
          SA4    X5-1 
          SB4    B0                N.PAR = 0
          SB6    A4-B5             B6 = FWA OF PARAM LIST 
  
*         SYNTAX CHECK ARG LIST 
  
 ASFD1    NEXTE 
          IF.NE  NAME,ASF.E1       IF NOT A NAME
          SB4    B4+B5             N.PAR = N.PAR+1
          NEXTE 
          EQ     B2,B3,ASFD1       LOOP IF A ,
  
          IF.NE  EL.),ASF.E1       IF NO )
          NEXTE 
          IF.NE  EL.=,ASF.E1       IF NO = S
          SB7    A4-B5             B7 = FWA OF TEXT 
  
          SX6    B4 
          SA6    N.PAR             SAVE NUMBER OF PARAMS
          SX7    X6-M.FP-1
          PL     X7,ASF.E2         IF TOO MANY PARAMS 
  
*         REPLACE ALL REFERENCES TO PARAMETERS WITH SUBSTITUTION FLAGS
*         CHECK FOR DOUBLY DEFINED PARAMETERS 
  
          SX0    B5                PARAMETER ORDINAL
          SB1    EL.PC
          SB4    -B4               -N.PAR 
          PX7    B1,X0             SUBSTITUTION FLAG
          SB3    EL.EOS 
  
 ASFD2    SA3    B6                PARAMETER
          SB6    B6-2 
          SA4    B6                FIRST ITEM OF INTEREST 
          UX1    B2,X4
          SB4    B4+B5             DECREMENT NUMBER OF ARGS TO GO 
  
 ASFD3    EQ     B2,B3,ASFD4       IF EOS 
          IX2    X3-X4             PARAM - ELIST
          NEXTE 
          NZ     X2,ASFD3          IF NO MATCH
          LE     B2,B5,ASF.E3      IF DUMMY ARG FOLLOWED BY CON OR NAME 
  
          SB1    A4-B7
          PL     B1,ASF.E4         IF DOUBLY DEFINED PARAMETER
          SA7    A4+B5             REPLACE WITH PARAMETER MARKER
          EQ     ASFD3
  
 ASFD4    SX6    A4-B7
          ZR     X6,ASF.E5         IF FWA OF TEXT = EOS (I.E., NO TEXT).
          IX7    X7+X0             ADVANCE SUBSTITUTION FLAG ORDINAL
          MI     B4,ASFD2          IF NOT FINISHED. 
  
*         SCAN TEXT AGAIN TO FIND FORMAL PARAMS THAT ARE SURROUNDED BY
*         PARENS OR COMMA AND MARK THEM SPECIALLY ( EL.PCS = EL.PC+1 )
*         SO WE DO NOT SURROUND THE ACTUAL ARGS WITH REDUNDANT PARENS 
*         DURING EXPANSION
  
          SA4    B6                INTIIALIZE SCAN
          SA2    DMASK             DELIMTER MASK FOR ( ) AND ,
          SB7    B2+B5             EL.PCS = EL.PC+1 
          SB1    EL.PC
          SB7    B1+B5             EL.PCS = EL.PC+1 
 ASFD4A   NEXTE 
          EQ     B2,B3,ASFD4B      IF EOS 
          NE     B2,B1,ASFD4A      IF NOT A DUMMY ARG 
          SA3    A4+B5             LASTE
          UX1    B2,X3
          LX0    B2,X2
          PL     X0,ASFD4A         IF NOT ( ) OR ,
          SA3    A4-B5             NEXTE
          UX1    B2,X3
          LX0    B2,X2
          PL     X0,ASFD4A         IF NOT ( ) OR ,
          PX6    B7,X4
          SA6    A4                UPDATE PARAM REFERENCE 
          EQ     ASFD4A 
  
*         MOVE TEXT TO ASF AREA 
  
 ASFD4B   SX6    A4                FWA OF TEXT ( EOS )
          SX0    B6                LWA+1 ( = )
          IX7    X0-X6
          SA6    FWA
          SA7    A6+B5
          ALLOC  ASF,X7            GET SPACE
          SA3    O.ASF
          SA4    L.ASF
          SA2    FWA
          SA1    A2+B5             LENGTH 
          IX3    X3+X4             DESTINATION ADDRESS
          IX7    X1+X4
          SA7    A4                UPDATE ASFTAB LENGTH 
          LX7    P.RA 
          SA5    N.PAR
          LX5    P.FARG 
          BX7    X5+X7
          SA5    WORDB
          SA4    X5                WORD B OF ASF ENTRY
          BX7    X7+X4             SAVE NUMBER OF ARGS AND INDEX
          SA7    A4                TO ASFTAB IN WORD B
          MOVE   X1,X2,X3    TEXT TO ASF AREA 
  
*         MOVE NON LOGICAL CONSTANTS IN ASF DEFINITION TO ASFTAB
  
*         PHASE 1 - DETERMINE HOW MUCH SPACE WE NEED AND BUILD A
*         TEMPORARY TABLE WHICH OVERLAYS THE E-LIST.
*         FORMAT:  12/2000B+WC,48/ASFTAB ORD OF CONSTOR ENTRY 
  
          SA1    O.ASF
          SA2    L.ASF
          SA5    SELIST 
          SB3    EL.EOS 
          SB7    X5                B7 = FWA OF TEMP TBL 
          SB6    B0                B6 = LENGTH
          SA0    X1 
          SB4    X2                B4 = INDEX TO ASFTAB 
          MX7    0                 WC = 0 
          SX1    10 
          PX1    X1 
          NX1    X1                X1 = 10. 
          MX0    10 
          LX0    10+18             X0 = MASK FOR CHAR COUNT 
  
 ASFD5    SB4    B4-B5
          SA4    A0+B4             ASFTAB ENTRY 
          UX6    B2,X4
          BX5    X0*X4
          EQ     B2,B3,ASFD6       IF EOS 
          NZ     B2,ASFD5          IF NOT A CONSTANT
          ZR     X5,ASFD5          IF A LOGICAL CON ( N = 0 ) 
  
          AX5    18 
          SX6    X5+9 
          PX4    X6 
          FX3    X4/X1             (N+9)/10 
          UX2    X3,B1
          LX6    B1,X2             WC 
          SB2    X6 
          IX7    X6+X7             ADVANCE SUM
          SX2    B4 
          PX6    B2,X2
          SA6    B7-B6             STORE ENTRY IN TEMP TBL
          SB6    B6+B5             LEN = LEN+1
          EQ     ASFD5
  
 ASFD6    ZR     B6,ASFD9          IF NO CONSTANTS
          SA7    CLEN 
          SX6    B6 
          SA6    A7+B5             NUMBER OF CONS 
          ALLOC  ASF,X7            GET SPACE
  
*         PHASE 2 - MOVE THE CONSTANTS TO ASFTAB
  
          SA1    O.ASF
          SA2    L.ASF
          SA5    SELIST 
          SA3    CLEN 
          SA4    A3+B5             NUMBER OF CONS 
          MX0    60-18
          SB7    X5+B5             LWA+1 OF TBL 
          SB6    X4 
          IX7    X3+X2
          SA7    A2                UPDATE ASFTAB LENGTH 
          IX6    X1+X2
          SB4    X6                B4 = ASFTAB STORE ADDRESS
  
 ASFD7    SA5    B7-B6             ENTRY FROM TEMP TBL
          SB6    B6-B5
          UX3    B2,X5             B2 = WC , X3 = ASFTAB INDEX
          IX4    X1+X3
          SA5    X4                E-LIST FOR CON 
          BX6    X0*X5
          IX7    X6+X2             INSTALL LOCAL POINTER
          IX7    X1+X7             *** MAKE THE ADDRESS ABSOLUTE ***
          SA7    A5 
          IX3    X1+X2             STORE ADDR 
          SX2    X2+B2             UPDATE LEN 
          SA5    X5 
 ASFD8    SB2    B2-B5             MOVE CONSTANT TO ASFTAB
          BX6    X5 
          SA6    B4 
          SB4    B4+B5
          SA5    A5+B5
          NZ     B2,ASFD8 
          NZ     B6,ASFD7          IF MORE CONSTANTS
  
 ASFD9    SA5    RSELECT
          ZR     X5,PH2RETN        IF R = 0 
          ADDREF IDORDL,DEF        DEFINTION OF THE ASF 
          EQ     PH2RETN
          SPACE  3
*         ERROR EXITS 
  
 ASF.E1   SB6    E.PLE             PARAMETER LIST SYNTAX ERROR
          EQ     ASF.EX 
  
 ASF.E2   SB6    E.TMP             TOO MANY PARAMETERS
          EQ     ASF.EX0
  
 ASF.E3   SB6    E.BADA            DUMMY ARG FOLLOWED BY CON OR NAME
          SA4    A4+B5
          EQ     ASF.EX 
  
 ASF.E4   SB6    E.DDP             DOUBLY DEFINED PARAM 
          SA4    A4+B5
          EQ     ASF.EX 
  
 ASF.E5   SB6    E.BADA            SYNTAX ERROR IN ASF. 
          EQ     ASF.EX 
 ASF.EX0  SA2    IDORDL 
          RJ     PSYM              FORMAT NAME
  
 ASF.EX   SA5    O.SCR             RESET SCRATCH TABLE TO ZERO SPACE. 
          BX7    X7-X7
          LX6    X5 
          SA7    S.SCR
          SA6    FWAWORK
          POSTER SEV=FE,NR=**,RETURN=PH2RETN
          SPACE  3
 ASFR.E1  SB6    E.UBP             UNBALANCED PARENS
          EQ     ASF.EX0
  
 ASFR.E2  SB6    E.EAP             EMPTY ACTUAL PARAMETER 
          EQ     ASF.EX0
  
 ASFR.E3  SA2    IDORDL            MEMORY OVERFLOW ON EXPANSION.
          RJ     PSYM 
          POSTER SEV=FC,NR=E.RSE   * TABLE OVERFLOW * 
  
 ASFR.E4  SB6    E.UML             N.ACT PARAMS .NE. N.PARAMS IN DEF
          EQ     ASF.EX0
          TITLE              ASFREF - EXPAND ASF REFERENCE
*** 
*         ASFREF- EXPAND ASF REFERENCE
* 
  
 ASFREF   ENTRY.
          SB5    1
          SA3    NAMFWA 
          SA2    X3-1              WORD B OF ASF
          AX2    P.RA 
          MX0    60-L.FARG
          SX7    X2                INDEX TO ASFTAB
          AX2    P.FARG-P.RA
          BX6    -X0*X2 
          SA6    N.PAR             NUMBER OF PARAMS 
          SA7    IASF              INDEX
          ALLAE  SCR               GET SPACE FOR SCRATCH INFO 
  
*         SYNTAX CHECK THE ARG LIST AND FORM AN ARG SUBSTITUTION
*         TABLE IN THE SCRATCH AREA.
*         FORMAT:  24/0,18/FWA,18/LEN 
*         SAVE THE ACTUAL PARAMETERS ABOVE THE TABLE IN THE SCRATCH AREA
  
          SA1    O.SCR
          SA2    S.SCR             ALLOCATION 
          SA5    SELIST 
          SA4    N.PAR
          SA0    X1                A0 = O.SCR 
          SB7    X2                B7 = S.SCR 
          SB6    X4                B6 = INDEX TO ACTUAL PARAMS
          MX0    0                 X0 = ARG NUMBER - 1
          SB1    B5                B1 = PAREN COUNT 
          SA4    X5-1              A4 = E-LIST POINTER
          SX5    A4-B5             X5 = FWA OF ARG
  
 ASFR2    NEXTE 
          NZ     X1,ASFR2          SKIP CONS , NAMES AND OPS WITH PRECED
          ZR     B2,ASFR2          IF LOGICAL CONSTANT .FALSE.
          IF.NE  EL.(,ASFR3 
          SB1    B1+B5             PC = PC+1
          EQ     ASFR2
 ASFR3    IF.EQ  EL.EOS,ASFR.E1    ERROR IF EOS 
          EQ     B1,B5,ASFR4       IF PC = 1
          IF.NE  EL.),ASFR2 
          SB1    B1-B5             PC = PC-1
          EQ     ASFR2
  
*         OP MUST BE COMMA OR ) 
  
 ASFR4    SX4    A4 
          IX3    X5-X4             PARAMETER LEN
          ZR     X3,ASFR.E2        IF EMPTY PARAMETER 
  
          SB6    B6+X3             NEW INDEX
          SB4    B6-B5             FWA OF TEXT
          SX2    B4+A0
          LX2    18 
          BX6    X2+X3             24/0,18/FWA,18/LEN 
          SB1    X0 
          SA6    A0+B1             STORE ENTRY IN SCRATCH AREA
          SX0    X0+B5             ADVANCE PARAMETER ORDINAL
          GE     B4,B7,ASFR.E3     IF NOT ENOUGH SPACE
  
          SA1    X5 
          SB1    X3                LEN
 ASFR5    BX6    X1                MOVE TEXT TO SCR TBL AREA
          SA1    A1-B5             NEXT 
          SB1    B1-B5
          SA6    A0+B4
          SB4    B4-B5
          NZ     B1,ASFR5 
  
          SB1    B5                RESTORE B1 
          SX5    A4-B5
          IF.EQ  EL.COMMA,ASFR2    LOOP FOR NEXT ARG
  
          SA1    N.PAR
          IX0    X1-X0
          NZ     X0,ASFR.E4        IF NUM OF PARAMS .NE. TO NUM IN DEF
  
          SA2    LWAWORK           FWA OF REMAINDER OF STMT 
          SX4    A4+B5           LWA+1  ( INCLUDING CLOSING PAREN ) 
          IX1    X4-X2             LENGTH 
          BX6    X1 
          SX7    B6+A0
          BX3    X7 
          SB6    B6+X1             INCREMENT LENGTH OF SCRATCH AREA 
          SA6    L.REM
          SA7    O.REM
          GE     B6,B7,ASFR.E3     IF NOT ENOUGH SPACE
  
          SX6    B6+A0
          SA6    FWAWORK
          MOVE   X1,X2,X3    REST OF STMT TO SCRATCH AREA 
  
*         EXPAND THE ASF
  
 STW      MACRO                    STORE TEXT WORD
          SA7    A7-B5
          ENDM
  
          SA1    O.ASF
          SA2    IASF              INDEX TO TEXT IN ASFTAB
          SA4    FWAWORK
          SA5    SELIST 
          SX7    EL.(+2000B        SIMULATE FULLY PARENTHESIZED STMT
          LX7    48                (SELIST WILL POINT AHEAD SINCE 
                                   ARITH HAS ALREADY PROCESSED A (
          SB6    X4                B6 = FWAWORK ( LOWER BOUND ) 
          SA7    X5                PRESTORE 
          SX6    A7-B5             SELIST = SELIST-1
          SA6    A5                DECREMENTING SELIST BY 1 INSURES 
*                                  THAT A RECURSIVE ASF WILL GENERATE 
*                                  AN FC ERROR. 
  
          SA3    O.SCR
          SB1    X3-1              B1 = O.SCR-1 ( INDEX TO PARAM INFO ) 
          IX0    X1+X2
          SA4    X0                INITIALIZE A4 TO FWA OF ASF TEXT + 1 
  
 ASFR6    NEXTE 
          SB3    B2-EL.PC 
          PL     B3,ASFR8          IF A PARAMETER REF 
          BX7    X4 
          STW 
          IF.EQ  EL.EOS,ASFR11     IF END OF ASF TEXT 
 ASFR6A   SB7    A7 
          GT     B7,B6,ASFR6       IF NO OVERFLOW 
          EQ     ASFR.E3
  
 ASFR8    SA1    B1+X1             PARAMETER INFO WORD
          SB2    X1                LEN
          AX1    18 
          SA2    X1                FIRST WORD 
          NZ     B3,ASFR10         IF NO NEED TO ENCLOSE EXPR IN () S 
          NE     B2,B5,ASFR9       IF AN EXPRESSION 
          BX7    X2 
          STW 
          EQ     ASFR6A 
  
 ASFR9    SX7    LEFT(
          LX7    48 
          STW 
  
 ASFR10   BX7    X2                STORE ARGUMENT 
          SA2    A2-B5
          SB2    B2-B5
          STW 
          NZ     B2,ASFR10
          NZ     B3,ASFR6A         IF NO NEED FOR A CLOSING PAREN 
  
          SX7    RIGHT( 
          LX7    48 
          STW 
          EQ     ASFR6A 
  
*         END OF EXPANSION - MOVE THE REST OF THE STATEMENT UP
  
 ASFR11   SA1    L.REM
          SA2    O.REM
          SX4    A7+B5
          IX3    X4-X1             DESTIN ADD ( NEW LWAWORK ) 
  
          SA5    LWAWORK           OLD LWAWORK
          SA4    LELIST 
          IX0    X3-X5             NEW - OLD
          IX7    X0+X4
          SA7    A4                UPDATE LELIST
          BX6    X3 
          SA6    A5                AND LWAWORK
  
          MX7    0
          SB2    X6 
          SA7    S.SCR             CLEAR SCRATCH TABLE ALLOC
          LT     B2,B1,ASFR.E3     IF LWAWORK < O.SCR-1 
  
          SX7    B1+B5
          SA7    FWAWORK
          MOVE   X1,X2,X3    REST OF STMT BACK
          EQ     ASFREF 
  
          END 
