*DECK     STMTF 
          IDENT  STMTF
 STMTF    SECT   (STATEMENT FUNCTION PROCESSOR.)
 STMTF    SPACE  4
*         IN ALLOC
          EXT    ADW,ALC
  
*         IN FEC
          EXT    ERT,ESY,FEC.RTN,REFVAR,SCSA,SCS,SCT,SSY,STY,TRV,WANFP
  
*         IN FERRS
          EXT    E.LP1,E.LP2,E.SF00,E.SF01,E.SF02,E.SF03,E.SF04,E.SF05
          EXT    E.SF06,E.SF07,E.SF08,E.SF11,E.SF12,E.SF14,FILL.,FILL.2 
          EXT    FILL.3 
  
*         IN PEM
          EXT    ANSI=,PDM
  
*         IN PUC
          EXT    E=TOTAL,SCR,T=STF,T=SCR,T.STF,T.SCR,T.SYM
  
*         IN UTILITY
          EXT    MVE= 
 SCRATCH  SPACE  4,8
 STFERR   EQU    SCR+3       ERROR IN STATEMENT FUNCTION REFERENCE
 FWASTF   EQU    SCR+4       FWA OF STATEMENT FUNCTION RELATIVE TO T.STF
 FWAREF   EQU    SCR+5       FWA OF REFERENCE 
 SVB6     EQU    SCR+6
 SVB5     EQU    SCR+7
 STMTF    SPACE  4,8
          DESCRIBE ST.       SCRATCH TABLE HOLDS DUMMY ARGUMENTS
 SYM      DEFINE 42          SYMBOLIC NAME
 MODE     DEFINE 3           ARG TYPE 
 CNT      DEFINE 15          ARG USE COUNT
          TITLE  DEFINITION.
 SFD      SPACE  4,10 
**        SFD -  STATEMENT FUNCTION DEFINITION PROCESSOR. 
*         ENTERED FROM FRONT END CONTROLLER.
*         ENTRY  (B4) - START OF STATEMENT. 
*         EXIT   TO *FEC.RNX*.
* 
*         T.STF ENTRY FORMAT. 
*         1      = 24/0, 18/0, 18/LENGTH OF SKELETON + ARGUMENT WORDS 
*         2 TO N = 6/0, 18/LEN OF REF, 18/FWA OF REF, 18/NO OF USES 
* 
*         N+1    = ACTUAL SKELETON, WITH DUMMY PARAMETERS ENTRIES IN THE
*                  FOLLOWING FORMAT 
*                  18/PARAMETER NUMBER, 24/0, 18/O.STFA 
* 
*         USES T.SCR FOR PARAMETER CHECKING.
  
  
 SFD      BSSENT 0           ENTRY... 
          SHRINK T=SCR,0
          MX0    WA.SYML
          =A2    B4 
          BX6    X0*X2
          SA6    FILL.3 
          CALL   SSY         SCAN SYMBOL TABLE
          MI     B7,SFD05    IF NOT ALREADY IN SYMBOL TABLE 
          CLAS=  X2,WB,(LAB)
          BX2    X2*X6
          NZ     X2,E.SF08   IF STATEMENT LABEL 
          CLAS=  X2,WB,(NVAR) 
          BX2    X2*X6
          NZ     X2,SFD03    IF ALREADY KNOWN AS *NVAR* 
          CLAS=  X2,WB,(FP,VAR) 
          BX2    X2*X6
          ZR     X2,SFD05    IF NOT NVAR, VAR, OR FP -- OKAY
          EQ     E.SF08      CONFLICTING DEFINITION 
  
 SFD03    SBIT   X6,WB.FUNP 
          PL     X6,E.SF08   IF PREVIOUSLY DEFINED .NOT. FUNCTION 
          =A2    A2-WB.W+WC.W 
          MX1    -WC.FUNTL
          LX2    -WC.FUNTP
          BX2    -X1*X2      ISOLATE (X2) = FUNCTION TYPE 
          =X2    X2-MF.STF
          NZ     X2,E.SF08   IF PREVIOUSLY DEFINED .NOT. STMT FUNCTION
          WARN   E.SF07      DUPLICATE STATEMENT FUNCTION - NEW OVERIDES
  
 SFD05    =A2    B4+1 
          =B4    B4+1 
          SB7    X2-O.( 
          NZ     B7,SFD05    IF LEFT PAREN NOT FOUND
          =A2    B4-1 
          MX0    TB.TOCL
          BX6    X0*X2
          ADDWD  T.SCR
          SA6    FILL.
          MX6    0
          ADDWD  T.SCR
          SA4    B4+1 
          SB7    X4-O.RP
          NZ     B7,SFD7     IF NOT NULL PARAMETER LIST 
          SB4    B4+1 
          EQ     SFD20
  
**        ADD DUMMY ARGS TO SCRATCH TABLE 
  
 SFD7     MX6    0
          SA6    WANFP       AVOID TURNING WA.NFP ON IN *SSY* OR *ESY*
  
 SFD10    =A4    B4+1 
          =B4    B4+1 
          SB7    X4-O.VAR 
          ZR     B7,SFD11    IF A VARIABLE
          FATAL  E.SF06      ** DUMMY ARG NOT SIMPLE VAR
          MX6    1
          LX6    1+WA.NFPP
          SA6    WANFP       RESET WA.NFP CELL
          SHRINK T=SCR,0     CLEAN UP SCRATCH TABLE 
          EQ     FEC.RTN
  
 SFD11    =B2    0
          CALL   TRV         ENTER ARGUMENT INTO SYMBOL TABLE 
          BX6    X0 
          SA6    SFDA        SAVE SYMTAB ORD
          =A4    A2+WA.W-WB.W 
          MX0    WA.SYML
          BX6    X0*X4
          SA6    FILL.2 
          MX0    -WB.MODEL
          LX2    -WB.MODEP
          BX0    -X0*X2      EXTRACT MODE 
          LX2    WB.MODEP 
          SBIT   X2,WB.ARYP 
          PL     X2,SFD12    IF DUMMY ARGUMENT NOT AN ARRAY 
          ANSI   E.SF11      DUMMY ARG CANNOT BE AN ARRAY 
  
 SFD12    LX2    WB.ARYL+WB.ARYP
          CLAS=  X1,WB,(SAVE,LEV,VDS,LCM,FP,COM,ARY,EQV,DEF)
          BX1    X1*X2
          NZ     X1,SFD13    IF DUMMY ARGUMENT IS FIXED AS TRUE VARIABLE
          CLAS=  X7,WB,(SFA)
          BX7    X7+X2       MERGE IN DUMMY ARGUMENT PROPERTY 
          SA7    A2 
  
 SFD13    SX0    X0-M.CHAR
          NZ     X0,SFD15    IF NOT TYPE CHARACTER
          =A4    A2+WC.W-WB.W 
          SBIT   X4,WC.CTYPP
          PL     X4,SFD15    IF NOT PASSED LENGTH 
          FATAL  E.SF14 
  
 SFD15    LX6    ST.SYMP-WA.SYMP
          SCAN   T.SCR,SCT   LOOK FOR DUMMY ARG 
          MI     B7,SFD17    IF NOT ALREADY REFERENCED
          FATAL  E.SF05      DUPLICATE DUMMY ARGUMENT 
          EQ     SFD19
  
 SFD17    ADDWD  T.SCR
          SA4    SFDA 
          BX6    X4 
          ADDWD  T.SCR       WORD 2 OF SCR ENTRY = SYMORD 
  
 SFD19    =A4    B4+1 
          =B4    B4+1 
          SB7    X4-O.COMMA 
          ZR     B7,SFD10    IF MORE ARGUMENTS
          MX6    1
          LX6    1+WA.NFPP
          SA6    WANFP       RESET WA.NFP CELL
          SB7    X4-O.) 
          ZR     B7,SFD20    IF CLOSING *)* 
          SHRINK T=SCR,0     CLEAN UP SCRATCH FILE
          EQ     E.SF00      ERROR MSG - EXPECTED RIGHT PAREN ... 
  
**        HERE IF END OF ARGUMENT STRING FOUND
*         (B4) _ CLOSING *)*
  
 SFD20    SA2    B4+B1
          SB4    B4+B1
          SB7    X2-O.= 
          NZ     B7,E.SF01   IF NO *=* FOLLOWING END OF ARGUMENTS 
          SX6    B4 
          SB5    B4          LENGTH OF STATEMENT FUNCTION SKELETON
          SA2    STFMASK
          SA6    SCR+1       SAVE START OF STATEMENT FUNCTION 
          BX6    X2 
          SA6    SCSA        SET MASK FOR *SCS* 
          =B3    0           ARG CHAIN
  
**        HERE IF *=* FOUND AFTER END OF ARGUMENTS. SCAN THROUGH THE
*         STATEMENT FUNCTION REPLACING ALL REFERENCES TO DUMMY ARGUMENTS
*         WITH:  18/ ARGUMENT NUM,  24/0,  18/ O.AFSA 
*         CHECK IF STATEMENT FUNCTION IS RECURSIVE, AND OUTPUT ERROR IF 
*         SO. 
  
          SB6    0           BALANCED PARENTHESES INDICATOR 
  
 SFD30    SA1    B4+B1
          SB4    B4+B1
          BX6    X1 
          =A2    B4-1 
          ZR     X1,SFD50    IF *EOS* 
          SB7    X1-O.LP
          NZ     B7,SFD31    IF NOT *(* 
          SB6    B6+1        INCREMENT PARENTHESIS COUNT
          SB7    X2-O.STFA
          NZ     B7,SFD30    IF *(* DOES NOT FOLLOW DUMMY ARGUMENT
          FATAL  E.SF12      ** DUMMY ARGUMENT MUST BE USED AS VARIABLE 
          EQ     SFD30
  
 SFD31    SB7    X1-O.RP
          NZ     B7,SFD32    IF NOT *)* 
          SB6    B6-1        DECREMENT PARENTHESIS COUNT
          EQ     SFD30
  
 SFD32    SB7    X1-O.VAR 
          NZ     B7,SFD30    IF NOT VARIABLE
          SCAN   T.SCR,SCS   SCAN TO SEE IF ARGUMENT
          MI     B7,SFD30    IF NOT IN TABLE (NOT ARGUMENT) 
          ZR     B7,E.SF03   IF RECURSIVE DEFINITION
          SA6    FILL.2 
          SA4    B4-1 
          SX0    X4-O.CONS
          ZR     X0,SFD30    IF NOT ARGUMENT (E,D TYPE CONSTANT)
          SX0    X4-O.PERIOD
          ZR     X0,SFD30    IF NOT ARGUMENT (E, D, TYPE CONSTANT)
          =X0    1
          IX7    X0+X2       UPDATE USE COUNT 
          =X6    B7-1 
          AX6    B1,X6
          LX0    ST.CNTP
          SA7    A2          RESET WITH USE COUNT UPDATED 
  
**        HERE IF ARGUMENT REFERENCE FOUND. 
  
          =A4    A2+1 
          LX4    TB.ORDP
          SX3    B3 
          LX6    TB.ACTEP 
          LX3    TB.DACP
          BX6    X6+X3
          SB3    B4-B5       NEW CHAIN POINTER
          BX6    X6+X4       INSTALL MODE IN TOKEN
          SX0    O.STFA 
          IX6    X0+X6
          SA6    B4          RESET TO INDICATE ARGUMENT.
          =A3    B4+1 
          SB7    X3-O.VAR 
          NZ     B7,SFD30    IF NOT LONG NAME 
  
**        THROW AWAY EXCESS TOKENS IN NAME (OVERWRITE STRING BUFFER)
  
 SFD35    SA3    A3+1 
          SB7    X3-O.VAR 
          ZR     B7,SFD35    IF MORE TOKENS IN NAME 
          SA1    A3-1 
  
 SFD37    =A1    A1+1 
          NZ     X1,SFD37    IF NOT *EOS* 
          =B7    A3-1 
          MOVE   A1-B7,A3,B4+1     THROW AWAY THE WHOLE MESS
          EQ     SFD30       CONTINUE 
  
**        VALIDATE THAT ALL DUMMY PARAMETERS ARE USED.
*         (IF ONE IS NOT USED OUTPUT WARNING MESSAGE.)
  
 SFD50    ZR     B6,SFD52    IF PARENTHESES BALANCED
          SB7    E.LP2
          MI     B6,SFD51    IF TOO FEW LEFT PARENS 
          SB7    E.LP1
  
 SFD51    FATAL  B7 
  
 SFD52    SA2    T=SCR
          SA4    T.SCR
          SX6    B3 
          SA6    SCR+2       SAVE CHAIN POINTER 
          MX0    -ST.CNTL 
          SB3    X2-2        DO NOT CHECK STMT FUNCTION 
          MX5    TB.TOCL
          SB5    B4-B5       LENGTH OF STATEMENT FUNCTION SKELETON
          AX2    B1,X2
          SB6    X2-1 
  
 SFD55    SA2    X4+B3
          SB3    B3-2 
          LX2    -ST.CNTP 
          BX1    -X0*X2 
          MI     B3,SFD60    IF END OF ARGUMENT LIST
          NZ     X1,SFD55    IF ARGUMENT USED 
          BX6    X5*X2
          SA6    FILL.2      ARGUMENT NOT USED. 
          WARN   E.SF04      ARGUMENT NEVER USED
          EQ     SFD55       LOOP THROUGH TABLE 
  
**        HERE WHEN ALL ARGUMENT REFERENCES IN STATEMENT FUNCTION HAVE
*         BEEN TRANSLATED AND VALIDATED.
*         NOW ADD SKELETON FOR STATEMENT FUNCTION TO T.STF. 
*         (B5) = LENGTH OF SKELETON FOR THIS STATEMENT FUNCTION 
*         (B6) = NUMBER OF PARAMETERS.
  
 SFD60    LE     B5,B1,E.SF02      IF NULL PARAMETER LIST 
          SA2    E=TOTAL
          NZ     X2,SFDEX    IF ERRORS, SUPPRESS DEFINITION 
          =X6    B6+1 
          SX7    B5 
          SA6    ARGNUM      SAVE B6 CELL 
          SA7    STFLEN      SAVE B5 CELL 
  
**        MAKE SYMBOL TABLE ENTRY 
  
          SA1    T.SCR
          =X6    CR.DEC 
          SA2    X1 
          SA6    REFVAR      SET REF MAP VALUE
          BX6    X2 
          CALL   SSY         SCAN SYMBOL TABLE
          PL     B7,SFD64    IF ALREADY IN SYMTAB 
          CALL   STY         SET IMPLICIT TYPE
          BX7    X1 
          ADSYM  T.SYM       ADD STATEMENT FUNCTION NAME TO SYMTAB
  
 SFD64    BX4    X2          PRESERVE *WB*
          SB5    B7          PRESERVE SYMTAB ORDINAL
          LX0    XR.TAGP
          ADDREF X0,CR.DEF
          CLAS=  X3,WB,(NVAR,FUN,DEF) 
          BX6    X3+X4
          SA2    T.SYM
          =B4    B5+WC.W-WB.W 
          SA3    X2+B4
          CLAS=  X1,WC,(FUNT,ARGC)
          =A6    X2+B5
          SB7    B5          RESTORE B7 
          SX7    B6          SET (WC.ARGC) = NUMBER OF ARGUMENTS
          BX3    -X1*X3      CLEAR POSSIBLE PREVIOUS FIELDS 
          LX7    WC.ARGCP 
          =X1    MF.STF 
          BX3    X7+X3
          LX1    WC.FUNTP 
          BX7    X3+X1       UPDATE (WC)
          SA7    A3 
          SX6    B7 
          SA6    SCR         REMEMBER (SCR) = SYMTAB INDEX OF NAME
  
**        ADD SKELETON TO TABLE 
  
          SA1    ARGNUM 
          SA2    STFLEN 
          SB6    X1 
          SB5    X2 
          SA1    SCR+1
          SB4    X1 
          SX4    B5+2        ROOM FOR HEADER AND EOS
          SA5    T=STF
          ALLOC  T.STF,X4    RESERVE SPACE FOR THIS STATEMENT FUNCTION
  
**        (X1) = NEW ORGIN OF TS.ARG. 
*         (X2) = LENGTH.
*         (X5) = FWA FOR CURRENT SKELETON RELATIVE TO T.STF 
*         (B6) = NUMBER OF PARAMETERS +1. 
  
          SA4    T.SYM
          IX1    X1+X5
          SA3    SCR         STATEMENT FUNCTION *WB* INDEX
          =X0    B6-1        NUMBER OF ARGUMENTS
          SB7    X4 
          SA2    X3+B7       TAG FOR CURRENT STATEMENT FUNCTION 
          MX6    -WB.STFPL
          LX6    WB.STFPP 
          BX2    X6*X2
          SB3    X1          FWA FOR HEADER 
          =A4    B4+1        FWA OF SKELETON
          LX5    WB.STFPP 
          BX6    X2+X5       SET (WB.STFP) = INDEX OF MACRO IN T.STF
          SA6    A2          STATEMENT FUNCTION *WB*
          SA3    SCR+2
          BX6    X3 
          LX6    SF.DACPP 
          SA6    B3          HEADER GETS CHAIN POINTER
          =B3    B3+1 
  
**        ADD SKELETON TO T.STF FOR LATER PROCESSING WHEN STATEMENT 
*         FUNCTION IS REFERENCED. 
*         (B5) = LENGTH OF SKELETON.
*         (A4) _ SKELETON 
*         (B3) _ FWA FOR SKELETON 
  
 SFD70    BX6    X4 
          =B5    B5-1 
          SA6    B3          ADD SKELETON WORD TO T.STF 
          =A4    A4+1        NEXT WORD
          =B3    B3+1 
          NZ     B5,SFD70    IF NOT END 
          =X6    O.EOS       INDICATE END OF STATEMENT FUNCTION 
          =X7    O.RP 
          SA7    A6 
          =A6    A7+1 
 SFDEX    BSSENT 0           ...RETURN FROM ERROR PROCESSOR 
          SHRINK T=SCR,0     CLEAR TABLE
          EQ     FEC.RTN     EXIT TO FRONT END CONTROLLER...
  
 STFMASK  SYMASK (TB.TOC) 
 STFLEN   DATA   0           TEMP SAVE CELL 
 ARGNUM   DATA   0           TEMP SAVE CELL 
 SFDA     BSS    1
 SFR      SPACE  4,10 
  
          LIST   D
          END 
