Trailing-Edge
-
PDP-10 Archives
-
BB-D480F-SB_FORTRAN10_V10
-
lexica.bli
There are 27 other files named lexica.bli in the archive. Click here to see a list.
!COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1973, 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: D. B. TOLMAN/DCE/SJW/CKS/AHM/PY/PLB/RVM/MEM/AlB
MODULE LEXICAL(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4)=
BEGIN
GLOBAL BIND LEXICV = #10^24 + 0^18 + #2526; ! Version Date: 27-Mar-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
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.
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 SPURFF and SPURCR be global routines so that they can be used
by LEXCLA.
2475 MEM 5-Nov-84
Fix bug where "-n where n was a double precision constant was
incorrectly negated as if it were single precision.
2477 AlB 13-Nov-84
Fix ACMENTREMARK to correctly test for column 1, and to use the
global ANSIPLIT for its 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 the call to
it was replaced by in-line code.
2506 AlB 30-Nov-84
Under certain conditions, comment lines were not printed because
LASTCODELINE had moved too far down the linked list. Now when
a continuation line is detected, we back up to the first unprinted
line before printing out comments.
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, which is what was the guts of ACMCONTDIG. This
routine is now called from ACMGOBAKNXT and ACMCONTDIG in both
LEXICA and LEXCLA.
2526 AlB 27-Mar-85
Macro ACMLT modified to correctly handle a look-ahead problem
which was causing some continued lines to either be printed twice,
or to be printed as a blank line. This would also cause garbage
in the listing if that line contained an error.
***** 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
LEXICA(1);
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
CORMAN,
DECEXP,
DECREMENT,
%2412% DOCHAR, ! Character after DO in classifier
DOTOPTAB,
DSCASGNMT,
DSCDO,
DSCDOUB,
DSCEND,
DSCIFARITH,
DSCIFBLOCK,
DSCIFLOGIC,
DSCPARAMT,
DSCSFAY,
DSCSUBASSIGN,
%1573% DSCWHILE,
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
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,
%2474% NEWCELL, ! Get linked list entry for source line
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,
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
%2474% OWN
%2474% SAVEPTR; ! Save CURPTR during action
! Binds that must agree with FIRST and TABLES. (LEXICA won't
! compile with FIRST, so they can't be REQUIREd.)
BIND
%1221% LTLSIZ = 4, ! Size of literal table entry header.
! Characters of the literal string follow
! immediately.
%1530% CHARSPERWORD = 5, ! Number of characters in one word
%1530% FLSIZ = 16; ! Number of FREELISTs for CORMAN/SAVSPACE calls
!-----------------------------------------------------------------------
! 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,
ACTANY = 1,
ACTTAB = 2,
ACTHOLCONDONE = 3,
ACTFMTHOLPKUP = 4,
ACTHOLCON = 5,
ACTREMEND = 6,
ACTGOBAKNOW = 7,
ACTLT = 8,
ACTFMTHOLCK = 9,
ACTGOBAKNXT = 10,
ACTEXPLT = 11,
ACTLEXFOS = 12,
ACTRETNOW = 13,
%2241% ACTCONTLT = 14, ! Continuation - line terminator,
ACTCALCONT = 15,
ACTCONTDIG = 16,
ACTCLABSKP = 17,
ACTENTREMARK = 18,
ACTMULTST = 19,
ACTINTERR = 20,
ACTNOCONT = 21,
ACTCITCONT = 22,
%2474% ACTCALCLT = 23,
ACTENTCLABSKP = 24,
ACTCBUGCHK = 25,
ACTUPLOW = 26,
ACTCONSTSKP = 27,
ACTSKNAME = 28,
ACTSKLPAREN = 29,
ACTSKRPAREN = 30,
ACTSKCOMMA = 31,
ACTGETLIT = 32,
ACTENDLIT = 33,
ACTBAKTOTERM = 34,
ACTSKCONBLD = 35,
ACTSKPHOLX = 36,
ACTSKPHOL = 37,
ACTHOLTAB = 38,
ACTENTERM = 39,
ACTUNMATEOS = 40,
ACTFMTQT1 = 41,
ACTSKILL = 42,
ACTCLASLT = 43,
ACTBADCHAR = 44,
ACTSINGLEX = 45,
ACTDOUBLEX = 46,
ACTNOTDOUB = 47,
ACTMAYBDOUB = 48,
ACTENTIDENT = 49,
ACTPKUPID = 50,
ACTENDID = 51,
ACTENTDOT = 52,
ACTTRYREAL = 53,
ACTMISOPER = 54,
ACTGETOPER = 55,
ACTOPCHK = 56,
ACTMISOP1 = 57,
ACTENTGETCONST = 58,
ACTGOTINT = 59,
ACTCHECKLET = 60,
ACTBILDDBLINT = 61,
ACTREALCON = 62,
ACTENTRLBLDD = 63,
ACTGOTREAL = 64,
ACTEXDBCHK = 65,
ACTGOTOP = 66,
ACTCHKPLMI = 67,
ACTNOEXP = 68,
ACTINTEXP1 = 69,
ACTFMTQT = 70,
ACTGOTIEXP = 71,
ACTHOLCHAR = 72,
ACTHOLEND = 73,
ACTENTLITLEX = 74,
ACTLITEDCHK = 75,
ACTTIC2CHK = 76,
ACTENTOCTQ = 77,
ACTNOOCT = 78,
ACTCHKOCPM = 79,
ACTOCTQ1 = 80,
ACTGOTOCT = 81,
ACTNOTIC = 82,
ACTSCANCHAR = 83,
ACTSTRCHK = 84,
ACTSTOPLIT = 85,
ACTFLEX1 = 86,
ACTFMTEOS = 87,
ACTFMTCHAR = 88,
ACTRIS = 89,
ACTSTOPINT = 90,
ACTGOT6INT = 91,
ACT6DIGIT = 92,
ACTSKCOLON = 93,
ACTKEYCHK = 94,
ACTKEY1CHK = 95,
%2241% ACTCONTBLANK = 96; ! Continuation processing blank line action
!-----------------------------------------------------------------------
! 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 "LEXICA" IS DEFINED IN THIS SECTION IN
! TERMS OF STATES AND ACTION MACROS.
!
! ALL STATES WHICH ARE LEXICA 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, 0);
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, 0);
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% CONTPRINT(); ! Print any intervening lines
%2514% HASCODE(LINLCURR) = 1; ! This line has some code
%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, 0);
$;
%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
$;
% 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 =
%2474% IF .LINLLAST NEQ 0
%2474% THEN
%2474% BEGIN ! This line is on linked list
%2474% IF .LINLCURR NEQ .LINLLAST
%2474% THEN
%2474% BEGIN ! Next line is on linked list
%2474% IF .LINLCURR NEQ .LASTCODELINE
%2474% THEN
%2474% BEGIN ! Next codeline is in linked list
%2474% DO
%2474% BEGIN
%2474% PRINT(.LINLCURR); ! Print the line
%2474% SKIPDL(); ! Skip to next one
%2474% END
%2474% UNTIL .HASCODE(LINLCURR) OR .NOCONTINUE(LINLCURR);
%2474% IF .NOCONTINUE(LINLCURR)
%2474% THEN
%2474% BEGIN ! No continuation
%2474% CHARPOS _ 72;
%2474% IF .CHAR NEQ EOF THEN CHAR _ EOS;
%2474% CODE _ FOS ;
%2474% LEAVE NEWSTATE ;
%2474% END; ! No continuation
%2474% ! Reprocess this line from the continuation state
%2526% LINLCURR = .LINLCURR - LINLSENT;
%2526% LINELINE = .LINENUM(LINLCURR);
%2474% ENTCALCONT; ! Continuation processing
%2474% END ! Next codeline is in linked list
%2474% ELSE
%2474% BEGIN ! Last codeline
%2474% PRINT(.LINLCURR); ! Print this line
%2474% SKIPDL(); ! Step to next line
%2474% IF .NOCONTINUE(LINLCURR)
%2474% THEN
%2474% BEGIN ! No continuation
CHARPOS = 72;
IF .CHAR NEQ EOF THEN CHAR _ EOS;
CODE _ FOS;
LEAVE NEWSTATE;
%2474% END ! No continuation
%2474% ELSE
%2474% BEGIN ! Continuation
%2474% CHARPOS = 72;
%2474% CALL(STCONTINUE); ! Process new line
%2474% LEAVE SMALCHAR; ! from continuation state
%2474% END; ! Continuation
%2474% END; ! Last codeline
%2474% END; ! Next line is on linked list
%2474% END; ! This line is on linked list
%2474% ! No more entries on linked list
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;
%2474% PRINT(.LINLCURR);
% CONTINUATION PROCESSING %
ENTCALCONT;
$;
!-----------------------------------------------------------------------
! CONTINUATION PROCESSING
!-----------------------------------------------------------------------
% SMALL STATE DEFINITION STCALCONT NUMBER (#) 2S %
% 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
ILL2S = ACTCALCONT,
TAB2S = ACTCALCONT,
%2474% LT2S = ACTCALCONT,
BLANK2S = ACTCALCONT,
SPEC2S = ACTCALCONT,
DIGIT2S = ACTCALCONT,
UPPER2S = ACTCALCONT,
LOWER2S = ACTCALCONT,
FOS2S = ACTCALCONT,
EOB2S = ACTEOB,
REMARK2S = 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 .LINLLAST NEQ 0
%2474% THEN
%2474% BEGIN ! This line is in linked list
%2474% IF .LINLCURR NEQ .LINLLAST
%2474% THEN
%2474% BEGIN ! Next line is on linked list
%2474% SKIPDL(); ! Step to next line
%2474% CHARPOS = 72;
%2474% STATE = STCALCONT; ! Continue continuation
%2474% LEAVE SMALCHAR;
%2474% END; ! Next line is on linked list
%2474% END; ! This line is in linked list
! No more entries on linked list
%2474% IF NOT SPURCR()
THEN
BEGIN ! Line terminator
IF .FOUNDCR ! CR was found in remark processing
THEN FOUNDCR _ 0
ELSE NOCR _ 1;
%2474% LASTBP(LINLCURR) = .CURPTR;
CHARPOS = 72; ! Setup pointers for next line
LINEPTR = .CURPTR;
STATE = STCALCONT; ! Continue continuation processing
LEAVE SMALCHAR
END ! Line terminator
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
%2474% ! Dismembered by AlB on 19-Oct-84 (No longer used)
INTERR('CALCLT');
CHARPOS = 72;
IF .CHAR NEQ EOF THEN CHAR = EOS;
CODE = FOS ;
LEAVE NEWSTATE ;
$;
! 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
LEAVE NEWSTATE; ! WITH CURRENT CHARACTER
$;
!-----------------------------------------------------------------------
! CONTINUATION LINE CHECKING
!-----------------------------------------------------------------------
% BIG STATE DEFINITION STCONTINUE NUMBER (#) 2B %
% 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% ILL2B = ACTNOCONT,
TAB2B = ACTCITCONT,
%2241% LT2B = ACTCONTLT, ! Blank lines are legal
BLANK2B = ACTENTCLABSKP,
%670% SPEC2B = ACTNOCONT,
%670% DIGIT2B = ACTNOCONT,
%670% UPPER2B= ACTNOCONT,
LOWER2B = ACTUPLOW,
FOS2B = ACTNOCONT,
EOB2B = ACTEOB,
%2241% REMARK2B = ACTENTREMARK, ! Remark lines are legal
%670% EQUAL2B = ACTNOCONT,
%670% LPAREN2B = ACTNOCONT,
%670% RPAREN2B = ACTNOCONT,
%670% COLON2B = ACTNOCONT,
%670% COMMA2B = ACTNOCONT,
%2241% DOLLAR2B = ACTENTREMARK, ! Comment lines are legal
%2241% ASTERISK2B = ACTENTREMARK, ! Comment lines are legal
%2241% SLASH2B = ACTENTREMARK, ! Comment lines are legal
%670% PLUS2B = ACTNOCONT,
%670% MINUS2B = ACTNOCONT,
%670% ANDSGN2B = ACTNOCONT,
%670% LITSGN2B = ACTNOCONT,
%670% OCTSGN2B = ACTNOCONT,
%670% NEQSGN2B = ACTNOCONT,
%670% DOT2B = ACTNOCONT,
%670% SEMICOL2B = ACTNOCONT,
%670% LTSGN2B = ACTNOCONT,
%670% GTSGN2B = ACTNOCONT,
%2241% COMNTSGN2B = ACTENTREMARK, ! Comment lines are legal
DEBUGSGN2B = ACTCBUGCHK,
%670% UPAROW2B = ACTNOCONT;
% SMALL STATE DEFINITION STCLABSKP NUMBER (#) 3S %
% CONTINUATION LINE CHECK, SKIP THE LABEL FIELD %
BIND
%670% ILL3S = ACTNOCONT,
TAB3S = ACTCITCONT,
%2241% LT3S = ACTCONTLT, ! Blank lines are legal
BLANK3S = ACTCLABSKP,
%670% SPEC3S = ACTNOCONT,
%670% DIGIT3S = ACTNOCONT,
%670% UPPER3S = ACTNOCONT,
%670% LOWER3S = ACTNOCONT,
FOS3S = ACTNOCONT,
EOB3S = ACTEOB,
%2241% REMARK3S = ACTENTREMARK; ! Remark lines are legal
% SMALL STATE DEFINITION STCNTCONT NUMBER (#) 4S %
% CONTINUATION FIELD, CONTINUATION CHECK, NO INITIAL TAB %
BIND
ILL4S = ACTNOCONT,
TAB4S = ACTCITCONT,
%2241% LT4S = ACTCONTLT, ! Blank lines are legal
%2241% BLANK4S = ACTCONTBLANK, ! Test for initial line vs. blank line
SPEC4S = ACTGOBAKNXT,
DIGIT4S = ACTCONTDIG,
UPPER4S = ACTGOBAKNXT,
LOWER4S = ACTGOBAKNXT,
FOS4S = ACTNOCONT,
EOB4S = ACTEOB,
%2241% REMARK4S = ACTENTREMARK; ! Remark lines are legal
% SMALL STATE DEFINITION STCITCONT NUMBER (#) 5S %
% CONTINUATION FIELD, CONTINUATION LINE CHECK, INITIAL TAB %
BIND
ILL5S = ACTNOCONT,
%2241% TAB5S = ACTCONTBLANK, ! Test for initial line vs. blank line
%2241% LT5S = ACTCONTLT, ! Blank lines are legal
%2241% BLANK5S = ACTCONTBLANK, ! Test for initial line vs. blank line
SPEC5S = ACTNOCONT,
DIGIT5S = ACTCONTDIG,
UPPER5S = ACTNOCONT,
LOWER5S = ACTNOCONT,
FOS5S = ACTNOCONT,
EOB5S = ACTEOB,
%2241% REMARK5S = ACTENTREMARK; ! Remark lines are legal
% SMALL STATE DEFINITION STCONTBLANK NUMBER (#) 35S %
% 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
ILL35S = ACTNOCONT,
TAB35S = ACTCONTBLANK,
LT35S = ACTCONTLT,
BLANK35S = ACTCONTBLANK,
SPEC35S = ACTNOCONT,
DIGIT35S = ACTNOCONT,
UPPER35S = ACTNOCONT,
LOWER35S = ACTNOCONT,
FOS35S = ACTNOCONT,
EOB35S = ACTEOB,
REMARK35S = 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% CONTPRINT(); ! Print any intervening lines
%2505% HASCODE(LINLCURR) = 1; ! This line has code
%2474% LASTCODELINE = .LINLCURR; ! Latest non-comment 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 =
%2505% IF .LASTCODELINE NEQ 0
%2474% THEN
%2474% BEGIN ! Back over any comment lines
%2474% LINLCURR = .LASTCODELINE; ! Previous non-comment line
%2474% LASTLINE = LEXLINE = .LINENUM(LINLCURR);! Where we want to be
%2474% IF .LINLCURR NEQ .LINLLAST
%2474% THEN SKIPDL() ! Be at beginning of next line
%2474% ELSE CURPTR = .CONTPTR;
%2474% END ! Back over any comment lines
%2474% ELSE CURPTR = .CONTPTR;
CHARPOS _ 72;
IF .CHAR NEQ EOF THEN CHAR _ EOS;
CODE _ FOS ;
% 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
$;
!-----------------------------------------------------------------------
! STATEMENT SKIPPING
!-----------------------------------------------------------------------
% BIG STATE DEFINITION STSKIP NUMBER (#) 1B %
BIND
ILL1B = ACTSKILL,
TAB1B = ACTTAB,
LT1B = ACTLT,
BLANK1B = ACTANY,
SPEC1B = ACTANY,
DIGIT1B = ACTENTERM,
UPPER1B = ACTENTERM,
LOWER1B = ACTENTERM,
FOS1B = ACTUNMATEOS,
EOB1B = ACTEOB,
REMARK1B = ACTENTREMARK,
EQUAL1B = ACTANY,
LPAREN1B = ACTENTERM,
RPAREN1B = ACTSKILL,
COLON1B = ACTANY,
COMMA1B = ACTANY,
DOLLAR1B = ACTANY,
ASTERISK1B = ACTANY,
SLASH1B = ACTANY,
PLUS1B = ACTANY,
MINUS1B = ACTANY,
ANDSGN1B = ACTANY,
LITSGN1B = ACTENTERM,
OCTSGN1B = ACTANY,
NEQSGN1B = ACTANY,
DOT1B = ACTANY,
SEMICOL1B = ACTMULTST,
LTSGN1B = ACTANY,
GTSGN1B = ACTANY,
COMNTSGN1B = ACTENTERM,
DEBUGSGN1B = ACTENTERM,
UPAROW1B = 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 (#) 3B %
% SKIPS OVER LEXICAL CONSTRUCTS - %
BIND
ILL3B = ACTGOBAKNOW,
TAB3B = ACTTAB,
LT3B = ACTEXPLT,
BLANK3B = ACTANY,
SPEC3B = ACTANY,
DIGIT3B = ACTCONSTSKP,
UPPER3B = ACTSKNAME,
LOWER3B = ACTSKNAME,
FOS3B = ACTGOBAKNOW,
EOB3B = ACTEOB,
REMARK3B = ACTENTREMARK,
EQUAL3B = ACTANY,
LPAREN3B = ACTSKLPAREN,
RPAREN3B = ACTSKRPAREN,
COLON3B = ACTSKCOLON,
COMMA3B = ACTSKCOMMA,
DOLLAR3B = ACTANY,
ASTERISK3B = ACTANY,
SLASH3B = ACTANY,
PLUS3B = ACTANY,
MINUS3B = ACTANY,
ANDSGN3B = ACTANY,
LITSGN3B = ACTGETLIT,
OCTSGN3B = ACTANY,
NEQSGN3B = ACTANY,
DOT3B = ACTANY,
SEMICOL3B = ACTMULTST,
LTSGN3B = ACTANY,
GTSGN3B = ACTANY,
COMNTSGN3B = ACTSKNAME,
DEBUGSGN3B = ACTSKNAME,
UPAROW3B = ACTANY;
% SMALL STATE DEFINITION STGETLIT NUMBER (#) 6S %
% PICKS UP ' LITERALS %
BIND
ILL6S = ACTANY,
TAB6S = ACTTAB,
LT6S = ACTEXPLT,
BLANK6S = ACTANY,
SPEC6S = ACTENDLIT,
DIGIT6S = ACTANY,
UPPER6S = ACTANY,
LOWER6S = ACTANY,
FOS6S = ACTGOBAKNOW,
EOB6S = ACTEOB,
REMARK6S = ACTANY;
% SMALL STATE DEFINITION STSKNAME NUMBER (#) 7S %
% SKIPS IDENTIFIERS %
BIND
ILL7S = ACTGOBAKNOW,
TAB7S = ACTTAB,
LT7S = ACTEXPLT,
BLANK7S = ACTANY,
SPEC7S = ACTBAKTOTERM,
DIGIT7S = ACTANY,
UPPER7S = ACTANY,
LOWER7S = ACTANY,
FOS7S = ACTGOBAKNOW,
EOB7S = ACTEOB,
REMARK7S = ACTENTREMARK;
% SMALL STATE DEFINITION STCONSTSKP NUMBER (#) 8S %
% SKIPS CONSTANTS FOLLOWED BY H ( HOLERITH ) OR X FOR FORMATS %
BIND
ILL8S = ACTGOBAKNOW,
TAB8S = ACTTAB,
LT8S = ACTEXPLT,
BLANK8S = ACTANY,
SPEC8S = ACTBAKTOTERM,
DIGIT8S = ACTSKCONBLD,
UPPER8S = ACTSKPHOLX,
LOWER8S = ACTUPLOW,
FOS8S = ACTGOBAKNOW,
EOB8S = ACTEOB,
REMARK8S = ACTENTREMARK;
% SMALL STATE DEFINITION STSKPHOL NUMBER (#) 9S %
BIND
ILL9S = ACTSKPHOL,
TAB9S = ACTHOLTAB,
LT9S = ACTEXPLT,
BLANK9S = ACTSKPHOL,
SPEC9S = ACTSKPHOL,
DIGIT9S = ACTSKPHOL,
UPPER9S = ACTSKPHOL,
LOWER9S = ACTSKPHOL,
FOS9S = ACTGOBAKNOW,
EOB9S = ACTEOB,
REMARK9S = 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
$;
% LINE TERMINATORS DURING CLASSIFICATION LOOKAHEAD SHOULD BE
DETECTED BUT NOT CAUSE PRINTING %
MACRO
ACMCLASLT =
%2474% IF .LINLLAST NEQ 0
%2474% THEN
%2474% BEGIN ! This line is in linked list
%2505% LASTBP(LINLCURR) = .CURPTR;
%2474% IF .LINLCURR NEQ .LINLLAST
%2474% THEN
%2474% BEGIN ! Next line is in linked list
%2474% IF .LINLCURR NEQ .LASTCODELINE
%2474% THEN
%2474% BEGIN ! Next codeline is in linked list
%2474% DO SKIPDL() ! Get to next line
%2474% UNTIL .HASCODE(LINLCURR) OR .NOCONTINUE(LINLCURR);
%2474% IF .NOCONTINUE(LINLCURR)
%2474% THEN
%2474% BEGIN ! No continuation
%2474% CHARPOS _ 72;
%2474% IF .CHAR NEQ EOF THEN CHAR _ EOS;
%2474% CODE _ FOS ;
%2474% LEAVE NEWSTATE ;
%2474% END; ! No continuation
%2474% ! Reprocess this line
%2474% CALL(STCONTINUE);
%2474% LEAVE SMALCHAR;
%2474% END ! Next codeline is in linked list
%2474% ELSE
%2474% BEGIN ! No more code lines in linked list
%2474% SKIPDL(); ! Get to next line
%2474% IF .NOCONTINUE(LINLCURR)
%2474% THEN
%2474% BEGIN ! No continuation
%2474% CHARPOS = 72;
%2474% IF .CHAR NEQ EOF THEN CHAR = EOS;
%2474% CODE = FOS;
%2474% LEAVE NEWSTATE;
%2474% END; ! No continuation
%2474% ! Reprocess this line
%2474% CALL(STCONTINUE);
%2474% LEAVE SMALCHAR;
%2474% END; ! No more code lines in linked list
%2474% END; ! Next line is on linked list
%2474% END; ! This line is in linked list
%2474% ! No more entries on linked list
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;
ENTCALCONT
END;
$;
!----------------------------------------------------------------------
! RETURN AFTER SKIPPING TO SIGNIFICANT CHAR
!----------------------------------------------------------------------
% SMALL STATE DEFINITION STRETNX NUMBER (#) 1S %
% RETURN AFTER POSITIONING TO THE NEXT SIGNIFICANT CHARACTER %
BIND
ILL1S = ACTRETNOW,
TAB1S = ACTTAB,
LT1S = ACTLT,
BLANK1S = ACTANY,
SPEC1S = ACTRETNOW,
DIGIT1S = ACTRETNOW,
UPPER1S = ACTRETNOW,
LOWER1S = ACTRETNOW,
FOS1S = ACTRETNOW,
EOB1S = ACTEOB,
REMARK1S = ACTENTREMARK;
MACRO
ACMRETNOW =
RETURNOW (.VALUE)
$;
!----------------------------------------------------------------------
! CHARACTER LOOKAHEAD
!----------------------------------------------------------------------
% SMALL STATE DEFINITION STCSCAN NUMBER (#) 26S %
% LOOK AT THE NEXT CHARACTER AND SEE IF IT MATCHES THE CHARACTER
IN LOOK4CHAR %
BIND
ILL26S = ACTSCANCHAR,
TAB26S = ACTINTERR,
LT26S = ACTINTERR,
BLANK26S = ACTINTERR,
SPEC26S = ACTSCANCHAR,
DIGIT26S = ACTSCANCHAR,
UPPER26S = ACTSCANCHAR,
LOWER26S = ACTUPLOW,
FOS26S = ACTSCANCHAR,
EOB26S = ACTINTERR,
REMARK26S = ACTINTERR;
% SEE IF THE CHARACTER MATCHES %
MACRO
ACMSCANCHAR =
IF .LOOK4CHAR EQL "?D"
THEN
BEGIN % ANY DIGIT IS A MATCH %
IF .CODE EQL DIGIT
THEN ( RETURNXT( .CHAR ) )
END
ELSE
IF .LOOK4CHAR EQL "?L"
THEN
BEGIN % ANY LETTER IS A MATCH %
IF .CODE EQL UPPER
THEN ( RETURNXT ( .CHAR ) )
END
ELSE
IF .CHAR EQL .LOOK4CHAR
THEN ( RETURNXT ( 1 ) );
% NO MATCH %
%FIX UP LEXLINE IF NECESSARY%
IF .CHAR EQL EOS
THEN IF ..CURPTR NEQ ";"
THEN LEXLINE _ .LASTLINE;
RETURNOW ( 0 )
$;
!----------------------------------------------------------------------
! STRING LOOKAHEAD
!----------------------------------------------------------------------
% SMALL STATE DEFINITION STSSCAN NUMBER (#) 27S %
% TRY AND MATCH THE STRING POINTED TO BY LOOK4CHAR %
BIND
ILL27S = ACTSTRCHK,
TAB27S = ACTTAB,
LT27S = ACTCLASLT,
BLANK27S = ACTANY,
SPEC27S = ACTSTRCHK,
DIGIT27S = ACTSTRCHK,
UPPER27S = ACTSTRCHK,
LOWER27S = ACTUPLOW,
FOS27S = ACTSTRCHK,
EOB27S = ACTEOB,
REMARK27S = ACTENTREMARK;
MACRO
ACMSTRCHK =
REGISTER R;
% SAVE POSITION IF FIRST ENTRY %
IF .LOOK4CHAR NEQ 0
THEN
BEGIN
POINTER _ .LOOK4CHAR;
LOOK4CHAR _ 0;
ISCAN ( R,POINTER );
IF .CHAR NEQ .R
THEN ( %FIX UP LEXLINE IF NECESSARY%
IF .CHAR EQL EOS
THEN IF ..CURPTR NEQ ";"
THEN LEXLINE _ .LASTLINE;
RETURNOW(0)
)
ELSE ( BAKSAVE(); LEAVE SMALCHAR ) ! GOT ONE
END;
% CHECK THE STRING %
ISCAN ( R, POINTER );
IF .CHAR EQL .R
THEN LEAVE SMALCHAR; ! GOT ONE
IF .R EQL 0
THEN
BEGIN % ITS A MATCH %
IF .BACKLINE NEQ 0 THEN BACKPRINT();
RETURNOW ( 1 )
END
ELSE
BEGIN % BACKUP %
BACKUP();
ISCAN(CHAR,CURPTR);
CHARPOS_.CHARPOS-1;
RETURNOW( 0 )
END
$;
!----------------------------------------------------------------------
! KEYWORD LOOKAHEAD
!----------------------------------------------------------------------
% [1465] New %
% SMALL STATE DEFINITION STKEYSCAN NUMBER (#) 33S %
% CHECK FOR A KEYWORD "LETTERS="
ONLY RETURNS FIRST 6 LETTERS %
BIND
ILL33S = ACTKEYCHK,
TAB33S = ACTTAB,
LT33S = ACTCLASLT,
BLANK33S = ACTANY,
SPEC33S = ACTKEYCHK,
DIGIT33S = ACTKEYCHK,
UPPER33S = ACTKEYCHK,
LOWER33S = ACTUPLOW,
FOS33S = ACTKEYCHK,
EOB33S = ACTEOB,
REMARK33S = ACTENTREMARK;
% SMALL STATE DEFINITION STKEY1CHK NUMBER (#) 34S %
% HAVE SEEN INITIAL LETTER OF KEYWORD. BYTE POINTERS AND EVERYTHING
ARE ALL SET UP. READ LETTERS UP TO "=" AND STORE IN SIXBIT KEYWORD %
BIND
ILL34S = ACTKEY1CHK,
TAB34S = ACTTAB,
LT34S = ACTCLASLT,
BLANK34S = ACTANY,
SPEC34S = ACTKEY1CHK,
DIGIT34S = ACTKEY1CHK,
UPPER34S = ACTKEY1CHK,
LOWER34S = ACTUPLOW,
FOS34S = ACTKEY1CHK,
EOB34S = ACTEOB,
REMARK34S = ACTENTREMARK;
%2370% BIND
%2370% MAXNWD = 4, ! KEYBUFFER has 4 words
%2370% MAXLENGTH = MAXNWD*5-1; ! therefore it can only store up to
! 20-1 (or 19) asciz characters
! last character in 20 character string
! must be left null
MACRO
ACMKEYCHK =
REGISTER R;
IF .CODE EQL UPPER ! If first char is a letter
THEN
BEGIN ! letter
%2370% INCR WORD FROM 0 TO MAXNWD-1
%2370% DO KEYBUFFER[.WORD] = 0; ! Clear keyword buffer
%2370% KEYLENGTH = 1;
%2370% POINTER = KEYBUFFER<36,7>;! Set up pointer to result buffer
%2370% REPLACEI (POINTER, .CHAR); ! Store asciz character
BAKSAVE(); ! Set backup pointer
STATE = STKEY1CHK; ! New state for rest of chars
LEAVE SMALCHAR; ! Go read next char
END ! letter
ELSE
BEGIN ! not letter
IF .CHAR EQL EOS ! Fix up LEXLINE if necessary
THEN IF ..CURPTR NEQ ";"
THEN LEXLINE = .LASTLINE;
RETURNOW(0) ! Return failure
END; ! not letter
$;
MACRO
ACMKEY1CHK =
IF .CODE EQL UPPER
THEN
BEGIN ! Another letter
%2370% IF (KEYLENGTH = .KEYLENGTH + 1) LEQ MAXLENGTH
%2370% THEN REPLACEI (POINTER, .CHAR); ! store this one
LEAVE SMALCHAR; ! and go get next one
END; ! Another letter
IF .CHAR EQL "="
THEN
BEGIN ! Match
IF .BACKLINE NEQ 0 THEN BACKPRINT(); ! Let output catch up
%2370% RETURNXT (.KEYBUFFER) ! Return the keyword
END ! Match
ELSE
BEGIN ! No match
BACKUP(); ! Back up to where we were before
ISCAN(CHAR,CURPTR); ! Get first char again
CHARPOS = .CHARPOS - 1; ! Count first char
RETURNOW (0); ! Return failure
END; ! No match
$;
!----------------------------------------------------------------------
! OBJECT OF STOP OR PAUSE STATEMENTS
!----------------------------------------------------------------------
% SMALL STATE DEFINITION STOPOBJ NUMBER (#) 28S %
% LOOK FOR AN DECIMAL STRING OR A 'LITERAL-STRING' FOLLOWING A STOP OR PAUSE STATEMENT %
BIND
ILL28S = ACTSTOPLIT,
TAB28S = ACTINTERR,
LT28S = ACTINTERR,
BLANK28S = ACTINTERR,
SPEC28S = ACTSTOPLIT,
%742% DIGIT28S = ACTSTOPINT,
UPPER28S = ACTSTOPLIT,
LOWER28S = ACTSTOPLIT,
FOS28S = ACTSTOPLIT,
EOB28S = ACTINTERR,
REMARK28S = ACTINTERR;
% SEE IF ITS A LITERAL STRING %
MACRO
ACMSTOPLIT =
IF .CHAR EQL "'"
THEN ( ACTION _ ACTENTLITLEX; LEAVE NEWACTION )
ELSE (RETURNOW ( 0 ))
$;
MACRO
ACMSTOPINT =
% PICK UP A SIX DIGIT INTEGER FOR STOP/PAUSE STATEMENT
THIS IS THE INITIALIZATION ROUTINE FOR THE NUMBER %
BIND NDIGITS = 6; ! MAX OF SIX CHARACTERS (STANDARD SAYS 5)
%1245% ! Get string as HOLLCONST
%1245% VALUE<RIGHT> _ LITDEF(NDIGITS,HOLLDEF); !WANT A STRING REPRESENTATION
VALUE<LEFT> _ LITSTRING;
POINTER _ (@VALUE + LTLSIZ)<36,7>;
SUM _ 0;
ACTION _ ACT6DIGIT;
LEAVE NEWACTION
$;
% SMALL STATE DEFINITION STSIXDIGIT NUMBER (#) 32S %
% PICK UP A SIX DIGIT INTEGER FOR STOP/PAUSE STATEMENT %
BIND
ILL32S = ACTBADCHAR,
TAB32S = ACTTAB,
LT32S = ACTLT,
BLANK32S= ACTANY,
SPEC32S = ACTGOT6INT,
DIGIT32S= ACT6DIGIT,
UPPER32S= ACTGOT6INT,
LOWER32S= ACTGOT6INT,
FOS32S = ACTGOT6INT,
EOB32S = ACTEOB,
REMARK32S= ACTENTREMARK;
MACRO
ACM6DIGIT =
%COLLECT UP TO 6 DIGITS FOR STOP/PAUSE STATEMENT%
STATE _ STSIXDIGIT;
ACTION _ ACT6DIGIT;
IF .SUM EQL 6 THEN FATLEX( PLIT'6-digit number?0', PLIT'larger number?0', E0<0,0> );
REPLACEI(POINTER,.CHAR);
SUM_.SUM+1;
LEAVE SMALCHAR
$;
MACRO
ACMGOT6INT =
STATE _ STRETNX;
LEAVE NEWSTATE
$;
!----------------------------------------------------------------------
! LEXICAL ANALYZER
!----------------------------------------------------------------------
% BIG STATE DEFINITION STLEXEME NUMBER (#) 0B %
% THIS IS THE ENTRANCE TO THE LEXICAL ANALYZER %
BIND
ILL0B = ACTBADCHAR,
TAB0B = ACTINTERR,
LT0B = ACTINTERR,
BLANK0B = ACTINTERR,
SPEC0B = ACTINTERR,
DIGIT0B = ACTENTGETCONST,
UPPER0B = ACTENTIDENT,
LOWER0B = ACTUPLOW,
FOS0B = ACTLEXFOS,
![675] IN STLEXEME NUMBER 0B, CHANGE TO CATCH A RUBOUT IN SOURCE.
%675% EOB0B = ACTRIS,
REMARK0B = ACTINTERR,
EQUAL0B = ACTDOUBLEX,
LPAREN0B = ACTSINGLEX,
RPAREN0B = ACTSINGLEX,
COLON0B = ACTSINGLEX,
COMMA0B = ACTSINGLEX,
DOLLAR0B = ACTSINGLEX,
ASTERISK0B = ACTDOUBLEX,
%1244% SLASH0B = ACTDOUBLEX,
PLUS0B = ACTSINGLEX,
MINUS0B = ACTSINGLEX,
ANDSGN0B = ACTSINGLEX,
LITSGN0B = ACTENTLITLEX,
OCTSGN0B = ACTENTOCTQ,
NEQSGN0B = ACTSINGLEX,
DOT0B = ACTENTDOT,
SEMICOL0B = ACTMULTST,
LTSGN0B = ACTDOUBLEX,
GTSGN0B = ACTDOUBLEX,
COMNTSGN0B = ACTENTIDENT,
DEBUGSGN0B = ACTENTIDENT,
UPAROW0B = ACTSINGLEX;
MACRO
ACMLEXFOS =
%1640% IF ..CURPTR NEQ ";" AND (.CHAR EQL EOS OR .CHAR EQL EOF)
THEN LEXLINE _ .LASTLINE; ! PROPERLY SET LEXEME LINE NUMBER
! FOR STATEMENTS TERMINATED BY END OF LINE
RETURNOW (EOSLEX^18)
$;
![675] ADD MACRO ROUTINE TO CHECK FOR A RUBOUT CHARACTER IN THE
![675] SOURCE PROGRAM - THIS IS NECESSARY SINCE THE RUBOUT
![675] CHARACTER (#177) IS ALSO USED INTERNALLY AS AN END OF
![675] BUFFER CHARACTER.
%675% MACRO
ACMRIS =
%675% IF CURWORD NEQ .CURPOOLEND AND .CHAR EQL #177
%675% THEN ACTION _ ACTBADCHAR
%675% ELSE ACTION _ ACTINTERR;
%675% LEAVE NEWACTION
$;%675%
% 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
$;
% SINGLE CHARACTER LEXEME %
MACRO
ACMSINGLEX =
% MOST CODES ARE IDENTICAL TO THE LEXEME CODE %
%2241% REGISTER VAL;
%2241% VAL =
%2241% IF (VAL = .CODE) LEQ EQUAL
%2241% THEN .VAL^18 ! includes ():,/+-& and dollar
%2241% ELSE IF .VAL EQL NEQSGN
%2260% THEN ! # is .NE.
%2260% BEGIN
%2260% FLAGRELOP('#'); ! Compatibility flagging
%2260% DOTNE
%2260% END
%2260% ELSE ! ^
%2260% BEGIN
%2260% IF FLAGEITHER THEN CFLEXB(E235<0,0>);
%2260% POWER^18
%2260% END;
%2241% RETURNXT(.VAL)
$;
% CHECK FOR TWO CHARACTER LEXEMES, IE. <=, >= , **, ETC. %
MACRO
ACMDOUBLEX =
VALUE _ .CODE;
STATE _ STDOUBLEX;
LEAVE BIGCHAR
$;
% BIG STATE DEFINITION STDOUBLEX NUMBER (#) 4B %
% WE HAVE /, *, =, <, OR > - SEE IF ITS A TWO CHARACTER LEXEME %
BIND
ILL4B = ACTBADCHAR,
TAB4B = ACTTAB,
LT4B = ACTLT,
BLANK4B = ACTANY,
SPEC4B = ACTNOTDOUB,
DIGIT4B = ACTNOTDOUB,
UPPER4B = ACTNOTDOUB,
LOWER4B = ACTNOTDOUB,
FOS4B = ACTNOTDOUB,
EOB4B = ACTEOB,
REMARK4B = ACTENTREMARK,
EQUAL4B = ACTMAYBDOUB,
LPAREN4B = ACTNOTDOUB,
RPAREN4B = ACTNOTDOUB,
COLON4B = ACTNOTDOUB,
COMMA4B = ACTNOTDOUB,
DOLLAR4B = ACTNOTDOUB,
ASTERISK4B = ACTMAYBDOUB,
%1244% SLASH4B = ACTMAYBDOUB,
PLUS4B = ACTNOTDOUB,
MINUS4B = ACTNOTDOUB,
ANDSGN4B = ACTNOTDOUB,
LITSGN4B = ACTNOTDOUB,
OCTSGN4B = ACTNOTDOUB,
NEQSGN4B = ACTNOTDOUB,
DOT4B = ACTNOTDOUB,
SEMICOL4B = ACTNOTDOUB,
LTSGN4B = ACTMAYBDOUB,
GTSGN4B = ACTMAYBDOUB,
COMNTSGN4B = ACTNOTDOUB,
DEBUGSGN4B = ACTNOTDOUB,
UPAROW4B = ACTNOTDOUB;
% ITS NOT A DOUBLE CHARACTER LEXEME %
MACRO
ACMNOTDOUB =
%2241% REGISTER VAL;
%2241% VAL =
%2241% IF (VAL = .VALUE) LEQ EQUAL
%2241% THEN .VAL^18 ! includes: =,*,/
%2241% ELSE IF .VAL EQL LTSGN
%2260% THEN ! < is .LT.
%2260% BEGIN
%2260% FLAGRELOP('<'); ! Compatibility flagging
%2260% VREG = DOTLT
%2260% END
%2260% ELSE ! > is .GT.
%2260% BEGIN
%2260% FLAGRELOP('>'); ! Compatibility flagging
%2260% VREG = DOTGT
%2260% END;
%2241% RETURNOW(.VAL)
$;
% MIGHT HAVE A DOUBLE CHARACTER LEXEME %
% HERE FROM STDOUBLEX ON /, *, =, <, >
WITH VALUE = BIGCODE OF FIRST CHARACTER
CODE = BIGCODE OF SECOND CHARACTER
CHAR = SECOND CHARACTER
THIS STATE ISN'T ENTERED IF FIRST OR SECOND CHAR IS PLUS, BUT
THE CASE STATEMENTS MUST CONTAIN PLUS ANYWAY SINCE IT'S BETWEEN
SLASH AND ASTERISK. %
MACRO
ACMMAYBDOUB =
%2241% REGISTER VAL;
ACTION _ ACTNOTDOUB;
%1244% CASE .VALUE-SLASH OF
SET
%1244% % SLASH %
%1244% BEGIN
%1244% IF .CHAR NEQ "/"
%1244% THEN LEAVE NEWACTION; ! JUST /
%1244% VAL _ CONCAT^18 ! //
%1244% END;
%1244% % PLUS %
%1244% LEAVE NEWACTION;
% ASTERISK %
BEGIN
IF .CHAR NEQ "*"
THEN LEAVE NEWACTION; ! JUST *
VAL = POWER^18
END;
%=%
BEGIN
CASE .CODE-SLASH OF
SET
%1244% %/% (LEAVE NEWACTION); ! JUST =
%1244% %+% (LEAVE NEWACTION); ! JUST =
%*% (LEAVE NEWACTION); ! JUST =
%2260% %=% (FLAGRELOP('=='); ! == is compatibility flagged
%2260% VAL = DOTEQ);
%2260% %<% (FLAGRELOP('=<'); ! =< is compatibility flagged
%2260% VAL = DOTLE);
%2260% %>% (FLAGRELOP('=>'); ! => is compatibility flagged
%2260% VAL = DOTGE);
TES
END;
%<%
BEGIN
IF .CHAR NEQ "="
THEN LEAVE NEWACTION;
%2260% FLAGRELOP('<='); ! Compatibility flagger
VAL _ DOTLE
END;
%>%
BEGIN
IF .CHAR NEQ "="
THEN LEAVE NEWACTION;
%2260% FLAGRELOP('>='); ! Compatibility flagger
VAL _ DOTGE
END;
TES;
RETURNXT(.VAL)
$;
!----------------------------------------------------------------------
! IDENTIFIERS
!----------------------------------------------------------------------
% SMALL STATE DEFINITION STIDENT NUMBER (#) 10S %
% SCAN IDENTIFIERS AND PUT IN THE SYMBOL TABLE IN 6-BIT %
BIND
ILL10S = ACTBADCHAR,
TAB10S = ACTTAB,
LT10S = ACTLT,
BLANK10S = ACTANY,
SPEC10S = ACTENDID,
DIGIT10S = ACTPKUPID,
UPPER10S = ACTPKUPID,
LOWER10S = ACTUPLOW,
FOS10S = ACTENDID,
EOB10S = ACTEOB,
REMARK10S = ACTENTREMARK;
% WE HAVE THE FIRST CHARACTER OF AN IDENTIFIER %
MACRO
ACMENTIDENT =
%1213% SYMTYPE _ .TYPTAB[ 2 * (.CHAR - "A") ]<RIGHT>;
%1213% IF .SYMTYPE EQL #15 ! Is it CHARACTER data?
%1213% THEN CHLEN _ .TYPTAB[ 2 * (.CHAR - "A") + 1 ]; ! Character count
CNT _ 5; ! Identifier count
IDENTF _ .CHAR - " "; ! FIRST CHARACTER
STATE _ STIDENT;
LEAVE SMALCHAR
$;
% PICKUP EACH CHARACTER OF THE IDENTIFIED AND CONVERT TO 6-BIT %
MACRO
ACMPKUPID =
IF ( CNT _ .CNT - 1 ) GEQ 0
THEN
BEGIN % SAVE THE CHARACTER %
REGISTER R; MACHOP ADDI = #271, LSH = #242;
R _ .IDENTF;
LSH ( R,6 );
ADDI ( R, -" ", CHAR );
IDENTF _ .R;
LEAVE SMALCHAR
END;
% ELSE WE HAVE MORE THAN 6 CHARACTER %
IF .CNT NEQ -1
THEN LEAVE SMALCHAR; !IGNORE THE CHARACTER
% OUTPUT THE MESSAGE IF ITS NOT CALL DEFINEFILE %
!%1126% IF .STMNROUTINE ( @STMNDESC) EQL CALLST<0,0> AND .IDENTF EQL SIXBIT'DEFINE'
!%1126% THEN LEAVE SMALCHAR; ! NO MESSAGE
WARNLEX (.IDENTF, E76<0,0>);
LEAVE SMALCHAR
$;
% END OF THE IDENTIFIER - ENTER IT INTO THE SYMBOL TABLE %
MACRO
ACMENDID =
%1213% REGISTER IDPTR; ! Pointer to identifier symbol table entry
![1213] IDATTRIBUT(PARAMT) and IDCHLEN are defined in FIRST.BLI which
![1213] can't be compiled with LEXICA. Beware of skews.
IF .CNT GTR 0
THEN ENTRY _ .IDENTF^(.CNT*6)
ELSE ENTRY _ .IDENTF;
NAME _ .GIDTAB ;
%1213% IDPTR _ TBLSEARCH(); ! Get pointer to symbol table entry
%1213% ! Put character count in symbol table entry in IDPTR[IDCHLEN]
%1213% IF .SYMTYPE EQL #15 ! Is it character data?
%1213% THEN IF .(@IDPTR + 6)<0,36> EQL 0 ! test if we already have character count
%1213% THEN (@IDPTR + 6)<0,36> _ .CHLEN; ! Set IDPTR[IDCHLEN]
%2327% ! If neither psect field is set, then set the psect fields
%2222% IF .(.IDPTR+8)<34,2> EQL 0 !IF .IDPTR[IDPSECT] EQL PSOOPS
%2222% THEN IF .(.IDPTR+8)<32,2> EQL 0 !THEN IF .IDPTR[IDPSCHARS] EQL PSOOPS
%2327% THEN SETPSECTS(.IDPTR);
! CHECK HERE FOR PARAMETER VARIABLE REFERENCES
IF .(@IDPTR + 1 )<32,1> ! [IDATTRIBUT(PARAMT)]
THEN IDPTR _ NAMREF( 5%PARAREF%, .IDPTR<RIGHT> )
%NAMREF WILL RETURN THE CONSTLEX%
ELSE IDPTR<LEFT> _ IDENTIFIER;
RETURNOW (.IDPTR)
$;
!----------------------------------------------------------------------
! DOTTED OPERATORS
!----------------------------------------------------------------------
% SMALL STATE DEFINITION STDOT NUMBER (#) 11S %
% WE HAVE AN INITIAL "." - IS IT AN OPERATOR OR A CONSTANT ? %
BIND
ILL11S = ACTBADCHAR,
TAB11S = ACTTAB,
LT11S = ACTLT,
BLANK11S = ACTANY,
SPEC11S = ACTMISOPER,
DIGIT11S = ACTTRYREAL,
UPPER11S = ACTGETOPER,
LOWER11S = ACTUPLOW,
FOS11S = ACTMISOPER,
EOB11S = ACTEOB,
REMARK11S = ACTENTREMARK;
% FOUND AN INITIAL "." %
MACRO
ACMENTDOT =
STATE _ STDOT;
LEAVE SMALCHAR
$;
% "." FOLLOWED BY A DIGIT MUST BE A REAL CONSTANT %
MACRO
ACMTRYREAL =
DECEXP _ 0;
INCREM _ -1;
HIAC _ 0;
LOAC _ 0;
NAME _ .GCONTAB ;
SYMTYPE _ GREAL<0,0>;
CALLR ( STBLDDBLINT, STREALCON1 );
LEAVE NEWSTATE
$;
% UNRECOGNIZED DOTTED OPERATOR %
MACRO
ACMMISOPER =
FATLEX ( PLIT'DOTTED OPERATOR?0', .CHAR, E0<0,0> );
VALUE _ EOSLEX^18;
CALLR ( STSKIP, STRETNX );
LEAVE BIGCHAR
$;
% WE HAVE A "." FOLLOWED BY A LETTER - SEE IF IT COULD BE AN OPERATOR %
MACRO
ACMGETOPER =
%2260% XORCHAR=(.CHAR EQL "X"); ! To trap the .XOR.
STATE _ STSCANOP;
IF ( POINTER _ @DOTOPTAB[.CHAR-"A" ] ) NEQ 0
THEN LEAVE SMALCHAR; ! WE HAVE A POSSIBLE OPERATOR
% ELSE WHO KNOWS WHAT IT IS %
ACTION _ ACTMISOPER;
LEAVE NEWACTION
$;
% SMALL STATE DEFINITION STSCANOP NUMBER (#) 12S %
% THIS STATE WILL DETERMINE WHETHER OR NOT WE HAVE FOUND A DOTTED OPERATOR
SO FAR A "." AND THE FIRST LETTER OF A VALID OPERATOR HAVE
BEEN FOUND. POINTER CONTAINS A BYTE POINTER TO A CHARACTER
STRING WHICH MAY LEGALLY COMPLETE THIS OPERATOR. THIS IS
IN TABLE LEGALOP. THE ALGORITHM IS - IF ALL CHARACTERS IN
THE STRING ARE MATCHED AND THE NEXT CHARACTER IS ".", THEN
THE WORD FOLLOWING THE CHARACTER STRING CONTAINS THE
APPROPRIATE LEXEME CODE, WHICH IS RETURNED. IF A CHARACTER
DOES NOT MATCH THEN TRY THE PARALLEL CHARACTER IN THE NEXT
POSSIBLE STRING, WHICH IS TWO WORDS FURTHER IN THE TABLE.
EVENTUALLY , IF NO COMPLETE MATCHES ARE MADE A 0 WORD WILL
BE REACHED SIGNALING NO MATCH. THE WORD FOLLOWING THIS
THEN BEGINS A LITERAL OF WHAT ONE WAS LOOKING FOR, WHICH
CAN BE SHOVED OUT WITH ERROR 0.
%
BIND
ILL12S = ACTBADCHAR,
TAB12S = ACTTAB,
LT12S = ACTLT,
BLANK12S = ACTANY,
SPEC12S = ACTOPCHK,
DIGIT12S = ACTMISOP1,
UPPER12S = ACTOPCHK,
LOWER12S = ACTUPLOW,
FOS12S = ACTMISOP1,
EOB12S = ACTEOB,
REMARK12S = ACTENTREMARK;
% COMPARE THE INPUT STREAM AGAINST THE LEGAL OPERATOR STRINGS %
MACRO
ACMOPCHK =
REGISTER
R,
%2241% VAL;
ISCAN ( R, POINTER );
WHILE 1 DO
BEGIN % LOOP THROUGH POSSIBLE OPERATOR STRINGS %
IF .R EQL .CHAR
THEN LEAVE SMALCHAR; ! FINE - GET THE NEXT CHARACTER
IF .R EQL 0 AND .CHAR EQL "."
THEN
BEGIN % A STRING HAS BEEN MATCHED %
VAL _ @(@POINTER+1);
IF .VAL LSS 0
THEN
BEGIN % LOGICAL CONSTANT %
NAME _ .GCONTAB ;
SYMTYPE _ GLOGI<0,0>;
ENTRY[0] _ 0;
%2241% ENTRY[1] _ .VAL + 1;
%2241% VAL = TBLSEARCH();
%2241% VAL<LEFT> = CONSTLEX
END
%2260% ELSE
%2260% IF .XORCHAR AND FLAGANSI
%2260% THEN ! .XOR. operator is compatibility flagged
%2260% BEGIN
%2260% WARNLEX(E287<0,0>);
%2260% VAL=@(@POINTER+1) ! Restore the lexeme value
%2260% END;
%2241% RETURNXT(.VAL) ! RETURN THE LEXEME CODE
END;
% LETS SEE IF THERE IS ANOTHER POSSIBILITY %
IF ( @(POINTER_@POINTER+2) ) EQL 0 OR .R EQL 0
% THE .R CHECK IS THERE SO .NET. WILL NOT BE ACCEPTED %
THEN
BEGIN % NOTHING LEFT TO TRY %
ACTION _ ACTMISOP1;
LEAVE NEWACTION
END;
% THERE IS ANOTHER POSSIBILITY SO LETS TRY IT %
R _ ..POINTER;
END %LOOP%
$;
% WE DIDN'T FIND THE OPERATOR , BUT HAD SOME IDEA OF WHAT WE WERE
LOOKING FOR %
MACRO
ACMMISOP1 =
% GET THE EXPECTED LITERAL %
UNTIL @@POINTER EQL 0
DO POINTER _ .POINTER + 1;
FATLEX ( .POINTER<RIGHT>+1 , .CHAR, E0<0,0> );
CALLR ( STSKIP, STRETNX);
VALUE _ EOSLEX^18;
LEAVE BIGCHAR
$;
!----------------------------------------------------------------------
! CONSTANTS
!----------------------------------------------------------------------
% BIG STATE DEFINITION STGETCONST NUMBER (#) 5B %
% RETURN HERE FROM
BLDDBLINT, WHICH JUST PICKED UP AN INTEGER %
BIND
ILL5B = ACTBADCHAR,
TAB5B = ACTTAB,
LT5B = ACTLT,
BLANK5B = ACTANY,
SPEC5B = ACTGOTINT,
DIGIT5B = ACTINTERR,
UPPER5B = ACTCHECKLET,
LOWER5B = ACTUPLOW,
FOS5B = ACTGOTINT,
EOB5B = ACTEOB,
REMARK5B = ACTENTREMARK,
EQUAL5B = ACTGOTINT,
LPAREN5B = ACTGOTINT,
RPAREN5B = ACTGOTINT,
COLON5B = ACTGOTINT,
COMMA5B = ACTGOTINT,
DOLLAR5B = ACTGOTINT,
ASTERISK5B = ACTGOTINT,
SLASH5B = ACTGOTINT,
PLUS5B = ACTGOTINT,
MINUS5B = ACTGOTINT,
ANDSGN5B = ACTGOTINT,
LITSGN5B = ACTGOTINT,
OCTSGN5B = ACTGOTINT,
NEQSGN5B = ACTGOTINT,
DOT5B = ACTREALCON,
SEMICOL5B = ACTMULTST,
LTSGN5B = ACTGOTINT,
GTSGN5B = ACTGOTINT,
COMNTSGN5B = ACTCHECKLET,
DEBUGSGN5B = ACTCHECKLET,
UPAROW5B = ACTGOTINT;
BIND SUM=HOLCONST;
% WE HAVE A DIGIT FROM LEXEME AND THUS AN INTEGER TO PICK UP %
MACRO
ACMENTGETCONST =
DECEXP _ 0;
INCREM _ 0;
HIAC _ 0;
LOAC _ 0;
NAME _ .GCONTAB ;
CALLR ( STBLDDBLINT, STGETCONST );
LEAVE NEWSTATE ! GO BUILD THE INTEGER
$;
% WE HAVE AN INTEGER %
MACRO
ACMGOTINT =
%2241% REGISTER VAL;
%CHECK FOR OVERFLOW%
IF .LOAC<35,1> OR .HIAC NEQ 0
THEN ( FATLEX(E64<0,0>); NAME _ .GCONTAB );
ENTRY[1] _ .LOAC;
ENTRY[0] _ 0;
% CHECK TO SEE IF WE ARE LOOKING FOR A LABEL %
IF .LOOK4LABEL NEQ 0
THEN
BEGIN % THIS IS A LABEL %
%2241% VAL = LABREF(); ! LABEL IS IN ENTRY[1]
%2241% VAL<LEFT> _ LABELEX
END
ELSE
BEGIN % INTEGER %
SYMTYPE _ GINTEGER<0,0>;
%2241% VAL = TBLSEARCH();
%2241% VAL<LEFT> _ CONSTLEX
END;
%2241% RETURNOW(.VAL)
$;
% THERE IS A LETTER FOLLOWING AN INTEGER
IS IT A HOLERITH OR EXPONENT OR WHAT %
MACRO
ACMCHECKLET =
% FIRST CHECK FOR LABELS %
IF .STATE NEQ STREALCON1
THEN BEGIN
IF .LOOK4LABEL NEQ 0
THEN
BEGIN % WE REALLY WANT A LABEL %
ACTION _ ACTGOTINT;
LEAVE NEWACTION
END;
IF .CHAR EQL "H"
THEN
BEGIN % HOLERITH %
% THE NUMBER OF CHARACTERS IS IN LOAC %
%1107% ! Prohibit 0H - bad hollerith constant
%1107% IF .LOAC EQL 0 THEN FATLEX( E158<0,0> );
% MAKE AN ENTRY IN THE LITERAL TABLE %
%1245% ! Get string as HOLLCONST
%1245% VALUE<RIGHT> _ LITDEF(.LOAC,HOLLDEF);
VALUE <LEFT> _ LITSTRING;
POINTER _ (@VALUE+LTLSIZ)<36,7> ; ! POINTER TO BEGINNING OF LITERAL STORAGE
%2260% IF ( SUM = 5-( .LOAC MOD 5)) EQL 5 ! For blank fill at end
%2260% THEN SUM = 0
%2260% ELSE ! Padding required to get to word boundary
%2455% IF FLAGVMS THEN WARNLEX(E242<0,0>);
STATE _ STHOLEX;
LEAVE SMALCHAR
END
END;
% LOOK FOR EXPONENT %
SIIGN _ 0;
!REMOVE STATE _ STINTEXPONENT;
IF .CHAR EQL "D"
THEN
BEGIN % DOUBLEPRECISION %
SYMTYPE _ GDOUBLPREC<0,0>;
STATE_STINTEXPONENT;
LEAVE SMALCHAR
END;
IF .CHAR EQL "E"
THEN
BEGIN % REAL EXPONENT %
SYMTYPE _ GREAL<0,0>;
STATE_STINTEXPONENT;
LEAVE SMALCHAR
END;
% JUST INTEGER %
IF .STATE EQL STREALCON1 THEN ACTION_ACTGOTREAL ELSE
ACTION _ ACTGOTINT;
LEAVE NEWACTION
$;
% SMALL STATE DEFINITION STBLDDBLINT NUMBER (#) 13S %
% BUILD A DOUBLE PRECISION CONSTANT IN HIAC AND LOAC %
BIND
ILL13S = ACTGOBAKNOW,
TAB13S = ACTTAB,
LT13S = ACTLT,
BLANK13S = ACTANY,
SPEC13S = ACTGOBAKNOW,
DIGIT13S = ACTBILDDBLINT,
UPPER13S = ACTGOBAKNOW,
LOWER13S = ACTGOBAKNOW,
FOS13S = ACTGOBAKNOW,
EOB13S = ACTEOB,
REMARK13S = ACTENTREMARK;
%2241% ! Build a constant as a double integer number. If it is
%2241% ! followed by Dnn it is actually double precision, and will need
%2241% ! all the mantissa bits.
MACRO
ACMBILDDBLINT=
BEGIN
REGISTER R[2];
%2241% MACHOP
%2241% DADD = #114,
%2241% DMOVE = #120,
%2241% DMOVEM = #124,
%2241% ASHC = #244;
%2241% DMOVE(R[0],HIAC); ! Fetch both words into regs
IF (.R[0] AND #760000000000) EQL 0
THEN
BEGIN ! No overflow
DECEXP = .DECEXP + .INCREM; ! Keep track of decimal point
%2241% ASHC(R[0],3); ! Multiply (HIAC,LOAC) by 8
%2241% DADD(R[0],HIAC); ! Add in (HIAC,LOAC)
%2241% DADD(R[0],HIAC); ! Add in (HIAC,LOAC)
%2241% HIAC = 0;
%2241% LOAC = .CHAR - "0"; ! Convert digit to number
%2241% DADD(R[0],HIAC); ! Add it in
%2241% DMOVEM(R[0],HIAC); ! Move result to (HIAC,LOAC)
END ! No overflow
ELSE
BEGIN ! Overflow
! ADJUST EXPONENT FOR IGNORED LEAST SIGNIFIGANT DIGITS
IF .INCREM EQL 0
THEN DECEXP _ .DECEXP + 1
END;
LEAVE SMALCHAR
END;
$;
% SMALL STATE DEFINITION STREALCON NUMBER (#) 14S %
% WE HAVE <INTEGER> "."
WE ARE NOW LOOKING AT WHATEVER FOLLOWS THE "."
%
BIND
ILL14S = ACTBADCHAR,
TAB14S = ACTTAB,
LT14S = ACTLT,
BLANK14S = ACTANY,
SPEC14S = ACTGOTREAL,
DIGIT14S = ACTENTRLBLDD,
UPPER14S = ACTEXDBCHK,
LOWER14S = ACTUPLOW,
FOS14S = ACTGOTREAL,
EOB14S = ACTEOB,
REMARK14S = ACTENTREMARK;
MACRO
ACMREALCON =
SYMTYPE _ GREAL<0,0>;
STATE _ STREALCON;
LEAVE SMALCHAR
$;
% BUILD THE FRACTIONAL PORTION OF A CONSTANT %
MACRO
ACMENTRLBLDD =
INCREM _ -1;
CALLR ( STBLDDBLINT, STREALCON1 );
LEAVE NEWSTATE
$;
% WE HAVE A REAL OR DOUBLE PRECISION CONSTANT %
MACRO
ACMGOTREAL =
FLTGEN();
ENTRY[0] _ .HIAC;
ENTRY[1] _ .LOAC;
RETURNOW (( CONSTLEX^18 + TBLSEARCH() ))
$;
% WE HAVE <INTEGER> "." <LETTER>
AND UNFORTUNATELY MUST CHECK WHETHER IT IS AN EXPONENT OR
A RELATIONAL/LOGICAL OPERATOR %
MACRO
ACMEXDBCHK =
SIIGN _ 0;
IF .CHAR EQL "D"
THEN
BEGIN % DOUBLE PRECISION %
SYMTYPE _ GDOUBLPREC<0,0>;
STATE _ STINTEXPONENT;
LEAVE SMALCHAR
END;
IF .CHAR EQL "E"
THEN
BEGIN % POSSIBLE EXPONENT OR RELATIONAL OPERATOR %
% IF THEREIS ANOTHER LETTER FOLLOWING IT WE
WILL ASSUME THAT IT IS AN OPERATOR %
BAKSAV(); ! SAVE CURRENT POSITION
STATE _ STOPCHK;
LEAVE SMALCHAR
END;
% ELSE EVERYTHING ELSE IS AN OPERATOR %
DECREMENT ( CURPTR<ADRS> );
CHARPOS _ .CHARPOS + 1; !BACKUP THE CHARACTER POSITION COUNTER
CHAR _ ".";
CODE _ DOT;
ACTION _ ACTGOTINT;
LEAVE NEWACTION
$;
% SMALL STATE DEFINITION STREALCON1 NUMBER (#) 15S %
% WE HAVE [<INTEGER>] "." < INTEGER > - SO LOOK FOR EXPONENT %
BIND
ILL15S = ACTBADCHAR,
TAB15S = ACTTAB,
LT15S = ACTLT,
BLANK15S = ACTANY,
SPEC15S = ACTGOTREAL,
DIGIT15S = ACTINTERR,
UPPER15S = ACTCHECKLET,
LOWER15S = ACTUPLOW,
FOS15S = ACTGOTREAL,
EOB15S = ACTEOB,
REMARK15S = ACTENTREMARK;
% SMALL STATE DEFINITION STOPCHK NUMBER (#) 16S %
% WE HAVE <INTEGER> "." "E" - ? IS IT AN EXPONENT OR OERATOR %
BIND
ILL16S = ACTBADCHAR,
TAB16S = ACTTAB,
LT16S = ACTCLASLT,
BLANK16S = ACTANY,
SPEC16S = ACTCHKPLMI,
DIGIT16S = ACTINTEXP1,
UPPER16S = ACTGOTOP,
LOWER16S = ACTGOTOP,
FOS16S = ACTNOEXP,
EOB16S = ACTEOB,
REMARK16S = ACTENTREMARK;
% ITS AN OPERATOR %
MACRO
ACMGOTOP =
% SO BACK UP %
BACKUP();
CHAR _ ".";
CODE _ DOT;
ACTION _ ACTGOTINT;
LEAVE NEWACTION
$;
% SMALL STATE DEFINITION STINTEXPONENT NUMBER (#) 17S %
% LOOK FOR SIGN OF EXPONENT FOLLOWING D OR E %
BIND
ILL17S = ACTBADCHAR,
TAB17S = ACTTAB,
LT17S = ACTLT,
BLANK17S = ACTANY,
SPEC17S = ACTCHKPLMI,
DIGIT17S = ACTINTEXP1,
UPPER17S = ACTNOEXP,
LOWER17S = ACTNOEXP,
FOS17S = ACTNOEXP,
EOB17S = ACTEOB,
REMARK17S = ACTENTREMARK;
% SET SIIGN IF ITS PLUS OF MINUS, OTHERWISE ITS NO EXPONENT %
MACRO
ACMCHKPLMI =
% CHECK TO SEE IF SOME LINES WERE LOOKED AHEAD OVER %
IF .BACKLINE NEQ 0 THEN BACKPRINT();
STATE _ STINTEXP0;
IF .CHAR EQL "-"
THEN ( SIIGN _ -1; LEAVE SMALCHAR); ! GO GET EXPONENT
IF .CHAR EQL "+" THEN LEAVE SMALCHAR;
% ELSE NO EXPONENT %
ACTION _ ACTNOEXP;
LEAVE NEWACTION
$;
% NO EXPONENT AFTER E OR D %
MACRO
ACMNOEXP =
% CHECK FOR BACK PRINT %
IF .BACKLINE NEQ 0 THEN BACKPRINT();
FATLEX( E95<0,0>);
NAME _ .GCONTAB;
ACTION _ ACTGOTREAL;
LEAVE NEWACTION
$;
% SMALL STATE DEFINITION STINTEXP0 NUMBER (#) 18S %
% SIGN OF EXPONENT HAS BEEN FOUND - LETS NOT HAVE ANY MORE SIGNS %
BIND
ILL18S = ACTBADCHAR,
TAB18S = ACTTAB,
LT18S = ACTLT,
BLANK18S = ACTANY,
SPEC18S = ACTNOEXP,
DIGIT18S = ACTINTEXP1,
UPPER18S = ACTNOEXP,
LOWER18S = ACTNOEXP,
FOS18S = ACTNOEXP,
EOB18S = ACTEOB,
REMARK18S = ACTENTREMARK;
% SMALL STATE DEFINITION STINTEXP1 NUMBER (#) 19S %
% LOOK FOR DIGITS OF THE EXPONENT AFTER THE FIRST %
BIND
ILL19S = ACTBADCHAR,
TAB19S = ACTTAB,
LT19S = ACTLT,
BLANK19S = ACTANY,
SPEC19S = ACTGOTIEXP,
DIGIT19S = ACTSKCONBLD,
UPPER19S = ACTGOTIEXP,
LOWER19S = ACTGOTIEXP,
FOS19S = ACTGOTIEXP,
EOB19S = ACTEOB,
REMARK19S = ACTENTREMARK;
% WE HAVE 1ST DIGIT OF EXPONENT %
MACRO
ACMINTEXP1 =
IF .BACKLINE NEQ 0 THEN BACKPRINT();
SUM _ .CHAR - "0";
STATE _ STINTEXP1;
LEAVE SMALCHAR
$;
% WE HAVE AN EXPONENT %
MACRO
ACMGOTIEXP =
IF .SIIGN NEQ 0
THEN SUM _ -.SUM;
DECEXP _ .DECEXP + .SUM;
ACTION _ ACTGOTREAL;
LEAVE NEWACTION
$;
!----------------------------------------------------------------------
! HOLERITH CONSTANTS
!----------------------------------------------------------------------
% SMALL STATE DEFINITION STHOLEX NUMBER (#) 20S %
% PICK UP A HOLERITH STRING - LOAC CONTAINS THE NUMBER OF CARACTERS %
BIND
ILL20S = ACTHOLCHAR,
TAB20S = ACTHOLTAB,
LT20S = ACTLT,
BLANK20S = ACTHOLCHAR,
SPEC20S = ACTHOLCHAR,
DIGIT20S = ACTHOLCHAR,
UPPER20S = ACTHOLCHAR,
LOWER20S = ACTHOLCHAR,
FOS20S = ACTHOLEND,
EOB20S = ACTEOB,
REMARK20S = ACTHOLCHAR;
% FORM THE HOLERITH STRING %
MACRO
ACMHOLCHAR =
IF .LOAC EQL 0
THEN ( ACTION _ ACTHOLEND; LEAVE NEWACTION )
ELSE
BEGIN % STORE THE CHARACTERS %
LOAC _ .LOAC -1;
REPLACEI ( POINTER, .CHAR );
LEAVE SMALCHAR
END
$;
% END OF THE HOLERITH STRING %
MACRO
ACMHOLEND =
%2260% IF FLAGANSI THEN WARNLEX(E243<0,0>); ! "ANSI: Hollerith constant"
LOAC _ .LOAC + .SUM; ! SUM IS # CHARS TO BLANK FILL
WHILE .LOAC NEQ 0
DO
BEGIN % BLANK FILL IF EOS WAS REACHED AND TO WORD BONDRY %
REPLACEI ( POINTER, " " );
LOAC _ .LOAC-1
END;
(.POINTER<RIGHT>+1)<0,36> _ 0; ! NULL WORD ON THE END
STATE _ STRETNX;
LEAVE NEWSTATE
$;
!----------------------------------------------------------------------
! LITERAL STRINGS
!----------------------------------------------------------------------
% SMALL STATE DEFINITION STLITLEX NUMBER (#) 21S %
% PICK UP A LITERAL STRING %
BIND
ILL21S = ACTLITEDCHK,
TAB21S = ACTHOLTAB,
LT21S = ACTLT,
BLANK21S = ACTLITEDCHK,
SPEC21S = ACTLITEDCHK,
DIGIT21S = ACTLITEDCHK,
UPPER21S = ACTLITEDCHK,
LOWER21S = ACTLITEDCHK,
FOS21S = ACTNOTIC,
EOB21S = ACTEOB,
REMARK21S = ACTLITEDCHK;
BIND LSTADDR = SUM;
!***************************************************************
! The size of the literal is not yet known. Build a literal
! table entry of a reasonable size and see if it fits. If so
! any space left over will be returned. If not a larger area
! will be requested. This is accomplished by adding to the
! block through another call to CORMAN. CORMAN assumes that all
! blocks larger than FLSIZ words will be taken from free storage
! and that successive requests will add to the original request.
!***************************************************************
MACRO
ACMENTLITLEX =
% MAKE FIRST ENTRY %
%1245% CHARCOUNT _ 0; ! Length of character constant
%1245% ! Get string as HOLLCONST
%1530% VALUE<RIGHT> = LITDEF(CHARSPERWORD * FLSIZ, CHARDEF);
VALUE<LEFT> _ LITSTRING;
POINTER _ (@VALUE + LTLSIZ)<36,7>; ! FORM STARTING BYTE POINTER
LSTADDR _ .VALUE<RIGHT> + LTLSIZ + FLSIZ - 1; ! ADDRESS OF LAST WORD IN ENTRY
STATE _ STLITLEX;
LEAVE SMALCHAR
$;
% LOOKING FOR CLOSING ' %
MACRO
ACMLITEDCHK =
% MAKE SURE THAT THERE IS SPACE LEFT %
IF .LSTADDR<RIGHT> EQL .POINTER<RIGHT>
THEN
BEGIN % NEED MORE SPACE %
%1530% NAME<LEFT> = FLSIZ; ! Must be at least FLSIZ words
CORMAN();
%5130% LSTADDR = .LSTADDR + FLSIZ;
END;
IF .CHAR EQL "'"
THEN
BEGIN % THIS MAY BE THE END OF THE LITERAL %
STATE _ STLITEND
END
ELSE
BEGIN % STORE THE CHARACTER %
REPLACEI ( POINTER, .CHAR );
%1245% CHARCOUNT _ .CHARCOUNT + 1; ! Increment length
END;
LEAVE SMALCHAR
$;
% MISSING TERMINAL "'" %
MACRO
ACMNOTIC =
FATLEX ( E72<0,0> );
RETURNOW (EOSLEX^18)
$;
% SMALL STATE DEFINITION STLITEND NUMBER (#) 22S %
% LOOKING FOR SECOND ' %
BIND
ILL22S = ACTTIC2CHK,
TAB22S = ACTTIC2CHK,
LT22S = ACTLT,
BLANK22S = ACTTIC2CHK,
SPEC22S = ACTTIC2CHK,
DIGIT22S = ACTTIC2CHK,
UPPER22S = ACTTIC2CHK,
LOWER22S = ACTTIC2CHK,
FOS22S = ACTTIC2CHK,
EOB22S = ACTEOB,
REMARK22S = ACTTIC2CHK;
% CHECK FOR SUCCESSIVE 'S %
MACRO
ACMTIC2CHK =
IF .CHAR EQL "'"
THEN
BEGIN % GOT ONE %
REPLACEI( POINTER, .CHAR ); ! SPACE CHECK ALREADY MADE
%1245% CHARCOUNT _ .CHARCOUNT + 1; ! Increment length
STATE _ STLITLEX;
LEAVE SMALCHAR
END
ELSE
BEGIN % END OF THE LINE FOR THE LITERAL %
%1245% IF .CHARCOUNT EQL 0 THEN FATLEX( E159<0,0> ); ! Illegal character constant '' found - complain
% BLANK FILL %
UNTIL .POINTER<30,6> EQL 1
DO REPLACEI( POINTER, " " );
%1245% ENDOFLIT( .POINTER<RIGHT>,.VALUE<RIGHT>,.LSTADDR<RIGHT>,.CHARCOUNT );
% CLEAN UP AND SAVE SPACE %
STATE _ STRETNX;
LEAVE NEWSTATE
END
$;
!----------------------------------------------------------------------
! OCTAL CONSTANTS
!----------------------------------------------------------------------
% SMALL STATE DEFINITION STOCTQ NUMBER (#) 23S %
% LOOK FOR SIGN OF OCTAL %
BIND
ILL23S = ACTBADCHAR,
TAB23S = ACTTAB,
LT23S = ACTLT,
BLANK23S = ACTANY,
SPEC23S = ACTCHKOCPM,
DIGIT23S = ACTOCTQ1,
UPPER23S = ACTNOOCT,
LOWER23S = ACTNOOCT,
FOS23S = ACTNOOCT,
EOB23S = ACTEOB,
REMARK23S = ACTENTREMARK;
% LOOKING FOR OCTAL CONSTANT %
MACRO
ACMENTOCTQ =
HIAC _ 0;
LOAC _ 0;
SIIGN _ 0;
%2225% CHARCOUNT = 0; ! Used to count the number of octal digits
STATE _ STOCTQ;
LEAVE SMALCHAR
$;
% NO DIGITS IN OCTAL CONSTANT %
MACRO
ACMNOOCT =
FATLEX ( PLIT'OCTAL DIGIT?0', .CHAR, E0<0,0> );
CALLR ( STSKIP, STRETNX );
VALUE _ EOSLEX^18;
LEAVE NEWSTATE
$;
% SEE IF WE HAVE A SIGN %
MACRO
ACMCHKOCPM =
STATE _ STOCTQ0;
IF .CHAR EQL "-"
THEN ( SIIGN _ -1; LEAVE SMALCHAR );
IF .CHAR EQL "+" THEN LEAVE SMALCHAR;
ACTION _ ACTNOOCT;
LEAVE NEWACTION
$;
% SMALL STATE DEFINITION STOCTQ0 NUMBER (#) 24S %
% AFTER THE SIGN BUT BEFORE ANY DIGITS %
BIND
ILL24S = ACTBADCHAR,
TAB24S = ACTTAB,
LT24S = ACTLT,
BLANK24S = ACTANY,
SPEC24S = ACTNOOCT,
DIGIT24S = ACTOCTQ1,
UPPER24S = ACTNOOCT,
LOWER24S = ACTNOOCT,
FOS24S = ACTNOOCT,
EOB24S = ACTEOB,
REMARK24S = ACTENTREMARK;
% SMALL STATE DEFINITION STOCTQ1 NUMBER (#) 25S %
% LOOK FOR DIGITS AFTER THE FIRST %
BIND
ILL25S = ACTBADCHAR,
TAB25S = ACTTAB,
LT25S = ACTLT,
BLANK25S = ACTANY,
SPEC25S = ACTGOTOCT,
DIGIT25S = ACTOCTQ1,
UPPER25S = ACTGOTOCT,
LOWER25S = ACTGOTOCT,
FOS25S = ACTGOTOCT,
EOB25S = ACTEOB,
REMARK25S = ACTENTREMARK;
% PICK UP THOSE OCTAL DIGITS %
MACRO
ACMOCTQ1 =
MACHOP LSHC = #246;
REGISTER T[2];
STATE _ STOCTQ1;
T[0] _ .HIAC; T[1] _ .LOAC;
IF .CHAR GEQ "8"
THEN
BEGIN % BAD DIGIT %
FATLEX ( PLIT'OCTAL DIGIT?0', .CHAR, E0<0,0> );
CHAR _ "0"
END;
%2225% CHARCOUNT = .CHARCOUNT + 1; ! Count the digit
LSHC(T[0],3); ! Build the number
T[1] _ .T[1] + ( .CHAR - "0" );
HIAC _ .T[0];
LOAC _ .T[1];
LEAVE SMALCHAR
$;
MACRO
ACMGOTOCT =
%2260% IF FLAGEITHER THEN CFLEXB(E266<0,0>); ! Compatibility flagger
%2225% ! Check for too many digits and complain
%2225% IF .CHARCOUNT GTR 24
%2225% THEN FATLEX( PLIT'a maximum of 24?0',PLIT'too many digits?0',E0<0,0>);
IF .SIIGN NEQ 0
THEN
%2475% BEGIN
%2475% HIAC = -.HIAC - 1;
%2475% IF (LOAC = -.LOAC) EQL 0
%2475% THEN HIAC = .HIAC + 1
%2475% END;
% NEGATIVES ARE KEPT IN DOUBLE PRECISION %
%2225% ! Set the datatype based on number of digits
%2225% SYMTYPE = (IF .CHARCOUNT LEQ 12 THEN GOCTAL<0,0> ELSE GDUBOCT<0,0>);
ENTRY[0] _ .HIAC;
ENTRY[1] _ .LOAC;
NAME _ .GCONTAB ;
RETURNOW ( CONSTLEX^18 + TBLSEARCH() )
$;
!----------------------------------------------------------------------
! FORMAT STATEMENT LEXICAL ANALYZER
!----------------------------------------------------------------------
!
! The lexical analyzer for FORMATS returns constants, literals (
! "'" and holerith ), and single character lexemes. The actual
! lexeme number for any given lexeme is obtained from two tables
! in FORMAT.BLI. For letters the code comes from FMTLET[.CHAR],
! for the other single letter lexemes the code is obtained from
! the table FMTLEX[.CODE] (i.e. the lexical character code is the
! index). The constant lexeme number is FMTLEX[DIGIT], the
! literal lexeme code ( or holerith ) is FMTLEX[LITSGN].
!
!----------------------------------------------------------------------
% BIG STATE DEFINITION STFMTLEX NUMBER (#) 6B %
BIND
ILL6B = ACTFLEX1,
TAB6B = ACTINTERR,
LT6B = ACTINTERR,
BLANK6B = ACTINTERR,
SPEC6B = ACTFLEX1,
DIGIT6B = ACTFMTHOLCK,
UPPER6B = ACTFMTCHAR,
LOWER6B = ACTUPLOW,
FOS6B = ACTFMTEOS,
EOB6B = ACTEOB,
REMARK6B = ACTINTERR,
EQUAL6B = ACTFLEX1,
LPAREN6B = ACTFLEX1,
RPAREN6B = ACTFLEX1,
COLON6B = ACTFLEX1,
COMMA6B = ACTFLEX1,
DOLLAR6B = ACTFLEX1,
ASTERISK6B = ACTFLEX1,
SLASH6B = ACTFLEX1,
PLUS6B = ACTFLEX1,
MINUS6B = ACTFLEX1,
ANDSGN6B = ACTFLEX1,
LITSGN6B = ACTFMTQT,
OCTSGN6B = ACTFLEX1,
NEQSGN6B = ACTFLEX1,
DOT6B = ACTFLEX1,
SEMICOL6B = ACTMULTST,
LTSGN6B = ACTFLEX1,
GTSGN6B = ACTFLEX1,
COMNTSGN6B = ACTFMTCHAR,
DEBUGSGN6B = ACTFMTCHAR,
UPAROW6B = ACTFLEX1;
% STORE THE CHARACTER IN THE FORMAT NODE AND CHECK TO SEE
IF YOU HAVE RUN OUT OF SPACE %
MACRO
SVFMTCHAR =
REPLACEI ( FMTPTR, .CHAR );
IF .FMTPTR<RIGHT> EQL .FMTEND THEN FMTOVER(.CHAR)
$;
% SINGLE CHARACTER NON-LETTER LEXEMES %
MACRO
ACMFLEX1 =
% NOW STORE THE CHARACTER IN THE FORMAT NODE %
SVFMTCHAR;
RETURNXT( .FMTLEX[ .CODE ]<RIGHT> )
$;
% EOS ENCOUNTERED %
MACRO
ACMFMTEOS =
IF ..CURPTR NEQ ";" AND .CHAR EQL EOS
THEN LEXLINE _ .LASTLINE; !ADJUST LEXEME ERROR LINE NUMBER
RETURNOW ( .FMTLEX[ FOS ]<RIGHT> )
$;
% ITS A LETTER %
MACRO
ACMFMTCHAR =
SVFMTCHAR;
RETURNXT ( .FMTLET [ .CHAR - "A" +1 ]<LEFT> )
$;
% SMALL STATE DEFINITION STFMTQT NUMBER (#) 29S %
% PICK UP QUOTED LITERAL STRINGS IN FORMAT STATEMENTS %
BIND
ILL29S = ACTFMTQT1,
TAB29S = ACTHOLTAB,
LT29S = ACTLT,
BLANK29S = ACTFMTQT1,
SPEC29S = ACTFMTQT1,
DIGIT29S = ACTFMTQT1,
UPPER29S = ACTFMTQT1,
LOWER29S = ACTFMTQT1,
FOS29S = ACTFMTQT1,
EOB29S = ACTEOB,
REMARK29S = ACTFMTQT1;
% WE HAVE THE FIRST ' - SEE IF YOU CAN FIND ANOTHER %
MACRO
ACMFMTQT =
SVFMTCHAR;
STATE _ STFMTQT;
LEAVE SMALCHAR
$;
% LOOKING FOR THAT SECOND ' %
MACRO
ACMFMTQT1 =
IF .CODE EQL FOS
THEN
BEGIN % NEVER GOING TO FIND IT NOW %
FATLEX(E72<0,0>);
RETURNOW(.FMTLEX[FOS]<RIGHT>)
END
ELSE
BEGIN
SVFMTCHAR;
IF .CHAR EQL "'"
THEN (RETURNXT( .FMTLEX[ LITSGN ]<RIGHT> ))
ELSE LEAVE SMALCHAR
END
$;
% SMALL STATE DEFINITION STFHOLCON NUMBER (#) 30S %
% WE ARE HERE TO PICK UP A CONSTANT AND SAVE IT INCASE THERE IS A
HOLLERITH FOLLOWING %
BIND
ILL30S = ACTHOLCONDONE,
TAB30S = ACTTAB,
LT30S = ACTLT,
BLANK30S = ACTANY,
SPEC30S = ACTHOLCONDONE,
DIGIT30S = ACTHOLCON,
UPPER30S = ACTHOLCONDONE,
LOWER30S = ACTUPLOW,
FOS30S = ACTHOLCONDONE,
EOB30S = ACTEOB,
REMARK30S = ACTENTREMARK;
% WE HAVE A DIGIT %
MACRO
ACMFMTHOLCK =
% INITIALIZE THE CONSTANT PICKUP %
STATE _ STFHOLCON;
HOLCONST _ 0;
ACTION _ ACTHOLCON;
LEAVE NEWACTION
$;
% ADD UP THOSE DIGITS %
MACRO
ACMHOLCON =
HOLCONST _ .HOLCONST*10 + .CHAR - "0";
SVFMTCHAR;
LEAVE SMALCHAR
$;
% NO MORE DIGITS TO BE FOUND %
MACRO
ACMHOLCONDONE =
IF .CHAR NEQ "H"
THEN ( RETURNOW( .FMTLEX[DIGIT]<RIGHT> )) ! YOU FOUND A CONSTANT
ELSE
BEGIN % ITS A HOLERITH %
STATE _ STFHOLPKUP;
ACTION _ ACTFMTHOLPKUP;
LEAVE NEWACTION
END
$;
% SMALL STATE DEFINITION STFHOLPKUP NUMBER (#) 31S %
% GET THE HOLERITH STRING %
BIND
ILL31S = ACTFMTHOLPKUP,
TAB31S = ACTHOLTAB,
LT31S = ACTLT,
BLANK31S = ACTFMTHOLPKUP,
SPEC31S = ACTFMTHOLPKUP,
DIGIT31S = ACTFMTHOLPKUP,
UPPER31S = ACTFMTHOLPKUP,
LOWER31S = ACTFMTHOLPKUP,
FOS31S = ACTFMTHOLPKUP,
EOB31S = ACTEOB,
REMARK31S = ACTFMTHOLPKUP;
% GET THOSE ELUSIVE CHARACTERS %
MACRO
ACMFMTHOLPKUP =
% NOTE THAT THE INITIAL "H" PASSES THROUGH HERE TOOOOO %
IF .CODE EQL FOS
THEN ( RETURNOW ( .FMTLEX[LITSGN]<RIGHT> ));
SVFMTCHAR;
IF .HOLCONST EQL 0
THEN
BEGIN
RETURNXT( .FMTLEX[ LITSGN ]<RIGHT> )
END
ELSE
BEGIN % GO ON TO THE NEXT ONE %
HOLCONST _ .HOLCONST - 1;
LEAVE SMALCHAR
END
$;
!----------------------------------------------------------------------
! 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;
GLOBAL BIND SMALSTATE = UPLIT( LSMALSTATE 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,
ILL20S^27 + ILL21S^18 + ILL22S^9 + ILL23S,
TAB20S^27 + TAB21S^18 + TAB22S^9 + TAB23S,
LT20S^27 + LT21S^18 + LT22S^9 + LT23S,
BLANK20S^27 + BLANK21S^18 + BLANK22S^9 + BLANK23S,
SPEC20S^27 + SPEC21S^18 + SPEC22S^9 + SPEC23S,
DIGIT20S^27 + DIGIT21S^18 + DIGIT22S^9 + DIGIT23S,
UPPER20S^27 + UPPER21S^18 + UPPER22S^9 + UPPER23S,
LOWER20S^27 + LOWER21S^18 + LOWER22S^9 + LOWER23S,
FOS20S^27 + FOS21S^18 + FOS22S^9 + FOS23S,
EOB20S^27 + EOB21S^18 + EOB22S^9 + EOB23S,
REMARK20S^27 + REMARK21S^18 + REMARK22S^9 + REMARK23S,
S,
ILL24S^27 + ILL25S^18 + ILL26S^9 + ILL27S,
TAB24S^27 + TAB25S^18 + TAB26S^9 + TAB27S,
LT24S^27 + LT25S^18 + LT26S^9 + LT27S,
BLANK24S^27 + BLANK25S^18 + BLANK26S^9 + BLANK27S,
SPEC24S^27 + SPEC25S^18 + SPEC26S^9 + SPEC27S,
DIGIT24S^27 + DIGIT25S^18 + DIGIT26S^9 + DIGIT27S,
UPPER24S^27 + UPPER25S^18 + UPPER26S^9 + UPPER27S,
LOWER24S^27 + LOWER25S^18 + LOWER26S^9 + LOWER27S,
FOS24S^27 + FOS25S^18 + FOS26S^9 + FOS27S,
EOB24S^27 + EOB25S^18 + EOB26S^9 + EOB27S,
REMARK24S^27 + REMARK25S^18 + REMARK26S^9 + REMARK27S,
S,
ILL28S^27 + ILL29S^18 + ILL30S^9 + ILL31S,
TAB28S^27 + TAB29S^18 + TAB30S^9 + TAB31S,
LT28S^27 + LT29S^18 + LT30S^9 + LT31S,
BLANK28S^27 + BLANK29S^18 + BLANK30S^9 + BLANK31S,
SPEC28S^27 + SPEC29S^18 + SPEC30S^9 + SPEC31S,
DIGIT28S^27 + DIGIT29S^18 + DIGIT30S^9 + DIGIT31S,
UPPER28S^27 + UPPER29S^18 + UPPER30S^9 + UPPER31S,
LOWER28S^27 + LOWER29S^18 + LOWER30S^9 + LOWER31S,
FOS28S^27 + FOS29S^18 + FOS30S^9 + FOS31S,
EOB28S^27 + EOB29S^18 + EOB30S^9 + EOB31S,
REMARK28S^27 + REMARK29S^18 + REMARK30S^9 + REMARK31S,
S,
ILL32S^27 + ILL33S^18 + ILL34S^9 + ILL35S,
TAB32S^27 + TAB33S^18 + TAB34S^9 + TAB35S,
LT32S^27 + LT33S^18 + LT34S^9 + LT35S,
BLANK32S^27 + BLANK33S^18 + BLANK34S^9 + BLANK35S,
SPEC32S^27 + SPEC33S^18 + SPEC34S^9 + SPEC35S,
DIGIT32S^27 + DIGIT33S^18 + DIGIT34S^9 + DIGIT35S,
UPPER32S^27 + UPPER33S^18 + UPPER34S^9 + UPPER35S,
LOWER32S^27 + LOWER33S^18 + LOWER34S^9 + LOWER35S,
FOS32S^27 + FOS33S^18 + FOS34S^9 + FOS35S,
EOB32S^27 + EOB33S^18 + EOB34S^9 + EOB35S,
REMARK32S^27 + REMARK33S^18 + REMARK34S^9 + REMARK35S
);
BIND BIGSTATE = UPLIT( LBIGSTATE 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%
);
SWITCHES LIST ;
GLOBAL ROUTINE LEXICA(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
STLEXEME = BIGSTATE[0],
STSKIP = BIGSTATE[1],
STCONTINUE = BIGSTATE[2],
STTERM = BIGSTATE[3],
STDOUBLEX = BIGSTATE[4],
STGETCONST = BIGSTATE[5],
STFMTLEX = BIGSTATE[6];
!---------------------------------------------------------------------------
! BINDS OF THE SMALL STATE NAMES TO SMALSTATE[I]
!---------------------------------------------------------------------------
BIND
STREMARK= SMALSTATE[0],
STRETNX = SMALSTATE[1],
STCALCONT = SMALSTATE[2],
STCLABSKP = SMALSTATE[3],
STCNTCONT = SMALSTATE[4],
STCITCONT = SMALSTATE [5],
STGETLIT = SMALSTATE[6],
STSKNAME = SMALSTATE[7],
STCONSTSKP = SMALSTATE[8],
STSKPHOL = SMALSTATE[9],
STIDENT = SMALSTATE[10],
STDOT = SMALSTATE[11],
STSCANOP = SMALSTATE[12],
STBLDDBLINT = SMALSTATE[13],
STREALCON = SMALSTATE[14],
STREALCON1 = SMALSTATE[15],
STOPCHK = SMALSTATE[16],
STINTEXPONENT = SMALSTATE[17],
STINTEXP0 = SMALSTATE[18],
STINTEXP1 = SMALSTATE[19],
STHOLEX = SMALSTATE[20],
STLITLEX = SMALSTATE[21],
STLITEND = SMALSTATE[22],
STOCTQ = SMALSTATE[23],
STOCTQ0 = SMALSTATE[24],
STOCTQ1 = SMALSTATE[25],
STCSCAN = SMALSTATE[26],
STSSCAN = SMALSTATE[27],
STOPOBJ = SMALSTATE[28],
STFMTQT = SMALSTATE[29],
STFHOLCON = SMALSTATE[30],
STFHOLPKUP = SMALSTATE[31],
%742% STSIXDIGIT = SMALSTATE[32],
%1465% STKEYSCAN = SMALSTATE[33],
%1465% STKEY1CHK = SMALSTATE[34],
%2241% STCONTBLANK = SMALSTATE[35];
!---------------------------------------------------------------------------
! ALL GLOBAL STATE NAMES ARE DEFINED HERE IN THE FOLLOWING FORMAT:
! BIND DUM# = PLIT( EXTNAME GLOBALLY NAMES INTERNAL-NAME )
!---------------------------------------------------------------------------
BIND DUM0 = PLIT(
GSTLEXEME GLOBALLY NAMES STLEXEME ,
GSTCSCAN GLOBALLY NAMES STCSCAN ,
GSTSSCAN GLOBALLY NAMES STSSCAN ,
GSTOPOBJ GLOBALLY NAMES STOPOBJ ,
GSTFMTLEX GLOBALLY NAMES STFMTLEX,
%1465% GSTKSCAN GLOBALLY NAMES STKEYSCAN
);
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 SPURFF=
BEGIN !DETECTS FORM FEED WHEN ATTEMPTING TO DETECT CONTINUATION LINE.
!THIS CONDITION WILL CAUSE PAGE HEADER TO BE PRINTED, BUT
!WILL NOT PROHIBIT A CONTINUATION LINE AFTER THIS!
IF .CHAR EQL FF
THEN
BEGIN
LINEPTR_CONTPTR_.CURPTR;
%2474% CONTLCUR = .LINLCURR;
!%2474% ISCAN(CHAR,CURPTR);
FNDFF_1;
![642] ONLY OUTPUT THE PAGE HEADING IF NOT STILL CLASSIFYING THE
![642] STATEMENT WHICH PRECEDED THE FORM FEED.
%642% IF .FLGREG<LISTING> THEN
%642% IF .INCLAS EQL 0 THEN (CHAROUT(FF); HEADING());
RETURN 1;
END
ELSE RETURN 0;
END; ! of SPURFF
GLOBAL ROUTINE SPURCR=
BEGIN % DETECTS SPURIOUS CR. RETURNS 1 IF SPUR CR ,OUTPUTS MESSAGE AND 0 IF NO SPURIOUSCR%
IF .CHAR EQL CR
THEN
BEGIN
ISCAN ( CHAR,CURPTR);
IF ( CODE _ SMALCODE ) NEQ LT
THEN IF CHKXCR() NEQ LT
THEN RETURN 1;
FOUNDCR _ 1
END;
RETURN 0
END; ! of SPURCR
ROUTINE SKIPDL=
!++
! FUNCTIONAL DESCRIPTION:
!
! Routine to step to the next line in the source list.
!
! It is assumed that we are not at the bottom of the list.
!
! FORMAL PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! LINLCURR - Pointer to current entry in linked list.
! CONTPTR - Continuation backup pointer.
! CONTLCUR - Continuation backup linked list entry
! CURPTR - Pointer to current character in POOL.
! LINELINE - Line number for current line.
! LINEPTR - Pointer to start of current line.
!
! ROUTINE VALUE:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
%2474% ! Written by AlB on 19-Oct-84
%2500% ! Rewritten by AlB on 15-Nov-84
BEGIN
LINLCURR = .LINLCURR + LINLSENT; ! Step to next
IF .LINLCURR GEQ LINLEND<0,0> ! Sanity check
THEN INTERR('SKIPDL');
LINEPTR = CONTPTR = CURPTR = .FIRSTBP(LINLCURR);
CONTLCUR = .LINLCURR;
LINELINE = .LINENUM(LINLCURR);
END; ! of SKIPDL
GLOBAL ROUTINE CONTPRINT=
!++
! FUNCTIONAL DESCRIPTION:
!
! Print any comment lines that have not previously been printed.
!
! This routine is called when it is discovered that the current
! source line is a continuation line.
!
! FORMAL PARAMETERS:
!
! None
!
! IMPLICIT INPUTS:
!
! LINLCURR - Pointer to current entry in linked source list
! LASTCODELINE - Pointer to last linked list entry that had code
!
! IMPLICIT OUTPUTS:
!
! LINEPTR - Byte pointer to current line
! LINELINE - ISN of current line
!
! ROUTINE VALUE:
!
! None
!
! SIDE EFFECTS:
!
! Comment lines may be sent to listing file
!
!--
%2514% ! Copied from ACMCONTDIG on 23-Jan-85
BEGIN
IF .LASTCODELINE NEQ 0
THEN
BEGIN ! Print intervening lines
SAVEPTR = .CURPTR; ! So we don't disturb it
TEMP = .LASTCODELINE; ! Last non-comment line
! Back up to first unprinted line
WHILE .TEMP GEQ LINLLIST<0,0> AND NOT .PRINTED(TEMP)
DO TEMP = .TEMP - LINLSENT;
TEMP = .TEMP + LINLSENT;
! Print up to but not through current line
WHILE .TEMP LSS .LINLCURR
DO
BEGIN
PRINT(.TEMP);
TEMP = .TEMP + LINLSENT
END;
CURPTR = .SAVEPTR;
LINEPTR = .FIRSTBP(LINLCURR);
LINELINE = .LINENUM(LINLCURR)
END; ! Print intervening lines
END; ! of CONTPRINT
!---------------------------------------------------------------------------
! BEGIN ROUTINE LEXICA
!---------------------------------------------------------------------------
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;
% 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, 0);
%2241% NEXT = NONE;
END;
CASE .ACTION OF
SET
BEGIN ACMEOB END; ! 0
BEGIN ACMANY END; ! 1
BEGIN ACMTAB END; ! 2
BEGIN ACMHOLCONDONE END; ! 3
BEGIN ACMFMTHOLPKUP END; ! 4
BEGIN ACMHOLCON END; ! 5
BEGIN ACMREMEND END; ! 6
BEGIN ACMGOBAKNOW END; ! 7
BEGIN ACMLT END; ! 8
BEGIN ACMFMTHOLCK END; ! 9
BEGIN ACMGOBAKNXT END; ! 10
BEGIN ACMEXPLT END; ! 11
BEGIN ACMLEXFOS END; ! 12
BEGIN ACMRETNOW END; ! 13
%2241% BEGIN ACMCONTLT END; ! 14
BEGIN ACMCALCONT END; ! 15
BEGIN ACMCONTDIG END; ! 16
BEGIN ACMCLABSKP END; ! 17
BEGIN ACMENTREMARK END; ! 18
BEGIN ACMMULTST END; ! 19
BEGIN ACMINTERR END; ! 20
BEGIN ACMNOCONT END; ! 21
BEGIN ACMCITCONT END; ! 22
%2474% BEGIN ACMCALCLT END; ! 23
BEGIN ACMENTCLABSKP END; ! 24
BEGIN ACMCBUGCHK END; ! 25
BEGIN ACMUPLOW END; ! 26
BEGIN ACMCONSTSKP END; ! 27
BEGIN ACMSKNAME END; ! 28
BEGIN ACMSKLPAREN END; ! 29
BEGIN ACMSKRPAREN END; ! 30
BEGIN ACMSKCOMMA END; ! 31
BEGIN ACMGETLIT END; ! 32
BEGIN ACMENDLIT END; ! 33
BEGIN ACMBAKTOTERM END; ! 34
BEGIN ACMSKCONBLD END; ! 35
BEGIN ACMSKPHOLX END; ! 36
BEGIN ACMSKPHOL END; ! 37
BEGIN ACMHOLTAB END; ! 38
BEGIN ACMENTERM END; ! 39
BEGIN ACMUNMATEOS END; ! 40
BEGIN ACMFMTQT1 END; ! 41
BEGIN ACMSKILL END; ! 42
BEGIN ACMCLASLT END; ! 43
BEGIN ACMBADCHAR END; ! 44
BEGIN ACMSINGLEX END; ! 45
BEGIN ACMDOUBLEX END; ! 46
BEGIN ACMNOTDOUB END; ! 47
BEGIN ACMMAYBDOUB END; ! 48
BEGIN ACMENTIDENT END; ! 49
BEGIN ACMPKUPID END; ! 50
BEGIN ACMENDID END; ! 51
BEGIN ACMENTDOT END; ! 52
BEGIN ACMTRYREAL END; ! 53
BEGIN ACMMISOPER END; ! 54
BEGIN ACMGETOPER END; ! 55
BEGIN ACMOPCHK END; ! 56
BEGIN ACMMISOP1 END; ! 57
BEGIN ACMENTGETCONST END; ! 58
BEGIN ACMGOTINT END; ! 59
BEGIN ACMCHECKLET END; ! 60
BEGIN ACMBILDDBLINT END; ! 61
BEGIN ACMREALCON END; ! 62
BEGIN ACMENTRLBLDD END; ! 63
BEGIN ACMGOTREAL END; ! 64
BEGIN ACMEXDBCHK END; ! 65
BEGIN ACMGOTOP END; ! 66
BEGIN ACMCHKPLMI END; ! 67
BEGIN ACMNOEXP END; ! 68
BEGIN ACMINTEXP1 END; ! 69
BEGIN ACMFMTQT END; ! 70
BEGIN ACMGOTIEXP END; ! 71
BEGIN ACMHOLCHAR END; ! 72
BEGIN ACMHOLEND END; ! 73
BEGIN ACMENTLITLEX END; ! 74
BEGIN ACMLITEDCHK END; ! 75
BEGIN ACMTIC2CHK END; ! 76
BEGIN ACMENTOCTQ END; ! 77
BEGIN ACMNOOCT END; ! 78
BEGIN ACMCHKOCPM END; ! 79
BEGIN ACMOCTQ1 END; ! 80
BEGIN ACMGOTOCT END; ! 81
BEGIN ACMNOTIC END; ! 82
BEGIN ACMSCANCHAR END; ! 83
BEGIN ACMSTRCHK END; ! 84
BEGIN ACMSTOPLIT END; ! 85
BEGIN ACMFLEX1 END; ! 86
BEGIN ACMFMTEOS END; ! 87
BEGIN ACMFMTCHAR END; ! 88
%675% BEGIN ACMRIS END; ! 89
%742% BEGIN ACMSTOPINT END; ! 90
%742% BEGIN ACMGOT6INT END; ! 91
%742% BEGIN ACM6DIGIT END; ! 92
%1247% BEGIN ACMSKCOLON END; ! 93
%1465% BEGIN ACMKEYCHK END; ! 94
%1465% BEGIN ACMKEY1CHK END; ! 95
%2241% BEGIN ACMCONTBLANK END; ! 96
!---------------------------------------------------------------
! 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 LEXICA
END
ELUDOM