Trailing-Edge
-
PDP-10 Archives
-
BB-D480F-SB_FORTRAN10_V10
-
lexcla.bli
There are 20 other files named lexcla.bli in the archive. Click here to see a list.
!COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1984, 1985
!ALL RIGHTS RESERVED.
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
!ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
!INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
!COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
!OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
!TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
!AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
!CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
!SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!AUTHOR: T.F. Vasak/MEM/AlB
MODULE LEXCLA(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4)=
BEGIN
GLOBAL BIND LEXCLV = #10^24 + 0^18 + #2514; ! Version Date: 24-Jan-85
%(
***** Begin Revision History *****
2 ----- ----- KLUDGE UP THE CLASSIFIER SO IT WILL HANDLE
THE IBM ' RECORD MARKS
ADD THE NECESSARY THING TO THE CLASSIFIER SO IT
WILL RECOGNIZE THE PARAMETER STATEMENT
HAVE THE IDENTIFIER LEXEME RETURN CHECK FOR
PARAMETER REFERENCES
3 ----- ----- CHANGE ACMEOP SO THAT THE "+" COMPIL CONSTRUCT WILL WORK
4 ----- ----- PUT A CHECK IN THE CLASSIFIER SO THAT "["
IN AN INCLUDE STATEMENT WILL NOT BLOW EVERYTHING
UP
5 ----- ----- REMOVE THE INCLUDE CROCK BECAUSE THE FILE SPEC IS NOW IN 'S
ACMRETNXT WAS CHANGED TO PASS OVER REMARKS BEFORE
RETURNING
ZEROCHK WAS CLEARED WHEN A BAD LABEL WAS ENCOUNTERED
IN ORDER NOT TO GET THE ZERO LABEL MESSAGE
INTERR WAS UPDATED TO THE E61<0,0> EXTERNAL FORM IN ASHELP
6 ----- ----- CHARPOS WAS NOT BEING ADJUSTED PROPERLY AFTER THE
REL-OP LOOKAHEAD FOLLOWING <CONST>.<LETTER>
ACMEXDBCHK MACRO
7 ----- ----- UPLOW WAS SETTING CODE TO UPPER RATHER THAN
DOING A SETCODE. THUS C AND D WERE NOT BEING
RECOGNIZED IN COL 1
8 ----- ----- GOTINT - CHECK FOR INTEGER OVERFLOW
9 ----- ----- 8 WAS NICE BUT THE CALL TO FATLEX DESTROYED
THE CONTENTS OF NAME
ALSO ADD CODE TO ACMBILDDBLINT SO THAT IT
WILL INCREMENT DECEXP IF IT IS IGNORING
INTEGRAL DIGITS OF A REAL NUMBER SO THAT
THE EXPONENT WILL BE CORRECT
10 ----- ----- FIX STSSCAN AND STCSCAN SO THAT IF THEY
ARE ENTERED WITH AN EOS THAT WHEN THEY FAIL
THEY WILL SET LEXLINE PROPERLY
11 ----- ----- HARD TO BELIEVE AT THIS LATE DATE BUT HOLLERITHS
IN EVEN MULTIPLES OF 5 CHARACTERS ARE MESSING UP
IN THE LAST WORD
ACMCHECKLET AND ACMHOLEND
12 ----- ----- CHANGE CONTROL-Z CHECK TO USE FLAGS2 RATHER
THAN DOING A DEVCHR
13 ----- ----- FIX ACMILABILL TO SET CHAR TO SMALCODE BECAUSE
IN ONE INSTANCE IT IS ENTERED WITH CODE CONTAINING
A BIGCODE
14 342 17876 FIX THINGS UP FOR LONG UNCLASSIFIABLE STMNTS, (DCE)
15 365 18857 FIX FORM FEEDS BETWEEN PROGRAMS (EAT ONE), (DCE)
16 366 18210 FIX MISC. BUGS IN SCANNING CONSTANTS SUCH AS
X=.123EQ.A AND X=1.1HABC, (DCE)
***** Begin Version 5A *****
17 547 21820 (QAR863) FIX TAB7S AND TAB11S SO INITIAL TAB
IN COLUMN 6 GOES TO COL 7 IF AN INITIAL LINE
OR COL 6 IF A CONTINUATION LINE, (SJW)
18 561 10429 ALLOW CONTINUATION LINES AFTER FORM FEEDS
USED SOLELY TO SEPARATE PAGES., (DCE)
19 573 ----- REQUIRE DBUGIT.REQ, (SJW)
***** Begin Version 5B *****
20 642 11409 FIX 561 SO THAT PAGE HEADING OUTPUT ONLY WHEN
NOT ATTEMPTING TO CLASSIFY STATEMENT, (DCE)
21 667 25664 MAKE INCLAS A GLOBAL (FOR LINESEQNO), (DCE)
22 670 25571 CHANGE CONTINUATION LINE PROCESSING SO THAT
THE LABEL FIELD CAN ONLY CONSIST OF BLANK CHARS., (DCE)
23 675 26049 RUBOUT CHAR (#177) IN SOURCE CAN GIVE INTERNAL
ERRORS IN ROUTINE LEXICA, (DCE)
24 713 26658 COMMENT LINES TERMINATED WITH <CR><CR><LF> MAY
GIVE PROBLEMS IF BUFFER SPLITS <CR> AND <LF>, (DCE)
25 717 26560 GIVE REASONABLE ERROR FOR DUPLICATE
PARAMETER STATEMENT., (DCE)
26 742 ----- ADD V6 STOP/PAUSE PROCESSING FOR DIGIT
STRING INSTEAD OF OCTAL STRING, (DCE)
***** Begin Version 6 *****
30 1107 TFV 10-Jul-81 ------
Prohibit 0H hollerith constants and '' character constants.
New errors are E158 (IVH) for invalid hollerith constant 0H and
E159 (IVC) for invalid character constant ''.
34 1126 AHM 22-Sep-81 Q20-01654
Remove last vestige of CALL DEFINE FILE support.
36 1141 EGM 27-Oct-81 10-31686
Produce fatal diagnostic when octal constant contains more than
24 significant digits.
***** Begin Version 6A *****
1162 PY 29-Jun-82 ------
Call WRITECRLF to type a CRLF when control-Z is typed at
a terminal.
***** Begin Version 7 *****
27 1214 CKS 20-May-81 ------
Add state to classifier for IF (...) THEN
28 1213 TFV 20-May-81 ------
Fix access to TYPTABle. Entries are now two words long. Second word is
the character count for character data. IDATTRIBUT(PARAMT) and IDCHLEN
fields of symbol table entries are defined here and in FIRST.BLI.
29 1221 CKS 4-Jun-81
Fix literal string parser to store characters of the literal starting
at LITC1 (byte ptr to first char of literal) instead of using hardwired
constant of 3. Unfortunately LEXICA cannot be compiled with FIRST, so
we can't use LITC1 (or even structure BASE), so change the hardwired
constant to LTLSIZ (copied from FIRST). The definitions of LTLSIZ in
FIRST and LEXICA must agree.
31 1244 CKS 31-Jul-81
Add CONCAT lexeme (//).
32 1245 TFV 3-Aug-81 ------
Fix LITDEF and ENDOFLIT to handle both character and HOLLERITH data.
33 1247 CKS 6-Aug-81
Modify classifier to recognize substring assignment statements.
35 1271 CKS 9-Oct-81
Modify classifier to treat "DO 10 ," as a DO statement.
37 1465 CKS 14-Jan-82
Add global state GSTKSCAN to scan "LETTERS=". It's used to parse
IO statement keyword lists in contexts where you can see either
a keyword or an expression. Also, LEXICA won't compile, so try
to squeeze under the 2**15 punt limit by removing the ACTnnn symbol
names. It is no longer possible to automatically generate the
CASE statement.
1505 AHM 13-Mar-82
Make state ACMENDID (end of identifier) set the psect index of
the symbol table entry it creates to PSDATA in order to
relocate those references by .DATA.
1526 AHM 8-Apr-82
Set IDPSCHARS to .DATA. as well for CHARACTER variables.
1527 CKS 29-Apr-82
Remove edit 717. Its purpose is to prevent the substitution of
constants for parameter variables on the left hand side of a parameter
definition. It regognizes this case by checking the upcoming lexeme
to see if it is "=". This check is no longer possible when the right
hand side is parsed as a general expression because LEXL and LSAVE are
not always set up correctly.
1530 TFV 4-May-82
Fix ACMENTLITLEX and ACMLITEDCHK. The CORMAN calls for literals
must request at least FLSIZ words. This causes CORMAN to
allocate memory at JOBFF and prevents SAVSPACE from reusing the
space. Add binds for CHARSPERWORD (also defined in TABLES) and
FLSIZ (also defined in FIRST).
1551 AHM 3-Jun-82
Change the value used for PSDATA in ACMENDID since it was
changed in FIRST.
1565 PLB 21-Jun-82
Use OUTTYX macro from LEXAID for instead of OUTSTR
as part of TOPS-20 nativization.
1573 CKS 1-Jul-82
Change classifier to recognize DO statements without a statement
label (of the form "DO I = 1,10"). Add classifier states to detect
DO WHILE statement.
1633 TFV 1-Sep-82
Count number of source lines for /STATISTICS
1640 RVM 7-Oct-82 Q10-00144
Fix bug that caused the ISN of the line being compiled to be off
when the line is the last line of an INCLUDE file or the "main"
input file. The last line in a file is marked with EOF, rather
than EOS. This prevented the lexical action ACMLEXFOS from setting
the line number correctly, since ACMLEXFOS only reset the line
number if the line ended with EOS. This error caused error messages
to contain the wrong line number and to appear late in the listing.
1653 CDM 21-Oct-82
In INITLZSTMNT, check /NOERROR flag before typing queued up
error messages to TTY.
***** End V7 Development *****
2035 TFV 16-Feb-84
Fix edit 1640. A file missing the CRLF on the last line causes
an ICE. LEXICA was not setting LASTLINE properly when EOF was
detected.
***** Begin Version 10 *****
2222 RVM 29-Sep-83
Keep LEXICA from setting the PSECT fields everytime it sees an
identifier.
2225 TFV 4-Oct-83
Fix lexical processing of octal constants. Count the leading
zeros. Up to 12 digits is OCTAL, 13 to 24 digits is DOUBLOCT,
more than 24 is an error.
2241 TFV 7-Dec-83
Implement FORTRAN-77 continuation line processing. Blank,
comment, debug, and remark lines may appear between an initial
line and its continuation lines and between continuation lines.
Also rework the lexical debugging trace facility to generate
symbolic output. To use this facility, DRIVER, INOUT, LEXICA
and LEXSUP must be compiled with DBUGIT=1 (this bind is in
DBUGIT.REQ), Specifying the /BUGOUT switch outputs the data to
the listing file. See LEXSUP for a description of the BUGOUT
values. Also change the classifier and lexeme scanner to detect
END statements properly. The standard says that a line
consisting of END must be the end statement for the program
unit. Continuation is not allowed. Finally, remove dead macros
and aliases.
2260 AlB 4-Jan-84
Addition of checks for the Compatibility Flagger.
Macros:
ACMAYBDOUB, ACMCHECKLET, ACMCOMNT, ACMDEBUG, ACMENTREMARK,
ACMGETOPR, ACMGOTOCT, ACMHOLEND, ACMMULTST, ACMNOTDOUB,
ACMOPCHK, ACMSINGLEX
2273 AlB 20-Jan-84
The rework of LEXICA for the comment lines disturbed the processing
of the ACMENTREMARK macro. In the new form, that macro is called
when a comment line is recognized, not just when the "!" is seen
on a line. This edit adds code to handle the various 'funny character
in column 1' flagger warnings.
Macro:
ACMCOMNT ACMENTREMARK
2327 RVM 23-Mar-84
Use SETPSECTS to set the psect fields for new identifiers.
2370 MEM 6-JUN-84
Keywords will now be stored in KEYBUFFER so STA1 can recognize keywords
more than 6 characters long past the sixth character. KEYLENGTH will
contain the number of characters in KEYBUFFER.
2412 TFV 1-Jul-84
Split LEXICA into two modules. The classifier is in the new
module LEXCLA. The lexeme scanner is in LEXICA. LEXCLA is
called to initialize each program unit, to classify each
statement, to classify the consequent statement of a logical IF,
and to do the standard end of program and missing end of program
actions.
2420 TFV 9-Jul-84
Compact the split LEXICA, LEXCLA modules. Remove the dead
states and macros from each. Redo the PLITS of smalstates and
bigstates. Change the lexical tracing routines for debugging so
they typeout the correct names. Also fix flagger warnings so
that each gets printed once instead of twice. Finally, fix the
line numbers for the warnings, they were wrong and could ICE the
compiler.
2431 TFV 18-Jul-84
Fix processing of line sequence numbers for second and later
program units. When a statement consisting of END is scanned,
it is the end statement for the program unit. The beginning of
the next line must be scanned for a LSN before returning from
LEXCLA.
2455 MEM 30-Aug-84
Replace all occurrences of VAX with VMS.
2474 TFV 21-Sep-84, AlB 30-Oct-84
Fix continuation processing to handle unlimited numbers of blank
and comment lines between continuation lines. The lines are
recorded in a linked list of four word entries, defined in
LEXAID.BLI. If there are too many blank and comment lines, the
buffer will get an overflow. When this happens, the buffer is
compacted using the information in the linked list. The info is
also used to speed up continuation processing in the lexeme
scan.
Make SPURCR and SPURFF be global routines in LEXICA.
2477 AlB 13-Nov-84
Fix ACMENTREMARK to correctly test for column 1.
ACMCOMNT and ACMENTREMARK now use the global ANSIPLIT for their
error message prefix.
2500 AlB 14-Nov-84
Change the list of entries for source lines from a linked list
in dynamic memory to a fixed-length list in static memory.
2501 AlB 20-Nov-84
Special handling of errors found in comment lines. Since these
errors can be detected while scanning unprinted comment lines, they
cannot go through the normal error queueing process.
2505 AlB 28-Nov-84
Fix some printing problems: Blank lines that were surrounded by
comment lines were not being printed, and BACKLINE was printing
extra stuff.
The SAVLINE routine in LEXSUP became so trivial that calls to it
were replaced by in-line code.
2506 AlB 30-Nov-84
Multiple statement lines were causing any following comments not
to be listed, and would under certain conditions complain if the
following line was a continuation.
2514 AlB 24-Jan-85
Patches for QARs 853012 and 853013
Source lines with spaces (not tab) in the label field were being
treated as code lines, even if they had no code. This tended to
confuse the comment/continuation code.
Continuation lines in source statements which do not start with tab
were causing preceding comments not to be printed. Created new
routine CONTPRINT in LEXICA in order to print those comments.
This routine is now called from ACMGOBAKNXT and ACMCONTDIG in both
LEXICA and LEXCLA.
An exclamation mark may now appear anywhere in the source line,
including the label and continuation fields. It will causes the
remainder of the line to be treated as a comment.
***** End V10 Development *****
***** End Revision History *****
)%
REQUIRE DBUGIT.REQ; ! Bind for debugging trace in LEXCLA
REQUIRE IOFLG.BLI; ! FLGREG bits
REQUIRE LEXNAM.BLI; ! Lexeme names and binds
REQUIRE LEXAID.BLI; ! Character code classifications
FORWARD
INITLZSTMNT, ! Statement initialization
%2412% LEXCLA(1); ! Lexical classifier
EXTERNAL
%2477% ANSIPLIT, ! ' Extension to Fortran-77: '
BACKLINE,
BACKPRINT,
BACKTYPE,
BACKUP,
BAKSAV,
BAKSAVE,
BLDMSG,
CALLST,
%2412% CHARCOUNT, ! Used to hold length of character constant
CHAROUT,
%2412% CHARTMP, ! Storage for register CHAR upon exit
%1213% CHLEN, ! Character count for character data
%2260% CFLEXB, ! Put out compatibility warning
%2420% CFLINB, ! Put out compatibility warning
%2412% CLASERR, ! If 1 indicates to STSKIP that an illegal character
%2412% ! was detected in classification and that STSKIP
%2412% ! should also detect it and report it
CLASHASH,
%2412% CLASLINE, ! Line number of beginning of classification
%2412% CLASPOS, ! Character position of beginning of classification
%2412% CNT,
CODETAB,
%2412% CODETMP, ! Storage for register CODE upon exit
%2412% COLONCOUNT, ! Number of zero-level colons skipped over by STTERM
%2514% CONTPRINT, ! Print intervening comment lines
CORMAN,
DECEXP,
DECREMENT,
%2500% DISCARD, ! Throw away any comment lines
%2412% DOCHAR, ! Character after DO in classifier
DOTOPTAB,
DSCASGNMT,
DSCDO,
DSCDOUB,
DSCEND,
DSCIFARITH,
DSCIFBLOCK,
DSCIFLOGIC,
DSCPARAMT,
DSCSFAY,
DSCSUBASSIGN,
%1573% DSCWHILE,
%2500% E51, ! Statement too long
E64,
%2260% E222,
%2260% E225,
%2260% E235,
%2260% E242,
%2260% E243,
%2260% E253,
%2260% E265,
%2260% E266,
%2260% E278,
%2260% E287,
ENDOFLIT,
ENTRY,
ERRFLAG,
ERRLINK,
ERRMSG,
FATLERR,
FATLEX,
FLAGS2,
FLTGEN,
FMTEND, ! Address of end of format area + 1
FMTLET, ! Letter lexeme codes table based upon the letter
FMTLEX, ! Non-letter lexeme code table based upon bigstate
! character codes
FMTOVER, ! Routine which adds more space to the format area
FMTPTR, ! Pointer to format storage area
FNDFF,
%2412% FOUNDCR, ! Indicates that a <CR> was encountered before the
%2412% ! line terminator which terminated the remark state
%2412% ! if set to 1.
GCONTAB,
GDOUBLPREC,
GDUBOCT,
GETBUF,
%717% GIDTAB,
GINTEGER,
GLOGI,
GOCTAL,
GREAL,
HEADING,
%2412% HIAC,
%2412% HOLCONST, ! Holds the constant for skipping holeriths
%2412% IDENTF,
%2412% INCLAS,
INCREM,
%2370% KEYBUFFER, ! contains keywords found in LEXICA
%2370% KEYLENGTH, ! contains the number of characters in KEYBUFFER
%2412% KEYPTR, ! Byte pointer for keyword spelling check
LABREF,
%717% LEXL,
%2412% LGIFCLAS, ! If 1 then classifying the object of a logical if
%1633% LINCNT, ! Number of source lines in program
LINEOUT,
LINESEQNO,
%2412% LOAC,
LOOK4CHAR,
LOOK4LABEL,
LITDEF,
MSGNOTYPD,
%2412% MSNGTIC, ! This flag is set if there is what appears to be an
%2412% ! unterminated lit string. The classifier will then
%2412% ! let unmatched parens go by so that it can classify
%2412% ! I/O statements with the damn ibm ' record mark in
%2412% ! them.
NAME,
NEWENTRY,
%717% NAMREF,
NUMFATL,
NUMWARN,
OVERFLOW,
OVRESTORE,
PAGE,
%717% PARAST,
%2412% PAREN, ! Count of parens for classification and skipping
%2412% POINTER,
PRINT,
%2327% SETPSECTS, ! Set the IDPSECT and IDPSCHARS for a variable
SHIFTPOOL,
%2412% SIIGN,
%2474% SPURCR, ! Check for spurious CR character
%2474% SPURFF, ! Check for FF character
STALABL,
%2412% STATESTACK, ! Area for state call stack
STMNDESC, ! Statement description block pointer
%2412% STSTKPTR, ! Current state stack pointer
%1213% SYMTYPE,
TBLSEARCH,
%2412% TEMP, ! Temporary storage within macros
TRACE,
TRACLEX,
%2241% TRACPUSH, ! Debugging trace of internal calls in LEXICA
%2241% TRACPOP, ! Debugging trace of internal returns in LEXICA
%717% TYPTAB,
%2412% VALUE, ! Value to be returned after skipping to next signif
%2412% ! char
WARNERR,
WARNLEX,
WARNOPT,
%1162% WRITECRLF,
%2412% XORCHAR, ! Set true if first letter after '.' is X
%2412% ! (to catch .XOR.)
%2412% ZEROCHK; ! Set to 1 if a digit was encountered in the label
%2412% ! field used to check for "0" label
OWN
%2505% SAVEPTR; ! Save CURPTR during Macros
!-----------------------------------------------------------------------
! NOW THE ACTION NAME BINDS AND ACTION MACRO NAME ASSOCATIONS
!
! There must be an equal number of action references in the
! "LEXICAL" case statement. The action macro ACMxxx must occur in
! the correct position to match the action number ACTxxx. Be
! careful to avoid skews. The ACTxxx names must also appear in
! the ACTIONPLIT in LEXSUP.BLI in the proper position.
!-----------------------------------------------------------------------
! ACTION ACTION
! NAME NUMBER
BIND
ACTEOB = 0,
ACTINIT = 1,
ACTANY = 2,
ACTTAB = 3,
ACTSTSKIP = 4,
ACTREMEND = 5,
ACTGOBAKNOW = 6,
ACTLT = 7,
ACTSTMNTFOS = 8,
ACTGOBAKNXT = 9,
ACTEXPLT = 10,
ACTRETNOW = 11,
%2241% ACTCONTLT = 12, ! Continuation - line terminator action
ACTCALCONT = 13,
ACTCONTDIG = 14,
ACTCLABSKP = 15,
ACTNOEND = 16,
ACTSTEOP = 17,
ACTENTREMARK = 18,
ACTMULTST = 19,
ACTCLASF1 = 20,
ACTMULTNULL = 21,
ACTILLCHAR = 22,
ACTCOMNT = 23,
ACTDEBUG = 24,
ACTCOMNTFOS = 25,
ACTINTERR = 26,
ACTNOCONT = 27,
ACTNULLFOS = 28,
ACTCITCONT = 29,
%2474% ACTCALCLT = 30,
ACTENTCLABSKP = 31,
ACTCBUGCHK = 32,
ACTENTLAB = 33,
ACTILABILL = 34,
ACTILABEDCK = 35,
ACTILITCONT = 36,
ACTILABDIG = 37,
ACTILNTC = 38,
ACTILNTI = 39,
ACTILNTD = 40,
ACTILITNC = 41,
ACTILITC = 42,
ACTILABLT = 43,
ACTUPLOW = 44,
ACTCONSTSKP = 45,
ACTSKNAME = 46,
ACTSKLPAREN = 47,
ACTSKRPAREN = 48,
ACTSKCOMMA = 49,
ACTGETLIT = 50,
ACTENDLIT = 51,
ACTBAKTOTERM = 52,
ACTSKCONBLD = 53,
ACTSKPHOLX = 54,
ACTSKPHOL = 55,
ACTHOLTAB = 56,
ACTENTERM = 57,
ACTUNMATEOS = 58,
ACTSKILL = 59,
ACTCLASLT = 60,
ACTCLASUNREC = 61,
ACTCLILLCHAR = 62,
ACTCLASBACK = 63,
ACTCOMPAR = 64,
ACTCLASAL1 = 65,
ACTASGNMNT = 66,
ACTCLASF2 = 67,
ACTIFCHK = 68,
ACTDOCHK = 69,
ACTARITHIF = 70,
ACTLOGICIF = 71,
ACTDOCHK1 = 72,
ACTDOSTMNT = 73,
ACTENDCHK = 74,
ACTCLASF3 = 75,
ACTCLASF4 = 76,
ACTKEYTERM = 77,
ACTUNMATKEY = 78,
ACTSPELLING = 79,
ACTBADCHAR = 80,
ACTTHENCHK = 81,
ACTBLOCKIF = 82,
ACTSUBCHK = 83,
ACTSUBASSIGN = 84,
ACTCLAS1A = 85,
ACTSKCOLON = 86,
ACTKEYSUB = 87,
ACTDOCHK2 = 88, ! [1573]
ACTWHILECHK = 89, ! [1573]
%2241% ACTCONTBLANK = 90, ! Continuation processing blank line action
%2241% ACTLTENDCHK = 91, ! Check for END statement in the classifier
%2241% ACTENDLTCHK = 92, ! Lexeme scan check for END statement
%2431% ACTENDLSN = 93; ! Scan line after END statement for LSN
!-----------------------------------------------------------------------
! NOW ONE CAN DEFINE THE ACTIONS AND STATES
!
! THE INDIVIDUAL ACTIONS ARE DEFINED AS MACROS. THEIR NAMES MUST
! APPEAR IN THE PRECEEDING TABLE, BOUND TO AN ACTION (OR CASE)
! NUMBER. ALL REFERENCES TO ACTIONS ARE MADE THROUGH THE NAME
! "ACTxxxx", WHICH IS BOUND TO THE ACTION NUMBER. THE ACTUAL
! ACTION MACRO DEFINITION NAME IS NEVER REFERENCED EXCEPT DURING
! THE DEFINITION OF THE "LEXICAL" CASE STATEMENT.
!
! THE INDIVIDUAL STATES ARE DEFINED IN TERMS OF A NAME AND A
! SERIES OF BINDS OF INPUT CODE TO THE DESIRED ACTION (ACTxxxx).
! THE STATE NAME IS NOT ACTUALLY DEFINED UNTIL LATER IN THIS CODE
! AFTER THE ACTUAL STATE TABLE PLITS HAVE BEEN DEFINED, HOWEVER
! THE STATE NAMES MAY STILL BE REFERENCED IN THE ACTION MACROS,
! SINCE THEIR REFERENCE IS NOT UNTIL EVEN LATER.
!
! IN ORDER TO DEFINE A STATE TABLES VALUES, ONE PRODUCES A SERIES
! OF BINDS, 11 FOR THE SMALL STATES AND 32 FOR THE BIG STATES.
! THE FORMAT IS CHARACTER CODE (SUCH AS "ILL"), SUFFIXED BY THE
! INDEX OF BIGSTATE OR SMALSTATE TO WHICH THIS NAME IS BOUND
! FOLLOWING THE STATE TABLE PLITS, FURTHER SUFFIXED BY A B ( FOR
! BIGSTATE ) OR S (FOR SMALSTATE). FOR EXAMPLE IF THE STATENAME
! "STxxxx" IS BOUND TO BIGSTATE[5], THEN THE DEFINITION OF THE
! RESULTING ACTION OF SOME CHARACTER CODE INPUT SUCH AS "ILL",
! WOULD BE OF THE FORM:
! BIND ILL5B = ACTXXX;
!
! ALL PROCESSING DONE BY "LEXCLA" IS DEFINED IN THIS SECTION IN
! TERMS OF STATES AND ACTION MACROS.
!
! ALL STATES WHICH ARE LEXCLA ENTRY STATES, I.E. SPECIFIED BY THE
! CALLER UPON CALLING, MUST BE BIGSTATES. ALL RETURNS TO THE
! LEXICAL CALLER MUST CLASSIFY THE NEXT SIGNIFICANT CHARACTER
! IN TERMS OF BIG CODES BEFORE RETURNING.
!
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
! UTILITY MACROS
!-----------------------------------------------------------------------
MACRO LINESEQBIT = @@CURPTR$;
MACRO SMALCODES(I) = .CODETAB[I]<LEFT>$;
MACRO BIGCODES(I) = .CODETAB[I]<RIGHT>$;
MACRO CODETYPE = @@STATE$; ! CODETYPE REFERENCE TO STATE TABLES
BIND B = 1, !BIGCODES CODE
S = 0; !SMALCODES CODE
% DETERMINE CODETYPE OF CURRENT STATE AND SET CODE ACCORDINGLY %
MACRO
SETCODE =
IF CODETYPE EQL S
THEN CODE _ SMALCODE
ELSE CODE _ BIGCODE ;
$;
% LEAVE TO BIG OR SMAL CHAR ACCORDING TO THE CURRENT STATE %
MACRO
LEAVENXT =
IF CODETYPE EQL S
THEN LEAVE SMALCHAR
ELSE LEAVE BIGCHAR
$;
%SAVE REGISTERS AND RETURN IMMEDIATELY %
MACRO
RETURNOW ( VAL ) =
CHARTMP _ .CHAR;
%2241% ! If debugging, output value returned to listing
%2241% IF DBUGIT
%2241% THEN TRACLEX(VAL);
RETURN VAL
$;
% SKIP TO NEXT SIGNIFICANT CHARACTER AND THEN RETURN %
MACRO
RETURNXT ( VAL ) =
VALUE _ VAL;
STATE _ STRETNX ;
LEAVE SMALCHAR
$;
% CALL NXTSTATE AND RETURN TO RETURNTO WHEN FINISHED%
MACRO
CALLR ( NXTSTATE, RETURNTO ) =
%2241% ! If debugging, output nesting level, next state, and return state
%2241% IF DBUGIT
%2420% THEN TRACPUSH(NXTSTATE, RETURNTO, 1);
STATESTACK [ .STSTKPTR ] _ RETURNTO;
STSTKPTR _ .STSTKPTR + 1;
STATE _ NXTSTATE
$;
%PUSH RETURN STATE ON THE STACK %
MACRO
CALL ( NXTSTATE ) =
%2241% ! If debugging, output nesting level, next state, and return state
%2241% IF DBUGIT
%2420% THEN TRACPUSH(NXTSTATE, .STATE, 1);
STATESTACK [ .STSTKPTR ] _ .STATE;
STSTKPTR _ .STSTKPTR + 1;
STATE _ NXTSTATE
$;
% RETURN TO THE CALLING STATE WITH CURRENT CHARACTER %
MACRO
ACMGOBAKNOW =
GOBACK;
SETCODE
LEAVE NEWSTATE
$;
% RETURN TO THE CALLING STATE WITH THE NEXT CHARACTER %
MACRO
ACMGOBAKNXT =
%2514% IF .INCLAS EQL 0 THEN CONTPRINT(); ! Print intervening comments
%2514% HASCODE(LINLCURR) = 1;
%2514% LASTCODELINE = .LINLCURR;
GOBACK;
LEAVENXT
$;
% RETURN TO CALLING STATE %
MACRO
GOBACK =
STATE _ .STATESTACK [ STSTKPTR _ .STSTKPTR -1 ];
%2241% ! If debugging, output nesting level, and return state
%2241% IF DBUGIT
%2420% THEN TRACPOP(.STATE, 1);
$;
%2260% ! If doing compatibility flagging, put out 'Symbolic relational'
%2260% ! flagger warning
%2260% MACRO FLAGRELOP(RELOP)=
%2260% IF FLAGEITHER THEN CFLEXB(PLIT ASCIZ RELOP,E278<0,0>)$;
% THIS ACTION WILL SKIP OVER NULLS, CHECK TO SEE IF ^Z IS AN END
OF FILE, AND CHECK FOR END OF STATEMENT BUFFER CONDITIONS
(#177) AND THEN CONTINUE WITH CURRENT STATE.
%
MACRO
ACMEOB =
IF .CHAR EQL 0 ! ITS A NULL
THEN (
DO CHAR _ SCANI (CURPTR )
UNTIL .CHAR NEQ 0;
SETCODE
LEAVE %TO% NEWSTATE
);
IF .CHAR EQL "?Z"
THEN
BEGIN
IF .FLAGS2<TTYINPUT> !IS INPUT DEVICE A TTY ?
THEN ( %EOF%
% JUST DELETE THE ^Z SO WE NEVER SEE IT AGAIN
MOVE TO THE END OF THE BUFFER, AND
DRIVE ON - EVERYTHING SHOULD WORK OUT %
!**;[1162] Macro: ACMEOB , @ line 1073, PY, 29-Jun-82
%1162% WRITECRLF(); !Write a CRLF after ^Z on TTY
! (The -10 does it for free)
.CURPTR _ 0;
CURPTR _ (@CURPOOLEND)<36,7>;
CHAR _ SCANI(CURPTR);
SETCODE;
LEAVE NEWACTION
)
ELSE
( % JUST ^Z %
CODE _ ILL;
LEAVE NEWSTATE
)
END
ELSE
%END OF BUFFER%
( IF CURWORD NEQ .CURPOOLEND
THEN %NOT REALLY END OF BUFFER %
( CODE _ ILL;
LEAVE NEWSTATE
)
ELSE
%END OF BUFFER %
( IF (CHAR _ GETBUF()) NEQ OVRFLO
THEN
BEGIN
%2035% ! If this is the EOF, set LASTLINE for
%2035% ! possible error printout
%2035% IF .CHAR EQL EOF
%2035% THEN LASTLINE = .LEXLINE;
SETCODE
LEAVE NEWSTATE
END
ELSE
%TIME TO SHIFT POOL UP AND MAKE ROOM FOR MORE INPUT%
( SHIFTPOOL();
% NOW BRING IN THE RING BUFFER %
IF ( CHAR _ OVRESTORE()) EQL OVRFLO
THEN % REAL OVERFLOW %
CHAR _ OVERFLOW (.INCLAS,CLASERR);
% OK PROCEED WITH THE CHARACTER NORMALLY%
SETCODE
LEAVE NEWSTATE
)
)
)
$;
MACRO
ACMINTERR = INTERR ('LEXICAL'); LEAVENXT $;
% IGNORE THE TAB AND ADJUST CHARPOS %
MACRO
ACMTAB =
CHARPOS _ .CHARPOS AND NOT 7;
LEAVENXT
$;
% JUST IGNORE IT %
MACRO
ACMANY =
LEAVENXT
$;
% TRANSLATE TO UPPER CASE %
MACRO
ACMUPLOW =
CHAR _ .CHAR - #40;
SETCODE;
LEAVE NEWSTATE
$;
% ILLEGAL CHARACTER DETECTED IN THE STATEMENT FIELD %
MACRO
ACMILLCHAR =
% ILLEGAL CHARACTER IN SOURCE %
FATLERR ( .CHAR,.LINELINE, E8<0,0> );
REPLACEN ( CURPTR, "??" );
CALLR ( STSKIP, STSTMNT );
LEAVE BIGCHAR
$;
% ENTER THE REMARK STATE %
MACRO
ACMENTREMARK =
%2273% IF FLAGEITHER ! Doing Compatibility flagging
%2420% THEN
%2273% IF FLAGANSI AND .CHAR EQL "!"
%2273% THEN
%2477% IF .CHARPOS EQL 71 ! Test for column 1
%2273% THEN ! ANSI doesn't like "!" in column 1
%2501% ERRCOMNT(LINLCURR) = ERRCMT1
%2273% ELSE ! It is "!" in other than column 1
%2501% ERRCOMNT(LINLCURR) = ERRCMT4
%2455% ELSE ! VMS and/or ANSI
%2273% ! It is either "!" anywhere, or something in column 1
%2273% IF .CHAR NEQ "C" AND .CHAR NEQ "!" AND .CHAR NEQ "*"
%2501% THEN
%2501% IF FLAGANSI
%2501% THEN
%2501% IF FLAGVMS
%2501% THEN ERRCOMNT(LINLCURR) = ERRCMT3 !Both
%2501% ELSE ERRCOMNT(LINLCURR) = ERRCMT1 !ANSI
%2501% ELSE
%2501% ERRCOMNT(LINLCURR) = ERRCMT2; !VMS
%2241% CALL(STREMARK);
LEAVE SMALCHAR
$;
% END OF A STATEMENT ON MULTIPLE STATEMENT LINE %
MACRO
ACMMULTST =
BEGIN
%2455% IF FLAGEITHER THEN CFLEXB(E253<0,0>); ! Incompatible with VMS and ANSI
CHAR _ EOS;
CODE _ FOS;
LEAVE NEWSTATE
END $;
MACRO
EXTRACRCHK =
ISCAN ( CHAR, CURPTR );
IF ( CODE _ SMALCODE ) NEQ LT
THEN IF CHKXCR() NEQ LT
%713% THEN ( IF CODETYPE EQL B THEN CODE _ BIGCODE;
LEAVE NEWSTATE
);
$;
% HANDLE PRINTING LINE TERMINATORS %
MACRO
ACMLT =
IF .CHAR EQL CR
THEN ( EXTRACRCHK )
ELSE IF .FOUNDCR ! CR WAS FOUND IN REMARK PROCESSING
THEN FOUNDCR _ 0
ELSE NOCR _ 1;
%2474% LASTBP(LINLCURR) = .CURPTR; ! Setup pointer for end of line
%2474% NOLTLINE = 0; ! Reset flag for no lt on line
%2474% PRINT(.LINLCURR);
%2474% IF .HASCODE(LINLCURR)
%2474% THEN LASTCODELINE = .LINLCURR; ! Setup pointer to last codeline
% CONTINUATION PROCESSING %
ENTCALCONT
$;
!-----------------------------------------------------------------------
! CONTINUATION PROCESSING
!-----------------------------------------------------------------------
% SMALL STATE DEFINITION STCALCONT NUMBER (#) 5S %
% CALCULATE THE NEXT LINE (OR LIN SEQ NO.) AND BEGIN PROCESSING THE NEXT
CONTINUATION FIELD. RETURN TO THE CALLING STATE WITH THE FIRST
CHARACTER OF THE STATEMENT FIELD IF IT'S A CONTINUATION OR WITH EOS IF
IT'S NOT %
BIND
ILL5S = ACTCALCONT,
TAB5S = ACTCALCONT,
%2474% LT5S = ACTCALCLT, ! Blank lines are legal
BLANK5S = ACTCALCONT,
SPEC5S = ACTCALCONT,
DIGIT5S = ACTCALCONT,
UPPER5S = ACTCALCONT,
LOWER5S = ACTCALCONT,
FOS5S = ACTCALCONT,
EOB5S = ACTEOB,
REMARK5S = ACTCALCONT;
% ENTER THE CONTINUATION PROCESSING AFTER COMPUTING LINE NUMBERS %
MACRO
ENTCALCONT =
CHARPOS _ 72;
LINEPTR _ .CURPTR; ! RECORD THE BEGINNING OF THE LINE
CALL ( STCALCONT );
LEAVE SMALCHAR; ! WITH THE NEXT CHARACTER
$;
%2241% ! Handle line terminators in continuation processing
%2241% MACRO
ACMCONTLT =
%2241% ! written by TFV on 15-Oct-83
! Ignore form feeds here - otherwise they will prevent
! continuation lines afterwards
%2474% IF NOT SPURCR()
THEN
BEGIN ! Line terminator so print the statement
%2474% LASTBP(LINLCURR) = .CURPTR;
%2474% HASCODE(LINLCURR) = 0; ! Mark current line as not a codeline
%2474% NOLTLINE = 0; ! Reset flag for no lt on line
CHARPOS = 72; ! Setup pointers for next line
LINEPTR = .CURPTR;
STATE = STCALCONT; ! Continue continuation processing
LEAVE SMALCHAR
END
ELSE
BEGIN ! Extraneous CR, set BIGCODE if necessary
IF CODETYPE EQL B
THEN CODE _ BIGCODE;
LEAVE NEWSTATE
END
$;
%2474% ! Handle line terminators in start of continuation processing.
%2474% ! This is invoked for lines containing just a line terminator.
%2474% MACRO
ACMCALCLT =
%2474% ! written by TFV on 21-Sep-84
! Line terminator at beginning of continuation processing.
! Setup entry for this line. Then begin continuation processing
! for the null line.
LASTLINE = .LINELINE; ! Save old line number
LINELINE = .LINELINE + 1; ! Increment line number
NEWCELL(); ! Get entry for new line
CONTPTR = .LINEPTR; ! Continuation backup pointer
CONTLCUR = .LINLCURR; ! Linked list backup entry
%2505% TEMP = LINLLIST<0,0>;
%2505% IF .HASCODE(TEMP) ! Only comments so far?
%2505% THEN ACTION = ACTCONTLT ! Code line, so process normally
%2505% ELSE ACTION = ACTNOCONT; ! Only comments, so don't continue
LEAVE NEWACTION;
$;
! CALCULATE LINE NUMBER ( OR LINE SEQUENCE NO) AND THEN BEGIN
! CONTINUATION PROCESSING. RETURN TO THE CALLER WITH THE FIRST
! CHARACTER OF THE STATEMENT FIELD IF ITS A CONTINUATION LINE OR
! EOS IF ITS NOT.
MACRO
ACMCALCONT =
LASTLINE _ .LINELINE; ! SAVE LINE NUMBER
% CHECK FOR LINE SEQ NO. AND SET LINELINE %
IF LINESEQBIT % TEST LINE SEQ BIT %
THEN ( LINELINE _ LINESEQNO( CURPTR<ADRS> ); ! DECODE NUMBER
LINEPTR _ .CURPTR; ! ADJUST BEGINNING PTR
ISCAN ( CHAR , CURPTR )
)
ELSE % NO LINE SEQ NO %
LINELINE _ .LINELINE + 1;
%2241% CODE _ BIGCODE; ! Code is BIGCODE for CHAR
%2474% NEWCELL(); ! Get entry for new line
CONTPTR _ .LINEPTR; ! SET CONTINUATION BACKUP PTR
%2474% CONTLCUR = .LINLCURR; ! Linked list backup entry
STATE _ STCONTINUE; ! ENTER CONTINUATION PROCESSING
! If first line has no code, it was a comment so don't continue
%2505% TEMP = LINLLIST<0,0>;
%2505% IF NOT .HASCODE(TEMP)
%2505% THEN
%2505% BEGIN
%2505% ACTION = ACTNOCONT;
%2505% LEAVE NEWACTION
%2505% END;
LEAVE NEWSTATE; ! WITH CURRENT CHARACTER
$;
!-----------------------------------------------------------------------
! CONTINUATION LINE CHECKING
!-----------------------------------------------------------------------
% BIG STATE DEFINITION STCONTINUE NUMBER (#) 3B %
% CONTINUATION LINE CHECK, FIRST CHARACTER OF THE LINE %
BIND
![670] CHANGE CONTINUATION LINE PROCESSING SO THAT THE
![670] LABEL FIELD MUST CONSIST OF ONLY BLANK CHARACTERS AS PER THE
![670] ANSI 1977 STANDARD.
%670% ILL3B = ACTNOCONT,
TAB3B = ACTCITCONT,
%2241% LT3B = ACTCONTLT, ! Blank lines are legal
BLANK3B = ACTENTCLABSKP,
%670% SPEC3B = ACTNOCONT,
%670% DIGIT3B = ACTNOCONT,
%670% UPPER3B= ACTNOCONT,
LOWER3B = ACTUPLOW,
FOS3B = ACTNOCONT,
EOB3B = ACTEOB,
%2241% REMARK3B = ACTENTREMARK, ! Remark lines are legal
%670% EQUAL3B = ACTNOCONT,
%670% LPAREN3B = ACTNOCONT,
%670% RPAREN3B = ACTNOCONT,
%670% COLON3B = ACTNOCONT,
%670% COMMA3B = ACTNOCONT,
%2241% DOLLAR3B = ACTENTREMARK, ! Comment lines are legal
%2241% ASTERISK3B = ACTENTREMARK, ! Comment lines are legal
%2241% SLASH3B = ACTENTREMARK, ! Comment lines are legal
%670% PLUS3B = ACTNOCONT,
%670% MINUS3B = ACTNOCONT,
%670% ANDSGN3B = ACTNOCONT,
%670% LITSGN3B = ACTNOCONT,
%670% OCTSGN3B = ACTNOCONT,
%670% NEQSGN3B = ACTNOCONT,
%670% DOT3B = ACTNOCONT,
%670% SEMICOL3B = ACTNOCONT,
%670% LTSGN3B = ACTNOCONT,
%670% GTSGN3B = ACTNOCONT,
%2241% COMNTSGN3B = ACTENTREMARK, ! Comment lines are legal
DEBUGSGN3B = ACTCBUGCHK,
%670% UPAROW3B = ACTNOCONT;
% SMALL STATE DEFINITION STCLABSKP NUMBER (#) 6S %
% CONTINUATION LINE CHECK, SKIP THE LABEL FIELD %
BIND
%670% ILL6S = ACTNOCONT,
TAB6S = ACTCITCONT,
%2241% LT6S = ACTCONTLT, ! Blank lines are legal
BLANK6S = ACTCLABSKP,
%670% SPEC6S = ACTNOCONT,
%670% DIGIT6S = ACTNOCONT,
%670% UPPER6S = ACTNOCONT,
%670% LOWER6S = ACTNOCONT,
FOS6S = ACTNOCONT,
EOB6S = ACTEOB,
%2241% REMARK6S = ACTENTREMARK; ! Remark lines are legal
% SMALL STATE DEFINITION STCNTCONT NUMBER (#) 7S %
% CONTINUATION FIELD, CONTINUATION CHECK, NO INITIAL TAB %
BIND
ILL7S = ACTNOCONT,
TAB7S = ACTCITCONT,
%2241% LT7S = ACTCONTLT, ! Blank lines are legal
%2241% BLANK7S = ACTCONTBLANK, ! Test for initial line vs. blank line
SPEC7S = ACTGOBAKNXT,
DIGIT7S = ACTCONTDIG,
UPPER7S = ACTGOBAKNXT,
LOWER7S = ACTGOBAKNXT,
FOS7S = ACTNOCONT,
EOB7S = ACTEOB,
%2241% REMARK7S = ACTENTREMARK; ! Remark lines are legal
% SMALL STATE DEFINITION STCITCONT NUMBER (#) 8S %
% CONTINUATION FIELD, CONTINUATION LINE CHECK, INITIAL TAB %
BIND
ILL8S = ACTNOCONT,
%2241% TAB8S = ACTCONTBLANK, ! Test for initial line vs. blank line
%2241% LT8S = ACTCONTLT, ! Blank lines are legal
%2241% BLANK8S = ACTCONTBLANK, ! Test for initial line vs. blank line
SPEC8S = ACTNOCONT,
DIGIT8S = ACTCONTDIG,
UPPER8S = ACTNOCONT,
LOWER8S = ACTNOCONT,
FOS8S = ACTNOCONT,
EOB8S = ACTEOB,
%2241% REMARK8S = ACTENTREMARK; ! Remark lines are legal
% SMALL STATE DEFINITION STCONTBLANK NUMBER (#) 22S %
% CONTINUATION LINE, NO CONTINUATION CHARACTER, CHECK FOR BLANK LINE
OTHERWISE IT IS AN INITIAL LINE. NOTE THAT A LINE CONTAINING ONLY
WHITESPACE AND A REMARK IS CONSIDERED TO BE A BLANK LINE.
%
%2241% ! created by TFV on 15-Oct-83
BIND
ILL22S = ACTNOCONT,
TAB22S = ACTCONTBLANK,
LT22S = ACTCONTLT,
BLANK22S = ACTCONTBLANK,
SPEC22S = ACTNOCONT,
DIGIT22S = ACTNOCONT,
UPPER22S = ACTNOCONT,
LOWER22S = ACTNOCONT,
FOS22S = ACTNOCONT,
EOB22S = ACTEOB,
REMARK22S = ACTENTREMARK;
!----------------------------------------------------------------------
! CONTINUATION LINE LABEL FIELD PROCESSING
!----------------------------------------------------------------------
% ENTER STATE WHICH SKIPS THE CONTINUATION LABEL FIELD %
MACRO
ACMENTCLABSKP =
STATE _ STCLABSKP;
LEAVE SMALCHAR
$;
% DEBUG LINE IN CONTINUATION LOOKAHEAD %
MACRO
ACMCBUGCHK =
%2260% IF FLAGANSI
%2501% THEN ERRCOMNT(LINLCURR) = ERRCMT5;
% CHECK THE INCLUDE SWITCH %
IF .FLGREG<INCLUDE>
THEN
BEGIN %ITS NOT A COMMENT PROCESS IT%
STATE _ STCLABSKP;
LEAVE SMALCHAR
END
ELSE
BEGIN ! It's a comment
%2241% ! Treat it as a remark to allow for further continuation lines
%2241% CALL(STREMARK);
%2241% LEAVE SMALCHAR
END ! It's a comment
$;
%2241% ! Check for blank line in continuation processing - line must be
%2241% ! all whitespace with a possible remark
%2241% MACRO
ACMCONTBLANK =
%2241% STATE = STCONTBLANK;
%2241% LEAVE SMALCHAR;
$;
% SKIP THE LABEL FIELD %
MACRO
ACMCLABSKP =
IF .CHARPOS NEQ 67 % POSITION 5%
THEN LEAVE SMALCHAR
ELSE
BEGIN % END OF THE LABEL FIELD %
STATE _ STCNTCONT; ! NO INITIAL TAB CONTINUATION CHECK
LEAVE SMALCHAR
END
$;
%ENTER THE CONTINUATION LINE INITIAL TAB, CONTINUATION FIELD CHECK%
MACRO
ACMCITCONT =
STATE _ STCITCONT;
LEAVE SMALCHAR
$;
% DIGIT IN CONTINUATION FIELD OR FOLLOWING INITIAL TAB %
MACRO
ACMCONTDIG =
IF .CHAR NEQ "0"
THEN
BEGIN % 1 THRU 9 ARE CONTINUATION INDICATORS %
%2514% IF .INCLAS EQL 0 THEN CONTPRINT(); ! Print intervening comments
%2474% HASCODE(LINLCURR) = 1; ! Mark current line as a codeline
%2474% LASTCODELINE = .LINLCURR; ! Set pointer to last code line
CHARPOS _ 66; ! IN CASE OF INITIAL TAB
GOBACK;
LEAVENXT
END
ELSE
BEGIN % A 0 IMPLIES NO CONTINUATION%
ACTION _ ACTNOCONT;
LEAVE NEWACTION
END
$;
% BACKUP %
MACRO
ACMNOCONT =
%2474% REGISTER CELL; ! Pointer to entry in linked list of lines
%2474% HASCODE(LINLCURR) = 0; ! Mark current line as a not a codeline
%2505% IF .LASTCODELINE NEQ 0
%2505% THEN
%2505% BEGIN ! Back over any comments
%2505% LINLCURR = .LASTCODELINE;
%2505% LASTLINE = LEXLINE = .LINENUM(LINLCURR);
%2505% IF .LINLCURR NEQ .LINLLAST
%2505% THEN LINLCURR = .LINLCURR + LINLSENT;
%2505% CONTLCUR = LINLLAST = .LINLCURR;
%2505% LINEPTR = CURPTR = CONTPTR = .FIRSTBP(LINLCURR);
%2505% LINELINE = .LINENUM(LINLCURR);
%2505% END ! Back over any comments
%2505% ELSE
%2505% BEGIN
%2505% LINLCURR = .CONTLCUR;
%2505% CURPTR = .CONTPTR;
%2505% END;
CHARPOS _ 72;
IF .CHAR NEQ EOF THEN CHAR _ EOS;
CODE _ FOS ;
%2474% ! Mark all the lines after last line with code as non-continuation
%2474% ! If there is no 'last code line', then there are only comments
%2474% ! in the linked list, so mark all lines.
%2474% IF (CELL = .LASTCODELINE) EQL 0
%2474% THEN
%2474% BEGIN
%2500% CELL = LINLLIST<0,0>; ! Mark all lines
%2474% NOCONTINUE(CELL) = 1;
%2474% END;
%2500% WHILE (CELL = .CELL + LINLSENT) LEQ .LINLLAST
%2474% DO NOCONTINUE(CELL) = 1; ! Not a continuation line
% RETURN TO CALLER %
GOBACK;
LEAVE NEWSTATE ;
$;
!-----------------------------------------------------------------------
! REMARKS OR PAST COLUMN 72
!-----------------------------------------------------------------------
% SMALL STATE DEFINITION STREMARK NUMBER (#) 0S %
!
! PROCESSES REMARKS FOLLOWING A "!" IN THE STATEMENT FIELD OR PAST
! CHARACTER POSITION 72
!
BIND
ILL0S = ACTANY,
TAB0S = ACTANY,
LT0S = ACTREMEND,
BLANK0S = ACTANY,
SPEC0S = ACTANY,
DIGIT0S = ACTANY,
UPPER0S = ACTANY,
LOWER0S = ACTANY,
FOS0S = ACTREMEND,
EOB0S = ACTEOB,
REMARK0S = ACTANY;
% LINE TERMINATION PROCESSING FOR REMARK STATE %
MACRO
ACMREMEND =
IF .CHAR EQL CR
THEN ( EXTRACRCHK;
FOUNDCR _ 1
);
% RETURN TO CALLING STATE %
GOBACK;
LEAVE NEWSTATE
$;
!-----------------------------------------------------------------------
! FIRST PROGRAM UNIT INITIALIZATION
!-----------------------------------------------------------------------
% SMALL STATE DEFINITION STINIT NUMBER (#) 1S %
% INITILIZATION OF LEXICAL AT THE BEGINNING OF THE FIRST PROGRAM UNIT %
BIND
ILL1S = ACTINIT,
TAB1S = ACTINIT,
LT1S = ACTINIT,
BLANK1S = ACTINIT,
SPEC1S = ACTINIT,
DIGIT1S = ACTINIT,
UPPER1S = ACTINIT,
LOWER1S = ACTINIT,
FOS1S = ACTINIT,
EOB1S = ACTEOB,
REMARK1S = ACTINIT;
% INITIALIZE LINELINE AND LEXICAL AFTER SKIPPING ALL NULLS AND CR'S%
MACRO
ACMINIT =
% HANDLE EOF %
IF .CODE EQL FOS THEN RETURN ENDOFILE<0,0>;
% IGNORE INITIAL CR'S %
IF .CHAR EQL CR
THEN ( CHARPOS _ .CHARPOS -1 ;
LEAVE SMALCHAR
);
IF LINESEQBIT %IS SET THEN ITS A LINE SEQUENCE NO %
THEN LINELINE _ LINESEQNO ( CURPTR<ADRS> )
ELSE ( IF NOT .FLGREG<ININCLUD> THEN LINELINE _ 1;
DECREMENT ( CURPTR<ADRS> )
);
CHARTMP _ EOS;
CHARPOS _ 72;
LINEPTR _ .CURPTR;
RETURN NOT ENDOFILE<0,0>
$;
!-----------------------------------------------------------------------
! NEW STATEMENT
!-----------------------------------------------------------------------
% BIG STATE DEFINITION STSTMNT NUMBER (#) 0B %
% THIS IS THE STATEMENT CLASSIFICATION ENTRY POINT. IT WILL FIRST
SKIP ANY OF THE LAST STATEMENT WHICH WASN'T READ IN, SKIP ALL
COMMENTS, NULL STATEMENTS, UNRECOGNIZED STATEMENTS, UNTIL FINALLY
IT CAN CLASSIFY A STATEMENT OR END OF FILE IS REACHED. IT WILL
RETURN WITH THE CLASSIFICATION OR END OF FILE.
%
BIND
ILL0B = ACTSTSKIP,
TAB0B = ACTSTSKIP,
LT0B = ACTSTSKIP,
BLANK0B = ACTSTSKIP,
SPEC0B = ACTSTSKIP,
DIGIT0B = ACTSTSKIP,
UPPER0B = ACTSTSKIP,
LOWER0B = ACTSTSKIP,
FOS0B = ACTSTMNTFOS,
EOB0B = ACTEOB,
REMARK0B = ACTSTSKIP,
EQUAL0B = ACTSTSKIP,
LPAREN0B = ACTSTSKIP,
RPAREN0B = ACTSTSKIP,
COLON0B = ACTSTSKIP,
COMMA0B = ACTSTSKIP,
DOLLAR0B = ACTSTSKIP,
ASTERISK0B = ACTSTSKIP,
SLASH0B = ACTSTSKIP,
PLUS0B = ACTSTSKIP,
MINUS0B = ACTSTSKIP,
ANDSGN0B = ACTSTSKIP,
LITSGN0B = ACTSTSKIP,
OCTSGN0B = ACTSTSKIP,
NEQSGN0B = ACTSTSKIP,
DOT0B = ACTSTSKIP,
SEMICOL0B = ACTSTSKIP,
LTSGN0B = ACTSTSKIP,
GTSGN0B = ACTSTSKIP,
COMNTSGN0B = ACTSTSKIP,
DEBUGSGN0B = ACTSTSKIP,
UPAROW0B = ACTSTSKIP;
% CHECK HERE TO SEE THAT THERE HAS BEEN AN ERROR MESSAGE %
MACRO
ACMSTSKIP =
IF ( NOT .MSGNOTYPD AND NOT .ERRFLAG ) OR .CLASERR NEQ 0
THEN % THE STATEMENT WAS NOT PROCESSID TO THE END AND
NO MESSAGE WAS TYPED, SO %
IF .CLASERR NEQ 0
THEN
BEGIN % CLASSIFIER WILL RETURN HERE IF IT CANNOT RECOGNIZE THE STATEMENT %
FATLERR ( .ISN, E10<0,0> );
CLASERR _ 0
END
ELSE
BEGIN % ALL OTHER STATEMENTS SHOULD BE PROCESSED FULLY
OR HAVE AN ERROR MESSAGE OUTPUT %
INTERR ('STSKIP')
END;
%SKIP TO EOS %
CALLR ( STSKIP ,STSTMNT);
LEAVE NEWSTATE
$;
ROUTINE INITLZSTMNT=
BEGIN
! Initialization for the beginning of a statement
%2474% EXTERNAL NEWCELL; ! Routine to get an entry on linked list
%2474% REGISTER CELL; ! Pointer to entry in linked list of lines
! Output messages for multiple statements
IF NOT .FLGREG<TTYDEV> AND .CHARPOS NEQ 72
AND ( .ERRFLAG OR .MSGNOTYPD )
THEN
BEGIN ! There are messages or lines to be output to TTY
LOCAL PTR;
! Type or finish typing the statement unless /NOERROR.
%1653% IF NOT .FLGREG<NOERRORS> THEN
BACKTYPE ( ALLCHAR );
! Now output any messages
MSGNOTYPD _ 0; ! Clear "messages to be typed" flag
PTR _ .ERRLINK<RIGHT>;
UNTIL .PTR<RIGHT> EQL 0
DO
BEGIN ! Message loop
IF NOT .ERRTYPD( PTR )
THEN
BEGIN ! The message was not yet typed, so type it
REGISTER MSG;
MSG _ BLDMSG ( .ERRMSG[.EMSGNUM(PTR)],.PTR<RIGHT>);
%1653% IF NOT .FLGREG<NOERRORS> THEN ! unless /NOERROR
%1565% OUTTYX(MSG);
ERRTYPD(PTR) _ 1
END;
PTR _ @@PTR
END ! Message loop
END; ! There are messages or lines to be output to tty
LEXLINE _ .LINELINE; ! MUST BE SET IN CASE WE GOT HERE AFTER SKIPING THE LAST STATEMENT
ERRFLAG _ 0;
STPOS _ .CHARPOS; ! LINE POSITION OF CHARACTER
ISN _ .LINELINE; ! LINE NUMBER
STPTR _ .CURPTR; ! BEGINNING CHARACTER POSITION
STLPTR _ .LINEPTR; ! BEGINNING OF LINE
STALABL _ 0;
ZEROCHK _ 0; ! SET TO 1 IF DIGIT ENCOUNTERED IN THE
! LABEL FIELD, USED TO CHECK FOR ZERO LABEL
%2474% FCHARPOS = .CHARPOS; ! Set beginning of statement position
%2505% LINLCURR = LASTCODELINE = 0; ! Start at head of list
%2474% NEWCELL(); ! Get first cell
%1633% LINCNT = .LINCNT + 1; ! Count the line
END; ! of INITLZSTMNT
% EOF AND EOS HANDLING FOR THE BEGINNING OF THE STATEMENT %
MACRO
ACMSTMNTFOS =
% THIS IS WHERE THE STATEMENT INITIALIZATION TAKES PLACE %
IF .CHAR EQL EOF
THEN ( RETURNOW ( ENDOFILE<0,0>)
% THIS IS THE ONLY PLACE EOF IS RETURNED FROM EXCEPT LEXINI %
)
ELSE
( %EOS SO BEGIN A NEW STATEMENT %
INITLZSTMNT();
% CHECK FOR MULTIPLE STATEMENTS %
IF .CHARPOS NEQ 72
THEN ! It is multiple statement line
%2506% BEGIN
%2506% HASCODE(LINLCURR) = 1; ! Must have had code
%2506% LASTCODELINE = .LINLCURR;
STATE _ STNULLST;
LEAVE SMALCHAR
END
ELSE
BEGIN
STATE _ STILINE; ! PROCEED TO INITIAL LINE PROCESSING
LEAVE BIGCHAR
END
)
$;
!-----------------------------------------------------------------------
! NORMAL END OF PROGRAM UNIT
!-----------------------------------------------------------------------
% BIG STATE DEFINITION STEOP NUMBER (#) 5B %
% IT IS THE END OF THE PROGRAM UNIT SO SKIP TO THE END OF THE CURRENT
STATEMENT AND BRING THINGS UP TO DATE %
BIND
ILL5B = ACTINTERR,
TAB5B = ACTINTERR,
LT5B = ACTINTERR,
BLANK5B = ACTINTERR,
SPEC5B = ACTINTERR,
DIGIT5B = ACTINTERR,
UPPER5B = ACTINTERR,
LOWER5B = ACTINTERR,
FOS5B = ACTSTEOP,
EOB5B = ACTEOB,
REMARK5B = ACTINTERR,
EQUAL5B = ACTINTERR,
LPAREN5B = ACTINTERR,
RPAREN5B = ACTINTERR,
COLON5B = ACTINTERR,
COMMA5B = ACTINTERR,
DOLLAR5B = ACTINTERR,
ASTERISK5B = ACTINTERR,
SLASH5B = ACTINTERR,
PLUS5B = ACTINTERR,
MINUS5B = ACTINTERR,
ANDSGN5B = ACTINTERR,
LITSGN5B = ACTINTERR,
OCTSGN5B = ACTINTERR,
NEQSGN5B = ACTINTERR,
DOT5B = ACTINTERR,
SEMICOL5B = ACTINTERR,
LTSGN5B = ACTINTERR,
GTSGN5B = ACTINTERR,
COMNTSGN5B = ACTINTERR,
DEBUGSGN5B = ACTINTERR,
UPAROW5B = ACTINTERR;
% WE ARE AT THE END OF THE LAST STATEMENT IN THE PROGRAM UNIT %
MACRO
ACMSTEOP =
IF .CHAR EQL EOF
THEN
BEGIN
IF .CHARPOS LSS 71
THEN % PARTIAL LINE LEFT TO BE PRINTED %
BEGIN
DECREMENT ( CURPTR<ADRS> );
%2474% PRINT(0)
END;
%2241% RETURNOW(ENDOFILE<0,0>)
END;
%ELSE EOS
PRINT PARTIAL LINE IF ANY AND THEN INITIALIZE FOR THE NEXT STATEMENT%
IF .CHARPOS NEQ 72
THEN
BEGIN % THIS STATEMENT DOES NOT START AT THE BEGINNING OF A LINE %
% PRINT BEGINNING OF LINE %
%2474% PRINT(0);
END;
INITLZSTMNT(); ! NEW STATEMENT INITIALIZATION
%2241% RETURNOW(NOT ENDOFILE<0,0>)
$;
!-----------------------------------------------------------------------
! MISSING END STATEMENT. END OF PROGRAM UNIT
!-----------------------------------------------------------------------
% BIG STATE DEFINITION STNOEND NUMBER (#) 4B %
% THIS PROGRAM UNIT HAS NO END STATEMENT SO BACK UP TO THE BEGINNING
OF THE CURRENT STATEMENT BECAUSE IT BELONGS WITH THE NEXT PROGRAM
UNIT AND THEN TRANSFER CONTROL TO THE NORMAL END OF PROGRAM PROCESSING %
BIND
ILL4B = ACTNOEND,
TAB4B = ACTNOEND,
LT4B = ACTNOEND,
BLANK4B = ACTNOEND,
SPEC4B = ACTNOEND,
DIGIT4B = ACTNOEND,
UPPER4B = ACTNOEND,
LOWER4B = ACTNOEND,
FOS4B = ACTNOEND,
EOB4B = ACTNOEND,
REMARK4B = ACTNOEND,
EQUAL4B = ACTNOEND,
LPAREN4B = ACTNOEND,
RPAREN4B = ACTNOEND,
COLON4B = ACTNOEND,
COMMA4B = ACTNOEND,
DOLLAR4B = ACTNOEND,
ASTERISK4B = ACTNOEND,
SLASH4B = ACTNOEND,
PLUS4B = ACTNOEND,
MINUS4B = ACTNOEND,
ANDSGN4B = ACTNOEND,
LITSGN4B = ACTNOEND,
OCTSGN4B = ACTNOEND,
NEQSGN4B = ACTNOEND,
DOT4B = ACTNOEND,
SEMICOL4B = ACTNOEND,
LTSGN4B = ACTNOEND,
GTSGN4B = ACTNOEND,
COMNTSGN4B = ACTNOEND,
DEBUGSGN4B = ACTNOEND,
UPAROW4B = ACTNOEND;
MACRO
ACMNOEND =
IF .CHAR EQL EOF
THEN
BEGIN
ACTION _ ACTSTEOP;
LEAVE NEWACTION
END
ELSE
BEGIN % BACK UP TO THE BEGINNING OF THE STATEMENT %
CURPTR _ .STPTR;
CHARPOS _ .STPOS;
LINELINE _ .ISN;
% CHECK TO SEE IF THERE MIGHT BE SOME PORTION UNPRINTED%
IF .CHARPOS NEQ 72
THEN % ITS POSSIBLE %
IF .LINEPTR EQL .STLPTR
THEN % IT HASN'T BEEN PRINTED %
%2474% PRINT(0);
ERRFLAG _ 0 ; ! CLEARED SO INITLZ DOSEN'T TRY TO PRINT
! A STATEMENT WHOSE END IT DOSEN'T KNOW
LINEPTR _ .STLPTR;
INITLZSTMNT(); ! INITIALIZE THE STATEMENT
%2241% RETURNOW(NOT ENDOFILE<0,0>)
END;
$;
!-----------------------------------------------------------------------
! STATEMENT SKIPPING
!-----------------------------------------------------------------------
% BIG STATE DEFINITION STSKIP NUMBER (#) 2B %
BIND
ILL2B = ACTSKILL,
TAB2B = ACTTAB,
LT2B = ACTLT,
BLANK2B = ACTANY,
SPEC2B = ACTANY,
DIGIT2B = ACTENTERM,
UPPER2B = ACTENTERM,
LOWER2B = ACTENTERM,
FOS2B = ACTUNMATEOS,
EOB2B = ACTEOB,
REMARK2B = ACTENTREMARK,
EQUAL2B = ACTANY,
LPAREN2B = ACTENTERM,
RPAREN2B = ACTSKILL,
COLON2B = ACTANY,
COMMA2B = ACTANY,
DOLLAR2B = ACTANY,
ASTERISK2B = ACTANY,
SLASH2B = ACTANY,
PLUS2B = ACTANY,
MINUS2B = ACTANY,
ANDSGN2B = ACTANY,
LITSGN2B = ACTENTERM,
OCTSGN2B = ACTANY,
NEQSGN2B = ACTANY,
DOT2B = ACTANY,
SEMICOL2B = ACTMULTST,
LTSGN2B = ACTANY,
GTSGN2B = ACTANY,
COMNTSGN2B = ACTENTERM,
DEBUGSGN2B = ACTENTERM,
UPAROW2B = ACTANY;
% REPORT ILLEGAL CHARACTER IF .CLASERR %
MACRO
ACMSKILL =
IF .CLASERR
THEN
BEGIN
IF .CODE EQL RPAREN
THEN FATLERR(.ISN,E9<0,0>) ! UNMATCHED )
ELSE ( FATLERR (.CHAR,.LINELINE,E8<0,0>);
REPLACEN(CURPTR,"??"));
CLASERR _ 0;
END;
LEAVE BIGCHAR
$;
% CALL STTERM TO SKIP SOME LEXICAL CONSTRUCT %
MACRO
ACMENTERM =
CALL ( STTERM );
PAREN _ 0; ! THIS MUST BE SET BECAUSE THE CLASSIFIER ENTERS AT THE 1 LEVEL
LEAVE NEWSTATE
$;
% CHECK FOR UNMATCHED PARENS %
MACRO
ACMUNMATEOS =
IF .CLASERR NEQ 0 AND .PAREN NEQ 0
THEN
BEGIN % UNMATCHED LEFT PAREN DETECTED IN THE CLASSIFIER %
FATLERR(.ISN,E9<0,0>);
END;
CLASERR _ 0;
GOBACK; ! WITH EOS OR EOF
LEAVE NEWSTATE
$;
!-----------------------------------------------------------------------
! SKIP LEXICAL CONSTRUCTS
!-----------------------------------------------------------------------
! STATES WHICH SKIP OVER LEXEMES. THEY ARE USED BY THE CLASSIFIER
! AND STSKIP TO PASS OVER THE STATEMENT
!----------------------------------------------------------------------
% BIG STATE DEFINITION STTERM NUMBER (#) 6B %
% SKIPS OVER LEXICAL CONSTRUCTS - %
BIND
ILL6B = ACTGOBAKNOW,
TAB6B = ACTTAB,
LT6B = ACTEXPLT,
BLANK6B = ACTANY,
SPEC6B = ACTANY,
DIGIT6B = ACTCONSTSKP,
UPPER6B = ACTSKNAME,
LOWER6B = ACTSKNAME,
FOS6B = ACTGOBAKNOW,
EOB6B = ACTEOB,
REMARK6B = ACTENTREMARK,
EQUAL6B = ACTANY,
LPAREN6B = ACTSKLPAREN,
RPAREN6B = ACTSKRPAREN,
COLON6B = ACTSKCOLON,
COMMA6B = ACTSKCOMMA,
DOLLAR6B = ACTANY,
ASTERISK6B = ACTANY,
SLASH6B = ACTANY,
PLUS6B = ACTANY,
MINUS6B = ACTANY,
ANDSGN6B = ACTANY,
LITSGN6B = ACTGETLIT,
OCTSGN6B = ACTANY,
NEQSGN6B = ACTANY,
DOT6B = ACTANY,
SEMICOL6B = ACTMULTST,
LTSGN6B = ACTANY,
GTSGN6B = ACTANY,
COMNTSGN6B = ACTSKNAME,
DEBUGSGN6B = ACTSKNAME,
UPAROW6B = ACTANY;
% SMALL STATE DEFINITION STGETLIT NUMBER (#) 13S %
% PICKS UP ' LITERALS %
BIND
ILL13S = ACTANY,
TAB13S = ACTTAB,
LT13S = ACTEXPLT,
BLANK13S = ACTANY,
SPEC13S = ACTENDLIT,
DIGIT13S = ACTANY,
UPPER13S = ACTANY,
LOWER13S = ACTANY,
FOS13S = ACTGOBAKNOW,
EOB13S = ACTEOB,
REMARK13S = ACTANY;
% SMALL STATE DEFINITION STSKNAME NUMBER (#) 14S %
% SKIPS IDENTIFIERS %
BIND
ILL14S = ACTGOBAKNOW,
TAB14S = ACTTAB,
LT14S = ACTEXPLT,
BLANK14S = ACTANY,
SPEC14S = ACTBAKTOTERM,
DIGIT14S = ACTANY,
UPPER14S = ACTANY,
LOWER14S = ACTANY,
FOS14S = ACTGOBAKNOW,
EOB14S = ACTEOB,
REMARK14S = ACTENTREMARK;
% SMALL STATE DEFINITION STCONSTSKP NUMBER (#) 15S %
% SKIPS CONSTANTS FOLLOWED BY H ( HOLERITH ) OR X FOR FORMATS %
BIND
ILL15S = ACTGOBAKNOW,
TAB15S = ACTTAB,
LT15S = ACTEXPLT,
BLANK15S = ACTANY,
SPEC15S = ACTBAKTOTERM,
DIGIT15S = ACTSKCONBLD,
UPPER15S = ACTSKPHOLX,
LOWER15S = ACTUPLOW,
FOS15S = ACTGOBAKNOW,
EOB15S = ACTEOB,
REMARK15S = ACTENTREMARK;
% SMALL STATE DEFINITION STSKPHOL NUMBER (#) 16S %
BIND
ILL16S = ACTSKPHOL,
TAB16S = ACTHOLTAB,
LT16S = ACTEXPLT,
BLANK16S = ACTSKPHOL,
SPEC16S = ACTSKPHOL,
DIGIT16S = ACTSKPHOL,
UPPER16S = ACTSKPHOL,
LOWER16S = ACTSKPHOL,
FOS16S = ACTGOBAKNOW,
EOB16S = ACTEOB,
REMARK16S = ACTSKPHOL;
% DETERMINE WHETHER CLASSIFICATION OR SKIPPING ANY HANDLE
LINE TERMINATORS ACCORDINGLY %
MACRO
ACMEXPLT =
IF .INCLAS NEQ 0
THEN ACTION _ ACTCLASLT ! CLASSIFICATION SO NO PRINTING
ELSE ACTION _ ACTLT; ! SKIPPING SO PRINT LINE
LEAVE NEWACTION
$;
% ENTER THE CONSTANT PICKUP STATE %
MACRO
ACMCONSTSKP =
STATE _ STCONSTSKP;
HOLCONST _ .CHAR - "0";
LEAVE SMALCHAR
$;
% ENTER THE NAME SKIPPING STATE %
MACRO
ACMSKNAME =
CODE _ SMALCODE;
STATE _ STSKNAME;
LEAVE NEWSTATE
$;
% LEFT PAREN ENCOUNTERED %
MACRO
ACMSKLPAREN =
PAREN _ .PAREN +1;
LEAVE BIGCHAR
$;
% RIGHT PAREN ENCOUNTERED %
MACRO
ACMSKRPAREN =
IF ( PAREN _ .PAREN - 1 ) GTR 0
THEN
BEGIN % SKIP OVER NESTED PARENS AND CONTINUE %
LEAVE BIGCHAR
END
ELSE
BEGIN
GOBACK;
IF .PAREN LSS 0
THEN ! UNMATCHED ")", RETURN IT TO CALLER
BEGIN
IF CODETYPE EQL S THEN CODE _ SMALCODE;
LEAVE NEWSTATE
END
ELSE (LEAVENXT); ! END OF NEST, SKIP IT AND RETURN
END
$;
%1247% % SKIP COLON, COUNTING IT IF AT PAREN LEVEL 1 %
MACRO
ACMSKCOLON =
IF .PAREN EQL 1
THEN COLONCOUNT _ .COLONCOUNT + 1;
LEAVE BIGCHAR
$;
% SKIP COMMA IF IN NESTED PAREN %
MACRO
ACMSKCOMMA =
IF .PAREN NEQ 0
THEN LEAVE BIGCHAR ! SKIP IT
ELSE
BEGIN % RETURN IT TO CALLER %
GOBACK;
LEAVE NEWSTATE
END
$;
% ENTER LITERAL PICKUP STATE %
MACRO
ACMGETLIT =
MSNGTIC _ 1; !SET MISSING TIC FLAG
STATE _ STGETLIT;
LEAVE SMALCHAR
$;
% RETURN TO STTERM WITH THE NEXT CHARACTER %
MACRO
ACMENDLIT =
% IF THIS CHARACTER IS ' %
IF .CHAR NEQ "'"
THEN LEAVE SMALCHAR; ! SKIP CHARACTER
% ELSE SKIP THE ' AND RETURN TO STTERM %
MSNGTIC _ 0;
STATE _ STTERM;
LEAVE BIGCHAR
$;
% RETURN TO STTERM WITH CURRENT CHARACTER %
MACRO
ACMBAKTOTERM =
CODE _ BIGCODE;
STATE _ STTERM;
LEAVE NEWSTATE
$;
% BUILD THE CONSTANT %
MACRO
ACMSKCONBLD =
HOLCONST _ .HOLCONST*10 + ( .CHAR - "0" );
LEAVE SMALCHAR
$;
% CHECK FOR HOLERITH OR X FOLLOWING THE CONSTANT %
MACRO
ACMSKPHOLX =
STATE _ STTERM;
IF .CHAR EQL "X"
THEN
BEGIN % SKIP THE X %
LEAVE BIGCHAR
END;
IF .CHAR EQL "H" AND .HOLCONST GTR 0
THEN
BEGIN % HOLERITH %
STATE _ STSKPHOL;
LEAVE SMALCHAR
END;
% ELSE JUST SKIP THE CONSTANT %
LEAVE NEWSTATE
$;
% SKIP .HOLCONST CHARACTERS OF HOLERITH STRING %
MACRO
ACMSKPHOL =
IF (HOLCONST _ .HOLCONST - 1 ) NEQ 0
THEN LEAVE SMALCHAR ! SKIP IT
ELSE
BEGIN
% HOLERITH HAS BEEN PASSED OVER %
STATE _ STTERM;
LEAVE BIGCHAR
END
$;
% ADJUST FOR TABS IN HOLERITH %
MACRO
ACMHOLTAB =
CHARPOS _ .CHARPOS AND NOT 7;
CODE _ BLANK; ! SEMANTICLY EQUIVALENT TO BLANK
LEAVE NEWSTATE
$;
!----------------------------------------------------------------------
! INITIAL LINE PROCESSING
!----------------------------------------------------------------------
% BIG STATE DEFINITION STILINE NUMBER (#) 1B %
% BEGIN PROCESSING AN INITIAL LINE
THIS IS CHARACTER POS 1 OF A STATEMENT WHICH BEGINS AT THE
BEGINNING OF A LINE %
BIND
ILL1B = ACTILABILL,
TAB1B = ACTILITCONT,
LT1B = ACTILABLT,
BLANK1B = ACTENTLAB,
SPEC1B = ACTILABILL,
DIGIT1B = ACTENTLAB,
UPPER1B = ACTILABILL,
LOWER1B = ACTUPLOW,
FOS1B = ACTSTMNTFOS,
EOB1B = ACTEOB,
REMARK1B = ACTCOMNT,
EQUAL1B = ACTILABILL,
LPAREN1B = ACTILABILL,
RPAREN1B = ACTILABILL,
COLON1B = ACTILABILL,
COMMA1B = ACTILABILL,
DOLLAR1B = ACTCOMNT,
ASTERISK1B = ACTCOMNT,
SLASH1B = ACTCOMNT,
PLUS1B = ACTILABILL,
MINUS1B = ACTILABILL,
ANDSGN1B = ACTILABILL,
LITSGN1B = ACTILABILL,
OCTSGN1B = ACTILABILL,
NEQSGN1B = ACTILABILL,
DOT1B = ACTILABILL,
SEMICOL1B = ACTILABILL,
LTSGN1B = ACTILABILL,
GTSGN1B = ACTILABILL,
COMNTSGN1B = ACTCOMNT,
DEBUGSGN1B = ACTDEBUG,
UPAROW1B = ACTILABILL;
!----------------------------------------------------------------------
! INITIAL LINE LABEL AND CONTINUATION FIELDS
!----------------------------------------------------------------------
% SMALL STATE DEFINITION STILABEL NUMBER (#) 9S %
% PICKS UP CHARACTER POSITIONS OF THE LABEL FIELD AND ANY DIGITS %
BIND
ILL9S = ACTILABILL,
TAB9S = ACTILITCONT,
LT9S = ACTILABLT,
BLANK9S = ACTILABEDCK,
SPEC9S = ACTILABILL,
DIGIT9S = ACTILABDIG,
UPPER9S = ACTILABILL,
LOWER9S = ACTILABILL,
FOS9S = ACTILABLT,
EOB9S = ACTEOB,
REMARK9S = ACTILABILL;
% SMALL STATE DEFINITION STLABSKP NUMBER (#) 10S %
% SKIPS THE LABEL FIELD OF INITIAL LINES FOUND TO HAVE ILLEGAL CHARACTERS %
BIND
ILL10S = ACTILABEDCK,
TAB10S = ACTILITCONT,
LT10S = ACTILABLT,
BLANK10S = ACTILABEDCK,
SPEC10S = ACTILABEDCK,
DIGIT10S = ACTILABEDCK,
UPPER10S = ACTILABEDCK,
LOWER10S = ACTILABEDCK,
FOS10S = ACTILABLT,
EOB10S = ACTEOB,
REMARK10S = ACTILABEDCK;
% SMALL STATE DEFINITION STILNTCONT NUMBER (#) 11S %
% CHECK THE CONTINUATION FIELD OF AN INITIAL LINE , NO INITIAL TAB %
BIND
ILL11S = ACTILNTC,
TAB11S = ACTILITCONT,
LT11S = ACTILABLT,
BLANK11S = ACTILNTI,
SPEC11S = ACTILNTC,
DIGIT11S = ACTILNTD,
UPPER11S = ACTILNTC,
LOWER11S = ACTILNTC,
FOS11S = ACTILABLT,
EOB11S = ACTEOB,
REMARK11S = ACTILNTC;
% SMALL STATE DEFINITION STILITCONT NUMBER (#) 12S %
% INITIAL LINE, FIRST CHARACTER AFTER INITIAL TAB %
BIND
ILL12S = ACTILITNC,
TAB12S = ACTILITNC,
LT12S = ACTILABLT,
BLANK12S = ACTILITNC,
SPEC12S = ACTILITNC,
DIGIT12S = ACTILITC,
UPPER12S = ACTILITNC,
LOWER12S = ACTILITNC,
FOS12S = ACTILITNC,
EOB12S = ACTEOB,
REMARK12S = ACTILITNC;
% ENTER THE LABEL PROCESSING STATE %
MACRO
ACMENTLAB =
STATE _ STILABEL;
LEAVE NEWSTATE
$;
% ILLEGAL CHARACTER IN THE LABEL FIELD %
MACRO
ACMILABILL =
%2514% IF .CHAR EQL "!"
%2514% THEN ! Allow remarks
%2514% BEGIN
%2514% ACTION = ACTENTREMARK;
%2514% LEAVE NEWACTION;
%2514% END;
STALABL _ 0;
ZEROCHK _ 0; !CLEAR ALL FLAGS ASSOCIATED WITH LABELS
FATLERR (.CHAR,.LINELINE,E7<0,0> );
REPLACEN( CURPTR,"??" );
STATE _ STLABSKP;
CODE _ SMALCODE;
LEAVE NEWSTATE
$;
% CHECK FOR THE END OF THE LABEL FIELD %
MACRO
ACMILABEDCK =
IF .CHARPOS NEQ 67 ! POSITION 5
THEN LEAVE SMALCHAR
ELSE
BEGIN % END OF THE LABEL FIELD %
STATE _ STILNTCONT; ! GOTO NO INITIAL TAB CONT FLD CHECK
LEAVE SMALCHAR
END
$;
% ENTER THE INITIAL LINE , INITIAL TAB CONTINUATION FIELD CHECK %
MACRO
ACMILITCONT =
STATE _ STILITCONT;
LEAVE SMALCHAR
$;
% LINE TERMINATORS FOR THE LABEL FIELD OF INITIAL LINES %
MACRO
ACMILABLT =
IF NOT SPURCR()
THEN
BEGIN % A LINE TERMINATOR IMPLIES AN INITIAL LINE %
%2474% HASCODE(LINLCURR) = 0; ! Mark current line as a not a codeline
STATE _ STNULLST ;
LEAVE NEWSTATE
END
ELSE
BEGIN %SPURIOUS CR %
IF CODETYPE EQL B % BIG %
THEN CODE _ BIGCODE;
LEAVE NEWSTATE
END
$;
% BUILD THE LABEL%
MACRO
ACMILABDIG =
ZEROCHK _ 1; ! NOTE THAT A DIGIT WAS FOUND
STALABL _ ( .STALABL * 10 ) + ( .CHAR - "0" );
IF .CHARPOS NEQ 67
THEN LEAVE SMALCHAR
ELSE
BEGIN % END OF THE LABEL FIELD %
STATE _ STILNTCONT;
LEAVE SMALCHAR
END
$;
% CONTINUATION CHARACTER IN INITIAL LINE %
MACRO
ACMILNTC =
% TEMPORARY%
%2514% IF .CHAR EQL "!"
%2514% THEN ! Comments should be allowed
%2514% BEGIN
%2514% ACTION = ACTENTREMARK;
%2514% LEAVE NEWACTION;
%2514% END;
%2474% HASCODE(LINLCURR) = 1; ! Mark current line as a codeline
%2474% LASTCODELINE = .LINLCURR; ! Set pointer to last code line
WARNERR ( .LINELINE,E109<0,0>);
STATE _ STNULLST;
LEAVE SMALCHAR
$;
% BLANK OR TAB IN THE CONTINUATION FIELD %
MACRO
ACMILNTI =
%2474% HASCODE(LINLCURR) = 1; ! Mark current line as a codeline
%2474% LASTCODELINE = .LINLCURR; ! Set pointer to last code line
STATE _ STNULLST;
LEAVE NEWSTATE ! DON'T PICK UP THE NEXT CHAR SO AS TO ALLOW NULLST TO ADJUST FOR TABS
$;
% DIGIT IN CONTINUATION FIELD %
MACRO
ACMILNTD =
%2474% HASCODE(LINLCURR) = 1; ! Mark current line as a codeline
%2474% LASTCODELINE = .LINLCURR; ! Set pointer to last code line
IF .CHAR EQL "0"
THEN
BEGIN % INITIAL LINE %
STATE _ STNULLST;
LEAVE SMALCHAR
END
ELSE
BEGIN % CONTINUATION CHARACTER %
ACTION _ ACTILNTC;
LEAVE NEWACTION
END
$;
% NON CONTINUATION CHARACTER FOLLOWING TAB %
MACRO
ACMILITNC =
%2474% HASCODE(LINLCURR) = 1; ! Mark current line as a codeline
%2474% LASTCODELINE = .LINLCURR; ! Set pointer to last code line
CHARPOS _ 65; ! 7TH CHARACTER POSITION
STATE _ STNULLST;
LEAVE NEWSTATE
$;
% DIGIT FOLLOWING TAB ON INITIAL LINE %
MACRO
ACMILITC =
%2474% HASCODE(LINLCURR) = 1; ! Mark current line as a codeline
%2474% LASTCODELINE = .LINLCURR; ! Set pointer to last code line
STATE _ STNULLST;
IF .CHAR NEQ "0"
THEN
BEGIN % INITIAL LINE HAS CONTINUATION CHARACTER %
WARNERR ( .LINELINE, E109<0,0>);
CHARPOS _ 66; ! 6TH CHARACTER POSITION
LEAVE SMALCHAR
END
ELSE
BEGIN % OK ITS A ZERO %
CHARPOS _ 65; ! 7TH CARACTER POSITION
LEAVE SMALCHAR
END
$;
MACRO
ACMCOMNT =
%2260% IF FLAGEITHER
%2260% THEN ! Doing Compatibility flagging
%2260% IF FLAGANSI AND .CHAR EQL "!"
%2260% THEN ! ANSI doesn't like "!" in column 1
%2477% WARNLEX(ANSIPLIT,E265<0,0>)
%2455% ELSE ! Either VMS or ANSI
%2273% IF .CHAR NEQ "C" AND .CHAR NEQ "!" AND .CHAR NEQ "*"
%2260% THEN CFLEXB(E265<0,0>); ! Bad character in column 1
CALLR (STREMARK,STCOMNT);
LEAVE SMALCHAR
$;
MACRO
ACMDEBUG =
%2260% IF FLAGANSI THEN WARNLEX(E225<0,0>); ! ANSI doesn't like debug lines
IF NOT .FLGREG<INCLUDE>
THEN
BEGIN
CALLR ( STREMARK, STCOMNT ); ! TREAT AS COMMENT LINE
LEAVE SMALCHAR
END
ELSE
BEGIN
STATE _ STILABEL; ! PROCESS THE LABEL FIELD
LEAVE SMALCHAR
END
$;
!----------------------------------------------------------------------
! COMMENT LINES
!----------------------------------------------------------------------
% SMALL STATE DEFINITION STCOMNT NUMBER (#) 4S %
BIND
ILL4S = ACTINTERR,
TAB4S = ACTINTERR,
LT4S = ACTLT,
BLANK4S = ACTINTERR,
SPEC4S = ACTINTERR,
DIGIT4S = ACTINTERR,
UPPER4S = ACTINTERR,
LOWER4S = ACTINTERR,
FOS4S = ACTCOMNTFOS,
%713% EOB4S = ACTEOB,
REMARK4S = ACTINTERR;
% END OF THE COMMENT LINE %
MACRO
ACMCOMNTFOS =
ACTION _ ACTSTMNTFOS;
LEAVE NEWACTION
$;
!----------------------------------------------------------------------
! NULL STATEMENT CHECK
!----------------------------------------------------------------------
% SMALL STATE DEFINITION STNULLST NUMBER (#) 3S %
% THIS STATE WILL SKIP ALL BLANKS AN TABS TO THE FIRST
SIGNIFICANT CHARACTER OF THE STATEMENT FIELD. IF IT THEN ENCOUNTERS
EOS IT IS A NULL STATEMENT AND CONTROL WILL BE TRANSFERED BACK TO
STSTMNT TO PROCESS THE NEXT STATEMENT. OTHERWISE CONTROL IS TRANSFERED
TO THE CLASSIFIER TO CLASSIFY THE STATEMENT. %
BIND
ILL3S = ACTILLCHAR,
TAB3S = ACTTAB,
LT3S = ACTLT,
BLANK3S = ACTANY,
SPEC3S = ACTMULTNULL,
DIGIT3S = ACTMULTNULL,
UPPER3S = ACTCLASF1,
LOWER3S = ACTUPLOW,
FOS3S = ACTNULLFOS,
EOB3S = ACTEOB,
REMARK3S = ACTENTREMARK;
% CHECK FOR MULTIPLE STATEMENT TERMINATOR %
MACRO
ACMMULTNULL =
BEGIN
IF .CHAR EQL ";"
THEN % YOU GOT ONE %
BEGIN CHAR _ EOS;
CODE _ FOS;
LEAVE NEWSTATE
END
ELSE
BEGIN % UNRECOGNIZED STATEMENT %
CLASERR _ 1;
ACTION _ ACTSTSKIP;
LEAVE NEWACTION
END
END $;
% CHECK TO SEE THAT THE NULL STATEMENT IS UNLABELED %
MACRO
ACMNULLFOS =
IF .STALABL NEQ 0 OR .ZEROCHK NEQ 0
THEN
BEGIN % CAN'T HAVE LABELED NULL STATEMENTS %
FATLERR (PLIT'NULL?0', .ISN,E110<0,0>)
END;
ACTION _ ACTSTMNTFOS;
LEAVE NEWACTION
$;
!----------------------------------------------------------------------
! CLASSIFICATION STATES
!----------------------------------------------------------------------
% BIG STATE DEFINITION STCLASF2 NUMBER (#) 7B %
% CHARACTER 2, WE HAVE <ALPHA> %
BIND
ILL7B = ACTCLILLCHAR,
TAB7B = ACTTAB,
LT7B = ACTCLASLT,
BLANK7B = ACTANY,
SPEC7B = ACTCLASUNREC,
DIGIT7B = ACTCLASAL1,
UPPER7B = ACTCLASF2,
LOWER7B = ACTUPLOW,
FOS7B = ACTCLASUNREC,
EOB7B = ACTEOB,
REMARK7B = ACTENTREMARK,
EQUAL7B = ACTASGNMNT,
%1247% LPAREN7B = ACTCLAS1A,
RPAREN7B = ACTCLASUNREC,
COLON7B = ACTCLASUNREC,
COMMA7B = ACTCLASUNREC,
DOLLAR7B = ACTCLASUNREC,
ASTERISK7B = ACTCLASUNREC,
SLASH7B = ACTCLASUNREC,
PLUS7B = ACTCLASUNREC,
MINUS7B = ACTCLASUNREC,
ANDSGN7B = ACTCLASUNREC,
LITSGN7B = ACTCLASUNREC,
OCTSGN7B = ACTCLASUNREC,
NEQSGN7B = ACTCLASUNREC,
DOT7B = ACTCLASUNREC,
SEMICOL7B = ACTCLASUNREC,
LTSGN7B = ACTCLASUNREC,
GTSGN7B = ACTCLASUNREC,
COMNTSGN7B = ACTCLASF2,
DEBUGSGN7B = ACTCLASF2,
UPAROW7B = ACTCLASUNREC;
% BIG STATE DEFINITION STCLASAL1 NUMBER (#) 8B %
% WE HAVE *<ALPHANUM> CLASSIFY AS TO ASSIGNMENT OR STFN/ARRY %
BIND
ILL8B = ACTCLILLCHAR,
TAB8B = ACTTAB,
LT8B = ACTCLASLT,
BLANK8B = ACTANY,
SPEC8B = ACTCLASUNREC,
DIGIT8B = ACTANY,
UPPER8B = ACTANY,
LOWER8B = ACTANY,
FOS8B = ACTCLASUNREC,
EOB8B = ACTEOB,
REMARK8B = ACTENTREMARK,
EQUAL8B = ACTASGNMNT,
%1247% LPAREN8B = ACTCLAS1A,
RPAREN8B = ACTCLASUNREC,
COLON8B = ACTCLASUNREC,
COMMA8B = ACTCLASUNREC,
DOLLAR8B = ACTCLASUNREC,
ASTERISK8B = ACTCLASUNREC,
SLASH8B = ACTCLASUNREC,
PLUS8B = ACTCLASUNREC,
MINUS8B = ACTCLASUNREC,
ANDSGN8B = ACTCLASUNREC,
LITSGN8B = ACTCLASUNREC,
OCTSGN8B = ACTCLASUNREC,
NEQSGN8B = ACTCLASUNREC,
DOT8B = ACTCLASUNREC,
SEMICOL8B = ACTCLASUNREC,
LTSGN8B = ACTCLASUNREC,
GTSGN8B = ACTCLASUNREC,
COMNTSGN8B = ACTANY,
DEBUGSGN8B = ACTANY,
UPAROW8B = ACTCLASUNREC;
% SMALL STATE DEFINITION STCLASF3 NUMBER (#) 17S %
% THIRD ALPHA CHARACTER %
% LOOKING FOR POSSIBLE "DO" OR "IF" %
BIND
ILL17S = ACTCLILLCHAR,
TAB17S = ACTTAB,
LT17S = ACTCLASLT,
BLANK17S = ACTANY,
SPEC17S = ACTIFCHK,
DIGIT17S = ACTDOCHK,
%1573% UPPER17S = ACTDOCHK,
LOWER17S = ACTUPLOW,
FOS17S = ACTCLASUNREC,
EOB17S = ACTEOB,
REMARK17S = ACTENTREMARK;
% BIG STATE DEFINITION STIFCHK NUMBER (#) 9B %
% WE HAVE "IF" "(" <EXP> ")" %
BIND
ILL9B = ACTCLILLCHAR,
TAB9B = ACTTAB,
LT9B = ACTCLASLT,
BLANK9B = ACTANY,
SPEC9B = ACTCLASUNREC,
DIGIT9B = ACTARITHIF,
UPPER9B = ACTTHENCHK,
LOWER9B = ACTUPLOW,
FOS9B = ACTCLASUNREC,
EOB9B = ACTEOB,
REMARK9B = ACTENTREMARK,
%1247% EQUAL9B = ACTSUBCHK,
%1247% LPAREN9B = ACTSUBASSIGN,
RPAREN9B = ACTCLILLCHAR,
COLON9B = ACTCLASUNREC,
COMMA9B = ACTCLASUNREC,
DOLLAR9B = ACTCLASUNREC,
ASTERISK9B = ACTCLASUNREC,
SLASH9B = ACTCLASUNREC,
PLUS9B = ACTCLASUNREC,
MINUS9B = ACTCLASUNREC,
ANDSGN9B = ACTCLASUNREC,
LITSGN9B = ACTCLASUNREC,
OCTSGN9B = ACTCLASUNREC,
NEQSGN9B = ACTCLASUNREC,
DOT9B = ACTCLASUNREC,
SEMICOL9B = ACTCLASUNREC,
LTSGN9B = ACTCLASUNREC,
GTSGN9B = ACTCLASUNREC,
COMNTSGN9B = ACTLOGICIF,
DEBUGSGN9B = ACTLOGICIF,
UPAROW9B = ACTCLASUNREC;
% SMALL STATE DEFINITION STTHENCHK NUMBER (#) 20S %
% WE HAVE "IF(" <EXPRESSION> ")" <LETTER> CHECK FOR "THEN" %
BIND
ILL20S = ACTTHENCHK,
TAB20S = ACTTAB,
LT20S = ACTCLASLT,
BLANK20S = ACTANY,
SPEC20S = ACTTHENCHK,
DIGIT20S = ACTTHENCHK,
UPPER20S = ACTTHENCHK,
LOWER20S = ACTUPLOW,
FOS20S = ACTTHENCHK,
EOB20S = ACTEOB,
REMARK20S = ACTENTREMARK;
% BIG STATE DEFINITION STDOCHK1 NUMBER (#) 10B %
% WE HAVE "DO" <DIGIT> %
BIND
ILL10B = ACTCLILLCHAR,
TAB10B = ACTTAB,
LT10B = ACTCLASLT,
BLANK10B = ACTANY,
SPEC10B = ACTSPELLING,
DIGIT10B = ACTANY,
UPPER10B = ACTANY,
LOWER10B = ACTANY,
%1573% FOS10B = ACTSPELLING,
EOB10B = ACTEOB,
REMARK10B = ACTENTREMARK,
EQUAL10B = ACTDOCHK1,
%1573% LPAREN10B = ACTDOCHK2,
RPAREN10B = ACTSPELLING,
COLON10B = ACTSPELLING,
%1573% COMMA10B = ACTANY,
DOLLAR10B = ACTSPELLING,
ASTERISK10B = ACTSPELLING,
SLASH10B = ACTSPELLING,
PLUS10B = ACTSPELLING,
MINUS10B = ACTSPELLING,
ANDSGN10B = ACTSPELLING,
LITSGN10B = ACTSPELLING,
OCTSGN10B = ACTSPELLING,
NEQSGN10B = ACTSPELLING,
DOT10B = ACTSPELLING,
SEMICOL10B = ACTSPELLING,
LTSGN10B = ACTSPELLING,
GTSGN10B = ACTSPELLING,
COMNTSGN10B = ACTANY,
DEBUGSGN10B = ACTANY,
UPAROW10B = ACTSPELLING;
% BIG STATE DEFINITION STDOCHK2 NUMBER (#) 11B %
% WE HAVE "DO" <ALPHANUM> "=" <TERM> %
BIND
ILL11B = ACTCLILLCHAR,
TAB11B = ACTTAB,
LT11B = ACTCLASLT,
BLANK11B = ACTANY,
SPEC11B = ACTANY,
DIGIT11B = ACTENTERM,
UPPER11B = ACTENTERM,
LOWER11B = ACTENTERM,
FOS11B = ACTUNMATKEY,
EOB11B = ACTEOB,
REMARK11B = ACTENTREMARK,
EQUAL11B = ACTANY,
LPAREN11B = ACTENTERM,
RPAREN11B = ACTCLILLCHAR,
COLON11B = ACTANY,
COMMA11B = ACTDOSTMNT,
DOLLAR11B = ACTANY,
ASTERISK11B = ACTANY,
SLASH11B = ACTANY,
PLUS11B = ACTANY,
MINUS11B = ACTANY,
ANDSGN11B = ACTANY,
LITSGN11B = ACTENTERM,
OCTSGN11B = ACTANY,
NEQSGN11B = ACTANY,
DOT11B = ACTANY,
SEMICOL11B = ACTMULTST,
LTSGN11B = ACTANY,
GTSGN11B = ACTANY,
COMNTSGN11B = ACTENTERM,
DEBUGSGN11B = ACTENTERM,
UPAROW11B = ACTANY;
%1573%
% SMALL STATE DEFINITION STDOCHK3 NUMBER (#) 21S %
% WE HAVE "DO" <LETTERS & DIGITS> ( ... ) %
% CHECK FOR DO WHILE %
BIND
ILL21S = ACTCLILLCHAR,
TAB21S = ACTTAB,
LT21S = ACTCLASLT,
BLANK21S = ACTANY,
SPEC21S = ACTWHILECHK,
DIGIT21S = ACTWHILECHK,
UPPER21S = ACTWHILECHK,
LOWER21S = ACTWHILECHK,
FOS21S = ACTWHILECHK,
EOB21S = ACTEOB,
REMARK21S = ACTENTREMARK;
% BIG STATE DEFINITION STCLASF4 NUMBER (#) 14B %
% WE HAVE 3*<ALPHA> %
BIND
ILL14B = ACTCLILLCHAR,
TAB14B = ACTTAB,
%2241% LT14B = ACTLTENDCHK,
BLANK14B = ACTANY,
SPEC14B = ACTCLASUNREC,
DIGIT14B = ACTCLASAL1,
UPPER14B = ACTCLASF4,
LOWER14B = ACTUPLOW,
FOS14B = ACTENDCHK,
EOB14B = ACTEOB,
REMARK14B = ACTENTREMARK,
EQUAL14B = ACTASGNMNT,
%1247% LPAREN14B = ACTCLAS1A,
RPAREN14B = ACTCLASUNREC,
COLON14B = ACTCLASUNREC,
COMMA14B = ACTCLASUNREC,
DOLLAR14B = ACTCLASUNREC,
ASTERISK14B = ACTCLASUNREC,
SLASH14B = ACTCLASUNREC,
PLUS14B = ACTCLASUNREC,
MINUS14B = ACTCLASUNREC,
ANDSGN14B = ACTCLASUNREC,
LITSGN14B = ACTCLASUNREC,
OCTSGN14B = ACTCLASUNREC,
NEQSGN14B = ACTCLASUNREC,
DOT14B = ACTCLASUNREC,
SEMICOL14B = ACTMULTST,
LTSGN14B = ACTCLASUNREC,
GTSGN14B = ACTCLASUNREC,
COMNTSGN14B = ACTCLASF4,
DEBUGSGN14B = ACTCLASF4,
UPAROW14B = ACTCLASUNREC;
% BIG STATE DEFINITION STCLASAL2 NUMBER (#) 12B %
% WE HAVE < 4 LETTERS OF A KEY WORD > %
BIND
ILL12B = ACTCLILLCHAR,
TAB12B = ACTTAB,
LT12B = ACTCLASLT,
BLANK12B = ACTANY,
SPEC12B = ACTSPELLING,
DIGIT12B = ACTANY,
UPPER12B = ACTANY,
LOWER12B = ACTANY,
FOS12B = ACTSPELLING,
EOB12B = ACTEOB,
REMARK12B = ACTENTREMARK,
EQUAL12B = ACTASGNMNT,
LPAREN12B = ACTKEYTERM,
RPAREN12B = ACTCLILLCHAR,
COLON12B = ACTSPELLING,
COMMA12B = ACTSPELLING,
DOLLAR12B = ACTSPELLING,
ASTERISK12B = ACTSPELLING,
SLASH12B = ACTSPELLING,
PLUS12B = ACTSPELLING,
MINUS12B = ACTSPELLING,
ANDSGN12B = ACTSPELLING,
LITSGN12B = ACTSPELLING,
OCTSGN12B = ACTSPELLING,
NEQSGN12B = ACTSPELLING,
DOT12B = ACTSPELLING,
SEMICOL12B = ACTSPELLING,
LTSGN12B = ACTSPELLING,
GTSGN12B = ACTSPELLING,
COMNTSGN12B = ACTANY,
DEBUGSGN12B = ACTANY,
UPAROW12B = ACTSPELLING;
% BIG STATE DEFINITION STCLASAL1A NUMBER (#) 15B % ![1247] New
% WE HAVE <ALPHANUM>* "(" <EXP> ")" %
BIND
ILL15B = ACTCLILLCHAR,
TAB15B = ACTTAB,
LT15B = ACTCLASLT,
BLANK15B = ACTANY,
SPEC15B = ACTCLASUNREC,
DIGIT15B = ACTCLASUNREC,
UPPER15B = ACTCLASUNREC,
LOWER15B = ACTCLASUNREC,
FOS15B = ACTCLASUNREC,
EOB15B = ACTEOB,
REMARK15B = ACTENTREMARK,
EQUAL15B = ACTSUBCHK,
LPAREN15B = ACTSUBASSIGN,
RPAREN15B = ACTCLILLCHAR,
COLON15B = ACTCLASUNREC,
COMMA15B = ACTCLASUNREC,
DOLLAR15B = ACTCLASUNREC,
ASTERISK15B = ACTCLASUNREC,
SLASH15B = ACTCLASUNREC,
PLUS15B = ACTCLASUNREC,
MINUS15B = ACTCLASUNREC,
ANDSGN15B = ACTCLASUNREC,
LITSGN15B = ACTCLASUNREC,
OCTSGN15B = ACTCLASUNREC,
NEQSGN15B = ACTCLASUNREC,
DOT15B = ACTCLASUNREC,
SEMICOL15B = ACTMULTST,
LTSGN15B = ACTCLASUNREC,
GTSGN15B = ACTCLASUNREC,
COMNTSGN15B = ACTCLASUNREC,
DEBUGSGN15B = ACTCLASUNREC,
UPAROW15B = ACTCLASUNREC;
% BIG STATE DEFINITION STCLASAL2A NUMBER (#) 13B %
% WE HAVE < 4 LETTERS OF KEY WORD > < ALPHANUM> "(" <EXP> ")" %
BIND
ILL13B = ACTCLILLCHAR,
TAB13B = ACTTAB,
LT13B = ACTCLASLT,
BLANK13B = ACTANY,
SPEC13B = ACTSPELLING,
DIGIT13B = ACTSPELLING,
UPPER13B = ACTSPELLING,
LOWER13B = ACTSPELLING,
FOS13B = ACTUNMATKEY,
EOB13B = ACTEOB,
REMARK13B = ACTENTREMARK,
%1247% EQUAL13B = ACTSUBCHK,
%1247% LPAREN13B = ACTKEYSUB,
RPAREN13B = ACTCLILLCHAR,
COLON13B = ACTSPELLING,
COMMA13B = ACTSPELLING,
DOLLAR13B = ACTSPELLING,
ASTERISK13B = ACTSPELLING,
SLASH13B = ACTSPELLING,
PLUS13B = ACTSPELLING,
MINUS13B = ACTSPELLING,
ANDSGN13B = ACTSPELLING,
LITSGN13B = ACTSPELLING,
OCTSGN13B = ACTSPELLING,
NEQSGN13B = ACTSPELLING,
DOT13B = ACTSPELLING,
SEMICOL13B = ACTSPELLING,
LTSGN13B = ACTSPELLING,
GTSGN13B = ACTSPELLING,
COMNTSGN13B = ACTSPELLING,
DEBUGSGN13B = ACTSPELLING,
UPAROW13B = ACTSPELLING;
% BIG STATE DEFINITION STCLASAL1B NUMBER (#) 16B % ![1247] New
% WE HAVE <KEYWORD> "(" <EXP> ")" "(" <EXP> ")" %
% SUBSTRING ASSIGNMENT IF FOLLOWED BY "=", ELSE KEYWORD STATEMENT %
BIND
ILL16B = ACTCLILLCHAR,
TAB16B = ACTTAB,
LT16B = ACTCLASLT,
BLANK16B = ACTANY,
SPEC16B = ACTSPELLING,
DIGIT16B = ACTSPELLING,
UPPER16B = ACTSPELLING,
LOWER16B = ACTSPELLING,
FOS16B = ACTSPELLING,
EOB16B = ACTSPELLING,
REMARK16B = ACTSPELLING,
EQUAL16B = ACTSUBASSIGN,
LPAREN16B = ACTSPELLING,
RPAREN16B = ACTSPELLING,
COLON16B = ACTSPELLING,
COMMA16B = ACTSPELLING,
DOLLAR16B = ACTSPELLING,
ASTERISK16B = ACTSPELLING,
SLASH16B = ACTSPELLING,
PLUS16B = ACTSPELLING,
MINUS16B = ACTSPELLING,
ANDSGN16B = ACTSPELLING,
LITSGN16B = ACTSPELLING,
OCTSGN16B = ACTSPELLING,
NEQSGN16B = ACTSPELLING,
DOT16B = ACTSPELLING,
SEMICOL16B = ACTSPELLING,
LTSGN16B = ACTSPELLING,
GTSGN16B = ACTSPELLING,
COMNTSGN16B = ACTSPELLING,
DEBUGSGN16B = ACTSPELLING,
UPAROW16B = ACTSPELLING;
% SMALL STATE DEFINITION STSPELLING NUMBER (#) 18S %
% CHECK THE SPELLING OF THE KEY WORD, IGNORING BLANKS AND TABS %
BIND
ILL18S = ACTCOMPAR,
TAB18S = ACTTAB,
%2241% LT18S = ACTENDLTCHK,
BLANK18S = ACTANY,
SPEC18S = ACTCOMPAR,
DIGIT18S = ACTCOMPAR,
UPPER18S = ACTCOMPAR,
LOWER18S = ACTUPLOW,
FOS18S = ACTCOMPAR,
EOB18S = ACTEOB,
REMARK18S = ACTENTREMARK;
% SMALL STATE DEFINITION STENDLSN NUMBER (#) 23S %
% AFTER AN END STATEMENT, CALCULATE THE NEXT LINE (OR LIN SEQ NO.)
THEN RETURN EOS SINCE CONTINUATION IS PROHIBITED. %
%2431% ! New - TFV, 18-Jul-84
BIND
ILL23S = ACTENDLSN,
TAB23S = ACTENDLSN,
LT23S = ACTENDLSN,
BLANK23S = ACTENDLSN,
SPEC23S = ACTENDLSN,
DIGIT23S = ACTENDLSN,
UPPER23S = ACTENDLSN,
LOWER23S = ACTENDLSN,
FOS23S = ACTENDLSN,
EOB23S = ACTEOB,
REMARK23S = ACTENDLSN;
%2241% MACRO
%2241% ACMLTENDCHK =
%2241%
%2241% IF .CHAR EQL CR
%2241% THEN
%2241% BEGIN ! Ignore CR's
%2241% ISCAN(CHAR,CURPTR);
%2241% LEAVE NEWSTATE;
%2241% END ! Ignore CR's
%2241% ELSE IF .NAME EQL "END"
%2241% THEN
%2241% BEGIN ! An END statement
%2241% STMNDESC = DSCEND<ADRS>;
%2241% ACTION = ACTSPELLING;
%2241% LEAVE NEWACTION;
%2241% END ! An END statement
%2241% ELSE
%2241% BEGIN ! Continuation processing
%2241% IF .INCLAS EQL 0
%2505% THEN IF .BACKLINE EQL 0
%2505% THEN BACKLINE = .LINLCURR;
%2241%
%2474% ! Setup pointer to last codeline
%2474% IF .HASCODE(LINLCURR)
%2474% THEN LASTCODELINE = .LINLCURR;
%2474% ! Setup pointer for end of line
%2474% LASTBP(LINLCURR) = .CURPTR;
%2474% ! Reset flag for no lt on line
%2474% NOLTLINE = 0;
%2241% ENTCALCONT;
%2241% END; ! Continuation processing
%2241% $;
%2241% MACRO
%2241% ACMENDLTCHK =
%2241% IF .CHAR EQL CR
%2241% THEN ( EXTRACRCHK )
%2241% ELSE IF .FOUNDCR ! CR WAS FOUND IN REMARK PROCESSING
%2241% THEN FOUNDCR _ 0
%2241% ELSE NOCR _ 1;
%2474% ! Setup pointer to last codeline
%2474% IF .HASCODE(LINLCURR)
%2474% THEN LASTCODELINE = .LINLCURR;
%2474% LASTBP(LINLCURR) = .CURPTR; ! Setup pointer for end of line
%2474% NOLTLINE = 0; ! Reset flag for no lt on line
%2474% PRINT(.LINLCURR);
%2241% IF .STMNDESC EQL DSCEND<0,0>
%2241% THEN
%2241% BEGIN ! Maybe end of END statement line
%2241% REGISTER
%2241% PTR,
%2241% NXTCHR;
%2241% PTR = .KEYPTR;
%2241% ISCAN(NXTCHR,PTR);
%2241% IF .NXTCHR EQL 0
%2241% THEN
%2241% BEGIN ! We matched an END statement
%2431% STATE = STENDLSN;
%2431% LEAVE SMALCHAR;
%2241% END; ! We matched an END statement
%2241% END;
%2474% ! Setup pointer to last codeline
%2474% IF .HASCODE(LINLCURR)
%2474% THEN LASTCODELINE = .LINLCURR;
%2474% LASTBP(LINLCURR) = .CURPTR; ! Setup pointer for end of line
%2474% NOLTLINE = 0; ! Reset flag for no lt on line
%2241% ENTCALCONT; ! continuation processing
%2241% $;
%2431% ! Calculate line number for statement following the END statement
MACRO
ACMENDLSN =
%2431% LASTLINE _ .LINELINE; ! SAVE LINE NUMBER
%2431% % CHECK FOR LINE SEQ NO. AND SET LINELINE %
%2431% IF LINESEQBIT % TEST LINE SEQ BIT %
%2431% THEN
%2431% BEGIN
%2431% LINELINE _ LINESEQNO( CURPTR<ADRS> ); ! DECODE NUMBER
%2431% LINEPTR _ .CURPTR; ! ADJUST BEGINNING PTR
%2431% END
%2431% ELSE
%2431% BEGIN
%2431% % NO LINE SEQ NO %
%2431% LINELINE _ .LINELINE + 1;
%2431% DECREMENT(CURPTR<ADRS>);
%2431% LINEPTR _ .CURPTR; ! ADJUST BEGINNING PTR
%2431% END;
%2474% NEWCELL(); ! Get entry for new line
%2474% FCHARPOS = 72;
%2431% CHARPOS _ 72;
%2431% CHAR = EOS;
%2431% CODE = FOS;
%2431% RETURNOW(NOT ENDOFILE<0,0>);
%2431% $;
% LINE TERMINATORS DURING CLASSIFICATION LOOKAHEAD SHOULD BE
DETECTED BUT NOT CAUSE PRINTING %
MACRO
ACMCLASLT =
IF .CHAR EQL CR
THEN
BEGIN % IGNORE THE CR %
ISCAN (CHAR, CURPTR );
LEAVE NEWSTATE
END
ELSE
BEGIN % CHECK FOR CONTINUATION BUT NO PRINTING %
%2505% IF .INCLAS EQL 0
%2505% THEN IF .BACKLINE EQL 0
%2505% THEN BACKLINE = .LINLCURR; ! FOR NON-CLASSIFICATION BACKUP
%2474% ! Setup pointer to last codeline
%2474% IF .HASCODE(LINLCURR)
%2474% THEN LASTCODELINE = .LINLCURR;
%2474% LASTBP(LINLCURR) = .CURPTR; ! Setup pointer for end of line
%2474% NOLTLINE = 0; ! Reset flag for no lt on line
ENTCALCONT
END
$;
% UNRECOGNIZED STATEMENT %
MACRO
ACMCLASUNREC =
CLASERR _ 1; ! CAUSES ACTSTSKP TO PRINT UNRECOGNIZED MESSAGE
% CHECK FOR LOGICAL IF CLASSIFICATION %
IF .LGIFCLAS NEQ 0
THEN ( STATE _ STRETNX; VALUE _ ENDOFILE<ADRS> )
ELSE STATE _ STSTMNT;
ACTION _ ACTCLASBACK;
LEAVE NEWACTION
$;
% BACKUP AND GO TO SKIP STATEMENT WHICH WILL DETECT AND REPORT
THE ERROR %
MACRO
ACMCLILLCHAR =
CLASERR _ 1;
% CHECK FOR LOGICAL IF CLASSIFICATION %
IF .LGIFCLAS NEQ 0
THEN ( STATE _ STRETNX; VALUE _ ENDOFILE<ADRS> )
ELSE ( CALLR ( STSKIP,STSTMNT) );
ACTION _ ACTCLASBACK;
LEAVE NEWACTION
$;
% RESTORE THE INPUT STREAM TO POSITION BEFORE CLASSIFICATION
AND PROCEED TO THE STATE WHICH WAS SET BY THE ACTION
WHICH EXECUTED THIS ACTION %
MACRO
ACMCLASBACK =
CURPTR _ .CLASPTR;
LINELINE _ .CLASLINE;
CHARPOS _ .CLASPOS;
LINEPTR _ .CLASLPT;
%2474% ! Find the last code line
%2500% LINLCURR = LINLLIST<0,0>; ! Start at top
%2474% LASTCODELINE = 0;
%2500% WHILE .LINLCURR LEQ .CLASLCUR
%2474% DO
%2474% BEGIN
%2474% IF .HASCODE(LINLCURR) THEN LASTCODELINE = .LINLCURR;
%2500% LINLCURR = .LINLCURR + LINLSENT;
%2474% END;
%2500% LINLLAST = LINLCURR = .CLASLCUR; ! End of linked list
PAREN _ 0;
INCLAS _ 0;
LEAVENXT ! FIRST CHARACTER OF STATEMENT
$;
% SET FLAG FOR LOGICAL IF CLASSIFICATION %
MACRO
ACMCLASF1 =
REGISTER CELL; ! Current entry on linked list
IF .STATE EQL STIFCLASIF
THEN
%2474% BEGIN ! Logical IF consequent
LGIFCLAS _ 1;
%2474% END ! Logical IF consequent
ELSE LGIFCLAS _ 0; ! Not logical IF
% ENTER THE CLASSIFIER WITH FIRST LETTER OF THE STATEMENT %
% CHECK FOR STATEMENTS LABELED WITH 0 %
IF .STALABL EQL 0 AND .ZEROCHK NEQ 0
THEN FATLERR ( .ISN, E19<0,0> ); ! LABEL WAS ZERO
STMNDESC _ 0; ! CLEAR FOR PURPOSES OF RECOGNIZING THE PARAMETER STATEMENT
INCLAS _ 1;
CLASERR _ 0;
NAME _ .CHAR;
%1247% COLONCOUNT _ 0;
% SAVE POSITION FOR BACKUP %
CLASPTR _ .CURPTR;
DECREMENT (CLASPTR<ADRS> ); ! POINTS TO 1ST CHAR -1
CLASLINE _ .LINELINE;
CLASPOS _ .CHARPOS + 1;
CLASLPT _ .LINEPTR;
%2474% CLASLCUR = .LINLCURR;
% BEGIN CLASSIFICATION %
STATE _ STCLASF2;
LEAVE BIGCHAR
$;
% ENTER ALGORITHM 1 WHICH CHECKS FOR ASSIGNMENT OR
STATEMENT FN / ARRAY REF OR [1247] SUBSTRING ASSIGNMENT %
MACRO
ACMCLASAL1 =
STATE _ STCLASAL1;
LEAVE NEWSTATE ! WITH CURRENT CHARACTER
$;
% [1247] WE HAVE <IDENTIFIER> ( %
% SKIP OVER THE PARENTHESIZED STRING (COUNTING ZERO-LEVEL COLONS)
AND CHECK THE CHARACTER AFTER THE CORRESPONDING RIGHT PAREN %
MACRO
ACMCLAS1A =
PAREN _ 1;
CALLR (STTERM, STCLASAL1A);
LEAVE BIGCHAR
$;
% WE HAVE AN ASSIGNMENT STATEMENT %
MACRO
ACMASGNMNT =
IF .STMNDESC EQL DSCPARAMT<0,0>
THEN
BEGIN %MAY BE A PARAMETER STATEMENT%
ACTION _ ACTSPELLING;
LEAVE NEWACTION
END;
STMNDESC _ DSCASGNMT<ADRS>;
STATE _ STRETNX; ! RETURN - NOT END OF FILE
VALUE _ NOT ENDOFILE<0,0>;
ACTION _ ACTCLASBACK;
LEAVE NEWACTION
$;
% SECOND ALPHABETIC CHARACTER %
MACRO
ACMCLASF2 =
NAME _ .NAME^7 + .CHAR;
STATE _ STCLASF3; ! WHAT IS THE 3RD
LEAVE SMALCHAR
$;
% THE THIRD CHARACTER OF THE STATEMENT WAS A SPECIAL CHARACTER
SO LETS SEE IF WE HAVE AN "IF" %
MACRO
ACMIFCHK =
IF .NAME EQL "IF" AND .CHAR EQL "("
THEN
BEGIN % POSSIBLE IF %
CALLR ( STTERM, STIFCHK ); ! SKIP WHATEVER IS IN ()
PAREN _ 1; ! THE FIRST WAS JUST PICKED UP
POINTER _ (UPLIT 'THEN?0')<36,7>; ! INIT POINTER FOR THENCHK
LEAVE BIGCHAR
END
ELSE
BEGIN % TRY ASSIGNMENT OR STFN/ARRAY %
STATE _ STCLASAL1;
CODE _ BIGCODE;
LEAVE NEWSTATE
END
$;
![1214], routine to distinguish logical IF and block IF
! POINTER has been set to asciz "THEN" by ACMIFCHK
! Here from STIFCHK on any letter after IF (...)
! and from STTHENCHK on any character after IF (...) T (or TH or THE or THEN)
! Check for match against THEN <EOS>. If it matches, block IF; if not, logical
MACRO
ACMTHENCHK =
REGISTER R;
STATE _ STTHENCHK; ! ENTER SMALL STATE TO SCAN FOR THEN
ISCAN (R,POINTER); ! GET NEXT CHAR OF "THEN"
IF .CHAR EQL .R THEN LEAVE SMALCHAR ! MATCH
ELSE
BEGIN ! HERE ON FIRST DIFFERENCE
! HAVE R = FIRST CHAR THAT DIFFERED,
! CHAR = DIFFERING CHAR FROM THE SOURCE
IF .R EQL 0 AND (.CHAR EQL EOS OR .CHAR EQL ";")
THEN ACTION _ ACTBLOCKIF
ELSE ACTION _ ACTLOGICIF;
LEAVE NEWACTION;
END
$;
% THE FIRST 2 CHARACTERS WERE ALPHA AND THE 3RD A DIGIT
SO HOW ABOUT A "DO" %
MACRO
ACMDOCHK =
IF .NAME EQL "DO"
THEN
BEGIN %POSSIBLY , LETS CHECK FOR ZERO LEVEL COMMA %
%1573% DOCHAR _ .CHAR; ! Save char after "DO"
%1573% STMNDESC _ DSCDOUB<0,0>; ! Set STMNDESC in case this turns
%1573% ! out to be DOUBLE PRECISION statement
STATE _ STDOCHK1;
LEAVE BIGCHAR
END
ELSE
BEGIN % NOT DO %
%1573% ACTION _ ACTCLASF3;
%1573% LEAVE NEWACTION
END
$;
% WE HAVE AN ARITHMETIC IF %
MACRO
ACMARITHIF =
STMNDESC _ DSCIFARITH<ADRS>;
ACTION _ ACTSPELLING; ! SKIPS OVER AND PRINTS THE IF
LEAVE NEWACTION
$;
% LOGICAL IF STATEMENT %
MACRO
ACMLOGICIF =
STMNDESC _ DSCIFLOGIC<ADRS>;
ACTION _ ACTSPELLING; ! SKIPS OVER AND PRINTS THE IF
LEAVE NEWACTION;
$;
% BLOCK IF STATEMENT %
MACRO
ACMBLOCKIF =
STMNDESC _ DSCIFBLOCK<ADRS>;
ACTION _ ACTSPELLING; ! SKIPS OVER AND PRINTS THE IF
LEAVE NEWACTION;
$;
% [1247] STATEMENT FUNCTION/ARRAY REFERENCE OR SUBSTRING ASSIGNMENT %
% HAVE SEEN IDENTIFIER (...) =
IT'S A SUBSTRING ASSIGNMENT IFF COLON WAS SEEN INSIDE THE PARENS %
MACRO
ACMSUBCHK =
IF .COLONCOUNT NEQ 0
THEN STMNDESC _ DSCSUBASSIGN<ADRS>
ELSE STMNDESC _ DSCSFAY<ADRS>;
VALUE _ NOT ENDOFILE<0,0>;
STATE _ STRETNX;
ACTION _ ACTCLASBACK;
LEAVE NEWACTION
$;
% [1247] SUBSTRING ASSIGNMENT %
% HAVE SEEN IDENTIFIER (...) (
MUST BE INDEXED SUBSTRING ASSIGNMENT %
MACRO
ACMSUBASSIGN =
STMNDESC _ DSCSUBASSIGN<ADRS>;
VALUE _ NOT ENDOFILE<0,0>;
STATE _ STRETNX;
ACTION _ ACTCLASBACK;
LEAVE NEWACTION
$;
% [1247] KEYWORD STATEMENT OR SUBSTRING ASSIGNMENT %
% HAVE SEEN <KEYWORD> (...) (
IT'S EITHER A SUBSTRING ASSIGNMENT OR A READ OR WRITE STATEMENT
SKIP TO THE MATCHING RIGHT PAREN AND CHECK FOR "=" FOLLOWING IT %
MACRO
ACMKEYSUB =
PAREN _ 1;
CALLR (STTERM, STCLASAL1B);
LEAVE BIGCHAR
$;
% WE HAVE DO <DIGIT> <ALPHANUM> = %
MACRO
ACMDOCHK1 =
% CHECK FOR ZERO LEVEL COMMA %
PAREN _ 0;
CALLR ( STTERM, STDOCHK2 );
LEAVE BIGCHAR
$;
%1573% % WE HAVE DO <CHARS> ( %
%1573% MACRO
ACMDOCHK2 =
PAREN _ 1;
CALLR ( STTERM, STDOCHK3 );
LEAVE BIGCHAR
$;
%1573% % WE HAVE DO <CHARS> ( <BAL> ) %
%1573% MACRO
ACMWHILECHK =
IF .CHAR EQL EOS OR .CHAR EQL ";"
THEN IF .DOCHAR EQL "W" OR (.DOCHAR GEQ "0" AND .DOCHAR LEQ "9")
THEN
BEGIN
STMNDESC _ DSCWHILE<ADRS>;
ACTION _ ACTSPELLING;
LEAVE NEWACTION;
END;
STATE _ STCLASAL2A;
SETCODE;
LEAVE NEWSTATE
$;
% ITS A "DO" %
MACRO
ACMDOSTMNT =
STMNDESC _ DSCDO<ADRS>;
ACTION _ ACTSPELLING;
LEAVE NEWACTION
$;
% WE HAVE <3 ALPHA > ( EOS / EOF ) %
MACRO
ACMENDCHK =
IF .NAME EQL "END"
THEN
BEGIN % ITS AN END %
STMNDESC _ DSCEND<ADRS>;
ACTION _ ACTSPELLING;
LEAVE NEWACTION
END
ELSE
BEGIN % UNRECOGNIZED STATEMENT %
ACTION _ ACTCLASUNREC;
LEAVE NEWACTION
END
$;
% THIRD LETTER %
MACRO
ACMCLASF3 =
NAME _ .NAME^7 + .CHAR;
STATE _ STCLASF4;
LEAVE BIGCHAR
$;
% WE HAVE 4 ALPHA CHARACTERS %
MACRO
ACMCLASF4 =
NAME _ .NAME^7 + .CHAR;
IF ( STMNDESC _ CLASHASH( .NAME ) ) NEQ 0
THEN
BEGIN % POSSIBLE KEY WORD , GO CHECK FOR ZERO LEVEL "=" TO BE SURE %
STATE _ STCLASAL2;
LEAVE BIGCHAR
END
ELSE
BEGIN % TRY ASSIGNMENT OR STFN/ARRAY %
STATE _ STCLASAL1;
LEAVE BIGCHAR
END
$;
% WE HAVE <4 LETTERS OF KEY WORD> < ALPHANUM > "(" %
MACRO
ACMKEYTERM =
% SKIP WHATS IN () AND LOOK FOR "=" %
PAREN _ 1; ! ONE HAS BEEN PICKED UP
CALLR ( STTERM, STCLASAL2A );
LEAVE BIGCHAR
$;
% WE HAVE EOS. CHECK FOR UNMATCHED "(" BEFORE CLASSIFYING AS
KEY WORD %
MACRO
ACMUNMATKEY =
IF .PAREN NEQ 0 AND NOT .MSNGTIC
THEN ACTION _ ACTCLILLCHAR ! UNMATCHED
% THE MISSING TIC CHECK ALLOWS TIC RECORD MARKS TO GET THROUGH %
ELSE
BEGIN
% IF WE GOT HERE FROM DO LOOP THEN ITS AN ASSIGNMENT %
IF .STATE EQL STDOCHK2
THEN ACTION _ ACTASGNMNT
ELSE ACTION _ ACTSPELLING ! KEY WORD STATEMENT
END;
LEAVE NEWACTION
$;
% NOW CHECK THE SPELLNG OF THE KEY WORD. THIS WILL ALSO CHECK
THE SPELLING OF THE FIRST 4 CHARACTERS AGAIN. THIS IS JUST
TO ASSURE THAT THEY WILL BE PRINTED JUST IN CASE SOME DEVIATE
HAS SPLIT THEM OVER A LINE %
MACRO
ACMSPELLING =
KEYPTR _ ( KEYWRD ( @STMNDESC ) ) < 29,7 >; ! BYTE POINTER TO BEGINNING OF CORRECT SPELLING
STATE _ STSPELLING;
ACTION _ ACTCLASBACK;
LEAVE NEWACTION
$;
% CHECK THE INPUT STRING AGAINST THE CORRECT SPELLING %
MACRO
ACMCOMPAR =
REGISTER KEYCHAR;
ISCAN ( KEYCHAR, KEYPTR ); ! NEXT CHARACTER OF KEY WORD
IF .KEYCHAR EQL .CHAR
THEN
BEGIN % MATCH %
LEAVE SMALCHAR ! TRY THE NEXT ONE
END
ELSE
BEGIN
IF .KEYCHAR EQL 0
THEN
BEGIN % THE SPELLING IS CORRECT %
RETURNOW ( NOT ENDOFILE<0,0> )
END
ELSE
BEGIN % NAME IS MISSPELLED %
%CHECK TO SEE IF WE WERE LOOKING FOR PARAMETER
BECAUSE THEN ITS REALLY AN ASSIGNMENT
CERTAINLY IS CONFUSING %
IF .STMNDESC EQL DSCPARAMT<0,0>
THEN
BEGIN % INDEED IT IS ONE %
STMNDESC _ 0;
ACTION _ ACTASGNMNT;
LEAVE NEWACTION;
END;
FATLERR ( .ISN, E12<0,0> );
IF .LGIFCLAS NEQ 0
THEN ( RETURNOW( ENDOFILE<ADRS> ) );
CALLR ( STSKIP,STSTMNT);
LEAVE NEWSTATE
END
END
$;
!----------------------------------------------------------------------
! RETURN AFTER SKIPPING TO SIGNIFICANT CHAR
!----------------------------------------------------------------------
% SMALL STATE DEFINITION STRETNX NUMBER (#) 2S %
% RETURN AFTER POSITIONING TO THE NEXT SIGNIFICANT CHARACTER %
BIND
ILL2S = ACTRETNOW,
TAB2S = ACTTAB,
LT2S = ACTLT,
BLANK2S = ACTANY,
SPEC2S = ACTRETNOW,
DIGIT2S = ACTRETNOW,
UPPER2S = ACTRETNOW,
LOWER2S = ACTRETNOW,
FOS2S = ACTRETNOW,
EOB2S = ACTEOB,
REMARK2S = ACTENTREMARK;
MACRO
ACMRETNOW =
RETURNOW (.VALUE)
$;
!----------------------------------------------------------------------
! LOGICAL IF OBJECT CLASSIFICATION
!----------------------------------------------------------------------
% SMALL STATE DEFINITION STIFCLASF NUMBER (#) 19S %
% CLASSIFY THE STATEMENT FOLLOWING A LOGICAL IF - THE NEXT CHARACTER
HAD BETTER BE A LETTER OR WE SHOULDN'T BE HERE %
BIND
ILL19S = ACTINTERR,
TAB19S = ACTINTERR,
LT19S = ACTINTERR,
BLANK19S = ACTINTERR,
SPEC19S = ACTINTERR,
DIGIT19S = ACTINTERR,
UPPER19S = ACTCLASF1,
LOWER19S = ACTUPLOW,
FOS19S = ACTINTERR,
EOB19S = ACTINTERR,
REMARK19S = ACTINTERR;
% ILLEGAL CHARACTER, SKIP STATEMENT AND RETURN EOSLEX %
MACRO
ACMBADCHAR =
IF .BACKLINE NEQ 0
THEN BACKPRINT(); ! THERE WAS A LOOKAHEAD THAT PASSED A LINE TERMINATOR
FATLERR ( .CHAR, .LINELINE, E8<0,0> );
REPLACEN ( CURPTR, "??" );
VALUE _ EOSLEX^18;
CALLR(STSKIP,STRETNX);
LEAVE BIGCHAR
$;
!----------------------------------------------------------------------
! STATE TABLE SKELETON PLITS
!----------------------------------------------------------------------
!
! TABLE SIZE AND PACKING DEFINITIONS
GLOBAL BIND
STPACK = 4, ! 4 STATE TABLE ENTRIES PER WORD
STBITS = 36/STPACK; ! NUMBER OF BITS PER ENTRY
SWITCHES NOLIST;
BIND SMALSTATE = UPLIT( CSMALSTATE GLOBALLY NAMES
S,
ILL0S^27 + ILL1S^18 + ILL2S^9 + ILL3S,
TAB0S^27 + TAB1S^18 + TAB2S^9 + TAB3S,
LT0S^27 + LT1S^18 + LT2S^9 + LT3S,
BLANK0S^27 + BLANK1S^18 + BLANK2S^9 + BLANK3S,
SPEC0S^27 + SPEC1S^18 + SPEC2S^9 + SPEC3S,
DIGIT0S^27 + DIGIT1S^18 + DIGIT2S^9 + DIGIT3S,
UPPER0S^27 + UPPER1S^18 + UPPER2S^9 + UPPER3S,
LOWER0S^27 + LOWER1S^18 + LOWER2S^9 + LOWER3S,
FOS0S^27 + FOS1S^18 + FOS2S^9 + FOS3S,
EOB0S^27 + EOB1S^18 + EOB2S^9 + EOB3S,
REMARK0S^27 + REMARK1S^18 + REMARK2S^9 + REMARK3S,
S,
ILL4S^27 + ILL5S^18 + ILL6S^9 + ILL7S,
TAB4S^27 + TAB5S^18 + TAB6S^9 + TAB7S,
LT4S^27 + LT5S^18 + LT6S^9 + LT7S,
BLANK4S^27 + BLANK5S^18 + BLANK6S^9 + BLANK7S,
SPEC4S^27 + SPEC5S^18 + SPEC6S^9 + SPEC7S,
DIGIT4S^27 + DIGIT5S^18 + DIGIT6S^9 + DIGIT7S,
UPPER4S^27 + UPPER5S^18 + UPPER6S^9 + UPPER7S,
LOWER4S^27 + LOWER5S^18 + LOWER6S^9 + LOWER7S,
FOS4S^27 + FOS5S^18 + FOS6S^9 + FOS7S,
EOB4S^27 + EOB5S^18 + EOB6S^9 + EOB7S,
REMARK4S^27 + REMARK5S^18 + REMARK6S^9 + REMARK7S,
S,
ILL8S^27 + ILL9S^18 + ILL10S^9 + ILL11S,
TAB8S^27 + TAB9S^18 + TAB10S^9 + TAB11S,
LT8S^27 + LT9S^18 + LT10S^9 + LT11S,
BLANK8S^27 + BLANK9S^18 + BLANK10S^9 + BLANK11S,
SPEC8S^27 + SPEC9S^18 + SPEC10S^9 + SPEC11S,
DIGIT8S^27 + DIGIT9S^18 + DIGIT10S^9 + DIGIT11S,
UPPER8S^27 + UPPER9S^18 + UPPER10S^9 + UPPER11S,
LOWER8S^27 + LOWER9S^18 + LOWER10S^9 + LOWER11S,
FOS8S^27 + FOS9S^18 + FOS10S^9 + FOS11S,
EOB8S^27 + EOB9S^18 + EOB10S^9 + EOB11S,
REMARK8S^27 + REMARK9S^18 + REMARK10S^9 + REMARK11S,
S,
ILL12S^27 + ILL13S^18 + ILL14S^9 + ILL15S,
TAB12S^27 + TAB13S^18 + TAB14S^9 + TAB15S,
LT12S^27 + LT13S^18 + LT14S^9 + LT15S,
BLANK12S^27 + BLANK13S^18 + BLANK14S^9 + BLANK15S,
SPEC12S^27 + SPEC13S^18 + SPEC14S^9 + SPEC15S,
DIGIT12S^27 + DIGIT13S^18 + DIGIT14S^9 + DIGIT15S,
UPPER12S^27 + UPPER13S^18 + UPPER14S^9 + UPPER15S,
LOWER12S^27 + LOWER13S^18 + LOWER14S^9 + LOWER15S,
FOS12S^27 + FOS13S^18 + FOS14S^9 + FOS15S,
EOB12S^27 + EOB13S^18 + EOB14S^9 + EOB15S,
REMARK12S^27 + REMARK13S^18 + REMARK14S^9 + REMARK15S,
S,
ILL16S^27 + ILL17S^18 + ILL18S^9 + ILL19S,
TAB16S^27 + TAB17S^18 + TAB18S^9 + TAB19S,
LT16S^27 + LT17S^18 + LT18S^9 + LT19S,
BLANK16S^27 + BLANK17S^18 + BLANK18S^9 + BLANK19S,
SPEC16S^27 + SPEC17S^18 + SPEC18S^9 + SPEC19S,
DIGIT16S^27 + DIGIT17S^18 + DIGIT18S^9 + DIGIT19S,
UPPER16S^27 + UPPER17S^18 + UPPER18S^9 + UPPER19S,
LOWER16S^27 + LOWER17S^18 + LOWER18S^9 + LOWER19S,
FOS16S^27 + FOS17S^18 + FOS18S^9 + FOS19S,
EOB16S^27 + EOB17S^18 + EOB18S^9 + EOB19S,
REMARK16S^27 + REMARK17S^18 + REMARK18S^9 + REMARK19S,
S,
%2431% ILL20S^27 + ILL21S^18 + ILL22S^9 + ILL23S,
%2431% TAB20S^27 + TAB21S^18 + TAB22S^9 + TAB23S,
%2431% LT20S^27 + LT21S^18 + LT22S^9 + LT23S,
%2431% BLANK20S^27 + BLANK21S^18 + BLANK22S^9 + BLANK23S,
%2431% SPEC20S^27 + SPEC21S^18 + SPEC22S^9 + SPEC23S,
%2431% DIGIT20S^27 + DIGIT21S^18 + DIGIT22S^9 + DIGIT23S,
%2431% UPPER20S^27 + UPPER21S^18 + UPPER22S^9 + UPPER23S,
%2431% LOWER20S^27 + LOWER21S^18 + LOWER22S^9 + LOWER23S,
%2431% FOS20S^27 + FOS21S^18 + FOS22S^9 + FOS23S,
%2431% EOB20S^27 + EOB21S^18 + EOB22S^9 + EOB23S,
%2431% REMARK20S^27 + REMARK21S^18 + REMARK22S^9 + REMARK23S
);
BIND BIGSTATE = UPLIT( CBIGSTATE GLOBALLY NAMES
B,
ILL0B^27 + ILL1B^18 + ILL2B^9 + ILL3B,
TAB0B^27 + TAB1B^18 + TAB2B^9 + TAB3B,
LT0B^27 + LT1B^18 + LT2B^9 + LT3B,
BLANK0B^27 + BLANK1B^18 + BLANK2B^9 + BLANK3B,
SPEC0B^27 + SPEC1B^18 + SPEC2B^9 + SPEC3B,
DIGIT0B^27 + DIGIT1B^18 + DIGIT2B^9 + DIGIT3B,
UPPER0B^27 + UPPER1B^18 + UPPER2B^9 + UPPER3B,
LOWER0B^27 + LOWER1B^18 + LOWER2B^9 + LOWER3B,
FOS0B^27 + FOS1B^18 + FOS2B^9 + FOS3B,
EOB0B^27 + EOB1B^18 + EOB2B^9 + EOB3B,
REMARK0B^27 + REMARK1B^18 + REMARK2B^9 + REMARK3B,
ANDSGN0B^27 + ANDSGN1B^18 + ANDSGN2B^9 + ANDSGN3B,
LPAREN0B^27 + LPAREN1B^18 + LPAREN2B^9 + LPAREN3B,
RPAREN0B^27 + RPAREN1B^18 + RPAREN2B^9 + RPAREN3B,
COLON0B^27 + COLON1B^18 + COLON2B^9 + COLON3B,
COMMA0B^27 + COMMA1B^18 + COMMA2B^9 + COMMA3B,
DOLLAR0B^27 + DOLLAR1B^18 + DOLLAR2B^9 + DOLLAR3B,
MINUS0B^27 + MINUS1B^18 + MINUS2B^9 + MINUS3B,
SLASH0B^27 + SLASH1B^18 + SLASH2B^9 + SLASH3B,
PLUS0B^27 + PLUS1B^18 + PLUS2B^9 + PLUS3B,
ASTERISK0B^27 + ASTERISK1B^18 + ASTERISK2B^9 + ASTERISK3B,
EQUAL0B^27 + EQUAL1B^18 + EQUAL2B^9 + EQUAL3B,
LTSGN0B^27 + LTSGN1B^18 + LTSGN2B^9 + LTSGN3B,
GTSGN0B^27 + GTSGN1B^18 + GTSGN2B^9 + GTSGN3B,
NEQSGN0B^27 + NEQSGN1B^18 + NEQSGN2B^9 + NEQSGN3B,
DOT0B^27 + DOT1B^18 + DOT2B^9 + DOT3B,
SEMICOL0B^27 + SEMICOL1B^18 + SEMICOL2B^9 + SEMICOL3B,
LITSGN0B^27 + LITSGN1B^18 + LITSGN2B^9 + LITSGN3B,
OCTSGN0B^27 + OCTSGN1B^18 + OCTSGN2B^9 + OCTSGN3B,
COMNTSGN0B^27 + COMNTSGN1B^18 + COMNTSGN2B^9 + COMNTSGN3B,
DEBUGSGN0B^27 + DEBUGSGN1B^18 + DEBUGSGN2B^9 + DEBUGSGN3B,
UPAROW0B^27 + UPAROW1B^18 + UPAROW2B^9 + UPAROW3B,
B,
ILL4B^27 + ILL5B^18 + ILL6B^9 + ILL7B,
TAB4B^27 + TAB5B^18 + TAB6B^9 + TAB7B,
LT4B^27 + LT5B^18 + LT6B^9 + LT7B,
BLANK4B^27 + BLANK5B^18 + BLANK6B^9 + BLANK7B,
SPEC4B^27 + SPEC5B^18 + SPEC6B^9 + SPEC7B,
DIGIT4B^27 + DIGIT5B^18 + DIGIT6B^9 + DIGIT7B,
UPPER4B^27 + UPPER5B^18 + UPPER6B^9 + UPPER7B,
LOWER4B^27 + LOWER5B^18 + LOWER6B^9 + LOWER7B,
FOS4B^27 + FOS5B^18 + FOS6B^9 + FOS7B,
EOB4B^27 + EOB5B^18 + EOB6B^9 + EOB7B,
REMARK4B^27 + REMARK5B^18 + REMARK6B^9 + REMARK7B,
ANDSGN4B^27 + ANDSGN5B^18 + ANDSGN6B^9 + ANDSGN7B,
LPAREN4B^27 + LPAREN5B^18 + LPAREN6B^9 + LPAREN7B,
RPAREN4B^27 + RPAREN5B^18 + RPAREN6B^9 + RPAREN7B,
COLON4B^27 + COLON5B^18 + COLON6B^9 + COLON7B,
COMMA4B^27 + COMMA5B^18 + COMMA6B^9 + COMMA7B,
DOLLAR4B^27 + DOLLAR5B^18 + DOLLAR6B^9 + DOLLAR7B,
MINUS4B^27 + MINUS5B^18 + MINUS6B^9 + MINUS7B,
SLASH4B^27 + SLASH5B^18 + SLASH6B^9 + SLASH7B,
PLUS4B^27 + PLUS5B^18 + PLUS6B^9 + PLUS7B,
ASTERISK4B^27 + ASTERISK5B^18 + ASTERISK6B^9 + ASTERISK7B,
EQUAL4B^27 + EQUAL5B^18 + EQUAL6B^9 + EQUAL7B,
LTSGN4B^27 + LTSGN5B^18 + LTSGN6B^9 + LTSGN7B,
GTSGN4B^27 + GTSGN5B^18 + GTSGN6B^9 + GTSGN7B,
NEQSGN4B^27 + NEQSGN5B^18 + NEQSGN6B^9 + NEQSGN7B,
DOT4B^27 + DOT5B^18 + DOT6B^9 + DOT7B,
SEMICOL4B^27 + SEMICOL5B^18 + SEMICOL6B^9 + SEMICOL7B,
LITSGN4B^27 + LITSGN5B^18 + LITSGN6B^9 + LITSGN7B,
OCTSGN4B^27 + OCTSGN5B^18 + OCTSGN6B^9 + OCTSGN7B,
COMNTSGN4B^27 + COMNTSGN5B^18 + COMNTSGN6B^9 + COMNTSGN7B,
DEBUGSGN4B^27 + DEBUGSGN5B^18 + DEBUGSGN6B^9 + DEBUGSGN7B,
UPAROW4B^27 + UPAROW5B^18 + UPAROW6B^9 + UPAROW7B,
B,
ILL8B^27 + ILL9B^18 + ILL10B^9 + ILL11B,
TAB8B^27 + TAB9B^18 + TAB10B^9 + TAB11B,
LT8B^27 + LT9B^18 + LT10B^9 + LT11B,
BLANK8B^27 + BLANK9B^18 + BLANK10B^9 + BLANK11B,
SPEC8B^27 + SPEC9B^18 + SPEC10B^9 + SPEC11B,
DIGIT8B^27 + DIGIT9B^18 + DIGIT10B^9 + DIGIT11B,
UPPER8B^27 + UPPER9B^18 + UPPER10B^9 + UPPER11B,
LOWER8B^27 + LOWER9B^18 + LOWER10B^9 + LOWER11B,
FOS8B^27 + FOS9B^18 + FOS10B^9 + FOS11B,
EOB8B^27 + EOB9B^18 + EOB10B^9 + EOB11B,
REMARK8B^27 + REMARK9B^18 + REMARK10B^9 + REMARK11B,
ANDSGN8B^27 + ANDSGN9B^18 + ANDSGN10B^9 + ANDSGN11B,
LPAREN8B^27 + LPAREN9B^18 + LPAREN10B^9 + LPAREN11B,
RPAREN8B^27 + RPAREN9B^18 + RPAREN10B^9 + RPAREN11B,
COLON8B^27 + COLON9B^18 + COLON10B^9 + COLON11B,
COMMA8B^27 + COMMA9B^18 + COMMA10B^9 + COMMA11B,
DOLLAR8B^27 + DOLLAR9B^18 + DOLLAR10B^9 + DOLLAR11B,
MINUS8B^27 + MINUS9B^18 + MINUS10B^9 + MINUS11B,
SLASH8B^27 + SLASH9B^18 + SLASH10B^9 + SLASH11B,
PLUS8B^27 + PLUS9B^18 + PLUS10B^9 + PLUS11B,
ASTERISK8B^27 + ASTERISK9B^18 + ASTERISK10B^9 + ASTERISK11B,
EQUAL8B^27 + EQUAL9B^18 + EQUAL10B^9 + EQUAL11B,
LTSGN8B^27 + LTSGN9B^18 + LTSGN10B^9 + LTSGN11B,
GTSGN8B^27 + GTSGN9B^18 + GTSGN10B^9 + GTSGN11B,
NEQSGN8B^27 + NEQSGN9B^18 + NEQSGN10B^9 + NEQSGN11B,
DOT8B^27 + DOT9B^18 + DOT10B^9 + DOT11B,
SEMICOL8B^27 + SEMICOL9B^18 + SEMICOL10B^9 + SEMICOL11B,
LITSGN8B^27 + LITSGN9B^18 + LITSGN10B^9 + LITSGN11B,
OCTSGN8B^27 + OCTSGN9B^18 + OCTSGN10B^9 + OCTSGN11B,
COMNTSGN8B^27 + COMNTSGN9B^18 + COMNTSGN10B^9 + COMNTSGN11B,
DEBUGSGN8B^27 + DEBUGSGN9B^18 + DEBUGSGN10B^9 + DEBUGSGN11B,
UPAROW8B^27 + UPAROW9B^18 + UPAROW10B^9 + UPAROW11B,
B,
ILL12B^27 + ILL13B^18 + ILL14B^9 + ILL15B,
TAB12B^27 + TAB13B^18 + TAB14B^9 + TAB15B,
LT12B^27 + LT13B^18 + LT14B^9 + LT15B,
BLANK12B^27 + BLANK13B^18 + BLANK14B^9 + BLANK15B,
SPEC12B^27 + SPEC13B^18 + SPEC14B^9 + SPEC15B,
DIGIT12B^27 + DIGIT13B^18 + DIGIT14B^9 + DIGIT15B,
UPPER12B^27 + UPPER13B^18 + UPPER14B^9 + UPPER15B,
LOWER12B^27 + LOWER13B^18 + LOWER14B^9 + LOWER15B,
FOS12B^27 + FOS13B^18 + FOS14B^9 + FOS15B,
EOB12B^27 + EOB13B^18 + EOB14B^9 + EOB15B,
REMARK12B^27 + REMARK13B^18 + REMARK14B^9 + REMARK15B,
ANDSGN12B^27 + ANDSGN13B^18 + ANDSGN14B^9 + ANDSGN15B,
LPAREN12B^27 + LPAREN13B^18 + LPAREN14B^9 + LPAREN15B,
RPAREN12B^27 + RPAREN13B^18 + RPAREN14B^9 + RPAREN15B,
COLON12B^27 + COLON13B^18 + COLON14B^9 + COLON15B,
COMMA12B^27 + COMMA13B^18 + COMMA14B^9 + COMMA15B,
DOLLAR12B^27 + DOLLAR13B^18 + DOLLAR14B^9 + DOLLAR15B,
MINUS12B^27 + MINUS13B^18 + MINUS14B^9 + MINUS15B,
SLASH12B^27 + SLASH13B^18 + SLASH14B^9 + SLASH15B,
PLUS12B^27 + PLUS13B^18 + PLUS14B^9 + PLUS15B,
ASTERISK12B^27 + ASTERISK13B^18 + ASTERISK14B^9 + ASTERISK15B,
EQUAL12B^27 + EQUAL13B^18 + EQUAL14B^9 + EQUAL15B,
LTSGN12B^27 + LTSGN13B^18 + LTSGN14B^9 + LTSGN15B,
GTSGN12B^27 + GTSGN13B^18 + GTSGN14B^9 + GTSGN15B,
NEQSGN12B^27 + NEQSGN13B^18 + NEQSGN14B^9 + NEQSGN15B,
DOT12B^27 + DOT13B^18 + DOT14B^9 + DOT15B,
SEMICOL12B^27 + SEMICOL13B^18 + SEMICOL14B^9 + SEMICOL15B,
LITSGN12B^27 + LITSGN13B^18 + LITSGN14B^9 + LITSGN15B,
OCTSGN12B^27 + OCTSGN13B^18 + OCTSGN14B^9 + OCTSGN15B,
COMNTSGN12B^27 + COMNTSGN13B^18 + COMNTSGN14B^9 + COMNTSGN15B,
DEBUGSGN12B^27 + DEBUGSGN13B^18 + DEBUGSGN14B^9 + DEBUGSGN15B,
UPAROW12B^27 + UPAROW13B^18 + UPAROW14B^9 + UPAROW15B,
B,
ILL16B^27,
TAB16B^27,
LT16B^27,
BLANK16B^27,
SPEC16B^27,
DIGIT16B^27,
UPPER16B^27,
LOWER16B^27,
FOS16B^27,
EOB16B^27,
REMARK16B^27,
ANDSGN16B^27,
LPAREN16B^27,
RPAREN16B^27,
COLON16B^27,
COMMA16B^27,
DOLLAR16B^27,
MINUS16B^27,
SLASH16B^27,
PLUS16B^27,
ASTERISK16B^27,
EQUAL16B^27,
LTSGN16B^27,
GTSGN16B^27,
NEQSGN16B^27,
DOT16B^27,
SEMICOL16B^27,
LITSGN16B^27,
OCTSGN16B^27,
COMNTSGN16B^27,
DEBUGSGN16B^27,
UPAROW16B^27,
);
SWITCHES LIST ;
GLOBAL ROUTINE LEXCLA(STATEE)=
BEGIN
REGISTER STATE;
REGISTER
CODE=1,
ACTION=2,
CHAR=3;
MACRO
SMALCODE = .CODETAB<LEFT,CHAR>$,
BIGCODE = .CODETAB<RIGHT,CHAR>$;
!---------------------------------------------------------------------------
! STATE TABLE STRUCTURE DEFINITIONS AND MAPPINGS
!---------------------------------------------------------------------------
! DEFINITION OF THE STRUCTURE OF THE SMALL STATE TABLES
STRUCTURE SMAL [I] = [((I/STPACK)+1)*(LASTSMALCODE+1) ]
( ( .SMAL + (.I/STPACK)*(LASTSMALCODE+1) )
< (STPACK-((.I MOD STPACK)+1))*STBITS + (36 MOD STBITS),STBITS,CODE>
);
! DEFINITION OF THE STRUCTURE OF THE BIG STATE TABLES
STRUCTURE BIG [I] = [((I/STPACK)+1)*(LASTBIGCODE+1) ]
( ( .BIG + (.I/STPACK)*(LASTBIGCODE+1) )
< (STPACK-((.I MOD STPACK)+1))*STBITS + (36 MOD STBITS),STBITS,CODE>
);
MAP BIG BIGSTATE;
MAP SMAL SMALSTATE;
!---------------------------------------------------------------------------
! ASSOCIATE STATE NAMES TO THE STARTING POSITION OF THEIR STATE
! TABLES. THIS FILE MUST FOLLOW THE PLITS WHICH DEFINE THE BIG
! AND SMALL STATE TABLES
!---------------------------------------------------------------------------
!
! BINDS OF THE BIG STATES TO BIGSTATE[I]
BIND
STSTMNT = BIGSTATE[0],
STILINE = BIGSTATE[1],
STSKIP = BIGSTATE[2],
STCONTINUE = BIGSTATE[3],
STNOEND = BIGSTATE[4],
STEOP = BIGSTATE[5],
STTERM = BIGSTATE[6],
STCLASF2 = BIGSTATE[7],
STCLASAL1 = BIGSTATE[8],
STIFCHK = BIGSTATE[9],
STDOCHK1 = BIGSTATE[10],
STDOCHK2 = BIGSTATE[11],
STCLASAL2 = BIGSTATE[12],
STCLASAL2A = BIGSTATE[13],
STCLASF4 = BIGSTATE[14],
%1247% STCLASAL1A = BIGSTATE[15],
%1247% STCLASAL1B = BIGSTATE[16];
!---------------------------------------------------------------------------
! BINDS OF THE SMALL STATE NAMES TO SMALSTATE[I]
!---------------------------------------------------------------------------
BIND
STREMARK = SMALSTATE[0],
STINIT = SMALSTATE[1],
STRETNX = SMALSTATE[2],
STNULLST = SMALSTATE[3],
STCOMNT = SMALSTATE[4],
STCALCONT = SMALSTATE[5],
STCLABSKP = SMALSTATE[6],
STCNTCONT = SMALSTATE[7],
STCITCONT = SMALSTATE [8],
STILABEL = SMALSTATE[9],
STLABSKP = SMALSTATE[10],
STILNTCONT = SMALSTATE[11],
STILITCONT = SMALSTATE[12],
STGETLIT = SMALSTATE[13],
STSKNAME = SMALSTATE[14],
STCONSTSKP = SMALSTATE[15],
STSKPHOL = SMALSTATE[16],
STCLASF3 = SMALSTATE[17],
STSPELLING = SMALSTATE[18],
STIFCLASIF = SMALSTATE[19],
%1214% STTHENCHK = SMALSTATE[20],
%1573% STDOCHK3 = SMALSTATE[21],
%2241% STCONTBLANK = SMALSTATE[22],
%2431% STENDLSN = SMALSTATE[23];
!---------------------------------------------------------------------------
! ALL GLOBAL STATE NAMES ARE DEFINED HERE IN THE FOLLOWING FORMAT:
! BIND DUM# = PLIT( EXTNAME GLOBALLY NAMES INTERNAL-NAME )
!---------------------------------------------------------------------------
BIND DUM0 = UPLIT(
GSTSTMNT GLOBALLY NAMES STSTMNT ,
GSTNOEND GLOBALLY NAMES STNOEND ,
GSTEOP GLOBALLY NAMES STEOP ,
GSTIFCLASIF GLOBALLY NAMES STIFCLASIF ,
);
ROUTINE CHKXCR=
BEGIN % CHANGES ALL EXTRANEOUS CRS TO NULL AND OUTPUTS MESSAGE %
LOCAL TMP;
TMP _ .CURPTR;
DECREMENT (TMP); ! THE CR WAS THE LAST CHARACTER
% SKIP ALL NULLS OR CR'S %
WHILE .CHAR EQL CR OR .CHAR EQL 0
DO ISCAN ( CHAR, CURPTR );
IF ( CODE _ SMALCODE ) NEQ LT
THEN
BEGIN
% HANDLE EXTRANEOUS CR'S %
% SET ALL CR'S TO NULL %
DO (REPLACEN(TMP,0);INCP(TMP))
UNTIL .TMP EQL .CURPTR ;
IF .CODE NEQ EOB
THEN % OUTPUT EXTRANEOUS CR MESSAGE %
% TEMPORARY MESSAGE %
BEGIN
LOCAL SAVNAME;
SAVNAME _ .NAME; !NAME MAY BE DESTROYED
WARNERR ( .LINELINE, E111<0,0>);
NAME _ .SAVNAME
END;
% ELSE WE DON'T KNOW WHETHER ITS EXTRANEOUS OR NOT SO ITS CLEARED
IN CASE IT IS BUT NO MESSAGE IS OUTPUT IN CASE ITS NOT. THIS
IS AN UNLIKELY CASE SO WE CAN LIVE THROUGH NOT REPORTING THE
EXTRANEOUS CR
%
% CONTINUE PROCESSING WITH GIVEN CHAR %
% THE CODE RETURNED IS SMALL SO IF BIG IS REQUIRED THEN THE CALLER MUST SET IT %
END;
RETURN .CODE
END; ! of CHKXCR
GLOBAL ROUTINE NEWCELL=
!++
!
! FUNCTIONAL DESCRIPTION:
!
! Create or find the next cell on the linked list of source lines.
! The global LINLCURR points to the current entry or is a zero.
! If it is zero, start at the head of the list. Otherwise, if at
! the end of the list, create a new cell and link it in. If there
! is a next entry on the list, move to it and zero the flags.
!
! FORMAL PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! LINLHEAD - Head of linked list
!
! IMPLICIT OUTPUTS:
!
! LINELINE - Line number of current statement
! LINEPTR - Byte pointer to beginning of line
! LINLCURR - Current entry on linked list
! LINLLAST - Pointer to last valid entry in linked list
!
! ROUTINE VALUE:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
%2474% ! Written by TFV on 21-Sep-84
%2500% ! Rewritten by AlB on 14-Nov-84
BEGIN
IF .LINLCURR EQL 0
THEN LINLCURR = LINLLIST<0,0> ! Start with head of list
ELSE LINLCURR = .LINLCURR + LINLSENT; ! Next entry
LINLLAST = .LINLCURR; ! Set pointer to last cell
%2501% LFLAGERR(LINLCURR) = 0; ! Clear flags and error code
LINENUM(LINLCURR) = .LINELINE; ! Set line number
FIRSTBP(LINLCURR) = .LINEPTR; ! Set BP to start of line
LASTBP(LINLCURR) = 0; ! Don't know where end is yet
NOLTLINE = 1; ! Set flag for no lt on line
IF .LINLCURR EQL LINLEND<0,0>
THEN
BEGIN ! List is full
DISCARD(); ! Remove comment entries
IF .LINLCURR EQL LINLEND<0,0>
THEN FATLEX(E51<0,0>); ! Statement too large
END; ! List is full
END; ! of NEWCELL
GLOBAL ROUTINE LEXINI=
BEGIN
! THIS IS THE ROUTINE WHICH WILL INITIALIZE LEXICAL
IF CURWORD EQL 0
THEN ( % INITIALIZATION FOR FIRST PROGRAM UNIT. PICK UP LINESEQNO IF ANY %
CHARPOS _ 72;
CURPTR _ POOLBEGIN<FIRSTCHAR>;
CHARTMP _ ..CURPTR ;
%2412% RETURN LEXCLA(STINIT)
)
ELSE
( % INITIALIZATION FOR >=2ND PROGRAM UNIT %
IF NOT .SEQLAST THEN LINELINE _ 1;
% ELSE LEAVE IT BECAUSE ITS A LINE SEQUENCE NO. %
CHARTMP _ EOS ;
%BLANK OUT THE BEGINNING 0F MULTIPLE STATEMENT LINES %
TEMP _ .LINEPTR;
UNTIL .TEMP EQL .CURPTR DO REPLACEI(TEMP," ");
!EAT ONE FORM FEED BETWEEN SUBPROGRAMS FOR READABILITY
SCANI(TEMP);
IF ..TEMP EQL FF THEN (SCANI(LINEPTR);SCANI(CURPTR));
RETURN 1
)
END; ! of LEXINI
!---------------------------------------------------------------------------
! BEGIN ROUTINE LEXCLA
!---------------------------------------------------------------------------
REGISTER
%2241% NEXT; ! Keep track of finite state machine transitions via LEAVE
! for debugging trace
BIND
%2241% NONE = -1,
%2241% NEWCASE = 0, ! NEWACTION loop
%2241% NEWSTADT = 1, ! NEWSTATE loop
%2241% NEWBIG = 2, ! BIGCHAR loop
%2241% NEWSMALL = 3; ! SMALCAHR loop
LABEL
NEWSTATE,
BIGCHAR,
SMALCHAR,
NEWACTION;
! STRUCTURE DEFINITION FOR STATE TABLE REFERENCES
STRUCTURE STATEREF[I] =[1] ( . ( ( ..STATEREF ) + .I ) );
!* REGISTER ACTION = 2 ;
!* REGISTER CHAR=3, CODE=1;
% THE NEXT CHARACTER IS FETCHED FROM THE INTERNAL STATEMENT
BUFFER AND PLACED IN "CHAR". THE CHARACTER CODE IS THEN
FETCHED FROM THE APPROPRIATE CODE TABLE AND PLACED IN "CODE".
%
MAP STATEREF STATE;
% AREA FOR STATE CALL STACK %
OWN STATESTACK[10],
STSTKPTR; ! CURRENT STACK POINTER
% INITIALIZE STACK POINTER %
STSTKPTR _ 0;
% RESTORE THE LAST CHARACTER TO THE REGISTERS %
CHAR _ .CHARTMP;
STATE _ .STATEE; ! PUT STATE IN A REGITER
SETCODE;
% SET LEXLINE TO THE LINENUMBER WHICH BEGINS THE LEXEME %
LEXLINE _ .LINELINE;
%2241% IF DBUGIT THEN NEXT = NONE;
WHILE 1 DO
NEWSTATE:
BEGIN ! Newstate
%2241% IF DBUGIT
%2241% THEN IF .NEXT EQL NONE
%2241% THEN NEXT = NEWSTADT;
SMALCHAR: BEGIN ! Smalchar
WHILE 1 DO
BEGIN ! Smalchar loop
BIGCHAR: BEGIN ! Bigchar
%2241% IF DBUGIT
%2241% THEN IF .NEXT EQL NONE
%2241% THEN NEXT = NEWBIG;
! set ACTION to .STATE[.CODE]
NSCAN(ACTION,STATE);
WHILE 1 DO
NEWACTION: BEGIN ! Newaction
IF DBUGIT
THEN
BEGIN
%2241% IF .NEXT EQL NONE
%2241% THEN NEXT = NEWCASE;
%2420% TRACE(.NEXT,.STATE,.CHAR,.CODE,.ACTION, 1);
%2241% NEXT = NONE;
END;
CASE .ACTION OF
SET
BEGIN ACMEOB END; ! 0
BEGIN ACMINIT END; ! 1
BEGIN ACMANY END; ! 2
BEGIN ACMTAB END; ! 3
BEGIN ACMSTSKIP END; ! 4
BEGIN ACMREMEND END; ! 5
BEGIN ACMGOBAKNOW END; ! 6
BEGIN ACMLT END; ! 7
BEGIN ACMSTMNTFOS END; ! 8
BEGIN ACMGOBAKNXT END; ! 9
BEGIN ACMEXPLT END; ! 10
BEGIN ACMRETNOW END; ! 11
%2241% BEGIN ACMCONTLT END; ! 12
BEGIN ACMCALCONT END; ! 13
BEGIN ACMCONTDIG END; ! 14
BEGIN ACMCLABSKP END; ! 15
BEGIN ACMNOEND END; ! 16
BEGIN ACMSTEOP END; ! 17
BEGIN ACMENTREMARK END; ! 18
BEGIN ACMMULTST END; ! 19
BEGIN ACMCLASF1 END; ! 20
BEGIN ACMMULTNULL END; ! 21
BEGIN ACMILLCHAR END; ! 22
BEGIN ACMCOMNT END; ! 23
BEGIN ACMDEBUG END; ! 24
BEGIN ACMCOMNTFOS END; ! 25
BEGIN ACMINTERR END; ! 26
BEGIN ACMNOCONT END; ! 27
BEGIN ACMNULLFOS END; ! 28
BEGIN ACMCITCONT END; ! 29
%2474% BEGIN ACMCALCLT END; ! 30
BEGIN ACMENTCLABSKP END; ! 31
BEGIN ACMCBUGCHK END; ! 32
BEGIN ACMENTLAB END; ! 33
BEGIN ACMILABILL END; ! 34
BEGIN ACMILABEDCK END; ! 35
BEGIN ACMILITCONT END; ! 36
BEGIN ACMILABDIG END; ! 37
BEGIN ACMILNTC END; ! 38
BEGIN ACMILNTI END; ! 39
BEGIN ACMILNTD END; ! 40
BEGIN ACMILITNC END; ! 41
BEGIN ACMILITC END; ! 42
BEGIN ACMILABLT END; ! 43
BEGIN ACMUPLOW END; ! 44
BEGIN ACMCONSTSKP END; ! 45
BEGIN ACMSKNAME END; ! 46
BEGIN ACMSKLPAREN END; ! 47
BEGIN ACMSKRPAREN END; ! 48
BEGIN ACMSKCOMMA END; ! 49
BEGIN ACMGETLIT END; ! 50
BEGIN ACMENDLIT END; ! 51
BEGIN ACMBAKTOTERM END; ! 52
BEGIN ACMSKCONBLD END; ! 53
BEGIN ACMSKPHOLX END; ! 54
BEGIN ACMSKPHOL END; ! 55
BEGIN ACMHOLTAB END; ! 56
BEGIN ACMENTERM END; ! 57
BEGIN ACMUNMATEOS END; ! 58
BEGIN ACMSKILL END; ! 59
BEGIN ACMCLASLT END; ! 60
BEGIN ACMCLASUNREC END; ! 61
BEGIN ACMCLILLCHAR END; ! 62
BEGIN ACMCLASBACK END; ! 63
BEGIN ACMCOMPAR END; ! 64
BEGIN ACMCLASAL1 END; ! 65
BEGIN ACMASGNMNT END; ! 66
BEGIN ACMCLASF2 END; ! 67
BEGIN ACMIFCHK END; ! 68
BEGIN ACMDOCHK END; ! 69
BEGIN ACMARITHIF END; ! 70
BEGIN ACMLOGICIF END; ! 71
BEGIN ACMDOCHK1 END; ! 72
BEGIN ACMDOSTMNT END; ! 73
BEGIN ACMENDCHK END; ! 74
BEGIN ACMCLASF3 END; ! 75
BEGIN ACMCLASF4 END; ! 76
BEGIN ACMKEYTERM END; ! 77
BEGIN ACMUNMATKEY END; ! 78
BEGIN ACMSPELLING END; ! 79
BEGIN ACMBADCHAR END; ! 80
%1214% BEGIN ACMTHENCHK END; ! 81
%1214% BEGIN ACMBLOCKIF END; ! 82
%1247% BEGIN ACMSUBCHK END; ! 83
%1247% BEGIN ACMSUBASSIGN END; ! 84
%1247% BEGIN ACMCLAS1A END; ! 85
%1247% BEGIN ACMSKCOLON END; ! 86
%1247% BEGIN ACMKEYSUB END; ! 87
%1573% BEGIN ACMDOCHK2 END; ! 88
%1573% BEGIN ACMWHILECHK END; ! 89
%2241% BEGIN ACMCONTBLANK END; ! 90
%2241% BEGIN ACMLTENDCHK END; ! 91
%2241% BEGIN ACMENDLTCHK END; ! 92
%2431% BEGIN ACMENDLSN END; ! 93
!---------------------------------------------------------------
! BEWARE OF SKEWS! CASE STATEMENT MACROS MUST MATCH ACTION NAME
! BINDS.
!---------------------------------------------------------------
TES;
END ! Newaction
END; ! Bigchar
% GET NEXT CHARACTER AND CLASIFY FOR BIG STATE%
IF .CHARPOS EQL 0 % CHARACTER POSITION 72 %
THEN ( LEAVE SMALCHAR ); % ENTER REMARK PROCESSING STATE %
CHARPOS _ .CHARPOS - 1;
ISCAN ( CHAR, CURPTR );
CODE _ BIGCODE;
END ! Smalchar loop
END; ! Smalchar
%2241% IF DBUGIT
%2241% THEN IF .NEXT EQL NONE
%2241% THEN NEXT = NEWSMALL;
% GET NEXT CHARACTER AND CLASIFY FOR SMALL STATE %
IF .CHARPOS EQL 0 % CHARACTER POSITION 72 %
THEN IF .STATE NEQ STREMARK
%2241% THEN (CALL(STREMARK)); % ENTER REMARK PROCESSING STATE %
CHARPOS _ .CHARPOS - 1 ;
ISCAN ( CHAR, CURPTR );
CODE _ SMALCODE;
END ! Newstate
END; ! of LEXCLA
END
ELUDOM