*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 = CDTMP$DSTRG[DSTRNG$WORD]; # GET NEXT CHARACTER# DCHARCNT = DCHARCNT + 1; # INCREMENT CHARACTER COUNT # CESIBUFF[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 CDTMP$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 CESIBUFF[0] = CINPLINE[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 = CINPLINE[0]; CESIBUFF[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 CINPLINE[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) # CNEXWORD[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 # CESIBUFF[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[BSTATETABLE[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 = CCDWORD[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 = CCHWORD[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 # BHEXV[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 = LOC(CSET$TABLE); # POINT TEMPLATE TO TABLE # GOTO CHECK$TABLE; CIRC$TYPE: P = LOC(CTYP$TABLE); GOTO CHECK$TABLE; EB$RES: P = LOC(EBR$TABLE); GOTO CHECK$TABLE; EOL$MODE: P = LOC(ELO$TABLE); GOTO CHECK$TABLE; DEVICE$TYPE: P = LOC(DT$TABLE); GOTO CHECK$TABLE; INPUT$DEVICE: P = LOC(IN$TABLE); GOTO CHECK$TABLE; LINE$SPEED: P = LOC(LSPEED$TABLE); GOTO CHECK$TABLE; LINE$TYPE: P = LOC(LTYPE$TABLE); GOTO CHECK$TABLE; LINK: P = LOC(LINK$TABLE); GOTO CHECK$TABLE; LOC$: P = LOC(LOC$TABLE); GOTO CHECK$TABLE; OUTPUT$DEV: P = LOC(OP$TABLE); GOTO CHECK$TABLE; PARITY: P = LOC(PA$TABLE); GOTO CHECK$TABLE; PSN: P = LOC(PSN$TABLE); GOTO CHECK$TABLE; SUB$DEV$TYPE: P = LOC(SDT$TABLE); GOTO CHECK$TABLE; SUB$TIPTYPE: P = LOC(STIP$TABLE); GOTO CHECK$TABLE; TERM$CLASS: P = LOC(TC$TABLE); GOTO CHECK$TABLE; TERM$SPEED: P = LOC(TSPEED$TABLE); GOTO CHECK$TABLE; TIPTYPE: P = LOC(TPTYPE$TABLE); GOTO CHECK$TABLE; YES$NO: P = 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 = 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,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 BKMAP[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 BSAMAP[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 BSAWMAP[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,MXCM); SSTATS(P,MXCOUP); SSTATS(P,MXLLINK*2); SSTATS(P,MXLLINK); SSTATS(P,MXNPU); SSTATS(P,MXTNI); SSTATS(P,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,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,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 CVWORD[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 CVWORD[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 CVWORDT[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 CVWORD[WDC] = A$CHAR[CVWORDT[WDCT]]; BTC = BTC + 2; # BUMP CHAR INDEX # VLENG1 = VLENG1 + 2; # BUMP LENGTH BY 2 # END ELSE # NO DOUBLE QUOTE FOUND # BEGIN # NO CONVERSION # CVWORD[WDC] = CVWORDT[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,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,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,200); SSTATS(P,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,10); # ALLOCATE MORE SPACE # SSTATS(P,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,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,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,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,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,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,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,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 CRPTNAME 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 CNAME$TEMP = C<8,2>CTEMP;# CONCAT PORT TO NAME # END ELSE # MUST BE ONLY ONE CHARACTER # BEGIN CNAME$TEMP = "0"; # CONCAT PORT TO NAME # CNAME$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 CNAME$TEMP = C<8,2>CTEMP;# CONCAT CNT TO NAME# END ELSE BEGIN # MUST BE ONE CHAR LONG # CNAME$TEMP = "0"; # CONCAT COUNT TO NAME # CNAME$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,-LNT$LENG); # RELEASE LL NODE TABLE # SSTATS(P,-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 = 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,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 CDTMP$DSTRG[DTMP$WCNT[0]] = # STORE CHARACTER FROM# CNEXWORD[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 CDTMP$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 CDTMP$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[BSTATETABLE[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 CDTMP$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 CDTMP$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 BDTMP$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 CCTEMP EQ " " DO # CHARACTER ZERO-FILL NAME TO RIGHT # BEGIN CCTEMP = "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,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 # BCMWORD[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 BCMWORD[CMAP$W] = 1;# SET FLAG # END ELSE BEGIN # DT IS NOT CON # IF BCMWORD[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 CTITLE$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 = LOC(LEXICON); # SET ARRAY TO LEXICON # P = LOC(LEXWORD); # SET ARRAY TO LEXWORD # P = 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 = 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