*DECK     STMTP 
          IDENT  STMTP
 STMTP    TITLE  STMTP -     MISCELLANEOUS STATEMENT PROCESSOR
*CALL     SSTCALL 
          LIST   F,X
  
 B=STMTP  RPVDEF             DEFINE ROUTINE FWA FOR REPRIEVE UTILITY
 SYM1     EQU    12B
 DIM1     EQU    17B
 SELIST   EQU    32B
 DUKE     EQU    RA.SSW+37B 
  
 CLABEL   EQU    23B
 PROGRAM  EQU    56B
  
          EXT    PSYM,WB.NML,VALUE. 
          EXT    DATA.,EPOINT.,WB.FTN,WB.NOP
          EXT    SCHBET,O.CEP,ENTRY.,ENTRY.D
          EXT    RSELECT
          EXT    FSTEX,DOFLAG,FTNNOP.,NOPS. 
          EXT    UDATA.,C.BLOCK 
  
          TABLES NML
          SPACE  3
*** 
*         STMTP - PROCESSORS FOR MISSCELLANEOUS STATEMENT TYPES 
* 
*CALL     PARSEM
*CALL     FMACDEF 
 CONT     TITLE  CONT - PROCESS CONTINUE STATEMENT. 
**        CONT - PROCESS *CONTINUE* STATEMENT.
* 
* 
*         ENTRY  NONE 
* 
*         EXIT   NONE 
* 
*         USES   NONE 
* 
*         CALLS  GETE, IF., POSTER
  
  
 E314     =      314         SPURIOUS CHARACTERS AFTER CONTINUE IGNORED 
  
 CONT     SUBR   =           ** ENTRY/EXIT ** 
          GETE
          IF.EQ  EL.EOS,EXIT.  IF EOS 
  
*         POST INFORMATIVE ERROR FOR SPURIOUS CHARS AFTER *CONTINUE*. 
  
          POSTER SEV=INF,NR=E314,FMT=ELIST,TXT=X4,RETURN=EXIT.
          TITLE              NAMELST - NAMELIST STATEMENT PROCESSOR 
*** 
*         NAMLIST - PROCESS NAMELIST STATEMENT
* 
  
*         ERROR NUMBERS 
  
 E.NSE    EQU    82                NAMELIST STMT SYNTAX ERROR 
 E.BGN    EQU    83                BAD GROUP NAME 
 E.GNE    EQU    84                GROUP NAME NOT IN SLASHS 
 E.ONV    EQU    85                CURRENT E-LIST WAS NOT A VARIABLE
 E.CUN    EQU    86                PRESENT USE CONFLICTS WITH PREVIOUS
 E.VDIM   EQU    87                VARIABLE DIMENSIONS NOT ALLOWED
 E.NASA   EQU    180               NAMELIST STMT IS NON USAS
  
 NMLGN    BSS    1           GROUP NAME INFO, 42/INDEX TO NML TABLE 
*                            18/ADDR OF WORD B
 SYMORD   BSS    1           SYMTAB ORD OF NAMELIST VARIABLE
 PNITYPE  BSS    1           TYPE OF NAMELIST VARIABLE
 DEB      BSS    1           DIM/EQU FLAG 
 PNIEQU   BSS    1           24/0,18/BASE,18/BIAS OF EQU VAR. 
  
 DATA.CD  LIT    11C  DATA 0B 
          SPACE  2
  
 #DAL     IFNE   .DAL,0      .NZ. IF LCM DIRECT ACCESS ALLOWED
 IAF      ENTRY. 0
 #DAL     ENDIF 
  
 NAMELST  ENTRY.
          OUTUSE DATA.             GET IN THE RIGHT RB
  
*         PROCESS GROUP NAME
  
          GETE                     FIRST E-LIST ELEMENT 
          IF.NE  EL.SLASH,NML.E1   IF NOT A / 
  
 NML1     NEXTE 
          IF.NE  NAME,NML.E4       IF NOT A NAME
          UPDATE
          SYMBOL                   GET SYMTAB ORDINAL 
          EQ     NML2 
  
          SB6    E.BGN
          EQ     NML.E6A           PREVIOUS USEAGE IN ANOTHER CONTEXT 
  
 NML2     ZR     X7,*+1            IF NO PREVIOUS USE  IN DEBUG STMTS 
          CALL   DBGCUN            ISSUE AN INFORMATIVE ERROR 
          SA3    WB.NML            WORD B BITS
          SA4    DATA.
          SX6    X4+B5             DATA. = DATA.+1
          SA6    A4 
          LX4    P.RA 
          IX0    X3+X4
          BX7    X0+X2             SET TYPE, RL,RA AND RB IN WORD B 
          SA7    A2 
          SX6    B1 
          SX7    A2 
          SA6    GNORD             SAVE SYMTAB ORDINAL
          SA5    L.NML
          LX5    18 
          BX6    X5+X7       42/INDEX TO NML,18/ADDR OF WORD B
          SA6    NMLGN
  
          SA5    RSELECT
          ZR     X5,NML3           IF R = 0 
          ADDREF B1,DEF            DEFINITION OF THE NAME 
  
 NML3     SA1    GNORD
          BX6    X1 
          F1AMAC GNAME             OUTPUT GROUP NAME DEFINITION 
  
          GETE                     NEXT AFTER THE NAME
          IF.NE  EL.SLASH,NML.E3   IF NO SECOND / 
  
*         PROCESS THE LIST OF NAMES 
  
 NML.L    NEXTE 
          IF.NE  NAME,NML.E4       IF NOT A NAME
          UPDATE
          RJ     PNV               PROCESS NAMELIST VARIABLE
          SA3    DATA.
          SX6    X3+2 
          SA6    A3                DATA. = DATA. + 2
          GETE                     NEXT ELEMENT 
          IF.EQ  EL.COMMA,NML.L    LOOP IF A COMMA
          SB1    1
          WRITEC =XF.CMPS,DATA.CD,2 
          SA5    DATA.
          SB5    B1+
          SX6    X5+B5             DATA. = DATA. + 1
          SA6    A5 
  
          SA2    =XOPT2 
          ZR     X2,NML4     IF NOT OPT=2 
          SA3    L.NML       NML ORD
          SA4    NMLGN       42/INDEX TO NML,18/ADDR OF WORD B
          SA2    X4          WORD B 
          AX4    18 
          IX1    X3-X4       NO. OF NAMELIST VARIABLES
          LX3    P.DIMP 
          BX7    X2+X3       INSERT NML ORD INTO WORD B 
          SA7    A2 
  
          ADDWD  NML,X1      ADD NO. OF VARIABLES TO TABLE
  
 NML4     GETE               ELEMENT AFTER LAST NAME
          IF.EQ  EL.SLASH,NML1     LOOP FOR NEXT GROUP IF A / 
  
          IF.NE  EL.EOS,NML.E1     IF NOT END OF STMT 
  
          POSTER SEV=ANSI,NR=E.NASA,RETURN=NAMELST   *NON-ANSI STMT*
  
 GNORD    BSS    1                 ORDINAL OF GROUP NMAE
          SPACE  3
*         ERROR EXITS 
  
 NML.E1   SB6    E.NSE             SYNTAX ERROR 
          EQ     NML.EX 
  
 NML.E2   SB6    E.BGN             BAD GROUP NAME 
          EQ     NML.EX 
  
 NML.E3   SA2    GNORD
          RJ     PSYM 
          SB6    E.GNE             GROUP NAME NOT IN // S 
          EQ     NML.EX 
  
 NML.E4   SB6    E.ONV             CURRENT OBJECT NOT A VARIABLE
          EQ     NML.EX 
  
 NML.E5   SB6    E.CUN             BAD VARIABLE NAME ( SEMANTICS )
          EQ     NML.E6A
  
 NML.E6   SB6    E.VDIM            VARIABLE DIMS NO ALLOWED 
  
 NML.E6A  SX2    B1                SYMTAB ORDINAL 
          RJ     PSYM              FORMAT NAME FOR ERPRO
  
 NML.EX   POSTER SEV=FE,NR=**,RETURN=NAMELST
          TITLE              PNV - PROCESS NAMELIST VARIABLE NAME 
 TBITN    MACRO  BIT,LABEL         IF( ^ BIT ) GO TO LABEL
          BX3    X1 
          LX3    59-P.BIT 
          PL     X3,LABEL 
          ENDM
  
*** 
*         PNV - PROCESS NAMELIST VARIABLE 
* 
*         ON ENTRY: 
*                X1 = 8R_VARNAME
* 
  
*         FIRST OCCURANCE - SET TYPE AND VN BIT 
  
 PNV.F    ZR     X7,PNV.F1         IF NO PREVIOUS USE IN A DEBUG STMT 
          CFO    VAR               CHECK SETTING OF DEBUG BITS
  
 PNV.F1   IX2    X6+X2             SET TYPE 
          SX0    B5 
          LX0    P.VAR             AND VAR BIT
          BX7    X0+X2
          SA7    A2 
          LX2    X7 
          EQ     PNV1 
  
 PNV
          SYMBOL                   GET SYMTAB ORDINAL 
          EQ     PNV.F
  
*         PREVIOUS OCCURANCES 
  
          NE     B1,B5,PNV1        IF NOT ORDINAL 1 
          SA3    VALUE. 
          ZR     X3,NML.E5         IF NOT A FUNCTION SUBPROGRAM 
          SB1    X3 
          SB2    B1+B1
          SA1    A0-B2             WORD A OF VALUE. 
          SA2    A1-B5             WORD B 
  
 PNV1     MX0    L.TYP
          BX3    X0*X2
          LX3    L.TYP
          SX4    X3-T.OCT 
          PL     X4,NML.E5         ERROR IF TYPE ECS, RETURNS OF SUCH 
  
          BX5    X1 
          LX5    59-P.FUN 
          BX3    X2 
          LX3    59-P.EXT 
          BX4    X3+X5
          NG     X4,NML.E5         IF FUNCTION OR EXTERNAL
  
          SX0    V.DEF
          BX6    X0+X1
          MX3    1
          LX3    1+P.VAR
          BX7    X2+X3       SET VAR BIT
          LX2    X7 
          SA7    A2 
          SA6    A1                SET DEFINED BIT
  
          BX3    X2 
          MX0    60-L.DIMP
          AX3    P.DIMP 
          BX4    -X0*X3 
          SX3    V.DIM+V.EQU
          SB2    B0 
          BX6    X3*X1
          SA6    DEB         SAVE DIM/EQU INFO
          ZR     X6,PNV2     IF NOT DIMENSIONED OR EQUIV/ED 
          SB2    X4 
          SB2    B2+B2             INDEX TO DIM TABLE 
          SA3    DIM1 
          SB2    B2+X3             B2 = ADDRESS OF DIM ENTRY
  
*         THE REGISTERS NOW HOLD: 
*         A1,X1,A2,X2 - WORD A AND WORD B OF SYMTAB ENTRY 
*         B1 = SYMTAB ORDINAL , B2 = ADDRESS OF DIM ENTRY OR 0
*         DO NOT DESTROY THEM UNTIL AFTER THE ADDREF CALL 
  
 PNV2     SX6    B1 
          SA6    SYMORD            SAVE SYMTAB ORD FOR PNI SUBROUTINE 
          SB7    B0                NUMBER OF ARGS 
          SVARG  NAMEL,1     ARG 1 = VARIABLE NAME
  
          BX6    X2 
          AX6    P.TYP
          SA6    PNITYPE           SAVE TYPE FOR PNI SUBROUTINE 
          SX6    X6+B5
  
 #DAL     IFNE   .DAL,0      .NZ. IF LCM DIRECT ACCESS ALLOWED
          MX0    -L.LVL 
          BX3    X2 
          LX3    -P.LVL 
          BX4    -X0*X3            EXTRACT THE LEVEL OF THE VARIABLE
          SX4    X4-3 
          ZR     X4,NML.E5   IF LEVEL 3 ERROR 
          LX3    P.LVL+59-P.LCM 
          PL     X3,PNV3     IF NOT LCM RESIDENT
          SA3    =XDIRECT 
          BX7    X3 
          SA7    IAF
          SX4    1S3
          BX6    X4+X6
 #DAL     ENDIF 
  
 PNV3     SVARG  OCT,2             ARG 2 = TYPE 
  
 #DAL     IFNE   .DAL,0      .NZ. IF LCM DIRECT ACCESS ALLOWED
          MX0    1
 #DAL     ENDIF 
  
  
          TBITN  EQU,PNV4          IF NOT EQUIVALENCED
          SA3    B2                WORD 1 OF DIM ENTRY
          AX3    18 
          BX6    X3 
          SB4    X3                SAVE BIAS
          SA6    PNIEQU      SAVE FOR PNI IF OPT=2
          AX3    18 
          SX6    X3 
          SVARG  NAME,3            ARG 3 = BASE 
          SX6    B4 
          SVARG  OCT,4             ARG 4 = BIAS 
  
 #DAL     IFNE   .DAL,0      .NZ. IF LCM DIRECT ACCESS ALLOWED
          MX0    0
 #DAL     ENDIF 
  
  
 PNV4     TBITN  FP,PNV5           IF NOT AN F.P. 
          SX6    B1-2              FP ORDINAL 
          SVARG  OCT,5             ARG 5 = FP ORDINAL 
  
 #DAL     IFNE   .DAL,0      .NZ. IF LCM DIRECT ACCESS ALLOWED
          MX0    0
          MX7    0
          SA7    IAF
 #DAL     ENDIF 
  
  
 PNV5     BSS    0
  
 #DAL     IFNE   .DAL,0      .NZ. IF LCM DIRECT ACCESS ALLOWED
          SA3    =XDIRECT 
          ZR     X4,PNV5.A   IF NOT LEVEL 2 
          ZR     X3,PNV5.A   IF NOT INDIRECT MODE 
          ZR     X0,PNV5.A   IF F.P. OR EQUIVALENCED
          SX6    B1           SYMTAB ORDINAL
          SVARG  NAME,3      BASE 
          MX6    0           KLUDGE ZERO BIAS FOR FMAC TO ADD TO
          SVARG  OCT,4        BIAS
 #DAL     ENDIF 
  
 PNV5.A   TBITN  DIM,PNV6    IF NOT DIMENSIONED 
          SA3    B2+B5             WORD 2 OF DIM ENTRY
          MX0    3
          BX4    X0*X3
          LX4    3
          SB4    X4                B4 = NUMBER OF DIMS
          BX6    X4 
          SVARG  INT,6             ARG 6 = NUMBER OF DIMENSIONS 
          LX0    3+54 
          BX4    X0*X3
          NZ     X4,NML.E6         ERROR IF VARIABLE DIMENSIONS 
  
          SX6    X3 
          SVARG  OCT,7             ARG 7 = DIM1 
          SB4    B4-B5
          ZR     B4,PNV6           IF ONLY 1 DIM
          SA4    DATA.
          SX6    X4+B5
          SA6    A4 
          SX0    X3                D1 
          AX3    18 
          SX6    X3 
          IX0    X0*X6             D1*D2
          SVARG  OCT,8             ARG 8 = DIM2 
          SB4    B4-B5
          ZR     B4,PNV6           IF ONLY 2 DIMS 
          AX3    18 
          SX3    X3                PRODUCT(DIMS) * (SDPF+1) 
          AX2    P.TYP             LAST ARG, DESTROY X2 
          SX5    X2-T.DBL 
          NG     X5,PNV5A          IF SINGLE PRECISION
          AX3    1                 /2 
 PNV5A    SB6    B7                SAVE B7
          IX6    X3/X0             COMPUTE D3 
          SB7    B6                RESTORE ARG COUNT TO B7
          SVARG  OCT,9             ARG 9 = D3 
  
 PNV6     NARGS= B7                SAVE NUMBER OF ARGS
  
          SA5    RSELECT
          ZR     X5,PNV7           IF R = 0 
          ADDREF B1,REF            A REFERENCE FOR THE VARIABLE 
  
 PNV7     FMAC   NAME              OUTPUT NAME MACRO CALL 
  
*         WHEN IN OPT=2, THE OPTIMIZATION INFORMATION ABOUT THE NAMELIST
*         VARIABLES WILL BE ENTERED IN THE NML TABLE .  FOR A NAMELIST
*         I/O, LISTIO WILL PUT THESE VARIABLES OUT IN THE PIO MACROS. 
  
          SA2    =XOPT2 
          ZR     X2,PNV      IF NOT IN OPT=2
          SA1    SYMORD 
          SA4    DEB         DIM/EQU INFO 
          LX1    AP.IHP      CA=0, IH 
          MX7    1           BIT USED FOR SETTING FLAGS 
          LX4    59-P.EQU 
          PL     X4,PNV8     IF NOT EQUIVED 
          SA3    PNIEQU      EQU INFO 
          SX6    X3          BIAS 
          AX3    18 
          SX2    X3          BASE 
          LX6    AP.CAP 
          BX1    X6+X2       CA,IH
  
 PNV8     LX4    P.EQU-P.DIM
          PL     X4,PNV9     IF NOT DIMENSIONED 
          LX7    1+AP.CRP 
          BX1    X7+X1       CR,CA,IH 
          EQ     PNV10
  
 PNV9     SA4    PNITYPE
          SX5    X4-T.DBL 
          MI     X5,PNV10    IF SINGLE PRECISION
          LX7    1+AP.P1P 
          BX1    X7+X1       SET DOUBLE WORD BIT
  
 PNV10    ADDWD  NML,X1      ADD ENTRY TO TABLE 
          EQ     PNV
          TITLE              ENTRY STATEMENT PROCESSOR
*** 
*         ENTRY STATEMENT PROCESSOR 
* 
*         SYNTAX:   ENTRY <NAME> <EOS>
*         ELIST:          ------------
* 
  
*         ERROR NUMBERS 
  
 E.ENTD   EQU    14                ENTRY STMT IN A DO LOOP
 E.ENTA   EQU    181               ENTRY STMT IS NOT USASI
 E.ENT1   EQU    78                PREVIOUS USE OF NAME IN ANOTHER CONTE
 E.ENT2   EQU    79                SYNTAX ERROR 
 E.ENTM   EQU    81                ENTRY STMT IN MAIN PROGRAM 
 E.ENT4   EQU    88                LABELED ENTRY STMT 
  
 M.UCJ    EQU    105B 
 M.ENT    RMEQU  103B        ENTRY STMT MACRO ORDINAL 
          SPACE  3
 ENTM     RMHDR  M.ENT,1           RLIST MACRO HEADER WORD
          BSS    1
 UCJM     RMHDR  M.UCJ,1
          BSS    1
 NOPA.CD  LIT    34CFTNNOP. DATA 46000460004600046000B
 NOPB.CD  LIT    32CNOPS. DATA 46000460004600046000B
          SPACE  3
 ENTRY    ENTRY.
          SA1    PROGRAM
          SA2    CLABEL 
          SB6    -E.ENTM
          UX3    B1,X1
          NZ     B1,ENTRY1         IF NOT A MAIN PROGRAM
  
 ENTRYX   POSTER SEV=FE,NR=**,RETURN=ENTRYXX
  
 ENTRY1   SB6    -E.ENT4
          NZ     X2,ENTRYX         IF STMT HAS A LABEL
  
*         PERFORM SYNTAX CHECK
  
          SA5    SELIST 
          SA4    X5                NAME 
          SA2    A4-B5             EOS
          UX1    B1,X4             NAME 
          UX2    B2,X2
          SB6    -E.ENT2           SYNTAX ERROR 
          NE     B1,B5,ENTRYX      IF NOT A NAME
          SB2    B2-EL.EOS
          NZ     B2,ENTRYX         IF NOT EOS 
  
*         ENTER NAME IN SYMTAB
  
          SYMBOL                   ENTER NAME IN THE SYMBOL TABLE 
          EQ     ENTRYN 
  
          SB6    -E.ENT1           DUPLICATE USE OF THE NAME
          EQ     ENTRYX 
  
*         NAME NOT IN THE TABLE 
  
 ENTRYN   ZR     X7,*+1            IF NO PREVIOUS USE IN DEBUG STMTS
          CALL   DBGCUN            ISSUE ERROR MESSAGE
          SX0    T.ENT
          LX0    P.TYP
          BX6    X0+X2             SET TYPE 
          SA6    A2 
          LX2    X6 
  
          SB7    ENTM 
          SX7    B1 
          SA7    B7+B5             STORE IN RLIST MACRO 
          SA7    O.CEP             UPDATE CURRENT ENTRY PT ORD FOR RTNPR
  
          SA3    FSTEX
          ZR     X3,ENTRY5         IF NO EXECUTABLES YET
          SA2    =XLSFLG
          ZR     X2,ENTRYN0  IF NO UCJP BEFORE
          MX7    0
          SA7    A2 
          WRM    B7          OUTPUT ENTR. MACRO HEADER
          EQ     ENTRYN1
  
 ENTRYN0  SA4    =XN.GL 
          SX6    I.GL+X4
          SX7    X4+B5
          SA6    UCJM+1      UJP #GL
          SA7    A4 
          WRM    A6-B5       OUTPUT JUMP AROUND 
          WRM    ENTM        ENTRY. DEF 
          SA5    UCJM+1 
          CALL   WLABM       LABEL DEF
  
 ENTRYN1  SA4    =XTEMPA0.
          ZR     X4,ENTRY2         IF NO F.P. S 
  
 ENTRYN2  PLUG   AT=ENTRYN2,TO=ENTRY2    SEND DATA STMTS ONLY ONCE
          SYMBOL =8RFTNNOP.        FTNNOP. TO SYMTAB
          SA3    EPOINT.           ENTRY. BLOCK 
          SX6    X3+B5             ENTRY. = ENTRY.+1
          SA6    A3 
          SA4    WB.FTN            TYPE , RL AND RB 
          LX3    P.RA 
          IX5    X3+X4
          BX6    X5+X2             DEFINE THE ADDRESS 
          SA6    A2 
          SX7    B1                SAVE THE SYMTAB ORDINAL
          SA7    FTNNOP.
          SYMBOL =8RNOPS.          NOPS. TO SYMTAB
          SA3    DATA.
          SX6    X3+B5             DATA. = DATA.+1
          SA6    A3 
          SA4    WB.NOP 
          LX3    P.RA 
          IX5    X3+X4
          BX6    X5+X2             DEFINE THE ADDRESS 
          SA6    A2 
          SX7    B1                SAVE THE SYMTAB ORDINAL
          SA7    NOPS.
          OUTUSE ENTRY. 
          WRITEC =XF.CMPS,NOPA.CD,4 
          OUTUSE DATA.
          WRITEC =XF.CMPS,NOPB.CD,4 
          SB5    B1+
          SX6    UDATA. 
          SA6    C.BLOCK           SET CURRENT BLOCK TO DATA. 
  
 ENTRY2   SA1    DOFLAG 
          ZR     X1,ENTRY3         IF NOT INSIDE A LOOP 
          POSTERR   NR=E.ENTD,SEV=FE,RETURN=ENTRY3   *ENTRY IN DO LOOP* 
  
 ENTRY3   CALL   CVDB        ISSUE *COMPUTE VARDIM BOUNDS* R-MACRO
          SA5    RSELECT
          ZR     X5,ENTRY4         IF R = 0 
          ADDREF ENTM+1,DEF        DEFINITION OF THE NAME 
  
 ENTRY4   ADDWD  ENTR,ENTM+1       SAVE SYMTAB ORDINAL IN ENTR TABLE
 ENTRYXX  POSTERR   NR=E.ENTA,SEV=ANSI,RETURN=ENTRY  *ENTRY IS NON-ANSI*
          SPACE  3
*** 
*         EXECUTABLE STMTS HAVE NOT YET APPEARED
*         MAKE THIS ENTRY POINT THE SAME AS THE MAIN ENTRY POINT
* 
  
 ENTRY5   SA3    ENTRY.D           WORD B OF ENTRY. 
          BX7    X3+X2             DEFINE THE ADDRESS 
          SA7    A2 
  
*         OUTPUT "FEQU" MACRO CALL
  
          INTARG
          SX6    B1 
          SVARG  NAME,1            ARG 1 = ORD OF ENTRY POINT NAME
          SA1    ENTRY. 
          BX6    X1 
          SVARG  NAME,2            ARG 2 = ORD(ENTRY.)
          NARGS= B7 
          FMAC   FEQU 
          EQ     ENTRY3 
          TITLE              STOP AND PAUSE STATEMENT PROCESSORS
          USE    /MACBUF/ 
 TEMP 
          USE    *
  
 E.STOP   EQU    220               BAD SYNTAX IN STOP OR PAUSE STMT 
  
 M.STOP   RMEQU  102B        EQ END. MACRO ORDINAL
 M.PAUSE  RMEQU  124B        GENERAL EXT FUNC CALL MACRO ORDINAL
  
 PAUSEMC  RMHDR  M.PAUSE,2
 STOPMC   RMHDR  M.STOP,2 
  
 RLBUF    BSS    3
 STOPP    SPACE  4
**        STOPP - PROCESS "STOP" STATEMENT
* 
*         SYNTAX:   STOP <EOS> OR  STOP <NNNNN> <EOS> 
*         ELIST:         -----          ------------- 
* 
*         <NNNNN>  MUST BE A STRING OF 1 TO 5 OCTAL DIGITS
* 
 STOPP    ENTRY.
          SA1    STOPMC 
          BX7    X1 
          SA7    RLBUF             MACRO HEADER TO BUFFER 
          SA1    =8RSTOP. 
          RJ     PSP               PROCESS STOP STMT
          EQ     STOPP
          SPACE  3
*** 
*         PAUSEP - PROCESS "PAUSE" STATEMENT
* 
*         SYNTAX:   SAME AS THAT OF A STOP STATEMENT
* 
 PAUSEP   ENTRY.
          SA1    PAUSEMC
          BX7    X1 
          SA7    RLBUF             MACRO HEADER TO BUFFER 
          SA1    =8RPAUSE.
          RJ     PSP               PROCESS PAUSE STATEMENT
          EQ     PAUSEP 
  
          EJECT 
*** 
*         PSP - PROCESS "STOP" AND "PAUSE" STATEMENTS 
* 
*         ON ENTRY: 
*                X1 = NAME OF SYMBOL TO BE ADDED TO SYMTAB
* 
 PSP1     MX0    1
          LX0    1+P.EXT
          BX6    X0+X2             SET EXT BIT
          SA6    A2 
  
          SX7    B1 
          SA7    RLBUF+1           SAVE IH IN BUF 
          SX6    A2 
          SA6    TEMP              SAVE ADDR OF WORD B
  
*         CHECK FOR EOS OR CONSTANT 
  
          SA2    SELIST 
          SA3    X2 
          UX6    B2,X3
          SB3    EL.EOS 
          MX0    0
          PX1    X0                FORM ELIST ENTRY 
          EQ     B2,B3,PSP3        IF EOS 
  
          NZ     B2,PSPERR         IF NOT A CONSTANT
          BX1    X3                E LIST TO X1 
          SA3    A3-B5             NEXT ENTRY 
          UX4    B2,X3
          LX7    X1 
          NE     B2,B3,PSPERR      IF NOT EOS 
  
*         CHECK FOR AN INTEGER CONSTANT OF < 6 DIGITS 
  
          MX0    57 
          LX7    15 
          BX2    -X0*X7            EXTRACT TYPE OF CONSTANT 
          SB2    X2 
          NE     B2,B5,PSP3        IF NOT TYPE INTEGER
          SX4    5
          IX7    X4+X7             CHANGE TO H FORM HOLLERITH TYPE
          LX7    45-18             POSITION DIGIT COUNT 
          SX2    X7-6 
          PL     X2,PSPERR         IF MORE THAN 5 DIGITS
          LX7    18                REPOSITION 
          SA2    X7                FETCH CONSTANT 
          BX1    X7                PLACE IN X1 FOR CONVERT
  
          MX0    6
          SB2    1R 
          SB3    1R8
  
*         CHECK FOR OCTAL DIGITS
  
 PSPL     BX3    X0*X2             EXTRACT CHARACTER
          LX3    6
          SB4    X3 
          LX2    6                 POSITION FOR NEXT CHARACTER
          EQ     B4,B2,PSP3        IF BLANK 
          LT     B4,B3,PSPL        LOOP IF OCTAL
  
*** 
*         ERROR EXIT - BAD "STOP" OR "PAUSE" STMT SYNTAX
* 
 PSPERR   POSTER SEV=FE,NR=E.STOP,RETURN=PSP   *BAD SYNTAX* 
          SPACE  3
 PSP3     SB1    B0 
          CALL   CONVERT     CONVERT CONSTANT AND GET IH
  
*         FORM MACRO CALL 
  
          SB7    RLBUF             FWA OF BUFFER
          LX1    30                12/I,18/H,30/CA
          SA2    B7+B5
          SX7    X1 
          MX0    30 
          SA4    DUKE        CURRENT LINE NUMBER
          BX1    X0*X1
          IX6    X1+X2
          LX7    18 
          SA6    A2 
          BX7    X4+X7
          SA7    A6+B5
          WRM    B7          STOP / PAUSE MACRO TO RLIST
          CALL   DOCALL            MARK AN EXTERNAL REF 
  
 PSP      ENTRY. *                 ** ENTRY/EXIT ** 
          SYMBOL ,PSP1             ENTER NAME IN SYMBOL TABLE 
  
          TITLE              FMAC - FORMAT MACRO CALL 
*** 
*         SVARG - SAVE MACRO ARGUMENT 
* 
*         ON ENTRY:   
*                B7 = NUMBER OF WORDS IN ARG BUFFER 
*                X6 = 12/2000B+CONVERSION CODE,6/0,42/ARG 
*                B6 = ARGUMENT NUMBER 
*                SUCCESSIVE CALLS TO SVARG MUST HAVE ASCENDING ARG NUMS 
* 
*         USES:  X6,X7,B7,A7
* 
 SVARG    ENTRY.
          MX7    42+12
          LX7    42 
          BX6    X7*X6             REMOVE BITS DUE TO NEGATIVE OCTAL NUM
          SX7    B6                ARGNUM 
          LX7    42 
          BX6    X6+X7             12/P(CONVERT),6/ARG.N,42/ARG 
          SA6    ABUF+B7
          SB7    B7+B5             WC = WC+1
          EQ     SVARG
          SPACE  3
*** 
*         F1AMAC - FORM AND OUTPUT A 1 ARGUMENT MACRO CALL
*         WHOSE ARGUMENT IS A NAME IN SYMTAB
* 
*         ON ENTRY: 
*                X1 = MACRO NAME
*                X6 = SYMTAB ORDINAL
* 
 F1AMAC   ENTRY.
          INTARG
          NARGS= B5                SET FOR 1 ARG
          SVARG  NAME,B5           ARG 1 = NAME 
          FMAC                     FORM AND OUTPUT THE CALL 
          EQ     F1AMAC 
          SPACE  3
*** 
*         FMAC - FORMAT MACRO STORED IN ABUF INTO BCD IMAGE AND OUTPUT
*         TO "COMPS" FILE 
* 
*         ON ENTRY: 
*                X1 = 10H MACRO NAME CALL 
*                NARGS = - NUMBER OF ARGUMENTS
*                ABUF(1) - ABUF(-NARGS) HOLD THE ARGUMENTS
* 
  
*         REGISTER ASSIGNMENTS
  
*         A0 = ADDRESS OF MACRO BUFFER ( "MBUF" ) 
*         A1,X1 - CURRENT ARGUMENT
*         X7 = CURRENT WORD BEING ACCUMULATED 
  
 WC       MICRO  1,,/B1/           WORD COUNT 
 BC       MICRO  1,,/B3/           BIT COUNT ( 6*N.CHARS )
 AN       MICRO  1,,/B4/           CURRENT ARG NUMBER 
 60       MICRO  1,,/B6/           CONSTANT 60
 BL       MICRO  1,,/B7/           BITS LEFT
 S1       MICRO  1,,/B2/           SCRATCH
 S2       MICRO  1,,/B3/           SCRATCH ( ** BE CAREFUL ** ) 
  
 FMACX    MX0    60-12
          BX6    X0*X6             MACRO NAME RESTRICTED TO 6 CHARS 
          SA6    A6 
          SB1    1
          WRITEC =XF.CMPS,A0,1
          SB5    B1+
  
 FMAC     ENTRY.
          BX6    X1 
          SA0    MBUF              A0 = BASE OF EXPANSION BUFFER
          SA6    A0                STORE MACRO NAME CALL WORD 
          S"WC"  B5                WC = 1 
          S"60"  60 
          S"BL"  "60"              BITS LEFT
          S"AN"  B5                CURRENT ARG NUMBER 
          SA1    ABUF              A1,X1 - CURRENT ARG
          MX7    0                 CLEAR ACCUMULATOR
  
          SA2    NARGS
          ZR     X2,FMACX          IF NO ARGS 
  
 FMAC.L   MX0    60-6 
          BX2    X1 
          AX2    42 
          BX3    -X0*X2 
          S"S1"  X3 
          S"S2"  "S1"-"AN"         THIS ARG - LAST ARG
          S"AN"  "S1"              LAST ARG = THIS ARG
          ZR     "S2",FMAC1        IF EQUAL 
  
*         ADD N COMMA"S TO THE STRING 
  
          SX3    "S2" 
          IX4    X3+X3
          LX3    2
          IX5    X3+X4             6*DIFF 
          S"BC"  X5 
          MX0    1
          S"S1"  "BC"-B5
          SA4    =10L,,,,,,,,,, 
          AX0    "S1",X0           MASK(BC) 
          BX5    X0*X4
          RJ     ADDCH             ADD CHARACTERS 
  
 FMAC1    UX2    "S1",X1
          JP     FMAC2+"S1"        JUMP TO PROCESSOR
  
 FMAC2    MX0    60          0 - NAME FROM SYMTAB 
          EQ     FMAC.N 
  
          SA5    =7L000000B        1 - OCTAL CONVERSION 
          EQ     FMAC.O 
  
          SX5    X1+1R0 
          EQ     FMAC.I            2 - INTEGER CONVERSION ( 1 DIGIT ) 
  
          S"BC"  48 
          EQ     FMAC.C            3 - CHARACTER CONVERSION 
  
          MX0    0           4 - NAME FROM SYMTAB, OVERIDE IAF
          EQ     FMAC.N 
  
 FMAC.A   RJ     ADDCH             ADD CHARS
          SA2    NARGS
          SA1    A1+B5             NEXT 
          SX6    X2+B5
          SA6    A2 
          NZ     X6,FMAC.L         IF NOT FINISHED
  
*         TERMINATE THE LINE AND DUMP THE BUFFER
  
          S"S1"  12 
          EQ     "S1","BL",FMAC4   IF EXACTLY 12 BITS 
  
          SX2    "BL"-"S1"
          SX3    "BL"-"S1"
          AX2    59 
          BX4    X2-X3             ABS(12-BL) 
          SA1    =10L 
          S"BC"  X4                BIT COUNT
          MX0    1
          S"S1"  "BC"-B5
          AX0    "S1",X0           MASK( ABS(12-BL) ) 
          BX5    X0*X1
          RJ     ADDCH
          SA5    =8L
          NZ     X7,FMAC4          IF MORE THAN 12 BITS WERE LEFT 
          BX7    X5 
  
 FMAC4    SA7    A0+"WC"
          SB7    B1+1        (B7) = WD CNT + 1 = LINE LENGTH
          SB1    1
          WRITEC =XF.CMPS,A0,B7 
          SB5    B1+
          EQ     FMAC 
  
*         NAME FROM SYMTAB
  
 FMAC.N   SA2    SYM1 
  
 #DAL     IFNE   .DAL,0      .NZ. IF LCM DIRECT ACCESS ALLOWED
          SA5    IAF
 #DAL     ENDIF 
  
          SX1    X1 
          LX1    1                  2*ORD 
          IX3    X2-X1
          SB3    48 
  
 #DAL     IFNE   .DAL,0      .NZ. IF LCM DIRECT ACCESS ALLOWED
          BX5    X5*X0        OVERRIDE IAF IF /NAMEL/ ARG 
 #DAL     ENDIF 
  
          SA4    X3                WORD A OF NAME 
  
 #DAL     IFNE   .DAL,0      .NZ. IF LCM DIRECT ACCESS ALLOWED
          NZ     X5,FMAC.N1        IF LCM INDIRECT ADDRESS MODE 
 #DAL     ENDIF 
  
          MX5    L.NAME 
          MX0    60-6 
          BX1    X5*X4
  
 FMAC.NL  S"BC"  "BC"-6 
          LX2    "BC",X1
          BX3    -X0*X2 
          SX4    X3-1R
          ZR     X4,FMAC.NL        LOOP IF A BLANK
          ZR     X3,FMAC.NL        OR A 0 CHAR ( STMT LABELS )
          MX0    1
          S"S1"  "BC"-B5
          AX0    "S1",X0           MASK(BC) 
          BX5    X0*X1
          EQ     FMAC.A 
  
 #DAL     IFNE   .DAL,0      .NZ. IF LCM DIRECT ACCESS ALLOWED
*         INDIRECT LCM ADDRESS FOR NAME.
  
 FMAC.N1  SA4    A4-B5       WORD B 
          MX1    L.RB 
          SX5    1R?
          LX4    -P.RB-L.RB  LEFT JUSTIFY RB FIELD
          BX1    X4*X1       (X1) = RB
          SB3    B0 
          LX1    58          MAKE RB FIELD 9 BITS 
          SB2    3           LOOP COUNT 
 FMAC.N2  MX2    -3 
          LX1    3
          BX2    -X2*X1      EXTRACT CHARACTER
          SX0    X2+B3
          ZR     X0,FMAC.NA  IF A LEADING ZERO
          LX5    6           POSITION FOR NEXT CHARACTER
          SB3    B3+6        BIT COUNT OF SYMBOLIC ORDINAL
          SX2    X2+1R0 
          BX5    X5+X2
 FMAC.NA  SB2    B2-B5
          NZ     B2,FMAC.N2  IF NOT FINISHED
          SB2    -B3
          SB2    B2+60-6
          LX5    B2          LCM BLOCK NAME 
          MX6    0
          SB3    B3+6        BIT COUNT OF NAME
          SA6    IAF         ZERO INDIRECT ADDRESSEING MODE FLAG
          MX2    60-L.RA
          BX1    -X2*X4      (X1) = RA
          SX0    V.DIM+V.EQU
          SX0    V.SCA
          LX4    P.RA        RESTORE WORD B 
          BX0    X0*X4       DIMP=SCAP BIT
          LX4    -P.DIMP
          MX2    60-L.DIMP
          BX4    -X2*X4      (X4) = DIMP
          NZ    X0,FMAC.N3   IF DIMP=SCAP 
          ZR    X4,FMAC.NB   IF NO DIMP FIELD 
          SA2    =XO.DIM
          LX4    1
          SB2    X2-2 
          SA2    X4+B2       WORD 1 OF DIMTAB ENTRY 
          SX1    X2          (X1) = RA FROM DIM ENTRY 
          EQ     FMAC.NB
  
 FMAC.N3  SA3    =XO.SCA     SAVED COMMON ADDRESSES 
          IX2    X3+X4
          SA3    X2          FETCH SCA ENTRY
          SX1    X3          RA FROM SCA TABLE
 FMAC.NB  ZR     X1,FMAC.A   IF RA = 0
          SA4    NARGS
          SX6    X4+B5
          ZR     X6,FMAC.N4  IF ONE ARG IN ABUF 
  
*         ADD COMMON BLOCK BIAS TO ARG2 IN ABUF.
  
          SA4    A1+B5             GET ARG2 
          IX6    X4+X1             ADD COMMON BLOCK BIAS
          SA6    A4                STORE ARG2 IN ABUF 
          EQ     FMAC.A 
  
*         STORE SECOND ARGUMENT IN ABUF.
  
 FMAC.N4  SX6    -2 
          MX4    1
          LX4    44          ARG COUNT = 2
          SA6    NARGS
          BX1    X4+X1
          PX6    B5,X1
          SA6    A1+B5       ARG2 TO ABUF 
          EQ     FMAC.A 
 #DAL     ENDIF 
  
  
  
*         OCTAL CONVERSION - NUMBER BETWEEN -377777B AND 377777B
  
 FMAC.O   S"S1"  24                SHIFT COUNT
          MX0    60-3 
          LX1    42 
          MX4    0
          AX1    42 
          PL     X1,FMAC.O1        IF POSITIVE
          BX1    -X1
          SX4    1R-
  
 FMAC.O1  BX2    -X0*X1 
          LX3    "S1",X2
          IX5    X3+X5             ADD DIGIT TO STRING
          AX1    3
          S"S1"  "S1"+6 
          NZ     X1,*-1            IF MORE TO GO
  
          S"BC"  "S1"-18           BIT COUNT
          S"S1"  "60"-"S1"
          LX5    "S1",X5           LEFT JUSTIFY 
          MX0    1
          AX0    "BC",X0           MASK(BC+1) 
          BX5    X0*X5
          ZR     X4,FMAC.A         IF POSITIVE
          BX5    X4+X5
          LX5    54                 -NNNNB
          S"BC"  "BC"+6 
          EQ     FMAC.A 
  
 FMAC.I   LX5    60-6              1 DIGIT INTEGER CONVERSION 
          S"BC"  6
          EQ     FMAC.A 
  
 FMAC.C   MX0    60-6              CHARACTER CONVERSION 
          LX2    18                MOVE STRING TO TOP OF WORD 
          BX1    X2 
          EQ     FMAC.NL           APPEND THE STRING
          SPACE  3
*** 
*         ADDCH - ADD CHARACTERS TO ACCUMULATED STRING IN X7
* 
*         ON ENTRY: 
*                "BC" SET TO BIT COUNT
*                X5 = CHARACTERS TO BE ADDED
* 
  
 ADDCH1   LX5    "BL",X5           JUSTIFY STRING 
          BX7    X5+X7
          S"BL"  "BL"-"BC"         UPDATE BIT COUNT 
          NZ     "BL",ADDCH        IF WORD IS NOT FILLED UP 
          SA7    A0+"WC"           STORE WORD 
          S"WC"  "WC"+B5           WC = WC+1
          MX7    0
          S"BL"  "60"              RESET BITS LEFT
 ADDCH
          LE     "BC","BL",ADDCH1  IF BC @ BL 
          MX2    1
          S"S1"  "BL"-B5
          AX3    "S1",X2           MASK(BL) 
          BX4    X3*X5
          LX6    "BL",X4
          IX7    X6+X7             ACCUMULATE WORD
          SA7    A0+"WC"           AND STORE
          BX5    -X3*X5 
          S"BC"  "BC"-"BL"
          LX7    "BL",X5           POSITION REMAINING CHARS 
          S"WC"  "WC"+B5
          S"BL"  "60"-"BC"         UPDATE BITS LEFT 
          EQ     ADDCH
  
          END 
