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