Retro1.org codex

NDLPSS1

[00006] PROC NDLPSS1
[00010] PASS 1 PROCEDURE
[00087] PROC ABORT
[00088] PROC SSTATS
[00089] PROC STD$START
[00090] PROC STDNO
[00091] PROC STDYES
[00092] PROC READH
[00093] PROC REWIND
[00094] PROC WRITEH
[00095] PROC WRITEW
[00096] PROC MESSAGE
[00097] PROC WRITEF
[00098] PROC RECALL
[00151] PROC LEXSCAN
[00152] PROC LEXSNC
[00153] PROC PRINTRC
[00235] PROC DIAG(CODE)
[00239] DIAG - DIAGNOSTIC PROCEDURE FOR STD.
[00298] PROC ERRMS1(CODE,LINE,CLRWORD)
[00302] ERRMS1 - PASS 1 ERROR MESSAGE PROC
[00336] PROC RECALL
[00337] PROC WRITEF
[00338] PROC WRITEW
[00388] PROC GETDCHAR(CHAR,TYPE)
[00392] GETDCHAR - GET NEXT CHARACTER IN DEFINE STRING
[00567] PROC GETSCHAR(CHAR,LINENUM,TYPE)
[00571] GETSCHAR - GET NEXT CHARACTER FROM SOURCE LINE.
[00622] FUNC XCDD C(10)
[00821] PROC LEXSCAN
[00825] LEXSCAN - LEXICAL SCANNER
[01254] PROC LEXSNC
[01258] LEXSNC - SKIP TO NEXT CARD/SOURCE LINE.
[01291] PROC PRINTRC(MSG,MLENG)
[01295] PRINTRC - PRINT TRACE LINE.
[01331] PROC SUBR
[01335] SUBR - SYNTATIC SUB-ROUTINES CALLED BY STD
[01364] PROC STD$RET
[01417] PROC CHKDEC(CDWD,CDLENG,CDKWID,CDSTID,CDINT$VAL,CDRINFO,
[01422] CHKDEC - CHECK VALUE TO BE A DECIMAL NUMBER
[01533] PROC CHKHEX(CHWD,CHLENG,CHKWID,CHSTID,CHINT$VAL,CHRINFO,
[01538] CHKHEX - CHECK FOR HEXIDECIMAL VALUE.
[01690] PROC CHKNAME(CNWD,CNKWID,CNSTID,CNTYPE,CNLENG,
[01695] CHKNAME - CHECK FOR NAME.
[01787] PROC CHKTABL(CKTWORD,CKTLENG,CKTKWID,CKTSTID,CKTRINFO,
[01792] CHKTABL - CHECK TABLE FOR LEGAL VALUE.
[02283] PROC CKDEFNAM(DFNAME,DFLAG,DFNLENG,DLINE,CDNSTAT)
[02287] CKDEFNAM - CHECK FOR DEFINE NAME.
[02374] PROC CKGNAME(GNAME,NAMLENG,GPORT,CGNLINE,CGNSTAT)
[02378] CKGNAME - CHECK GENERATED NAME.
[02461] PROC CKKWD(KWDNAME,KWDSTMT,KWDNEX,KWDLXID,KWDMAP,KWDRINFO,
[02466] CKKWD - CHECK KEYWORD.
[02600] PROC CKLNAME(LBLNAME,LBLTYPE,LBLLXID,LBLLENG,LBLKLBL,
[02754] PROC CKSTMTDEC(SCSTMT,SNAME,SLXID,SMAP,SRPTINFO,SLINE,
[02759] CKSTMTDEC - CHECK STATEMENT DECLARATION
[03248] PROC CKVDEC(VKWID,VWRD,VLENG,VLINE,VCSTMT,VRPTINFO)
[03252] CKVDEC - CHECK VALUE DECLARATION.
[03857] PROC ENTLABL(LABEL$,LAB$ERR,STMT$ID,ELRPTINFO,ELLINE)
[03861] ENTLABL - ENTER LABEL INTO TABLES.
[04144] PROC ENTNID
[04148] ENTNID - ENTER NODE I.D. INTO LOGICAL LINK TABLE.
[04228] PROC ENTVAL(EVVALUE,EVKWID,EVSTID,EVNA,EVLENG,EVRINFO,
[04233] ENTVAL - ENTER VALUE INTO TABLES.
[04870] PROC NAMEGEN(RPTNAME,GROUPSIZE,NCIR$CNT,PORT$NUM,NGLINE,NGSTAT)
[04874] NAMEGEN - NAME GENERATOR
[04927] FUNC XCHD C(10)
[05019] PS1TERM - PASS 1 TERMINATION ROUTINE.
[05085] PROC PS1TERM(P1TCSTMT,P1TNEXW,P1TLINE,P1TEOF)
[05162] PROC SCNTOPRD
[05166] SCNTOPRD - SCAN TO PERIOD
[05197] PROC SDEFINE(SDCSTMT)
[05201] SDEFINE - STORE DEFINE STRING.
[05455] PROC STERM(TRPTINFO,TLINE,TCSTMT,TL$STID)
[05459] STERM - STATEMENT TERMINATION ROUTINE
[05798] PROC STITLE(STTLINE)
[05802] STITLE - STORE TITLE.
Source Code

*DECK NDLPSS1 
USETEXT NDLDATT 
USETEXT NDLER1T 
USETEXT NDLFETT 
USETEXT NDLTBLT 
      PROC NDLPSS1; 
      BEGIN 
*IF,DEF,IMS 
# 
**    NDLPSS1 - PASS 1 PROCEDURE
* 
*     D.K. ENDO    81/10/23 
* 
*     THIS PROCEDURE CONTAINS ALL THE PROC-S THAT PARSES THE NDL SOURCE 
*     AND DOES INITIALIZATION BEFORE PROCEDING. 
* 
*     PROC NDLPSS1
* 
*     ENTRY        NONE.
* 
*     EXIT         NONE.
* 
*     NOTES 
* 
*     THE NESTING OF THE PROCEDURES IS AS FOLLOWS:  
* 
*     NDL$PS1                PASS 1 INITIALIZATION
*       DIAG                 INTERFACE BETWEEN STD AND ERRMS1 
*       ERRMS1               PASS 1 ERROR MESSAGE PROC
*       GETDCHAR             GET NEXT CHARACTER FROM DEFINE STRING
*       GETSCHAR             GET NEXT CHARACTER FROM SOURCE LINE
*       LEXSCAN              FORMS TOKENS AND CATEGORIZES THEM
*       LEXSNC               SKIPS TO NEXT CARD 
*       PRINTRC              PRINT TRACE LINE 
*       SUBR                 CONTAIN SYNTACTICAL PROC-S CALLED BY STD 
*         CHKDEC             CHECK TOKEN TO BE DECIMAL
*         CHKHEX             CHECK TOKEN TO BE HEXIDECIMAL
*         CHKNAME            CHECK TOKEN TO BE A NAME 
*         CHKTABL            CHECK TABLE FOR TOKEN
*         CKDEFNAM           CHECK FOR TOKEN TO BE DEFINE NAME
*         CKGNAME            CHECK GENERATED NAME 
*         CKKWD              CHECK KEYWORD
*         CKLNAME            CHECK LABEL NAME 
*         CKSTMTDEC          CHECK STATEMENT DECLARATION
*         CKVDEC             CHECK VALUE DECLARATION
*         ENTLABL            ENTER LABEL INTO TABLES
*         ENTNID             ENTER NODE I.D. INTO TABLE 
*         ENTVAL             ENTER VALUE INTO TABLES
*         NAMEGEN            NAME GENERATOR 
*         PS1TERM            PASS 1 TERMINATION PROC
*         SCNTOPRD           SCAN TO PERIOD 
*         SDEFINE            STORE DEFINE STRING
*         STERM              STATEMENT TERMINATION PROC 
*         STITLE             STORE TITLE
* 
*     METHOD
* 
*     INITIALIZE POINTERS, FLAGS, VALUES, AND TABLES. 
*     IF THIS IS THE FIRST DIVISION 
*       READ FIRST SOURCE LINE
*       IF NOTHING WAS READ 
*         SEND ERROR MESSAGE TO DAYFILE 
*         ABORT JOB 
*     REWIND SCRATCH FILES
*     GET FIRST CHARACTER IN SOURCE LINE
*     FORM THE FIRST TOKEN
*     CALL SYNTAX TABLE DRIVER (STD)
* 
# 
*ENDIF
# 
****  PROC NDLPSS1 - XREF LIST BEGINS.
# 
      XREF
        BEGIN 
        ITEM TFLAG U;        # FLAG INDICATING A TRACE IS DESIRED      #
        ARRAY LEXICON;       # INDEX OF LEXWORD                        #
          ITEM LEX U; 
        ARRAY LEXWORD;       # TABLE CONTAINING ALL STMT-NAMES AND     #
          ITEM LEXWRD U;     #    KEYWORDS                             #
        ARRAY LBLPTRS;       # POINTERS TO LABELS IN SYNTABLE          #
          ITEM LBLPTR U;
        ARRAY SYNTBLE;       # ALL INSTRUCTIONS FOR SYNTAX TABLE DRIVER#
          ITEM SYNWORD U; 
        ARRAY TRACEM;        # INFORMATION TO GENERATE A TRACE         #
          ITEM TRACEINSTR U;
        PROC ABORT;          # WHEN CALLED CAUSES JOB TO ABORT         #
        PROC SSTATS;         # REQUESTS FOR MORE TABLE SPACE           #
        PROC STD$START;      # INITIAL TRANSFER OF CONTROL -STD-       #
        PROC STDNO;          # RETURNS AN STDFLAG OF -NO-E             #
        PROC STDYES;         # RETURNS AN STDFLAG OF -YES-             #
        PROC READH;          # READS NEXT SOURCE LINE                  #
        PROC REWIND;         # REWINDS SPECIFIED FILE                  #
        PROC WRITEH;         # WRITES LINE TO FILE                     #
        PROC WRITEW;         # WRITES SPECIFIED NUMBER OF WORDS TO FILE#
        PROC MESSAGE; 
        PROC WRITEF;         # FLUSH BUFFER AND WRITE EOF MARKER       #
        PROC RECALL;
        SWITCH SUBRJUMP;     # SWITCH FOR SYNTACTIC SUBROUTINES        #
        END 
# 
****
# 
# 
****  PROC NDLPSS1 - XDEF LIST BEGINS.
# 
      XDEF
        BEGIN 
        ITEM NDLDIAG;        # LOCATION OF DIAG                        #
        ITEM LBLPNTR;        # LOCATION OF LBLPTRS TABLE               #
        ITEM LINECTR;        # LINE COUNT                              #
        ITEM LINELMT;        # UPPER LIMIT ON NUMBER OF OUTPUT LINES   #
        ITEM SWITCHV ;       # LOCATION OF SWITCH FOR STD              #
        ITEM SYNSECT;        # USED BY STD AS LABEL TO JUMP TO         #
        ITEM SYNTBL;         # LOCATION OF SYNTBLE TABLE               #
        ITEM TRACE ;         # LOCATION OF TRACEM TABLE                #
        ARRAY CWORD [0:25] S(1);
          BEGIN 
          ITEM CURWORD C(0,0,10);      # CURRENT WORDS FROM SOURCE LINE#
          END 
        ARRAY CURHNAME [0:0] S(1);
          BEGIN 
          ITEM CHNAME U(0,18,42)=[0];  # CURRENT HOST NAME FOR COUPLER #
          END 
        ITEM CURLENG;        # LENGTH IN CHARACTERS OF CURRENT WORD    #
        ITEM CURLENW;        # LENGTH IN 60 BIT WORDS OF CURRENT WORD  #
        ITEM CURTYPE;        # SYNTACTIC TYPE OF CURRENT WORD          #
        ITEM CURLINE;        # LINE NUMBER OF CURRENT WORD             #
        ITEM CURLXID;        # LEXICAL ID OF CURRENT WORD              #
        ARRAY CURMAP[0:0] S(1);        # BIT MAP FOR CURRENT WORD      #
          BEGIN 
          ITEM CURP1 U(0,30,15);       # 1ST PARAM FOR CURRENT WORD    #
          ITEM CURP2 U(0,45,15);       # 2ND PARAM FOR CURRENT WORD    #
          ITEM CMAP  U(0,30,30);       # BIT MAP -- SAMAP OR KWAMAP    #
          END 
        ARRAY NWORD [0:25] S(1);
          BEGIN 
          ITEM NEXWORD C(0,0,10);      # SUCCESSIVE CP WORDS OF TOKEN  #
          END 
        ITEM NEXLENG;        # LENGTH IN CHARACTERS OF NEXT WORD       #
        ITEM NEXLENW;        # LENGTH IN 60 BIT WORDS OF NEXT WORD     #
        ITEM NEXTYPE;        # SYNTACTIC TYPE OF NEXT WORD             #
        ITEM NEXLINE;        # LINE NUMBER OF NEXT WORD                #
        ITEM NEXLXID;        # LEXICAL ID OF NEXT WORD IN SOURCE       #
        ARRAY NEXMAP[0:0] S(1);        # BIT MAP FOR NEXT WORD         #
          BEGIN 
          ITEM NEXP1 U(0,30,15);       # 1ST PARAM FOR NEXT WORD       #
          ITEM NEXP2 U(0,45,15);       # 2ND PARAM FOR NEXT WORD       #
          ITEM NMAP  U(0,30,15);       # BIT MAP -- SAMAP OR KWAMAP    #
          END 
        PROC LEXSCAN;        # FORMS NEXT TOKEN                        #
        PROC LEXSNC;         # SKIPS TO NEXT CARD IMAGE                #
        PROC PRINTRC;        # PRINTS TRACE WHEN REQUESTED             #
        END 
# 
****
# 
      DEF COLON$DC # 00 #;   # DISPLAY CODE COLON ":"                  #
      DEF COMMA$DC # 46 #;   # DISPLAY CODE COMMA ","                  #
      DEF LINELIMIT # 132 #; # LIMIT ON NUMBER OF CHARACTERS PER LINE  #
      DEF MXTOK   # 260 #;   # MAXIMUM TOKEN LENGTH IN 6-BIT CHARS     #
      DEF MXTOKW  # 26 #;    # MAXIMUM TOKEN LENGTH IN 60-BIT WORDS    #
      DEF PERIOD$DC # 47 #;  # DISPLAY CODE PERIOD "."                 #
      DEF SPACE$DC # 45 #;   # DISPLAY CODE SPACE " "                  #
      DEF TRNS$OK # 0 #;     #STATUS OF -GOOD- RETURNED BY READ ROUTINE#
      DEF TYPEKWD # 100 #;   # LEXICAL TYPE FOR KEYWORD                #
      DEF TYPENAM # 101 #;   # LEXICAL TYPE FOR NAME                   #
      DEF TYPENUM # 105 #;   # LEXICAL TYPE FOR NUMBER                 #
      DEF TYPEUNK # 109 #;   # LEXICAL TYPE FOR COMPLEX(UNKNOWN)       #
      DEF TYPEEOF #  11 #;   # LEXICAL TYPE FOR EOF                    #
 
      ITEM BGN$LT$PNTR;      # BEGINNING OF LABEL TABLE POINTER        #
      ITEM CMAP$B;           # CONSOLE MAP BIT POINTER                 #
      ITEM CMAP$W;           # CONSOLE MAP WORD POINTER                #
      ITEM COL;              # COLUMN NUMBER OF CURRENT CHAR IN SOURCE #
      ITEM CURCHAR$TEMP C(1);# TEMPORARY FOR CURCHAR                   #
      ITEM CURSTAT$TEMP;     # TEMPORARY FOR CURSTAT                   #
      ITEM DCHARCNT;         # DEFINE STRING CHARACTER COUNT           #
      ITEM DEFCOL;           # COLUMN NUMBER OF ESIBUFF                #
      ITEM DEFFLAG B;        # DEFINE FLAG -- SET IF PARSING DEFINE    #
      ITEM DEFPNTR;          # DEFINE STRING POINTER                   #
      ITEM DSTRNG$WORD;      # POINTS TO WORD IN DEFINE STRING         #
      ITEM END$DT$PNTR;      # END OF DEFINE TABLE POINTER             #
      ITEM ENDFLAG B;        # FLAG INDICATING -END- STMT FOUND        #
      ITEM EOFFLAG B;        # END OF FILE FLAG -- SET IF EOF SENSED   #
      ITEM I;                # SCRATCH ITEM                            #
      ITEM SCN$TO$END B;     # FLAG INDICATING IGNORE DIVISION         #
      ITEM TITLE$FLAG B;     # FLAG SET IF TITLE WAS SPECIFED          #
      ITEM VAL$DEC B;        # FLAG SET IF PARSING VALUE-DEC PORTION   #
      ITEM FIRST$STMT B;     # FLAG INDICATING FIRST STMT IN DIVISION  #
      ITEM CURCHAR C(1);     # CURRENT CHARACTER BEING LOOKED AT       #
      ITEM LINE;             # CURRENT LINE NUMBER OF SOURCE           #
      ITEM CURSTAT;          # USED TO CONTAIN STATUS OF CURCHAR       #
      ITEM PERIOD$SKIP B;    # FLAG TO CHECK IF ".' SHOULD BE SKIPPED  #
      BASED ARRAY DT$TEMPLATE [0:0] S(1); 
        BEGIN                # TEMPLATE FOR DEFINE TABLE               #
        ITEM DTMP$NAME C(0,0,7);       # DEFINE-NAME                   #
        ITEM DTMP$WCNT U(0,54,6);      #NUM OF CP WRDS CONTAINING STRNG#
        ITEM DTMP$DSTRG C(0,0,10);     # DEFINE STRING                 #
        END 
      ARRAY EMPTY$FILE [0:0] S(2);     # EMPTY FILE MESSAGE TEXT       #
        BEGIN 
        ITEM EFMESS C(0,0,18) = [" INPUT FILE EMPTY."]; 
        ITEM EFZBYTE U(1,48,12) = [0];
        END 
      BASED ARRAY INPTEMPLET [0:0] S(9);
        ITEM INPTEMP C(0,0,90);        # POINT TO BUFFER FOR READH     #
      BASED ARRAY LEXICN[26] S(1);     # BASED ARRAY FOR LEXICON TABLE #
        ITEM LEXENTRY U(0,0,60);
      BASED ARRAY LXWRDS  S(2); 
        BEGIN 
        ITEM LWORD C(0,0,10);          # KEYWORD,DELIMITER,STMT-NAME   #
        ITEM LEXID U(1,0,15);          # LEXICAL ID OF LWORD           #
        ITEM P1    U(1,15,15);         # 1ST PARAM VALUE               #
        ITEM P2    U(1,30,15);         # 2ND PARAM VALUE               #
        END 
      BASED ARRAY CHARSET;
        ITEM C64 B(0,0,1);   # SET IF 64 CHARACTER SET, ELSE 63 CSET   #
      DEF MXKYWD # 201 #; 
      ARRAY ORDINAL$TBL [0:MXKYWD] S(1);
        ITEM KYWD$ORD I(0,0,60);       # ORDINAL OF KEYWORD IN ST OR TB#
      STATUS STAT            # STATUS TYPES FOR CURCHAR                #
                 BLANK, 
                 LETTER,
                 DIGIT, 
                 DELIM, 
                 PER, 
                 ASTRSK,
                 SPEC,
                 EOF, 
                 EOC, 
                 TRACE, 
                 SQUOTE;
      CONTROL EJECT;
      PROC DIAG(CODE);
      BEGIN 
*IF,DEF,IMS 
# 
**    DIAG - DIAGNOSTIC PROCEDURE FOR STD.
* 
*     D.K. ENDO    81/10/23 
* 
*     THIS PROCEDURE CALLS THE PASS 1 ERROR MESSAGE PROC FOR STD. 
* 
*     PROC DIAG(CODE) 
* 
*     ENTRY        CODE = ERROR CODE. 
* 
*     EXIT         NONE.
* 
*     METHOD
* 
*     SELECT CASE THAT APPLIES: 
*       CASE 1(CLARIFIER WORD): 
*         CALL ERRMS1 WITH THE CURRENT WORD AS CLARIFIER
*       CASE 2(NO CLARIFIER):   
*         CALL ERRMS1 WITH A BLANK CLARIFIER
* 
# 
*ENDIF
      ITEM CODE;             # ERROR CODE                              #
      ITEM CTEMP C(10);      # CHARACTER TEMPORARY                     #
      SWITCH CODEJUMP        # SWITCH FOR WHEN CLARIFIER IS NEEDED     #
        NOCLRFR,
        NOCLRFR,
        NOCLRFR,
        NOCLRFR,
        NOCLRFR,
        NOCLRFR,
        CLRFR,
        NOCLRFR,
        CLRFR,
        CLRFR,
        NOCLRFR,
        NOCLRFR,
        ,,,,,,, 
        CLRFR,
        NOCLRFR,
        NOCLRFR,
        ,,,,,,,,
        NOCLRFR,
        ; 
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      GOTO CODEJUMP[CODE];
CLRFR:                       # PUT CLARIFIER IN ERROR MESSAGE          #
      ERRMS1(CODE,LINE,CURWORD[0]); 
      GOTO EXIT;
NOCLRFR:                     # NO CLARIFIER IS NEEDED                  #
      CTEMP = "          "; 
      ERRMS1(CODE,LINE,CTEMP);
      GOTO EXIT;
EXIT: 
      RETURN;                # **** RETURN ****                        #
      END # DIAG #
      CONTROL EJECT;
      PROC ERRMS1(CODE,LINE,CLRWORD); 
      BEGIN 
*IF,DEF,IMS 
# 
**    ERRMS1 - PASS 1 ERROR MESSAGE PROC
* 
*     D.K. ENDO    81/10/23 
* 
*     THIS PROCEDURE MAKES ENTRIES INTO THE PASS 1 ERROR FILE.
* 
*     PROC ERRMS1(CODE,LINE,CLRWORD)
* 
*     ENTRY        CODE = ERROR CODE. 
*                  LINE = SOURCE LINE NUMBER THAT ERROR WAS DETECTED. 
*                  CLRWORD = CLARIFIER WORD.
* 
*     EXIT         NONE.
* 
*     METHOD
* 
*     IF ERROR CODE IS NOT ZERO,
*     THEN, 
*       CREATE ENTRY
*       IF THIS IS A FATAL ERROR, 
*       THEN, 
*         INCREMENT ERROR COUNT 
*       OTHERWISE 
*         INCREMENT WARNING COUNT 
*     OTHERWISE,
*       CREATE ZERO ENTRY 
*     WRITE ENTRY TO FILE 
*     IF ERROR CODE IS ZERO 
*       FLUSH CIO BUFFER AND WRITE EOF
* 
# 
*ENDIF
      XREF
        BEGIN 
        PROC RECALL;
        PROC WRITEF;         # FLUSHES BUFFER AND WRITES EOF           #
        PROC WRITEW;         # WRITES ENTRY TO FILE                    #
        END 
      ITEM CODE;             # ERROR CODE                              #
      ITEM LINE;             # LINBE NUMBER THAT ERROR WAS DETECTED    #
      ITEM CLRWORD C(10);    # CLARIFIER WORD                          #
      ARRAY ELT [0:0]  S(2); # ERROR LISTING TABLE                     #
        BEGIN 
        ITEM ELTCODE I(0,0,12);        # ERROR CODE                    #
        ITEM ELTLINE I(0,12,18);       # LINE NUMBER                   #
        ITEM ELTCLRW C(1,0,10);        # CLARIFIER WORD                #
        ITEM ELTWRD1 U(0,0,60); 
        ITEM ELTWRD2 U(1,0,60); 
        END 
CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      IF CODE NQ 0           # BUFFER SHOULD NOT BE CLEARED            #
      THEN
        BEGIN 
        ELTWRD1[0] = 0;                # CLEAR FIRST WORD OF ENTRY     #
        ELTCODE[0] = CODE;             # MAKE ENTRY IN ERROR TABLE     #
        ELTLINE[0] = LINE;
        ELTCLRW[0] = CLRWORD; 
        IF EMTTYPE[CODE] EQ "E" 
        THEN                 # SET FLAG IN SOURCE                      #
          BEGIN 
          ERRCNT = ERRCNT + 1;         # INCREMENT FATAL ERROR COUNT   #
          END 
        ELSE
          BEGIN 
          WARNCNT = WARNCNT + 1;       # INCREMENT WARNING ERROR COUNT #
          END 
        INPELINE[0] = "***";           # PUT ERROR INDICATOR IN SOURCE #
        END 
      ELSE                   # CLEAR BUFFER                            #
        BEGIN 
        ELTWRD1[0] = 0;                # MAKE ZEROED ENTRY             #
        ELTWRD2[0] = 0;                #   FLAGGING END OF TABLE       #
        END 
      WRITEW(ERR1FET,ELT,2); # WRITE ENTRY TO FILE                     #
      IF CODE EQ 0
      THEN                             # WRITE BUFFER TO FILE          #
        BEGIN 
        WRITEF(ERR1FET);
        RECALL(ERR1FET);
        END 
      RETURN;                # **** RETURN ****                        #
      END # ERRMS1 #
      CONTROL EJECT;
      PROC GETDCHAR(CHAR,TYPE); 
      BEGIN 
*IF,DEF,IMS 
# 
**    GETDCHAR - GET NEXT CHARACTER IN DEFINE STRING
* 
*     D.K. ENDO    81/10/23 
* 
*     THIS PROCEDURE GETS A CHARACTER AT A TIME FROM THE CURRENT DEFINE 
*     STRING BEING PARSED AND CLASSIFIES THE CHARACTER. 
* 
*     GETDCHAR(CHAR,TYPE) 
* 
*     ENTRY        NONE.
* 
*     EXIT         CHAR = NEXT CHARACTER IN DEFINE STRING.
*                  TYPE = WHAT THE CHARACTER TYPE IS. 
* 
*     METHOD
* 
*     IF THE EXPANDED SOURCE LINE IMAGE IS FULL,
*       WRITE LINE TO EXPANDED SECONDARY INPUT FILE.
*       RESET POINTER TO COLUMN IN BUFFER.
*       CLEAR BUFFER. 
*     GET NEXT CHARACTER IN DEFINE STRING.
*     PUT CHARACTER IN EXPANDED SOURCE LINE IMAGE BUFFER. 
*     INCREMENT COLUMN POINTER. 
*     CLASSIFY CHARACTER. 
* 
# 
*ENDIF
      ITEM CHAR C(1);        # NEXT CHARACTER IN DEFINE-STRING         #
      ITEM TYPE;             # WHAT THE CHARACTER TYPE IS              #
 
      ITEM STATS;            # STATUS RETURNED BY WRITEH               #
 
      SWITCH TYPESWITCH 
        DELIMITER,           # COLON #
        LETTER,              # A #
        LETTER,              # B #
        LETTER,              # C #
        LETTER,              # D #
        LETTER,              # E #
        LETTER,              # F #
        LETTER,              # G #
        LETTER,              # H #
        LETTER,              # I #
        LETTER,              # J #
        LETTER,              # K #
        LETTER,              # L #
        LETTER,              # M #
        LETTER,              # N #
        LETTER,              # O #
        LETTER,              # P #
        LETTER,              # Q #
        LETTER,              # R #
        LETTER,              # S #
        LETTER,              # T #
        LETTER,              # U #
        LETTER,              # V #
        LETTER,              # W #
        LETTER,              # X #
        LETTER,              # Y #
        LETTER,              # Z #
        DIGIT,               # 0 #
        DIGIT,               # 1 #
        DIGIT,               # 2 #
        DIGIT,               # 3 #
        DIGIT,               # 4 #
        DIGIT,               # 5 #
        DIGIT,               # 6 #
        DIGIT,               # 7 #
        DIGIT,               # 8 #
        DIGIT,               # 9 #
        SPECIAL,             # + #
        SPECIAL,             # - #
        ASTERISK,            # * #
        SPECIAL,             # / #
        SPECIAL,             # ( #
        SPECIAL,             # ) #
        LETTER,              # $ #
        DELIMITER,           # = #
        BLANK,               # BLANK #
        DELIMITER,           # , #
        PERIOD,              # . #
        LETTER,              # POUND #
        SPECIAL,             # [ #
        SPECIAL,             # ] #
        SPECIAL,             # % (FOR 63 CODE SET -- COLON)#
        LETTER,              # " #
        LETTER,              # _ #
        SPECIAL,             # ! #
        SPECIAL,             # & #
        SQTE,                # ' SINGLE QUOTE # 
        SPECIAL,             # ? #
        SPECIAL,             # < #
        SPECIAL,             # > #
        LETTER,              # @ #
        SPECIAL,             # \ #
        SPECIAL,             # ^ #
        SPECIAL;             # SEMICOLON #
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      IF DEFCOL GQ LINELIMIT # LINE IMAGE IS FULL                      #
      THEN
        BEGIN 
        WRITEH(ESIFET,ESI$BUFFER,14,STATS);  # WRITE LINE TO FILE      #
        DEFCOL = 30;         # INITIALIZE BEGINNING COLUMN             #
        ESIBUFF[0] = " ";    # CLEAR BUFFER                            #
        END 
      IF DCHARCNT GQ 10      # IF AT END OF WORD                       #
      THEN                   # INITIALIZE POINTERS TO NEXT WORD        #
        BEGIN 
        DSTRNG$WORD = DSTRNG$WORD + 1;
        DCHARCNT = 0; 
        END 
      CHAR = C<DCHARCNT,1>DTMP$DSTRG[DSTRNG$WORD]; # GET NEXT CHARACTER#
      DCHARCNT = DCHARCNT + 1;         # INCREMENT CHARACTER COUNT     #
      C<DEFCOL,1>ESIBUFF[0] = CHAR;    # PUT CHARACTER IN BUFFER       #
      DEFCOL = DEFCOL + 1;   # MOVE COLUMN POINTER                     #
#                                                                      #
      GOTO TYPESWITCH[CHAR];
#                                                                      #
BLANK:  
      TYPE = STAT"BLANK"; 
      GOTO EXIT;
LETTER: 
      TYPE = STAT"LETTER";
      GOTO EXIT;
DIGIT:  
      TYPE = STAT"DIGIT"; 
      GOTO EXIT;
DELIMITER:  
      TYPE = STAT"DELIM"; 
      GOTO EXIT;
PERIOD: 
      IF PERIOD$SKIP                   # IF SKIP PERIOD IS TRUE        #
      THEN
        BEGIN 
        TYPE = STAT"LETTER";
        IF C<DCHARCNT,1>DTMP$DSTRG[DSTRNG$WORD] EQ " "
        THEN
          BEGIN 
          TYPE = STAT"PER"; 
          DEFCOL = DEFCOL - 1;
          END 
        END 
      ELSE
        BEGIN 
        TYPE = STAT"PER"; 
        DEFCOL = DEFCOL - 1;           # WRITE OVER PERIOD             #
        END 
      GOTO EXIT;
ASTERISK: 
      TYPE = STAT"ASTRSK";
      GOTO EXIT;
SPECIAL:  
      IF NOT C64 AND CHAR EQ O"63"
      THEN
        TYPE = STAT"DELIM";  # OCTAL 63 IS A COLON                     #
      ELSE
        TYPE = STAT"SPEC";
      GOTO EXIT;
SQTE: 
      TYPE = STAT"SQUOTE";
      GOTO EXIT;
TRACEIND: 
      $BEGIN
      TYPE = STAT"TRACE"; 
      GOTO EXIT;
      $END
      GOTO SPECIAL; 
#                                                                      #
EXIT: 
      RETURN;                # **** RETURN ****                        #
      END # GETDCHAR #
      CONTROL EJECT;
      PROC GETSCHAR(CHAR,LINENUM,TYPE); 
      BEGIN 
*IF,DEF,IMS 
# 
**    GETSCHAR - GET NEXT CHARACTER FROM SOURCE LINE. 
* 
*     D.K. ENDO    81/10/23 
* 
*     THIS PROCEDURE GETS THE NEXT CHARACTER FROM THE SOURCE LINE AND 
*     CLASSIFIES IT.
* 
*     PROC GETSCHAR(CHAR,LINENUM,TYPE)
* 
*     ENTRY        NONE.
* 
*     EXIT         CHAR = NEXT CHARACTER IN SOURCE LINE.
*                  LINENUM = CURRENT LINE NUMBER. 
*                  TYPE = WHAT THE CHARACTER TYPE IS. 
* 
*     METHOD
* 
*     IF POINTING TO LAST RECOGNIZABLE COLUMN IN SOURCE LINE, 
*     THEN, 
*       IF DEFINE WAS IN LINE,
*         COPY REST OF SOURCE LINE TO EXPANDED SOURCE IMAGE.
*         WRITE EXPANDED LINE TO FILE(FOLD IF NECESSARY). 
*       WRITE SOURCE LINE TO SECONDARY INPUT FILE.
*       READ NEXT SOURCE LINE.
*       IF END OF FILE, 
*         SET EOF FLAG AND END OF INPUT FLAG. 
*       SET CHAR TO BLANK.
*       SET TYPE TO END OF CARD.
*       INCREMENT LINE NUMBER.
*     OTHERWISE,
*       IF EOF FLAG SET,
*       THEN, 
*         SET CHAR TO BLANK.
*         SET TYPE TO END OF FILE.
*       OTHERWISE,
*         GET NEXT CHARACTER FROM SOURCE. 
*         PUT CHARACTER IN EXPANDED SOURCE IMAGE BUFFER.
*         POINT TO NEXT COLUMN IN SOURCE LINE AND EXPANDED SOURCE LINE. 
*         IF EXPANDED SOURCE BUFFER IS FULL,
*           WRITE BUFFER TO FILE. 
*           RESET COLUMN POINTER. 
*           CLEAR BUFFER. 
*         CLASSIFY CHARACTER. 
* 
# 
*ENDIF
      ITEM CHAR C(1);        # NEXT CHARACTER IN SOURCE-LINE           #
      ITEM LINENUM;          # LINE NUMBER THAT CHARACTER IS ON        #
      ITEM TYPE;             # WHAT THE CHARACTER TYPE IS              #
      XREF
        BEGIN 
        FUNC XCDD C(10);     # CONVERTS BINARY TO DECIMAL DISPLAY CODE #
        END 
      DEF LASTCOL # 72 #;    # LAST COL THAT NDL RECOGNIZES ON CARD    #
      DEF ENDCOL # 89 #;     # LAST COL ON SOURCE LINE                 #
      ITEM CTEMP C(10);      # TEMPORARY FOR CHARACTER ITEMS           #
      ITEM I;                # TEMPORARY FOR INTERGER ITEMS            #
      ITEM STATS;            # STATUS RETURNED BY READ ROUTINE         #
#                                                                      #
      SWITCH TYPESWITCH 
        DELIMITER,           # COLON #
        LETTER,              # A #
        LETTER,              # B #
        LETTER,              # C #
        LETTER,              # D #
        LETTER,              # E #
        LETTER,              # F #
        LETTER,              # G #
        LETTER,              # H #
        LETTER,              # I #
        LETTER,              # J #
        LETTER,              # K #
        LETTER,              # L #
        LETTER,              # M #
        LETTER,              # N #
        LETTER,              # O #
        LETTER,              # P #
        LETTER,              # Q #
        LETTER,              # R #
        LETTER,              # S #
        LETTER,              # T #
        LETTER,              # U #
        LETTER,              # V #
        LETTER,              # W #
        LETTER,              # X #
        LETTER,              # Y #
        LETTER,              # Z #
        DIGIT,               # 0 #
        DIGIT,               # 1 #
        DIGIT,               # 2 #
        DIGIT,               # 3 #
        DIGIT,               # 4 #
        DIGIT,               # 5 #
        DIGIT,               # 6 #
        DIGIT,               # 7 #
        DIGIT,               # 8 #
        DIGIT,               # 9 #
        SPECIAL,             # + #
        SPECIAL,             # - #
        ASTERISK,            # * #
        SPECIAL,             # / #
        SPECIAL,             # ( #
        SPECIAL,             # ) #
        LETTER,              # $ #
        DELIMITER,           # = #
        BLANK,               # BLANK #
        DELIMITER,           # , #
        PERIOD,              # . #
        LETTER,              # POUND #
        SPECIAL,             # [ #
        SPECIAL,             # ] #
        SPECIAL,             # % (FOR 63 CODE SET -- COLON)#
        LETTER,              # " #
        LETTER,              # _ #
        SPECIAL,             # ! #
        SPECIAL,             # & #
        SQTE,                # ' SINGLE QUOTE # 
        SPECIAL,             # ? #
        SPECIAL,             # < #
        SPECIAL,             # > #
        LETTER,              # @ #
        SPECIAL,             # \ #
        SPECIAL,             # ^ #
        SPECIAL;             # SEMICOLON #
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      IF COL GQ LASTCOL      # INDECATES LAST COLUMN THAT NDLP WILL    #
      THEN                   #   RECOGNIZE ON CARD-IMAGE               #
        BEGIN 
        IF INPDLINE[0] EQ "D"          # IF DEFINES WERE SPECIFIED ON  #
        THEN                           #   THIS LINE --                #
          BEGIN 
          FOR I=COL STEP 1 UNTIL ENDCOL DO
            BEGIN                      # COPY REST OF IMAGE TO ESIBUFF #
            IF DEFCOL GQ LINELIMIT     # IF END OF LINE                #
            THEN                       #   FOLD TO NEXT LINE           #
              BEGIN 
              WRITEH(ESIFET,ESI$BUFFER,14,STATS); 
              DEFCOL = 30;
              ESIBUFF[0] = " ";        # CLEAR BUFFER                  #
              END 
            C<DEFCOL,1>ESIBUFF[0] = C<I,1>INPLINE[0]; 
            DEFCOL = DEFCOL + 1;
            END 
          IF ESIBUFF[0] NQ " "         # WRITE OUT BUFFER IF NOT BLANK #
          THEN
            BEGIN 
            WRITEH(ESIFET,ESI$BUFFER,14,STATS);  # WRITE EXPANDED LINE #
            END 
          END                                    #   TO FILE           #
        WRITEH(SECFET,INPUT$BUFFER,11,STATS);  # WRITE TO FILE         #
        INPBUFF[0] = " ";    # CLEAR INPUT BUFFER                      #
        READH(INFET,INPTEMPLET,9,STATS);
        IF STATS NQ TRNS$OK 
        THEN
          BEGIN 
          EOFFLAG = TRUE; 
          EOINP = TRUE; 
          END 
        CHAR = " "; 
        TYPE = STAT"EOC";    # SEND BACK END OF CARD STATUS            #
        COL = 0;             # INITIALIZE COLUMN COUNT                 #
        LINENUM = LINENUM + 1;         # INCREMENT LINE COUNT          #
        CTEMP = XCDD(LINENUM);         # PUT LINE NUMBER               #
        INPLNUM[0] = C<5,5>CTEMP;      #    LINE IMAGE                 #
        ESILINE[0] = INPLNUM[0];
        DEFCOL = 20;
        END 
      ELSE                   # MORE CHARACTERS ON CARD-IMAGE           #
        BEGIN 
        IF EOFFLAG           # IF EOF FLAG IS SET                      #
        THEN
          BEGIN 
          CHAR = " "; 
          TYPE = STAT"EOF";  # SEND BACK STATUS OF EOF                 #
          END 
        ELSE                 # GET NEXT CHARACTER                      #
          BEGIN 
          CHAR = C<COL,1>INPLINE[0];
          C<DEFCOL,1>ESIBUFF[0] = CHAR; 
          COL = COL + 1;     # INCREMENT COLUMN COUNT                  #
          DEFCOL = DEFCOL + 1;
          IF DEFCOL GQ LINELIMIT       # IF LINE IS FULL --            #
          THEN
            BEGIN 
            WRITEH(ESIFET,ESIBUFF,14,STATS);      # WRITE OUT ESIBUFF  #
            DEFCOL = 30;
            ESIBUFF[0] = " ";# CLEAR BUFFER                            #
            END 
          GOTO TYPESWITCH[CHAR];
            BLANK:  
              TYPE = STAT"BLANK"; 
              GOTO EXIT;
            LETTER: 
              TYPE = STAT"LETTER";
              GOTO EXIT;
            DIGIT:  
              TYPE = STAT"DIGIT"; 
              GOTO EXIT;
            DELIMITER:  
              TYPE = STAT"DELIM"; 
              GOTO EXIT;
            PERIOD: 
              IF PERIOD$SKIP
              THEN
                BEGIN 
                TYPE = STAT"LETTER";
                IF COL LQ 89
                THEN
                  BEGIN 
                  IF C<COL,1>INPLINE[0] EQ " "
                  THEN
                    BEGIN 
                    TYPE = STAT"PER"; 
                    END 
                  END 
                END 
              ELSE
                BEGIN 
                TYPE = STAT"PER"; 
                END 
              GOTO EXIT;
            ASTERISK: 
              TYPE = STAT"ASTRSK";
              GOTO EXIT;
            SPECIAL:  
              IF NOT C64 AND CHAR EQ O"63"
              THEN
                TYPE = STAT"DELIM"; 
              ELSE
                TYPE = STAT"SPEC";
              GOTO EXIT;
            SQTE: 
              TYPE = STAT"SQUOTE";
              GOTO EXIT;
            TRACEIND: 
              $BEGIN
              TYPE = STAT"TRACE"; 
              GOTO EXIT;
              $END
              GOTO SPECIAL; 
 
EXIT: 
          END 
        END 
      RETURN;                # **** RETURN ****                        #
      END # GETSCHAR #
      CONTROL EJECT;
      PROC LEXSCAN; 
      BEGIN 
*IF,DEF,IMS 
# 
**    LEXSCAN - LEXICAL SCANNER 
* 
*     D.K. ENDO    81/10/23 
* 
*     THIS PROCEDURE FORMS TOKENS AND CLASSIFIES THEM.
* 
*     PROC LEXSCAN
* 
*     ENTRY        NONE.
* 
*     EXIT         NONE.
* 
*     METHOD
* 
*     MOVE NEXT WORD INTO CURRENT WORD BUFFER.
*     MOVE NEXT WORD INFO INTO CURRENT WORD INFO BUFFERS. 
*     CLEAR NEXT WORD AND NEXT WORD INFO. 
*     IF CURRENT WORD IS PERIOD 
*       SCAN REST OF CARD FOR COMMENT 
*       IF COMMENT EXISTS AND NOT DELIMITED BY ASTERISK 
*         FLAG ERROR
*     INITIAL STATE TO ZERO STATE 
*     ENTER STATE TABLE:  
* 
*     ***STATE I      0      I      1      I      2      I      3      I
*        ***   I             I             I             I             I
*     STIM  ***I    INIT     I    NAME     I   NUMBER    I   UNKNOWN   I
*     ---------+-------------+-------------+-------------+-------------+
*              I       (S) 0 I           0 I           0 I           0 I
*              I             I SET         I SET         I SET         I
*              I             I   TYPE      I   TYPE      I   TYPE      I
*     BLANK    I    NONE     I   LENGTH    I   LENGTH    I   LENGTH    I
*              I             I IF KEYWORD  I             I             I
*              I             I   SET I.D.  I             I             I
*              I             I          (E)I          (E)I          (E)I
*     ---------+-------------+-------------+-------------+-------------+
*              I       (S) 1 I         (S) I         (S) I       (S) 3 I
*              I             IIF CHARCNT 0IIF CHARCNT 0I             I
*              I STORE       I  STOR CHAR  I  STOR CHAR  I       ++    I
*     LETTER   I   CHARACTER I  STATE = 1  I  STATE = 2  I   NONE      I
*              I             IELSE,        IELSE,        I             I
*              I             I  STATE = 3  I  STATE = 3  I             I
*              I             I             I             I             I
*     ---------+-------------+-------------+-------------+-------------+
*              I       (S) 2 I         (S) I         (S) I       (S) 3 I
*              I             IIF CHARCNT 0IIF CHARCNT 0I             I
*              I STORE       I  STOR CHAR  I  STOR CHAR  I       ++    I
*     DIGIT    I   CHARACTER I  STATE = 1  I  STATE = 2  I   NONE      I
*              I             IELSE,        IELSE,        I             I
*              I             I  STATE = 3  I  STATE = 3  I             I
*              I             I             I             I             I
*     ---------+-------------+-------------+-------------+-------------+
*              I       (S) 0 I           0 I           0 I           0 I
*              I STORE CHAR  I SET         I SET         I SET         I
*          +   I SET         I   TYPE      I   TYPE      I   TYPE      I
*     DELIM    I   TYPE      I   LENGTH    I   LENGTH    I   LENGTH    I
*              I   I.D.      I IF KEYWORD  I             I             I
*              I             I   SET I.D.  I             I             I
*              I          (E)I          (E)I          (E)I          (E)I
*     ---------+-------------+-------------+-------------+-------------+
*              I         (S) I             I             I             I
*              I IF VALU-DEC I IF VALU-DEC I IF VALU-DEC I IF VALU-DEC I
*              I  (A)        I   (A)       I   (A)       I   (A)       I
*     ASTERISK I ELSE,       I ELSE,       I ELSE,       I ELSE,       I
*              I  SET TYPE   I   (B)       I   (B)       I   (B)       I
*              I  SET LENGTH I             I             I             I
*              I  (E)        I             I             I             I
*     ---------+-------------+-------------+-------------+-------------+
*              I           0 I           0 I           0 I           0 I
*              I IF DEFFLAG  I (B)         I (B)         I (B)         I
*              I  (S)        I IF DEFFLAG  I IF DEFFLAG  I IF DEFFLAG  I
*     PERIOD   I  CLEAR FLAG I   (S)       I   (S)       I   (S)       I
*              I ELSE,       I   CLEAR FLAGI   CLEAR FLAGI   CLEAR FLAGI
*              I  (B)        I             I             I             I
*              I          (E)I          (E)I          (E)I          (E)I
*     ---------+-------------+-------------+-------------+-------------+
*              I       (S) 0 I           0 I           0 I           0 I
*              I STORE CHAR  I SET         I SET         I SET         I
*            * I SET         I   TYPE      I   TYPE      I   TYPE      I
*     SPECIAL  I   TYPE      I   LENGTH    I   LENGTH    I   LENGTH    I
*              I   LENGTH    I IF KEYWORD  I             I             I
*              I             I   SET I.D.  I             I             I
*              I          (E)I          (E)I          (E)I          (E)I
*     ---------+-------------+-------------+-------------+-------------+
* 
*    (A) -- SAME AS LETTER. 
*    (B) -- SAME AS DELIMETER 
*    (E) -- EXIT STATE TABLE
*    (S) -- SET INPUT POINTER TO NEXT CHARACTER IN SOURCE LINE
*     +  -- DELIMITER --> : / = / , 
*    ++  -- CHARACTER COUNT IS INCREMENTED BY ONE -- ONLY TIME COUNT IS 
*           INCREMENTED EXCEPT WHEN STORING CHARACTER 
*     *  -- CHARACTERS THAT ARE NOT ONE OF THE ABOVE
* 
# 
*ENDIF
      DEF PERIOD$ID # O"01003" #;      # LEXID OF PERIOD               #
      DEF STATE0 #  0 #;     # STATE 0 -- BIT NUM OF COL IN STATE TABLE#
      DEF STATE1 # 06 #;     # STATE 1 -- BIT NUM OF COL IN STATE TABLE#
      DEF STATE2 # 12 #;     # STATE 2 --                              #
      DEF STATE3 # 18 #;     # STATE 3 --                              #
      DEF STATE4 # 24 #;     # STATE 4 -- BIT NUM OF COL IN STATE TABLE#
      DEF STATE5 # 30 #;     # STATE 5 --                              #
      DEF STATE6 # 36 #;     # STATE 6 --                              #
      DEF STATE7 # 42 #;     # STATE 7 -- BIT NUM OF COL IN STATE TABLE#
      DEF STATE8 # 48 #;     # STATE 8 --                              #
      DEF STATE9 # 54 #;     # STATE 9 --                              #
      ITEM CHARGRP;          # CHARACTER GROUP -- PNTR INTO LEXICON    #
      ITEM CTEMP C(10);      # TEMPORARY FOR CHARACTER STRING          #
      ITEM ENTRIES;          # NUMBER OF ENTRIES IN CHARACTER GROUP    #
      ITEM FOUND B;          # BOOLEAN SCRATCH ITEM                    #
      ITEM I;                # INTEGER SCRATCH ITEM                    #
      ITEM STATE;            # CURRENT STATE                           #
      ITEM WORD$BOUND;       # WORD COUNT UNTIL CURRENT WORD BOUND     #
      ITEM WDPTR;            # WORD POINTER INTO LEXWORDS(KEYWORD LIST)#
      SWITCH NDLJMPVCTR   ERR,         # COLON  00 #
                          PROCEED,     # A      01 #
                          STORCHAR,    # B      02 #
                          SETTRACE,    # C      03 #
                          NAME,        # D      04 #
                          NUMBER,      # E      05 #
                          UNKNOWN,     # F      06 #
                          STRING,      # G      07 #
                          DELIMITER,   # H      10 #
                          PERIOD,      # I      11 #
                          ASTRISK,     # J      12 #
                          SPECIAL,     # K      13 #
                          EOF,         # L      14 #
                          TRANS01,     # M      15 #
                          TRANS02,     # N      16 #
                          TRANS03,     # O      17 #
                          TRANS04,     # P      20 #
                          TRANS05,     # Q      21 #
                          TRANS06,     # R      22 #
                          TRANS07,     # S      23 #
                          TRANS08,     # T      24 #
                          TRANS09;     # U      25 #
#                                                                      #
      ARRAY STATETAB [0:10] S(1); 
#     STATE TABLE CONTROLS EXECUTION OF LABELED SECTIONS OF            #
#     SWITCH NDLJMPVCTR DEPENDING ON --                                #
#       1. CURRENT STATE                                               #
#       2. STATUS OF CURCHAR                                           #
#                                                                      #
#     SECTIONS MAY --                                                  #
#       1. CHANGE STATE                                                #
#       2. STORE CURCHAR                                               #
#       3. SET LEXTYPE/LEXID/P1/P2 AND RETURN                          #
#                                                                      #
        ITEM STATETABLE U(0,0,60) = [ 
                       #            /    STATES  #
                       # STIMULUS  /   0123456789#
                       # BLANK    #   "ADEFA     ", 
                       # LETTER   #   "MBBAB     ", 
                       # DIGIT    #   "NBBAB     ", 
                       # DELIMITER#   "HDEFE     ", 
                       # PERIOD   #   "IDEFE     ", 
                       # ASTERISK #   "JJJJE     ", 
                       # SPECIAL  #   "KDEFE     ", 
                       # EOF      #   "LDEFE     ", 
                       # EOC      #   "ADEFA     ", 
                       # TRACE    #   "CDEFE     ", 
                       # SQUOTE   #   "PDEFG     "];
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      FOR I = 0 STEP 1 UNTIL MXTOKW-1 DO
        BEGIN 
        CURWORD[I] = NEXWORD[I];       # MOVE NEXINFO INTO CURINFO     #
        END 
      CURTYPE = NEXTYPE;               # MOVE NEXINFO INTO CURINFO     #
      CURLXID = NEXLXID;
      CURP1[0] = NEXP1[0];
      CURP2[0] = NEXP2[0];
      CURLENG = NEXLENG;
      CURLENW = NEXLENW;
      CURLINE = NEXLINE;
      FOR I = 0 STEP 1 UNTIL MXTOKW-1 DO
        BEGIN 
        NEXWORD[I] = " ";              # CLEAR NEXWORD                 #
        END 
      NEXTYPE = 0;                     # CLEAR NEXINFO                 #
      NEXLXID = 0;
      NEXP1[0] = 0; 
      NEXP2[0] = 0; 
      NEXLENG = 0;
      NEXLENW = 1;
      NEXLINE = 0;
      IF CURWORD[0] EQ "." AND NOT DEFFLAG
      THEN                   # IF PERIOD AND NOT DEFINE, SCAN FOR -*-  #
        BEGIN 
        FOR I=0 WHILE CURSTAT NQ STAT"EOC" DO 
          BEGIN 
          IF CURSTAT EQ STAT"TRACE" 
          THEN
            BEGIN 
            TFLAG = TFLAG + 1;         # RESET TRACE FLAG              #
            GETSCHAR(CURCHAR,LINE,CURSTAT); 
            TEST I; 
            END 
          IF CURSTAT NQ STAT"BLANK" 
          THEN               # CHECK FOR ASTERISK                      #
            BEGIN 
            IF CURCHAR NQ "*" 
            THEN
              BEGIN 
              CTEMP = CURCHAR;
              ERRMS1(ERR22,LINE,CTEMP);# NO ASTERISK FOUND             #
              END 
            FOR I=0 WHILE CURSTAT NQ STAT"EOC" DO 
              GETSCHAR(CURCHAR,LINE,CURSTAT); 
            END 
          ELSE
            GETSCHAR(CURCHAR,LINE,CURSTAT); 
          END 
        GETSCHAR(CURCHAR,LINE,CURSTAT); 
        NEXLINE = LINE; 
        END 
      WORD$BOUND = 10;                 # INITIALIZE WORD BOUND         #
      STATE = STATE0;                  # INITIAL STATE IS ZERO         #
      GOTO STARTSTATE;                 # GO TO STATE TABLE             #
#                                                                      #
PROCEED:  
      IF DEFFLAG                       # IF DEFINE STRING IS BEING     #
      THEN                             #   PARSED, GET NEXT CHAR FROM  #
        GETDCHAR(CURCHAR,CURSTAT);     #   STRING                      #
      ELSE
        GETSCHAR(CURCHAR,LINE,CURSTAT);#GET NEXT CHAR FOR SOURCE       #
      GOTO STARTSTATE;
STORCHAR:                    # STORE CHARACTER AND GET NEXT ONE        #
      IF NEXLENG LS MXTOK    # IF NEXWORD IS LESS THAN MAX TOKEN LENGTH#
      THEN                   #   STORE CHAR AND INCREMENT LENGTH       #
        BEGIN 
        I = (NEXLENG)/10;    # INDEX FOR WORDS IN TOKEN (TRUNCATED)    #
        C<NEXLENG-(10*I),1>NEXWORD[I] = CURCHAR;
        END 
      ELSE                   # NEXWORD IS LONGER THAN MAX TOKEN LENGTH,#
        BEGIN                #  IGNORE REST OF TOKEN                   #
        STATE = STATE3; 
        END 
      NEXLENG = NEXLENG + 1;           # INCREMENT TOKEN LENGTH        #
      IF NEXLENG GQ WORD$BOUND
      THEN                   # IF REACHED END OF CURRENT WORD          #
        BEGIN 
        NEXLENW = NEXLENW + 1;         # INCREMENT WORD COUNT          #
        WORD$BOUND = WORD$BOUND + 10;  # SET NEW WORD BOUND LIMIT      #
        END 
      GOTO PROCEED;          # GET NEXCHAR AND PROCEED                 #
#                                                                      #
SETTRACE:                    # SET/CLEAR TRACE FLAG                    #
      TFLAG = TFLAG + 1;
      GOTO PROCEED;          # GET NEXT CHARACTER AND PROCEED          #
#                                                                      #
NAME:                        # SEE IF NAME IS IN LEXWORDS(KEYWORD LIST)#
      FOUND = FALSE;         # CLEAR FOUND FLAG                        #
      CHARGRP = B<0,6>NEXWORD[0];                # SET CHARACTER GROUP #
      WDPTR = B<6,12>LEXENTRY[CHARGRP] / 2;      # SET POINTER INTO TBL#
      ENTRIES = B<0,6>LEXENTRY[CHARGRP];         # SET NUM OF ENTRIES  #
      FOR I=0 STEP 1 WHILE I LS ENTRIES AND NOT FOUND DO
        BEGIN 
        IF NEXWORD[0] EQ LWORD[WDPTR] 
        THEN
          BEGIN 
          FOUND = TRUE;      # IF FOUND IN LEXWORDS THEN INICATE SO    #
          TEST I; 
          END 
        WDPTR = WDPTR + 1;
        END 
      IF FOUND
      THEN                   # IF FOUND --                             #
        BEGIN 
        NEXLXID = LEXID[WDPTR];        # SET NEXLEXID                  #
        NEXP1[0] = P1[WDPTR];          # SET NEXP1                     #
        NEXP2[0] = P2[WDPTR];          # SET NEXP2                     #
        NEXTYPE = TYPEKWD;             # SET NEXTYPE TO KEYWORD        #
        END 
      ELSE                   # IF NOT FOUND --                         #
        NEXTYPE = TYPENAM;             # SET NEXTYPE TO NAME           #
      NEXLINE = LINE;                  # SAVE CURRENT LINE NUMBER      #
      RETURN;                # **** RETURN ****                        #
#                                                                      #
NUMBER: 
      NEXTYPE = TYPENUM;     # SET NEXTYPE TO NUMBER                   #
      NEXLINE = LINE;        # SAVE CURRENT LINE NUMBER                #
      RETURN;                # **** RETURN ****                        #
#                                                                      #
UNKNOWN:  
      NEXTYPE = TYPEUNK;     # SET NEXTYPE TO COMPLEX(UNKNOWN)         #
      NEXLINE = LINE;        # SAVE CURRENT LINE NUMBER                #
      RETURN;                # **** RETURN ****                        #
#                                                                      #
DELIMITER:  
      C<0,1>NEXWORD[0] = CURCHAR; # STORE DELIMITER                    #
      NEXTYPE = TYPEKWD;               # SET NEXTYPE TO KEYWORD        #
      NEXLENG = 1;                     # SET NEXLENG TO ONE CHAR       #
      NEXLINE = LINE;                  # SAVE CURRENT LINE NUMBER      #
      CHARGRP = 0;                     # CHARACTER GROUP IS ZERO       #
      WDPTR = B<6,12>LEXENTRY[CHARGRP] / 2;# STORE BEGIN WORD POINTER  #
      ENTRIES = B<0,6>LEXENTRY[CHARGRP];#STORE NUMBER OF ENTRIES       #
      FOUND = FALSE;                   # CLEAR FOUND FLAG              #
      FOR I=0 STEP 1 WHILE I LS ENTRIES AND NOT FOUND DO
        BEGIN 
        IF NEXWORD[0] EQ LWORD[WDPTR] 
        THEN
          BEGIN 
          NEXLXID = LEXID[WDPTR]; 
          FOUND = TRUE; 
          END 
        WDPTR = WDPTR + 1;
        END 
      IF DEFFLAG
      THEN                   # GET NEXT CHARACTER                      #
        GETDCHAR(CURCHAR,CURSTAT);
      ELSE
        GETSCHAR(CURCHAR,LINE,CURSTAT); 
      RETURN;                # **** RETURN ****                        #
#                                                                      #
PERIOD: 
      IF DEFFLAG             # IF DEFINE FLAG SET,                     #
      THEN                   #   PERIOD INDICATES END OF DEFINE-STRING #
        BEGIN 
        DEFFLAG = FALSE;     # CLEAR DEFINE FLAG                       #
        CURCHAR = CURCHAR$TEMP;        # GET CURRENT CHAR IN SOURCE    #
        CURSTAT = CURSTAT$TEMP;        # GET STATUS OF CURCHAR         #
        C<DEFCOL,1>ESIBUFF[0] = CURCHAR;#PUT CURRENT CHAR IN LINE IMAGE#
        DEFCOL = DEFCOL + 1;           # INCREMENT COLUMN POINTER      #
        GOTO STARTSTATE;     # FORM NEXT ELEMENT IN SOURCE             #
        END 
      ELSE                   # PERIOD INDICATES END OF STATEMENT       #
        BEGIN 
        NEXWORD[0] = ".         ";     # STORE PERIOD                  #
        NEXTYPE = TYPEKWD;   # SET NEXTYPE TO KEYWORD                  #
        NEXLENG = 1;         # SET NEXLENG TO ONE CHARACTER            #
        NEXLXID = PERIOD$ID; # SET LEXED TO -PERIOD-                   #
        NEXLINE = LINE;      # SAVE CURRENT LINE NUMBER                #
        GETSCHAR(CURCHAR,LINE,CURSTAT); 
        RETURN;              # **** RETURN ****                        #
        END 
      RETURN;                # **** RETURN ****                        #
#                                                                      #
ASTRISK:    
      IF VAL$DEC             # IF CURRENTLY PARSING VALUE-DEC PORTION  #
      THEN
        BEGIN 
        NEXLXID = 999;       # SET LEX I.D. TO INDICATE ASTRSK PRESENT #
        IF STATE EQ STATE0   # IF CURRENT STATE IS ZERO                #
        THEN
          BEGIN 
          GOTO TRANS01;      # ASSUME NEXWORD IS A NAME --             #
          END                          # SET CURRENT STATE TO ONE      #
        ELSE                 # NOT IN INIT STATE                       #
          BEGIN 
          GOTO STORCHAR;     # JUST STORE CHAR WITH NO STATE CHANGE    #
          END 
        END 
      ELSE                   # NOT PARSING VALUE-DEC PORTION --        #
        BEGIN                          # TREAT ASTERISK AS DELIMITER   #
        CURSTAT = STAT"DELIM";         # SET STAT OF CRNT CHAR TO DELIM#
        GOTO STARTSTATE;
        END 
#                                                                      #
SPECIAL:  
      C<0,1>NEXWORD[0] = CURCHAR;      # STORE SPECIAL CHARACTER       #
      NEXTYPE = TYPEUNK;     # SET NEXTYPE TO UNKNOWN                  #
      NEXLENG = 1;           # SET NEXLENG TO ONE CHARACTER            #
      NEXLINE = LINE;        # SAVE CURRENT LINE NUMBER                #
      IF DEFFLAG             # GET NEXT CHARACTER                      #
      THEN
        GETDCHAR(CURCHAR,CURSTAT);
      ELSE
        GETSCHAR(CURCHAR,LINE,CURSTAT); 
      RETURN;                # **** RETURN ****                        #
 
STRING: 
      IF DEFFLAG             # SKIP TERMINATING QUOTE                  #
      THEN
        BEGIN 
        GETDCHAR(CURCHAR,CURSTAT);
        END 
      ELSE
        BEGIN 
        GETSCHAR(CURCHAR,LINE,CURSTAT); 
        END 
      NEXTYPE = TYPENUM;     # STRINGS HAVE NUMERIC TYPE               #
      NEXLINE = LINE;        # SAVE CURRENT LINE NUMBER                #
      RETURN; 
#                                                                      #
EOF:  # END OF FILE SENSED   #
      NEXTYPE = TYPEEOF;     # SET TYPE TO EOF                         #
      NEXLENG = 0;           # CLEAR NEXLENG                           #
      RETURN;                # **** RETURN ****                        #
#                                                                      #
STARTSTATE: 
      GOTO NDLJMPVCTR[B<STATE,6>STATETABLE[CURSTAT]]; 
#                                                                      #
TRANS01:  
      STATE = STATE1;        # SET STATE AND                           #
      GOTO STORCHAR;         #   STORE CHARACTER                       #
TRANS02:  
      STATE = STATE2; 
      GOTO STORCHAR;
TRANS03:  
      STATE = STATE3; 
      GOTO STORCHAR;
TRANS04:                     # START OF STRING                         #
      STATE = STATE4; 
      GOTO PROCEED; 
TRANS05:  
      STATE = STATE5; 
      GOTO STORCHAR;
TRANS06:  
      STATE = STATE6; 
      GOTO STORCHAR;
TRANS07:  
      STATE = STATE7; 
      GOTO STORCHAR;
TRANS08:  
      STATE = STATE8; 
      GOTO STORCHAR;
TRANS09:  
      STATE = STATE9; 
      GOTO STORCHAR;
#                                                                      #
ERR:  
      RETURN;          # **** RETURN ****                              #
#                                                                      #
      END # LEXSCAN # 
      CONTROL EJECT;
      PROC LEXSNC;
      BEGIN                  # SKIP TO NEXT CARD IMAGE                 #
*IF,DEF,IMS 
# 
**    LEXSNC - SKIP TO NEXT CARD/SOURCE LINE. 
* 
*     D.K. ENDO    81/10/23 
* 
*     THIS PROCEDURE CAUSES SCANNING OF SOURCE TO RESUME ON NEXT SOURCE 
*     LINE. 
* 
*     PROC LEXSNC 
* 
*     ENTRY        NONE.
* 
*     EXIT         NONE.
* 
*     METHOD
* 
*     SCAN TO END OF CARD.
*     IF EOF IS NOT ENCOUNTERED,
*       GET CHARACTER ON NEXT LINE. 
* 
# 
*ENDIF
      ITEM I;                # SCRATCH ITEM                            #
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      FOR I=0 WHILE CURSTAT NQ STAT"EOC" AND CURSTAT NQ STAT"EOF" DO
        GETSCHAR(CURCHAR,LINE,CURSTAT);# SCAN TO END OF CARD           #
      IF CURSTAT NQ STAT"EOF" 
      THEN                             # IF NOT EOF, THEN GET NEXT CHAR#
        GETSCHAR(CURCHAR,LINE,CURSTAT); 
      RETURN;                # **** RETURN **** TO STD                 #
      END # LEXSNC #
      CONTROL EJECT;
      PROC PRINTRC(MSG,MLENG);         # PRINTS TRACE LINE             #
      BEGIN 
*IF,DEF,IMS 
# 
**    PRINTRC - PRINT TRACE LINE. 
* 
*     D.K. ENDO    81/10/23 
* 
*     THIS PROCEDURE PRINT TRACE MESSAGE WHEN CALLED BY STD.
* 
*     PROC PRINTRC(MSG,MLENG) 
* 
*     ENTRY        MSG = TRACE MESSAGE TO BE PRINTED. 
*                  MLENG = LENGTH OF MESSAGE IN CHARACTERS. 
* 
*     EXIT         NONE.
* 
*     METHOD
* 
*     CALCULATE LENGTH OF MESSAGE IN CP WORDS.
*     WRITE MESSAGE TO SECONDARY INPUT FILE 
* 
# 
*ENDIF
      ITEM MSG C(80);        # MESSAGE TO BE PRINTED                   #
      ITEM MLENG;            # LENGTH OF MESSAGE IN NUM OF CHARACTERS  #
      ITEM I;                # INTEGER TEMPORARY                       #
      ITEM TEMP;             # INTEGER TEMPORARY                       #
      ITEM STATS;            # STATUS RETURNED BY WRITEH               #
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      TEMP = MLENG; 
      FOR I=0 STEP 1 WHILE TEMP GR 0 DO 
        TEMP = TEMP - 10;    # CALCULATE NUMBER OR WORDS IN MSG        #
      TEMP = I; 
      WRITEH(SECFET,MSG,TEMP,STATS);
      RETURN;                # **** RETURN ****                        #
      END # PRINTRC # 
      CONTROL EJECT;
      PROC SUBR;
      BEGIN 
*IF,DEF,IMS 
# 
**    SUBR - SYNTATIC SUB-ROUTINES CALLED BY STD
* 
*     D.K. ENDO    81/10/23 
* 
*     THE PROCEDURE IS USED BY STD TO CALLED PROC-S AS NEEDED TO PARSE
*     THE NDL SOURCE INPUT. 
* 
*     PROC SUBR 
* 
*     ENTRY        NONE.
* 
*     EXIT         NONE.
* 
*     METHOD
* 
*     BY WAY OF A SWITCH, WHICH CAN BE EXTERNALLY REFERENCED BY STD,
*     THE APPROPRIATE PROC IS CALLED TO PROCESS AND CHECK THE NDL 
*     SOURCE INPUT. THE PROC-S CALLED ARE:  
* 
*        CHKDEV    CKGNAME   ENTLABL   SCNTOPRD 
*        CHKHEX    CKKWD     ENTNID    SDEFINE
*        CHKNAME   CKLNAME   ENTVAL    STERM
*        CHKTABL   CKSTMTDEC NAMEGEN   STITLE 
*        CKDEFNAM  CKVDEC    PS1TERM
* 
# 
*ENDIF
      XREF
        BEGIN 
        PROC STD$RET; 
        END 
      XDEF
        BEGIN 
        SWITCH SUBRJUMP      # SWITCH FOR SYNTACTIC SUBROUTINES        #
          CKCMNT, 
          CKLBNM, 
          CKSTDEC,
          SCNTOPD,
          CKDELIM,
          CKDEFNM,
          CKKYWD, 
          CKVALDC,
          STORDEF,
          STORTITLE,
          STMTTRM,
          PSS1TRM;
        END 
      DEF AYE # "A" #;
      DEF BLANK # " " #;
      DEF EFF # "F" #;
      DEF NINE # "9" #; 
      DEF USER$TIP # "TT1" #;          # FIRST THREE CHARS OF USER TIP #
      DEF ZERO # "0" #; 
      ITEM CKSTAT B;         # STATUS RETURNED FROM CHECKING ROUTINE   #
      ITEM CRNT$LTYPE C(10); # CURRENT LINE TYPE                       #
      ITEM CRNT$TIP C(10);   # CURRENT TIPTYPE                         #
      ITEM CTEMP C(10);      # TEMPORARY FOR CHARACTER STRING          #
      ITEM KWDFLAG B;        # FLAG SET OF LABEL IS A KEYWORD          #
      ITEM KWID;             # KEYWORD-ID OF KEYWORD BEING CHECKED     #
      ITEM LAST$STID = 18;   # STATEMENT-ID OF PREVIOUS STATEMENT      #
                             #   INITIALIZE TO -COMMENT- STMT I.D.     #
      ITEM LERR$CODE;        # ERROR CODE                              #
      ITEM LERR$LINE;        # LINE NUMBER IN ERROR                    #
      ITEM LERR$NAME C(10);  # NAME OF LABEL IN ERROR                  #
      ITEM RINFOWORD U;      # TEMPORARY TO SAVE REPEAT INFORMATION    #
      ARRAY CURSTMT [0:0] S(1);        # CURRENT STATEMENT             #
        BEGIN 
        ITEM CURSTID U(0,0,9);         # STATEMENT-ID                  #
        ITEM CUREFLG B(0,15,1);        # LABEL ERROR FLAG              #
        ITEM CURKLBL B(0,16,1);        # SET OF LABEL IS A KEYWORD     #
        ITEM CURLABL C(0,18,7);        # STATEMENT LABEL               #
        END 
      ARRAY RPTINFO [0:0] S(1);        # REPEAT INFORMATION            #
        BEGIN 
        ITEM GRPFLAG B(0,0,1);         # GROUP FLAG                    #
        ITEM SVCFLG  B(0,1,1);         # SVC FLAG                      #
        ITEM PORTNUM U(0,6,9);         # PORT NUMBER FROM GROUP STMT   #
        ITEM GRPCNT  U(0,15,9);        # GROUP COUNT                   #
        ITEM NCIRVAL U(0,24,9);        # NCIR VALUE                    #
        ITEM RPTINFO$WORD U(0,0,60) = [0];
        END 
      CONTROL EJECT;
      PROC CHKDEC(CDWD,CDLENG,CDKWID,CDSTID,CDINT$VAL,CDRINFO,
                                  CDLINE,CDSTAT); 
      BEGIN 
*IF,DEF,IMS 
# 
**    CHKDEC - CHECK VALUE TO BE A DECIMAL NUMBER 
* 
*     D.K. ENDO    81/10/23 
* 
*     THIS PROCEDURE CHECKS A TOKEN TO BE A DECIMAL NUMBER AND CONVERTS 
*     IT TO INTEGER 
* 
*     PROC CHKDEC(CDWD,CDKWID,CDSTID,CDINT$VAL,CDRINFO,CDLINE,CDSTAT) 
* 
*     ENTRY        CDWD = DISPLAY CODED NUMBER TO BE CHECKED. 
*                  CDKWID = I.D. OF KEYWORD THE NUMBER IS ASSIGNED TO.
*                  CDSTID = CURRENT STATEMENT I.D.
*                  CDRINFO = REPEAT INFORMATION 
*                  CDLINE = CURRENT LINE NUMBER 
* 
*     EXIT         CDINT$VAL = CONVERTED INTEGER VALUE
*                  CDSTAT = STATUS OF VALUE(SET TO TRUE IF O.K.)
* 
*     METHOD
* 
*     STATUS RETURN STATUS TO O.K.
*     FOR EACH CHARACTER FROM RIGHT TO LEFT,
*       IF CHARACTER IS NOT A BLANK,
*         IF CHARACTER IS NOT A DECIMAL DIGIT,
*         THEN, 
*           SET RETURN STATUS TO ERROR. 
*         OTHERWISE,
*           CALCULATE INTEGER VALUE OF CHARACTER. 
*           ADD INTEGER TO RETURN VALUE.
*     IF RETURN STATUS IS O.K., 
*     THEN, 
*       ENTER VALUE DECLARATION IN STMT ENTRY WITH INTEGER VALUE. 
*     OTHERWISE,
*       FLAG ERROR -- NOT A DECIMAL VALUE.
*       ENTER VALUE DECLARATION IN STMT ENTRY WITH CHARACTER VALUE. 
* 
# 
*ENDIF
      ARRAY CDWD [0:25] S(1); 
        BEGIN 
        ITEM CDWORD C(0,0,10);#NUMBER TEXT TO BE CHECKED               #
        END 
      ITEM CDLENG;           # LENGTH OF TEXT                          #
      ITEM CDKWID;           # KEYWORD I.D.                            #
      ITEM CDSTID;           # CURRENT STATEMENT I.D.                  #
      ITEM CDINT$VAL;        # CONVERTED DECIMAL NUMBER IN BINARY      #
      ITEM CDRINFO;          # REPEAT INFORMATION                      #
      ITEM CDLINE;           # CURRENT LINE NUMBER                     #
      ITEM CDSTAT B;         # RETURN STATUS OF NUMBER                 #
#                                                                      #
      ITEM CTEMP C(1);       # CHARACTER TEMPORARY                     #
      ITEM EXPONENT;         # ITEM USED TO STORE EXPONENT             #
      ITEM I;                # SCRATCH ITEM                            #
      ITEM ITEMP;            # INTEGER TEMPORARY                       #
#                                                                      #
      ARRAY ERRVALU [0:0] S(1); 
        ITEM ERRWORD C(0,18,7);        # VALUE IN RIGHT MOST 42 BITS   #
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      CDSTAT = TRUE;         # SET RETURN STATUS TO O.K.               #
      EXPONENT = 0;          # INITIALIZE EXPONENT VALUE               #
      CDINT$VAL = 0;         # INITIALIZE RETURN BINARY VALUE          #
      FOR I=9 STEP -1 UNTIL 0 DO       # BEGINNING FROM RIGHT, CHECK   #
        BEGIN                          #   AND CONVERT EACH CHARACTER  #
        CTEMP = C<I,1>CDWORD[0];       # MASK CHARACTER                #
        IF CTEMP NQ BLANK    # IF BLANK, THEN IGNORE                   #
        THEN                 #   ELSE                                  #
          BEGIN 
          IF CTEMP LS ZERO OR CTEMP GR NINE 
          THEN               # IF NOT A DECIMAL CHARACTER              #
            BEGIN 
            CDSTAT = FALSE;  # RETURN ERROR STATUS                     #
            END 
          ELSE               # CHARACTER IS O.K.                       #
            BEGIN 
            IF EXPONENT LQ 14          # IF VALUE IS NOT TOO BIG       #
            THEN
              BEGIN 
              ITEMP = CTEMP - ZERO;    # CALCULATE BINARY VALUE        #
              CDINT$VAL = CDINT$VAL + (ITEMP * 10**EXPONENT);#ADD VALUE#
              EXPONENT = EXPONENT + 1; # INCREMENT EXPONENT            #
              END 
            END 
          END 
        END 
      IF CDSTAT              # NO ERRORS DETECTED                      #
      THEN                   #   MAKE VALUE-DECLARATION ENTRY          #
        BEGIN 
        ENTVAL(CDINT$VAL,CDKWID,CDSTID,CDWD,CDLENG,CDRINFO, 
                                        CDLINE,CDSTAT); 
        END 
      ELSE                   # ILLEGAL DECIMAL VALUE                   #
        BEGIN                #   MAKE VALUE-DEC ENTRY WITH ILLEGAL TEXT#
        ERRWORD[0] = CDWORD[0]; 
        ENTVAL(ERRVALU,CDKWID,CDSTID,CDWD,CDLENG,CDRINFO, 
                                      CDLINE,CDSTAT); 
        IF CDKWID EQ KID"AL"           # IF AL IS THE ERROR KEYWORD    #
        THEN
          BEGIN 
          ERRMS1(ERR42,CDLINE,CDWORD[0]); # WARNING -- IS GENERATED    #
          END 
        ELSE
          BEGIN 
          ERRMS1(ERR10,CDLINE,CDWORD[0]); 
          END 
        END 
      RETURN;                # **** RETURN ****                        #
      END # CHKDEC #
      CONTROL EJECT;
      PROC CHKHEX(CHWD,CHLENG,CHKWID,CHSTID,CHINT$VAL,CHRINFO,
                                          CHLINE,CHSTAT); 
      BEGIN 
*IF,DEF,IMS 
# 
**    CHKHEX - CHECK FOR HEXIDECIMAL VALUE. 
* 
*     D.K. ENDO    81/11/18 
* 
*     THIS PROCEDURE CHECKS A TOKEN TO BE HEXIDECIMAL AND CONVERTS IT 
*     TO INTEGER. 
* 
*     PROC CHKHEX(CHWD,CHKWID,CHSTID,CHINT$VAL,CHRINFO,CHLINE,CHSTAT) 
* 
*     ENTRY        CHWD = CHARACTER NUMBER TO BE CHECKED. 
*                  CHKWID = CURRENT KEYWORD I.D.
*                  CHSTID = CURRENT STATEMENT I.D.
*                  CHRINFO = CURRENT REPEAT INFO. 
*                  CHLINE = CURRENT LINE NUMBER.
* 
*     EXIT         CHINT$VAL = CONVERTED INTEGER VALUE. 
*                  CHSTAT = RETURN STATUS -- SET TRUE IF O.K. 
* 
*     METHOD
* 
*     SET RETURN STATUS TO O.K. 
*     FOR EACH CHARACTER FROM RIGHT TO LEFT,
*       IF CHARACTER IS NOT BLANK,
*         IF CHARACTER IS HEXIDECIMAL,
*         THEN, 
*           CALCULATE INTEGER VALUE FOR CHARACTER.
*           ADD INTEGER TO RETURN VALUE.
*         OTHERWISE,
*           SET RETURN STATUS TO ERROR. 
*     IF RETURN STATUS IS O.K.
*     THEN
*       ENTER VALUE DECLARATION IN STATEMENT ENTRY WITH INTEGER VALUE.
*     OTHERWISE$
*       FLAG ERROR -- NOT A HEXIDECIMAL VALUE.
*       ENTER VALUE DECLARATION IN STATEMENT ENTRY WITH CHARACTER VALUE.
* 
# 
*ENDIF
      ARRAY CHWD [0:25] S(1); 
        BEGIN 
        ITEM CHWORD C(0,0,10);#NUMBER TEXT TO BE CONVERTED             #
        END 
 
      ITEM CHLENG;           # LENGTH OF TEXT                          #
      ITEM CHKWID;           # KEYWORD I.D.                            #
      ITEM CHSTID;           # CURRENT STATEMENT I.D.                  #
      ITEM CHINT$VAL;        # CONVERTED HEX NUMBER IN BINARY          #
      ITEM CHRINFO;          # REPEAT INFORMATION                      #
      ITEM CHLINE;           # CURRENT LINE NUMBER                     #
      ITEM CHSTAT B;         # RETURNED STATUS OF NUMBER               #
#                                                                      #
      ITEM CTEMP C(1);       # CHARACTER TEMPORARY                     #
      ITEM EXPONENT;         # ITEM USED TO STORE EXPONENT             #
      ITEM I, J;             # SCRATCH ITEMS                           #
      ITEM ITEMP;            # INTEGER TEMPORARY                       #
#                                                                      #
      ARRAY ERRVALU [0:0] S(1); 
        ITEM ERRWORD C(0,18,7);        # VALUE IN RIGHT MOST 42 BITS   #
 
      ARRAY HEXVALU [0:25] S(1);
        BEGIN 
        ITEM HEXV I(00,00,60);#4-BIT HEX VALUES FOR PAD OR UDATA       #
        END 
      ITEM HWI, HDI;         # HEXVALU WORD INDEX, BIT DISPL. INDEX    #
      ITEM CWI, CDI;         # CHWD WORD INDEX, CHWD CHAR. DISPL. INDEX#
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      CHSTAT = TRUE;         # SET RETURN STATUS TO O.K                #
      EXPONENT = 0;          # INITIALIZE EXPONENT                     #
      CHINT$VAL = 0;         # INITIALIZE RETURN BINARY VALUE          #
      IF (CHKWID EQ KID"PAD") OR (CHKWID EQ KID"UDATA") 
      THEN
        BEGIN                # CLEAR HEX VALUE VECTOR                  #
        FOR I = 0 STEP 1 UNTIL 25 DO
           HEXV[I] = 0; 
        END 
      FOR I=CHLENG-1 STEP -1 UNTIL 0 DO 
        BEGIN                          # BEGINNING FROM RIGHT, CHECK   #
                                       #   AND CONVERT EACH CHARACTER  #
        CWI = I/10;                    # CHWORD WORD INDEX             #
        CDI = I - CWI*10;              # CHWORD CHAR. DISPL. INDEX     #
        CTEMP = C<CDI,1>CHWORD[CWI];
        IF CTEMP NQ BLANK              # MASK CHARACTER                #
        THEN
          BEGIN 
          IF CTEMP GQ AYE AND CTEMP LQ EFF
          THEN               # IF CHARACTER IS BETWEEN -A- THRU -F-    #
            BEGIN            #   CONVERT TO BINARY                     #
            IF EXPONENT LQ 11          # IF VALUE IS NOT TOO BIG       #
            THEN
              BEGIN 
              ITEMP = (CTEMP - AYE) + 10; 
              CHINT$VAL = CHINT$VAL + (ITEMP * 16**EXPONENT); 
              EXPONENT = EXPONENT + 1;
              END 
            END 
          ELSE               # CHARACTER IS NOT -A- THRU -F-           #
            BEGIN 
            IF CTEMP GQ ZERO AND CTEMP LQ NINE
            THEN             # IF CHARACTER IS BETWEEN -0- THRU -9-    #
              BEGIN          #   CONVERT TO BINARY                     #
              IF EXPONENT LQ 11        # IF VALUE IS NOT TOO BIG       #
              THEN
                BEGIN 
                ITEMP = CTEMP - ZERO; 
                CHINT$VAL = CHINT$VAL + (ITEMP * 16**EXPONENT); 
                EXPONENT = EXPONENT + 1;
                END 
              END 
            ELSE             # CHARACTER IS NOT A HEX NUMBER           #
              BEGIN 
              CHSTAT = FALSE;# RETURN ERROR STATUS                     #
              END 
            END 
          IF (CHKWID EQ KID"PAD") OR (CHKWID EQ KID"UDATA") 
          THEN
            BEGIN 
            HWI = I*4/60;              # HEXV WORD INDEX               #
            HDI = (I - HWI*15) *4;     # HEXV BIT DISPLACEMENT INDEX   #
            B<HDI,4>HEXV[HWI] = B<56,4>CHINT$VAL; 
            CHINT$VAL = 0;             # RESET HEX DIGIT VALUE         #
            EXPONENT = 0; 
            END 
          END 
        END 
      IF CHSTAT              # IF VALUE IS A VALID HEX NUMBER          #
      THEN                   #   MAKE VALUE-DECLARATION ENTRY          #
        BEGIN 
        IF (CHKWID EQ KID"PAD") OR (CHKWID EQ KID"UDATA") 
        THEN
          BEGIN 
          ENTVAL(CHINT$VAL,CHKWID,CHSTID,HEXVALU,CHLENG,CHRINFO,
                                          CHLINE,CHSTAT); 
          END 
        ELSE
          BEGIN 
          ENTVAL(CHINT$VAL,CHKWID,CHSTID,CHWD,CHLENG,CHRINFO, 
                                          CHLINE,CHSTAT); 
          END 
        END 
      ELSE                   # VALUE IN NOT A VALID HEX NUMBER         #
        BEGIN 
        ERRWORD[0] = C<0,7>CHWORD[0]; 
        ENTVAL(ERRVALU,CHKWID,CHSTID,CHWD,CHLENG,CHRINFO, 
                                        CHLINE,CHSTAT); 
        ERRMS1(ERR10,CHLINE,CHWORD[0]); 
        END 
      RETURN;                # **** RETURN ****                        #
      END # CHKHEX #
      CONTROL EJECT;
      PROC CHKNAME(CNWD,CNKWID,CNSTID,CNTYPE,CNLENG,
                      CNRINFO,CNLINE,CNSTAT); 
      BEGIN 
*IF,DEF,IMS 
# 
**    CHKNAME - CHECK FOR NAME. 
* 
*     D.K. ENDO    81/11/18 
* 
*     THIS PROCEDURE CHECKS THE VALUE TO BE A LEGAL NAME(7 CHARACTERS,
*     BEGINNING WITH A LETTER, CONSISTS OF ONLY ALPHANUMERIC CHARACTERS)
* 
*     PROC CHKNAME(CNWD,CNKWID,CNSTID,CNTYPE,CNLENG,CNLINE,CNSTAT)
* 
*     ENTRY        CNWD = NAME TO BE CHECKED. 
*                  CNKWID = CURRENT KEYWORD I.D.
*                  CNSTID = CURRENT STATEMENT I.D.
*                  CNTYPE = LEXICAL TYPE FOR NAME.
*                  CNLENG = LENGTH OF NAME IN CHARACTERS. 
*                  CNLINE = CURRENT LINE NUMBER.
* 
*     EXIT         CNSTAT = RETURN STATUS -- SET TRUE IF O.K. 
* 
*     METHOD
* 
*     IF NAME IS CLASSIFIED AS NAME OR KEYWORD, 
*     THEN, 
*       IF LENGTH OF NAME LESS THAN OR EQUAL TO SEVEN,
*       THEN, 
*         IF NAME DOES NOT CONTAIN ASTERISKS, 
*         THEN
*           SET STATUS TO O.K.
*         OTHERWISE,
*           FLAG ERROR -- INVALID NAME. 
*           SET RETURN STATUS TO ERROR. 
*       OTHERWISE,
*         FLAG ERROR -- NAME TO LONG. 
*         SET RETURN STATUS TO ERROR. 
*     OTHERWISE,
*       FLAG ERROR -- INVALID NAME. 
*       SET RETURN STATUS TO ERROR. 
*     ENTER VALUE DECLARATION IN STATEMENT TABLE. 
* 
# 
*ENDIF
      ARRAY CNWD [0:25] S(1); 
        BEGIN 
        ITEM CNWORD C(0,0,10);#LABEL-NAME VALUE                        #
        END 
      ITEM CNKWID;           # KEYWORD I.D.                            #
      ITEM CNSTID;           # CURRENT STATEMENT I.D.                  #
      ITEM CNTYPE;           # LEXICAL TYPE OF VALUE                   #
      ITEM CNLENG;           # LENGTH OF LABEL-NAME IN CHARACTERS      #
      ITEM CNRINFO;          # REPEAT INFORMATION                      #
      ITEM CNLINE;           # CURRENT LINE NUMBER                     #
      ITEM CNSTAT B;         # RETURN STATUS OF LABEL-NAME             #
#                                                                      #
      ARRAY LAB$NAME [0:0] S(1);
        ITEM RIGHT$WORD C(0,18,7);     # NAME IN RIGHT MOST 42 BITS    #
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      IF CNTYPE EQ TYPENAM OR CNTYPE EQ TYPEKWD # IF NAME OR KEYWORD   #
      THEN                   # (ASSUMES NO DELIMITERS AT THIS POINT)   #
        BEGIN 
        IF CNLENG LQ 7       # IF 7 CHARACTERS OR LESS IN LENGTH       #
        THEN
          BEGIN 
          IF CURLXID NQ 999  # IF NO ASTERISK IN NAME                  #
          THEN
            BEGIN 
            CNSTAT = TRUE;   # RETURN A STATUS OF O.K.                 #
            END 
          ELSE               # ASTERISK PRESENT IN NAME                #
            BEGIN            # FLAG ERROR -- INVALID VALUE             #
            ERRMS1(ERR10,CNLINE,CNWORD[0]); 
            CNSTAT = FALSE;  # RETURN ERROR STATUS                     #
            END 
          END 
        ELSE                 # GREATER THAN 7 CHARACTERS               #
          BEGIN 
          CNSTAT = FALSE;    # RETURN ERROR STATUS                     #
          ERRMS1(ERR10,CNLINE,CNWORD[0]); # FLAG ERROR -- INVALID NAME #
          END 
        END 
      ELSE                   # DOES NOT BEGIN WITH LETTER              #
        BEGIN 
        CNSTAT = FALSE;      # RETURN ERROR STATUS                     #
        ERRMS1(ERR10,CNLINE,CNWORD[0]); # FLAG ERROR -- INVALID NAME   #
        END 
      RIGHT$WORD[0] = CNWORD[0]; # PUT NAME IN RIGHT MOST 42 BITS      #
      ENTVAL(LAB$NAME,CNKWID,CNSTID,CNWD,CNLENG,CNRINFO,
                                       CNLINE,CNSTAT);
      RETURN;                # **** RETURN ****                        #
      END # CHKNAME # 
      CONTROL EJECT;
      PROC CHKTABL(CKTWORD,CKTLENG,CKTKWID,CKTSTID,CKTRINFO,
                                       CKTLINE,CKTSTAT);
      BEGIN 
*IF,DEF,IMS 
# 
**    CHKTABL - CHECK TABLE FOR LEGAL VALUE.
* 
*     D.K. ENDO    81/10/23 
* 
*     THIS PROCEDURE CHECKS A TABLE FOR THE CURRENT VALUE BEING CHECKED.
* 
*     PROC CHKTABL(CKTWORD,CKTKWID,CKTSTID,CKTRINFO,CKTLINE,CKTSTAT)
* 
*     ENTRY        CKTWORD = VALUE TO BE CHECKED IN TABLE.
*                  CKTKWID = CURRENT KEYWORD I.D. 
*                  CKTSTID = CURRENT STATEMENT I.D. 
*                  CKTRINFO = REPEAT INFORMATION. 
*                  CKTLINE = CURRENT SOURCE LINE NUMBER.
* 
*     EXIT         CKTSTAT = RETURNED STATUS (SET -TRUE- IF VALUE FOUND)
* 
*     METHOD
* 
*     POINT BASED ARRAY AT TABLE TO BE CHECKED.(DETERMINED BY KEYWORD)
*     SEARCH TABLE FOR VALUE. 
*     IF VALUE FOUND, 
*     THEN, 
*       SET CKTSTAT TO TRUE.
*     OTHERWISE,
*       SET CKTSTAT TO FALSE. 
*       FLAG ERROR. 
*     PUT VALUE-DECLARATION IN STATEMENT ENTRY. 
* 
# 
*ENDIF
      ITEM CKTWORD C(10);    # VALUE TO BE CHECKED IN TABLE            #
      ITEM CKTLENG;          # LENGTH OF VALUE                         #
      ITEM CKTKWID;          # KEYWORD I.D.                            #
      ITEM CKTSTID;          # CURRENT STATEMENT I.D.                  #
      ITEM CKTRINFO;         # REPEAT INFORMATION                      #
      ITEM CKTLINE;          # CURRENT LINE NUMBER                     #
      ITEM CKTSTAT B;        # RETURN STATUS OF BVALUE                 #
#                                                                      #
      ITEM FOUND B;          # FLAG INDICATING VALUE FOUND IN TABLE    #
      ITEM I;                # SCRATCH ITEM                            #
#                                                                      #
      BASED ARRAY TAB$TEMPLATE [0:0] S(1);
        BEGIN 
        ITEM ENTRY$CNT U(0,54,6); 
        ITEM TAB$VALUE C(0,0,10); 
        END 
#                                                                      #
      ARRAY LABEL$NAME [0:0] S(1);
        ITEM RIGHT$WORD C(0,18,7);     # VALUE IN RIGHT MOST 42 BITS   #
#                                                                      #
      DEF MXCSET # 10 #;
      ARRAY CSET$TABLE[0:MXCSET] S(1);
        BEGIN 
        ITEM CSCNT  U(0,54,6) = [MXCSET]; 
        ITEM CSVALUE C(0,0,10)= [,"BCD       ", 
                                  "ASCII     ", 
                                  "APLTP     ", 
                                  "APLBP     ", 
                                  "EBCD      ", 
                                  "EBCDAPL   ", 
                                  "CORRES    ", 
                                  "CORAPL    ", 
                                  "EBCDIC    ", 
                                  "CSET15    "
                                ];
        END 
      DEF MXCTYP # 2 #; 
      ARRAY CTYP$TABLE [0:MXCTYP] S(1); 
        BEGIN 
        ITEM CTPCNT   U(0,54,6) = [MXCTYP]; 
        ITEM CTPVALUE C(0,0,10) = [,"PVC       ", 
                                    "SVC       "
                                  ];
        END 
      DEF MXDT # 7 #; 
      ARRAY DT$TABLE [0:MXDT] S(1); 
        BEGIN 
        ITEM DTCNT   U(0,54,6) = [MXDT];
        ITEM DTVALUE C(0,0,10) = [,"CON       ",
                                   "CR        ",
                                   "LP        ",
                                   "CP        ",
                                   "PL        ",
                                   "DT12      ",
                                   "AP        " 
                                 ]; 
        END 
      DEF MXEBR # 4 #;
      ARRAY EBR$TABLE [0:MXEBR] S(1); 
        BEGIN 
        ITEM EBRCNT  U(0,54,6) = [MXEBR]; 
        ITEM EBR$VAL C(0,0,10) = [,"NO        ",
                                   "CR        ",
                                   "LF        ",
                                   "CL        " 
                                  ];
        END 
      DEF MXELO # 2 #;
      ARRAY ELO$TABLE [0:MXELO] S(1); 
        BEGIN 
        ITEM ELOCNT  U(0,54,6) = [MXELO]; 
        ITEM ELO$VAL C(0,0,10) = [,"EL        ",
                                   "EB        " 
                                 ]; 
        END 
      DEF MXIN # 3 #; 
      ARRAY IN$TABLE [0:MXIN] S(1); 
        BEGIN 
        ITEM INCNT   U(0,54,6) = [MXIN];
        ITEM INVALUE C(0,0,10) = [,"KB        ",
                                   "PT        ",
                                   "BK        " 
                                 ]; 
        END 
      DEF MXLINK # 2 #; 
      ARRAY LINK$TABLE [0:MXLINK] S(1); 
        BEGIN 
        ITEM LKCNT   U(0,54,6) = [MXLINK];
        ITEM LKVALUE C(0,0,10) = [,"LAP       ",
                                   "LAPB      " 
                                 ]; 
        END 
      DEF MXLOC # 2 #;
      ARRAY LOC$TABLE [0:MXLOC] S(1); 
        BEGIN 
        ITEM LCCNT   U(0,54,6) = [MXLOC]; 
        ITEM LCVALUE C(0,0,10) = [,"PRIMARY   ",
                                   "SECOND    " 
                                 ]; 
        END 
      DEF MXLSPEED # 11 #;
      ARRAY LSPEED$TABLE [0:MXLSPEED] S(1); 
        BEGIN 
        ITEM LSPDCNT   U(0,54,6) = [MXLSPEED];
        ITEM LSPDVALUE C(0,0,10) = [,"110       ",
                                     "134       ",
                                     "150       ",
                                     "300       ",
                                     "600       ",
                                     "1200      ",
                                     "2400      ",
                                     "4800      ",
                                     "9600      ",
                                     "19200     ",
                                     "38400     " 
                                   ]; 
        END 
      DEF MXLTYPE # 9 #;
      ARRAY LTYPE$TABLE [0:MXLTYPE] S(1); 
        BEGIN 
        ITEM LTYPECNT  U(0,54,6) = [MXLTYPE]; 
        ITEM LTYPE$VAL C(0,0,10) = [,"S1        ",
                                     "S2        ",
                                     "S3        ",
                                     "S4        ",
                                     "A1        ",
                                     "A2        ",
                                     "A6        ",
                                     "H1        ",
                                     "H2        " 
                                   ]; 
        END 
      DEF MXOP # 3 #; 
      ARRAY OP$TABLE [0:MXOP] S(1); 
        BEGIN 
        ITEM OPCNT   U(0,54,6) = [MXOP];
        ITEM OPVALUE C(0,0,10) = [,"PR        ",
                                   "DI        ",
                                   "PT        " 
                                 ]; 
        END 
      DEF MXPA # 5 #; 
      ARRAY PA$TABLE [0:MXPA] S(1); 
        BEGIN 
        ITEM PACNT   U(0,54,6) = [MXPA];
        ITEM PAVALUE C(0,0,10) = [,"Z         ",
                                   "O         ",
                                   "E         ",
                                   "N         " 
                                  ,"I         " 
                                 ]; 
        END 
      DEF MXPSN # 10 #; 
      ARRAY PSN$TABLE [0:MXPSN] S(1); 
        BEGIN 
        ITEM PSNCNT   U(0,54,6) = [MXPSN];
        ITEM PSNVALUE C(0,0,10) = [,"DATAPAC   ", 
                                    "TELENET   ", 
                                    "TRNSPAC   ", 
                                    "TYMNET    ", 
                                    "CDSN      ", 
                                    "UNINET    ", 
                                    "C120      ", 
                                    "PSN253    ", 
                                    "PSN254    ", 
                                    "PSN255    "
                                  ];
        END 
      DEF MXSDT # 11 #; 
      ARRAY SDT$TABLE [0:MXSDT] S(1); 
        BEGIN 
        ITEM SDTCNT   U(0,54,6) = [MXSDT];
        ITEM SDTVALUE C(0,0,10) = [,"A6        ", 
                                    "B6        ", 
                                    "A9        ", 
                                    "26        ", 
                                    "29        ", 
                                    "6BIT      ", 
                                    "8BIT      ", 
                                    "SDT12     ", 
                                    "SDT13     ", 
                                    "SDT14     ", 
                                    "SDT15     "
                                  ];
        END 
      DEF MXSTIP # 11 #;
      ARRAY STIP$TABLE [0:MXSTIP] S(1); 
        BEGIN 
        ITEM STIPCNT   U(0,54,6) = [MXSTIP];
        ITEM STIPVALUE C(0,0,10) = [,"M4A       ",
                                     "M4C       ",
                                     "2741      ",
                                     "N2741     ",
                                     "POST      ",
                                     "PRE       ",
                                     "PAD       ",
                                     "USER      ",
                                     "XAA       ",
                                     "2780      ",
                                     "3780      " 
                                   ]; 
        END 
      DEF MXTC # 24 #;
      ARRAY TC$TABLE [0:MXTC] S(1); 
        BEGIN 
        ITEM TCCNT   U(0,54,6) = [MXTC];
        ITEM TCVALUE C(0,0,10) = [,"M33       ",
                                   "713       ",
                                   "M40       ",
                                   "H2000     ",
                                   "751       ",
                                   "T4014     ",
                                   "2741      ",
                                   "HASP      ",
                                   "HPRE      ",
                                   "200UT     ",
                                   "734       ",
                                   "714X      ",
                                   "711       ",
                                   "714       ",
                                   "2780      ",
                                   "3780      ",
                                   "TC28      ",
                                   "TC29      ",
                                   "TC30      ",
                                   "TC31      ",
                                   "752       ",
                                   "721       ",
                                   "X364      ",
                                   "3270      " 
                                 ]; 
        END 
      DEF MXTIPTYPE # 9 #;
      ARRAY TPTYPE$TABLE [0:MXTIPTYPE] S(1);
        BEGIN 
        ITEM TTCNT   U(0,54,6) = [MXTIPTYPE]; 
        ITEM TTVALUE C(0,0,10) = [,"ASYNC     ",
                                   "MODE4     ",
                                   "HASP      ",
                                   "X25       ",
                                   "BSC       ",
                                   "TT12      ",
                                   "TT13      ",
                                   "TT14      ",
                                   "3270      " 
                                 ]; 
        END 
      DEF MXTSPEED # 11 #;
      ARRAY TSPEED$TABLE [0:MXTSPEED] S(1); 
        BEGIN 
        ITEM TSPDCNT   U(0,54,6) = [MXTSPEED];
        ITEM TSPDVALUE C(0,0,10) = [,"110       ",
                                     "134       ",
                                     "150       ",
                                     "300       ",
                                     "600       ",
                                     "1200      ",
                                     "2400      ",
                                     "4800      ",
                                     "9600      ",
                                     "19200     ",
                                     "38400     " 
                                   ]; 
        END 
      DEF MXYSNO # 2 #; 
      ARRAY YSNO$TABLE [0:MXYSNO] S(1); 
        BEGIN 
        ITEM YSNOCNT   U(0,54,6) = [MXYSNO];
        ITEM YSNOVALUE C(0,0,10) = [,"YES       ",
                                     "NO        " 
                                   ]; 
        END 
#                                                                      #
      SWITCH CKTJUMP              ,            , # UNK     , NODE     ,#
                                  , YES$NO     , # VARIANT , OPGO     ,#
                      YES$NO      ,            , # DMP     , LLNAME   ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  , LOC$       , # HNAME   , LOC      ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  , YES$NO     , # NCNAME  , DI       ,#
                                  ,            , # N1      , P1       ,#
                                  ,            , # N2      , P2       ,#
                      YES$NO      , YES$NO     , # NOLOAD1 , NOLOAD2  ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , # NI      , PORT     ,#
                      LINE$TYPE   , TIPTYPE    , # LTYPE   , TIPTYPE  ,#
                      YES$NO      ,            , # AUTO    , SL       ,#
                      LINE$SPEED  ,            , # LSPEED  , DFL      ,#
                                  ,            , # FRAME   , RTIME    ,#
                                  ,            , # RCOUNT  , NSVC     ,#
                      PSN         , YES$NO     , # PSN     , DCE      ,#
                                  , YES$NO     , # DTEA    , ARSPEED  ,#
                                  , YES$NO     , #         , IMDISC   ,#
                      YES$NO      ,            , # RC      ,          ,#
                      SUB$TIPTYPE , TERM$CLASS , # STIP    , TC       ,#
                      YES$NO      , CODE$SET   , # RIC     , CSET     ,#
                      TERM$SPEED  ,            , # TSPEED  , CA       ,#
                                  , YES$NO     , # CO      , BCF      ,#
                                  ,            , # MREC    , W        ,#
                      CIRC$TYPE   ,            , # CTYP    , NCIR     ,#
                                  , YES$NO     , # NEN     , COLLECT  ,#
                           YES$NO , DEVICE$TYPE, # XAUTO   , DT       ,#
                      SUB$DEV$TYPE,            , # SDT     , TA       ,#
                                  ,            , # ABL     , DBZ      ,#
                                  ,            , # UBZ     , DBL      ,#
                                  ,            , # UBL     , XBZ      ,#
                                  ,            , # DO      , STREAM   ,#
                                  ,            , # HN      , AUTOLOG  ,#
                      YES$NO      , YES$NO     , # AUTOCON , PRI      ,#
                                  ,            , # P80     , P81      ,#
                                  ,            , # P82     , P83      ,#
                                  ,            , # P84     , P85      ,#
                                  ,            , # P86     , P87      ,#
                                  ,            , # P88     , P89      ,#
                                  , YES$NO     , # AB      , BR       ,#
                                  ,            , # BS      , B1       ,#
                                  ,            , # B2      , CI       ,#
                                  ,            , # CN      , CT       ,#
                                  , YES$NO     , # DLC     , DLTO     ,#
                                  , YES$NO     , # DLX     , EP       ,#
                      INPUT$DEVICE,            , # IN      , LI       ,#
                      OUTPUT$DEV  , PARITY     , # OP      , PA       ,#
                      YES$NO      ,            , # PG      , PL       ,#
                                  , YES$NO     , # PW      , SE       ,#
                      YES$NO      ,            , # FA      , XLC      ,#
                                  , YES$NO     , # XLX     , XLTO     ,#
                      EOL$MODE    ,            , # ELO     , ELX      ,#
                      EB$RES      , EOL$MODE   , # ELR     , EBO      ,#
                      EB$RES      , YES$NO     , # EBR     , CP       ,#
                      YES$NO      , YES$NO     , # IC      , OC       ,#
                      YES$NO      ,            , # LK      , EBX      ,#
                                  ,            , #         , MC       ,#
                                  ,  YES$NO    , # XLY     ,  EOF     ,#
                                  ,  YES$NO    , # PAD     , RTS      ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , # MFAM    , MUSER    ,#
                                  ,            , # MAPPL   , DFAM     ,#
                                  ,            , # DUSER   , PFAM     ,#
                                  ,            , # PUSER   ,          ,#
                                  , YES$NO     , # PAPPL   , RS       ,#
                                  , YES$NO     , #         , NETXFR   ,#
                      YES$NO      , YES$NO     , # UID     , PRIV     ,#
                      YES$NO      , YES$NO     , # KDSP    , PRU      ,#
                                  ,            , # NAME1   , NAME2    ,#
                                  ,            , # SNODE   , DNODE    ,#
                                  ,            , # ACCLEV  , DHOST    ,#
                                  ,            , # DPLR    , DPLS     ,#
                                  ,            , # PRID    , UDATA    ,#
                                  ,            , # WR      , WS       ,#
                                  ,            , #         ,          ,#
                                  ,            , # FAM     , UNAME     #
                                  ,            , # FAC1    , FAC2     ,#
                                  ,            , # FAC3    , FAC4     ,#
                                  ,            , # FAC5    , FAC6     ,#
                                  ,            , # FAC7    , FAC8     ,#
                                  ,            , # FAC9    , FAC10    ,#
                                  ,            , # FAC11   , FAC12    ,#
                                  ,            , # FAC13   , FAC14    ,#
                                  ,            , # FAC15   , FAC16    ,#
                                  ,            , # FAC17   , FAC18    ,#
                                  ,            , # FAC19   , FAC20    ,#
                                  ,            , # FAC21   , FAC22    ,#
                                  ,            , # FAC23   , FAC24    ,#
                                  ,            , # FAC25   , FAC26    ,#
                                  ,            , # FAC27   , FAC28    ,#
                                  ,            , # FAC29   , FAC30    ,#
                                  ,            , # FAC31   , ANAME    ,#
                                  , YES$NO     ; # SHOST   ,FASTSEL    #
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      GOTO CKTJUMP[CKTKWID];
#                                                                      #
CODE$SET: 
      P<TAB$TEMPLATE> = LOC(CSET$TABLE); # POINT TEMPLATE TO TABLE     #
      GOTO CHECK$TABLE; 
CIRC$TYPE:  
      P<TAB$TEMPLATE> = LOC(CTYP$TABLE);
      GOTO CHECK$TABLE; 
EB$RES: 
      P<TAB$TEMPLATE> = LOC(EBR$TABLE); 
      GOTO CHECK$TABLE; 
EOL$MODE: 
      P<TAB$TEMPLATE> = LOC(ELO$TABLE); 
      GOTO CHECK$TABLE; 
DEVICE$TYPE:  
      P<TAB$TEMPLATE> = LOC(DT$TABLE);
      GOTO CHECK$TABLE; 
INPUT$DEVICE: 
      P<TAB$TEMPLATE> = LOC(IN$TABLE);
      GOTO CHECK$TABLE; 
LINE$SPEED: 
      P<TAB$TEMPLATE> = LOC(LSPEED$TABLE);
      GOTO CHECK$TABLE; 
LINE$TYPE:  
      P<TAB$TEMPLATE> = LOC(LTYPE$TABLE); 
      GOTO CHECK$TABLE; 
LINK: 
      P<TAB$TEMPLATE> = LOC(LINK$TABLE);
      GOTO CHECK$TABLE; 
LOC$: 
      P<TAB$TEMPLATE> = LOC(LOC$TABLE); 
      GOTO CHECK$TABLE; 
OUTPUT$DEV: 
      P<TAB$TEMPLATE> = LOC(OP$TABLE);
      GOTO CHECK$TABLE; 
PARITY: 
      P<TAB$TEMPLATE> = LOC(PA$TABLE);
      GOTO CHECK$TABLE; 
PSN:  
      P<TAB$TEMPLATE> = LOC(PSN$TABLE); 
      GOTO CHECK$TABLE; 
SUB$DEV$TYPE: 
      P<TAB$TEMPLATE> = LOC(SDT$TABLE); 
      GOTO CHECK$TABLE; 
SUB$TIPTYPE:  
      P<TAB$TEMPLATE> = LOC(STIP$TABLE);
      GOTO CHECK$TABLE; 
TERM$CLASS: 
      P<TAB$TEMPLATE> = LOC(TC$TABLE);
      GOTO CHECK$TABLE; 
TERM$SPEED: 
      P<TAB$TEMPLATE> = LOC(TSPEED$TABLE);
      GOTO CHECK$TABLE; 
TIPTYPE:  
      P<TAB$TEMPLATE> = LOC(TPTYPE$TABLE);
      GOTO CHECK$TABLE; 
YES$NO: 
      P<TAB$TEMPLATE> = LOC(YSNO$TABLE);
      GOTO CHECK$TABLE; 
#                                                                      #
CHECK$TABLE:                 # ONCE TEMPLATE IS SET, CHECK FOR VALUE   #
      CKTSTAT = FALSE;       # CLEAR RETURN STATUS                     #
      FOUND = FALSE;         # CLEAR FOUND FLAG                        #
      FOR I=1 STEP 1 UNTIL ENTRY$CNT[0] DO  # STEP THRU TABLE          #
        BEGIN 
        IF CKTWORD EQ TAB$VALUE[I]     # IF VALUE IS FOUND             #
        THEN
          BEGIN 
          FOUND = TRUE;      # SET FOUND FLAG                          #
          CKTSTAT = TRUE;    # SET RETURN STATUS TO O.K.               #
          END 
        END 
      RIGHT$WORD[0] = CKTWORD;         # PUT VALUE IN RIGHT MOST 42 BIT#
      ENTVAL(LABEL$NAME,CKTKWID,CKTSTID,CKTWORD,CKTLENG,CKTRINFO, 
               CKTLINE,CKTSTAT);
      IF NOT FOUND           # IF NOT A VALID VALUE                    #
      THEN
        BEGIN 
        ERRMS1(ERR10,CKTLINE,CKTWORD); # FLAG ERROR -- INVALID VALUE   #
        END 
      RETURN;                # **** RETURN ****                        #
      END # CHKTABL # 
      CONTROL EJECT;
      PROC CKDEFNAM(DFNAME,DFLAG,DFNLENG,DLINE,CDNSTAT);
      BEGIN                  # CHECK DEFINE NAME                       #
*IF,DEF,IMS 
# 
**    CKDEFNAM - CHECK FOR DEFINE NAME. 
* 
*     D.K. ENDO    81/10/26 
* 
*     THIS PROCEDURE CHECKS IF NAME IS IN DEFINE TABLE.  IF SO, THEN
*     SETS DEFINE FLAG AND POINTS TO DEFINE STRING TO BEGIN PARSING.
* 
*     PROC CKDEFNAM(DFNAME,DFLAG,DFNLENG,DLINE,CDNSTAT) 
* 
*     ENTRY        DFNAME = NAME TO BE CHECKED. 
*                  DFLAG  = DEFINE FLAG.
*                  DFNLENG = LENGTH IN DEFINE NAME IN CHARACTERS. 
*                  DLINE = CURRENT SOURCE LINE NUMBER.
* 
*     EXIT         DFLAG = DEFINE FLAG(SET -TRUE- IF NAME IN TABLE).
*                  DSTAT = RETURN STATUS(SET -TRUE- IF NAME IN TABLE).
* 
*     METHOD
* 
*     SEARCH DEFINE TABLE FOR NAME. 
*     IF NAME IS FOUND, 
*       SET CDNSTAT TO TRUE.
*       IF DFLAG IS SET,
*       THEN, 
*         FLAG ERROR. 
*         GET NEXT TOKEN. 
*       OTHERWISE,
*         SET DFLAG TO TRUE.
*         SET UP POINTERS AND COUNTER TO BEGIN PARSING DEFINE STRING. 
*         FLAG DEFINE ON SOURCE LINE. 
* 
# 
*ENDIF
      ITEM DFNAME C(10);     # DEFINE NAME TO GE CHECKED               #
      ITEM DFLAG B;          # DEFINE FLAG                             #
      ITEM DFNLENG;          # LENGTH OF DFNAME IN CHARACTERS          #
      ITEM DLINE;            # LINE NUMBER OF DEFINE NAME              #
      ITEM CDNSTAT B;        # SET TO TRUE IF DFNAME IS FOUND IN DT    #
 
      ITEM FOUND B;          # FLAG INDICATING DEFINE NAME WAS FOUND   #
      ITEM I;                # SCRATCH ITEM                            #
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      CDNSTAT = FALSE;       # INITIALIZE FLAG TO NOT FOUND            #
      FOUND = FALSE;         # INITIALIZE FOUND DEF-NAME FLAG          #
      FOR I=1 WHILE NOT FOUND AND I LS DTWC[0] DO 
        BEGIN                # LOOK FOR DEFINE NAME                    #
        IF DFNAME EQ DEFNAME[I]        # NAME FOUND IN TABLE           #
        THEN
          BEGIN 
          FOUND = TRUE; 
          END 
        ELSE                           # NAME NOT FOUND YET            #
          BEGIN 
          I = I + DEFWCNT[I] + 1;      # POINT TO BEGIN OF NEXT ENTRY  #
          END 
        END 
      IF FOUND
      THEN
        BEGIN 
        CDNSTAT = TRUE;      # RETURN STATUS OF FOUND                  #
        IF DFLAG
        THEN                 # NESTED DEFINE FOUND                     #
          BEGIN 
          ERRMS1(ERR12,DLINE,DFNAME); 
          LEXSCAN;           # GET NEXT TOKEN                          #
          END 
        ELSE
          BEGIN 
          CDNSTAT = TRUE;    # RETURN STATUS OF FOUND                  #
          DFLAG = TRUE;      # SET DEFINE FLAG                         #
          DCHARCNT = 0;      # INITIALIZE CHARACTER COUNT              #
          DSTRNG$WORD = 1;   # POINT TO 1ST WORD OF STRING             #
          P<DT$TEMPLATE> = LOC(DEFNAME[I]); # INITIALIZE TABLE POINTER #
          DEFCOL = DEFCOL - DFNLENG - 1; # REPLACE DFNAME WITH STRING  #
        INPDLINE[0] = "D";             # PUT -D- IN SOURCE LINE        #
        ESI$DEF[0] = "D";              # PUT -D- IN EXPANDED SOURCE    #
          CURCHAR$TEMP = CURCHAR;      # SAVE CURRENT CHAR IN SOURCE   #
          CURSTAT$TEMP = CURSTAT;      # SAVE CURRENT STAT OF CURCHAR  #
          GETDCHAR(CURCHAR,CURSTAT);   # GET 1ST CHAR IN DEF-STRING    #
          LEXSCAN;           # FORM FIRST ELEMENT IN DEFINE STRING     #
          END 
        END 
      RETURN;                # **** RETURN ****                        #
      END # CKDEFNAM #
      CONTROL EJECT;
      PROC CKGNAME(GNAME,NAMLENG,GPORT,CGNLINE,CGNSTAT);
      BEGIN 
*IF,DEF,IMS 
# 
**    CKGNAME - CHECK GENERATED NAME. 
* 
*     D.K. ENDO    81/10/26 
* 
*     THIS PROCEDURE CHECKS A GENERATED NAME TO BE VALID. IF VALID, THEN
*     ENTER INTO LABEL TABLE, OTHERWISE FLAG ERROR. 
* 
*     PROC CKGNAME(GNAME,NAMLENG,GPORT,CGNLINE,CGNSTAT) 
* 
*     ENTRY        GNAME = GENERATED NAME TO BE CHECKED.
*                  NAMLENG = LENGTH OF NAME IN CHARACTERS.
*                  GPORT = CURRENT PORT NUMBER. 
*                  CGNLINE = CURRENT SOURCE LINE NUMBER.
* 
*     EXIT         CGNSTAT = RETURNED STATUS(SET TRUE IF O.K.). 
* 
*     METHOD
* 
*     IF NAMLENG IS NOT TOO LONG, 
*     THEN, 
*       SEARCH LABEL TABLE FOR GENERATED NAME 
*       IF FOUND, 
*       THEN, 
*         FLAG ERROR. 
*         SET CGNSTAT TO FALSE. 
*       OTHERWISE,
*         SET CGNSTAT TO TRUE.
*         PUT NAME AND PORT IN ENTRY. 
*     OTHERWISE,
*       FLAG ERROR. 
*       SET CGNSTAT TO FALSE. 
* 
# 
*ENDIF
      ITEM GNAME C(10);      # GENERATED NAME                          #
      ITEM NAMLENG;          # LENGTH OF NAME IN CHARACTERS            #
      ITEM GPORT;            # PORT NUMBER ON -GROUP- STMT             #
      ITEM CGNLINE;          # LINE NUMBER                             #
      ITEM CGNSTAT B;        # STATUS RETURNED -- SET TRUE IF O.K.     #
#                                                                      #
      ITEM FOUND B;          # FLAG INDICATING DUPLICATE LABEL         #
      ITEM I;                # INTEGER TEMPORARY                       #
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      IF NAMLENG LQ 7        # NAME MUST BE 7 CHARACTERS OR LESS       #
      THEN
        BEGIN                # CHECK FOR DUPLICATE LABEL               #
        FOUND = FALSE;       # INITIALIZE FLAG                         #
        FOR I=1 STEP 1 WHILE I LQ LABLCNT[0] AND NOT FOUND DO 
          BEGIN              # SCAN TO END OF TABLE OR DUPLICATE LABEL #
          IF GNAME EQ LABLNAM[I]
          THEN               # GENERATED NAME ALREADY IN LABEL TABLE   #
            BEGIN 
            FOUND = TRUE;    # SET FOUND FLAG                          #
            CGNSTAT = FALSE; # SET RETURN STATUS                       #
            ERRMS1(ERR1,CGNLINE,GNAME);# FLAG ERROR                    #
            END 
          END 
        IF NOT FOUND         # LABEL IS NOT DUPLICATE                  #
        THEN
          BEGIN 
          CGNSTAT = TRUE;    # SET RETURN STATUS                       #
          IF LABLCNT[0] GQ LT$LENG - 1 # NEED MORE TABLE SAPCE         #
          THEN
            BEGIN 
            SSTATS(P<LABEL$TABLE>,500); 
            END 
          LABLCNT[0] = LABLCNT[0] + 1; # INCREMENT ENTRY COUNT         #
          LABEL$WORD[LABLCNT[0]] = 0;  # CLEAR ENTRY WORD              #
          LABLNAM[LABLCNT[0]] = GNAME; # STORE LABEL-NAME              #
          LABLPORT[LABLCNT[0]] = GPORT;# STORE PORT --                 #
                                       #   ZERO IF NOT APPLICABLE      #
          END 
        END 
      ELSE                   # NAME IS TOO LONG                        #
        BEGIN 
        ERRMS1(ERR31,CGNLINE,GNAME);   # FLAG ERROR                    #
        CGNSTAT = FALSE;     # SET RETURN STATUS                       #
        END 
      RETURN;                # **** RETURN ****                        #
      END # CKGNAME # 
      CONTROL EJECT;
      PROC CKKWD(KWDNAME,KWDSTMT,KWDNEX,KWDLXID,KWDMAP,KWDRINFO,
                                   KWDLINE,KWDSTAT);
      BEGIN                  # CHECK KEYWORD                           #
*IF,DEF,IMS 
# 
**    CKKWD - CHECK KEYWORD.
* 
*     D.K. ENDO    81/10/26 
* 
*     THIS PROCEDURE CHECKS THE CURRENT KEYWORD TO BE VALID AND ALLOWED 
*     ON CURRENT STATEMENT. 
* 
*     PROC CKKWD(KWDNAME,KWDSTMT,KWDNEX,KWDLXID,KWDMAP,KWDRINFO,
*                                  KWDLINE,KWDSTAT) 
* 
*     ENTRY        KWDNAME = KEYWORD NAME TO BE CHECKED.
*                  KWDSTMT = CURRENT STATEMENT. 
*                  KWDNEX =  NEXT TOKEN.
*                  KWDLXID = CURRENT LEXICAL I.D. 
*                  KWDMAP = KEYWORD ALLOWED MAP.
*                  KWDRINFO = REPEAT INFORMATION. 
*                  KWDLINE = CURRENT SOURCE LINE NUMBER.
* 
*     EXIT         KWDSTAT = RETURNED STATUS(SET TO TRUE IF O.K.).
* 
*     METHOD
* 
*     IF KWDNAME IS A KEYWORD,
*     THEN, 
*       IF KEYWORD IS ALLOWED ON CURRENT STATEMENT, 
*       THEN, 
*         IF VALUE IS REQUIRED
*         THEN, 
*           IF KWDNEX IS AN EQUAL SIGN
*           THEN, 
*             SET KWDSTAT TO TRUE.
*           OTHERWISE,
*             FLAG ERROR. 
*             SET KWDSTAT TO FALSE. 
*         OTHERWISE,
*           SET KWDSTAT TO TRUE.
*           IF KWDNEX IS NOT AN EQUAL SIGN, 
*             PUT VALUE-DECLARATION INTO STATEMENT ENTRY. 
*       OTHERWISE,
*         SET KWDSTAT TO FALSE. 
*         FLAG ERROR. 
*     OTHERWISE,
*       SET KWDSTAT TO FALSE. 
*       FLAG ERROR. 
* 
# 
*ENDIF
      ITEM KWDNAME C(10);    # KEYWORD NAME                            #
      ITEM KWDNEX C(10);     # NEXT WORD FORMED BY LEXSCAN             #
      ITEM KWDRINFO;         # REPEAT INFORMATION                      #
      ITEM KWDLINE;          # KEYWORD LINE NUMBER                     #
      ITEM KWDSTAT B;        # STATUS RETURNED TO SUBR                 #
      ARRAY KWDSTMT [0:0] S(1);        # CURRENT STATEMENT             #
        BEGIN 
        ITEM KWDSTID U(0,0,9);         # CURRENT STATEMENT-ID          #
        END 
      ARRAY KWDLXID [0:0] S(1);        # KEYWORD LEXICAL-ID            #
        BEGIN 
        ITEM KWDFLAG B(0,48,1);        # KEYWORD FLAG                  #
        ITEM KWDVREQ B(0,49,1);        # VALUE REQUIRED FLAG           #
        ITEM KWDID   U(0,51,9);        # KEYWORD-ID                    #
        END 
      ARRAY KWDMAP [0:0] S(1);
        BEGIN 
        ITEM KMAP U(0,30,30);          # KEYWORD ALLOWED MAP           #
        END 
      ARRAY LABEL$NAME [0:0] S(1);
        ITEM RIGHT$WORD C(0,18,7);     # VALUE IN RIGHT MOST 42 BITS   #
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      IF KWDFLAG[0]          # IF THIS IS A LEGAL KEYWORD              #
      THEN
        BEGIN 
        IF B<KWDSTID[0],1>KMAP[0] EQ 1 # IF ALLOWED ON CURRENT STMT    #
        THEN
          BEGIN 
          IF KWDVREQ[0]      # IF VALUE IS REQUIRED                    #
          THEN
            BEGIN 
            IF KWDID[0] EQ KID"SERVICE" 
              OR KWDID[0] EQ KID"DOMAIN"
            THEN
              BEGIN 
              PERIOD$SKIP = TRUE;  # TURN ON SKIP PERIOD FLAG          #
              END 
            IF KWDNEX EQ "=" # IF NEXT ELEMENT IS AN EQUAL             #
            THEN             #   ASSUME A VALUE FOLLOWS                #
              BEGIN 
              KWDSTAT = TRUE;# RETURN A STATUS OF O.K.                 #
              END 
            ELSE             # NO EQUAL                                #
              BEGIN          #   ASSUME NO VALUE WAS SPECIFIED         #
              KWDSTAT = FALSE;         # RETURN ERROR STATUS           #
              IF KWDID[0] EQ KID"AL"   # IF KEYWORD IS AL              #
              THEN
                BEGIN 
                ERRMS1(ERR43,KWDLINE,KWDNAME); # FLAG WARNING          #
                END 
              ELSE
                BEGIN 
                ERRMS1(ERR30,KWDLINE,KWDNAME); # FLAG ERROR OTHERWISE  #
                END 
              ENTVAL(" ",KWDID[0],KWDSTID[0]," ",0,KWDRINFO,
                       KWDLINE,KWDSTAT);
              END 
            END 
          ELSE               # VALUE IS NOT REQUIRED                   #
            BEGIN 
            KWDSTAT = TRUE;  # SET RETURN STATUS TO O.K.               #
            IF KWDNEX NQ "=" # IF NEXT ELEMENT IS NOT AN EQUAL         #
            THEN             #   ASSUME NO VALUE WAS SPECIFIED         #
              BEGIN 
              RIGHT$WORD[0] = "YES";   # PUT VAL IN RIGHT MOST 42 BITS #
              ENTVAL(LABEL$NAME,KWDID[0],KWDSTID[0],
                  "YES",3,KWDRINFO,KWDLINE,KWDSTAT);
              END 
            END 
          END 
        ELSE                 # KEYWORD NOT ALLOWED ON CURRENT STMT     #
          BEGIN 
          KWDSTAT = FALSE;   # RETURN ERROR STATUS                     #
          ERRMS1(ERR29,KWDLINE,KWDNAME);#FLAG ERROR -- KWD NOT ALLOWED #
          END 
        END 
      ELSE                   # NOT A VALID KEYWORD                     #
        BEGIN 
        KWDSTAT = FALSE;               # RETURN ERROR STATUS           #
        ERRMS1(ERR9,KWDLINE,KWDNAME);  # FLAG ERROR -- INVALID KEYWORD #
        END 
      RETURN;                # **** RETURN ****                        #
      END # CKKWD # 
      CONTROL EJECT;
      PROC CKLNAME(LBLNAME,LBLTYPE,LBLLXID,LBLLENG,LBLKLBL, 
                                        LBLNWRD,LBLLINE,LBLSTAT); 
*IF,DEF,IMS 
# 
**    CKLNAME = CHECK LABEL NAME. 
* 
*     D.K. ENDO    81/10/26 
* 
*     THIS PROCEDURE CHECKS A LABEL TO BE VALID.
* 
*     PROC CKLNAME(LBLNAME,LBLTYPE,LBLLXID,LBLLENG,LBLKLBL, 
*                                       LBLNWRD,LBLLINE,LBLSTAT)
* 
*     ENTRY        LBLNAME = LABEL NAME TO BE CHECKED.
*                  LBLTYPE = SYNTACTICAL TYPE FOR LABEL NAME. 
*                  LBLLXID = LEXICAL I.D. FOR LABEL NAME. 
*                  LBLLENG = LENGTH OF LABEL NAME IN CHARACTERS.
*                  LBLKLBL = SET IF LABEL IS A KEYWORD. 
*                  LBLNWRD = NEXT WORD AFTER LABEL. 
*                  LBLLINE = CURRENT SOURCE LINE NUMBER.
* 
*     EXIT         LBLSTAT = RETURNED STATUS(SET -TRUE- IF LABEL) 
* 
*     METHOD
* 
*     SELECT THE CASE THAT APPLIES: 
*       CASE 1(LBLTYPE = NAME): 
*         IF LENGTH OF LABEL IS TOO LONG, 
*           SET LBLSTAT TO FALSE. 
*           SET LERR$CODE.
*       CASE 2(LBLTYPE = KEYWORD):  
*         IF LABEL IS A DELIMITER,
*         THEN, 
*           SET LBLSTAT TO TRUE 
*           SET LERR$CODE.
*         OTHERWISE,
*           IF NEXT WORD IS A COLON,
*           THEN, 
*             SET LBLKLBL TO TRUE.
*             IF LENGTH OF LABEL IS TOO LONG, 
*               SET LBLSTAT TO FALSE. 
*               SET LERR$CODE.
*           OTHERWISE,(MUST BE A STATEMENT NAME.
*             CLEAR LBLNAME.
*             SET LBLSTAT TO FALSE. 
*             CLEAR LERR$CODE.
*       CASE 3(LBLTYPE = NUMBER): 
*         SET LBLSTAT TO FALSE. 
*         SET LERR$CODE.
*       CASE 4(LBLTYPE = UNKNOWN):  
*         SET LBLSTAT TO FALSE. 
*         SET LERR$CODE.
* 
# 
*ENDIF
      BEGIN                  # CHECK LABEL NAME                        #
      ITEM LBLNAME C(10);    # LABEL-NAME                              #
      ITEM LBLTYPE;          # SYNTACTICAL TYPE OF LABEL-NAME          #
      ITEM LBLLXID;          # LEXICAL ID OF LABEL-NAME                #
      ITEM LBLLENG;          # LENGTH OF LABEL-NAME IN CHARACTERS      #
      ITEM LBLKLBL B;        # SET IF LABEL IS A KEYWORD               #
      ITEM LBLNWRD C(10);    # NEXT WORD AFTER LBLNAME                 #
      ITEM LBLLINE;          # LINE NUMBER OF LABEL                    #
      ITEM LBLSTAT B;        # STATUS RETURNED TO SUBR                 #
#                                                                      #
      ITEM CTEMP C(10);      # TEMPORARY FOR CHARACTER STRING          #
      ITEM I;                # INTEGER TEMPORARY FOR LOOP              #
      ITEM TYPE;             # TYPE FOR SWITCH                         #
      SWITCH LABELJUMP
        KEYWORD,             #  0 # 
        NAME,                #  1 # 
        ,,, 
        NUMBER,              #  5 # 
        ,,, 
        UNKNOWN,             #  9 # 
        , 
        EOF;                 # 11 # 
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      LBLSTAT = TRUE; 
      LBLKLBL = FALSE;       # CLEAR KEYWORD LABEL FLAG                #
      TYPE = LBLTYPE;        # SAVE LABEL TYPE IN TEMPORARY            #
      LERR$LINE = LBLLINE;   # SAVE LINE NUMBER                        #
      LERR$NAME = LBLNAME;   # SAVE LABEL NAME                         #
      IF LBLTYPE GQ 100      # IF LESS THAT 100, THEN TYPE EOF         #
      THEN                   #    TYPE EOF = 11                        #
        TYPE = TYPE - 100;   # SET UP TYPE FOR SWITCH                  #
      GOTO LABELJUMP[TYPE];  # CHECK LABEL-NAME BASED ON SYNTACTIC TYPE#
#                                                                      #
NAME: 
      IF LBLLENG GR 7 
      THEN
        BEGIN 
        LERR$CODE = ERR18;   # LABEL GREATER THAN SEVEN CHARACTERS     #
        LBLSTAT = FALSE;
        END 
      RETURN;                # **** RETURN ****                        #
#                                                                      #
KEYWORD:  
      IF B<50,1>LBLLXID EQ 1 # IF ONE, THEN CHARACTER MUST BE DELIM    #
      THEN                   #    FLAG ERROR                           #
        BEGIN 
        LERR$CODE = ERR8;    # PUNCTUATION ERROR                       #
        LBLSTAT = FALSE;
        IF LBLNAME EQ ":"    # IF DELIMITER IS ASTERISK                #
        THEN                 #    ASSUME USER FORGOT LABEL             #
          BEGIN 
          LEXSCAN;           # GET NEXT TOKEN -- HOPEFULLY A STMT NAME #
          END 
        LBLNAME = " ";       # CLEAR LABEL NAME                        #
        END 
      ELSE
        BEGIN 
        IF LBLNWRD EQ ":"    # IF NEXWORD IS A COLON, THEN ASSUME      #
        THEN                 #    KEYWORD IS A LABEL                   #
          BEGIN 
          LBLKLBL = TRUE;    # LABEL IS A KEYWORD                      #
          GOTO NAME;
          END 
        ELSE
          BEGIN 
          LBLNAME = " ";     # MUST BE STMT-NAME WITH NO LABEL         #
          LERR$CODE = 0;
          LBLSTAT = FALSE;
          END 
        END 
      RETURN;                # **** RETURN ****                        #
#                                                                      #
NUMBER: 
      LERR$CODE = ERR23;               # MUST BEGIN WITH A LETTER      #
      LBLSTAT = FALSE;
      RETURN;                # **** RETURN ****                        #
#                                                                      #
UNKNOWN:  
      IF LBLLENG EQ 1        # LENGTH OF ONE IMPLIES SPECIAL CHARACTER #
      THEN                   #    FLAG ERROR                           #
        BEGIN 
        LERR$CODE = ERR8;    # PUNCTUATION ERROR                       #
        LBLSTAT = FALSE;
        END 
      ELSE                   # MUST BE NAME GREATER THAN TEN CHARACTERS#
        BEGIN                #    IN LENGTH                            #
        LERR$CODE = ERR18;   # LABEL TOO LONG                          #
        LBLSTAT = FALSE;
        END 
      RETURN;                # **** RETURN ****                        #
#                                                                      #
EOF:  
      RETURN;                # **** RETURN ****                        #
#                                                                      #
      END # CKLNAME # 
      CONTROL EJECT;
      PROC CKSTMTDEC(SCSTMT,SNAME,SLXID,SMAP,SRPTINFO,SLINE,
                                  SL$STID,SSTAT); 
      BEGIN                  # CHECK STATEMENT DECLARATION             #
*IF,DEF,IMS 
# 
**    CKSTMTDEC - CHECK STATEMENT DECLARATION 
* 
*     D.K. ENDO    81/10/26 
* 
*     THIS PROCEDURE VALIDATES EACH STATEMENT DECLARATION.
* 
*     PROC CKSTMTDEC(SCSTMT,SNAME,SLXID,SMAP,SRPTINFO,SLINE,SL$STID,
*                    SSTAT) 
* 
*     ENTRY        SCSTMT = CURRENT STATEMENT INFORMATION(JUST LABEL).
*                  SNAME = STATEMENT NAME.
*                  SLXID = LEXICAL I.D. OF STATEMENT NAME.
*                  SMAP = STATEMENT ALLOWED BIT MAP.
*                  SRPTINFO = CURRENT REPEAT INFORMATION. 
*                  SLINE = CURRENT SOURCE LINE NUMBER.
*                  SL$STID = PREVIOUS STATEMENT-S I.D.
* 
*     EXIT         SRPTINFO = REPEAT INFORMATION. 
*                  SSTAT = RETURNED STATUS(SET -TRUE- IF STMT-DEC O.K.) 
* 
*     NOTE
* 
*     CKSTMTDEC ALSO SETS -SYNSECT-, WHICH STD USES TO DETERMINE WHICH
*     SYNTACTIC SECTION TO JUMP TO. 
* 
*     METHOD
* 
*     IF THERE IS A LABEL ERROR,
*     THEN, 
*       IF FIRST STATEMENT DIVISION OR IF STATEMENT NOT LFILE 
*         FLAG ERROR. 
* 
*     IF FLAG TO SCAN TO END OF DIVISION IS NOT SET,
*     THEN, 
*       INITIALIZE RETURN STATUS TO O.K.
*       IF STATEMENT FLAG IS NOT SET FOR THIS KEYWORD,
*       THEN, 
*         FLAG ERROR -- INVALID STATEMENT NAME. 
*         SET RETURN STATUS TO ERROR. 
*       OTHERWISE,
*         IF THIS IS FIRST STATEMENT IN DIVISION, 
*         THEN, 
*           IF STATEMENT IS NOT NFILE OR LFILE
*             FLAG ERROR -- FIRST STATEMENT MUST BE NFILE OR LFILE. 
*             SET SCAN TO END FLAG
*             SET RETURN STATUS TO ERROR. 
*         OTHERWISE,
*           IF THIS STATEMENT IS NOT ALLOWED TO BE AFTER PREVIOUS ONE,
*           THEN, 
*             FLAG ERROR -- STATEMENT OUT OF SEQUENCE.
*             IF STMT IS NOT NFILE,LFILE,OR END,
*               SET RETURN STATUS TO ERROR. 
*           OTHERWISE,
*             IF POSSIBLE STATEMENTS MISSING, 
*               FLAG ERROR -- POSSIBLE MISSING STMTS PRECEDING THIS ONE.
*         IF LABEL IS REQUIRED, 
*         THEN, 
*           IF LABEL WAS NOT SPECIFIED, 
*             FLAG ERROR -- REQUIRED ELEMENT NAME MISSING.
*             SET LABEL ERROR FLAG. 
*         OTHERWISE,
*           IF LABEL WAS SPECIFIED, 
*             FLAG ERROR -- LABEL NOT ALLOWED WITH STATEMENT. 
*             SET LABEL ERROR FLAG
*         IF RETURN STATUS IS O.K., 
*           SELECT CASE THAT APPLIES: 
*             CASE 1(LFILE,NFILE):  
*               IF THIS IS NOT FIRST STATEMENT IN FILE
*               THEN, 
*                 SET SYNSECT TO EXECUTE DIVISION TERMINATION CHECKS. 
*               OTHERWISE,
*                 IF NFILE STATEMENT, 
*                 THEN, 
*                   ALLOCATE TABLE SPACE. 
*                   CLEAR HEADERS IN TABLES.
*                   SET NCF FLAG. 
*                 OTHERWISE,
*                   SET LCF FLAG. 
*                 MAKE STATEMENT DECLARATION ENTRY. 
*                 PUT FILE NAME IN TITLE STRING BUFFER. 
*             CASE 2(TITLE) 
*               POINT TO BEGINNING OF STRING
*               SET SYNSECT TO STORE TITLE. 
*             CASE 3(NPU,LINE): 
*               CLEAR REPEAT INFO.
*               MAKE STATEMENT DECLARATION ENTRY. 
*             CASE 4(GROUP):  
*               CLEAR REPEAT INFO.
*               SET GROUP FLAG. 
*               MAKE STATEMENT DECLARATION ENTRY. 
*             CASE 5(TERMINAL,TERMDEV): 
*               CLEAR CIRCUIT COUNT 
*               IF LTYPE IS X25 
*                 SET SVC FLAG. 
*               MAKE STATEMENT DECLARATION ENTRY. 
*             CASE 6(END):  
*               SET SYNSECT TO DIVISION TERMINATION CHECKS. 
*               SET END FLAG. 
*             CASE 7(DEFINE): 
*               IF LABEL IS O.K.
*                 IF LABEL IS IN LABEL TABLE, 
*                 THEN, 
*                   FLAG ERROR -- DUPLICATE ELEMENT NAME. 
*                   SET RETURN STATUS TO ERROR. 
*                 IF LABEL IS KEYWORD,
*                   FLAG ERROR -- DEFINE CAN NOT BE KEYWORD.
*                   SET RETURN STATUS TO ERROR. 
*                 IF NOT ERRORS 
*                   PUT DEFINE NAME IN LABEL TABLE. 
*                   SET SYNSECT TO STORE DEFINE STRING. 
*               OTHERWISE,
*                 SET RETURN STATUS TO ERROR. 
*             CASE 8(SUPLINK,COUPLER,LOGLINK,DEVICE,TRUNK,
*                    USER,APPL,INCALL,OUTCALL): 
*               MAKE STATEMENT DECLARATION ENTRY. 
*               SET SYNSECT TO VALUE DECLARATION CHECK. 
*     OTHERWISE,
*       IF STATEMENT IS LFILE,NFILE,OR END
*       THEN, 
*         SET SYNSECT TO DIVISION TERMINATION CHECKS. 
*         SET RETURN STATUS TO O.K. 
*         IF END STATEMENT, 
*           SET END FLAG. 
*       OTHERWISE,
*         SET RETURN STATUS TO ERROR. 
* 
# 
*ENDIF
      ITEM SNAME C(10);      # STATEMENT-NAME                          #
      ITEM SLINE;            # STATEMENT LINE NUMBER                   #
      ITEM SL$STID;          # PREVIOUS STATEMENT-ID                   #
      ITEM SSTAT B;          # STATUS RETURNED TO SUBR                 #
      DEF MXSTMT # 31 #;
      ARRAY STMT$WRN$MAP [1:MXSTMT] S(1); 
        BEGIN 
        ITEM SAWMAP U(0,30,30) = [O"1760000000",    # NFILE    #
                                  O"1760000000",    # NPU      #
                                              0,    # SUPLINK  #
                                              0,    # COUPLER  #
                                              0,    # LOGLINK  #
                                  O"0060000000",    # GROUP    #
                                  O"0060000000",    # LINE     #
                                              0,    #          #
                                              0,    # TERMINAL #
                                              0,    # DEVICE   #
                                              0,    # TRUNK    #
                                  O"1760000000",    # LFILE    #
                                              0,    # USER     #
                                              0,    # APPL     #
                                              0,    # OUTCALL  #
                                              0,    # INCALL   #
                                  O"1760000000",    # END      #
                                              0,    # TERMDEV  #
                                              0,    # DEFINE   #
                                              0,    # COMMENT  #
                                              0,    # TITLE    #
                                 ]; 
        END 
      ARRAY SCSTMT [0:0] S(1);         # CURRENT STATEMENT-INFO        #
        BEGIN 
        ITEM SCSTID U(0,0,9);          # STATEMENT-ID                  #
        ITEM SCEFLG B(0,15,1);         # LABEL ERROR FLAG              #
        ITEM SCKLBL B(0,16,1);         # SET IF LABEL IS A KEYWORD     #
        ITEM SCLABL C(0,18,7);         # LABEL NAME                    #
        END 
      ARRAY SLXID [0:0] S(1);          # STATEMENT LEXICAL-ID          #
        BEGIN 
        ITEM SFLAG B(0,45,1);          # STATEMENT FLAG                #
        ITEM SLREQ B(0,46,1);          # LABEL REQUIRED                #
        ITEM SID   U(0,51,9);          # STATEMENT-ID                  #
        END 
      ARRAY SMAP [0:0] S(1);
        BEGIN 
        ITEM SAMAP U(0,30,30);         # STATEMENT ALLOWED MAP         #
        END 
      ARRAY SRPTINFO [0:0] S(1);       # REPEAT INFORMATION            #
        BEGIN 
        ITEM SGFLAG  B(0,0,1);         # GROUP FLAG                    #
        ITEM SSVC    B(0,1,1);         # SVC FLAG                      #
        ITEM SPRTNUM U(0,6,9);         # PROT NUMBER                   #
        ITEM SGRPCNT U(0,15,9);        # GROUP COUNT                   #
        ITEM SNCIR   U(0,24,9);        # CIRCUIT COUNT                 #
        ITEM SRIWORD I(0,0,60); 
        END 
      DEF DEFINE # 2 #;      # VAL FOR SYNSECT TO CAUSE STORAGE OF DEF #
      DEF STMTDEC # 1 #;     # VALUE FOR SYNSECT TO CHECK STMT-DEC     #
      DEF TITLE  # 3 #;      # VALUE FOR SYNSECT TO STORE TITLE        #
      DEF TERM$  # 4 #;      # VAL FOR SYNSECT TO CAUSE PASS1 TO TRMNAT#
      DEF VALUDEC # 5 #;     # VAL FOR SYNSECT TO CHECK VALUE-DEC      #
      ITEM CTEMP C(10);      # CHARACTER TEMPORARY                     #
      ITEM FOUND B;          # FLAG  INDICATING LABEL WAS FOUND        #
      ITEM I;                # SCRATCH ITEM                            #
#                                                                      #
      SWITCH STMTJUMP 
        ,                    # NULL STATEMENT # 
        LFILE$NFILE,         # NFILE    # 
        NPU$LINE,            # NPU      # 
        STMT$ENTRY,          # SUPLINK  # 
        STMT$ENTRY,          # COUPLER  # 
        STMT$ENTRY,          # LOGLINK  # 
        GROUP$,              # GROUP    # 
        NPU$LINE,            # LINE     # 
        ,                    #          # 
        TERMINAL$,           # TERMINAL # 
        STMT$ENTRY,          # DEVICE   # 
        STMT$ENTRY,          # TRUNK    # 
        LFILE$NFILE,         # LFILE    # 
        STMT$ENTRY,          # USER     # 
        STMT$ENTRY,          # APPL     # 
        STMT$ENTRY,          # OUTCALL  # 
        STMT$ENTRY,          # INCALL   # 
        END$,                # END      # 
        TERMINAL$,           # TERMDEV  # 
        DEFINE$,             # DEFINE   # 
        COMMENT,             # COMMENT  # 
        TITLE$;              # TITLE    # 
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGIN HERE                           #
#                                                                      #
      IF SCEFLG[0] AND LERR$CODE NQ 0 
      THEN                   # HAS LABEL ERROR                         #
        BEGIN 
        IF FIRST$STMT OR NOT(SID[0] EQ STID"LFILE") 
        THEN
          BEGIN 
          ERRMS1(LERR$CODE,LERR$LINE,LERR$NAME);
          END 
        END 
 
      IF NOT SCN$TO$END      # IF NOT SCANNING TO END OF DIVISION      #
      THEN
        BEGIN 
        SSTAT = TRUE;        # INITIALIZE RETURN STATUS TO O.K.        #
        IF NOT SFLAG[0]      # IF THIS KEYWORD IS NOT A STMT-NAME      #
        THEN                 #   THEN FLAG ERROR AND IGNORE REST OF    #
          BEGIN              #   STATEMENT                             #
          ERRMS1(ERR2,SLINE,SNAME); 
          ERRMS1(ERR3,SLINE," "); 
          SSTAT = FALSE;
          END 
        ELSE
          BEGIN 
          IF FIRST$STMT AND NOT(SID[0] EQ STID"COMMENT")
          THEN               # IF THIS IS THE FIRST STMT IN THE        #
            BEGIN            #   DIVISION (BESIDES A COMMENT)          #
            IF NOT(SID[0] EQ STID"NFILE" OR SID[0] EQ STID"LFILE")
            THEN                       # SHOULD BE NFILE OR LFILE STMT #
              BEGIN                              # IF NOT, FLAG ERROR  #
              ERRMS1(ERR25,SLINE,SNAME);
              SCN$TO$END = TRUE;       # IGNORE REST OF DIVISION       #
              FIRST$STMT = FALSE;      # CLEAR FIRST STMT FLAG         #
              SSTAT = FALSE;           # RETURN ERROR STATUS           #
              END 
            END 
          ELSE               # NOT FIRST STATEMENT                     #
            BEGIN 
            IF B<SL$STID,1>SAMAP[0] NQ 1
            THEN             # STMT NOT ALLOWED AFTER LAST STMT        #
              BEGIN 
              ERRMS1(ERR14,SLINE,SNAME);#FLAG ERROR -- OUT OR SEQUENCE #
              IF NOT(SID[0] EQ STID"NFILE" OR 
                     SID[0] EQ STID"LFILE" OR 
                     SID[0] EQ STID"END$")
              THEN           # IF NOT NFILE, LFILE, OR END STMT        #
                BEGIN 
                SSTAT = FALSE;         # RETURN ERROR STATUS           #
                END                    # IGNORE REST OF STMT           #
              END 
            ELSE             # STMT IS ALLOWED AFTER LAST STMT         #
              BEGIN 
              IF B<SL$STID,1>SAWMAP[SID[0]] EQ 1
              THEN           # STMT DOES NOT USUALLY FOLLOW PREVIOUS   #
                BEGIN 
                ERRMS1(ERR40,SLINE,SNAME); # FLAG ERROR, MISSING STMTS #
                END 
              END 
            END 
          IF SLREQ[0]        # CHECK IF LABEL IS REQUIRED              #
          THEN               #   IF SO,                                #
            BEGIN 
            IF SCLABL[0] EQ BLANK      # IF LABEL WAS NOT SPECIFIED    #
            THEN                       #   THEN FLAG ERROR             #
              BEGIN 
              ERRMS1(ERR15,SLINE,SCLABL[0]);
              SCEFLG[0] = TRUE;        # SET LABEL ERROR FLAG          #
              END 
            END 
          ELSE
            BEGIN            # LABEL IS NOT REQUIRED                   #
            IF SCLABL[0] NQ " " # IF LABEL WAS SPECIFIED, FLAG ERROR   #
            THEN
              BEGIN 
              ERRMS1(ERR17,SLINE,SCLABL[0]);
              SCEFLG[0] = TRUE;        # SET LABEL ERROR FLAG          #
              SCLABL[0] = BLANK;       # CLEAR LABEL WORD              #
              END 
            END 
          IF SSTAT           # NO STATEMENT ERRORS DETECTED YET        #
          THEN
            BEGIN 
#                                                                      #
#                                                                      #
            GOTO STMTJUMP[SID[0]];     # JUMP TO STMT CHECK            #
#                                                                      #
COMMENT:  
            IF CURLINE EQ NEXLINE      # IF CHARACTER POINTER STILL ON #
            THEN                       #   SAME LINE AS COMMENT STMT   #
              BEGIN 
              LEXSNC;        # SKIP TO NEXT CARD/SOURCE-LINE           #
              LEXSCAN;       # FORM FIRST ELEMENT ON NEXT LINE         #
              END 
            SYNSECT = STMTDEC;        #SET SYNSECT TO STMT-DEC CHECKING#
            GOTO EXIT;       # **** RETURN ****                        #
LFILE$NFILE:  
            IF NOT FIRST$STMT # IF NOT FIRST STMT, THEN MUST BE END OF #
            THEN              #   DIVSION                              #
              BEGIN 
              SYNSECT = TERM$;  # SET SYNTACTIC SECTION                #
              END 
            ELSE
              BEGIN          # THIS IS THE FIRST NON COMMENT SENSED    #
              IF SID[0] EQ STID"NFILE" # GET SPACE FOR TABLES          #
              THEN
                BEGIN 
                SSTATS(P<CONSOLE$MAP>,MXCM);
                SSTATS(P<COUP$TABLE>,MXCOUP); 
                SSTATS(P<LLINK$TABLE>,MXLLINK*2); 
                SSTATS(P<LL$NODE$TABL>,MXLLINK);
                SSTATS(P<NPU$TABLE>,MXNPU); 
                SSTATS(P<TNI$TABLE>,MXTNI); 
                SSTATS(P<TNN$TABLE>,MXTNN); 
                CTWORD[0] = 0;         # CLEAR HEADER WORD             #
                LLTWORD[0] = 0; 
                LLTWORD1[0] = 0;
                LNTWORD[0] = 0; 
                NTWORD[0] = 0;
                TNIWORD[0] = 0; 
                TNNWORD[0] = 0; 
                TNNWORD1[0] = 0;
                FOR I=0 STEP 1 UNTIL CM$LENG-1
                DO           # CLEAR CONSOLE DEFINED BIT MAP           #
                  BEGIN 
                  CMWORD[I] = 0;
                  END 
                CMAP$B = 0;  # CLEAR BIT MAP POINTER                   #
                CMAP$W = 0; 
                NCFDIV = TRUE;         # SET NCF DIVISION FLAG         #
                END 
              ELSE                     # MUST BE LFILE STMT            #
                BEGIN 
                LCFDIV = TRUE;         # SET LCF DIVISION FLAG         #
                END 
              ENTLABL(SCLABL[0],SCEFLG,SID[0],SRPTINFO,SLINE);
                             # MAKE STATEMENT-DECLARATION ENTRY        #
              C<0,7>TITLE$WORD[0] = SCLABL[0]; # STORE LABEL AS TITLE  #
              SYNSECT = VALUDEC;       # SWITCH TO VALUE DECLARATION   #
              VAL$DEC = TRUE;          # SET VALUE-DEC FLAG            #
              FIRST$STMT = FALSE;      # CLEAR FIRST STMT FLAG         #
              END 
            GOTO EXIT;       # **** RETURN ****                        #
#                                                                      #
TITLE$: 
            COL = COL - (NEXLENG + 1); # MOVE TO BEGINNING OF STRING   #
            GETSCHAR(CURCHAR,LINE,CURSTAT); # GET 1ST CHAR IN STRING   #
            SYNSECT = TITLE  ; # SET SYNSECT TO STORE TITLE            #
            GOTO EXIT;       # **** RETURN ****                        #
#                                                                      #
NPU$LINE: 
            SRIWORD[0] = 0;  # CLEAR REPEAT INFO FLAGS AND VALUES      #
            CRNT$LTYPE = " ";          # CLEAR CURRENT LTYPE           #
            CRNT$TIP = " ";  # CLEAR CURRENT TIPTYPE                   #
            GOTO STMT$ENTRY;
#                                                                      #
GROUP$: 
            SRIWORD[0] = 0;  # CLEAR REPEAT INFO FLAGS AND VALUES      #
            SGFLAG[0] = TRUE;          # SET GROUP FLAG                #
            CRNT$LTYPE = " ";          # CLEAR CURRENT LTYPE           #
            CRNT$TIP = " ";  # CLEAR CURRENT TIPTYPE                   #
            GOTO STMT$ENTRY;
#                                                                      #
TERMINAL$:  
            SNCIR[0] = 0;              # CLEAR CIRCUIT COUNT           #
            IF CRNT$TIP EQ "X25" OR 
               ((CRNT$LTYPE EQ "H1" OR CRNT$LTYPE EQ "H2") AND
                C<0,3>CRNT$TIP EQ USER$TIP) 
            THEN
              BEGIN 
              SSVC[0] = TRUE;          # SET SVC FLAG - DEFAULT FOR X25#
              END 
            CMAP$B = CMAP$B + 1;       # POINT TO NEXT BIT POSITION    #
            IF CMAP$B GQ 60 
            THEN                       # IF PAST A WORD BOUND          #
              BEGIN 
              CMAP$B = 0;              # POINT TO BEGINNING OF WORD    #
              CMAP$W = CMAP$W + 1;     # POINT TO NEXT WORD            #
              IF CMAP$W GQ CM$LENG     # IF NEED MORE TABLE SPACE      #
              THEN
                BEGIN                  # ALLOCATE MORE SPACE           #
                SSTATS(P<CONSOLE$MAP>,10);
                FOR I=CMAP$W STEP 1 UNTIL CM$LENG-1 
                DO                     # CLEAR NEWLY ALLOCATED WORDS   #
                  BEGIN 
                  CMWORD[I] = 0;
                  END 
                END 
              END 
            GOTO STMT$ENTRY;
#                                                                      #
END$: 
            ENDFLAG = TRUE;  # SET FLAG THAT -END- WAS FOUND           #
            SYNSECT = TERM$;    # SET SYNSECT TO VALUE-DEC CHECK       #
            GOTO EXIT;
#                                                                      #
DEFINE$:  
            IF NOT SCEFLG[0] # IF LABEL IS O.K.                        #
            THEN
              BEGIN 
              FOUND = FALSE;
              IF SCKLBL[0]   # LABEL IS A KEYWORD                      #
              THEN
                BEGIN 
                CTEMP = SCLABL[0];
                ERRMS1(ERR16,SLINE,CTEMP);   # FLAG ERROR              #
                SCEFLG[0] = TRUE;      # SET LABEL ERROR FLAG          #
                SSTAT = FALSE;
                FOUND = TRUE; 
                END 
              FOR I=1 STEP 1 WHILE I LQ LABLCNT[0] AND NOT FOUND DO 
                BEGIN 
                IF LABLNAM[I] EQ SCLABL[0] # CHECK FOR DUPLICATE LABEL #
                THEN
                  BEGIN 
                  ERRMS1(ERR1,SLINE,SCLABL[0]); # FLAG ERROR           #
                  SCEFLG[0] = TRUE;    # SET LABEL ERROR FLAG          #
                  FOUND = TRUE;        # SET FOUND FLAG                #
                  SSTAT = FALSE;       # IGNORE REST OF STATEMENT      #
                  END 
                END 
              IF NOT FOUND   # LABEL WAS NOT FOUND IN LABEL-TABLE      #
              THEN
                BEGIN        # ENTER LABEL IN TABLE                    #
                IF LABLCNT[0] GQ LT$LENG - 1 # NEED MORE TABLE SPACE   #
                THEN
                  BEGIN 
                  SSTATS(P<LABEL$TABLE>,500); 
                  END 
                LABLCNT[0] = LABLCNT[0] + 1;
                LABEL$WORD[LABLCNT[0]] = 0; 
                LABLNAM[LABLCNT[0]] = SCLABL[0];
                SYNSECT = DEFINE; 
                END 
              END 
            ELSE
              SSTAT = FALSE;
            GOTO EXIT;
#                                                                      #
STMT$ENTRY: 
            ENTLABL(SCLABL[0],SCEFLG[0],SID[0],SRPTINFO,SLINE); 
                             # MAKE STATEMENT-DECLARATION ENTRY        #
            SYNSECT = VALUDEC;         # SET SYNSECT TO VALUE-DEC CHECK#
          VAL$DEC = TRUE;              # SET VALUE-DEC FLAG            #
EXIT: 
            END 
          END 
        END 
      ELSE                   # IGNORE DIVISION FLAG IS SET             #
        BEGIN 
        IF SID[0] EQ STID"NFILE" OR 
           SID[0] EQ STID"LFILE" OR 
           SID[0] EQ STID"END$" 
        THEN                 # IF STMT IS NFILE, LFILE, OR END         #
          BEGIN 
          SYNSECT = TERM$;   # TERMINATE PASS 1                        #
          SSTAT = TRUE;      # RETURN STATUS OF O.K.                   #
          IF SID[0] EQ STID"END$"      # END STATEMENT FOUND           #
          THEN
            BEGIN 
            ENDFLAG = TRUE;  # SET END FLAG                            #
            END 
          END 
        ELSE
          BEGIN 
          SSTAT = FALSE;     # IGNORE STATEMENT                        #
          END 
        END 
      RETURN;                # **** RETURN ****                        #
      END # CKSTMTDEC # 
      CONTROL EJECT;
      PROC CKVDEC(VKWID,VWRD,VLENG,VLINE,VCSTMT,VRPTINFO);
      BEGIN                  # CHECK VALUE DECLARATION                 #
*IF,DEF,IMS 
# 
**    CKVDEC - CHECK VALUE DECLARATION. 
* 
*     D.K. ENDO    81/10/23 
* 
*     THIS PROCEDURE VALIDATES THE CURRENT VALUE DECLARATION. 
* 
*     PROC CKVDEC(VKWID,VWRD,VLINE,VCSTMT,VRPTINFO) 
* 
*     ENTRY        VKWID = CURRENT KEYWORD I.D. 
*                  VWRD = CHARACTER VALUE.
*                  VLINE = CURRENT SOURCE LINE NUMBER.
*                  VCSTMT = CURRENT STATEMENT INFORMATION.
*                  VRPTINFO = REPEAT INFORMATION. 
* 
*     EXIT         NONE.
* 
*     METHOD
* 
*     THE TYPE OF CHECKING DONE IS DETERMINED BY A SWITCH ON KEYWORD
*     I.D.  THERE ARE FIVE TYPES OF VALUES: DECIMAL, HEXIDECIMAL
*     ALPHANUMERIC, NAME BEGINNING WITH A LETTER WITH THE REST ALPHA- 
*     NUMERIC, AND THE VALUE BEING CONTAINED IN A TABLE.  THE SWITCH
*     DETERMINES WHICH OF THE FIVE TYPES TO CHECK FOR.  SOME KEYWORDS 
*     CAN BE ASSIGNED A SPECIAL VALUE: -AUTOREC-, -CCP-, OR -NONE-. 
*     IF SO A CHECK FOR ONE OF THESE SPECIAL VALUES IS MADE BEFORE
*     CHECKING FOR ONE OF THE TYPES LISTED ABOVE. 
* 
# 
*ENDIF
      ITEM VKWID;            # KEYWORD-ID                              #
      ARRAY VWRD [0:25] S(1); 
        BEGIN 
        ITEM VWORDC1 C(0,0,01);# FIRST CHARACTER                       #
        ITEM VWORD0  U(0,0,60);# FIRST WORD                            #
        ITEM VWORD C(0,0,10);# VALUE WORD                              #
        END 
      ITEM VLENG;            # LENGTH OF VALUE TO BE CHECKED           #
      ARRAY VWRD1 [0:25] S(1);# STORAGE FOR CONVERSION                 #
        BEGIN 
        ITEM VWORDT C(0,0,10);# VALUE WORD                             #
        ITEM VWORDT0 I(0,0,60);# FIRST WORD                            #
        END 
      ITEM VLENG1;            # LENGTH AFTER CONVERSION                #
      ITEM FLAGDQ B;          # DOUBLE QUOTE FLAG                      #
      ITEM WDCT ;             # WORD COUNT FOR TEMP ARRAY              #
      ITEM BTCT ;             # CHAR INDEX FOR TEMP ARRAY              #
      DEF MXAT # 63 #;        # SIZE OF ASCII TABLE                    #
      ARRAY ASCII$TABLE [00:MXAT] S(1); # TABLE TO CONVERT DISPLAY CODE#
        BEGIN                           # TO TWO DC OF ASCII CODE      #
        ITEM A$CHAR C(00,48,02) = ["3A",          # COLON              #
                                   "41",          # A                  #
                                   "42",          # B                  #
                                   "43",          # C                  #
                                   "44",          # D                  #
                                   "45",          # E                  #
                                   "46",          # F                  #
                                   "47",          # G                  #
                                   "48",          # H                  #
                                   "49",          # I                  #
                                   "4A",          # J                  #
                                   "4B",          # K                  #
                                   "4C",          # L                  #
                                   "4D",          # M                  #
                                   "4E",          # N                  #
                                   "4F",          # O                  #
                                   "50",          # P                  #
                                   "51",          # Q                  #
                                   "52",          # R                  #
                                   "53",          # S                  #
                                   "54",          # T                  #
                                   "55",          # U                  #
                                   "56",          # V                  #
                                   "57",          # W                  #
                                   "58",          # X                  #
                                   "59",          # Y                  #
                                   "5A",          # Z                  #
                                   "30",          # 0                  #
                                   "31",          # 1                  #
                                   "32",          # 2                  #
                                   "33",          # 3                  #
                                   "34",          # 4                  #
                                   "35",          # 5                  #
                                   "36",          # 6                  #
                                   "37",          # 7                  #
                                   "38",          # 8                  #
                                   "39",          # 9                  #
                                   "2B",          # +                  #
                                   "2D",          # -                  #
                                   "2A",          # *                  #
                                   "2F",          # /                  #
                                   "28",          # (                  #
                                   "29",          # )                  #
                                   "24",          # $                  #
                                   "3D",          # =                  #
                                   "20",          # BLANK              #
                                   "2C",          # ,                  #
                                   "2E",          # .                  #
                                   "23",          # POUND              #
                                   "5B",          # [                  #
                                   "5D",          # ]                  #
                                   "25",          # %                  #
                                   "22",          # "                  #
                                   "5F",          # _                  #
                                   "21",          # !                  #
                                   "26",          # &                  #
                                   "27",          # '                  #
                                   "3F",          # ?                  #
                                   "3C",          # <                  #
                                   "3E",          # >                  #
                                   "40",          #                   # 
                                   "5C",          # \                  #
                                   "5E",          #                   # 
                                   "3A"           # SEMI COLON         #
                                  ];
        END 
      ITEM VLINE;            # VALUE LINE NUMBER                       #
      ARRAY VCSTMT [0:0] S(1);         # CURRENT STATEMENT-INFO        #
        BEGIN 
        ITEM VCSTID U(0,0,9);          # STATEMENT-ID                  #
        ITEM VCEFLG B(0,15,1);         # LABEL ERROR FLAG              #
        ITEM VCLABL C(0,18,7);         # LABEL-NAME                    #
        END 
      ARRAY VRPTINFO [0:0] S(1);       # REPEAT INFORMATION            #
        BEGIN 
        ITEM VGRPFLG B(0,0,1);         # GROUP FLAG                    #
        ITEM VSVC    B(0,1,1);         # SVC FLAG                      #
        ITEM VPRTNUM U(0,6,9);         # PORT NUMBER                   #
        ITEM VGRPCNT U(0,15,9);        # GROUP COUNT                   #
        ITEM VNCIR   U(0,24,9);        # CIRCUIT COUNT                 #
        END 
#                                                                      #
      DEF DEF$MXLENG # 7 #;  # DEFAULT MAXIMUM LENGTH OF VALUE         #
      DEF DEF$MXSTRING # 122 #; # DEFAULT MAXIMUN LENGTH OF STRING     #
 
      ITEM ITEMP;            # INTEGER TEMPORARY                       #
      ITEM MAXLENG;          # MAXIMUM LENGTH ALLOWED FOR CURRENT VALUE#
      ITEM VSTAT B;          # STATUS OF VALUE PASSED TO ENTVAL        #
      ITEM K;                # INTEGER TEMPORARY                       #
      ITEM I;                # INTEGER TEMPORARY                       #
      ITEM WDC;              # WORD COUNT                              #
      ITEM BTC;              # BYTE INDEX                              #
      ITEM CHARCOUNT;        # CHARACTER COUNT                         #
#                                                                      #
      ARRAY LABEL$NAME [0:0] S(1);
        BEGIN 
        ITEM RIGHT$WORD C(0,18,7);     # LABEL-NAME IN RIGHT 42 BITS   #
        END 
      DEF MXMLT # 8 #;       # SIZE OF MAXIMUM LENGTH TABLE            #
      ARRAY MXLENG$TBL [0:MXMLT] S(1);
        BEGIN 
        ITEM MXKWID I(00,00,30) = [KID"UNKNOWN",  # KEYWORD I.D.       #
                                   KID"NAME2",
                                   KID"UDATA",
                                   KID"DHOST",
                                   KID"SHOST",
                                   KID"ANAME",
                                   KID"PID",
                                   KID"PAD",
                                   KID"NETOSD"
                                  ];
        ITEM MXLENG I(00,30,30) = [0,         # MAXIMUM LENGTH         #
                                   3, 
                                   256, 
                                   2, 
                                   3, 
                                   7, 
                                   3, 
                                   64,
                                   3
                                  ];
        END 
#                                                                      #
      SWITCH VALUJUMP             , DECIMAL    , # UNK     , NODE     ,#
                      NAME        , TABLE      , # VARIANT , OPGO     ,#
                      TABLE       , NAME       , # DMP     , LLNAME   ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                      NAME        , TABLE      , # HNAME   , LOC      ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                      NAME        , TABLE      , # NCNAME  , DI       ,#
                      NAME        , HEXIDECIMAL, # N1      , P1       ,#
                      NAME        , HEXIDECIMAL, # N2      , P2       ,#
                      TABLE       , TABLE      , # NOLOAD1 , NOLOAD2  ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                      DECIMAL     , HEXIDECIMAL, # NI      , PORT     ,#
                      TABLE       , TABLE      , # LTYPE   , TIPTYPE  ,#
                      TABLE       , DECIMAL    , # AUTO    , AL       ,#
                      TABLE       , DECIMAL    , # LSPEED  , DFL      ,#
                      DECIMAL     , DECIMAL    , # FRAME   , RTIME    ,#
                      DECIMAL     , DECIMAL    , # RCOUNT  , NSVC     ,#
                      TABLE       , TABLE      , # PSN     , DCE      ,#
                      DECIMAL     , TABLE      , # DTEA    , ARSPEED  ,#
                      DECIMAL     , TABLE      , # LCN     , IMDISC   ,#
                      TABLE       ,            , # RC      ,          ,#
                      AUTO$TABLE  ,  CCP$TABLE , # STIP    , TC       ,#
                      TABLE       , AUTO$TABLE , # RIC     , CSET     ,#
                      AUTO$TABLE  , AUTO$HEX   , # TSPEED  , CA       ,#
                      AUTO$DEC    , TABLE      , # CO      , BCF      ,#
                      CCP$DEC     , DECIMAL    , # MREC    , W        ,#
                      TABLE       , DECIMAL    , # CTYP    , NCIR     ,#
                      DECIMAL     , CCP$TABLE  , # NEN     , COLLECT  ,#
                      TABLE       , TABLE      , # XAUTO   , DT       ,#
                      CCP$TABLE   , AUTO$HEX   , # SDT     , TA       ,#
                      DECIMAL     , DECIMAL    , # ABL     , DBZ      ,#
                      DECIMAL     , DECIMAL    , # UBZ     , DBL      ,#
                      DECIMAL     , DECIMAL    , # UBL     , XBZ      ,#
                      DECIMAL     , AUTO$DEC   , # DO      , STREAM   ,#
                      NONE$DEC    ,            , # HN      , AUTOLOG  ,#
                      TABLE       , TABLE      , # AUTOCON , PRI      ,#
                      HEXIDECIMAL , HEXIDECIMAL, # P80     , P81      ,#
                      HEXIDECIMAL , HEXIDECIMAL, # P82     , P83      ,#
                      HEXIDECIMAL , HEXIDECIMAL, # P84     , P85      ,#
                      HEXIDECIMAL , HEXIDECIMAL, # P86     , P87      ,#
                      HEXIDECIMAL , HEXIDECIMAL, # P88     , P89      ,#
                      CCP$HEX     , CCP$TABLE  , # AB      , BR       ,#
                      CCP$HEX     , CCP$HEX    , # BS      , B1       ,#
                      CCP$HEX     , CCP$DEC    , # B2      , CI       ,#
                      CCP$HEX     , CCP$HEX    , # CN      , CT       ,#
                      CCP$DEC     , CCP$TABLE  , # DLC     , DLTO     ,#
                      CCP$HEX     , CCP$TABLE  , # DLX     , EP       ,#
                      CCP$TABLE   , CCP$DEC    , # IN      , LI       ,#
                      CCP$TABLE   , CCP$TABLE  , # OP      , PA       ,#
                      CCP$TABLE   , CCP$DEC    , # PG      , PL       ,#
                      CCP$DEC     , CCP$TABLE  , # PW      , SE       ,#
                      CCP$TABLE   , CCP$DEC    , # FA      , XLC      ,#
                      CCP$HEX     , CCP$TABLE  , # XLX     , XLTO     ,#
                      CCP$TABLE   , CCP$HEX    , # ELO     , ELX      ,#
                      CCP$TABLE   , CCP$TABLE  , # ELR     , EBO      ,#
                      CCP$TABLE   , CCP$TABLE  , # EBR     , CP       ,#
                      CCP$TABLE   , CCP$TABLE  , # IC      , OC       ,#
                      CCP$TABLE   , CCP$HEX    , # LK      , EBX      ,#
                                  , HEXIDECIMAL, #         , MC       ,#
                      CCP$HEX     ,  TABLE     , # XLY     ,  EOF     ,#
                      HEXIDECIMAL , TABLE      , # PAD     , RTS      ,#
                      DECIMAL     , DECIMAL    , # MCI     , MLI      ,#
                      ALPHANUM    , ALPHSTRING , # NETOSD  , DOMAIN   ,#
                      ALPHSTRING  ,            , # SERVICE ,          ,#
                      ALPHANUM    , ALPHANUM$A , # MFAM    , MUSER    ,#
                      ALPHANUM    , ALPHANUM   , # MAPPL   , DFAM     ,#
                      ALPHANUM$A  , ALPHANUM   , # DUSER   , PFAM     ,#
                      ALPHANUM$A  ,            , # PUSER   ,          ,#
                      ALPHANUM    , TABLE      , # PAPPL   , RS       ,#
                      DECIMAL     , TABLE      , # MXCOPYS , NETXFR   ,#
                      TABLE       , TABLE      , # UID     , PRIV     ,#
                      TABLE       , TABLE      , # KDSP    , PRU      ,#
                      ALPHANUM    , ALPHANUM   , # NAME1   , NAME2    ,#
                      DECIMAL     , DECIMAL    , # SNODE   , DNODE    ,#
                      DECIMAL     , HEXIDECIMAL, # ACCLEV  , DHOST    ,#
                      DECIMAL     , DECIMAL    , # DPLR    , DPLS     ,#
                      HEXIDECIMAL , NONE$HEX   , # PRID    , UDATA    ,#
                      DECIMAL     , DECIMAL    , # WR      , WS       ,#
                      ALPHANUM    ,            , # PID     ,          ,#
                      ALPHANUM    , ALPHANUM$A , # FAM     , UNAME    ,#
                      HEXIDECIMAL , HEXIDECIMAL, # FAC1    , FAC2     ,#
                      HEXIDECIMAL , HEXIDECIMAL, # FAC3    , FAC4     ,#
                      HEXIDECIMAL , HEXIDECIMAL, # FAC5    , FAC6     ,#
                      HEXIDECIMAL , HEXIDECIMAL, # FAC7    , FAC8     ,#
                      HEXIDECIMAL , HEXIDECIMAL, # FAC9    , FAC10    ,#
                      HEXIDECIMAL , HEXIDECIMAL, # FAC11   , FAC12    ,#
                      HEXIDECIMAL , HEXIDECIMAL, # FAC13   , FAC14    ,#
                      HEXIDECIMAL , HEXIDECIMAL, # FAC15   , FAC16    ,#
                      HEXIDECIMAL , HEXIDECIMAL, # FAC17   , FAC18    ,#
                      HEXIDECIMAL , HEXIDECIMAL, # FAC19   , FAC20    ,#
                      HEXIDECIMAL , HEXIDECIMAL, # FAC21   , FAC22    ,#
                      HEXIDECIMAL , HEXIDECIMAL, # FAC23   , FAC24    ,#
                      HEXIDECIMAL , HEXIDECIMAL, # FAC25   , FAC26    ,#
                      HEXIDECIMAL , HEXIDECIMAL, # FAC27   , FAC28    ,#
                      HEXIDECIMAL , HEXIDECIMAL, # FAC29   , FAC30    ,#
                      HEXIDECIMAL , ALPHANUM   , # FAC31   , ANAME    ,#
                      HEXIDECIMAL , TABLE      ; # SHOST   , FASTSEL  ,#
#                                                                      #
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      VSTAT = TRUE;          # INITIALIZE FLAG                         #
      GOTO VALUJUMP[VKWID];  # JUMP TO APPROPRIATE CHECK               #
#                                                                      #
AUTO$DEC:                    # FALUE SHOULD BE -AUTO- OR DECIMAL       #
      IF VWORD[0] EQ "AUTOREC"  # IF VALUE IS -AUTOREC-                #
      THEN                   #   THEN MAKE VALUE-DECLARATION ENTRY     #
        BEGIN 
        RIGHT$WORD[0] = VWORD[0]; 
        ENTVAL(LABEL$NAME,VKWID,VCSTID[0],VWRD,VLENG,VRPTINFO,
                                            VLINE,VSTAT); 
        GOTO EXIT;
        END 
      ELSE                   # IF NOT -AUTO-                           #
        BEGIN 
        GOTO DECIMAL;        # CHECK FOR DECIMAL VALUE                 #
        END 
AUTO$HEX:                    # VALUE SHOULD BE -AUTO- OR HEXIDECIMAL   #
      IF VWORD[0] EQ "AUTOREC"  # IF VALUE IS -AUTOREC-                #
      THEN                   #   THEN MAKE VALUE-DECLARATION ENTRY     #
        BEGIN 
        RIGHT$WORD[0] = VWORD[0]; 
        ENTVAL(LABEL$NAME,VKWID,VCSTID[0],VWRD,VLENG,VRPTINFO,
                                            VLINE,VSTAT); 
        GOTO EXIT;
        END 
      ELSE                   # IF NOT -AUTO-                           #
        BEGIN 
        GOTO HEXIDECIMAL;    # CHECK FOR HEXIDECIMAL VALUE             #
        END 
AUTO$TABLE:                  # SHOULD BE -AUTO- OR IN A TABLE          #
      IF VWORD[0] EQ "AUTOREC"  # IF VALUE IS -AUTOREC-                #
      THEN                   #   THEN MAKE VALUE-DECLARATION ENTRY     #
        BEGIN 
        RIGHT$WORD[0] = VWORD[0]; 
        ENTVAL(LABEL$NAME,VKWID,VCSTID[0],VWRD,VLENG,VRPTINFO,
                                            VLINE,VSTAT); 
        GOTO EXIT;
        END 
      ELSE                   # IF NOT -AUTO-                           #
        BEGIN 
        GOTO TABLE;          # CHECK IF VALUE IS IN A TABLE            #
        END 
CCP$DEC:                     # SHOULD BE -CCP- OR DECIMAL VALUE        #
      IF VWORD[0] EQ "CCP"   # IF VALUE IS -CCP-                       #
      THEN                   #   THEN MAKE VALUE-DECLARATION ENTRY     #
        BEGIN 
        RIGHT$WORD[0] = VWORD[0]; 
        ENTVAL(LABEL$NAME,VKWID,VCSTID[0],VWRD,VLENG,VRPTINFO,
                                            VLINE,VSTAT); 
        GOTO EXIT;
        END 
      ELSE                   # IF NOT -CCP-                            #
        BEGIN 
        GOTO DECIMAL;        # CHECK FOR DECIMAL VALUE                 #
        END 
CCP$HEX:                     # SHOULD BE -CCP- OR HEXIDECIMAL VALUE    #
      IF VWORD[0] EQ "CCP"   # IF VALUE IS C-CCP-                      #
      THEN                   #   THEN MAKE VALUE-DECLARATION ENTRY     #
        BEGIN 
        RIGHT$WORD[0] = VWORD[0]; 
        ENTVAL(LABEL$NAME,VKWID,VCSTID[0],VWRD,VLENG,VRPTINFO,
                                            VLINE,VSTAT); 
        GOTO EXIT;
        END 
      ELSE                   # IF NOT -CCP-                            #
        BEGIN 
        GOTO HEXIDECIMAL;    # CHECK FOR HEXIDECIMAL VALUE             #
        END 
CCP$TABLE:                   # SHOULD BE -CCP- OR ENTRY IN A TABLE     #
      IF VWORD[0] EQ "CCP"   # IF VALUE IS -CCP-                       #
      THEN                   #   THEN MAKE VALUE-DECLARATION ENTRY     #
        BEGIN 
        RIGHT$WORD[0] = VWORD[0]; 
        ENTVAL(LABEL$NAME,VKWID,VCSTID[0],VWRD,VLENG,VRPTINFO,
                                            VLINE,VSTAT); 
        GOTO EXIT;
        END 
      ELSE                   # IF NOT -CCP-                            #
        BEGIN 
        GOTO TABLE;          # CHECK IF VALUE IS IN A TABLE            #
        END 
NONE$DEC:                    # SHOULD BE -NONE- OR DECIMAL VALUE       #
      IF VWORD[0] EQ "NONE"  # IF VALUE IS -NONE-                      #
      THEN                   # MAKE VALUE-DECLARATION ENTRY            #
        BEGIN 
        RIGHT$WORD[0] = VWORD[0]; 
        ENTVAL(LABEL$NAME,VKWID,VCSTID[0],VWRD,VLENG,VRPTINFO,
                                            VLINE,VSTAT); 
        GOTO EXIT;
        END 
      ELSE                   # IF NOT -NONE-                           #
        BEGIN 
        GOTO DECIMAL;        # CHECK FOR DECIMAL VALUE                 #
        END 
NONE$HEX:                    # SHOULD BE -NONE- OR DECIMAL VALUE       #
      IF VWORD[0] EQ "NONE"  # IF VALUE IS -NONE-                      #
      THEN                   # MAKE VALUE-DECLARATION ENTRY            #
        BEGIN 
        RIGHT$WORD[0] = VWORD[0]; 
        ENTVAL(LABEL$NAME,VKWID,VCSTID[0],VWRD,VLENG,VRPTINFO,
                                            VLINE,VSTAT); 
        GOTO EXIT;
        END 
      ELSE                   # IF NOT -NONE-                           #
        BEGIN 
        GOTO HEXIDECIMAL;    # CHECK FOR DECIMAL VALUE                 #
        END 
ALPHANUM:                    # VALUE SHOULD BE ALPHANUMERIC - NO ASTRSK#
      IF CURLXID EQ 999      # IF VALUE CONTAINS ASTERISK              #
      THEN
        BEGIN                # FLAG ERROR -- INVALID VALUE             #
        ERRMS1(ERR10,VLINE,VWORD[0]); 
        VSTAT = FALSE;                 # SET ERROR STATUS FLAG         #
        END 
ALPHANUM$A:                  # VALUE CAN CONTAIN ASTERISK              #
      MAXLENG = DEF$MXLENG;  # SET MAXIMUM LENGTH TO DEFAULT           #
      FOR ITEMP=0 STEP 1 UNTIL MXMLT
      DO                     # SEARCH TABLE FOR EXCEPTIONS TO DEFAULT  #
        BEGIN 
        IF VKWID EQ MXKWID[ITEMP] 
        THEN                 # IF KEYWORD I.D. IS FOUND                #
          BEGIN 
          MAXLENG = MXLENG[ITEMP];     # SAVE MAXIMUM LENGTH           #
          END 
        END 
      IF VLENG GR MAXLENG 
      THEN                   # IF VALUE IS TOO LONG                    #
        BEGIN                # FLAG ERROR -- NAME TOO LONG             #
        ERRMS1(ERR10,VLINE,VWORD[0]); 
        VSTAT = FALSE;       # SET ERROR STATUS                        #
        END 
      RIGHT$WORD[0] = VWORD[0]; 
      ENTVAL(LABEL$NAME,VKWID,VCSTID[0],VWRD,VLENG,VRPTINFO,
                                          VLINE,VSTAT); 
      GOTO EXIT;
ALPHSTRING: 
                             # CHECK FOR STRING VALUE                  #
      IF VLENG GR DEF$MXSTRING
      THEN
        BEGIN 
        ERRMS1(ERR10,VLINE,VWORD[0]); 
        VSTAT = FALSE;
        END 
      CHARCOUNT = 0;               # SET CHARACTER COUNT TO ZERO       #
      WDC = 0;
      BTC = 0;
      FOR K = 0 STEP 1 UNTIL VLENG-1
      DO
        BEGIN 
        IF C<BTC,1>VWORD[WDC] EQ "."
        THEN
          BEGIN 
          CHARCOUNT = 0;     # CLEAR CHARACTER COUNT                   #
          END 
        ELSE
          BEGIN 
          CHARCOUNT = CHARCOUNT + 1;
          IF CHARCOUNT GR 31  # PATH NAMES TOO LONG                    #
          THEN
            BEGIN 
            ERRMS1(ERR10,VLINE,VWORD[0]); 
            VSTAT = FALSE;
            GOTO ENT$;
            END 
          END 
        BTC = BTC + 1;       # BUMP CHAR INDEX                         #
        IF BTC GR 9 
        THEN
          BEGIN 
          BTC = 0;           # RESET BYTE COUNT                        #
          WDC = WDC + 1;     # BUMP WORD COUNT                         #
          END 
        END                  # END OF FOR                              #
ENT$: 
      ENTVAL(LABEL$NAME,VKWID,VCSTID[0],VWRD,VLENG,VRPTINFO,
                                         VLINE,VSTAT);
      GOTO EXIT;
DECIMAL:                     # CHECK FOR DECIMAL VALUE                 #
      CHKDEC(VWRD,VLENG,VKWID,VCSTID[0],ITEMP,VRPTINFO, 
             VLINE,VSTAT);
      GOTO EXIT;
HEXIDECIMAL:                 # CHECK FOR HEXIDECIMAL VALUE             #
      IF VKWID EQ KID"UDATA"
      THEN                   # IF KEYWORD IS UDATA                     #
        BEGIN 
      FLAGDQ = FALSE;              # RESET DOUBLE QUOTE FLAG           #
      WDC = 0;
      BTC = 0;
      FOR K = 0 STEP 1 UNTIL VLENG-1
      DO
        BEGIN 
        IF C<BTC,1>VWORD[WDC] EQ """"       # CHECK DOUBLE QUOTE       #
        THEN
          BEGIN 
          IF FLAGDQ                         # TOGGLE THE FLAG          #
           THEN 
             FLAGDQ = FALSE;
           ELSE 
             FLAGDQ = TRUE; 
          END 
        BTC = BTC + 1;       # BUMP CHAR INDEX                         #
        IF BTC GR 9 
        THEN
          BEGIN 
          BTC = 0;           # RESET BYTE COUNT                        #
          WDC = WDC + 1;     # BUMP WORD COUNT                         #
          END 
        END                  # END OF FOR LOOP                         #
      IF FLAGDQ              # IF THERE ARE ODD NUMBER OF DOUBLE QUOTE #
       THEN                  # THEN GIVE ERROR                         #
        BEGIN 
        ERRMS1(ERR45,VLINE,VWORD[0]);  # ODD NUMBER OF DOUBLE QUOTES   #
        GOTO EXIT;
        END 
      I = (VLENG -1 )/10;          # WORD INDEX                        #
      FOR K=0 STEP 1 UNTIL I       # COPY TO TEMP STORAGE              #
       DO 
       BEGIN
        VWORDT0 [K] = VWORD0 [K]; 
       END
#                                                                      #
#       IF ASCII CHARACTERS BETWEEN TWO DOUBLE QUOTES                  #
#       CONVERT CHARATER TO HEX, TWO DISPLAY CODES                     #
#                                                                      #
      WDC = 0;                              # RESET WORD AND CHAR      #
      BTC = 0;                              # INDEX FOR BOTH ARRAY     #
      WDCT = 0; 
      BTCT = 0; 
      VLENG1 = 0;                           # RESET LENGTH             #
      FOR K = 0 STEP 1 UNTIL VLENG-1
      DO
        BEGIN 
        IF C<BTCT,1>VWORDT[WDCT] EQ """"    # CHECK DOUBLE QUOTE       #
        THEN
          BEGIN 
          IF FLAGDQ                         # TOGGLE THE FLAG          #
           THEN 
             FLAGDQ = FALSE;
           ELSE 
             FLAGDQ = TRUE; 
          END 
        ELSE
          BEGIN 
          IF FLAGDQ                         # IF ONE DOULBE QUOTE      #
           THEN                             # THEN CONVERT             #
             BEGIN
             C<BTC,2>VWORD[WDC] = A$CHAR[C<BTCT,1>VWORDT[WDCT]];
             BTC = BTC + 2;                 # BUMP CHAR INDEX          #
             VLENG1 = VLENG1 + 2;           # BUMP LENGTH BY 2         #
             END
           ELSE                             # NO DOUBLE QUOTE FOUND    #
             BEGIN                          # NO CONVERSION            #
             C<BTC,1>VWORD[WDC] = C<BTCT,1>VWORDT[WDCT];
             BTC = BTC + 1;                 # BUMP CHAR INDEX          #
             VLENG1 = VLENG1 +1 ;           # BUMP LENGTH              #
             END
           END                                # NOT DOUBLE QUOTE       #
#                                                                      #
#       CHECK THE CONVERTED LENGTH                                     #
#                                                                      #
        IF VLENG1 GR 248     # IF CONVERTED LENGTH IS GREATER THAN 248 #
        THEN                 # THEN GIVE ERROR                         #
         BEGIN
         ERRMS1(ERR46,VLINE,VWORD[0]);  # CONVERTED UDATA TOO LONG     #
         GOTO EXIT; 
         END
#                                                                      #
#       RESET THE CHAR INDEX AND WORD COUNT FOR TEMP ARRAY             #
#                                                                      #
        BTCT = BTCT + 1;                    # BUMP CHAR INDEX          #
        IF BTCT GR 9
        THEN
         BEGIN
          BTCT = 0;                         # RESET BYTE COUNT         #
          WDCT = WDCT + 1;                  # BUMP WORD COUNT          #
          END 
#                                                                      #
#        RESET THE CHAR INDEX AND WORD COUNT FOR FINAL ARRAY           #
#                                                                      #
        IF BTC GR 9 
        THEN
          BEGIN 
          BTC = BTC - 10;                   # RESET BYTE COUNT         #
          WDC = WDC + 1;                    # BUMP WORD COUNT          #
          END 
        END                                 # END OF FOR LOOP          #
        VLENG = VLENG1;                     # RESET LENGTH             #
        IF VLENG GR MAXUDATA   # IF LENGTH GR MAXIMUM UDATA LENGTH     #
        THEN
          BEGIN 
          ERRMS1(ERR10,VLINE,VWORD[0]);  # FLAG -- VALUE TOO LONG      #
          VSTAT = FALSE;              # SET ERROR STATUS               #
          END 
        END 
      ELSE
        BEGIN 
        IF VKWID EQ KID"PAD"
        THEN                   # IF KEYWORD IS PAD                     #
          BEGIN 
          IF VLENG GR MAXPAD     # IF LENGTH GR MAXIMUM PAD LENGTH     #
          THEN
            BEGIN 
            ERRMS1(ERR10,VLINE,VWORD[0]);  # FLAG -- VALUE TOO LONG    #
            VSTAT = FALSE;              # SET ERROR STATUS             #
            END 
          IF B<58,2>VLENG NQ 0
          THEN
            BEGIN    # PAD VALUES MUST BE IN MULTIPLES OF 4 HEX DIGITS #
            ERRMS1(ERR44,VLINE,VWORD[0]); 
            VSTAT = FALSE;
            END 
          END 
        END 
      CHKHEX(VWRD,VLENG,VKWID,VCSTID[0],ITEMP,VRPTINFO, 
             VLINE,VSTAT);
      GOTO EXIT;
NAME:                        # VALUE SHOULD BE A NAME                  #
      CHKNAME(VWRD,VKWID,VCSTID[0],CURTYPE,VLENG,VRPTINFO,
                VLINE,VSTAT); 
      GOTO EXIT;
TABLE:                       # VALUE SHOULD BE IN A TABLE              #
      CHKTABL(VWRD,VLENG,VKWID,VCSTID[0],VRPTINFO,VLINE,VSTAT); 
      GOTO EXIT;
EXIT: 
      RETURN;                # **** RETURN ****                        #
      END # CKVDEC #
      CONTROL EJECT;
      PROC ENTLABL(LABEL$,LAB$ERR,STMT$ID,ELRPTINFO,ELLINE);
      BEGIN 
*IF,DEF,IMS 
# 
**    ENTLABL - ENTER LABEL INTO TABLES.
* 
*     D.K. ENDO    81/10/28 
* 
*     THIS PROCEDURE INITIALIZES THE STATEMENT TABLE ENTRY BUFFERS, 
*     CREATES THE HEADER FOR THE ENTRY, AND IF NECESSARY, MAKES 
*     ENTRIES INTO VARIOUS OTHER INTERNAL TABLES. 
* 
*     PROC ENTLABL(LABEL$,LAB$ERR,STMT$ID,ELLINE) 
* 
*     ENTRY        LABEL$ = LABEL/ELEMENT NAME. 
*                  LAB$ERR = LABEL ERROR FLAG.
*                  STMT$ID = STATEMENT I.D. 
*                  ELLINE = CURRENT SOURCE LINE NUMBER. 
* 
*     EXIT         NONE.
* 
*     METHOD
* 
*     CLEAR STATEMENT TABLE ENTRY BUFFER. 
*     SELECT CASE THAT APPLIES:  (STMT TABLE ENTRY) 
*       CASE 1(TERMINAL): 
*         CLEAR TERMINAL STMT ENTRY BUFFER. 
*         INITIALIZE TERMIANL HEADER. 
*       CASE 2(TERMDEV):  
*         CLEAR TERMINAL STMT ENTRY BUFFER. 
*         INITIALIZE TERMINAL HEADER. 
*         INITIALIZE DEVICE HEADER. 
*       CASE 3(DEVICE): 
*         INITIALIZE DEVICE HEADER. 
*       CASE 4(LINE,GROUP): 
*         INITIALIZE LINE HEADER. 
*       CASE 5(SUPLINK,OUTCALL,INCALL): 
*         INITIALIZE HEADER(NO LABEL ENTRY).
*       CASE 6(ALL OTHERS): 
*         INITIALIZE HEADER(WITH LABEL ENTRY).
*     SELECT CASE THAT APPLIES:  (OTHER TABLE ENTRIES)
*       CASE 1(NPU):  
*         MAKE ENTRY INTO NPU TABLE.
*       CASE 2(COUPLER):  
*         MAKE ENTRY INTO COUPLER TABLE.
*       CASE 3(LOGLINK):  
*         MAKE ENTRY INTO LOGLINK TABLE.
*       CASE 4(SUPLINK):  
*         SET SUPLINK FLAG IN CURRENT NPU TABLE ENTRY.
*       CASE 5(OTHERS): 
*         NULL. 
* 
# 
*ENDIF
      ITEM LABEL$ C(10);     # LABEL-NAME                              #
      ITEM LAB$ERR B;        # LABEL ERROR FLAG                        #
      ITEM STMT$ID;          # STATEMENT I.D.                          #
      ITEM ELLINE;           # LINE NUMBER OF STATEMENT                #
      ARRAY ELRPTINFO [0:0] S(1);      # REPEAT INFO                   #
        BEGIN 
        ITEM ELGFLAG B(0,0,1);         # GROUP FLAG                    #
        ITEM ELSVCFLG B(0,1,1);        # SVC FLAG                      #
        END 
#                                                                      #
      ITEM FOUND B;          # FLAG INDICATING LABEL WAS FOUND         #
      ITEM I;                # SCRATCH ITEM                            #
      ARRAY STMT$NAMES [0:21] S(1);  # ABBREVIATED STMT NAMES          #
        ITEM ST$NAME C(0,0,10) = ["UNK       ",     # NULL STMT # 
                                  "NFL       ",     # NFILE     # 
                                  "NPU       ",     # NPU       # 
                                  "SUP       ",     # SUPLINK   # 
                                  "CPL       ",     # COUPLER   # 
                                  "LLK       ",     # LOGLINK   # 
                                  "GRP       ",     # GROUP     # 
                                  "LIN       ",     # LINE      # 
                                  "UNK       ",     #           # 
                                  "TRM       ",     # TERMINAL  # 
                                  "DEV       ",     # DEVICE    # 
                                  "TRK       ",     # TRUNK     # 
                                  "LFL       ",     # LFILE     # 
                                  "USR       ",     # USER      # 
                                  "APP       ",     # APPL      # 
                                  "OTC       ",     # OUTCALL   # 
                                  "INC       ",     # INCALL    # 
                                  "UNK       ",     # END       # 
                                  "UNK       ",     # TERMDEV   # 
                                  "UNK       ",     # DEFINE    # 
                                  "UNK       ",     # COMMENT   # 
                                  "UNK       "      # TITLE     # 
                                 ]; 
      SWITCH EL1JUMP
        EL$EXIT,             # NULL STATEMENT # 
        OTHERS,              # NFILE    # 
        OTHERS,              # NPU     #
        NO$LABEL,            # SUPLINK  # 
        OTHERS,              # COUPLER  # 
        OTHERS,              # LOGLINK  # 
        LINE$GROUP,          # GROUP    # 
        LINE$GROUP,          # LINE     # 
        EL$EXIT,             #          # 
        EL$TERMINAL,         # TERMINAL # 
        DEVICE,              # DEVICE   # 
        OTHERS,              # TRUNK    # 
        OTHERS,              # LFILE    # 
        OTHERS,              # USER     # 
        OTHERS,              # APPL     # 
        NO$LABEL,            # OUTCALL  # 
        NO$LABEL,            # INCALL   # 
        EL$EXIT,             # END      # 
        TERMDEV,             # TERMDEV  # 
        EL$EXIT,             # DEFINE   # 
        EL$EXIT,             # COMMENT  # 
        EL$EXIT;             # TITLE    # 
      SWITCH EL2JUMP
        EL$EXIT,             # NULL STATEMENT # 
        EL$EXIT,             # NFILE    # 
        NPU,                 # NPU      # 
        SUPLINK,             # SUPLINK  # 
        COUPLER,             # COUPLER  # 
        LOGLINK,             # LOGLINK  # 
        EL$EXIT,             # GROUP    # 
        EL$EXIT,             # LINE     # 
        EL$EXIT,             #          # 
        EL$EXIT,             # TERMINAL # 
        EL$EXIT,             # DEVICE   # 
        TRUNK,               # TRUNK    # 
        EL$EXIT,             # LFILE    # 
        EL$EXIT,             # USER     # 
        EL$EXIT,             # APPL     # 
        EL$EXIT,             # OUTCALL  # 
        EL$EXIT,             # INCALL   # 
        EL$EXIT,             # END      # 
        EL$EXIT,             # TERMDEV  # 
        EL$EXIT,             # DEFINE   # 
        EL$EXIT,             # COMMENT  # 
        EL$EXIT;             # TITLE    # 
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      FOR I=0 STEP 1 UNTIL 2           # CLEAR STMT-TABLE BUFF HEADER  #
      DO
        STWORD[I] = 0;
#                                                                      #
#                                                                      #
      GOTO EL1JUMP[STMT$ID]; # MAKE STATEMENT TABLE ENTRY              #
#                                                                      #
EL$TERMINAL:  
      FOR I=0 STEP 1 UNTIL 2           # CLEAR TERMINAL STATEMENT BUFF #
      DO
        TBWORD[I] = 0;
      TBNAME[0] = ST$NAME[STID"TRMNL"];# SET ABBREV STMT NAME          #
      TBSTID[0] = STMT$ID;   # SET STATEMENT I.D. TO TERMINAL          #
      TBLINE[0] = ELLINE;    # SAVE LINE NUMBER OF STATEMENT           #
      TBWC[0] = 1;           # SET WORD COUNT TO ONE                   #
      TBCMB[1] = CMAP$B;     # SAVE POINTER TO CONSOLE MAP             #
      TBCMW[1] = CMAP$W;
      GOTO NEXT$JUMP; 
#                                                                      #
TERMDEV:  
      FOR I=0 STEP 1 UNTIL 2           # CLEAR TERMINAL STMT BUFFER    #
      DO
        TBWORD[I] = 0;
      TBNAME[0] = ST$NAME[STID"TRMNL"];# SET ABBREV STMT NAME          #
      TBSTID[0] = STID"TRMNL";# SET STATEMENT I.D. TO TERMINAL         #
      TBLINE[0] = ELLINE;    # SAVE LINE NUMBER OF STATEMENT           #
      TBWC[0] = 1;           # SET WORD COUNT TO ONE                   #
      TBCMB[1] = CMAP$B;     # SAVE POINTER TO CONSOLE MAP             #
      TBCMW[1] = CMAP$W;
#                                                                      #
DEVICE: 
      STNAME[0] = ST$NAME[STID"DEVICE"]; # SET ABBREV STMT NAME        #
      STSTID[0] = STID"DEVICE";        # SET STATEMENT I.D. TO DEVICE  #
      STLNUM[0] = ELLINE;    # SAVE LINE NUMBER OF STATEMENT           #
      STLABEL[1] = LABEL$;   # SAVE LABEL-NAME                         #
      STWC[0] = 2;           # SET WORD COUNT TO TWO                   #
      STLBERR[1] = LAB$ERR;  # SAVE LABEL ERROR FLAG                   #
      GOTO NEXT$JUMP; 
#                                                                      #
NO$LABEL: 
      STNAME[0] = ST$NAME[STMT$ID];    # SET ABBREV STMT NAME          #
      STSTID[0] = STMT$ID;   # SAVE STATEMENT I.D.                     #
      STLNUM[0] = ELLINE;    # SAVE LINE NUMBER OF STATEMENT           #
      STWC[0] = 0;           # WORD COUNT IS ZERO                      #
      GOTO NEXT$JUMP; 
#                                                                      #
LINE$GROUP: 
      STNAME[0] = ST$NAME[STMT$ID];    # SET ABBREV STMT NAME          #
      STSTID[0] = STMT$ID;   # SAVE STATEMENT I.D.                     #
      STLNUM[0] = ELLINE;    # SAVE LINE NUMBER                        #
      STWC[0] = 2;           # SET WORD COUNT TO TWO                   #
      STLABEL[1] = LABEL$;   # SAVE LABEL NAME                         #
      STLBERR[1] = LAB$ERR;  # SAVE LABEL ERROR FLAG                   #
      GOTO NEXT$JUMP; 
#                                                                      #
OTHERS: 
      STNAME[0] = ST$NAME[STMT$ID];    # SET ABBREV STMT NAME          #
      STSTID[0] = STMT$ID;   # SAVE STATEMENT I.D.                     #
      STLNUM[0] = ELLINE;    # SAVE LINE NUMBER OF STATEMENT           #
      STWC[0] = 1;           # SET WORD COUNT TO ONE                   #
      STLABEL[1] = LABEL$;   # SAVE LABEL NAME                         #
      STLBERR[1] = LAB$ERR;  # SABE LABEL ERROR FLAG                   #
#                                                                      #
#                                                                      #
NEXT$JUMP:                   # MAKE ENTRIES IN INTERNAL TABLES         #
      GOTO EL2JUMP[STMT$ID]; #   SWITCH BY STATEMENT I.D.              #
#                                                                      #
NPU:  
      IF (NTWC[0]*2) GQ NT$LENG - 1    # NEED MORE TABLE SPACE         #
      THEN
        BEGIN 
        SSTATS(P<NPU$TABLE>,30);
        END 
      NTCNP[0] = NTWC[0] + 1;          # POINT TO CURRENT NPU ENTRY    #
      NTWC[0] = NTWC[0] + NTENTSZ;     # INCREMENT ENTRY COUNT         #
      FOR I=NTWC[0] STEP -1 UNTIL NTCNP[0] DO 
        BEGIN                # CLEAR ENTRY                             #
        NTWORD[I] = 0;
        END 
      IF LAB$ERR                       # IF LABEL IS NOT O.K.          #
      THEN
        NTNAME[NTCNP[0]] = BLANK;      # CLEAR ENTRY NAME              #
      ELSE                   # LABEL IS O.K.                           #
        NTNAME[NTCNP[0]] = LABEL$;     # SAVE NPU NAME                 #
      GOTO EL$EXIT; 
#                                                                      #
COUPLER:  
      IF CTENT[0] GQ CT$LENG - 1       # NEED MORE TABLE SPACE         #
      THEN
        BEGIN 
        SSTATS(P<COUP$TABLE>,20); 
        END 
      CTENT[0] = CTENT[0] + 1;         # INCREMENT ENTRY COUNT         #
      CHNAME[0] = 0;                   # CLEAR COUPLER NAME            #
      CTWORD[CTENT[0]] = 0;            # CLEAR ENTRY WORD              #
      CTNID[CTENT[0]] = NTNID[NTCNP[0]];           # ENTER NPU I.D.    #
      IF LAB$ERR             # IF LABEL IS NOT O.K.                    #
      THEN
        CTNAME[CTENT[0]] = BLANK;      # CLEAR ENTRY NAME              #
      ELSE                             # LABEL IS O.K.                 #
        CTNAME[CTENT[0]] = LABEL$;     # SAVE COUPLER NAME             #
      GOTO EL$EXIT; 
#                                                                      #
LOGLINK:  
      IF LNTENT[0] GQ LNT$LENG - 1     # NEED MORE TABLE SPACE         #
      THEN
        BEGIN 
        SSTATS(P<LLINK$TABLE>,200); 
        SSTATS(P<LL$NODE$TABL>,100);
        END 
      LNTENT[0] = LNTENT[0] + 1;       # INCREMENT LNT ENTRY COUNT     #
      LLTENT[0] = LLTENT[0] + 1;       # INCREMENT LLT ENTRY COUNT     #
      LNTWORD[LNTENT[0]] = 0;          # CLEAR ENTRY WORD -- LNT       #
      LLTWORD[LLTENT[0]] = 0;          # CLEAR ENTRY WORD -- LLT       #
      LLTWORD1[LLTENT[0]] = 0;         # CLEAR ENTRY WORD 2 -- LLT     #
      LLTHNID[LLTENT[0]] = CTHNID[CTENT[0]];    # ENTER HOST NODE I.D. #
      LLTHNAME[LLTENT[0]] = CHNAME[0];          # ENTER HOST NAME      #
      IF LAB$ERR             # IF LABEL IS NOT O.K.                    #
      THEN
        LLTNAME[LLTENT[0]] = BLANK;    # CLEAR ENTRY NAME              #
      ELSE                   # LABEL IS O.K.                           #
        LLTNAME[LLTENT[0]] = LABEL$;   # SAVE LOGLINK NAME             #
      GOTO EL$EXIT; 
#                                                                      #
SUPLINK:  
      NTSPLK[NTCNP[0]] = TRUE;         # SUPLINK PRESENT FLAG          #
      GOTO EL$EXIT; 
 
TRUNK:  
      IF TNIWC[0] GQ TNI$LENG - 1      # NEED MORE TABLE SPACE         #
      THEN
        BEGIN 
        SSTATS(P<TNI$TABLE>,10);       # ALLOCATE MORE SPACE           #
        SSTATS(P<TNN$TABLE>,20);
        END 
      TNIWC[0] = TNIWC[0] + 1;         # INCREMENT ENTRY COUNT         #
      TNNEC[0] = TNNEC[0] + 1;
      TNIWORD[TNIWC[0]] = 0;           # CLEAR NEXT ENTRY              #
      TNNWORD[TNNEC[0]] = 0;
      TNNWORD1[TNNEC[0]] = 0; 
      GOTO EL$EXIT; 
#                                                                      #
EL$EXIT:  
 
      RETURN;                # **** RETURN ****                        #
      END # ENTLABL # 
      CONTROL EJECT;
      PROC ENTNID;
      BEGIN 
*IF,DEF,IMS 
# 
**    ENTNID - ENTER NODE I.D. INTO LOGICAL LINK TABLE. 
* 
*     D.K. ENDO    81/10/29 
* 
*     THIS PROCEDURE INSERTS A TERMINAL NODE I.D. INTO EACH ENTRY OF
*     THE LOGICAL LINK TABLE BASED ON A NAME IN THE CORRESPONDING ENTRY 
*     IN THE LOGICAL LINK NODE NAME TABLE.
* 
*     PROC ENTNID 
* 
*     ENTRY        NONE.
* 
*     EXIT         NONE.
* 
*     METHOD
* 
*     FOR EACH ENTRY IN THE LOGICAL LINK NODE NAME TABLE
*       SEARCH COUPLER TABLE FOR NODE NAME. 
*       IF FOUND, 
*       THEN, 
*         PUT NODE I.D. INTO CORRESPONDING ENTRY OF LOGICAL LINK TABLE. 
*       OTHERWISE,
*         SEARCH NPU TABLE FOR NODE NAME. 
*         IF FOUND, 
*           PUT NODE I.D. INTO LOGICAL LINK TABLE.
* 
# 
*ENDIF
      ITEM FOUND B;          # FLAG SET IF NAME IS FOUND               #
      ITEM I;                # SCRATCH ITEM                            #
      ITEM J;                # SCRATCH ITEM                            #
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      FOR I=1 STEP 1 UNTIL LNTENT[0] DO 
        BEGIN                # FOR EACH ENTRY IN THE LLINK-NODE-TABLE  #
        FOUND = FALSE;       # CLEAR FOUND FLAG                        #
        FOR J=1 STEP 1 WHILE J LQ CTENT[0] AND NOT FOUND DO 
          BEGIN              # SEARCH COUPLER TABLE FOR NAME           #
          IF CTNAME[J] EQ LNTNAME[I]
          THEN               # IF NAME IS FOUND IN COUPLER TABLE       #
            BEGIN 
            LLTNID[I] = CTHNID[J];     # PUT HNID OF COUPLER IN LLT    #
            FOUND = TRUE;    # SET FOUND FLAG                          #
            END 
          END 
        FOR J=1 STEP NTENTSZ WHILE J LS NTWC[0] AND NOT FOUND DO
          BEGIN              # SEARCH NPU TABLE FOR NAME IF NOT IN CT  #
          IF NTNAME[J] EQ LNTNAME[I]
          THEN               # IF NAME IS FOUND IN NPU TABLE           #
            BEGIN 
            LLTNID[I] = NTNID[J];      # PUT NID OF NPU IN LLT         #
            FOUND = TRUE;    # SET FOUND FLAG                          #
            END 
          END 
        END 
      FOR I=1 STEP 1 UNTIL TNNEC[0] 
      DO                               # FOR EACH ENTRY IN TNN TABLE   #
        BEGIN 
        FOR J=1 STEP NTENTSZ UNTIL NTWC[0]
        DO                             # FOR EACH ENTRY IN NPU TABLE   #
          BEGIN 
          IF TNNN1[I] EQ NTNAME[J]     # IF N1 VALUE MATCHES CRNT NAME #
          THEN
            BEGIN 
            TNIN1[I] = NTNID[J];       # PUT NODE I.D. IN TNI TABLE    #
            END 
          ELSE                         # NO MATCH ON -N1- VALUE        #
            BEGIN 
            IF TNNN2[I] EQ NTNAME[J]   # IF N2 VALUE MATCHES CRNT NAME #
            THEN
              BEGIN 
              TNIN2[I] = NTNID[J];     # PUT NODE I.D. IN TNI TABLE    #
              END 
            END 
          END 
        END 
      RETURN;                # **** RETURN ****                        #
      END # ENTNID #
      CONTROL EJECT;
      PROC ENTVAL(EVVALUE,EVKWID,EVSTID,EVNA,EVLENG,EVRINFO,
                                           EVLINE,EVSTAT);
      BEGIN 
*IF,DEF,IMS 
# 
**    ENTVAL - ENTER VALUE INTO TABLES. 
* 
*     D.K. ENDO    81/10/29 
* 
*     THIS PROCEDURE, BASED ON STATEMENT AND KEYWORD I.D., MAKES ENTRIES
*     INTO STATEMENT TABLE ENTRY BUFFER AND OTHER VARIOUS INTERNAL
*     TABLES. 
* 
*     PROC ENTVAL(EVVALUE,EVKWID,EVSTID,EVNA,EVRINFO,EVLINE,EVSTAT) 
* 
*     ENTRY        EVVALUE = VALUE TO BE ENTER INTO TABLE.
*                  EVKWID = KEYWORD I.D.
*                  EVSTID = STATEMENT I.D.
*                  EVNA = KEYWORD NAME. 
*                  EVRINFO = REPEAT INFORMATION.
*                  EVLINE = CURRENT SOURCE LINE NUMBER. 
*                  EVSTAT = STATUS(SET TRUE IF VALUE O.K.)
* 
*     EXIT         NONE.
* 
*     METHOD
* 
*     SELECT CASE THAT APPLIES: 
*       CASE 1(COUPLER):  
*         IF KEYWORD IS -NODE-, 
*           ENTER VALUE IN CURRENT COUPLER ENTRY. 
*       CASE 2(LOGLINK):  
*         IF KEYWORD IS -NCNAME-, 
*           ENTER VALUE IN CURRENT LOGICAL LINK NODE NAME TABLE ENTRY.
*       CASE 3(NPU):  
*         IF KEYWORD IS -NODE-, 
*           ENTER VALUE IN CURRENT NPU TABLE ENTRY. 
*       CASE 4(OTHER STMT-S): 
*         NULL. 
*     SELECT CASE THAT APPLIES: 
*       CASE 1(AUTO,DT,LTYPE,STIP,TC,TIPTYPE):  
*         PUT ORDINAL INTO ORDINAL WORD 
*       CASE 2(CTYP): 
*         IF VALUE IS -SVC-,
*           SET SVC FLAG IN REPEAT INFO.
*       CASE 3(NCIR,NI,PORT): 
*         SAVE VALUE AS PART OF REPEAT INFO.
*     IF NOT DUPLICATE VALUE DECLARATION, 
*     THEN, 
*       MAKE ENTRY INTO STATEMENT TABLE ENTRY BUFFER. 
*     OTHERWISE,
*       FIND ENTRY. 
*       REPLACE WITH NEW ENTRY
*       FLAG WARNING THAT ENTRY WAS REPLACED. 
* 
# 
*ENDIF
      DEF MAXSTRINGW # 14 #; # MAX WORD COUNT NEEDED FOR SERVICE/DOMAIN#
      ITEM EVKWID;           # KEYWORD I.D.                            #
      ITEM EVSTID;           # CURRENT STATEMENT I.D.                  #
      ARRAY EVNA [0:25] S(1); 
        BEGIN 
        ITEM EVVNAME C(0,0,10);        # CURRENT WORDS FROM SOURCE LINE#
        END 
      ITEM EVLENG;           # LENGTH OF VALUE                         #
      ITEM EVLINE;           # LINE NUMBER OF VALUE FOR KEYWORD        #
      ITEM EVSTAT B;         # STATUS OF VALUE ENTRY                   #
      ARRAY EVVALUE [0:0] S(1);        # VALUE TO BE ENTERED           #
        BEGIN 
        ITEM RIGHT$VAL U(0,18,42);     # VALUE IN RIGHT MOST 42 BITS   #
        ITEM RIGHT$NAM C(0,18,7);      # NAME IN RIGHT MOST 42 BITS    #
        ITEM FULL$VAL  U(00,00,60);    # FULL WORD ENTRY FOR FAC       #
        END 
      ARRAY EVRINFO [0:0] S(1);        # REPEAT INFORMATION            #
        BEGIN 
        ITEM EVGRPFLG  B(00,00,01);    # GROUP FLAG                    #
        ITEM EVSVC     B(00,01,01);    # SVC FLAG                      #
        ITEM EVPRTNUM  U(00,06,09);    # PORT NUMBER                   #
        ITEM EVGRPCNT  U(00,15,09);    # GROUP COUNT                   #
        ITEM EVNCIR    U(00,24,09);    # CIRCUIT COUNT                 #
        END 
#                                                                      #
      ITEM I, J, ITEMP, JTEMP; # INTEGER TEMPORARY                     #
#                                                                      #
      SWITCH EVJUMP           , # NULL STMT # 
                              , # NFILE     # 
                     NPU      , # NPU       # 
                     KWD$ENTRY, # SUPLINK   # 
                     COUPLER  , # COUPLER   # 
                     LOGLINK  , # LOGLINK   # 
                     KWD$ENTRY, # GROUP     # 
                     KWD$ENTRY, # LINE      # 
                              , #           # 
                     KWD$ENTRY, # TERMINAL  # 
                     KWD$ENTRY, # DEVICE    # 
                     TRUNK$   , # TRUNK     # 
                              , # LFILE     # 
                     KWD$ENTRY, # USER      # 
                     KWD$ENTRY, # APPL      # 
                     KWD$ENTRY, # OUTCALL   # 
                     KWD$ENTRY, # INCALL    # 
                              , # END       # 
                     KWD$ENTRY, # TERMDEV   # 
                              , # DEFINE    # 
                              , # COMMENT   # 
                              ; # TITLE     # 
#                                                                      #
      SWITCH EVKWDJUMP            , ST$ENTRY   , # UNK     , NODE     ,#
                      ST$ENTRY    , ST$ENTRY   , # VARIANT , OPGO     ,#
                      ST$ENTRY    , ST$ENTRY   , # DMP     , LLNAME   ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                      ST$ENTRY    , ST$ENTRY   , # HNAME   , LOC      ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                      ST$ENTRY    , ST$ENTRY   , # NCNAME  , DI       ,#
                      ST$ENTRY    , ST$ENTRY   , # N1      , P1       ,#
                      ST$ENTRY    , ST$ENTRY   , # N2      , P2       ,#
                      ST$ENTRY    , ST$ENTRY   , # NOLOAD1 , NOLOAD2  ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                      NI          , PORT       , # NI      , PORT     ,#
                      LTYPE       , TIPTYPE    , # LTYPE   , TIPTYPE  ,#
                      AUTO        , ST$ENTRY   , # AUTO    , AL       ,#
                      ST$ENTRY    , ST$ENTRY   , # LSPEED  , DFL      ,#
                      ST$ENTRY    , ST$ENTRY   , # FRAME   , RTIME    ,#
                      ST$ENTRY    , ST$ENTRY   , # RCOUNT  , NSVC     ,#
                      ST$ENTRY    , ST$ENTRY   , # PSN     , DCE      ,#
                      ST$ENTRY3   , ST$ENTRY   , # DTEA    , ARSPEED  ,#
                      ST$ENTRY    , ST$ENTRY   , # LCN     , IMDISC   ,#
                      ST$ENTRY    ,            , # RC      ,          ,#
                      STIP        , TC         , # STIP    , TC       ,#
                      TB$ENTRY    , TB$ENTRY   , # RIC     , CSET     ,#
                      TB$ENTRY    , TB$ENTRY   , # TSPEED  , CA       ,#
                      TB$ENTRY    , TB$ENTRY   , # CO      , BCF      ,#
                      TB$ENTRY    , TB$ENTRY   , # MREC    , W        ,#
                      CTYP        , NCIR       , # CTYP    , NCIR     ,#
                      TB$ENTRY    , COLLECT$   , # NEN     , COLLECT  ,#
                      AUTO        , DT         , # XAUTO   , DT       ,#
                      ST$ENTRY    , ST$ENTRY   , # SDT     , TA       ,#
                      ST$ENTRY    , ST$ENTRY   , # ABL     , DBZ      ,#
                      ST$ENTRY    , ST$ENTRY   , # UBZ     , DBL      ,#
                      ST$ENTRY    , ST$ENTRY   , # UBL     , XBZ      ,#
                      ST$ENTRY    , ST$ENTRY   , # DO      , STREAM   ,#
                      ST$ENTRY    ,            , # HN      , AUTOLOG  ,#
                      ST$ENTRY    , ST$ENTRY   , # AUTOCON , PRI      ,#
                      ST$ENTRY    , ST$ENTRY   , # P80     , P81      ,#
                      ST$ENTRY    , ST$ENTRY   , # P82     , P83      ,#
                      ST$ENTRY    , ST$ENTRY   , # P84     , P85      ,#
                      ST$ENTRY    , ST$ENTRY   , # P86     , P87      ,#
                      ST$ENTRY    , ST$ENTRY   , # P88     , P89      ,#
                      ST$ENTRY    , ST$ENTRY   , # AB      , BR       ,#
                      ST$ENTRY    , ST$ENTRY   , # BS      , B1       ,#
                      ST$ENTRY    , ST$ENTRY   , # B2      , CI       ,#
                      ST$ENTRY    , ST$ENTRY   , # CN      , CT       ,#
                      ST$ENTRY    , ST$ENTRY   , # DLC     , DLTO     ,#
                      ST$ENTRY    , ST$ENTRY   , # DLX     , EP       ,#
                      ST$ENTRY    , ST$ENTRY   , # IN      , LI       ,#
                      ST$ENTRY    , ST$ENTRY   , # OP      , PA       ,#
                      ST$ENTRY    , ST$ENTRY   , # PG      , PL       ,#
                      ST$ENTRY    , ST$ENTRY   , # PW      , SE       ,#
                      ST$ENTRY    , ST$ENTRY   , # FA      , XLC      ,#
                      ST$ENTRY    , ST$ENTRY   , # XLX     , XLTO     ,#
                      ST$ENTRY    , ST$ENTRY   , # ELO     , ELX      ,#
                      ST$ENTRY    , ST$ENTRY   , # ELR     , EBO      ,#
                      ST$ENTRY    , ST$ENTRY   , # EBR     , CP       ,#
                      ST$ENTRY    , ST$ENTRY   , # IC      , OC       ,#
                      ST$ENTRY    , ST$ENTRY   , # LK      , EBX      ,#
                                  , ST$ENTRY   , #         , MC       ,#
                      ST$ENTRY    , TB$ENTRY   , # XLY     ,  EOF     ,#
                      TB$ENTRY    , ST$ENTRY   , # PAD     , RTS      ,#
                      ST$ENTRY    , ST$ENTRY   , # MCI     , MLI      ,#
                      ST$ENTRY    , STRING$ENTR, # NETOSD  , DOMAIN   ,#
                      STRING$ENTR ,            , # SERVICE ,          ,#
                      ST$ENTRY    , ST$ENTRY   , # MFAM    , MUSER    ,#
                      ST$ENTRY    , ST$ENTRY   , # MAPPL   , DFAM     ,#
                      ST$ENTRY    , ST$ENTRY   , # DUSER   , PFAM     ,#
                      ST$ENTRY    ,            , # PUSER   ,          ,#
                      ST$ENTRY    , ST$ENTRY   , # PAPPL   , RS       ,#
                      ST$ENTRY    , ST$ENTRY   , # MXCOPYS , NETXFR   ,#
                      ST$ENTRY    , ST$ENTRY   , # UID     , PRIV     ,#
                      ST$ENTRY    , ST$ENTRY   , # KDSP    , PRU      ,#
                      ST$ENTRY    , ST$ENTRY   , # NAME1   , NAME2    ,#
                      ST$ENTRY    , ST$ENTRY   , # SNODE   , DNODE    ,#
                      ST$ENTRY    , ST$ENTRY   , # ACCLEV  , DHOST    ,#
                      ST$ENTRY    , ST$ENTRY   , # DPLR    , DPLS     ,#
                      ST$ENTRY    , ST$ENTRYN  , # PRID    , UDATA    ,#
                      ST$ENTRY    , ST$ENTRY   , # WR      , WS       ,#
                      ST$ENTRY    ,            , # PID     ,          ,#
                      ST$ENTRY    , ST$ENTRY   , # FAM     , UNAME    ,#
                      ST$FAC      , ST$FAC     , # FAC1    , FAC2     ,#
                      ST$FAC      , ST$FAC     , # FAC3    , FAC4     ,#
                      ST$FAC      , ST$FAC     , # FAC5    , FAC6     ,#
                      ST$FAC      , ST$FAC     , # FAC7    , FAC8     ,#
                      ST$FAC      , ST$FAC     , # FAC9    , FAC10    ,#
                      ST$FAC      , ST$FAC     , # FAC11   , FAC12    ,#
                      ST$FAC      , ST$FAC     , # FAC13   , FAC14    ,#
                      ST$FAC      , ST$FAC     , # FAC15   , FAC16    ,#
                      ST$FAC      , ST$FAC     , # FAC17   , FAC18    ,#
                      ST$FAC      , ST$FAC     , # FAC19   , FAC20    ,#
                      ST$FAC      , ST$FAC     , # FAC21   , FAC22    ,#
                      ST$FAC      , ST$FAC     , # FAC23   , FAC24    ,#
                      ST$FAC      , ST$FAC     , # FAC25   , FAC26    ,#
                      ST$FAC      , ST$FAC     , # FAC27   , FAC28    ,#
                      ST$FAC      , ST$FAC     , # FAC29   , FAC30    ,#
                      ST$FAC      , ST$ENTRY   , # FAC31   , ANAME    ,#
                      ST$ENTRY    , ST$ENTRY   ; # SHOST   , FASTSEL  ,#
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      GOTO EVJUMP[EVSTID];
#                                                                      #
COUPLER:                     # FOR -COUPLER- STATEMENT                 #
      IF EVKWID EQ KID"NODE" AND EVSTAT 
      THEN                   # IF NODE AND O.K.                        #
        BEGIN                #   MAKE ENTRY IN COUPLER TABLE           #
        CTHNID[CTENT[0]] = RIGHT$VAL[0];
        END 
      GOTO ST$ENTRY;
LOGLINK:                     # FOR -LOGLINK- STATEMENT                 #
      IF EVKWID EQ KID"NCNAME" AND EVSTAT 
      THEN                   # IF NCNAME AND O.K.                      #
        BEGIN                #   MAKE ENTRY IN LOGLINK NODE TABLE      #
        LNTNAME[LNTENT[0]] = RIGHT$NAM[0];
        END 
      GOTO ST$ENTRY;
NPU:                         # FOR -NPU- STATEMENT                     #
      IF EVKWID EQ KID"NODE" AND EVSTAT 
      THEN                   # IF NODE AND O.K.                        #
        BEGIN                #   MAKE ENTRY IN NPU TABLE               #
        NTNID[NTCNP[0]] = RIGHT$VAL[0]; 
        END 
      GOTO ST$ENTRY;
TRUNK$:                      # FOR -TRUNK- STATEMENT                   #
      IF EVSTAT 
      THEN                   # IF VALUE IS O.K.                        #
        BEGIN 
        IF EVKWID EQ KID"N1"           # IF KEYWORD ID -N1-            #
        THEN
          BEGIN                        # SAVE VALUE IN TNN TABLE       #
          TNNN1[TNNEC[0]] = RIGHT$NAM[0]; 
          END 
        ELSE                           # KEYWORD IS NOT -N1-           #
          BEGIN 
          IF EVKWID EQ KID"N2"         # IF KEYWORD ID -N2-            #
          THEN
            BEGIN                      # SAVE VALUE IN TNN TABLE       #
            TNNN2[TNNEC[0]] = RIGHT$NAM[0]; 
            END 
          END 
        END 
      GOTO ST$ENTRY;
#                                                                      #
KWD$ENTRY:                   # FOR ALL OTHER STATEMENTS EXCEPT ABOVE   #
      GOTO EVKWDJUMP[EVKWID]; 
AUTO: 
      IF STORD3[2] EQ 0      # IF NOT SPECIFIED YET                    #
      THEN
        BEGIN 
        STORD3[2] = STWC[0] + 1;       # PUT ORDINAL IN ENTRY          #
        END 
      GOTO ST$ENTRY;
CTYP: 
      IF RIGHT$NAM[0] NQ "SVC"         # IF VALUE IS NOT -SVC-         #
      THEN
        BEGIN 
        EVSVC[0] = FALSE;              # CLEAR -SVC- FLAG              #
        END 
      GOTO TB$ENTRY;
DT: 
      IF STORD1[2] EQ 0      # IF NOT SPECIFIED YET                    #
      THEN
        BEGIN 
        STORD1[2] = STWC[0] + 1;       # PUT ORDINAL IN ENTRY          #
        END 
      GOTO ST$ENTRY;                   # MAKE VALUE-DECLARATION ENTRY  #
LTYPE:  
      IF STORD1[2] EQ 0      # IF NOT SPECIFIED YET                    #
      THEN
        BEGIN 
        STORD1[2] = STWC[0] + 1;       # PUT ORDINAL IN ENTRY          #
        END 
      CRNT$LTYPE = RIGHT$NAM[0];       # SAVE CURRENT LTYPE            #
      GOTO ST$ENTRY;
NCIR: 
      IF EVSTAT                        # IF VALUE IS O.K.              #
      THEN
        BEGIN 
        EVNCIR[0] = RIGHT$VAL[0];      # SAVE CURRENT CIRCUIT COUNT    #
        END 
      GOTO TB$ENTRY;
NI: 
      IF EVSTAT                        # IF VALUE IS O.K.              #
      THEN
        BEGIN 
        EVGRPCNT[0] = RIGHT$VAL[0];    # SAVE GROUP COUNT              #
        END 
      GOTO ST$ENTRY;
PORT: 
      IF EVSTAT AND                    # IF VALUE IS O.K. AND ON GROUP #
    EVSTID EQ STID"GROUP"    #   STATEMENT                             #
      THEN
        BEGIN 
        EVPRTNUM[0] = RIGHT$VAL[0];    # SAVE PORT NUMBER              #
        END 
      GOTO ST$ENTRY;
STIP: 
      IF TBORD1[1] EQ 0      # IF NOT SPECIFIED YET                    #
      THEN
        BEGIN 
        TBORD1[1] = TBWC[0] + 1;       # PUT ORDINAL IN ENTRY          #
        END 
      GOTO TB$ENTRY;         # MAKE VALUE-DECLARATION ENTRY            #
TC: 
      IF TBORD2[1] EQ 0      # IF NOT SPECIFIED YET                    #
      THEN
        BEGIN 
        TBORD2[1] = TBWC[0] + 1;       # PUT ORDINAL IN ENTRY          #
        END 
      GOTO TB$ENTRY;         # MAKE VALUE-DECLARATION ENTRY            #
TIPTYPE:  
      IF STORD2[2] EQ 0      # IF NOT SPECIFIED YET                    #
      THEN
        BEGIN 
        STORD2[2] = STWC[0] + 1;       # PUT ORDINAL IN ENTRY          #
        END 
      CRNT$TIP = RIGHT$NAM[0];         # SAVE CURRENT TIP VALUE        #
      GOTO ST$ENTRY;         # MAKE VALUE-DECLARATION ENTRY            #
COLLECT$: 
      IF EVSTID EQ STID"INCALL" 
      THEN                   # COLLECT IS SPECIFIED ON INCALL STMT     #
        GOTO ST$ENTRY;       #   STORE STATEMENT TABLE ENTRY           #
      ELSE                   # COLLECT IS SPECIFIED ON TERM STMT       #
        GOTO TB$ENTRY;       #   STORE IN TERMINAL BUFFER              #
#                                                                      #
ST$ENTRY:                    # MAKE VALUE-DECLARATION ENTRY            #
      IF (EVSTID EQ STID"COUPLER") AND (EVKWID EQ KID"HNAME") 
      THEN
        BEGIN 
                             # SET CURRENT COUPLER HOST NAME          # 
        CHNAME[0] = RIGHT$VAL[0]; 
        END 
      IF KYWD$ORD[EVKWID] EQ 0         # IF NOT SPECIFIED YET          #
      THEN
        BEGIN 
        STWC[0] = STWC[0] + 1;         # INCREMENT WORD COUNT          #
        KYWD$ORD[EVKWID] = STWC[0];    # PUT ORDINAL IN TABLE          #
        IF EVKWID EQ KID"AUTO"         # KWID = AUTO                   #
        THEN
          BEGIN 
          KYWD$ORD[KID"XAUTO"] = STWC[0]; # SET XAUTO POINTER          #
          END 
        ELSE
          BEGIN 
          IF EVKWID EQ KID"XAUTO"         # KEYWORD ID = XAUTO         #
          THEN
            BEGIN 
            KYWD$ORD[KID"AUTO"] = STWC[0]; # SET AUTO POINTER          #
            END 
          END 
        END 
      ELSE                   # MUST HAVE ALREADY BEEN DEFINED          #
        BEGIN 
        ERRMS1(ERR39,EVLINE,EVVNAME[0]);# FLAG WARNING - OVERRIDING DEC#
        END 
      IF STB$LENG-1 LS STWC[0]
      THEN                   # IF NEED MORE TABLE SPACE                #
        BEGIN                #    ALLOCATE MORE SPACE                  #
        SSTATS(P<STMT$TABLE>,20); 
        END 
      ITEMP = KYWD$ORD[EVKWID];        # SAVE ORDINAL                  #
      STWORD[ITEMP] = 0;               # CLEAR ENTRY                   #
      STKWID[ITEMP] = EVKWID;          # INSERT KEYWORD I.D.           #
      STVALLEN[ITEMP] = EVLENG;        # INSERT VALUE LENGTH           #
      STVALNUM[ITEMP] = RIGHT$VAL[0];  # INSERT VALUE                  #
      IF NOT EVSTAT                    # IF VALUE IS NO GOOD           #
      THEN
        BEGIN 
        STVLERR[ITEMP] = TRUE;         # SET VALUE ERROR FLAG          #
        END 
      GOTO EXIT;
ST$ENTRY2:                   # MAKE 2-WORD VAL-DEC ENTRY               #
      IF KYWD$ORD[EVKWID] EQ 0         # IF NOT SPECIFIED YET          #
      THEN
        BEGIN 
        STWC[0] = STWC[0] +1;          # INCREMENT WORD COUNT          #
        KYWD$ORD[EVKWID] = STWC[0];    # PUT ORDINAL INTO TABLE        #
        STWC[0] = STWC[0] + 1;         # INCREMENT COUNT FOR 2ND WORD  #
        END 
      ELSE                   # MUST HAVE ALREADY BEEN SPECIFIED        #
        BEGIN 
        ERRMS1(ERR39,EVLINE,EVVNAME[0]);# FLAG WARNING - OVERRIDING DEC#
        END 
      IF STWC[0]+1 GQ STB$LENG
      THEN                   # IF NOT ENOUGH ROOM FOR ENTRY            #
        BEGIN 
        SSTATS(P<STMT$TABLE>,20);      # ALLOCATE MORE TABLE SPACE     #
        END 
      ITEMP = KYWD$ORD[EVKWID];        # SAVE ORDINAL                  #
      STWORD[ITEMP] = 0;               # CLEAR ENTRY                   #
      STWORD[ITEMP+1] = 0;
      STKWID[ITEMP] = EVKWID;          # INSERT KEYWORD I.D. INTO ENTRY#
      STVALLEN[ITEMP] = EVLENG;        # INSERT VALUE LENGTH           #
      STVALNAM[ITEMP] = C<0,7>EVVNAME[0]; # INSERT 1ST 7 CHAR OF VALUE #
      STVALNAM[ITEMP+1] = C<7,3>EVVNAME[0]; # INS 2ND 7 CHAR OF VALUE  #
      C<3,4>STVALNAM[ITEMP+1] = C<0,4>EVVNAME[1]; 
      IF NOT EVSTAT                    #IF VALUE IS NO GOOD            #
      THEN
        BEGIN 
        STVLERR[ITEMP] = TRUE;         # SET VALUE-DEC ERROR FLAG      #
        END 
      GOTO EXIT;
ST$ENTRY3:                   # MAKE 3-WORD VAL-DEC ENTRY               #
      IF KYWD$ORD[EVKWID] EQ 0         # IF NOT SPECIFIED YET          #
      THEN
        BEGIN 
        STWC[0] = STWC[0] +1;          # INCREMENT WORD COUNT          #
        KYWD$ORD[EVKWID] = STWC[0];    # PUT ORDINAL INTO TABLE        #
        STWC[0] = STWC[0] + 2;         # INCREMENT COUNT FOR 2ND WORD  #
        END 
      ELSE                   # MUST HAVE ALREADY BEEN SPECIFIED        #
        BEGIN 
        ERRMS1(ERR39,EVLINE,EVVNAME[0]);# FLAG WARNING - OVERRIDING DEC#
        END 
      IF STWC[0]+1 GQ STB$LENG
      THEN                   # IF NOT ENOUGH ROOM FOR ENTRY            #
        BEGIN 
        SSTATS(P<STMT$TABLE>,20);      # ALLOCATE MORE TABLE SPACE     #
        END 
      ITEMP = KYWD$ORD[EVKWID];        # SAVE ORDINAL                  #
      STWORD[ITEMP] = 0;               # CLEAR ENTRY                   #
      STWORD[ITEMP+1] = 0;
      STWORD[ITEMP+2] = 0;
      STKWID[ITEMP] = EVKWID;          # INSERT KEYWORD I.D. INTO ENTRY#
      STVALLEN[ITEMP] = EVLENG;        # INSERT VALUE LENGTH           #
      STVALNAM[ITEMP] = C<0,7>EVVNAME[0]; # INSERT 1ST 7 CHAR OF VALUE #
      STVALNAM[ITEMP+1] = C<7,3>EVVNAME[0]; # INS 2ND 7 CHAR OF VALUE  #
      C<3,4>STVALNAM[ITEMP+1] = C<0,4>EVVNAME[1]; 
      C<0,1>STVALNAM[ITEMP + 2] = C<4,1>EVVNAME[1]; 
      IF NOT EVSTAT                    #IF VALUE IS NO GOOD            #
      THEN
        BEGIN 
        STVLERR[ITEMP] = TRUE;         # SET VALUE-DEC ERROR FLAG      #
        END 
      GOTO EXIT;
ST$FAC:                               # MAKE ENTRY FOR FAC             #
      IF KYWD$ORD[EVKWID] EQ 0         # IF NOT SPECIFIED YET          #
      THEN
        BEGIN 
        STWC[0] = STWC[0] +1;          # INCREMENT WORD COUNT          #
        KYWD$ORD[EVKWID] = STWC[0];    # PUT ORDINAL INTO TABLE        #
        STWC[0] = STWC[0] + 1;         # INCREMENT COUNT FOR 2ND WORD  #
        END 
      ELSE                   # MUST HAVE ALREADY BEEN SPECIFIED        #
        BEGIN 
        ERRMS1(ERR39,EVLINE,EVVNAME[0]);# FLAG WARNING - OVERRIDING DEC#
        END 
      IF STWC[0]+1 GQ STB$LENG
      THEN                   # IF NOT ENOUGH ROOM FOR ENTRY            #
        BEGIN 
        SSTATS(P<STMT$TABLE>,20);      # ALLOCATE MORE TABLE SPACE     #
        END 
      ITEMP = KYWD$ORD[EVKWID];        # SAVE ORDINAL                  #
      STWORD[ITEMP] = 0;               # CLEAR ENTRY                   #
      STWORD[ITEMP+1] = 0;
      STKWID[ITEMP] = EVKWID;          # INSERT KEYWORD I.D. INTO ENTRY#
      STVALLEN[ITEMP] = EVLENG;        # INSERT VALUE LENGTH           #
      STWORD[ITEMP + 1] = FULL$VAL[0]; # STORE FULL WORD VALUE         #
      IF NOT EVSTAT                    #IF VALUE IS NO GOOD            #
      THEN
        BEGIN 
        STVLERR[ITEMP] = TRUE;         # SET VALUE-DEC ERROR FLAG      #
        END 
      GOTO EXIT;
ST$ENTRYN:                             # MAKE N-WORD ENTRY             #
      IF KYWD$ORD[EVKWID] EQ 0         # IF NOT SPECIFIED YET          #
      THEN
        BEGIN 
        STWC[0] = STWC[0] + 1;         # INCREMENT WORD COUNT          #
        KYWD$ORD[EVKWID] = STWC[0];    # PUT ORDINAL INTO TABLE        #
        IF EVKWID EQ KID"UDATA"        # STATEMENT TABLE ENTRY SIZES   #
        THEN                           # DEPEND ON MAX PARAMETER LENGTH#
          BEGIN 
          STWC[0] = STWC[0] + MAXUDATW;  # MAX WORDS FOR UDATA         #
          END 
        END 
      ELSE                             # MUST HAVE ALREADY BEEN        #
        BEGIN                          # SPECIFIED                     #
        ERRMS1(ERR39,EVLINE,EVVNAME[0]);# FLAG WARNING - OVERIDING DEC #
        END 
 
      IF STWC[0]+1 GQ STB$LENG
      THEN
        BEGIN 
        SSTATS(P<STMT$TABLE>,30);      # ALLOCATE TABLE SPACE          #
        END 
 
      ITEMP = KYWD$ORD[EVKWID];        # SAVE ORDINAL                  #
      STWORD[ITEMP] = 0;               # CLEAR ENTRY                   #
      STKWID[ITEMP] = EVKWID;          # INSERT KEYWORD I.D. INTO ENTRY#
      STVALNUM[ITEMP] = EVLENG;        # INSERT VALUE LENGTH           #
      IF EVVNAME[0] EQ "NONE"          # IF NONE SPECIFIED             #
      THEN
        BEGIN 
        STVALNUM[ITEMP] = 0;           # SPECIAL CASE IT               #
        END 
      ELSE
        BEGIN 
      # MAKE WORD ENTRIES INTO STATEMENT TABLE: ROUND UP, NEAREST WORD #
 
        EVLENG = (EVLENG*4 + 5)/6;     # GET DISPLAY CODE COUNT        #
        JTEMP = (EVLENG+9)/10;         # NUMBER OF WORDS, SIGNIF. DATA #
        FOR I = 1 STEP 1 WHILE I LQ JTEMP 
        DO
          BEGIN 
          J = 10*I; 
          IF J LQ EVLENG               # INSERT VALUE INTO TABLE:      #
          THEN
            BEGIN                      # EITHER 10 CHARS PER WORD, OR  #
            STWORD[ITEMP+I] = B<0,60>EVVNAME[I-1];
            END 
          ELSE
            BEGIN                      # LAST (PARTIAL WORD) ENTRY:    #
            STWORD[ITEMP+I] = 0;       # CLEAR ENTRY                   #
            J = EVLENG-(J-10);         # LENGTH MODULO 10, LAST LENGTH #
            C<0,J>STWORD[ITEMP+I] = C<0,J>EVVNAME[I-1]; 
            END 
          END 
        END 
      IF NOT EVSTAT 
      THEN
        BEGIN 
        STVLERR[ITEMP] = TRUE;            # SET VALUE-DEC ERROR FLAG   #
        END 
      GOTO EXIT;
 
STRING$ENTR:                           # MAKE STRING ENTRY             #
      IF KYWD$ORD[EVKWID] EQ 0         # IF NOT SPECIFIED YET          #
      THEN
        BEGIN 
        STWC[0] = STWC[0] + 1;         # INCREMENT WORD COUNT          #
        KYWD$ORD[EVKWID] = STWC[0];    # PUT ORDINAL INTO TABLE        #
        STWC[0] = STWC[0] + MAXSTRINGW;# MAX WORDS FOR STRING          #
        END 
      ELSE                             # MUST HAVE ALREADY BEEN        #
        BEGIN                          # SPECIFIED                     #
        ERRMS1(ERR39,EVLINE,EVVNAME[0]);# FLAG WARNING - OVERIDING DEC #
        END 
 
      IF STWC[0]+1 GQ STB$LENG
      THEN
        BEGIN 
        SSTATS(P<STMT$TABLE>,30);      # ALLOCATE TABLE SPACE          #
        END 
 
      ITEMP = KYWD$ORD[EVKWID];        # SAVE ORDINAL                  #
      STWORD[ITEMP] = 0;               # CLEAR ENTRY                   #
      STKWID[ITEMP] = EVKWID;          # INSERT KEYWORD I.D. INTO ENTRY#
      STVALNUM[ITEMP] = EVLENG;        # INSERT VALUE LENGTH           #
      JTEMP = EVLENG/10 + 1;           # ROUND UP TO INTEGER NUMBER    #
                                       # OF WORDS                      #
      FOR I = 1 STEP 1 UNTIL JTEMP
      DO
        BEGIN 
        STWORD[ITEMP + I] = EVVNAME[I - 1];  # TRANSFER WORDS          #
        END 
      IF NOT EVSTAT 
      THEN
        BEGIN 
        STVLERR[ITEMP] = TRUE;            # SET VALUE-DEC ERROR FLAG   #
        END 
      GOTO EXIT;
TB$ENTRY:                    # MAKE VALUE-    ENTRY IN TERM BUFFER     #
      IF KYWD$ORD[EVKWID] EQ 0         # IF NOT SPECIFIED YET          #
      THEN
        BEGIN 
        KYWD$ORD[EVKWID] = TBWC[0] + 1;# PUT ORDINAL IN TABLE          #
        TBWC[0] = TBWC[0] + 1;         # INCREMENT WORD COUNT          #
        IF EVKWID EQ KID"PAD"          # TERM BUFF TABLE ENTRY SIZES   #
        THEN                           # DEPEND ON MAX PARAMETER LENGTH#
          BEGIN 
          TBWC[0] = TBWC[0] + MAXPADW; # MAX WORDS FOR PAD             #
          END 
        END 
      ELSE                   # MUST HAVE ALREADY BEEN DEFINED          #
        BEGIN 
        ERRMS1(ERR39,EVLINE,EVVNAME[0]);# FLAG WARNING - OVERRIDING DEC#
        END 
 
      IF TB$LENG-1 LS TBWC[0] 
      THEN                   # IF NEED MORE TABLE SPACE                #
        BEGIN                #   ALLOCATE MORE SPACE                   #
        SSTATS(P<TERM$BUFFER>,30);
        END 
 
      ITEMP = KYWD$ORD[EVKWID];        # SAVE ORDINAL                  #
      TBWORD[ITEMP] = 0;               # CLEAR ENTRY                   #
      TBKWID[ITEMP] = EVKWID;          # INSERT KEYWORD I.D. INTO ENTRY#
 
      IF EVKWID NQ KID"PAD" 
      THEN
        BEGIN 
        TBVALLEN[ITEMP] = EVLENG;      # INSERT VALUE LENGTH           #
        TBVALNUM[ITEMP] = RIGHT$VAL[0];# INSERT VALUE                  #
        END 
      ELSE
        BEGIN 
        TBVALNUM[ITEMP] = EVLENG / 2;  # NUMBER OF 8-BIT PAD ENTRIES   #
        EVLENG = (EVLENG*4 + 5)/6;     # 4-BIT HEX STRINGS ARE 4/6 THE #
                                       # SIZE OF 6-BIT CHAR. HEX STRNGS#
        #PUT WORD ENTRIES INTO TERM BUFF TABLE: ROUND UP, NEAREST WORD #
        JTEMP = (EVLENG+9)/10;         # NUMBER OF WORDS, SIGNIF. DATA #
        FOR I = 1 STEP 1 WHILE I LQ JTEMP 
        DO
          BEGIN 
          J = 10*I; 
          IF J LQ EVLENG               # INSERT VALUE INTO TABLE:      #
          THEN
            BEGIN                      # EITHER 10 CHARS PER WORD, OR  #
            TBWORD[ITEMP+I] = B<0,60>EVVNAME[I-1];
            END 
          ELSE
            BEGIN                        # LAST (PARTIAL WORD) ENTRY:  #
            TBWORD[ITEMP+I] = 0;         # CLEAR ENTRY                 #
            J = EVLENG-(J-10);           # LENGTH MODULO 10, LAST LNGTH#
            C<0,J>TBWORD[ITEMP+I] = C<0,J>EVVNAME[I-1]; 
            END 
          END 
        END 
 
        IF NOT EVSTAT                  # IF VALUE IS NO GOOD           #
        THEN
          BEGIN 
          TBVLERR[ITEMP] = TRUE;       # SET VALUE ERROR FLAG          #
          END 
      GOTO EXIT;
EXIT: 
      RETURN;                # **** RETURN ****                        #
      END # ENTVAL #
      CONTROL EJECT;
      PROC NAMEGEN(RPTNAME,GROUPSIZE,NCIR$CNT,PORT$NUM,NGLINE,NGSTAT);
      BEGIN 
*IF,DEF,IMS 
# 
**    NAMEGEN - NAME GENERATOR
* 
*     D.K. ENDO    81/10/29 
* 
*     THIS PROCEDURE CONTATINATES PORT NUMBER AND/OR CIRCUIT COUNT ON 
*     TO A GIVEN ROOT NAME. 
* 
*     PROC NAMEGEN(RPTNAME,GROUPSIZE,NCIR$CNT,PORT$NUM,NGLINE,NGSTAT) 
* 
*     ENTRY        RPTNAME = ROOT NAME. 
*                  GROUPSIZE = -NI- VALUE ON GROUP STATEMENT. 
*                  NCIR$CNT = -NCIR- VALUE. 
*                  PORT$NUM = PORT NUMBER.
*                  NGLINE = CURRENT SOURCE LINE NUMBER. 
* 
*     EXIT         NGSTAT = RETURNED STATUS (SET -TRUE- IF GENERATED OK)
* 
*     NOTE
* 
*     THE ALGORITHM FOR CONCATINATION IS SUCH THAT BOTH A PORT NUMBER 
*     AND A CIRCUIT COUNT NUMBER CAN BE CONCATINATED TO A ROOT NAME.
*     THIS IS BECAUSE WHEN THIS PROC WAS FIRST WRITTEN THERE WAS A
*     NEED FOR IT.  EVEN THOUGH IT IS NO LONGER NECESSARY TO HAVE THE 
*     CAPABILITY, THE CODE WAS LEFT IN SHOULD THE NEED ARISE. 
* 
*     METHOD
* 
*     CHECK RPTNAME LENGTH, GROUPSIZE,NCIR$CNT, AND SUM OF PORTNUM AND
*     GROUPSIZE TO BE TOO LARGE.  IF SO, THEN FLAG AN ERROR, OTHERWISE
*     CONCATINATE NUMBER TO NAME AS FOLLOWS:  
* 
*     FOR EACH ITERATION OF PORTNUM UNTIL GROUPSIZE 
*       IF GROUPSIZE GREATER THAN ZERO, 
*         CONCATINATE PORT TO ROOT NAME.
*       IF NCIR$CNT GREATER THAN ZERO,
*       THEN, 
*         FOR EACH ITERATION OF NUMBER FROM ZERO UNTIL NCIR$CNT,
*           CONCATINATE NUMBER TO CURRENT NAME. 
*           CHECK FOR DUPLICATE LABEL (SEE CKGNAME) 
*       OTHERWISE,
*         CHECK NAME FOR DUPLICATE LABLE (SEE CKGNAME)
* 
# 
*ENDIF
      ITEM RPTNAME C(10);    # ROOT-NAME                               #
      ITEM GROUPSIZE;        # GROUP SIZE                              #
      ITEM NCIR$CNT;         # NCIR COUNT                              #
      ITEM PORT$NUM;         # PORT NUMBER                             #
      ITEM NGLINE;           # CURRENT LINE NUMBER                     #
      ITEM NGSTAT B;         # STATUS RETURNED, SET TRUE IF NO ERRORS  #
#                                                                      #
      XREF
        BEGIN 
        FUNC XCHD C(10);     # CONVERTS BINARY TO HEX DISPLAY CODE     #
        END 
      ITEM CTEMP C(10);      # CHARACTER TEMPORARY                     #
      ITEM GRP$CNT;          # GROUP COUNT                             #
      ITEM ITEMP;            # INTEGER TEMPORARY                       #
      ITEM LENGTH;           # LENGTH OF NAME AFTER ADDING PORT        #
      ITEM NAME$TEMP C(10);  # BUFFER FOR CHARACTER CONCATINATION      #
      ITEM RCOUNT;           # REPEAT COUNT                            #
      ITEM RLNGTH;           # LENGTH OF NAME AFTER ADDING RPT$CNT     #
      ITEM RNLENG;           # LENGTH OF ROOT-NAME IN CHARACTERS       #
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      NGSTAT = TRUE;         # INITIALIZE RETURN STATUS TO O.K.        #
      RNLENG = 0;            # INITIALIZE CHARACTER COUNT              #
      FOR ITEMP=0 STEP 1 UNTIL 9 DO    # FIND LENGTH OF ROOT-NAME      #
        BEGIN 
        IF C<ITEMP,1>RPTNAME NQ " "    # ASSUME NAME IS LEFT JUSTIFIED #
        THEN                           #   AND BLANK FILLED            #
          BEGIN 
          RNLENG = RNLENG + 1;
          END 
        END 
      IF RNLENG GR 5         # THERE IS NO ROOM TO CONCAT NUM TO NAME  #
      THEN
        BEGIN 
        ERRMS1(ERR31,NGLINE,RPTNAME);  # FLAG ERROR -- LABEL TOO LONG  #
        NGSTAT = FALSE;                # RETURN ERROR STATUS           #
        END 
      ELSE                   # THERE IS ROOM TO CONCAT AT LEAST 1 CHAR #
        BEGIN 
        IF NCIR$CNT GQ 255   # -NCIR- PARAMETER OUT OF RANGE           #
        THEN
          BEGIN 
          ERRMS1(ERR27,NGLINE,BLANK);  # FLAG ERROR -- NI TOO LARGE    #
          NGSTAT = FALSE;              # RETURN ERROR STATUS           #
          END 
        ELSE                 # REPEAT COUNT IS O.K.                    #
          BEGIN 
          IF GROUPSIZE GQ 255          # -NI- PARAMETER TO LARGE       #
          THEN
            BEGIN 
            ERRMS1(ERR37,NGLINE,BLANK);# FLAG ERROR -- NI TOO LARGE    #
            NGSTAT = FALSE;            # RETURN ERROR STATUS           #
            END 
          ELSE               # GROUP SIZE IS O.K.                      #
            BEGIN 
            IF PORT$NUM + GROUPSIZE GR X"FF"       # PORT IS TOO LARGE #
            THEN
              BEGIN 
              ERRMS1(ERR38,NGLINE,BLANK); #FLAG ERROR--PORT OUT OF RNGE#
              NGSTAT = FALSE;          # RETURN ERROR STATUS           #
              END 
            END 
          END 
        END 
      IF NGSTAT              # NOT LIMIT ERRORS DETECTED               #
      THEN
        BEGIN 
        ITEMP = 0;           # INITIALIZE TEMP TO CONTAIN CURRENT PORT #
#                                                                      #
#     THE FOLLOWING LOOP WAS CODED IN A MANNER THAT WOULD              #
#         SIMULATE A -FASTLOOP-.  SYMPL COMPILER DOES NOT              #
#         GENERATE THE LOOP PROPERLY.                                  #
#                                                                      #
        GRP$CNT = 0;         # INITIALIZE GROUP COUNT                  #
NGLOOP:   BEGIN 
          NAME$TEMP = RPTNAME;         # PUT ROOT-NAME IN BUFFER       #
          LENGTH = RNLENG;   # INITIALIZE CHAR COUNT OF NAME           #
          IF GROUPSIZE NQ 0  # GROUP STMT MUST HAVE BEEN SPECIFIED     #
          THEN
            BEGIN 
            ITEMP = PORT$NUM + GRP$CNT;# CALCULATE PORT                #
            CTEMP = XCHD(ITEMP);       # CONVERT PORT TO DISPLAY CODE  #
            LENGTH = LENGTH + 2;       # INCREMENT LENGTH              #
            IF ITEMP GR X"F" # IF PORT GREATER THAN 15                 #
            THEN             #   THEN MUST BE TWO CHAR LONG            #
              BEGIN 
              C<RNLENG,2>NAME$TEMP = C<8,2>CTEMP;# CONCAT PORT TO NAME #
              END 
            ELSE             # MUST BE ONLY ONE CHARACTER              #
              BEGIN 
              C<RNLENG,1>NAME$TEMP = "0";        # CONCAT PORT TO NAME #
              C<RNLENG+1,1>NAME$TEMP = C<9,1>CTEMP; 
              END 
            END 
          IF NCIR$CNT GR 0           # NCIR MUST BAVE BEEN SPECIFIED   #
          THEN               #   CONCAT REPEAT ITERATION               #
            BEGIN 
*IF,DEF,IMS 
# 
**    PS1TERM - PASS 1 TERMINATION ROUTINE. 
* 
*     D.K. ENDO    81/10/29 
* 
*     THIS PROCEDURE DOES FINAL CHECKING AND PROCESSING FOR PASS 1. 
* 
*     PROC PS1TERM(P1TCSTMT,P1TNEXW,P1TLINE,P1TEOF) 
* 
*     ENTRY        P1TCSTMT = CURRENT STATEMENT INFORMATION.
*                  P1TNEXW = NEXT TOKEN/WORD. 
*                  P1TLINE = CURRENT SOURCE LINE NUMBER.
*                  P1TEOF = END OF FILE FLAG. 
* 
*     EXIT         NONE.
* 
*     METHOD
* 
*     IF CURRENT STATEMENT IS -END-,
*     THEN, 
*       IF SUPERFLUOUS DATA AFTER END,
*         FLAG ERROR. 
*     OTHERWISE,
*       IF CURRENT STATEMENT IS NOT LFILE OR NFILE, 
*         FLAG ERROR -- MISSING END.
*     IF NCF DIVISION,
*       CALL ENTNID TO PUT TERMINAL NODE I.D.-S IN LOGLINK TABLE. 
*     FLUSH CIO BUFFERS FOR SECONDARY INPUT FILE, EXPANDED SECONDARY
*       INPUT FILE, STATEMENT TABLE, AND PASS 1 ERROR FILE. 
* 
# 
*ENDIF
            FOR RCOUNT=0 STEP 1 WHILE RCOUNT LS NCIR$CNT AND NGSTAT DO
              BEGIN 
              CTEMP = XCHD(RCOUNT);    # CONVERT REPEAT COUNT TO HEX   #
              RLNGTH = LENGTH + 2;     # INCREMENT LENGTH              #
              IF RCOUNT GR X"F"        # MUST BE TWO CHAR LONG         #
              THEN
                BEGIN 
                C<LENGTH,2>NAME$TEMP = C<8,2>CTEMP;# CONCAT CNT TO NAME#
                END 
              ELSE
                BEGIN        # MUST BE ONE CHAR LONG                   #
                C<LENGTH,1>NAME$TEMP = "0";     # CONCAT COUNT TO NAME #
                C<LENGTH+1,1>NAME$TEMP = C<9,1>CTEMP; 
                END 
              CKGNAME(NAME$TEMP,RLNGTH,ITEMP,NGLINE,NGSTAT);#CHECK NAME#
              END 
            END 
          ELSE
            BEGIN 
            CKGNAME(NAME$TEMP,LENGTH,ITEMP,NGLINE,NGSTAT);  #CHECK NAME#
            END 
          END 
        GRP$CNT = GRP$CNT + 1;         # INCREMENT COUNT               #
        IF GRP$CNT LS GROUPSIZE AND NGSTAT
        THEN
          BEGIN 
          GOTO NGLOOP;
          END 
#                                                                      #
#     THIS SHOULD BE THE END OF THE LOOP                               #
#                                                                      #
        END 
      RETURN;                # **** RETURN ****                        #
      END # NAMEGEN # 
      CONTROL EJECT;
      PROC PS1TERM(P1TCSTMT,P1TNEXW,P1TLINE,P1TEOF);
      BEGIN                  # PASS 1 TERMINATION ROUTINE              #
      ITEM P1TNEXW C(10);    # NEXT WORD/ELEMENT                       #
      ITEM P1TLINE;          # LINE NUMBER OF LAST LINE                #
      ITEM P1TEOF B;         # END OF FILE FLAG                        #
      ARRAY P1TCSTMT [0:0] S(1);       # CURRENT STATEMENT INFO        #
        BEGIN 
        ITEM P1TCSTID U(0,0,9);        # CURRENT STATEMENT I.D.        #
        END 
#                                                                      #
      ITEM I;                # SCRATCH ITEM                            #
      ITEM STATS;            # STATUS RETURNED BY WRITEH               #
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      IF P1TCSTID[0] EQ STID"END$"     # LAST STMT SENSED WAS -END-    #
      THEN
        BEGIN 
        IF P1TNEXW EQ "."    # OF NEXT ELEMENT IS A PERIOD             #
        THEN
          BEGIN 
          LEXSCAN;           # FORM NEXT ELEMENT                       #
          IF NEXTYPE NQ TYPEEOF        # IF NEXT END OF FILE           #
          THEN
            BEGIN 
            ERRMS1(ERR35,NEXLINE,BLANK);#FLAG ERROR -- SUPERFLUOUS DATA#
            FOR I=0 WHILE NEXTYPE NQ TYPEEOF DO 
              BEGIN          # SCAN TO END OF FILE                     #
              LEXSCAN;       # GET NEXT WORD/ELEMENT                   #
              END 
            END 
          END 
        ELSE                 # NEXT WORD IS NOT PERIOD                 #
          BEGIN 
          IF P1TNEXW EQ TYPEEOF 
          THEN               # IF END OF FILE                          #
            BEGIN 
            ERRMS1(ERR8,P1TLINE,BLANK);# FLAG ERROR -- NO PERIOD       #
            END 
          ELSE               # NOT END OF FILE                         #
            BEGIN 
            ERRMS1(ERR35,P1TLINE,BLANK);#FLAG ERROR -- SUPERFLUOUS DATA#
            FOR I=0 WHILE NEXTYPE NQ TYPEEOF DO 
              BEGIN          # SCAN TO END OF FILE                     #
              LEXSCAN;       # GET NEXT WORD/ELEMENT                   #
              END 
            END 
          END 
        END 
      ELSE                   # LAST STMT SENSED WAS NOT END            #
        BEGIN 
        IF P1TCSTID[0] NQ STID"NFILE" AND 
           P1TCSTID[0] NQ STID"LFILE" 
        THEN                 # IF NOT NFILE OR LFILE STATEMENT         #
          BEGIN 
          ERRMS1(ERR21,LINE,BLANK);    # FLAG ERROR -- MISSING END     #
          WRITEH(SECFET,INPBUFF,11,STATS);
          END 
        END 
      IF NCFDIV 
      THEN                   # IF THIS IS AN NCF DIVISION              #
        BEGIN 
        ENTNID;              # ENTER NODE I.D.-S IN LL AND TNI TABLES  #
        SSTATS(P<LL$NODE$TABL>,-LNT$LENG);  # RELEASE LL NODE TABLE    #
        SSTATS(P<TNN$TABLE>,-TNN$LENG);     # RELEASE TNN TABLE        #
        END 
      FIRSTDIV = FALSE;      # CLEAR FIRST DIVIVSION FLAG              #
      WRITEF(SECFET);        # FLUSH SECONDARY INPUT FILE BUFFER       #
      RECALL(SECFET); 
      WRITEF(ESIFET);        # FLUSH EXPANDED SECONDARY INPUT FILE BUFF#
      RECALL(ESIFET); 
      WRITEF(STFET);         # WRITE EOF ON STMT-TABLE FILE            #
      RECALL(STFET);
      ERRMS1(0,0,0);         # FLUSH PASS 1 ERROR FILE BUFFER          #
      RETURN;                # **** RETURN ****                        #
      END # PS1TERM # 
      CONTROL EJECT;
      PROC SCNTOPRD;
      BEGIN                  # SCAN TO PERIOD                          #
*IF,DEF,IMS 
# 
**    SCNTOPRD - SCAN TO PERIOD 
* 
*     D.K. ENDO    81/10/29 
* 
*     THIS PROCEDURE SCAN SOURCE LINE TO PERIOD, MARKING THE END OF 
*     CURRENT STATEMENT.
* 
*     PROC SCNTOPRD 
* 
*     ENTRY        NONE.
* 
*     EXIT         NONE.
* 
*     METHOD
* 
*     KEEP CALLING LEXSCAN TO FORM TOKENS TILL A PERIOD IS FOUND. 
* 
# 
*ENDIF
      ITEM I; 
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      FOR I=0 WHILE CURWORD[0] NQ "." AND NEXTYPE NQ TYPEEOF
      DO
        BEGIN 
        LEXSCAN;
        END 
      RETURN;                # **** RETURN ****                        #
      END # SCNTOPRD #
      CONTROL EJECT;
      PROC SDEFINE(SDCSTMT);
      BEGIN                  # STORE DEFINE STRING                     #
*IF,DEF,IMS 
# 
**    SDEFINE - STORE DEFINE STRING.
* 
*     D.K. ENDO    81/10/29 
* 
*     THIS PROCEDURE STORES A DEFINE STRING INTO THE DEFINE TABLE 
*     PACKING OUT EXTRA BLANKS. 
* 
*     PROC SDEFINE(SDCSTMT) 
* 
*     ENTRY        SDCSTMT = CURRENT STATEMENT INFORMATION
* 
*     EXIT         NONE.
* 
*     METHOD
* 
*     PUT DEFINE NAME INTO NEW ENTRY. 
*     IF NEXT TOKEN IS NOT COMMA, 
*       STORE NEXT WORD IN BEGIN OF DEFINE TEXT.
*     IF NEXT TOKEN IS A PERIOD,
*     THEN, 
*       STORE PERIOD IN DEFINE TEXT.
*     OTHERWISE,
*       ENTER STATE TABLE:  
*E
* 
*     ***STATE I 0)          I 1)          I 2)LAST CHAR I 3)LAST CHAR I
*        ***   I    INIT     I  ALPHA-     I BEFORE BLNKSI NON-        I
*     STIM  ***I             I    NUMERIC  I --ALPHANUM  I  ALPHANUM   I
*     ---------+-------------+-------------+-------------+-------------+
*              I           0 I           2 I           2 I           3 I
*              I             I             I             I             I
*              I             I             I             I             I
*     BLANK    I    NONE     I    NONE     I    NONE     I    NONE     I
*              I             I             I             I             I
*              I             I             I             I             I
*              I             I             I             I             I
*     ---------+-------------+-------------+-------------+-------------+
*              I           1 I           1 I           1 I           1 I
*              I             I             I             I             I
*     LETTER   I PACK        I PACK        I PACK COMMA  I PACK        I
*     DIGIT    I   CHARACTER I   CHARACTER I PACK        I   CHARACTER I
*     ASTERISK I             I             I   CHARACTER I             I
*              I             I             I             I             I
*              I             I             I             I             I
*     ---------+-------------+-------------+-------------+-------------+
*              I           3 I           3 I           3 I           3 I
*              I             I             I             I             I
*          +   I PACK        I PACK        I PACK        I PACK        I
*     DELIM    I   CHARACTER I   CHARACTER I   CHARACTER I   CHARACTER I
*              I             I             I             I             I
*              I             I             I             I             I
*              I             I             I             I             I
*     ---------+-------------+-------------+-------------+-------------+
*              I           0 I           0 I           0 I           0 I
*              I             I             I             I             I
*              I PACK        I PACK        I PACK        I PACK        I
*     PERIOD   I   CHARACTER I   CHARACTER I   CHARACTER I   CHARACTER I
*              I             I             I             I             I
*              I             I             I             I             I
*              I          (E)I          (E)I          (E)I          (E)I
*     ---------+-------------+-------------+-------------+-------------+
*              I           2 I           2 I           2 I           2 I
*              I             I             I             I             I
*            * I FLAG ERROR  I FLAG ERROR  I FLAG ERROR  I FLAG ERROR  I
*     SPECIAL  I PACK        I PACK        I PACK        I PACK        I
*              I   CHARACTER I   CHARACTER I   CHARACTER I   CHARACTER I
*              I             I             I             I             I
*              I             I             I             I             I
*     ---------+-------------+-------------+-------------+-------------+
* 
*     (E) -- EXIT STATE TABLE 
*      +  -- DELIMITER --> : / = / ,
*      *  -- ALL CHARACTERS THAT ARE NOT ONE OF ABOVE 
* 
# 
*ENDIF
      ARRAY SDCSTMT [0:0] S(1);        # CURRENT STATEMENT INFO        #
        BEGIN 
        ITEM SDCSTID U(0,0,9);         # STATEMENT I.D.                #
        ITEM SDCEFLG B(0,15,1);        # LABEL ERROR FLAG              #
        ITEM SDCLABL C(0,18,7);        # LABEL-NAME                    #
        END 
#                                                                      #
      DEF STATE0 #  0 #;     # STATE 0 -- BIT NUM OF COL IN STATE TABLE#
      DEF STATE1 #  6 #;     # STATE 1 --                              #
      DEF STATE2 # 12 #;     # STATE 2 -- BIT NUM OF COL IN STATE TABLE#
      DEF STATE3 # 18 #;     # STATE 3 --                              #
      DEF STATE4 # 24 #;     # STATE 4 --                              #
      ITEM CHARCNT;          # CHARACTER COUNT                         #
      ITEM CHARCNT1;         # CHARACTER COUNT                         #
      ITEM CTEMP C(10);      # CHARACTER TEMPORARY                     #
      ITEM I;                # INTEGER TEMPORARY                       #
      ITEM STATE;            # CURRENT STATE                           #
      ARRAY STATETAB [0:10] S(1);       # STATE TABLE                  #
        ITEM STATETABLE U(0,0,60) = [ 
                       #             /    STATES  # 
                       # STIMULUS  /    0123456789# 
                       # BLANK    #    "AJAAA     ",
                       # LETTER   #    "CCBCC     ",
                       # DIGIT    #    "CCBCC     ",
                       # DELIMITER#    "EEEEE     ",
                       # PERIOD   #    "GGGGG     ",
                       # ASTERISK #    "CCBCC     ",
                       # SPECIAL  #    "FFFFF     ",
                       # EOF      #    "HHHHH     ",
                       # EOC      #    "AAAAA     ",
                       # TRACE    #    "DDDDD     ",
                       # SQUOTE   #    "LLLLJ     "]; 
      SWITCH SDEFJMP ERR,              # COLON 00 # 
                     PROCEED,          # A     01 # 
                     STORCOMMA,        # B     02 # 
                     STORCHAR,         # C     03 # 
                     SETTRACE,         # D     04 # 
                     DELIMITER,        # E     05 # 
                     SPECIAL,          # F     06 # 
                     PERIOD,           # G     07 # 
                     EOF,              # H     10 # 
                     TRANS01,          # I     11 # 
                     TRANS02,          # J     12 # 
                     TRANS03,          # K     13 # 
                     TRANS04;          # L     14 # 
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      P<DT$TEMPLATE> = LOC(DEFNAME[DTWC[0]])+ 1; #INITIALIZE TABLE PNTR#
      DTMP$NAME[0] = SDCLABL[0];       # SAVE DEFINE NAME              #
      DTMP$WCNT[0] = 1;                # INITIALIZE WORD COUNT         #
      CHARCNT = 0;                     # INITIALIZE CHARACTER COUNT    #
      CHARCNT1 = 0 ;                   # INITIALIZE CHARACTER COUNT    #
      STATE = STATE0;                  # INITIALIZE STATE TO STATE 0   #
      IF DT$LENG - DTWC[0] LS 50       # NEED MORE TABLE SPACE         #
      THEN
        BEGIN 
        SSTATS(P<DEFINE$TABLE>,200);
        END 
      IF C<0,1>NEXWORD[0] NQ ","       # SAVE NEXWORD IN DEFINE STRING #
      THEN
        BEGIN 
        FOR I=1 STEP 1 UNTIL NEXLENG DO 
          BEGIN 
          IF CHARCNT GQ 10   # AT END OF WORD                          #
          THEN               # STORE IN NEXT WORD                      #
            BEGIN 
            DTMP$WCNT[0] = DTMP$WCNT[0] + 1;     # INCREMENT WORD COUNT#
            CHARCNT = 0;     # INITIALIZE CHARACTER COUNT              #
            END 
          C<CHARCNT,1>DTMP$DSTRG[DTMP$WCNT[0]] = # STORE CHARACTER FROM#
                 C<CHARCNT1,1>NEXWORD[0]          ;       # NEXWORD    #
          CHARCNT = CHARCNT + 1;       # INCREMENT CHARACTER COUNT     #
          CHARCNT1 = CHARCNT1 + 1;     # BUMP CHARCNT1                 #
          END 
        STATE = STATE2;                # SET STATE TO STATE 2          #
        END 
      IF NEXTYPE EQ TYPEUNK AND NEXLENG EQ 1  # MUST BE A SPECIAL      #
      THEN                                    #   CHARACTER            #
        BEGIN 
        ERRMS1(ERR6,LINE,NEXWORD[0]);# FLAG ERROR                      #
        END 
      IF NEXWORD[0] EQ "."
      THEN
        GOTO PERIOD;
      GOTO STARTSTATE;
#                                                                      #
STORCOMMA:                   # STORE COMMA IN DEFINE STRING            #
      IF CHARCNT GQ 10       # WORD IS FULL                            #
      THEN                   #   STORE IN NEXT WORD                    #
        BEGIN 
        DTMP$WCNT[0] = DTMP$WCNT[0] + 1;   # INCREMENT WORD COUNT      #
        CHARCNT = 0;                   # INITIAL CHARACTER COUNT       #
        END 
      C<CHARCNT,1>DTMP$DSTRG[DTMP$WCNT[0]] = ","; # STORE COMMA        #
      CHARCNT = CHARCNT + 1;                  # INCREMENT CHAR COUNT   #
STORCHAR:                    # STORE CHARACTER IN DEFINE STRING        #
      STATE = STATE1;        # SET STATE TO STATE 2                    #
      IF CHARCNT GQ 10       # WORD IS FULL                            #
      THEN                   #   STORE CHARACTER IN NEXT WORD          #
        BEGIN 
        DTMP$WCNT[0] = DTMP$WCNT[0] + 1;   # INCREMENT WORD COUNT      #
        CHARCNT = 0;                   # INITIALIZE CHARACTER COUNT    #
        END 
      C<CHARCNT,1>DTMP$DSTRG[DTMP$WCNT[0]] = CURCHAR;#PUT CHAR IN STRNG#
      CHARCNT = CHARCNT  + 1;          # INCREMENT CHARACTER COUNT     #
#                                                                      #
PROCEED:                     # GET NEXT CHARACTER                      #
      GETSCHAR(CURCHAR,LINE,CURSTAT); 
#                                                                      #
STARTSTATE: 
      GOTO SDEFJMP[B<STATE,6>STATETABLE[CURSTAT]];
#                                                                      #
SETTRACE: 
      TFLAG = TFLAG + 1;# RESECT TRACE FLAG                            #
      GOTO PROCEED; 
#                                                                      #
DELIMITER:  
      STATE = STATE3;        # SET STATE TO STATE 3                    #
      IF CHARCNT GQ 10     # WORD IS FULL                              #
      THEN                 # STORE CHARACTER IN NEXT WORD              #
        BEGIN 
        DTMP$WCNT[0] = DTMP$WCNT[0] + 1; # INCREMENT WORD COUNT        #
        CHARCNT = 0;
        END 
      C<CHARCNT,1>DTMP$DSTRG[DTMP$WCNT[0]] = CURCHAR;#PUT CHAR IN STRNG#
      CHARCNT = CHARCNT + 1;         # INCREMENT CHARACTER COUNT       #
      GOTO PROCEED;        # GET NEXT CHARACTER                        #
#                                                                      #
SPECIAL:  
      CTEMP = CURCHAR;
      ERRMS1(ERR6,LINE,CTEMP);  # MAKE ENTRY IN ERROR-FILE             #
      STATE = STATE2;        # SET STATE TO STATE 2                    #
      GOTO STORCHAR;         # STORE CHARACTER                         #
#                                                                      #
PERIOD:                      # MARKS END OF DEFINE STRING              #
      IF CHARCNT GQ 10       # WORD IS FULL                            #
      THEN                   #   STORE PERIOD IN NEXT WORD             #
        BEGIN 
        DTMP$WCNT[0] = DTMP$WCNT[0] + 1;   # INCREMENT WORD COUNT      #
        CHARCNT = 0;                   # INTIALIZE CHARACTER COUNT     #
        END 
      C<CHARCNT,1>DTMP$DSTRG[DTMP$WCNT[0]] = ".";       # STORE PERIOD #
      CHARCNT = CHARCNT + 1; # INCREMENT CHARACTER COUNT               #
      IF CHARCNT LS 10       # IF WORD IS NOT FULL                     #
      THEN                   #   ZERO FILL REST OF WORD                #
        BEGIN 
        FOR I=CHARCNT STEP 1 UNTIL 9 DO 
          B<I*6,6>DTMP$DSTRG[DTMP$WCNT[0]] = " "; 
        END 
      DTWC[0] = DTWC[0] + DTMP$WCNT[0] + 1;   # INCR DEF TAB WORD COUNT#
      IF CURSTAT EQ STAT"PER"# IF CURRENT CHARACTER IS PERIOD          #
      THEN                   #   STORE IT IN NEXWORD                   #
        LEXSCAN;
#                                                                      #
EOF:  
      LEXSCAN;
ERR:  
      RETURN;                # **** RETURN ****                        #
#                                                                      #
TRANS01:  
      STATE = STATE1;        # SET STATE                               #
      GOTO PROCEED;          #   GET NEXT CHARACTER                    #
#                                                                      #
TRANS02:  
      STATE = STATE2; 
      GOTO PROCEED; 
#                                                                      #
TRANS03:  
      STATE = STATE3; 
      GOTO PROCEED; 
#                                                                      #
TRANS04:  
      STATE = STATE4; 
      GOTO PROCEED; 
END # SDEFINE # 
      CONTROL EJECT;
      PROC STERM(TRPTINFO,TLINE,TCSTMT,TL$STID);
      BEGIN                  # STATEMENT TERMINATION ROUTINE           #
*IF,DEF,IMS 
# 
**    STERM - STATEMENT TERMINATION ROUTINE 
* 
*     D.K. ENDO    81/10/29 
* 
*     THIS PROCEDURE DOES FINAL CHECKING AND PROCESSING ON A STATEMENT. 
* 
*     PROC STERM(TRPTINFO,TLINE,TCSTMT,TL$STID) 
* 
*     ENTRY        TRPTINFO = REPEAT INFORMATION. 
*                  TLINE = CURRENT SOURCE LINE NUMBER.
*                  TCSTMT = CURRENT STATEMENT INFORMATION.
*                  TL$STID = PREVIOUS STATEMENT-S I.D.
* 
*     EXIT         NONE.
* 
*     METHOD
* 
*     IF CURRENT STATEMENT IS GROUP AND NI NOT SPECIFIED, 
*       DEFAULT NI TO ONE.
*     IF CURRENT LINE IS X.25,
*       IF STATEMENT IS GROUP,
*       THEN
*         FLAG ERROR -- GROUP NOT ALLOWED FOR X.25. 
*         SET LABEL ERROR FLAG. 
*         CLEAR LABEL POINTER.
*       OTHERWISE,
*         IF CURRENT STATEMENT IS TERMINAL OR TERMDEV 
*           IF CURRENT CIRCUIT IS SVC,
*           THEN, 
*             IF CURRENT CIRCUIT COUNT IS ZERO, 
*               DEFAULT CIRCUIT COUNT TO ONE. 
*           OTHERWISE,
*             CLOSE THE CIRCUIT COUNT.
*     IF NI IS GREATER THAN ZERO, 
*     THEN, 
*       IF PORT NUMBER IS GREATER THAN ZERO,
*       THEN, 
*         IF LABEL WAS SPECIFIED AND IS O.K.
*         THEN, 
*           GENERATE NAMES FOR GROUP. 
*         IF ERRORS WERE DETECTED IN NAME GENERATION, 
*         THEN, 
*           SET LABEL ERROR FLAG. 
*           CLEAR LABEL POINTER.
*         OTHERWISE,
*           SAVE LABEL POINTER. 
*       OTHERWISE,
*         FLAG ERROR -- NO PORT, NAME GENERATION SUPPRESSED.
*         SET LABEL ERROR FLAG. 
*         CLEAR LABEL POINTER.
*     OTHERWISE,
*       IF NCIR IS GREATER THAN ZERO, 
*       THEN
*         IF LABEL WAS SPECIFIED AND IS O.K., 
*           GENERATE NAMES FOR CIRCUITS 
*         IF ERRORS DETECTED IN NAME GENERATION,
*         THEN, 
*           SET LABEL ERROR FLAG. 
*           CLEAR LABEL POINTER.
*         OTHERWISE,
*           SAVE LABEL POINTER. 
*       OTHERWISE,
*         IF LABEL WAS SPECIFIED AND IS O.K., 
*           SEARCH LABEL TABLE FOR CURRENT LABEL. 
*           IF FOUND, 
*           THEN, 
*             FLAG ERROR -- DUPLICATE LABEL NAME. 
*           OTHERWISE,
*             PUT LABEL INTO LABEL TABLE. 
*             SAVE LABEL POINTER. 
*     SELECT CASE THAT APPLIES, 
*       CASE 1(TERMINAL): 
*         WRITE TERMINAL STATEMENT ENTRY TO STATEMENT TABLE FILE. 
*       CASE 2(TERMDEV):  
*         WRITE TERMINAL STATEMENT ENTRY TO STATEMENT TABLE FILE. 
*         WRITE STATEMENT ENTRY BUFFER TO STATEMENT TABLE FILE. 
*       CASE 3(ALL OTHER STATEMENTS): 
*         WRITE STATEMENT ENTRY BUFFER TO STATEMENT TABLE FILE. 
*     IF CURRENT STATEMENT IS NOT TRUNK,
*       SAVE CURRENT STATEMENT I.D. 
*     CLEAR KEYWORD ORDINAL TABLE.
*     CLEAR VALUE DECLARATION PORTION FLAG. 
* 
# 
*ENDIF
      ITEM TLINE;            # CURRENT LINE NUMBER                     #
      ITEM TL$STID;          # LAST STATEMENT-ID                       #
      ARRAY TRPTINFO [0:0] S(1);       # REPEAT INFORMATION            #
        BEGIN 
        ITEM TGRPFLG B(0,0,1);         # GROUP FLAG                    #
        ITEM TSVC    B(0,1,1);         # SVC FLAG                      #
        ITEM TPRTNUM U(0,6,9);         # PORT NUMBER                   #
        ITEM TGRPCNT U(0,15,9);        # GROUP COUNT                   #
        ITEM TNCIR   U(0,24,9);        # CIRCUIT COUNT                 #
        END 
      ARRAY TCSTMT [0:0] S(1);         # CURRENT STATEMENT INFO        #
        BEGIN 
        ITEM TCSTID U(0,0,9);          # STATEMENT-ID                  #
        ITEM TCEFLG B(0,15,1);         # LABEL ERROR FLAG              #
        ITEM TCLABL C(0,18,7);         # LABEL-NAME                    #
        END 
#                                                                      #
      ITEM CTEMP C(10);      # CHARACTER TERMPORARY                    #
      ITEM FOUND B;          # FOUND FLAG                              #
      ITEM ITEMP;            # INTEGER TEMPORARY                       #
      ITEM TSTAT B;          # STATUS RETURNED FROM NAMEGEN            #
#                                                                      #
      SWITCH STRMJUMP EXIT,            # NULL STATEMENT # 
                      OTHERS,          # NFILE    # 
                      OTHERS,          # NPU      # 
                      OTHERS,          # SUPLINK  # 
                      OTHERS,          # COUPLER  # 
                      OTHERS,          # LOGLINK  # 
                      OTHERS,          # GROUP    # 
                      OTHERS,          # LINE     # 
                      EXIT,            #          # 
                      TERMINAL$,       # TERMINAL # 
                      OTHERS,          # DEVICE   # 
                      OTHERS,          # TRUNK    # 
                      OTHERS,          # LFILE    # 
                      OTHERS,          # USER     # 
                      OTHERS,          # APPL     # 
                      OTHERS,          # OUTCALL  # 
                      OTHERS,          # INCALL   # 
                      NEXT,            # END      # 
                      TERMDEV,         # TERMDEV  # 
                      EXIT,            # DEFINE   # 
                      EXIT,            # COMMENT  # 
                      EXIT;            # TITLE    # 
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      IF TCSTID[0] EQ STID"GROUP" AND              # NI PARAMETER WAS  #
         TGRPCNT[0] EQ 0
      THEN                                         # NOT SPECIFIED     #
        BEGIN 
        TGRPCNT[0] = 1;      # DEFAULT IS ONE                          #
        END 
      IF CRNT$TIP EQ "X25" OR          # IF X25 LINE                   #
       ((CRNT$LTYPE EQ "H1" OR CRNT$LTYPE EQ "H2") AND
        C<0,3>CRNT$TIP EQ USER$TIP) 
      THEN
        BEGIN 
        IF TCSTID[0] EQ STID"GROUP"    # IF CRNT STMT IS -GROUP-       #
        THEN
          BEGIN              # CLEAR GROUP COUNT                       #
          TGRPCNT[0] = 0;    # FLAG ERROR - GROUP INVALID FOR X25      #
          ERRMS1(ERR28,TLINE," ");
          STLBERR[1] = TRUE;           # SET LABEL ERROR FLAG          #
          STLBPNTR[1] = 0;             # CLEAR LABEL POINTER           #
          END 
        ELSE                           # NOT A GROUP STMT              #
          BEGIN                        # IF CRNT STMT IS TERMINAL OR   #
          IF TCSTID[0] EQ STID"TRMNL" OR         # TERMDEV             #
             TCSTID[0] EQ STID"TERMDEV" 
          THEN
            BEGIN 
            IF TSVC[0]                 # IF CURRENT CIRCUIT IS -SVC-   #
            THEN
              BEGIN 
              IF TNCIR[0] EQ 0         # IF CIRCUIT COUNT IS ZERO      #
              THEN
                BEGIN 
                TNCIR[0] = 1;          # DEFAULT COUNT TO ONE          #
                END 
              END 
            ELSE                       # NOT AN SVC CIRCUIT            #
              BEGIN 
              TNCIR[0] = 0;            # CLEAR CIRCUIT COUNT           #
              END 
            END 
          END 
        END 
      ELSE                             # NOT AN X25 LINE               #
        BEGIN 
        TNCIR[0] = 0;                  # CLEAR CIRCUIT COUNT           #
        END 
      IF TGRPCNT[0] GR 0     # GROUP STMT WAS SPECIFIED                #
      THEN
        BEGIN 
        IF TPRTNUM GR 0      # PORT WAS SPECIFIED OR IS O.K.           #
        THEN
          BEGIN 
          IF NOT TCEFLG[0] AND TCLABL[0] NQ " " 
          THEN                         # NO LABEL ERROR AND A LABEL    #
            BEGIN                      #   EXISTS                      #
            ITEMP = LABLCNT[0] + 1;    # SAVE LABEL TABLE POINTER      #
            CTEMP = TCLABL[0];         # PUT ROOT-NAME IN TEMPORARY    #
            NAMEGEN(CTEMP,TGRPCNT[0],TNCIR[0],TPRTNUM[0],TLINE,TSTAT);
                                       # GENERATE GROUP/DEVICE NAMES   #
            IF NOT TSTAT     # ERRORS WERE DETECTED IN NAME GENERATION #
            THEN
              BEGIN 
              STLBERR[1] = TRUE;       # SET LABEL ERROR FLAG          #
              STLBPNTR[1] = 0;         # CLEAR LABEL TABLE POINTER     #
              END 
            ELSE             # NO ERRORS DETECTED                      #
              BEGIN 
              STLBPNTR[1] = ITEMP;     # SET LABEL TABLE POINTER       #
              END 
            END 
          END 
        ELSE                 # NO PORT NUMBER                          #
          BEGIN 
          CTEMP = TCLABL[0];
          ERRMS1(ERR32,TLINE,CTEMP);   # FLAG ERROR                    #
          STLBERR[1] = TRUE; # SET LABEL ERROR FLAG                    #
          STLBPNTR[1] = 0;   # CLEAR LABEL TABLE POINTER               #
          END 
        END 
      ELSE                   # NO GROUP STMT SPECIFIED                 #
        BEGIN 
        IF TNCIR[0] GR 0     # NCIR VALUE WAS SPECIFIED                #
        THEN
          BEGIN 
          IF NOT TCEFLG[0] AND TCLABL[0] NQ " " 
          THEN                         # NO LABEL ERROR AND A LABEL    #
            BEGIN                      #   EXISTS                      #
            ITEMP = LABLCNT[0] + 1;    # SAVE LABEL TABLE POINTER      #
            CTEMP = TCLABL[0];         # PUT ROOT-NAME IN TEMPORARY    #
            FOR I = 4 STEP -1 WHILE C<I,1>CTEMP EQ " "
            DO               # CHARACTER ZERO-FILL NAME TO RIGHT       #
              BEGIN 
              C<I,1>CTEMP = "0";
              END 
            STLABEL[1] = CTEMP;        # REPLACE NEW NAME IN TABLE     #
            NAMEGEN(CTEMP,TGRPCNT[0],TNCIR[0],TPRTNUM[0],TLINE,TSTAT);
                                       # GENERATE GROUP/REPEAT NAMES   #
            IF NOT TSTAT     # ERRORS DETECTED IN NAME GENERATION      #
            THEN
              BEGIN 
              STLBERR[1] = TRUE;       # SET LABEL ERROR FLAG          #
              STLBPNTR[1] = 0;         # CLEAR LABEL TABLE POINTER     #
              END 
            ELSE
              BEGIN 
              STLBPNTR[1] = ITEMP;     # SET LABEL TABLE POINTER       #
              END 
            END 
          END 
        ELSE                 # JUST ENTER LABEL INTO LABEL-TABLE       #
          BEGIN 
          IF NOT TCEFLG[0]   # IF LABEL IS O.K.                        #
          THEN
            BEGIN 
            IF TCLABL[0] NQ BLANK      # IF LABEL IS NOT BLANK         #
            THEN
              BEGIN 
              FOUND = FALSE;           # CLEAR FOUND FLAG              #
              FOR I=1 STEP 1 WHILE NOT FOUND AND I LQ LABLCNT[0]
              DO
                BEGIN        # SEARCH FOR LABEL IN LABEL-TABLE         #
                IF TCLABL[0] EQ LABLNAM[I]
                THEN
                  BEGIN      # IF LABEL IS FOUND AND NOT A PID STMT    #
                  TCEFLG[0] = TRUE;    # SET LABEL ERROR FLAG          #
                  FOUND = TRUE;        # SET FOUND FLAG                #
                             # FLAG ERROR -- DUPLICATE LABEL           #
                  ERRMS1(ERR1,TLINE,TCLABL[0]); 
                  END 
                END 
              IF NOT FOUND   # IF NOT A DUPLICATE LABEL                #
              THEN
                BEGIN 
                IF LABLCNT[0] GQ LT$LENG - 1   # NEED MORE TABLE SPACE #
                THEN
                  BEGIN 
                  SSTATS(P<LABEL$TABLE>,500); 
                  END 
                LABLCNT[0] = LABLCNT[0] + 1; # INCREMENT LABEL COUNT   #
                LABEL$WORD[LABLCNT[0]] = 0;  # CLEAR ENTRY             #
                LABLNAM[LABLCNT[0]] = TCLABL[0]; # PUT LABEL INTO TABLE#
                STLBPNTR[1] = LABLCNT[0];    # SAVE LABEL POINTER      #
                END 
              END 
            END 
          END 
        END 
#                                                                      #
      GOTO STRMJUMP[TCSTID[0]];        # WRITE BUFF TO STMT TABLE FILE #
#                                                                      #
TERMINAL$:  
      ITEMP = TBWC[0] + 1;             # ENTRY WORD COUNT PLUS HEADER  #
      WRITEW(STFET,TERM$BUFFER,ITEMP); # WRITE TERMINAL BUFFER TO FILE #
      GOTO NEXT;
#                                                                      #
TERMDEV:  
      ITEMP = TBWC[0] + 1;             # CALCULATE WORD COUNT          #
      WRITEW(STFET,TERM$BUFFER,ITEMP); # WRITE TEMINAL BUFFER TO FILE # 
OTHERS: 
      ITEMP = STWC[0] + 1;             # ENTRY WORD COUNT PLUS HEADER  #
      WRITEW(STFET,STMT$TABLE,ITEMP);  # WRITE STMT$TABL BUFFER TO FILE#
      GOTO NEXT;
#                                                                      #
NEXT: 
      IF TCSTID[0] NQ STID"TRUNK"      # IF CURRENT STMT IS NOT -TRUNK-#
      THEN
        BEGIN 
        TL$STID = TCSTID;              # SAVE THE CURRENT STMT I.D.    #
        END 
      IF TCSTID[0] EQ STID"DEVICE" OR 
         TCSTID[0] EQ STID"TERMDEV" 
      THEN                   # IF CRNT STMT IS DEVICE OR TERMDEV       #
        BEGIN 
        IF STORD1[2] EQ 0 
        THEN                 # IF -DT- WAS NOT SPECIFIED               #
          BEGIN              #  ASSUME A DEFAULT OF CONSOLE            #
          B<CMAP$B,1>CMWORD[CMAP$W] = 1;  # SET FLAG                   #
          END 
        ELSE                 # -DT- WAS SPECIFED                       #
          BEGIN 
          IF STVALNAM[STORD1[2]] EQ "CON" OR
             STVALNAM[STORD1[2]] EQ "DT7" OR
             STVALNAM[STORD1[2]] EQ "AP"
          THEN               # IF -DT- VALUE IS CONSOLE                #
            BEGIN 
            B<CMAP$B,1>CMWORD[CMAP$W] = 1;# SET FLAG                   #
            END 
          ELSE
            BEGIN 
                                          # DT IS NOT CON              #
            IF B<CMAP$B,1>CMWORD[CMAP$W] EQ 0#IF NO CONSOLE DEFINED YET#
            THEN
              BEGIN 
              ERRMS1(ERR41,TLINE,STVALNAM[STORD1[2]]);
              END 
            END 
          END 
        END 
      FOR ITEMP = 0 STEP 1 UNTIL MXKYWD DO
        BEGIN 
        KYWD$ORD[ITEMP] = 0; # CLEAR ORDINAL TABLE                     #
        END 
EXIT: 
      VAL$DEC = FALSE;       # NO LONGER VALUE-DEC PORTION - CLEAR FLAG#
      RETURN;                # **** RETURN ****                        #
      END # STERM # 
      CONTROL EJECT;
      PROC STITLE(STTLINE); 
      BEGIN 
*IF,DEF,IMS 
# 
**    STITLE - STORE TITLE. 
* 
*     D.K. ENDO    81/10/29 
* 
*     THIS PROCEDURE TITLE TEXT FOR FILE HEADER RECORD
* 
*     PROC STITLE(STTLINE)
* 
*     ENTRY        STTLINE = SOURCE LINE NUMBER.
* 
*     EXIT         NONE.
* 
*     METHOD
* 
*     IF TITLE WAS SPECIFIED ALREADY, 
*       FLAG ERROR -- PREVIOUS TITLE OVER-WRITTEN.
*     IF CURRENT CHARACTER IS NOT A PERIOD, 
*     THEN, 
*       IF CURRENT CHARACTER IS A COMMA,
*         SKIP TO NEXT CHARACTER. 
*       FOR EACH CHARACTER UNTIL PERIOD OR 45 CHARACTERS
*         PUT CHARACTER IN THE TITLE STRING 
*       IF PERIOD NOT FOUND,
*       THEN, 
*         FLAG ERROR -- STORED ONLY 1ST 45 CHARACTERS 
*       OTHERWISE,
*         GET TOKEN FOR NEXT LINE.
*     OTHERWISE,
*       GET TOKEN FOR NEXT LINE.
* 
# 
*ENDIF
      ITEM STTLINE;          # LINE NUMBER OF TITLE STATEMENT          #
#                                                                      #
      ITEM FOUND B;          # FLAG SET IF PERIOD IS FOUND             #
      ITEM I;                # SCRATCH ITEM                            #
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      TITLE$WORD[0] = " ";   # CLEAR TEXT FOR TITLE                    #
      IF TITLE$FLAG          # IF TITLE WAS SPECIFIED ALREADY          #
      THEN
        BEGIN 
        ERRMS1(ERR33,STTLINE,BLANK);   # FLAG ERROR -- THIS TITLE OVER-#
        END                            #   RIDES PREVIOUS ONE          #
      ELSE                   # TITLE NOT SPECIFIED YET                 #
        BEGIN 
        TITLE$FLAG = TRUE;   # SET TITLE FLAG                          #
        END 
      IF CURSTAT EQ STAT"BLANK"        # IF CURRENT CHARACTER IS BLANK,#
      THEN                             #   SCAN TO 1ST NON-BLANK       #
        BEGIN 
        FOR I=0 WHILE CURSTAT EQ STAT"BLANK" DO 
          BEGIN 
          GETSCHAR(CURCHAR,LINE,CURSTAT); 
          END 
        END 
      IF CURSTAT NQ STAT"PER"          # IF CURRENT CHARACTER IS NOT   #
      THEN                             #   A PERIOD, STORE TEXT        #
        BEGIN 
        IF CURCHAR EQ ","              # IF FIRST NON-BLANK IS A COMMA,#
        THEN                           #   IGNORE IT                   #
          BEGIN 
          GETSCHAR(CURCHAR,LINE,CURSTAT); 
          END 
        FOUND = FALSE;       # CLEAR PERIOD FOUND FLAG                 #
        FOR I=0 STEP 1 WHILE I LS 45 AND NOT FOUND DO 
          BEGIN                        # STORE TITLE TEXT TILL PERIOD  #
          IF CURSTAT EQ STAT"PER"      #   OR FIRST 45 CHARACTERS      #
          THEN                         # IF CURRENT CHAR IS A PERIOD,  #
            BEGIN 
            FOUND = TRUE;              # SET PERIOD FOUND FLAG         #
            END 
          ELSE               # NON-PERIOD                              #
            BEGIN 
            C<I,1>TITLE$WORD[0] = CURCHAR;       # STORE CHARACTER     #
            GETSCHAR(CURCHAR,LINE,CURSTAT);      # GET NEXT CHARACTER  #
            END 
          END 
        IF NOT FOUND AND CURCHAR NQ "." 
        THEN                 # IF NO PERIOD FOUND YET                  #
          BEGIN 
          ERRMS1(ERR34,LINE,BLANK);    # FLAG ERROR -- STORED ONLY 1ST #
          SCNTOPRD;                    #   45 CHARACTERS               #
          END 
        ELSE                 # PERIOD WAS FOUND                        #
          BEGIN 
          LEXSCAN;           # PUT PERIOD IN NEXWORD                   #
          LEXSCAN;           # EXECUTES LINE TERMINATION PROCEDURES    #
          END                #   FORMS 1ST ELEMENT ON NEXT LINE        #
        END 
      ELSE                   # NO TEXT FOR TITLE                       #
        BEGIN 
        COL = COL + 1;       # SKIP SCAN OF PERIOD                     #
        GETSCHAR(CURCHAR,LINE,CURSTAT); 
        LEXSCAN;             # PUT PERIOD IN NEXWORD                   #
                             # EXECUTES LINE TERMINALTION PROCEDURES   #
        END                  #   FORMS 1ST ELEMENT ON NEXT LINE        #
      RETURN;                # **** RETURN ****                        #
      END # STITLE #
      CONTROL EJECT;
#                     SSSSSS   U       U  BBBBBBB    RRRRRRR           #
#                    S      S  U       U  B      B   R      R          #
#                   S          U       U  B       B  R       R         #
#                    S         U       U  B      B   R      R          #
#                     SSSSS    U       U  BBBBBBB    RRRRRRR           #
#                          S   U       U  B      B   R    R            #
#                           S  U       U  B       B  R     R           #
#                   S      S    U     U   B      B   R      R          #
#                    SSSSSS      UUUUU    BBBBBBB    R       R         #
#                                                                      #
CKCMNT: 
      IF B<51,9>NEXLXID EQ STID"COMMENT"
      THEN
        STDYES; 
      ELSE
        STDNO;
CKLBNM: 
      CTEMP = CURWORD[0]; 
      CKLNAME(CTEMP,CURTYPE,CURLXID,CURLENG,KWDFLAG,NEXWORD[0], 
                                   CURLINE,CKSTAT); 
      CURLABL[0] = CTEMP;    # SAVE STATEMENT LABEL                    #
      CURKLBL[0] = KWDFLAG;  # SET IF LABEL IS KEYWORD                 #
      IF CKSTAT              # IF THE LABEL IS O.K.                    #
      THEN
        CUREFLG[0] = FALSE;  # CLEAR LABEL ERROR FLAG                  #
      ELSE                   # LABEL IS NOT O.K.                       #
        CUREFLG[0] = TRUE;   # SET LABEL ERROR FLAG                    #
      STDNO;                 # RETURN TO STD WITH STDFLAG=NO           #
CKSTDEC:  
      CKSTMTDEC(CURSTMT,CURWORD[0],CURLXID,CURMAP,
                        RPTINFO,CURLINE,LAST$STID,CKSTAT);
      IF CKSTAT 
      THEN
        BEGIN 
        CURSTID[0] = B<54,6>CURLXID;   # SAVE STMT-ID OF CURRENT STMT  #
        STDYES;                        # RETURN TO STD WITH -YES-      #
        END 
      ELSE
        STDNO;               # RETURN TO STD WITH STDFLAG = NO         #
SCNTOPD:  
      SCNTOPRD; 
      STDNO;
CKDELIM:  
      IF B<50,1>NEXLXID EQ 1
      THEN                   # DELIMITER FLAG IS SET                   #
        STDYES;              #   RETURN STATUS OF -YES-                #
      ELSE                   # NEXWORD IS NOT A DELIMITER              #
        STDNO;               #   RETURN STATUS OF -NO-                 #
CKDEFNM:  
      IF NEXTYPE EQ TYPENAM  # IF NEXWORD IS A NAME                    #
      THEN
        BEGIN                # CHECK IF IT IS A DEFINE-NAME            #
        CKDEFNAM(NEXWORD[0],DEFFLAG,NEXLENG,NEXLINE,CKSTAT);
        IF CKSTAT            # NEXWORD WAS A DEFINE NAME               #
        THEN
          STDYES;            # RETURN STATUS OF -YES-                  #
        ELSE                 # NEXWORD IS NOT A DEFINE NAME            #
          STDNO;             # RETURN STATUS OF -NO-                   #
        END 
      ELSE                   # NEXWORD IS NOT A NAME                   #
        STDNO;
CKKYWD: 
      CKKWD(CURWORD[0],CURSTMT,NEXWORD[0],CURLXID,
                               CURMAP,RPTINFO,CURLINE,CKSTAT);
      IF CKSTAT 
      THEN
        BEGIN 
        KWID = B<51,9>CURLXID;         # SAVE KEYWORD-ID               #
        STDYES;              # RETURN TO STD WITH STDFLAG = YES        #
        END 
      ELSE
        STDNO;               # RETURN TO STD WITH STDFLAG = NO         #
CKVALDC:  
      PERIOD$SKIP = FALSE;
      CKVDEC(KWID,CWORD,CURLENG,CURLINE,CURSTMT,RPTINFO); 
      STDNO;
STORDEF:  
      SDEFINE(CURSTMT); 
      STDNO;
STORTITLE:  
      STITLE(NEXLINE);
      STDNO;
STMTTRM:  
      RINFOWORD = RPTINFO$WORD[0];  # SAVE REPEAT INFORMATION          #
      IF CURSTID[0] EQ STID"TRUNK"
      THEN
        BEGIN 
        RPTINFO$WORD[0] = 0; # CLEAR REPEAT INFORMATION                #
        END 
      STERM(RPTINFO,CURLINE,CURSTMT,LAST$STID); 
      RPTINFO$WORD[0] = RINFOWORD; # RESTORE REPEAT INFORMATION        #
      STDNO;
PSS1TRM:  
      PS1TERM(CURSTMT,NEXWORD[0],CURLINE,EOFFLAG);
      STD$RET;               # **** RETURN ***** TO PASS 1             #
      END # SUBR #
      CONTROL EJECT;
#                      PASS1 CODE BEGINS HERE                          #
#                                                                      #
      LBLPNTR = LOC(LBLPTRS);          # SAVE LOCATION OF LBLPTRS TABLE#
      SWITCHV = LOC(SUBRJUMP);
      SYNTBL = LOC(SYNTBLE);           # SAVE LOCATION OF SYNTAX TABLE #
      TRACE = LOC(TRACEM);             # SAVE LOCATION OF TRACE TABLE  #
      NDLDIAG = LOC(DIAG);             # SAVE LOCATION OF DIAG         #
      P<LEXICN> = LOC(LEXICON);        # SET ARRAY TO LEXICON          #
      P<LXWRDS> = LOC(LEXWORD);        # SET ARRAY TO LEXWORD          #
      P<INPTEMPLET> = LOC(INPLINE[0]); # POINT TO BUFFER FOR READH     #
      COL = 0;               # INITIALIZE COLUMN COUNT                 #
      DEFCOL = 20;           # INITIALIZE ESIBUFF COLUMN POINTER       #
      LABLCNT[0] = 0;        # INITIALIZE LABEL COUNT                  #
      LCFDIV = FALSE;        # INITIALIZE LCF DIVISION FLAG            #
      LINE = 1;              # INITIALIZE SOURCE LINE COUNT            #
      LINECTR = 1;           # INITIALIZE TOTAL LINE COUNT             #
      LINELMT = 100000;      # LINITIALIZE TOTAL LINE COUNT LIMIT      #
      PERIOD$SKIP = FALSE;   # INITIALIZE PERIOD SKIP TO FALSE         #
      NCFDIV = FALSE;        # CLEAR NCF DIVISION FLAG                 #
      ENDFLAG = FALSE;       # INITIALIZE END FLAG TO NOT DETECTED     #
      EOFFLAG = FALSE;       # INITIALIZE EOF FLAG                     #
      ERRCNT = 0;            # CLEAR FATAL ERROR COUNT                 #
      ESIBUFF[0] = " ";      # CLEAR ESI BUFFER                        #
      FIRST$STMT = TRUE;     # INITIAL FIRST STMT FLAG                 #
      INPWRD1 = " ";         # CLEAR WORD 1 OF INPUT BUFFER            #
      INPWRD2 = " ";         # CLEAR WORD 2 OF INPUT BUFFER            #
      INPLNUM = "    1";     # INITIALIZE LINE NUMBER ON SOURCE LINE   #
      ESILINE[0] = INPLNUM[0];         # DO SAME FOR ESI BUFFER        #
      DEFFLAG = FALSE;       # INITIALIZE DEFINE FLAG                  #
      SCN$TO$END  = FALSE;   # INITIALIZE IGNORE DIVISION FLAG         #
      TITLE$FLAG = FALSE;    # CLEAR TITLE SPECIFIED FLAG              #
      TITLE$WORD[0] = " ";   # CLEAR TITLE TEXT                        #
      VAL$DEC = FALSE;       # CLEAR VALUE-DEC FLAG                    #
      WARNCNT = 0;           # CLEAR WARNING ERROR COUNT               #
      P<CHARSET> = 55;       # SET ARRAY TO CHARACTER SET INDICATOR    #
      FOR I=0 STEP 1 UNTIL LT$LENG - 1 DO 
        BEGIN                # CLEAR DEFINE TABLE                      #
        DTWORD[I] = 0;
        END 
      FOR I=0 STEP 1 UNTIL MXKYWD DO
        BEGIN 
        KYWD$ORD[I] = 0;     # CLEAR ORDINAL TABLE                     #
        END 
      IF FIRSTDIV 
      THEN
        BEGIN 
        READH(INFET,INPTEMPLET,9,CURSTAT);       # READ IN FIRST LINE  #
        IF CURSTAT NQ TRNS$OK          # NO TEXT IN FILE OR NO FILE    #
        THEN
          BEGIN 
          MESSAGE(EMPTY$FILE,0);       # ISSUE DAYFILE MSG, EMPTY FILE #
          ABORT;             # ABORT JOB                               #
          END 
        END 
      GETSCHAR(CURCHAR,LINE,CURSTAT);  # GET FIRST CHARACTER           #
      REWIND(STFET);         # REWIND STATEMENT TABLE FILE             #
      RECALL(STFET);
      REWIND(ERR1FET);       # REWIND PASS 1 ERROR FILE                #
      RECALL(ERR1FET);
      REWIND(SECFET);        # REWIND SECONDARY INPUT FILE             #
      RECALL(SECFET); 
      REWIND(ESIFET);        # REWIND EXPANDED SECONDARY INPUT FILE    #
      RECALL(ESIFET); 
      LEXSCAN;               # GET FIRST WORD                          #
      STD$START;             # TRANSFER CONTROL TO SYNTAX TABLE DRIVER #
      RETURN;                # **** RETURN **** TO MAIN                #
      END # NDLPSS1 # 
      TERM
Retro1.org codex

Table of Contents

NDLPSS1

Table Of Contents

Source Code
