Trailing-Edge
-
PDP-10 Archives
-
BB-4157F-BM_1983
-
fortran/compiler/lexica.bli
There are 27 other files named lexica.bli in the archive. Click here to see a list.
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
! OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1973, 1983
!AUTHOR: D. B. TOLMAN/DCE/SJW/CKS/AHM/PY/PLB/RVM
MODULE LEXICAL(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4)=
BEGIN
GLOBAL BIND LEXICV = 7^24 + 0^18 + #1640; ! Version Date: 7-Oct-82
%(
***** 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 Revision History *****
)%
% LEXICAL.BLI MUST FIRST BE PROCESSED BY PRELEX.TEC, BEFORE COMPILATION
IF ANY STATES OR ACTION MACROS HAVE BEEN ADDED OR DELETED.
PRELEX.TEC USES LASTACT TO GENERATE THE LEXICAL CASE STATEMENT,
LASTBIG AND LASTSMAL TO GENERATE THE STATE TABLE PRESET PLIT
SKELETONS.
%
REQUIRE DBUGIT.REQ;
REQUIRE IOFLG.BLI;
FORWARD
LEXICAL(1);
EXTERNAL
BACKLINE,
BACKPRINT,
BACKTYPE,
BACKUP,
BAKSAV,
BAKSAVE,
BLDMSG,
CALLST,
CHAROUT,
%1213% CHLEN, ! Character count for character data
CLASHASH,
CODETAB,
CORMAN,
DECEXP,
DECREMENT,
DOTOPTAB,
DSCASGNMT,
DSCDO,
DSCDOUB,
DSCEND,
DSCIFARITH,
DSCIFBLOCK,
DSCIFLOGIC,
DSCPARAMT,
DSCSFAY,
DSCSUBASSIGN,
%1573% DSCWHILE,
E64,
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,
GCONTAB,
GDOUBLPREC,
GDUBOCT,
GETBUF,
%717% GIDTAB,
GINTEGER,
GLOGI,
GOCTAL,
GREAL,
HEADING,
INCREM,
LABREF,
%717% LEXL,
%1633% LINCNT, ! Number of source lines in program
LINEOUT,
LINESEQNO,
LOOK4CHAR,
LOOK4LABEL,
LITDEF,
MSGNOTYPD,
NAME,
NEWENTRY,
%717% NAMREF,
NUMFATL,
NUMWARN,
OVERFLOW,
OVRESTORE,
PAGE,
%717% PARAST,
PRINT,
SAVLINE,
SHIFTPOOL,
STALABL,
STMNDESC, ! Statement description block pointer
%1213% SYMTYPE,
TBLSEARCH,
TRACE,
TRACLEX,
%717% TYPTAB,
WARNERR,
WARNLEX,
WARNOPT;
! 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
OWN
TEMP, % TEMPORARY STORAGE WITHIN MACROS %
CHARTMP, % STORAGE FOR REGISTER CHAR UPON EXIT %
CODETMP; %STORAGE FOR REGISTER CODE UPON EXIT %
GLOBAL % LINE PROCESSING VARIABLES %
CLASLINE, ! LINE NUMBER OF BEGINNING OF CLASSIFICATION
CLASPOS; ! CHARACTER POSITION OF BEGINNING OF CLASSIFICATION
OWN FOUNDCR; ! INDICATES THAT A <CR> WAS ENCOUNTERED BEFORE THE
! LINE TERMINATOR WHICH TERMINATED THE REMARK STATE
! IF SET TO 1.
%[667]% GLOBAL INCLAS; !MAKE INCLAS A GLOBAL, NOT AN OWN
OWN VALUE, ! VALUE TO BE RETURNED AFTER SKIPPING TO NEXT SIGNIF CHAR
![667] INCLAS, ! IF 1 INDICATES THAT CLASIFICATION LOOKAHEAD IS TAKING PLACE
CLASERR, ! IF 1 INDICATES TO STSKIP THAT AN ILLEGAL CHARACTER
! WAS DETECTED IN CLASSIFICATION AND THAT STSKIP
! SHOULD ALSO DETECT IT AND REPORT IT
ZEROCHK, ! SET TO 1 IF A DIGIT WAS ENCOUNTERED IN THE LABEL FIELD
! USED TO CHECK FOR "0" LABEL
INCOMNT; ! IF 1 INDICATES THAT A COMMENT LINE IS BEING PROCESSED
%1245% OWN CHARCOUNT; ! Used to hold length of character constant
%1247% OWN COLONCOUNT; ! Number of zero-level colons skipped over by STTERM
%1573% OWN DOCHAR; ! Character after DO in classifier
!
! --------------------------------------------------
!
! FIRST WE NEED THE LEXEME AND CHARACTER CODE CLASS BINDS
!
! --------------------------------------------------
!
REQUIRE LEXNAM.BLI;
REQUIRE LEXAID.BLI;
!
! --------------------------------------------------
!
! NOW WE NEED THE ACTION NAME BINDS AND ACTION MACRO NAME ASSOCATIONS
!
! --------------------------------------------------
!
%ACTDEF%
! ACTION NUMBER BINDS AND ACTION MACRO ASSOCIATIONS
! TO THE LEXICAL CASE STATEMENT
!
! 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.
! ACTION ACTION
! NAME NUMBER
BIND ACTEOB = 0;
BIND ACTINIT = 1;
BIND ACTANYS = 2;
BIND ACTTABB = 3;
BIND ACTHOLCONDONE = 4 ;
BIND ACTFMTHOLPKUP = 5 ;
BIND ACTSTSKIP = 6;
BIND ACTTABS = 3;
BIND ACTHOLCON = 7 ;
BIND ACTREMEND = 8;
BIND ACTGOBAKNOW = 9;
BIND ACTLT = 10 ;
BIND ACTSTMNTFOS = 11;
BIND ACTANYB = 2 ;
BIND ACTFMTHOLCK = 12 ;
BIND ACTGOBAKNXT = 13 ;
BIND ACTEXPLT = 14 ;
BIND ACTLEXFOS = 15 ;
BIND ACTRETNOW = 16 ;
BIND ACTIGNCRCALC = 17 ;
BIND ACTCALCONT = 18 ;
BIND ACTCONTDIG = 19 ;
BIND ACTCLABSKP = 20 ;
BIND ACTNOEND = 21 ;
BIND ACTSTEOP = 22 ;
BIND ACTENTREMARK = 23 ;
BIND ACTMULTST = 24 ;
BIND ACTCLASF1 = 25 ;
BIND ACTMULTNULL = 26 ;
BIND ACTILLCHAR = 27 ;
BIND ACTCOMNT = 28 ;
BIND ACTDEBUG = 29 ;
BIND ACTCOMNTFOS = 30 ;
BIND ACTINTERR = 31 ;
BIND ACTNOCONT = 32 ;
BIND ACTNULLFOS = 33 ;
BIND ACTCITCONT = 34 ;
BIND ACTCLABLT = 35 ;
BIND ACTENTCLABSKP = 36 ;
BIND ACTCBUGCHK = 37 ;
BIND ACTENTLAB = 38 ;
BIND ACTILABILL = 39 ;
BIND ACTILABEDCK = 40 ;
BIND ACTILITCONT = 41 ;
BIND ACTILABDIG = 42 ;
BIND ACTILNTC = 43 ;
BIND ACTILNTI = 44 ;
BIND ACTILNTD = 45 ;
BIND ACTILITNC = 46 ;
BIND ACTILITC = 47 ;
BIND ACTILABLT = 48 ;
BIND ACTUPLOW = 49 ;
BIND ACTCONSTSKP = 50 ;
BIND ACTSKNAME = 51 ;
BIND ACTSKLPAREN = 52 ;
BIND ACTSKRPAREN = 53 ;
BIND ACTSKCOMMA = 54 ;
BIND ACTGETLIT = 55 ;
BIND ACTENDLIT = 56 ;
BIND ACTBAKTOTERM = 57 ;
BIND ACTSKCONBLD = 58 ;
BIND ACTSKPHOLX = 59 ;
BIND ACTSKPHOL = 60 ;
BIND ACTHOLTAB = 61 ;
BIND ACTENTERM = 62 ;
BIND ACTUNMATEOS = 63 ;
BIND ACTFMTQT1 = 64 ;
BIND ACTUNMATCHK = 65 ;
BIND ACTSKILL = 65 ;
BIND ACTCLASLT = 66 ;
BIND ACTCLASUNREC = 67 ;
BIND ACTCLILLCHAR = 68 ;
BIND ACTCLASBACK = 69 ;
BIND ACTCOMPAR = 70 ;
BIND ACTCLASAL1 = 71 ;
BIND ACTASGNMNT = 72 ;
BIND ACTCLASF2 = 73 ;
BIND ACTIFCHK = 74 ;
BIND ACTDOCHK = 75 ;
BIND ACTARITHIF = 76 ;
BIND ACTLOGICIF = 77 ;
BIND ACTUNMATUNREC = 78 ;
BIND ACTSTFNARRY = 79 ;
BIND ACTDOCHK1 = 80 ;
BIND ACTDOSTMNT = 81 ;
BIND ACTENDCHK = 82 ;
BIND ACTCLASF3 = 83 ;
BIND ACTCLASF4 = 84 ;
BIND ACTKEYTERM = 85 ;
BIND ACTUNMATKEY = 86 ;
BIND ACTSPELLING = 87 ;
BIND ACTBADCHAR = 88 ;
BIND ACTSINGLEX = 89 ;
BIND ACTDOUBLEX = 90 ;
BIND ACTNOTDOUB = 91 ;
BIND ACTMAYBDOUB = 92 ;
BIND ACTENTIDENT = 93 ;
BIND ACTPKUPID = 94 ;
BIND ACTENDID = 95 ;
BIND ACTENTDOT = 96 ;
BIND ACTTRYREAL = 97 ;
BIND ACTMISOPER = 98 ;
BIND ACTGETOPER = 99 ;
BIND ACTOPCHK = 100 ;
BIND ACTMISOP1 = 101 ;
BIND ACTENTGETCONST = 102 ;
BIND ACTGOTINT = 103 ;
BIND ACTCHECKLET = 104 ;
BIND ACTBILDDBLINT = 105 ;
BIND ACTREALCON = 106 ;
BIND ACTENTRLBLDD = 107 ;
BIND ACTGOTREAL = 108 ;
BIND ACTEXDBCHK = 109 ;
BIND ACTGOTOP = 110 ;
BIND ACTCHKPLMI = 111 ;
BIND ACTNOEXP = 112 ;
BIND ACTINTEXP1 = 113 ;
BIND ACTFMTQT = 114 ;
BIND ACTSUMIEXP = 58 ;
BIND ACTGOTIEXP = 115 ;
BIND ACTHOLCHAR = 116 ;
BIND ACTHOLEND = 117 ;
BIND ACTENTLITLEX = 118 ;
BIND ACTLITEDCHK = 119 ;
BIND ACTTIC2CHK = 120 ;
BIND ACTENTOCTQ = 121 ;
BIND ACTNOOCT = 122 ;
BIND ACTCHKOCPM = 123 ;
BIND ACTOCTQ1 = 124 ;
BIND ACTGOTOCT = 125 ;
BIND ACTNOTIC = 126 ;
BIND ACTSCANCHAR = 127 ;
BIND ACTSTRCHK = 128 ;
BIND ACTSTOPOCT = 129 ;
BIND ACTSTOPLIT = 130 ;
BIND ACTFLEX1 = 131 ;
BIND ACTFMTEOS = 132 ;
BIND ACTFMTCHAR = 133 ;
BIND ACTRIS = 134 ;
BIND ACTSTOPINT = 135 ;
BIND ACTGOT6INT = 136 ;
BIND ACT6DIGIT = 137 ;
BIND ACTTHENCHK = 138 ;
BIND ACTBLOCKIF = 139 ;
BIND ACTSUBCHK = 140 ;
BIND ACTSUBASSIGN = 141 ;
BIND ACTCLAS1A = 142 ;
BIND ACTSKCOLON = 143 ;
BIND ACTKEYSUB = 144 ;
BIND ACTKEYCHK = 145 ;
BIND ACTKEY1CHK = 146 ;
BIND ACTDOCHK2 = 147 ; ! [1573]
BIND ACTWHILECHK = 148 ; ! [1573]
BIND %%LASTACT = 149 ; ! [1573]
%USFMAC%
%HERE ARE A FEW USEFUL MACROS %
MACRO LINESEQBIT = @@CURPTR $ ;
!
! --------------------------------------------------
!
! NOW ONE CAN DEFINE THE "LEXICAL" 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 (ACTXXX).
! 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"), SUFFEXED BY THE INDEX
! OF BIGSTATE OR SMALSTATE TO WHICH THIS NAME IS BOUND FOLLOWING THE
! STATE TABLE PLITS, FURTHER SUFFEXED 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 "LEXICAL" IS DEFINED IN THIS SECTION IN TERMS
! OF STATES AND ACTION MACROS.
!
! --------------------------------------------------
!
! REQUIRED STRUCTURE FOR THE DEFINITION OF STATES AND ACTIONS:
!
! 1. ALL STATES WHICH ARE LEXICAL 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 INTERMS OF BIG CODES BEFORE
! RETURNING.
!
! 2.
!
!
! --------------------------------------------------
!
!------------------------------ UTILITY MACROS ------------------------------
%UTILMAC%
% A FEW UTILITY MACROS %
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;
IF DBUGIT THEN
BEGIN
IF ( CHAR_.BUGOUT AND #10 ) NEQ 0
THEN TRACLEX(VAL)
END;
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 ) =
STATESTACK [ .STSTKPTR ] _ RETURNTO;
STSTKPTR _ .STSTKPTR + 1;
STATE _ NXTSTATE
$;
%PUSH RETURN STATE ON THE STACK %
MACRO
CALL ( NXTSTATE ) =
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 =
GOBACK;
LEAVENXT
$;
% RETURN TO CALLING STATE %
MACRO
GOBACK =
STATE _ .STATESTACK [ STSTKPTR _ .STSTKPTR -1 ]
$;
MACRO DVTTY = 21,1$;
% 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]% EXTERNAL WRITECRLF;
%[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 ( SETCODE
LEAVE NEWSTATE
)
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
ACMTABB =
CHARPOS _ .CHARPOS AND NOT 7;
LEAVENXT
$;
% IGNORE THE TAB AND ADJUST CHARPOS %
% MACRO
ACMTABS =
CHARPOS _ .CHARPOS AND NOT 7;
LEAVE SMALCHAR
$;
%
% JUST IGNORE IT %
% MACRO
ACMANYB =
LEAVE BIGCHAR
$;
%
% JUST IGNORE IT %
MACRO
ACMANYS =
LEAVENXT
$;
% TRANSLATE TO UPPER CASE %
MACRO
ACMUPLOW =
CHAR _ .CHAR - #40;
SETCODE;
LEAVE NEWSTATE
$;
% ILLEGAL CHARACTER DETECTED IN THE STATEMENT FIELD %
MACRO
ACMILLCHAR =
% ILLEGAL CHARACTER IN SOURCE %
FATLERR ( .CHAR,.LINELINE, E8<0,0> );
REPLACEN ( CURPTR, "??" );
CALLR ( STSKIP, STSTMNT );
LEAVE BIGCHAR
$;
% ENTER THE REMARK STATE %
MACRO
ACMENTREMARK =
ENTREMARK;
LEAVE SMALCHAR
$;
% END OF A STATEMENT ON MULTIPLE STATEMENT LINE %
MACRO
ACMMULTST =
BEGIN
CHAR _ EOS;
CODE _ FOS;
LEAVE NEWSTATE
END $;
MACRO
EXTRACRCHK =
ISCAN ( CHAR, CURPTR );
IF ( CODE _ SMALCODE ) NEQ LT
THEN IF CHKXCR() NEQ LT
%[713]% THEN ( IF CODETYPE EQL B THEN CODE _ BIGCODE;
LEAVE NEWSTATE
);
$;
% HANDLE PRINTING LINE TERMINATORS %
MACRO
ACMLT =
IF .CHAR EQL CR
THEN ( EXTRACRCHK )
ELSE IF .FOUNDCR ! CR WAS FOUND IN REMARK PROCESSING
THEN FOUNDCR _ 0
ELSE NOCR _ 1;
PRINT ();
% CONTINUATION PROCESSING %
ENTCALCONT
$;
!------------------------------ CONTINUATION PROCESSING ------------------------------
% SMALL STATE DEFINITION STCALCONT NUMBER (#) 5S %
% CALCULATE THE NEXT LINE (OR LIN SEQ NO.) AND BEGIN PROCESSING
THE NEXT CONTINUATION FIELD. RETURN TO THE CALLING STATE WITH
THE FIRST CHARACTER OF THE STATEMENT FIELD IF ITS A CONTINUATION
OR WITH EOS IF ITS NOT %
% SKIP ALL NULLS AND CR'S%
BIND
ILL5S = ACTCALCONT ,
TAB5S = ACTCALCONT ,
LT5S = ACTIGNCRCALC ,
BLANK5S = ACTCALCONT ,
SPEC5S = ACTCALCONT ,
DIGIT5S = ACTCALCONT ,
UPPER5S = ACTCALCONT ,
LOWER5S = ACTCALCONT ,
FOS5S = ACTCALCONT ,
EOB5S = ACTEOB ,
REMARK5S = ACTCALCONT ;
% ENTER THE CONTINUATION PROCESSING AFTER COMPUTING LINE NUMBERS %
MACRO
ENTCALCONT =
CHARPOS _ 72;
LINEPTR _ .CURPTR; ! RECORD THE BEGINNING OF THE LINE
CALL ( STCALCONT );
LEAVE SMALCHAR; ! WITH THE NEXT CHARACTER
$;
% IGNORE CR'S FOLLOWING THE LINE TERMINATOR %
MACRO
ACMIGNCRCALC =
IF .CHAR EQL CR
THEN ( CHARPOS _ .CHARPOS - 1 ; ! ADJUST LINE POSITION
LEAVE SMALCHAR
)
ELSE ( % BEGIN CONTINUATION PROCESSING WITH THIS CHARACTER %
ACTION _ ACTCALCONT;
LEAVE NEWACTION;
)
$;
% CALCULATE LINE NUMBER ( OR LINE SEQUENCE NO) AND THEN BEGIN
CONTINUATION PROCESSING. RETURN TO THE CALLER
WITH THE FIRST CHARACTER OF THE STATEMENT FIELD IF ITS A CONTINUATION
LINE OR EOS IF ITS NOT %
MACRO
ACMCALCONT =
LASTLINE _ .LINELINE; ! SAVE LINE NUMBER
% CHECK FOR LINE SEQ NO. AND SET LINELINE %
IF LINESEQBIT % TEST LINE SEQ BIT %
THEN ( LINELINE _ LINESEQNO( CURPTR<ADRS> ); ! DECODE NUMBER
LINEPTR _ .CURPTR; ! ADJUST BEGINNING PTR
ISCAN ( CHAR , CURPTR )
)
ELSE % NO LINE SEQ NO %
LINELINE _ .LINELINE + 1
;
% RETURN IF YOU ARE PROCESSING A COMMENT %
IF .INCOMNT NEQ 0
THEN CODE _ FOS ! CAUSES STCONTINUE TO BELIEVE ITS HIT EOS
ELSE CODE _ BIGCODE;
CONTPTR _ .LINEPTR; ! SET CONTINUATION BACKUP PTR
STATE _ STCONTINUE; ! ENTER CONTINUATION PROCESSING
LEAVE NEWSTATE; ! WITH CURRENT CHARACTER
$;
!----------------------------------------------------------------------
! THE FOLLOWING STATES PROCESS THE CONTINUATION LINE CHECKING
% BIG STATE DEFINITION STCONTINUE NUMBER (#) 4B %
% 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]% ILL4B = ACTNOCONT ,
TAB4B = ACTCITCONT ,
LT4B = ACTCLABLT ,
BLANK4B = ACTENTCLABSKP ,
%[670]% SPEC4B = ACTNOCONT ,
%[670]% DIGIT4B = ACTNOCONT ,
%[670]% UPPER4B= ACTNOCONT ,
LOWER4B = ACTUPLOW ,
FOS4B = ACTNOCONT ,
EOB4B = ACTEOB ,
REMARK4B = ACTNOCONT ,
%[670]% EQUAL4B = ACTNOCONT ,
%[670]% LPAREN4B = ACTNOCONT ,
%[670]% RPAREN4B = ACTNOCONT ,
%[670]% COLON4B = ACTNOCONT ,
%[670]% COMMA4B = ACTNOCONT ,
DOLLAR4B = ACTNOCONT ,
ASTERISK4B = ACTNOCONT ,
SLASH4B = ACTNOCONT ,
%[670]% PLUS4B = ACTNOCONT ,
%[670]% MINUS4B = ACTNOCONT ,
%[670]% ANDSGN4B = ACTNOCONT ,
%[670]% LITSGN4B = ACTNOCONT ,
%[670]% OCTSGN4B = ACTNOCONT ,
%[670]% NEQSGN4B = ACTNOCONT ,
%[670]% DOT4B = ACTNOCONT ,
%[670]% SEMICOL4B = ACTNOCONT ,
%[670]% LTSGN4B = ACTNOCONT ,
%[670]% GTSGN4B = ACTNOCONT ,
COMNTSGN4B = ACTNOCONT ,
DEBUGSGN4B = ACTCBUGCHK ,
%[670]% UPAROW4B = ACTNOCONT ;
% SMALL STATE DEFINITION STCLABSKP NUMBER (#) 6S %
% CONTINUATION LINE CHECK, SKIP THE LABEL FIELD %
BIND
%[670]% ILL6S = ACTNOCONT ,
TAB6S = ACTCITCONT ,
LT6S = ACTCLABLT ,
BLANK6S = ACTCLABSKP ,
%[670]% SPEC6S = ACTNOCONT ,
%[670]% DIGIT6S = ACTNOCONT ,
%[670]% UPPER6S = ACTNOCONT ,
%[670]% LOWER6S = ACTNOCONT ,
FOS6S = ACTNOCONT ,
EOB6S = ACTEOB ,
%[670]% REMARK6S = ACTNOCONT ;
% SMALL STATE DEFINITION STCNTCONT NUMBER (#) 7S %
% CONTINUAATION FIELD, CONTINUATION CHECK, NO INITIAL TAB %
BIND
ILL7S = ACTNOCONT ,
TAB7S = ACTCITCONT ,
LT7S = ACTCLABLT ,
BLANK7S = ACTNOCONT ,
SPEC7S = ACTGOBAKNXT ,
DIGIT7S = ACTCONTDIG ,
UPPER7S = ACTGOBAKNXT ,
LOWER7S = ACTGOBAKNXT ,
FOS7S = ACTNOCONT ,
EOB7S = ACTEOB ,
REMARK7S = ACTGOBAKNXT ;
% SMALL STATE DEFINITION STCITCONT NUMBER (#) 8S %
% CONTINUATION FIELD, CONTINUATION LINE CHECK, INITIAL TAB %
BIND
ILL8S = ACTNOCONT ,
TAB8S = ACTNOCONT ,
LT8S = ACTCLABLT ,
BLANK8S = ACTNOCONT ,
SPEC8S = ACTNOCONT ,
DIGIT8S = ACTCONTDIG ,
UPPER8S = ACTNOCONT ,
LOWER8S = ACTNOCONT ,
FOS8S = ACTNOCONT ,
EOB8S = ACTEOB ,
REMARK8S = ACTNOCONT ;
!--------------------------------------------------
! CONTINUATION LINE LABEL FIELD PROCESSING MACROS
% ENTER STATE WHICH SKIPS THE CONTINUATION LABEL FIELD %
MACRO
ACMENTCLABSKP =
STATE _ STCLABSKP;
LEAVE SMALCHAR
$;
% DEBUG LINE IN CONTINUATION LOOKAHEAD %
MACRO
ACMCBUGCHK =
% CHECK THE INCLUDE SWITCH %
IF .FLGREG<INCLUDE>
THEN
BEGIN %ITS NOT A COMMENT PROCESS IT%
STATE _ STCLABSKP;
LEAVE SMALCHAR
END
ELSE
BEGIN % ITS A COMMENT %
ACTION _ ACTNOCONT ;
LEAVE NEWACTION
END
$;
% 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
$;
% LINE TERMINATORS FOR THE CONTINUATION LINE CHECK %
MACRO
ACMCLABLT =
!WE WANT TO IGNORE FORM FEEDS HERE - OTHERWISE THEY WILL
! PREVENT CONTINUATION LINES AFTERWARDS
IF NOT ( SPURCR() OR SPURFF())
THEN
BEGIN % A LINE TERMINATOR ENCOUNTERED BEFORE THE STATEMENT
FIELD IMPLIES NO CONTINUATION %
ACTION _ ACTNOCONT;
LEAVE NEWACTION
END
ELSE
BEGIN % ITS AN EXTRANEOUS CR %
% SET BIGCODE IF NECESSARY %
IF CODETYPE EQL B
THEN CODE _ BIGCODE;
LEAVE NEWSTATE
END
$;
% DIGIT IN CONTINUATION FIELD OR FOLLOWING INITIAL TAB %
MACRO
ACMCONTDIG =
IF .CHAR NEQ "0"
THEN
BEGIN % 1 THRU 9 ARE CONTINUATION INDICATORS %
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 =
CHARPOS _ 72;
CURPTR _ .CONTPTR;
IF .CHAR NEQ EOF THEN CHAR _ EOS;
CODE _ FOS ;
% RETURN TO CALLER %
GOBACK;
LEAVE NEWSTATE ;
$;
!------------------------------ REMARKS OR PAST POSITION 72 ------------------------------
%STMACS%
%BEGIN DEFINING THE SPECIFIC STATES AND THEIR ACTION MACROS %
% SMALL STATE DEFINITION STREMARK NUMBER (#) 0S %
!
! PROCESSES REMARKS FOLLOWING A "!" IN THE STATEMENT FIELD OR PAST
! CARACTER POSITION 72
!
BIND
ILL0S = ACTANYS ,
TAB0S = ACTANYS ,
LT0S = ACTREMEND ,
BLANK0S = ACTANYS ,
SPEC0S = ACTANYS ,
DIGIT0S = ACTANYS ,
UPPER0S = ACTANYS ,
LOWER0S = ACTANYS ,
FOS0S = ACTREMEND ,
EOB0S = ACTEOB ,
REMARK0S = ACTANYS ;
% ENTER THE REMARK STATE %
MACRO
ENTREMARK =
CALL (STREMARK);
$;
% LINE TERMINATION PROCESSING FOR REMARK STATE %
MACRO
ACMREMEND =
IF .CHAR EQL CR
THEN ( EXTRACRCHK;
FOUNDCR _ 1
);
% RETURN TO CALLING STATE %
GOBACK;
LEAVE NEWSTATE
$;
!------------------------------ FIRST PROGRAM UNIT INITIALIZATION ------------------------------
% SMALL STATE DEFINITION STINIT NUMBER (#) 1S %
% INITILIZATION OF LEXICAL AT THE BEGINNING OF THE FIRST PROGRAM UNIT %
BIND
ILL1S = ACTINIT ,
TAB1S = ACTINIT ,
LT1S = ACTINIT ,
BLANK1S = ACTINIT ,
SPEC1S = ACTINIT ,
DIGIT1S = ACTINIT ,
UPPER1S = ACTINIT ,
LOWER1S = ACTINIT ,
FOS1S = ACTINIT ,
EOB1S = ACTEOB ,
REMARK1S = ACTINIT ;
% INITIALIZE LINELINE AND LEXICAL AFTER SKIPPING ALL NULLS AND CR'S%
MACRO
ACMINIT =
% HANDLE EOF %
IF .CODE EQL FOS THEN RETURN ENDOFILE<0,0>;
% IGNORE INITIAL CR'S %
IF .CHAR EQL CR
THEN ( CHARPOS _ .CHARPOS -1 ;
LEAVE SMALCHAR
);
IF LINESEQBIT %IS SET THEN ITS A LINE SEQUENCE NO %
THEN LINELINE _ LINESEQNO ( CURPTR<ADRS> )
ELSE ( IF NOT .FLGREG<ININCLUD> THEN LINELINE _ 1;
DECREMENT ( CURPTR<ADRS> )
);
CHARTMP _ EOS;
CHARPOS _ 72;
LINEPTR _ .CURPTR;
RETURN NOT ENDOFILE<0,0>
$;
!------------------------------ NEW STATEMENT ------------------------------
% BIG STATE DEFINITION STSTMNT NUMBER (#) 0B %
% THIS IS THE STATEMENT CLASSIFICATION ENTRY POINT. IT WILL FIRST
SKIP ANY OF THE LAST STATEMENT WHICH WASN'T READ IN, SKIP ALL
COMMENTS, NULL STATEMENTS, UNRECOGNIZED STATEMENTS, UNTIL FINALLY
IT CAN CLASSIFY A STATEMENT OR END OF FILE IS REACHED. IT WILL
RETURN WITH THE CLASSIFICATION OR END OF FILE.
%
BIND
ILL0B = ACTSTSKIP ,
TAB0B = ACTSTSKIP ,
LT0B = ACTSTSKIP ,
BLANK0B = ACTSTSKIP ,
SPEC0B = ACTSTSKIP ,
DIGIT0B = ACTSTSKIP ,
UPPER0B = ACTSTSKIP ,
LOWER0B = ACTSTSKIP ,
FOS0B = ACTSTMNTFOS ,
EOB0B = ACTEOB ,
REMARK0B = ACTSTSKIP ,
EQUAL0B = ACTSTSKIP ,
LPAREN0B = ACTSTSKIP ,
RPAREN0B = ACTSTSKIP ,
COLON0B = ACTSTSKIP ,
COMMA0B = ACTSTSKIP ,
DOLLAR0B = ACTSTSKIP ,
ASTERISK0B = ACTSTSKIP ,
SLASH0B = ACTSTSKIP ,
PLUS0B = ACTSTSKIP ,
MINUS0B = ACTSTSKIP ,
ANDSGN0B = ACTSTSKIP ,
LITSGN0B = ACTSTSKIP ,
OCTSGN0B = ACTSTSKIP ,
NEQSGN0B = ACTSTSKIP ,
DOT0B = ACTSTSKIP ,
SEMICOL0B = ACTSTSKIP ,
LTSGN0B = ACTSTSKIP ,
GTSGN0B = ACTSTSKIP ,
COMNTSGN0B = ACTSTSKIP ,
DEBUGSGN0B = ACTSTSKIP ,
UPAROW0B = ACTSTSKIP ;
% CHECK HERE TO SEE THAT THERE HAS BEEN AN ERROR MESSAGE %
MACRO
ACMSTSKIP =
IF ( NOT .MSGNOTYPD AND NOT .ERRFLAG ) OR .CLASERR NEQ 0
THEN % THE STATEMENT WAS NOT PROCESSID TO THE END AND
NO MESSAGE WAS TYPED, SO %
IF .CLASERR NEQ 0
THEN
BEGIN % CLASSIFIER WILL RETURN HERE IF IT CANNOT RECOGNIZE THE STATEMENT %
FATLERR ( .ISN, E10<0,0> );
CLASERR _ 0
END
ELSE
BEGIN % ALL OTHER STATEMENTS SHOULD BE PROCESSED FULLY
OR HAVE AN ERROR MESSAGE OUTPUT %
INTERR ('STSKIP')
END;
%SKIP TO EOS %
CALLR ( STSKIP ,STSTMNT);
LEAVE NEWSTATE
$;
ROUTINE INITLZSTMNT =
BEGIN
! Initialization for the beginning of a statement
! Output messages for multiple statements
IF NOT .FLGREG<TTYDEV> AND .CHARPOS NEQ 72
AND ( .ERRFLAG OR .MSGNOTYPD )
THEN
BEGIN ! There are messages or lines to be output to TTY
LOCAL PTR;
! Type or finish typing the statement unless /NOERROR.
%1653% IF NOT .FLGREG<NOERRORS> THEN
BACKTYPE ( ALLCHAR );
! Now output any messages
MSGNOTYPD _ 0; ! Clear "messages to be typed" flag
PTR _ .ERRLINK<RIGHT>;
UNTIL .PTR<RIGHT> EQL 0
DO
BEGIN ! Message loop
IF NOT .ERRTYPD( PTR )
THEN
BEGIN ! The message was not yet typed, so type it
REGISTER MSG;
MACHOP OUTSTR = #051;
MSG _ BLDMSG ( .ERRMSG[.EMSGNUM(PTR)],.PTR<RIGHT>);
%1653% IF NOT .FLGREG<NOERRORS> THEN ! unless /NOERROR
%1565% OUTTYX(MSG);
ERRTYPD(PTR) _ 1
END;
PTR _ @@PTR
END ! Message loop
END; ! There are messages or lines to be output to tty
LEXLINE _ .LINELINE; ! MUST BE SET IN CASE WE GOT HERE AFTER SKIPING THE LAST STATEMENT
ERRFLAG _ 0;
STPOS _ .CHARPOS; ! LINE POSITION OF CHARACTER
ISN _ .LINELINE; ! LINE NUMBER
STPTR _ .CURPTR; ! BEGINNING CHARACTER POSITION
STLPTR _ .LINEPTR; ! BEGINNING OF LINE
STALABL _ 0;
ZEROCHK _ 0; ! SET TO 1 IF DIGIT ENCOUNTERED IN THE
! LABEL FIELD, USED TO CHECK FOR ZERO LABEL
%1633% LINCNT = .LINCNT + 1; ! Count the line
END; ! of INITLZSTMNT
% EOF AND EOS HANDLING FOR THE BEGINNING OF THE STATEMENT %
MACRO
ACMSTMNTFOS =
% THIS IS WHERE THE STATEMENT INITIALIZATION TAKES PLACE %
IF .CHAR EQL EOF
THEN ( RETURNOW ( ENDOFILE<0,0>)
% THIS IS THE ONLY PLACE EOF IS RETURNED FROM EXCEPT LEXINI %
)
ELSE
( %EOS SO BEGIN A NEW STATEMENT %
INITLZSTMNT();
% CHECK FOR MULTIPLE STATEMENTS %
IF .CHARPOS NEQ 72
THEN
BEGIN % IT IS MULTIPLE SO PROCEED TO NULL STATEMENT %
STATE _ STNULLST;
LEAVE SMALCHAR
END
ELSE
BEGIN
STATE _ STILINE; ! PROCEED TO INITIAL LINE PROCESSING
LEAVE BIGCHAR
END
)
$;
!------------------------------ NORMAL END OF PROGRAM UNIT ------------------------------
% BIG STATE DEFINITION STEOP NUMBER (#) 6B %
% IT IS THE END OF THE PROGRAM UNIT SO SKIP TO THE END OF THE CURRENT
STATEMENT AND BRING THINGS UP TO DATE %
BIND
ILL6B = ACTINTERR ,
TAB6B = ACTINTERR ,
LT6B = ACTINTERR ,
BLANK6B = ACTINTERR ,
SPEC6B = ACTINTERR ,
DIGIT6B = ACTINTERR ,
UPPER6B = ACTINTERR ,
LOWER6B = ACTINTERR ,
FOS6B = ACTSTEOP ,
EOB6B = ACTEOB ,
REMARK6B = ACTINTERR ,
EQUAL6B = ACTINTERR ,
LPAREN6B = ACTINTERR ,
RPAREN6B = ACTINTERR ,
COLON6B = ACTINTERR ,
COMMA6B = ACTINTERR ,
DOLLAR6B = ACTINTERR ,
ASTERISK6B = ACTINTERR ,
SLASH6B = ACTINTERR ,
PLUS6B = ACTINTERR ,
MINUS6B = ACTINTERR ,
ANDSGN6B = ACTINTERR ,
LITSGN6B = ACTINTERR ,
OCTSGN6B = ACTINTERR ,
NEQSGN6B = ACTINTERR ,
DOT6B = ACTINTERR ,
SEMICOL6B = ACTINTERR ,
LTSGN6B = ACTINTERR ,
GTSGN6B = ACTINTERR ,
COMNTSGN6B = ACTINTERR ,
DEBUGSGN6B = ACTINTERR ,
UPAROW6B = ACTINTERR ;
% WE ARE AT THE END OF THE LAST STATEMENT IN THE PROGRAM UNIT %
MACRO
ACMSTEOP =
IF .CHAR EQL EOF
THEN
BEGIN
IF .CHARPOS LSS 71
THEN % PARTIAL LINE LEFT TO BE PRINTED %
BEGIN
DECREMENT ( CURPTR<ADRS> );
PRINT()
END;
RETURN ENDOFILE<0,0>
END;
%ELSE EOS
PRINT PARTIAL LINE IF ANY AND THEN INITIALIZE FOR THE NEXT STATEMENT%
IF .CHARPOS NEQ 72
THEN
BEGIN % THIS STATEMENT DOES NOT START AT THE BEGINNING OF A LINE %
% PRINT BEGINNING OF LINE %
PRINT ();
END;
INITLZSTMNT(); ! NEW STATEMENT INITIALIZATION
RETURN NOT ENDOFILE<0,0>
$;
!------------------------------ MISSING "END". END OF PROGRAM UNIT ------------------------------
% BIG STATE DEFINITION STNOEND NUMBER (#) 5B %
% THIS PROGRAM UNIT HAS NO END STATEMENT SO BACK UP TO THE BEGINNING
OF THE CURRENT STATEMENT BECAUSE IT BELONGS WITH THE NEXT PROGRAM
UNIT AND THEN TRANSFER CONTROL TO THE NORMAL END OF PROGRAM PROCESSING %
BIND
ILL5B = ACTNOEND ,
TAB5B = ACTNOEND ,
LT5B = ACTNOEND ,
BLANK5B = ACTNOEND ,
SPEC5B = ACTNOEND ,
DIGIT5B = ACTNOEND ,
UPPER5B = ACTNOEND ,
LOWER5B = ACTNOEND ,
FOS5B = ACTNOEND ,
EOB5B = ACTNOEND ,
REMARK5B = ACTNOEND ,
EQUAL5B = ACTNOEND ,
LPAREN5B = ACTNOEND ,
RPAREN5B = ACTNOEND ,
COLON5B = ACTNOEND ,
COMMA5B = ACTNOEND ,
DOLLAR5B = ACTNOEND ,
ASTERISK5B = ACTNOEND ,
SLASH5B = ACTNOEND ,
PLUS5B = ACTNOEND ,
MINUS5B = ACTNOEND ,
ANDSGN5B = ACTNOEND ,
LITSGN5B = ACTNOEND ,
OCTSGN5B = ACTNOEND ,
NEQSGN5B = ACTNOEND ,
DOT5B = ACTNOEND ,
SEMICOL5B = ACTNOEND ,
LTSGN5B = ACTNOEND ,
GTSGN5B = ACTNOEND ,
COMNTSGN5B = ACTNOEND ,
DEBUGSGN5B = ACTNOEND ,
UPAROW5B = ACTNOEND ;
MACRO
ACMNOEND =
IF .CHAR EQL EOF
THEN
BEGIN
ACTION _ ACTSTEOP;
LEAVE NEWACTION
END
ELSE
BEGIN % BACK UP TO THE BEGINNING OF THE STATEMENT %
CURPTR _ .STPTR;
CHARPOS _ .STPOS;
LINELINE _ .ISN;
% CHECK TO SEE IF THERE MIGHT BE SOME PORTION UNPRINTED%
IF .CHARPOS NEQ 72
THEN % ITS POSSIBLE %
IF .LINEPTR EQL .STLPTR
THEN % IT HASN'T BEEN PRINTED %
PRINT();
ERRFLAG _ 0 ; ! CLEARED SO INITLZ DOSEN'T TRY TO PRINT
! A STATEMENT WHOSE END IT DOSEN'T KNOW
LINEPTR _ .STLPTR ;
INITLZSTMNT(); ! INITIALIZE THE STATEMENT
RETURN NOT ENDOFILE<0,0>
END;
$;
!------------------------------ STATEMENT SKIPPING ------------------------------
!----------------------------------------------------------------------
% BIG STATE DEFINITION STSKIP NUMBER (#) 3B %
BIND
ILL3B = ACTSKILL ,
TAB3B = ACTTABB ,
LT3B = ACTLT ,
BLANK3B = ACTANYB ,
SPEC3B = ACTANYB ,
DIGIT3B = ACTENTERM ,
UPPER3B = ACTENTERM ,
LOWER3B = ACTENTERM ,
FOS3B = ACTUNMATEOS ,
EOB3B = ACTEOB ,
REMARK3B = ACTENTREMARK ,
EQUAL3B = ACTANYB ,
LPAREN3B = ACTENTERM ,
RPAREN3B = ACTUNMATCHK ,
COLON3B = ACTANYB ,
COMMA3B = ACTANYB ,
DOLLAR3B = ACTANYB ,
ASTERISK3B = ACTANYB ,
SLASH3B = ACTANYB ,
PLUS3B = ACTANYB ,
MINUS3B = ACTANYB ,
ANDSGN3B = ACTANYB ,
LITSGN3B = ACTENTERM ,
OCTSGN3B = ACTANYB ,
NEQSGN3B = ACTANYB ,
DOT3B = ACTANYB ,
SEMICOL3B = ACTMULTST ,
LTSGN3B = ACTANYB ,
GTSGN3B = ACTANYB ,
COMNTSGN3B = ACTENTERM ,
DEBUGSGN3B = ACTENTERM ,
UPAROW3B = ACTANYB ;
!----------------------------------------------------------------------
! THE FOLLOWING MACROS CONTROL THE SKIPPING OF STATEMENTS
% PROBABLY AN UNMATCHED ). REPORT ONLY IF .CLASERR %
! MACRO
!ACMUNMATCHK =
! IF .CLASERR NEQ 0
! THEN
! BEGIN % UNMATCHED ) %
! FATLERR (.ISN,E9<0,0>);
! CLASERR _ 0
! END;
! LEAVE BIGCHAR
!$;
! THIS ROUTINE IS INCLUDED IN ACMSKILL
% 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 (#) 7B %
% SKIPS OVER LEXICAL CONSTRUCTS - %
BIND
ILL7B = ACTGOBAKNOW ,
TAB7B = ACTTABB ,
LT7B = ACTEXPLT ,
BLANK7B = ACTANYB ,
SPEC7B = ACTANYB ,
DIGIT7B = ACTCONSTSKP ,
UPPER7B = ACTSKNAME ,
LOWER7B = ACTSKNAME ,
FOS7B = ACTGOBAKNOW ,
EOB7B = ACTEOB ,
REMARK7B = ACTENTREMARK ,
EQUAL7B = ACTANYB ,
LPAREN7B = ACTSKLPAREN ,
RPAREN7B = ACTSKRPAREN ,
COLON7B = ACTSKCOLON ,
COMMA7B = ACTSKCOMMA ,
DOLLAR7B = ACTANYB ,
ASTERISK7B = ACTANYB ,
SLASH7B = ACTANYB ,
PLUS7B = ACTANYB ,
MINUS7B = ACTANYB ,
ANDSGN7B = ACTANYB ,
LITSGN7B = ACTGETLIT ,
OCTSGN7B = ACTANYB ,
NEQSGN7B = ACTANYB ,
DOT7B = ACTANYB ,
SEMICOL7B = ACTMULTST ,
LTSGN7B = ACTANYB ,
GTSGN7B = ACTANYB ,
COMNTSGN7B = ACTSKNAME ,
DEBUGSGN7B = ACTSKNAME ,
UPAROW7B = ACTANYB ;
% SMALL STATE DEFINITION STGETLIT NUMBER (#) 13S %
% PICKS UP ' LITERALS %
BIND
ILL13S = ACTANYS ,
TAB13S = ACTTABS ,
LT13S = ACTEXPLT ,
BLANK13S = ACTANYS ,
SPEC13S = ACTENDLIT ,
DIGIT13S = ACTANYS ,
UPPER13S = ACTANYS ,
LOWER13S = ACTANYS ,
FOS13S = ACTGOBAKNOW ,
EOB13S = ACTEOB ,
REMARK13S = ACTANYS ;
% SMALL STATE DEFINITION STSKNAME NUMBER (#) 14S %
% SKIPS IDENTIFIERS %
BIND
ILL14S = ACTGOBAKNOW ,
TAB14S = ACTTABS ,
LT14S = ACTEXPLT ,
BLANK14S = ACTANYS ,
SPEC14S = ACTBAKTOTERM ,
DIGIT14S = ACTANYS ,
UPPER14S = ACTANYS ,
LOWER14S = ACTANYS ,
FOS14S = ACTGOBAKNOW ,
EOB14S = ACTEOB ,
REMARK14S = ACTENTREMARK ;
% SMALL STATE DEFINITION STCONSTSKP NUMBER (#) 15S %
% SKIPS CONSTANTS FOLLOWED BY H ( HOLERITH ) OR X FOR FORMATS %
BIND
ILL15S = ACTGOBAKNOW ,
TAB15S = ACTTABS ,
LT15S = ACTEXPLT ,
BLANK15S = ACTANYS ,
SPEC15S = ACTBAKTOTERM ,
DIGIT15S = ACTSKCONBLD ,
UPPER15S = ACTSKPHOLX ,
LOWER15S = ACTUPLOW ,
FOS15S = ACTGOBAKNOW ,
EOB15S = ACTEOB ,
REMARK15S = ACTENTREMARK ;
% SMALL STATE DEFINITION STSKPHOL NUMBER (#) 16S %
BIND
ILL16S = ACTSKPHOL ,
TAB16S = ACTHOLTAB ,
LT16S = ACTEXPLT ,
BLANK16S = ACTSKPHOL ,
SPEC16S = ACTSKPHOL ,
DIGIT16S = ACTSKPHOL ,
UPPER16S = ACTSKPHOL ,
LOWER16S = ACTSKPHOL ,
FOS16S = ACTGOBAKNOW ,
EOB16S = ACTEOB ,
REMARK16S = ACTSKPHOL ;
!----------------------------------------------------------------------
! THE FOLLOWING ACTIONS CONTROL THE SKIPPING OF LEXICAL CONSTRUCTS %
% 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
$;
OWN PAREN; ! COUNT OF PARENS FOR CLASSIFICATION AND SKIPPING
% 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
$;
GLOBAL MSNGTIC; ! THIS FLAG IS SET IF THERE IS WHAT APPEARS TO BE AN
! UNTERMINATED LIT STRING. THE CLASSIFIER WILL THEN
! LET UNMATCHED PARENS GO BY SO THAT IT CAN CLASSIFY
! IO STATEMENTS WITH THE DAMN IBM ' RECORD MARK IN THEM
% 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
$;
OWN HOLCONST; ! HOLDS THE CONSTANT FOR SKIPPING HOLERITHS
% BUILD THE CONSTANT %
MACRO
ACMSKCONBLD =
HOLCONST _ .HOLCONST*10 + ( .CHAR - "0" );
LEAVE SMALCHAR
$;
% CHECK FOR HOLERITH OR X FOLLOWING THE CONSTANT %
MACRO
ACMSKPHOLX =
STATE _ STTERM;
IF .CHAR EQL "X"
THEN
BEGIN % SKIP THE X %
LEAVE BIGCHAR
END;
IF .CHAR EQL "H" AND .HOLCONST GTR 0
THEN
BEGIN % HOLERITH %
STATE _ STSKPHOL;
LEAVE SMALCHAR
END;
% ELSE JUST SKIP THE CONSTANT %
LEAVE NEWSTATE
$;
% SKIP .HOLCONST CHARACTERS OF HOLERITH STRING %
MACRO
ACMSKPHOL =
IF (HOLCONST _ .HOLCONST - 1 ) NEQ 0
THEN LEAVE SMALCHAR ! SKIP IT
ELSE
BEGIN
% HOLERITH HAS BEEN PASSED OVER %
STATE _ STTERM;
LEAVE BIGCHAR
END
$;
% ADJUST FOR TABS IN HOLERITH %
MACRO
ACMHOLTAB =
CHARPOS _ .CHARPOS AND NOT 7;
CODE _ BLANK; ! SEMANTICLY EQUIVALENT TO BLANK
LEAVE NEWSTATE
$;
!----------------------------------------------------------------------
! INITIAL LINE PROCESSING
% BIG STATE DEFINITION STILINE NUMBER (#) 1B %
% BEGIN PROCESSING AN INITIAL LINE
THIS IS CHARACTER POS 1 OF A STATEMENT WHICH BEGINS AT THE
BEGINNING OF A LINE %
BIND
ILL1B = ACTILABILL ,
TAB1B = ACTILITCONT ,
LT1B = ACTILABLT ,
BLANK1B = ACTENTLAB ,
SPEC1B = ACTILABILL ,
DIGIT1B = ACTENTLAB ,
UPPER1B = ACTILABILL ,
LOWER1B = ACTUPLOW ,
FOS1B = ACTSTMNTFOS ,
EOB1B = ACTEOB ,
REMARK1B = ACTCOMNT ,
EQUAL1B = ACTILABILL ,
LPAREN1B = ACTILABILL ,
RPAREN1B = ACTILABILL ,
COLON1B = ACTILABILL ,
COMMA1B = ACTILABILL ,
DOLLAR1B = ACTCOMNT ,
ASTERISK1B = ACTCOMNT ,
SLASH1B = ACTCOMNT ,
PLUS1B = ACTILABILL ,
MINUS1B = ACTILABILL ,
ANDSGN1B = ACTILABILL ,
LITSGN1B = ACTILABILL ,
OCTSGN1B = ACTILABILL ,
NEQSGN1B = ACTILABILL ,
DOT1B = ACTILABILL ,
SEMICOL1B = ACTILABILL ,
LTSGN1B = ACTILABILL ,
GTSGN1B = ACTILABILL ,
COMNTSGN1B = ACTCOMNT ,
DEBUGSGN1B = ACTDEBUG ,
UPAROW1B = ACTILABILL ;
!----------------------------------------------------------------------
! INITIAL LINE LABEL AND CONTINUATION FIELDS
% SMALL STATE DEFINITION STILABEL NUMBER (#) 9S %
% PICKS UP CHARACTER POSITIONS OF THE LABEL FIELD AND ANY DIGITS %
BIND
ILL9S = ACTILABILL ,
TAB9S = ACTILITCONT ,
LT9S = ACTILABLT ,
BLANK9S = ACTILABEDCK ,
SPEC9S = ACTILABILL ,
DIGIT9S = ACTILABDIG ,
UPPER9S = ACTILABILL ,
LOWER9S = ACTILABILL ,
FOS9S = ACTILABLT ,
EOB9S = ACTEOB ,
REMARK9S = ACTILABILL ;
% SMALL STATE DEFINITION STLABSKP NUMBER (#) 10S %
% SKIPS THE LABEL FIELD OF INITIAL LINES FOUND TO HAVE ILLEGAL CHARACTERS %
BIND
ILL10S = ACTILABEDCK ,
TAB10S = ACTILITCONT ,
LT10S = ACTILABLT ,
BLANK10S = ACTILABEDCK ,
SPEC10S = ACTILABEDCK ,
DIGIT10S = ACTILABEDCK ,
UPPER10S = ACTILABEDCK ,
LOWER10S = ACTILABEDCK ,
FOS10S = ACTILABLT ,
EOB10S = ACTEOB ,
REMARK10S = ACTILABEDCK ;
% SMALL STATE DEFINITION STILNTCONT NUMBER (#) 11S %
% CHECK THE CONTINUATION FIELD OF AN INITIAL LINE , NO INITIAL TAB %
BIND
ILL11S = ACTILNTC ,
TAB11S = ACTILITCONT ,
LT11S = ACTILABLT ,
BLANK11S = ACTILNTI ,
SPEC11S = ACTILNTC ,
DIGIT11S = ACTILNTD ,
UPPER11S = ACTILNTC ,
LOWER11S = ACTILNTC ,
FOS11S = ACTILABLT ,
EOB11S = ACTEOB ,
REMARK11S = ACTILNTC ;
% SMALL STATE DEFINITION STILITCONT NUMBER (#) 12S %
% INITIAL LINE, FIRST CHARACTER AFTER INITIAL TAB %
BIND
ILL12S = ACTILITNC ,
TAB12S = ACTILITNC ,
LT12S = ACTILABLT ,
BLANK12S = ACTILITNC ,
SPEC12S = ACTILITNC ,
DIGIT12S = ACTILITC ,
UPPER12S = ACTILITNC ,
LOWER12S = ACTILITNC ,
FOS12S = ACTILITNC ,
EOB12S = ACTEOB ,
REMARK12S = ACTILITNC ;
!----------------------------------------------------------------------
! MACROS TO PROCESS THE LABEL FIELD OF THE INITIAL LINE
% ENTER THE LABEL PROCESSING STATE %
MACRO
ACMENTLAB =
STATE _ STILABEL;
LEAVE NEWSTATE
$;
% ILLEGAL CHARACTER IN THE LABEL FIELD %
MACRO
ACMILABILL =
STALABL _ 0;
ZEROCHK _ 0; !CLEAR ALL FLAGS ASSOCIATED WITH LABELS
FATLERR (.CHAR,.LINELINE,E7<0,0> );
REPLACEN( CURPTR,"??" );
STATE _ STLABSKP;
CODE _ SMALCODE;
LEAVE NEWSTATE
$;
% CHECK FOR THE END OF THE LABEL FIELD %
MACRO
ACMILABEDCK =
IF .CHARPOS NEQ 67 ! POSITION 5
THEN LEAVE SMALCHAR
ELSE
BEGIN % END OF THE LABEL FIELD %
STATE _ STILNTCONT; ! GOTO NO INITIAL TAB CONT FLD CHECK
LEAVE SMALCHAR
END
$;
% ENTER THE INITIAL LINE , INITIAL TAB CONTINUATION FIELD CHECK %
MACRO
ACMILITCONT =
STATE _ STILITCONT;
LEAVE SMALCHAR
$;
% LINE TERMINATORS FOR THE LABEL FIELD OF INITIAL LINES %
MACRO
ACMILABLT =
IF NOT SPURCR()
THEN
BEGIN % A LINE TERMINATOR IMPLIES AN INITIAL LINE %
STATE _ STNULLST ;
LEAVE NEWSTATE
END
ELSE
BEGIN %SPURIOUS CR %
IF CODETYPE EQL B % BIG %
THEN CODE _ BIGCODE;
LEAVE NEWSTATE
END
$;
% BUILD THE LABEL%
MACRO
ACMILABDIG =
ZEROCHK _ 1; ! NOTE THAT A DIGIT WAS FOUND
STALABL _ ( .STALABL * 10 ) + ( .CHAR - "0" );
IF .CHARPOS NEQ 67
THEN LEAVE SMALCHAR
ELSE
BEGIN % END OF THE LABEL FIELD %
STATE _ STILNTCONT;
LEAVE SMALCHAR
END
$;
% CONTINUATION CHARACTER IN INITIAL LINE %
MACRO
ACMILNTC =
% TEMPORARY%
WARNERR ( .LINELINE,E109<0,0>);
STATE _ STNULLST;
LEAVE SMALCHAR
$;
% BLANK OR TAB IN THE CONTINUATION FIELD %
MACRO
ACMILNTI =
STATE _ STNULLST;
LEAVE NEWSTATE ! DON'T PICK UP THE NEXT CHAR SO AS TO ALLOW NULLST TO ADJUST FOR TABS
$;
% DIGIT IN CONTINUATION FIELD %
MACRO
ACMILNTD =
IF .CHAR EQL "0"
THEN
BEGIN % INITIAL LINE %
STATE _ STNULLST;
LEAVE SMALCHAR
END
ELSE
BEGIN % CONTINUATION CHARACTER %
ACTION _ ACTILNTC;
LEAVE NEWACTION
END
$;
% NON CONTINUATION CHARACTER FOLLOWING TAB %
MACRO
ACMILITNC =
CHARPOS _ 65; ! 7TH CHARACTER POSITION
STATE _ STNULLST;
LEAVE NEWSTATE
$;
% DIGIT FOLLOWING TAB ON INITIAL LINE %
MACRO
ACMILITC =
STATE _ STNULLST;
IF .CHAR NEQ "0"
THEN
BEGIN % INITIAL LINE HAS CONTINUATION CHARACTER %
WARNERR ( .LINELINE, E109<0,0>);
CHARPOS _ 66; ! 6TH CHARACTER POSITION
LEAVE SMALCHAR
END
ELSE
BEGIN % OK ITS A ZERO %
CHARPOS _ 65; ! 7TH CARACTER POSITION
LEAVE SMALCHAR
END
$;
MACRO
ACMCOMNT =
INCOMNT _ 1;
CALLR (STREMARK,STCOMNT);
LEAVE SMALCHAR
$;
MACRO
ACMDEBUG =
IF NOT .FLGREG<INCLUDE>
THEN
BEGIN
INCOMNT _ 1;
CALLR ( STREMARK, STCOMNT ); ! TREAT AS COMMENT LINE
LEAVE SMALCHAR
END
ELSE
BEGIN
STATE _ STILABEL; ! PROCESS THE LABEL FIELD
LEAVE SMALCHAR
END
$;
!------------------------------ COMMENT LINES ------------------------------
% SMALL STATE DEFINITION STCOMNT NUMBER (#) 4S %
BIND
ILL4S = ACTINTERR ,
TAB4S = ACTINTERR ,
LT4S = ACTLT ,
BLANK4S = ACTINTERR ,
SPEC4S = ACTINTERR ,
DIGIT4S = ACTINTERR ,
UPPER4S = ACTINTERR ,
LOWER4S = ACTINTERR ,
FOS4S = ACTCOMNTFOS ,
%[713]% EOB4S = ACTEOB ,
REMARK4S = ACTINTERR ;
% END OF THE COMMENT LINE %
MACRO
ACMCOMNTFOS =
INCOMNT _ 0;
ACTION _ ACTSTMNTFOS;
LEAVE NEWACTION
$;
!------------------------------ NULL STATEMENT CHECK ------------------------------
% SMALL STATE DEFINITION STNULLST NUMBER (#) 3S %
% THIS STATE WILL SKIP ALL BLANKS AN TABS TO THE FIRST
SIGNIFICANT CHARACTER OF THE STATEMENT FIELD. IF IT THEN ENCOUNTERS
EOS IT IS A NULL STATEMENT AND CONTROL WILL BE TRANSFERED BACK TO
STSTMNT TO PROCESS THE NEXT STATEMENT. OTHERWISE CONTROL IS TRANSFERED
TO THE CLASSIFIER TO CLASSIFY THE STATEMENT. %
BIND
ILL3S = ACTILLCHAR ,
TAB3S = ACTTABS ,
LT3S = ACTLT ,
BLANK3S = ACTANYS ,
SPEC3S = ACTMULTNULL ,
DIGIT3S = ACTMULTNULL ,
UPPER3S = ACTCLASF1 ,
LOWER3S = ACTUPLOW ,
FOS3S = ACTNULLFOS ,
EOB3S = ACTEOB ,
REMARK3S = ACTENTREMARK ;
% CHECK FOR MULTIPLE STATEMENT TERMINATOR %
MACRO
ACMMULTNULL =
BEGIN
IF .CHAR EQL ";"
THEN % YOU GOT ONE %
BEGIN CHAR _ EOS;
CODE _ FOS;
LEAVE NEWSTATE
END
ELSE
BEGIN % UNRECOGNIZED STATEMENT %
CLASERR _ 1;
ACTION _ ACTSTSKIP;
LEAVE NEWACTION
END
END $;
% CHECK TO SEE THAT THE NULL STATEMENT IS UNLABELED %
MACRO
ACMNULLFOS =
IF .STALABL NEQ 0 OR .ZEROCHK NEQ 0
THEN
BEGIN % CAN'T HAVE LABELED NULL STATEMENTS %
FATLERR (PLIT'NULL?0', .ISN,E110<0,0>)
END;
ACTION _ ACTSTMNTFOS;
LEAVE NEWACTION
$;
!------------------------------ CLASSIFICATION STATES ------------------------------
% BIG STATE DEFINITION STCLASF2 NUMBER (#) 8B %
% CHARACTER 2, WE HAVE <ALPHA> %
BIND
ILL8B = ACTCLILLCHAR ,
TAB8B = ACTTABB ,
LT8B = ACTCLASLT ,
BLANK8B = ACTANYB ,
SPEC8B = ACTCLASUNREC ,
DIGIT8B = ACTCLASAL1 ,
UPPER8B = ACTCLASF2 ,
LOWER8B = ACTUPLOW ,
FOS8B = ACTCLASUNREC ,
EOB8B = ACTEOB ,
REMARK8B = ACTENTREMARK ,
EQUAL8B = ACTASGNMNT ,
%1247% LPAREN8B = ACTCLAS1A ,
RPAREN8B = ACTCLASUNREC ,
COLON8B = ACTCLASUNREC ,
COMMA8B = ACTCLASUNREC ,
DOLLAR8B = ACTCLASUNREC ,
ASTERISK8B = ACTCLASUNREC ,
SLASH8B = ACTCLASUNREC ,
PLUS8B = ACTCLASUNREC ,
MINUS8B = ACTCLASUNREC ,
ANDSGN8B = ACTCLASUNREC ,
LITSGN8B = ACTCLASUNREC ,
OCTSGN8B = ACTCLASUNREC ,
NEQSGN8B = ACTCLASUNREC ,
DOT8B = ACTCLASUNREC ,
SEMICOL8B = ACTCLASUNREC ,
LTSGN8B = ACTCLASUNREC ,
GTSGN8B = ACTCLASUNREC ,
COMNTSGN8B = ACTCLASF2 ,
DEBUGSGN8B = ACTCLASF2 ,
UPAROW8B = ACTCLASUNREC ;
% BIG STATE DEFINITION STCLASAL1 NUMBER (#) 9B %
% WE HAVE *<ALPHANUM> CLASSIFY AS TO ASSIGNMENT OR STFN/ARRY %
BIND
ILL9B = ACTCLILLCHAR ,
TAB9B = ACTTABB ,
LT9B = ACTCLASLT ,
BLANK9B = ACTANYB ,
SPEC9B = ACTCLASUNREC ,
DIGIT9B = ACTANYB ,
UPPER9B = ACTANYB ,
LOWER9B = ACTANYB ,
FOS9B = ACTCLASUNREC ,
EOB9B = ACTEOB ,
REMARK9B = ACTENTREMARK ,
EQUAL9B = ACTASGNMNT ,
%1247% LPAREN9B = ACTCLAS1A ,
RPAREN9B = ACTCLASUNREC ,
COLON9B = ACTCLASUNREC ,
COMMA9B = ACTCLASUNREC ,
DOLLAR9B = ACTCLASUNREC ,
ASTERISK9B = ACTCLASUNREC ,
SLASH9B = ACTCLASUNREC ,
PLUS9B = ACTCLASUNREC ,
MINUS9B = ACTCLASUNREC ,
ANDSGN9B = ACTCLASUNREC ,
LITSGN9B = ACTCLASUNREC ,
OCTSGN9B = ACTCLASUNREC ,
NEQSGN9B = ACTCLASUNREC ,
DOT9B = ACTCLASUNREC ,
SEMICOL9B = ACTCLASUNREC ,
LTSGN9B = ACTCLASUNREC ,
GTSGN9B = ACTCLASUNREC ,
COMNTSGN9B = ACTANYB ,
DEBUGSGN9B = ACTANYB ,
UPAROW9B = ACTCLASUNREC ;
% SMALL STATE DEFINITION STCLASF3 NUMBER (#) 17S %
% THIRD ALPHA CHARACTER %
% LOOKING FOR POSSIBLE "DO" OR "IF" %
BIND
ILL17S = ACTCLILLCHAR ,
TAB17S = ACTTABS ,
LT17S = ACTCLASLT ,
BLANK17S = ACTANYS ,
SPEC17S = ACTIFCHK ,
DIGIT17S = ACTDOCHK ,
%1573% UPPER17S = ACTDOCHK ,
LOWER17S = ACTUPLOW ,
FOS17S = ACTCLASUNREC ,
EOB17S = ACTEOB ,
REMARK17S = ACTENTREMARK ;
% BIG STATE DEFINITION STIFCHK NUMBER (#) 10B %
% WE HAVE "IF" "(" <EXP> ")" %
BIND
ILL10B = ACTCLILLCHAR ,
TAB10B = ACTTABB ,
LT10B = ACTCLASLT ,
BLANK10B = ACTANYB ,
SPEC10B = ACTCLASUNREC ,
DIGIT10B = ACTARITHIF ,
UPPER10B = ACTTHENCHK ,
LOWER10B = ACTUPLOW ,
FOS10B = ACTCLASUNREC ,
EOB10B = ACTEOB ,
REMARK10B = ACTENTREMARK ,
%1247% EQUAL10B = ACTSUBCHK ,
%1247% LPAREN10B = ACTSUBASSIGN ,
RPAREN10B = ACTCLILLCHAR ,
COLON10B = ACTCLASUNREC ,
COMMA10B = ACTCLASUNREC ,
DOLLAR10B = ACTCLASUNREC ,
ASTERISK10B = ACTCLASUNREC ,
SLASH10B = ACTCLASUNREC ,
PLUS10B = ACTCLASUNREC ,
MINUS10B = ACTCLASUNREC ,
ANDSGN10B = ACTCLASUNREC ,
LITSGN10B = ACTCLASUNREC ,
OCTSGN10B = ACTCLASUNREC ,
NEQSGN10B = ACTCLASUNREC ,
DOT10B = ACTCLASUNREC ,
SEMICOL10B = ACTCLASUNREC ,
LTSGN10B = ACTCLASUNREC ,
GTSGN10B = ACTCLASUNREC ,
COMNTSGN10B = ACTLOGICIF ,
DEBUGSGN10B = ACTLOGICIF ,
UPAROW10B = ACTCLASUNREC ;
% SMALL STATE DEFINITION STTHENCHK NUMBER (#) 43S %
% WE HAVE "IF(" <EXPRESSION> ")" <LETTER> CHECK FOR "THEN" %
BIND
ILL43S = ACTTHENCHK ,
TAB43S = ACTTABS ,
LT43S = ACTCLASLT ,
BLANK43S = ACTANYS ,
SPEC43S = ACTTHENCHK ,
DIGIT43S = ACTTHENCHK ,
UPPER43S = ACTTHENCHK ,
LOWER43S = ACTUPLOW ,
FOS43S = ACTTHENCHK ,
EOB43S = ACTEOB ,
REMARK43S = ACTENTREMARK ;
% BIG STATE DEFINITION STDOCHK1 NUMBER (#) 11B %
% WE HAVE "DO" <DIGIT> %
BIND
ILL11B = ACTCLILLCHAR ,
TAB11B = ACTTABB ,
LT11B = ACTCLASLT ,
BLANK11B = ACTANYB ,
SPEC11B = ACTSPELLING ,
DIGIT11B = ACTANYB ,
UPPER11B = ACTANYB ,
LOWER11B = ACTANYB ,
%1573% FOS11B = ACTSPELLING ,
EOB11B = ACTEOB ,
REMARK11B = ACTENTREMARK ,
EQUAL11B = ACTDOCHK1 ,
%1573% LPAREN11B = ACTDOCHK2 ,
RPAREN11B = ACTSPELLING ,
COLON11B = ACTSPELLING ,
%1573% COMMA11B = ACTANYB ,
DOLLAR11B = ACTSPELLING ,
ASTERISK11B = ACTSPELLING ,
SLASH11B = ACTSPELLING ,
PLUS11B = ACTSPELLING ,
MINUS11B = ACTSPELLING ,
ANDSGN11B = ACTSPELLING ,
LITSGN11B = ACTSPELLING ,
OCTSGN11B = ACTSPELLING ,
NEQSGN11B = ACTSPELLING ,
DOT11B = ACTSPELLING ,
SEMICOL11B = ACTSPELLING ,
LTSGN11B = ACTSPELLING ,
GTSGN11B = ACTSPELLING ,
COMNTSGN11B = ACTANYB ,
DEBUGSGN11B = ACTANYB ,
UPAROW11B = ACTSPELLING ;
% BIG STATE DEFINITION STDOCHK2 NUMBER (#) 12B %
% WE HAVE "DO" <ALPHANUM> "=" <TERM> %
BIND
ILL12B = ACTCLILLCHAR ,
TAB12B = ACTTABB ,
LT12B = ACTCLASLT ,
BLANK12B = ACTANYB ,
SPEC12B = ACTANYB ,
DIGIT12B = ACTENTERM ,
UPPER12B = ACTENTERM ,
LOWER12B = ACTENTERM ,
FOS12B = ACTUNMATKEY ,
EOB12B = ACTEOB ,
REMARK12B = ACTENTREMARK ,
EQUAL12B = ACTANYB ,
LPAREN12B = ACTENTERM ,
RPAREN12B = ACTCLILLCHAR ,
COLON12B = ACTANYB ,
COMMA12B = ACTDOSTMNT ,
DOLLAR12B = ACTANYB ,
ASTERISK12B = ACTANYB ,
SLASH12B = ACTANYB ,
PLUS12B = ACTANYB ,
MINUS12B = ACTANYB ,
ANDSGN12B = ACTANYB ,
LITSGN12B = ACTENTERM ,
OCTSGN12B = ACTANYB ,
NEQSGN12B = ACTANYB ,
DOT12B = ACTANYB ,
SEMICOL12B = ACTMULTST ,
LTSGN12B = ACTANYB ,
GTSGN12B = ACTANYB ,
COMNTSGN12B = ACTENTERM ,
DEBUGSGN12B = ACTENTERM ,
UPAROW12B = ACTANYB ;
%[1573]%
% SMALL STATE DEFINITION STDOCHK3 NUMBER (#) 46S %
% WE HAVE "DO" <LETTERS & DIGITS> ( ... ) %
% CHECK FOR DO WHILE %
BIND
ILL46S = ACTCLILLCHAR ,
TAB46S = ACTTABS ,
LT46S = ACTCLASLT ,
BLANK46S = ACTANYS ,
SPEC46S = ACTWHILECHK ,
DIGIT46S = ACTWHILECHK ,
UPPER46S = ACTWHILECHK ,
LOWER46S = ACTWHILECHK ,
FOS46S = ACTWHILECHK ,
EOB46S = ACTEOB ,
REMARK46S = ACTENTREMARK ;
% BIG STATE DEFINITION STCLASF4 NUMBER (#) 15B %
% WE HAVE 3*<ALPHA> %
BIND
ILL15B = ACTCLILLCHAR ,
TAB15B = ACTTABB ,
LT15B = ACTCLASLT ,
BLANK15B = ACTANYB ,
SPEC15B = ACTCLASUNREC ,
DIGIT15B = ACTCLASAL1 ,
UPPER15B = ACTCLASF4 ,
LOWER15B = ACTUPLOW ,
FOS15B = ACTENDCHK ,
EOB15B = ACTEOB ,
REMARK15B = ACTENTREMARK ,
EQUAL15B = ACTASGNMNT ,
%1247% LPAREN15B = ACTCLAS1A ,
RPAREN15B = ACTCLASUNREC ,
COLON15B = ACTCLASUNREC ,
COMMA15B = ACTCLASUNREC ,
DOLLAR15B = ACTCLASUNREC ,
ASTERISK15B = ACTCLASUNREC ,
SLASH15B = ACTCLASUNREC ,
PLUS15B = ACTCLASUNREC ,
MINUS15B = ACTCLASUNREC ,
ANDSGN15B = ACTCLASUNREC ,
LITSGN15B = ACTCLASUNREC ,
OCTSGN15B = ACTCLASUNREC ,
NEQSGN15B = ACTCLASUNREC ,
DOT15B = ACTCLASUNREC ,
SEMICOL15B = ACTMULTST ,
LTSGN15B = ACTCLASUNREC ,
GTSGN15B = ACTCLASUNREC ,
COMNTSGN15B = ACTCLASF4 ,
DEBUGSGN15B = ACTCLASF4 ,
UPAROW15B = ACTCLASUNREC ;
% BIG STATE DEFINITION STCLASAL2 NUMBER (#) 13B %
% WE HAVE < 4 LETTERS OF A KEY WORD > %
BIND
ILL13B = ACTCLILLCHAR ,
TAB13B = ACTTABB ,
LT13B = ACTCLASLT ,
BLANK13B = ACTANYB ,
SPEC13B = ACTSPELLING ,
DIGIT13B = ACTANYB ,
UPPER13B = ACTANYB ,
LOWER13B = ACTANYB ,
FOS13B = ACTSPELLING ,
EOB13B = ACTEOB ,
REMARK13B = ACTENTREMARK ,
EQUAL13B = ACTASGNMNT ,
LPAREN13B = ACTKEYTERM ,
RPAREN13B = ACTCLILLCHAR ,
COLON13B = ACTSPELLING ,
COMMA13B = ACTSPELLING ,
DOLLAR13B = ACTSPELLING ,
ASTERISK13B = ACTSPELLING ,
SLASH13B = ACTSPELLING ,
PLUS13B = ACTSPELLING ,
MINUS13B = ACTSPELLING ,
ANDSGN13B = ACTSPELLING ,
LITSGN13B = ACTSPELLING ,
OCTSGN13B = ACTSPELLING ,
NEQSGN13B = ACTSPELLING ,
DOT13B = ACTSPELLING ,
SEMICOL13B = ACTSPELLING ,
LTSGN13B = ACTSPELLING ,
GTSGN13B = ACTSPELLING ,
COMNTSGN13B = ACTANYB ,
DEBUGSGN13B = ACTANYB ,
UPAROW13B = ACTSPELLING ;
% BIG STATE DEFINITION STCLASAL1A NUMBER (#) 19B % ![1247] New
% WE HAVE <ALPHANUM>* "(" <EXP> ")" %
BIND
ILL19B = ACTCLILLCHAR ,
TAB19B = ACTTABB ,
LT19B = ACTCLASLT ,
BLANK19B = ACTANYB ,
SPEC19B = ACTCLASUNREC ,
DIGIT19B = ACTCLASUNREC ,
UPPER19B = ACTCLASUNREC ,
LOWER19B = ACTCLASUNREC ,
FOS19B = ACTCLASUNREC ,
EOB19B = ACTEOB ,
REMARK19B = ACTENTREMARK ,
EQUAL19B = ACTSUBCHK ,
LPAREN19B = ACTSUBASSIGN ,
RPAREN19B = ACTCLILLCHAR ,
COLON19B = ACTCLASUNREC ,
COMMA19B = ACTCLASUNREC ,
DOLLAR19B = ACTCLASUNREC ,
ASTERISK19B = ACTCLASUNREC ,
SLASH19B = ACTCLASUNREC ,
PLUS19B = ACTCLASUNREC ,
MINUS19B = ACTCLASUNREC ,
ANDSGN19B = ACTCLASUNREC ,
LITSGN19B = ACTCLASUNREC ,
OCTSGN19B = ACTCLASUNREC ,
NEQSGN19B = ACTCLASUNREC ,
DOT19B = ACTCLASUNREC ,
SEMICOL19B = ACTMULTST ,
LTSGN19B = ACTCLASUNREC ,
GTSGN19B = ACTCLASUNREC ,
COMNTSGN19B = ACTCLASUNREC ,
DEBUGSGN19B = ACTCLASUNREC ,
UPAROW19B = ACTCLASUNREC ;
% BIG STATE DEFINITION STCLASAL2A NUMBER (#) 14B %
% WE HAVE < 4 LETTERS OF KEY WORD > < ALPHANUM> "(" <EXP> ")" %
BIND
ILL14B = ACTCLILLCHAR ,
TAB14B = ACTTABB ,
LT14B = ACTCLASLT ,
BLANK14B = ACTANYB ,
SPEC14B = ACTSPELLING ,
DIGIT14B = ACTSPELLING ,
UPPER14B = ACTSPELLING ,
LOWER14B = ACTSPELLING ,
FOS14B = ACTUNMATKEY ,
EOB14B = ACTEOB ,
REMARK14B = ACTENTREMARK ,
%1247% EQUAL14B = ACTSUBCHK ,
%1247% LPAREN14B = ACTKEYSUB ,
RPAREN14B = ACTCLILLCHAR ,
COLON14B = ACTSPELLING ,
COMMA14B = ACTSPELLING ,
DOLLAR14B = ACTSPELLING ,
ASTERISK14B = ACTSPELLING ,
SLASH14B = ACTSPELLING ,
PLUS14B = ACTSPELLING ,
MINUS14B = ACTSPELLING ,
ANDSGN14B = ACTSPELLING ,
LITSGN14B = ACTSPELLING ,
OCTSGN14B = ACTSPELLING ,
NEQSGN14B = ACTSPELLING ,
DOT14B = ACTSPELLING ,
SEMICOL14B = ACTSPELLING ,
LTSGN14B = ACTSPELLING ,
GTSGN14B = ACTSPELLING ,
COMNTSGN14B = ACTSPELLING ,
DEBUGSGN14B = ACTSPELLING ,
UPAROW14B = ACTSPELLING ;
% BIG STATE DEFINITION STCLASAL1B NUMBER (#) 20B % ![1247] New
% WE HAVE <KEYWORD> "(" <EXP> ")" "(" <EXP> ")" %
% SUBSTRING ASSIGNMENT IF FOLLOWED BY "=", ELSE KEYWORD STATEMENT %
BIND
ILL20B = ACTCLILLCHAR ,
TAB20B = ACTTABB ,
LT20B = ACTCLASLT ,
BLANK20B = ACTANYB ,
SPEC20B = ACTSPELLING ,
DIGIT20B = ACTSPELLING ,
UPPER20B = ACTSPELLING ,
LOWER20B = ACTSPELLING ,
FOS20B = ACTSPELLING ,
EOB20B = ACTSPELLING ,
REMARK20B = ACTSPELLING ,
EQUAL20B = ACTSUBASSIGN ,
LPAREN20B = ACTSPELLING ,
RPAREN20B = ACTSPELLING ,
COLON20B = ACTSPELLING ,
COMMA20B = ACTSPELLING ,
DOLLAR20B = ACTSPELLING ,
ASTERISK20B = ACTSPELLING ,
SLASH20B = ACTSPELLING ,
PLUS20B = ACTSPELLING ,
MINUS20B = ACTSPELLING ,
ANDSGN20B = ACTSPELLING ,
LITSGN20B = ACTSPELLING ,
OCTSGN20B = ACTSPELLING ,
NEQSGN20B = ACTSPELLING ,
DOT20B = ACTSPELLING ,
SEMICOL20B = ACTSPELLING ,
LTSGN20B = ACTSPELLING ,
GTSGN20B = ACTSPELLING ,
COMNTSGN20B = ACTSPELLING ,
DEBUGSGN20B = ACTSPELLING ,
UPAROW20B = ACTSPELLING ;
% SMALL STATE DEFINITION STSPELLING NUMBER (#) 18S %
% CHECK THE SPELLING OF THE KEY WORD, IGNORING BLANKS AND TABS %
BIND
ILL18S = ACTCOMPAR ,
TAB18S = ACTTABS ,
LT18S = ACTLT ,
BLANK18S = ACTANYS ,
SPEC18S = ACTCOMPAR ,
DIGIT18S = ACTCOMPAR ,
UPPER18S = ACTCOMPAR ,
LOWER18S = ACTUPLOW ,
FOS18S = ACTCOMPAR ,
EOB18S = ACTEOB ,
REMARK18S = ACTENTREMARK ;
!----------------------------------------------------------------------
! THE FOLLOWING MACROS CONTROL THE PROCESSING OF STATEMENT CLASSIFICATION
% LINE TERMINATORS DURING CLASSIFICATION LOOKAHEAD SHOULD BE
DETECTED BUT NOT CAUSE PRINTING %
MACRO
ACMCLASLT =
IF .CHAR EQL CR
THEN
BEGIN % IGNORE THE CR %
ISCAN (CHAR, CURPTR );
LEAVE NEWSTATE
END
ELSE
BEGIN % CHECK FOR CONTINUATION BUT NO PRINTING %
IF .INCLAS EQL 0 THEN SAVLINE(); ! FOR NON-CLASSIFICATION BACKUP
ENTCALCONT
END
$;
% UNRECOGNIZED STATEMENT %
MACRO
ACMCLASUNREC =
CLASERR _ 1; ! CAUSES ACTSTSKP TO PRINT UNRECOGNIZED MESSAGE
% CHECK FOR LOGICAL IF CLASSIFICATION %
IF .LGIFCLAS NEQ 0
THEN ( STATE _ STRETNX; VALUE _ ENDOFILE<ADRS> )
ELSE STATE _ STSTMNT;
ACTION _ ACTCLASBACK;
LEAVE NEWACTION
$;
OWN LGIFCLAS; ! IF 1 THEN CLASSIFYING THE OBJECT OF A LOGICAL IF
% BACKUP AND GO TO SKIP STATEMENT WHICH WILL DETECT AND REPORT
THE ERROR %
MACRO
ACMCLILLCHAR =
CLASERR _ 1;
% CHECK FOR LOGICAL IF CLASSIFICATION %
IF .LGIFCLAS NEQ 0
THEN ( STATE _ STRETNX; VALUE _ ENDOFILE<ADRS> )
ELSE ( CALLR ( STSKIP,STSTMNT) );
ACTION _ ACTCLASBACK;
LEAVE NEWACTION
$;
% RESTORE THE INPUT STREAM TO POSITION BEFORE CLASSIFICATION
AND PROCEED TO THE STATE WHICH WAS SET BY THE ACTION
WHICH EXECUTED THIS ACTION %
MACRO
ACMCLASBACK =
CURPTR _ .CLASPTR;
LINELINE _ .CLASLINE;
CHARPOS _ .CLASPOS;
LINEPTR _ .CLASLPT;
PAREN _ 0;
INCLAS _ 0;
LEAVENXT ! FIRST CHARACTER OF STATEMENT
$;
% SET FLAG FOR LOGICAL IF CLASSIFICATION %
MACRO
ACMCLASF1 =
IF .STATE EQL STIFCLASIF
THEN LGIFCLAS _ 1
ELSE LGIFCLAS _ 0;
% ENTER THE CLASSIFIER WITH FIRST LETTER OF THE STATEMENT %
% CHECK FOR STATEMENTS LABELED WITH 0 %
IF .STALABL EQL 0 AND .ZEROCHK NEQ 0
THEN FATLERR ( .ISN, E19<0,0> ); ! LABEL WAS ZERO
STMNDESC _ 0; ! CLEAR FOR PURPOSES OF RECOGNIZING THE PARAMETER STATEMENT
INCLAS _ 1;
CLASERR _ 0;
NAME _ .CHAR;
%1247% COLONCOUNT _ 0;
% SAVE POSITION FOR BACKUP %
CLASPTR _ .CURPTR;
DECREMENT (CLASPTR<ADRS> ); ! POINTS TO 1ST CHAR -1
CLASLINE _ .LINELINE;
CLASPOS _ .CHARPOS + 1;
CLASLPT _ .LINEPTR ;
% BEGIN CLASSIFICATION %
STATE _ STCLASF2;
LEAVE BIGCHAR
$;
% ENTER ALGORITHM 1 WHICH CHECKS FOR ASSIGNMENT OR
STATEMENT FN / ARRAY REF OR [1247] SUBSTRING ASSIGNMENT %
MACRO
ACMCLASAL1 =
STATE _ STCLASAL1;
LEAVE NEWSTATE ! WITH CURRENT CHARACTER
$;
% [1247] WE HAVE <IDENTIFIER> ( %
% SKIP OVER THE PARENTHESIZED STRING (COUNTING ZERO-LEVEL COLONS)
AND CHECK THE CHARACTER AFTER THE CORRESPONDING RIGHT PAREN %
MACRO
ACMCLAS1A =
PAREN _ 1;
CALLR (STTERM, STCLASAL1A);
LEAVE BIGCHAR
$;
% WE HAVE AN ASSIGNMENT STATEMENT %
MACRO
ACMASGNMNT =
IF .STMNDESC EQL DSCPARAMT<0,0>
THEN
BEGIN %MAY BE A PARAMETER STATEMENT%
ACTION _ ACTSPELLING;
LEAVE NEWACTION
END;
STMNDESC _ DSCASGNMT<ADRS>;
STATE _ STRETNX; ! RETURN - NOT END OF FILE
VALUE _ NOT ENDOFILE<0,0>;
ACTION _ ACTCLASBACK;
LEAVE NEWACTION
$;
% SECOND ALPHABETIC CHARACTER %
MACRO
ACMCLASF2 =
NAME _ .NAME^7 + .CHAR;
STATE _ STCLASF3; ! WHAT IS THE 3RD
LEAVE SMALCHAR
$;
% THE THIRD CHARACTER OF THE STATEMENT WAS A SPECIAL CHARACTER
SO LETS SEE IF WE HAVE AN "IF" %
MACRO
ACMIFCHK =
IF .NAME EQL "IF" AND .CHAR EQL "("
THEN
BEGIN % POSSIBLE IF %
CALLR ( STTERM, STIFCHK ); ! SKIP WHATEVER IS IN ()
PAREN _ 1; ! THE FIRST WAS JUST PICKED UP
POINTER _ (UPLIT 'THEN?0')<36,7>; ! INIT POINTER FOR THENCHK
LEAVE BIGCHAR
END
ELSE
BEGIN % TRY ASSIGNMENT OR STFN/ARRAY %
STATE _ STCLASAL1;
CODE _ BIGCODE;
LEAVE NEWSTATE
END
$;
![1214], routine to distinguish logical IF and block IF
! POINTER has been set to asciz "THEN" by ACMIFCHK
! Here from STIFCHK on any letter after IF (...)
! and from STTHENCHK on any character after IF (...) T (or TH or THE or THEN)
! Check for match against THEN <EOS>. If it matches, block IF; if not, logical
MACRO
ACMTHENCHK =
REGISTER R;
STATE _ STTHENCHK; ! ENTER SMALL STATE TO SCAN FOR THEN
ISCAN (R,POINTER); ! GET NEXT CHAR OF "THEN"
IF .CHAR EQL .R THEN LEAVE SMALCHAR ! MATCH
ELSE
BEGIN ! HERE ON FIRST DIFFERENCE
! HAVE R = FIRST CHAR THAT DIFFERED,
! CHAR = DIFFERING CHAR FROM THE SOURCE
IF .R EQL 0 AND (.CHAR EQL EOS OR .CHAR EQL ";")
THEN ACTION _ ACTBLOCKIF
ELSE ACTION _ ACTLOGICIF;
LEAVE NEWACTION;
END
$;
% THE FIRST 2 CHARACTERS WERE ALPHA AND THE 3RD A DIGIT
SO HOW ABOUT A "DO" %
MACRO
ACMDOCHK =
IF .NAME EQL "DO"
THEN
BEGIN %POSSIBLY , LETS CHECK FOR ZERO LEVEL COMMA %
%1573% DOCHAR _ .CHAR; ! Save char after "DO"
%1573% STMNDESC _ DSCDOUB<0,0>; ! Set STMNDESC in case this turns
%1573% ! out to be DOUBLE PRECISION statement
STATE _ STDOCHK1;
LEAVE BIGCHAR
END
ELSE
BEGIN % NOT DO %
%1573% ACTION _ ACTCLASF3;
%1573% LEAVE NEWACTION
END
$;
% WE HAVE AN ARITHMETIC IF %
MACRO
ACMARITHIF =
STMNDESC _ DSCIFARITH<ADRS>;
ACTION _ ACTSPELLING; ! SKIPS OVER AND PRINTS THE IF
LEAVE NEWACTION
$;
% LOGICAL IF STATEMENT %
MACRO
ACMLOGICIF =
STMNDESC _ DSCIFLOGIC<ADRS>;
ACTION _ ACTSPELLING; ! SKIPS OVER AND PRINTS THE IF
LEAVE NEWACTION;
$;
% BLOCK IF STATEMENT %
MACRO
ACMBLOCKIF =
STMNDESC _ DSCIFBLOCK<ADRS>;
ACTION _ ACTSPELLING; ! SKIPS OVER AND PRINTS THE IF
LEAVE NEWACTION;
$;
% THIS IS EITHER AN UNRECOGNIZED STATEMENT OR UNMATCHED "(" %
MACRO
ACMUNMATUNREC =
IF .PAREN NEQ 0
THEN ACTION _ ACTCLILLCHAR ! UNMATCHED
ELSE ACTION _ ACTCLASUNREC; ! UNRECOGNIZED STATEMENT
LEAVE NEWACTION
$;
% STATEMENT FUNCTION OR ARRAY REFERENCE %
MACRO
ACMSTFNARRY =
% CANNOT TELL YET %
STMNDESC _ DSCSFAY<ADRS>;
VALUE _ NOT ENDOFILE<0,0>;
STATE _ STRETNX; ! RETURN
ACTION _ ACTCLASBACK;
LEAVE NEWACTION
$;
% [1247] STATEMENT FUNCTION/ARRAY REFERENCE OR SUBSTRING ASSIGNMENT %
% HAVE SEEN IDENTIFIER (...) =
IT'S A SUBSTRING ASSIGNMENT IFF COLON WAS SEEN INSIDE THE PARENS %
MACRO
ACMSUBCHK =
IF .COLONCOUNT NEQ 0
THEN STMNDESC _ DSCSUBASSIGN<ADRS>
ELSE STMNDESC _ DSCSFAY<ADRS>;
VALUE _ NOT ENDOFILE<0,0>;
STATE _ STRETNX;
ACTION _ ACTCLASBACK;
LEAVE NEWACTION
$;
% [1247] SUBSTRING ASSIGNMENT %
% HAVE SEEN IDENTIFIER (...) (
MUST BE INDEXED SUBSTRING ASSIGNMENT %
MACRO
ACMSUBASSIGN =
STMNDESC _ DSCSUBASSIGN<ADRS>;
VALUE _ NOT ENDOFILE<0,0>;
STATE _ STRETNX;
ACTION _ ACTCLASBACK;
LEAVE NEWACTION
$;
% [1247] KEYWORD STATEMENT OR SUBSTRING ASSIGNMENT %
% HAVE SEEN <KEYWORD> (...) (
IT'S EITHER A SUBSTRING ASSIGNMENT OR A READ OR WRITE STATEMENT
SKIP TO THE MATCHING RIGHT PAREN AND CHECK FOR "=" FOLLOWING IT %
MACRO
ACMKEYSUB =
PAREN _ 1;
CALLR (STTERM, STCLASAL1B);
LEAVE BIGCHAR
$;
% WE HAVE DO <DIGIT> <ALPHANUM> = %
MACRO
ACMDOCHK1 =
% CHECK FOR ZERO LEVEL COMMA %
PAREN _ 0;
CALLR ( STTERM, STDOCHK2 );
LEAVE BIGCHAR
$;
%1573% % WE HAVE DO <CHARS> ( %
%1573% MACRO
ACMDOCHK2 =
PAREN _ 1;
CALLR ( STTERM, STDOCHK3 );
LEAVE BIGCHAR
$;
%1573% % WE HAVE DO <CHARS> ( <BAL> ) %
%1573% MACRO
ACMWHILECHK =
IF .CHAR EQL EOS OR .CHAR EQL ";"
THEN IF .DOCHAR EQL "W" OR (.DOCHAR GEQ "0" AND .DOCHAR LEQ "9")
THEN
BEGIN
STMNDESC _ DSCWHILE<ADRS>;
ACTION _ ACTSPELLING;
LEAVE NEWACTION;
END;
STATE _ STCLASAL2A;
SETCODE;
LEAVE NEWSTATE
$;
% ITS A "DO" %
MACRO
ACMDOSTMNT =
STMNDESC _ DSCDO<ADRS>;
ACTION _ ACTSPELLING;
LEAVE NEWACTION
$;
% WE HAVE <3 ALPHA > ( EOS / EOF ) %
MACRO
ACMENDCHK =
IF .NAME EQL "END"
THEN
BEGIN % ITS AN END %
STMNDESC _ DSCEND<ADRS>;
ACTION _ ACTSPELLING;
LEAVE NEWACTION
END
ELSE
BEGIN % UNRECOGNIZED STATEMENT %
ACTION _ ACTCLASUNREC;
LEAVE NEWACTION
END
$;
% THIRD LETTER %
MACRO
ACMCLASF3 =
NAME _ .NAME^7 + .CHAR;
STATE _ STCLASF4;
LEAVE BIGCHAR
$;
% WE HAVE 4 ALPHA CHARACTERS %
MACRO
ACMCLASF4 =
NAME _ .NAME^7 + .CHAR;
IF ( STMNDESC _ CLASHASH( .NAME ) ) NEQ 0
THEN
BEGIN % POSSIBLE KEY WORD , GO CHECK FOR ZERO LEVEL "=" TO BE SURE %
STATE _ STCLASAL2;
LEAVE BIGCHAR
END
ELSE
BEGIN % TRY ASSIGNMENT OR STFN/ARRAY %
STATE _ STCLASAL1;
LEAVE BIGCHAR
END
$;
% WE HAVE <4 LETTERS OF KEY WORD> < ALPHANUM > "(" %
MACRO
ACMKEYTERM =
% SKIP WHATS IN () AND LOOK FOR "=" %
PAREN _ 1; ! ONE HAS BEEN PICKED UP
CALLR ( STTERM, STCLASAL2A );
LEAVE BIGCHAR
$;
% WE HAVE EOS. CHECK FOR UNMATCHED "(" BEFORE CLASSIFYING AS
KEY WORD %
MACRO
ACMUNMATKEY =
IF .PAREN NEQ 0 AND NOT .MSNGTIC
THEN ACTION _ ACTCLILLCHAR ! UNMATCHED
% THE MISSING TIC CHECK ALLOWS TIC RECORD MARKS TO GET THROUGH %
ELSE
BEGIN
% IF WE GOT HERE FROM DO LOOP THEN ITS AN ASSIGNMENT %
IF .STATE EQL STDOCHK2
THEN ACTION _ ACTASGNMNT
ELSE ACTION _ ACTSPELLING ! KEY WORD STATEMENT
END;
LEAVE NEWACTION
$;
% NOW CHECK THE SPELLNG OF THE KEY WORD. THIS WILL ALSO CHECK
THE SPELLING OF THE FIRST 4 CHARACTERS AGAIN. THIS IS JUST
TO ASSURE THAT THEY WILL BE PRINTED JUST IN CASE SOME DEVIATE
HAS SPLIT THEM OVER A LINE %
MACRO
ACMSPELLING =
KEYPTR _ ( KEYWRD ( @STMNDESC ) ) < 29,7 >; ! BYTE POINTER TO BEGINNING OF CORRECT SPELLING
STATE _ STSPELLING;
ACTION _ ACTCLASBACK;
LEAVE NEWACTION
$;
OWN KEYPTR; ! BYTE POINTER FOR KEYWORD SPELLING CHECK
% CHECK THE INPUT STRING AGAINST THE CORRECT SPELLING %
MACRO
ACMCOMPAR =
REGISTER KEYCHAR;
ISCAN ( KEYCHAR, KEYPTR ); ! NEXT CHARACTER OF KEY WORD
IF .KEYCHAR EQL .CHAR
THEN
BEGIN % MATCH %
LEAVE SMALCHAR ! TRY THE NEXT ONE
END
ELSE
BEGIN
IF .KEYCHAR EQL 0
THEN
BEGIN % THE SPELLING IS CORRECT %
RETURNOW ( NOT ENDOFILE<0,0> )
END
ELSE
BEGIN % NAME IS MISSPELLED %
%CHECK TO SEE IF WE WERE LOOKING FOR PARAMETER
BECAUSE THEN ITS REALLY AN ASSIGNMENT
CERTAINLY IS CONFUSING %
IF .STMNDESC EQL DSCPARAMT<0,0>
THEN
BEGIN % INDEED IT IS ONE %
STMNDESC _ 0;
ACTION _ ACTASGNMNT;
LEAVE NEWACTION;
END;
FATLERR ( .ISN, E12<0,0> );
IF .LGIFCLAS NEQ 0
THEN ( RETURNOW( ENDOFILE<ADRS> ) );
CALLR ( STSKIP,STSTMNT);
LEAVE NEWSTATE
END
END
$;
!------------------------------ RETURN AFTER SKIP TO SIGNIFICANT CHAR ------------------------------
% SMALL STATE DEFINITION STRETNX NUMBER (#) 2S %
% RETURN AFTER POSITIONING TO THE NEXT SIGNIFICANT CHARACTER %
BIND
ILL2S = ACTRETNOW ,
TAB2S = ACTTABS ,
LT2S = ACTLT ,
BLANK2S = ACTANYS ,
SPEC2S = ACTRETNOW ,
DIGIT2S = ACTRETNOW ,
UPPER2S = ACTRETNOW ,
LOWER2S = ACTRETNOW ,
FOS2S = ACTRETNOW ,
EOB2S = ACTEOB ,
REMARK2S = ACTENTREMARK ;
MACRO
ACMRETNOW =
RETURNOW (.VALUE)
$;
! ------------------------------ LOGICAL IF OBJECT CLASSIFICATION ------------------------------
% SMALL STATE DEFINITION STIFCLASF NUMBER (#) 35S %
% CLASSIFY THE STATEMENT FOLLOWING A LOGICAL IF - THE NEXT CHARACTER
HAD BETTER BE A LETTER OR WE SHOULDN'T BE HERE %
BIND
ILL35S = ACTINTERR ,
TAB35S = ACTINTERR ,
LT35S = ACTINTERR ,
BLANK35S = ACTINTERR ,
SPEC35S = ACTINTERR ,
DIGIT35S = ACTINTERR ,
UPPER35S = ACTCLASF1 ,
LOWER35S = ACTUPLOW ,
FOS35S = ACTINTERR ,
EOB35S = ACTINTERR ,
REMARK35S = ACTINTERR ;
!------------------------------ CHARACTER LOOKAHEAD ------------------------------
% SMALL STATE DEFINITION STCSCAN NUMBER (#) 36S %
% LOOK AT THE NEXT CHARACTER AND SEE IF IT MATCHES THE CHARACTER
IN LOOK4CHAR %
BIND
ILL36S = ACTSCANCHAR ,
TAB36S = ACTINTERR ,
LT36S = ACTINTERR ,
BLANK36S = ACTINTERR ,
SPEC36S = ACTSCANCHAR ,
DIGIT36S = ACTSCANCHAR ,
UPPER36S = ACTSCANCHAR ,
LOWER36S = ACTUPLOW ,
FOS36S = ACTSCANCHAR ,
EOB36S = ACTINTERR ,
REMARK36S = 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 (#) 37S %
% TRY AND MATCH THE STRING POINTED TO BY LOOK4CHAR %
BIND
ILL37S = ACTSTRCHK ,
TAB37S = ACTTABS ,
LT37S = ACTCLASLT ,
BLANK37S = ACTANYS ,
SPEC37S = ACTSTRCHK ,
DIGIT37S = ACTSTRCHK ,
UPPER37S = ACTSTRCHK ,
LOWER37S = ACTUPLOW ,
FOS37S = ACTSTRCHK ,
EOB37S = ACTEOB ,
REMARK37S = 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 (#) 44S %
% CHECK FOR A KEYWORD "LETTERS="
ONLY RETURNS FIRST 6 LETTERS %
BIND
ILL44S = ACTKEYCHK ,
TAB44S = ACTTABS ,
LT44S = ACTCLASLT ,
BLANK44S = ACTANYS ,
SPEC44S = ACTKEYCHK ,
DIGIT44S = ACTKEYCHK ,
UPPER44S = ACTKEYCHK ,
LOWER44S = ACTUPLOW ,
FOS44S = ACTKEYCHK ,
EOB44S = ACTEOB ,
REMARK44S = ACTENTREMARK ;
% SMALL STATE DEFINITION STKEY1CHK NUMBER (#) 45S %
% HAVE SEEN INITIAL LETTER OF KEYWORD. BYTE POINTERS AND EVERYTHING
ARE ALL SET UP. READ LETTERS UP TO "=" AND STORE IN SIXBIT KEYWORD %
BIND
ILL45S = ACTKEY1CHK ,
TAB45S = ACTTABS ,
LT45S = ACTCLASLT ,
BLANK45S = ACTANYS ,
SPEC45S = ACTKEY1CHK ,
DIGIT45S = ACTKEY1CHK ,
UPPER45S = ACTKEY1CHK ,
LOWER45S = ACTUPLOW ,
FOS45S = ACTKEY1CHK ,
EOB45S = ACTEOB ,
REMARK45S = ACTENTREMARK ;
MACRO
ACMKEYCHK =
REGISTER R;
IF .CODE EQL UPPER ! If first char is a letter
THEN
BEGIN ! letter
VALUE = 0; ! Clear keyword buffer
POINTER = VALUE<36,6>; ! Set up pointer to result buffer
REPLACEI (POINTER, .CHAR - #40); ! Store sixbit 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
IF (.POINTER AND #770000000000) NEQ 0
! If there aren't 6 letters yet,
THEN REPLACEI (POINTER, .CHAR - #40); ! 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
RETURNXT (.VALUE) ! 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 (#) 38S %
% LOOK FOR AN DECIMAL STRING OR A 'LITERAL-STRING' FOLLOWING A STOP OR PAUSE STATEMENT %
BIND
ILL38S = ACTSTOPLIT ,
TAB38S = ACTINTERR ,
LT38S = ACTINTERR ,
BLANK38S = ACTINTERR ,
SPEC38S = ACTSTOPLIT ,
%[742]% DIGIT38S = ACTSTOPINT ,
UPPER38S = ACTSTOPLIT ,
LOWER38S = ACTSTOPLIT ,
FOS38S = ACTSTOPLIT ,
EOB38S = ACTINTERR ,
REMARK38S = ACTINTERR ;
% GOT A DIGIT, TRY FOR OCTAL %
MACRO
ACMSTOPOCT =
HIAC_LOAC_SIIGN_0;
ACTION _ ACTOCTQ1;
LEAVE NEWACTION
$;
% 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
$;
BIND
ILL42S = ACTBADCHAR,
TAB42S = ACTTABS,
LT42S = ACTLT,
BLANK42S= ACTANYS,
SPEC42S = ACTGOT6INT,
DIGIT42S= ACT6DIGIT,
UPPER42S= ACTGOT6INT,
LOWER42S= ACTGOT6INT,
FOS42S = ACTGOT6INT,
EOB42S = ACTEOB,
REMARK42S= 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 (#) 2B %
% THIS IS THE ENTRANCE TO THE LEXICAL ANALYZER %
BIND
ILL2B = ACTBADCHAR ,
TAB2B = ACTINTERR ,
LT2B = ACTINTERR ,
BLANK2B = ACTINTERR ,
SPEC2B = ACTINTERR ,
DIGIT2B = ACTENTGETCONST ,
UPPER2B = ACTENTIDENT ,
LOWER2B = ACTUPLOW ,
FOS2B = ACTLEXFOS ,
![675] IN STLEXEME NUMBER 2B, CHANGE TO CATCH A RUBOUT IN SOURCE.
%[675]% EOB2B = ACTRIS ,
REMARK2B = ACTINTERR ,
EQUAL2B = ACTDOUBLEX ,
LPAREN2B = ACTSINGLEX ,
RPAREN2B = ACTSINGLEX ,
COLON2B = ACTSINGLEX ,
COMMA2B = ACTSINGLEX ,
DOLLAR2B = ACTSINGLEX ,
ASTERISK2B = ACTDOUBLEX ,
%1244% SLASH2B = ACTDOUBLEX ,
PLUS2B = ACTSINGLEX ,
MINUS2B = ACTSINGLEX ,
ANDSGN2B = ACTSINGLEX ,
LITSGN2B = ACTENTLITLEX ,
OCTSGN2B = ACTENTOCTQ ,
NEQSGN2B = ACTSINGLEX ,
DOT2B = ACTENTDOT ,
SEMICOL2B = ACTMULTST ,
LTSGN2B = ACTDOUBLEX ,
GTSGN2B = ACTDOUBLEX ,
COMNTSGN2B = ACTENTIDENT ,
DEBUGSGN2B = ACTENTIDENT ,
UPAROW2B = 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 %
RETURNXT (
( IF ( VREG_.CODE ) LEQ EQUAL
THEN .VREG^18
% INCLUDES LPAREN,RPAREN,COLON,COMMA,DOLLAR,SLASH,
PLUS, MINUS, ANDSGN %
ELSE IF .VREG EQL NEQSGN
THEN DOTNE % # %
ELSE POWER^18 % ^ %
)
)
$;
% CHECK FOR TWO CHARACTER LEXEMES, IE. <=, >= , **, ETC. %
MACRO
ACMDOUBLEX =
VALUE _ .CODE;
STATE _ STDOUBLEX;
LEAVE BIGCHAR
$;
% BIG STATE DEFINITION STDOUBLEX NUMBER (#) 16B %
% WE HAVE /, *, =, <, OR > - SEE IF ITS A TWO CHARACTER LEXEME %
BIND
ILL16B = ACTBADCHAR ,
TAB16B = ACTTABB ,
LT16B = ACTLT ,
BLANK16B = ACTANYB ,
SPEC16B = ACTNOTDOUB ,
DIGIT16B = ACTNOTDOUB ,
UPPER16B = ACTNOTDOUB ,
LOWER16B = ACTNOTDOUB ,
FOS16B = ACTNOTDOUB ,
EOB16B = ACTEOB ,
REMARK16B = ACTENTREMARK ,
EQUAL16B = ACTMAYBDOUB ,
LPAREN16B = ACTNOTDOUB ,
RPAREN16B = ACTNOTDOUB ,
COLON16B = ACTNOTDOUB ,
COMMA16B = ACTNOTDOUB ,
DOLLAR16B = ACTNOTDOUB ,
ASTERISK16B = ACTMAYBDOUB ,
%1244% SLASH16B = ACTMAYBDOUB ,
PLUS16B = ACTNOTDOUB ,
MINUS16B = ACTNOTDOUB ,
ANDSGN16B = ACTNOTDOUB ,
LITSGN16B = ACTNOTDOUB ,
OCTSGN16B = ACTNOTDOUB ,
NEQSGN16B = ACTNOTDOUB ,
DOT16B = ACTNOTDOUB ,
SEMICOL16B = ACTNOTDOUB ,
LTSGN16B = ACTMAYBDOUB ,
GTSGN16B = ACTMAYBDOUB ,
COMNTSGN16B = ACTNOTDOUB ,
DEBUGSGN16B = ACTNOTDOUB ,
UPAROW16B = ACTNOTDOUB ;
% ITS NOT A DOUBLE CHARACTER LEXEME %
MACRO
ACMNOTDOUB =
RETURNOW (
( IF ( VREG _ .VALUE ) LEQ EQUAL
THEN .VREG^18
%1244% % EQUAL AND ASTERISK AND SLASH %
ELSE IF .VREG EQL LTSGN
THEN VREG _ DOTLT % < %
ELSE VREG _ DOTGT % > %
)
)
$;
% 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 =
ACTION _ ACTNOTDOUB;
%1244% CASE .VALUE-SLASH OF
SET
%1244% % SLASH %
%1244% BEGIN
%1244% IF .CHAR NEQ "/"
%1244% THEN LEAVE NEWACTION; ! JUST /
%1244% VREG _ CONCAT^18 ! //
%1244% END;
%1244% % PLUS %
%1244% LEAVE NEWACTION;
% ASTERISK %
BEGIN
IF .CHAR NEQ "*"
THEN LEAVE NEWACTION; ! JUST *
VREG _ POWER^18
END;
%=%
BEGIN
CASE .CODE-SLASH OF
SET
%1244% %/% (LEAVE NEWACTION); ! JUST =
%1244% %+% (LEAVE NEWACTION); ! JUST =
%*% (LEAVE NEWACTION); ! JUST =
%=% (VREG _ DOTEQ); ! ==
%<% (VREG _ DOTLE); ! =<
%>% ( VREG _ DOTGE); ! =>
TES
END;
%<%
BEGIN
IF .CHAR NEQ "="
THEN LEAVE NEWACTION;
VREG _ DOTLE
END;
%>%
BEGIN
IF .CHAR NEQ "="
THEN LEAVE NEWACTION;
VREG _ DOTGE
END;
TES;
RETURNXT (.VREG )
$;
!------------------------------ IDENTIFIERS ------------------------------
% SMALL STATE DEFINITION STIDENT NUMBER (#) 19S %
% SCAN IDENTIFIERS AND PUT IN THE SYMBOL TABLE IN 6-BIT %
BIND
ILL19S = ACTBADCHAR ,
TAB19S = ACTTABS ,
LT19S = ACTLT ,
BLANK19S = ACTANYS ,
SPEC19S = ACTENDID ,
DIGIT19S = ACTPKUPID ,
UPPER19S = ACTPKUPID ,
LOWER19S = ACTUPLOW ,
FOS19S = ACTENDID ,
EOB19S = ACTEOB ,
REMARK19S = ACTENTREMARK ;
OWN IDENTF,CNT;
% 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
%1551% (.IDPTR+8)<34,2> = (.IDPTR+8)<32,2> = 1; ! IDPTR[IDPSECT] = IDPTR[IDPSCHARS] = PSDATA; ! Relocate by .DATA.
%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]
! 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 (#) 20S %
% WE HAVE AN INITIAL "." - IS IT AN OPERATOR OR A CONSTANT ? %
BIND
ILL20S = ACTBADCHAR ,
TAB20S = ACTTABB ,
LT20S = ACTLT ,
BLANK20S = ACTANYB ,
SPEC20S = ACTMISOPER ,
DIGIT20S = ACTTRYREAL ,
UPPER20S = ACTGETOPER ,
LOWER20S = ACTUPLOW ,
FOS20S = ACTMISOPER ,
EOB20S = ACTEOB ,
REMARK20S = 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
$;
OWN POINTER;
% WE HAVE A "." FOLLOWED BY A LETTER - SEE IF IT COULD BE AN OPERATOR %
MACRO
ACMGETOPER =
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 (#) 21S %
% 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
ILL21S = ACTBADCHAR ,
TAB21S = ACTTABS ,
LT21S = ACTLT ,
BLANK21S = ACTANYS ,
SPEC21S = ACTOPCHK ,
DIGIT21S = ACTMISOP1 ,
UPPER21S = ACTOPCHK ,
LOWER21S = ACTUPLOW ,
FOS21S = ACTMISOP1 ,
EOB21S = ACTEOB ,
REMARK21S = ACTENTREMARK ;
% COMPARE THE INPUT STREAM AGAINST THE LEGAL OPERATOR STRINGS %
MACRO
ACMOPCHK =
REGISTER R;
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 %
VREG _ @(@POINTER+1);
IF .VREG LSS 0
THEN
BEGIN % LOGICAL CONSTANT %
NAME _ .GCONTAB ;
SYMTYPE _ GLOGI<0,0>;
ENTRY[0] _ 0;
ENTRY[1] _ .VREG+1;
TBLSEARCH();
VREG<LEFT> _ CONSTLEX
END;
RETURNXT ( .VREG ) ! 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 (#) 17B %
% RETURN HERE FROM
BLDDBLINT, WHICH JUST PICKED UP AN INTEGER %
BIND
ILL17B = ACTBADCHAR ,
TAB17B = ACTTABB ,
LT17B = ACTLT ,
BLANK17B = ACTANYB ,
SPEC17B = ACTGOTINT ,
DIGIT17B = ACTINTERR ,
UPPER17B = ACTCHECKLET ,
LOWER17B = ACTUPLOW ,
FOS17B = ACTGOTINT ,
EOB17B = ACTEOB ,
REMARK17B = ACTENTREMARK ,
EQUAL17B = ACTGOTINT ,
LPAREN17B = ACTGOTINT ,
RPAREN17B = ACTGOTINT ,
COLON17B = ACTGOTINT ,
COMMA17B = ACTGOTINT ,
DOLLAR17B = ACTGOTINT ,
ASTERISK17B = ACTGOTINT ,
SLASH17B = ACTGOTINT ,
PLUS17B = ACTGOTINT ,
MINUS17B = ACTGOTINT ,
ANDSGN17B = ACTGOTINT ,
LITSGN17B = ACTGOTINT ,
OCTSGN17B = ACTGOTINT ,
NEQSGN17B = ACTGOTINT ,
DOT17B = ACTREALCON ,
SEMICOL17B = ACTMULTST ,
LTSGN17B = ACTGOTINT ,
GTSGN17B = ACTGOTINT ,
COMNTSGN17B = ACTCHECKLET ,
DEBUGSGN17B = ACTCHECKLET ,
UPAROW17B = ACTGOTINT ;
GLOBAL HIAC,LOAC;
OWN SIIGN;
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 =
%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 %
LABREF(); ! LABEL IS IN ENTRY[1]
VREG<LEFT> _ LABELEX
END
ELSE
BEGIN % INTEGER %
SYMTYPE _ GINTEGER<0,0>;
TBLSEARCH();
VREG<LEFT> _ CONSTLEX
END;
RETURNOW ( .VREG )
$;
% 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
IF ( SUM _ 5-( .LOAC MOD 5)) EQL 5 THEN SUM _ 0; ! FOR BLANK FILL AT END
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 (#) 22S %
% BUILD A DOUBLE PRECISION CONSTANT IN HIAC AND LOAC %
BIND
ILL22S = ACTGOBAKNOW ,
TAB22S = ACTTABS ,
LT22S = ACTLT ,
BLANK22S = ACTANYS ,
SPEC22S = ACTGOBAKNOW ,
DIGIT22S = ACTBILDDBLINT ,
UPPER22S = ACTGOBAKNOW ,
LOWER22S = ACTGOBAKNOW ,
FOS22S = ACTGOBAKNOW ,
EOB22S = ACTEOB ,
REMARK22S = ACTENTREMARK ;
MACRO LO = R[1]<0,36>$,
HI = R[0]<0,36>$;
MACRO DPADD1(X) = ADD(X+1,LOAC);
TLZE(X+1,#400000);
AOS(X,HIAC);
MOVEM(X+1,LOAC)$;
MACRO DPADD(X) = ADDB(X,HIAC);
DPADD1(X);$;
MACHOP ADD=#270, TLZE=#623, AOS=#350, MOVEM=#202, ADDB=#273, ASHC=#244;
!
!ALGORITHM IS SIMPLY
! (HIAC,LOAC)_ (HIAC,LOAC)*8 + (HIAC,LOAC)*2 + .CHAR -"0"
!
!
MACRO
ACMBILDDBLINT=
BEGIN
REGISTER R[2];
HI _ .HIAC;
IF (.HI AND #760000000000 ) EQL 0
THEN BEGIN
DECEXP _ .DECEXP+.INCREM;
LO _ .LOAC;
ASHC(HI,3);
HIAC _ .HI; LOAC _ .LO;
ASHC(HI,-2);
DPADD(HI) !MACRO ABOVE
LO _ .CHAR;
LO _ .LO - "0";
DPADD1(HI) !MACRO ABOVE
END
ELSE
BEGIN
%ADJUST EXPONENT FOR IGNORED LEAST SIGNIFIGANT
DIGITS %
IF .INCREM EQL 0
THEN DECEXP _ .DECEXP + 1
END;
LEAVE SMALCHAR
END;
$;
% SMALL STATE DEFINITION STREALCON NUMBER (#) 23S %
% WE HAVE <INTEGER> "."
WE ARE NOW LOOKING AT WHATEVER FOLLOWS THE "."
%
BIND
ILL23S = ACTBADCHAR ,
TAB23S = ACTTABS ,
LT23S = ACTLT ,
BLANK23S = ACTANYS ,
SPEC23S = ACTGOTREAL ,
DIGIT23S = ACTENTRLBLDD ,
UPPER23S = ACTEXDBCHK ,
LOWER23S = ACTUPLOW ,
FOS23S = ACTGOTREAL ,
EOB23S = ACTEOB ,
REMARK23S = 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 (#) 24S %
% WE HAVE [<INTEGER>] "." < INTEGER > - SO LOOK FOR EXPONENT %
BIND
ILL24S = ACTBADCHAR ,
TAB24S = ACTTABS ,
LT24S = ACTLT ,
BLANK24S = ACTANYS ,
SPEC24S = ACTGOTREAL ,
DIGIT24S = ACTINTERR ,
UPPER24S = ACTCHECKLET ,
LOWER24S = ACTUPLOW ,
FOS24S = ACTGOTREAL ,
EOB24S = ACTEOB ,
REMARK24S = ACTENTREMARK ;
% SMALL STATE DEFINITION STOPCHK NUMBER (#) 25S %
% WE HAVE <INTEGER> "." "E" - ? IS IT AN EXPONENT OR OERATOR %
BIND
ILL25S = ACTBADCHAR ,
TAB25S = ACTTABS ,
LT25S = ACTCLASLT ,
BLANK25S = ACTANYS ,
SPEC25S = ACTCHKPLMI ,
DIGIT25S = ACTINTEXP1 ,
UPPER25S = ACTGOTOP ,
LOWER25S = ACTGOTOP ,
FOS25S = ACTNOEXP ,
EOB25S = ACTEOB ,
REMARK25S = ACTENTREMARK ;
% ITS AN OPERATOR %
MACRO
ACMGOTOP =
% SO BACK UP %
BACKUP();
CHAR _ ".";
CODE _ DOT;
ACTION _ ACTGOTINT;
LEAVE NEWACTION
$;
% SMALL STATE DEFINITION STINTEXPONENT NUMBER (#) 26S %
% LOOK FOR SIGN OF EXPONENT FOLLOWING D OR E %
BIND
ILL26S = ACTBADCHAR ,
TAB26S = ACTTABS ,
LT26S = ACTLT ,
BLANK26S = ACTANYS ,
SPEC26S = ACTCHKPLMI ,
DIGIT26S = ACTINTEXP1 ,
UPPER26S = ACTNOEXP ,
LOWER26S = ACTNOEXP ,
FOS26S = ACTNOEXP ,
EOB26S = ACTEOB ,
REMARK26S = 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 (#) 27S %
% SIGN OF EXPONENT HAS BEEN FOUND - LETS NOT HAVE ANY MORE SIGNS %
BIND
ILL27S = ACTBADCHAR ,
TAB27S = ACTTABS ,
LT27S = ACTLT ,
BLANK27S = ACTANYS ,
SPEC27S = ACTNOEXP ,
DIGIT27S = ACTINTEXP1 ,
UPPER27S = ACTNOEXP ,
LOWER27S = ACTNOEXP ,
FOS27S = ACTNOEXP ,
EOB27S = ACTEOB ,
REMARK27S = ACTENTREMARK ;
% SMALL STATE DEFINITION STINTEXP1 NUMBER (#) 28S %
% LOOK FOR DIGITS OF THE EXPONENT AFTER THE FIRST %
BIND
ILL28S = ACTBADCHAR ,
TAB28S = ACTTABS ,
LT28S = ACTLT ,
BLANK28S = ACTANYS ,
SPEC28S = ACTGOTIEXP ,
DIGIT28S = ACTSUMIEXP ,
UPPER28S = ACTGOTIEXP ,
LOWER28S = ACTGOTIEXP ,
FOS28S = ACTGOTIEXP ,
EOB28S = ACTEOB ,
REMARK28S = ACTENTREMARK ;
% WE HAVE 1ST DIGIT OF EXPONENT %
MACRO
ACMINTEXP1 =
IF .BACKLINE NEQ 0 THEN BACKPRINT();
SUM _ .CHAR - "0";
STATE _ STINTEXP1;
LEAVE SMALCHAR
$;
% ADD UP THE EXPONENT %
! MACRO
!ACMSUMIEXP =
! SUM _ .SUM*10 + ( .CHAR - "0" );
! LEAVE SMALCHAR
!$;
! THIS MACRO IS NOW ACMSKCONBLD
% 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 (#) 29S %
% PICK UP A HOLERITH STRING - LOAC CONTAINS THE NUMBER OF CARACTERS %
BIND
ILL29S = ACTHOLCHAR ,
TAB29S = ACTHOLTAB ,
LT29S = ACTLT ,
BLANK29S = ACTHOLCHAR ,
SPEC29S = ACTHOLCHAR ,
DIGIT29S = ACTHOLCHAR ,
UPPER29S = ACTHOLCHAR ,
LOWER29S = ACTHOLCHAR ,
FOS29S = ACTHOLEND ,
EOB29S = ACTEOB ,
REMARK29S = 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 =
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 (#) 30S %
% PICK UP A LITERAL STRING %
BIND
ILL30S = ACTLITEDCHK ,
TAB30S = ACTHOLTAB ,
LT30S = ACTLT ,
BLANK30S = ACTLITEDCHK ,
SPEC30S = ACTLITEDCHK ,
DIGIT30S = ACTLITEDCHK ,
UPPER30S = ACTLITEDCHK ,
LOWER30S = ACTLITEDCHK ,
FOS30S = ACTNOTIC ,
EOB30S = ACTEOB ,
REMARK30S = 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 (#) 31S %
% LOOKING FOR SECOND ' %
BIND
ILL31S = ACTTIC2CHK ,
TAB31S = ACTTIC2CHK ,
LT31S = ACTLT ,
BLANK31S = ACTTIC2CHK ,
SPEC31S = ACTTIC2CHK ,
DIGIT31S = ACTTIC2CHK ,
UPPER31S = ACTTIC2CHK ,
LOWER31S = ACTTIC2CHK ,
FOS31S = ACTTIC2CHK ,
EOB31S = ACTEOB ,
REMARK31S = 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 (#) 32S %
% LOOK FOR SIGN OF OCTAL %
BIND
ILL32S = ACTBADCHAR ,
TAB32S = ACTTABS ,
LT32S = ACTLT ,
BLANK32S = ACTANYS ,
SPEC32S = ACTCHKOCPM ,
DIGIT32S = ACTOCTQ1 ,
UPPER32S = ACTNOOCT ,
LOWER32S = ACTNOOCT ,
FOS32S = ACTNOOCT ,
EOB32S = ACTEOB ,
REMARK32S = ACTENTREMARK ;
%[1141]% BIND OCTOFLO=HOLCONST;
% LOOKING FOR OCTAL %
MACRO
ACMENTOCTQ =
HIAC _ 0;
LOAC _ 0;
SIIGN _ 0;
%[1141]% OCTOFLO _ 0; !No octal overflow
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 (#) 33S %
% AFTER THE SIGN BUT BEFORE ANY DIGITS %
BIND
ILL33S = ACTBADCHAR ,
TAB33S = ACTTABS ,
LT33S = ACTLT ,
BLANK33S = ACTANYS ,
SPEC33S = ACTNOOCT ,
DIGIT33S = ACTOCTQ1 ,
UPPER33S = ACTNOOCT ,
LOWER33S = ACTNOOCT ,
FOS33S = ACTNOOCT ,
EOB33S = ACTEOB ,
REMARK33S = ACTENTREMARK ;
% SMALL STATE DEFINITION STOCTQ1 NUMBER (#) 34S %
% LOOK FOR DIGITS AFTER THE FIRST %
BIND
ILL34S = ACTBADCHAR ,
TAB34S = ACTTABS ,
LT34S = ACTLT ,
BLANK34S = ACTANYS ,
SPEC34S = ACTGOTOCT ,
DIGIT34S = ACTOCTQ1 ,
UPPER34S = ACTGOTOCT ,
LOWER34S = ACTGOTOCT ,
FOS34S = ACTGOTOCT ,
EOB34S = ACTEOB ,
REMARK34S = 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;
![1141] CHECK FOR OCTAL OVERFLOW - LOSS OF SIGNIFICANT DIGITS
![1141] 24 SIGNIFICANT DIGITS IS THE MAX FOR A DOUBLE OCTAL
%[1141]% IF .OCTOFLO NEQ 0 THEN LEAVE SMALCHAR; !Already overflowed
%[1141]% LSHC(T[0],3); !Check for loss of significance
%[1141]% LSHC(T[0],-3);
%[1141]% IF .T[0] NEQ .HIAC
%[1141]% THEN !Lost something - give error
%[1141]% BEGIN
%[1141]% FATLEX( PLIT'a maximum of 24?0',
%[1141]% PLIT'too many digits?0', E0<0,0> );
%[1141]% OCTOFLO _ -1; !And mark overflow
%[1141]% LEAVE SMALCHAR
%[1141]% END;
LSHC(T[0],3);
T[1] _ .T[1] + ( .CHAR - "0" );
HIAC _ .T[0];
LOAC _ .T[1];
LEAVE SMALCHAR
$;
MACRO
ACMGOTOCT =
IF .SIIGN NEQ 0
THEN ( HIAC _ -.HIAC; LOAC _ -.LOAC);
% NEGATIVES ARE KEPT IN DOUBLE PRECISION %
SYMTYPE _ ( IF .HIAC NEQ 0
THEN GDUBOCT<0,0>
ELSE GOCTAL<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 MODULE FORMAT.
FOR LETTERS THE CODE COMES FROM FMTLET[.CHAR], FOR THE OTHER SINGLE
LETTER LEXEMES THE CODE IS OBTAINED FROM THE TABLE FMTLEX[.CODE]
( IE. 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 (#) 18B %
BIND
ILL18B = ACTFLEX1 ,
TAB18B = ACTINTERR ,
LT18B = ACTINTERR ,
BLANK18B = ACTINTERR ,
SPEC18B = ACTFLEX1 ,
DIGIT18B = ACTFMTHOLCK ,
UPPER18B = ACTFMTCHAR ,
LOWER18B = ACTUPLOW ,
FOS18B = ACTFMTEOS ,
EOB18B = ACTEOB ,
REMARK18B = ACTINTERR ,
EQUAL18B = ACTFLEX1 ,
LPAREN18B = ACTFLEX1 ,
RPAREN18B = ACTFLEX1 ,
COLON18B = ACTFLEX1 ,
COMMA18B = ACTFLEX1 ,
DOLLAR18B = ACTFLEX1 ,
ASTERISK18B = ACTFLEX1 ,
SLASH18B = ACTFLEX1 ,
PLUS18B = ACTFLEX1 ,
MINUS18B = ACTFLEX1 ,
ANDSGN18B = ACTFLEX1 ,
LITSGN18B = ACTFMTQT ,
OCTSGN18B = ACTFLEX1 ,
NEQSGN18B = ACTFLEX1 ,
DOT18B = ACTFLEX1 ,
SEMICOL18B = ACTMULTST ,
LTSGN18B = ACTFLEX1 ,
GTSGN18B = ACTFLEX1 ,
COMNTSGN18B = ACTFMTCHAR ,
DEBUGSGN18B = ACTFMTCHAR ,
UPAROW18B = 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 (#) 39S %
% PICK UP QUOTED LITERAL STRINGS IN FORMAT STATEMENTS %
BIND
ILL39S = ACTFMTQT1 ,
TAB39S = ACTHOLTAB ,
LT39S = ACTLT ,
BLANK39S = ACTFMTQT1 ,
SPEC39S = ACTFMTQT1 ,
DIGIT39S = ACTFMTQT1 ,
UPPER39S = ACTFMTQT1 ,
LOWER39S = ACTFMTQT1 ,
FOS39S = ACTFMTQT1 ,
EOB39S = ACTEOB ,
REMARK39S = 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 (#) 40S %
% WE ARE HERE TO PICK UP A CONSTANT AND SAVE IT INCASE THERE IS A
HOLLERITH FOLLOWING %
BIND
ILL40S = ACTHOLCONDONE ,
TAB40S = ACTTABS ,
LT40S = ACTLT ,
BLANK40S = ACTANYS ,
SPEC40S = ACTHOLCONDONE ,
DIGIT40S = ACTHOLCON ,
UPPER40S = ACTHOLCONDONE ,
LOWER40S = ACTUPLOW ,
FOS40S = ACTHOLCONDONE ,
EOB40S = ACTEOB ,
REMARK40S = 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 (#) 41S %
% GET THE HOLERITH STRING %
BIND
ILL41S = ACTFMTHOLPKUP ,
TAB41S = ACTHOLTAB ,
LT41S = ACTLT ,
BLANK41S = ACTFMTHOLPKUP ,
SPEC41S = ACTFMTHOLPKUP ,
DIGIT41S = ACTFMTHOLPKUP ,
UPPER41S = ACTFMTHOLPKUP ,
LOWER41S = ACTFMTHOLPKUP ,
FOS41S = ACTFMTHOLPKUP ,
EOB41S = ACTEOB ,
REMARK41S = 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 PRODUCED BY PRELEX.TEC
!
! --------------------------------------------------
!
! TABLE SIZE AND PACKING DEFINITIONS
GLOBAL BIND
%%STPACK = 4, % 4 STATE TABLE ENTRIES PER WORD %
STBITS = 36/STPACK, % NUMBER OF BITS PER ENTRY %
%%LASTBIG = 21, % TOTAL NO. OF BIG STATES, I.E. LAST NO. + 1 %
%%LASTSMAL= 47; % TOTAL NO. OF SMALL STATES, I.E. LAST NO. +1 %
!
! --------------------------------------------------
!
SWITCHES NOLIST;
%%%BEGIN SMALL STATE PLIT%%%
BIND DODO2 = PLIT ( SMALSTATE GLOBALLY NAMES
S ,
ILL0S^27 + ILL1S^18 + ILL2S^9 + ILL3S^0 ,
TAB0S^27 + TAB1S^18 + TAB2S^9 + TAB3S^0 ,
LT0S^27 + LT1S^18 + LT2S^9 + LT3S^0 ,
BLANK0S^27 + BLANK1S^18 + BLANK2S^9 + BLANK3S^0 ,
SPEC0S^27 + SPEC1S^18 + SPEC2S^9 + SPEC3S^0 ,
DIGIT0S^27 + DIGIT1S^18 + DIGIT2S^9 + DIGIT3S^0 ,
UPPER0S^27 + UPPER1S^18 + UPPER2S^9 + UPPER3S^0 ,
LOWER0S^27 + LOWER1S^18 + LOWER2S^9 + LOWER3S^0 ,
FOS0S^27 + FOS1S^18 + FOS2S^9 + FOS3S^0 ,
EOB0S^27 + EOB1S^18 + EOB2S^9 + EOB3S^0 ,
REMARK0S^27 + REMARK1S^18 + REMARK2S^9 + REMARK3S^0 ,
S ,
ILL4S^27 + ILL5S^18 + ILL6S^9 + ILL7S^0 ,
TAB4S^27 + TAB5S^18 + TAB6S^9 + TAB7S^0 ,
LT4S^27 + LT5S^18 + LT6S^9 + LT7S^0 ,
BLANK4S^27 + BLANK5S^18 + BLANK6S^9 + BLANK7S^0 ,
SPEC4S^27 + SPEC5S^18 + SPEC6S^9 + SPEC7S^0 ,
DIGIT4S^27 + DIGIT5S^18 + DIGIT6S^9 + DIGIT7S^0 ,
UPPER4S^27 + UPPER5S^18 + UPPER6S^9 + UPPER7S^0 ,
LOWER4S^27 + LOWER5S^18 + LOWER6S^9 + LOWER7S^0 ,
FOS4S^27 + FOS5S^18 + FOS6S^9 + FOS7S^0 ,
EOB4S^27 + EOB5S^18 + EOB6S^9 + EOB7S^0 ,
REMARK4S^27 + REMARK5S^18 + REMARK6S^9 + REMARK7S^0 ,
S ,
ILL8S^27 + ILL9S^18 + ILL10S^9 + ILL11S^0 ,
TAB8S^27 + TAB9S^18 + TAB10S^9 + TAB11S^0 ,
LT8S^27 + LT9S^18 + LT10S^9 + LT11S^0 ,
BLANK8S^27 + BLANK9S^18 + BLANK10S^9 + BLANK11S^0 ,
SPEC8S^27 + SPEC9S^18 + SPEC10S^9 + SPEC11S^0 ,
DIGIT8S^27 + DIGIT9S^18 + DIGIT10S^9 + DIGIT11S^0 ,
UPPER8S^27 + UPPER9S^18 + UPPER10S^9 + UPPER11S^0 ,
LOWER8S^27 + LOWER9S^18 + LOWER10S^9 + LOWER11S^0 ,
FOS8S^27 + FOS9S^18 + FOS10S^9 + FOS11S^0 ,
EOB8S^27 + EOB9S^18 + EOB10S^9 + EOB11S^0 ,
REMARK8S^27 + REMARK9S^18 + REMARK10S^9 + REMARK11S^0 ,
S ,
ILL12S^27 + ILL13S^18 + ILL14S^9 + ILL15S^0 ,
TAB12S^27 + TAB13S^18 + TAB14S^9 + TAB15S^0 ,
LT12S^27 + LT13S^18 + LT14S^9 + LT15S^0 ,
BLANK12S^27 + BLANK13S^18 + BLANK14S^9 + BLANK15S^0 ,
SPEC12S^27 + SPEC13S^18 + SPEC14S^9 + SPEC15S^0 ,
DIGIT12S^27 + DIGIT13S^18 + DIGIT14S^9 + DIGIT15S^0 ,
UPPER12S^27 + UPPER13S^18 + UPPER14S^9 + UPPER15S^0 ,
LOWER12S^27 + LOWER13S^18 + LOWER14S^9 + LOWER15S^0 ,
FOS12S^27 + FOS13S^18 + FOS14S^9 + FOS15S^0 ,
EOB12S^27 + EOB13S^18 + EOB14S^9 + EOB15S^0 ,
REMARK12S^27 + REMARK13S^18 + REMARK14S^9 + REMARK15S^0 ,
S ,
ILL16S^27 + ILL17S^18 + ILL18S^9 + ILL19S^0 ,
TAB16S^27 + TAB17S^18 + TAB18S^9 + TAB19S^0 ,
LT16S^27 + LT17S^18 + LT18S^9 + LT19S^0 ,
BLANK16S^27 + BLANK17S^18 + BLANK18S^9 + BLANK19S^0 ,
SPEC16S^27 + SPEC17S^18 + SPEC18S^9 + SPEC19S^0 ,
DIGIT16S^27 + DIGIT17S^18 + DIGIT18S^9 + DIGIT19S^0 ,
UPPER16S^27 + UPPER17S^18 + UPPER18S^9 + UPPER19S^0 ,
LOWER16S^27 + LOWER17S^18 + LOWER18S^9 + LOWER19S^0 ,
FOS16S^27 + FOS17S^18 + FOS18S^9 + FOS19S^0 ,
EOB16S^27 + EOB17S^18 + EOB18S^9 + EOB19S^0 ,
REMARK16S^27 + REMARK17S^18 + REMARK18S^9 + REMARK19S^0 ,
S ,
ILL20S^27 + ILL21S^18 + ILL22S^9 + ILL23S^0 ,
TAB20S^27 + TAB21S^18 + TAB22S^9 + TAB23S^0 ,
LT20S^27 + LT21S^18 + LT22S^9 + LT23S^0 ,
BLANK20S^27 + BLANK21S^18 + BLANK22S^9 + BLANK23S^0 ,
SPEC20S^27 + SPEC21S^18 + SPEC22S^9 + SPEC23S^0 ,
DIGIT20S^27 + DIGIT21S^18 + DIGIT22S^9 + DIGIT23S^0 ,
UPPER20S^27 + UPPER21S^18 + UPPER22S^9 + UPPER23S^0 ,
LOWER20S^27 + LOWER21S^18 + LOWER22S^9 + LOWER23S^0 ,
FOS20S^27 + FOS21S^18 + FOS22S^9 + FOS23S^0 ,
EOB20S^27 + EOB21S^18 + EOB22S^9 + EOB23S^0 ,
REMARK20S^27 + REMARK21S^18 + REMARK22S^9 + REMARK23S^0 ,
S ,
ILL24S^27 + ILL25S^18 + ILL26S^9 + ILL27S^0 ,
TAB24S^27 + TAB25S^18 + TAB26S^9 + TAB27S^0 ,
LT24S^27 + LT25S^18 + LT26S^9 + LT27S^0 ,
BLANK24S^27 + BLANK25S^18 + BLANK26S^9 + BLANK27S^0 ,
SPEC24S^27 + SPEC25S^18 + SPEC26S^9 + SPEC27S^0 ,
DIGIT24S^27 + DIGIT25S^18 + DIGIT26S^9 + DIGIT27S^0 ,
UPPER24S^27 + UPPER25S^18 + UPPER26S^9 + UPPER27S^0 ,
LOWER24S^27 + LOWER25S^18 + LOWER26S^9 + LOWER27S^0 ,
FOS24S^27 + FOS25S^18 + FOS26S^9 + FOS27S^0 ,
EOB24S^27 + EOB25S^18 + EOB26S^9 + EOB27S^0 ,
REMARK24S^27 + REMARK25S^18 + REMARK26S^9 + REMARK27S^0 ,
S ,
ILL28S^27 + ILL29S^18 + ILL30S^9 + ILL31S^0 ,
TAB28S^27 + TAB29S^18 + TAB30S^9 + TAB31S^0 ,
LT28S^27 + LT29S^18 + LT30S^9 + LT31S^0 ,
BLANK28S^27 + BLANK29S^18 + BLANK30S^9 + BLANK31S^0 ,
SPEC28S^27 + SPEC29S^18 + SPEC30S^9 + SPEC31S^0 ,
DIGIT28S^27 + DIGIT29S^18 + DIGIT30S^9 + DIGIT31S^0 ,
UPPER28S^27 + UPPER29S^18 + UPPER30S^9 + UPPER31S^0 ,
LOWER28S^27 + LOWER29S^18 + LOWER30S^9 + LOWER31S^0 ,
FOS28S^27 + FOS29S^18 + FOS30S^9 + FOS31S^0 ,
EOB28S^27 + EOB29S^18 + EOB30S^9 + EOB31S^0 ,
REMARK28S^27 + REMARK29S^18 + REMARK30S^9 + REMARK31S^0 ,
S ,
ILL32S^27 + ILL33S^18 + ILL34S^9 + ILL35S^0 ,
TAB32S^27 + TAB33S^18 + TAB34S^9 + TAB35S^0 ,
LT32S^27 + LT33S^18 + LT34S^9 + LT35S^0 ,
BLANK32S^27 + BLANK33S^18 + BLANK34S^9 + BLANK35S^0 ,
SPEC32S^27 + SPEC33S^18 + SPEC34S^9 + SPEC35S^0 ,
DIGIT32S^27 + DIGIT33S^18 + DIGIT34S^9 + DIGIT35S^0 ,
UPPER32S^27 + UPPER33S^18 + UPPER34S^9 + UPPER35S^0 ,
LOWER32S^27 + LOWER33S^18 + LOWER34S^9 + LOWER35S^0 ,
FOS32S^27 + FOS33S^18 + FOS34S^9 + FOS35S^0 ,
EOB32S^27 + EOB33S^18 + EOB34S^9 + EOB35S^0 ,
REMARK32S^27 + REMARK33S^18 + REMARK34S^9 + REMARK35S^0 ,
S ,
ILL36S^27 + ILL37S^18 + ILL38S^9 + ILL39S^0 ,
TAB36S^27 + TAB37S^18 + TAB38S^9 + TAB39S^0 ,
LT36S^27 + LT37S^18 + LT38S^9 + LT39S^0 ,
BLANK36S^27 + BLANK37S^18 + BLANK38S^9 + BLANK39S^0 ,
SPEC36S^27 + SPEC37S^18 + SPEC38S^9 + SPEC39S^0 ,
DIGIT36S^27 + DIGIT37S^18 + DIGIT38S^9 + DIGIT39S^0 ,
UPPER36S^27 + UPPER37S^18 + UPPER38S^9 + UPPER39S^0 ,
LOWER36S^27 + LOWER37S^18 + LOWER38S^9 + LOWER39S^0 ,
FOS36S^27 + FOS37S^18 + FOS38S^9 + FOS39S^0 ,
EOB36S^27 + EOB37S^18 + EOB38S^9 + EOB39S^0 ,
REMARK36S^27 + REMARK37S^18 + REMARK38S^9 + REMARK39S^0 ,
![742] ADD STATES FOR STOP/PAUSE STATEMENTS
S ,
%[742]% ILL40S^27 + ILL41S^18 + ILL42S^9 + ILL43S ,
%[742]% TAB40S^27 + TAB41S^18 + TAB42S^9 + TAB43S ,
%[742]% LT40S^27 + LT41S^18 + LT42S^9 + LT43S ,
%[742]% BLANK40S^27 + BLANK41S^18 + BLANK42S^9 + BLANK43S ,
%[742]% SPEC40S^27 + SPEC41S^18 + SPEC42S^9 + SPEC43S ,
%[742]% DIGIT40S^27 + DIGIT41S^18 + DIGIT42S^9 + DIGIT43S ,
%[742]% UPPER40S^27 + UPPER41S^18 + UPPER42S^9 + UPPER43S ,
%[742]% LOWER40S^27 + LOWER41S^18 + LOWER42S^9 + LOWER43S ,
%[742]% FOS40S^27 + FOS41S^18 + FOS42S^9 + FOS43S ,
%[742]% EOB40S^27 + EOB41S^18 + EOB42S^9 + EOB43S ,
%[742]% REMARK40S^27 + REMARK41S^18 + REMARK42S^9 + REMARK43S ,
S ,
ILL44S^27 + ILL45S^18 + ILL46S^9 %( + ILL47S )% ,
TAB44S^27 + TAB45S^18 + TAB46S^9 %( + TAB47S )% ,
LT44S^27 + LT45S^18 + LT46S^9 %( + LT47S )% ,
BLANK44S^27 + BLANK45S^18 + BLANK46S^9 %( + BLANK47S )% ,
SPEC44S^27 + SPEC45S^18 + SPEC46S^9 %( + SPEC47S )% ,
DIGIT44S^27 + DIGIT45S^18 + DIGIT46S^9 %( + DIGIT47S )% ,
UPPER44S^27 + UPPER45S^18 + UPPER46S^9 %( + UPPER47S )% ,
LOWER44S^27 + LOWER45S^18 + LOWER46S^9 %( + LOWER47S )% ,
FOS44S^27 + FOS45S^18 + FOS46S^9 %( + FOS47S )% ,
EOB44S^27 + EOB45S^18 + EOB46S^9 %( + EOB47S )% ,
REMARK44S^27 + REMARK45S^18 + REMARK46S^9 %( + REMARK47S )%
);
%%%END SMALL STATE PLIT%%%
%%%BEGIN BIG STATE PLIT%%%
BIND DODO1 = PLIT ( BIGSTATE GLOBALLY NAMES
B ,
ILL0B^27 + ILL1B^18 + ILL2B^9 + ILL3B^0 ,
TAB0B^27 + TAB1B^18 + TAB2B^9 + TAB3B^0 ,
LT0B^27 + LT1B^18 + LT2B^9 + LT3B^0 ,
BLANK0B^27 + BLANK1B^18 + BLANK2B^9 + BLANK3B^0 ,
SPEC0B^27 + SPEC1B^18 + SPEC2B^9 + SPEC3B^0 ,
DIGIT0B^27 + DIGIT1B^18 + DIGIT2B^9 + DIGIT3B^0 ,
UPPER0B^27 + UPPER1B^18 + UPPER2B^9 + UPPER3B^0 ,
LOWER0B^27 + LOWER1B^18 + LOWER2B^9 + LOWER3B^0 ,
FOS0B^27 + FOS1B^18 + FOS2B^9 + FOS3B^0 ,
EOB0B^27 + EOB1B^18 + EOB2B^9 + EOB3B^0 ,
REMARK0B^27 + REMARK1B^18 + REMARK2B^9 + REMARK3B^0 ,
ANDSGN0B^27 + ANDSGN1B^18 + ANDSGN2B^9 + ANDSGN3B^0 ,
LPAREN0B^27 + LPAREN1B^18 + LPAREN2B^9 + LPAREN3B^0 ,
RPAREN0B^27 + RPAREN1B^18 + RPAREN2B^9 + RPAREN3B^0 ,
COLON0B^27 + COLON1B^18 + COLON2B^9 + COLON3B^0 ,
COMMA0B^27 + COMMA1B^18 + COMMA2B^9 + COMMA3B^0 ,
DOLLAR0B^27 + DOLLAR1B^18 + DOLLAR2B^9 + DOLLAR3B^0 ,
MINUS0B^27 + MINUS1B^18 + MINUS2B^9 + MINUS3B^0 ,
SLASH0B^27 + SLASH1B^18 + SLASH2B^9 + SLASH3B^0 ,
PLUS0B^27 + PLUS1B^18 + PLUS2B^9 + PLUS3B^0 ,
ASTERISK0B^27 + ASTERISK1B^18 + ASTERISK2B^9 + ASTERISK3B^0 ,
EQUAL0B^27 + EQUAL1B^18 + EQUAL2B^9 + EQUAL3B^0 ,
LTSGN0B^27 + LTSGN1B^18 + LTSGN2B^9 + LTSGN3B^0 ,
GTSGN0B^27 + GTSGN1B^18 + GTSGN2B^9 + GTSGN3B^0 ,
NEQSGN0B^27 + NEQSGN1B^18 + NEQSGN2B^9 + NEQSGN3B^0 ,
DOT0B^27 + DOT1B^18 + DOT2B^9 + DOT3B^0 ,
SEMICOL0B^27 + SEMICOL1B^18 + SEMICOL2B^9 + SEMICOL3B^0 ,
LITSGN0B^27 + LITSGN1B^18 + LITSGN2B^9 + LITSGN3B^0 ,
OCTSGN0B^27 + OCTSGN1B^18 + OCTSGN2B^9 + OCTSGN3B^0 ,
COMNTSGN0B^27 + COMNTSGN1B^18 + COMNTSGN2B^9 + COMNTSGN3B^0 ,
DEBUGSGN0B^27 + DEBUGSGN1B^18 + DEBUGSGN2B^9 + DEBUGSGN3B^0 ,
UPAROW0B^27 + UPAROW1B^18 + UPAROW2B^9 + UPAROW3B^0 ,
B ,
ILL4B^27 + ILL5B^18 + ILL6B^9 + ILL7B^0 ,
TAB4B^27 + TAB5B^18 + TAB6B^9 + TAB7B^0 ,
LT4B^27 + LT5B^18 + LT6B^9 + LT7B^0 ,
BLANK4B^27 + BLANK5B^18 + BLANK6B^9 + BLANK7B^0 ,
SPEC4B^27 + SPEC5B^18 + SPEC6B^9 + SPEC7B^0 ,
DIGIT4B^27 + DIGIT5B^18 + DIGIT6B^9 + DIGIT7B^0 ,
UPPER4B^27 + UPPER5B^18 + UPPER6B^9 + UPPER7B^0 ,
LOWER4B^27 + LOWER5B^18 + LOWER6B^9 + LOWER7B^0 ,
FOS4B^27 + FOS5B^18 + FOS6B^9 + FOS7B^0 ,
EOB4B^27 + EOB5B^18 + EOB6B^9 + EOB7B^0 ,
REMARK4B^27 + REMARK5B^18 + REMARK6B^9 + REMARK7B^0 ,
ANDSGN4B^27 + ANDSGN5B^18 + ANDSGN6B^9 + ANDSGN7B^0 ,
LPAREN4B^27 + LPAREN5B^18 + LPAREN6B^9 + LPAREN7B^0 ,
RPAREN4B^27 + RPAREN5B^18 + RPAREN6B^9 + RPAREN7B^0 ,
COLON4B^27 + COLON5B^18 + COLON6B^9 + COLON7B^0 ,
COMMA4B^27 + COMMA5B^18 + COMMA6B^9 + COMMA7B^0 ,
DOLLAR4B^27 + DOLLAR5B^18 + DOLLAR6B^9 + DOLLAR7B^0 ,
MINUS4B^27 + MINUS5B^18 + MINUS6B^9 + MINUS7B^0 ,
SLASH4B^27 + SLASH5B^18 + SLASH6B^9 + SLASH7B^0 ,
PLUS4B^27 + PLUS5B^18 + PLUS6B^9 + PLUS7B^0 ,
ASTERISK4B^27 + ASTERISK5B^18 + ASTERISK6B^9 + ASTERISK7B^0 ,
EQUAL4B^27 + EQUAL5B^18 + EQUAL6B^9 + EQUAL7B^0 ,
LTSGN4B^27 + LTSGN5B^18 + LTSGN6B^9 + LTSGN7B^0 ,
GTSGN4B^27 + GTSGN5B^18 + GTSGN6B^9 + GTSGN7B^0 ,
NEQSGN4B^27 + NEQSGN5B^18 + NEQSGN6B^9 + NEQSGN7B^0 ,
DOT4B^27 + DOT5B^18 + DOT6B^9 + DOT7B^0 ,
SEMICOL4B^27 + SEMICOL5B^18 + SEMICOL6B^9 + SEMICOL7B^0 ,
LITSGN4B^27 + LITSGN5B^18 + LITSGN6B^9 + LITSGN7B^0 ,
OCTSGN4B^27 + OCTSGN5B^18 + OCTSGN6B^9 + OCTSGN7B^0 ,
COMNTSGN4B^27 + COMNTSGN5B^18 + COMNTSGN6B^9 + COMNTSGN7B^0 ,
DEBUGSGN4B^27 + DEBUGSGN5B^18 + DEBUGSGN6B^9 + DEBUGSGN7B^0 ,
UPAROW4B^27 + UPAROW5B^18 + UPAROW6B^9 + UPAROW7B^0 ,
B ,
ILL8B^27 + ILL9B^18 + ILL10B^9 + ILL11B^0 ,
TAB8B^27 + TAB9B^18 + TAB10B^9 + TAB11B^0 ,
LT8B^27 + LT9B^18 + LT10B^9 + LT11B^0 ,
BLANK8B^27 + BLANK9B^18 + BLANK10B^9 + BLANK11B^0 ,
SPEC8B^27 + SPEC9B^18 + SPEC10B^9 + SPEC11B^0 ,
DIGIT8B^27 + DIGIT9B^18 + DIGIT10B^9 + DIGIT11B^0 ,
UPPER8B^27 + UPPER9B^18 + UPPER10B^9 + UPPER11B^0 ,
LOWER8B^27 + LOWER9B^18 + LOWER10B^9 + LOWER11B^0 ,
FOS8B^27 + FOS9B^18 + FOS10B^9 + FOS11B^0 ,
EOB8B^27 + EOB9B^18 + EOB10B^9 + EOB11B^0 ,
REMARK8B^27 + REMARK9B^18 + REMARK10B^9 + REMARK11B^0 ,
ANDSGN8B^27 + ANDSGN9B^18 + ANDSGN10B^9 + ANDSGN11B^0 ,
LPAREN8B^27 + LPAREN9B^18 + LPAREN10B^9 + LPAREN11B^0 ,
RPAREN8B^27 + RPAREN9B^18 + RPAREN10B^9 + RPAREN11B^0 ,
COLON8B^27 + COLON9B^18 + COLON10B^9 + COLON11B^0 ,
COMMA8B^27 + COMMA9B^18 + COMMA10B^9 + COMMA11B^0 ,
DOLLAR8B^27 + DOLLAR9B^18 + DOLLAR10B^9 + DOLLAR11B^0 ,
MINUS8B^27 + MINUS9B^18 + MINUS10B^9 + MINUS11B^0 ,
SLASH8B^27 + SLASH9B^18 + SLASH10B^9 + SLASH11B^0 ,
PLUS8B^27 + PLUS9B^18 + PLUS10B^9 + PLUS11B^0 ,
ASTERISK8B^27 + ASTERISK9B^18 + ASTERISK10B^9 + ASTERISK11B^0 ,
EQUAL8B^27 + EQUAL9B^18 + EQUAL10B^9 + EQUAL11B^0 ,
LTSGN8B^27 + LTSGN9B^18 + LTSGN10B^9 + LTSGN11B^0 ,
GTSGN8B^27 + GTSGN9B^18 + GTSGN10B^9 + GTSGN11B^0 ,
NEQSGN8B^27 + NEQSGN9B^18 + NEQSGN10B^9 + NEQSGN11B^0 ,
DOT8B^27 + DOT9B^18 + DOT10B^9 + DOT11B^0 ,
SEMICOL8B^27 + SEMICOL9B^18 + SEMICOL10B^9 + SEMICOL11B^0 ,
LITSGN8B^27 + LITSGN9B^18 + LITSGN10B^9 + LITSGN11B^0 ,
OCTSGN8B^27 + OCTSGN9B^18 + OCTSGN10B^9 + OCTSGN11B^0 ,
COMNTSGN8B^27 + COMNTSGN9B^18 + COMNTSGN10B^9 + COMNTSGN11B^0 ,
DEBUGSGN8B^27 + DEBUGSGN9B^18 + DEBUGSGN10B^9 + DEBUGSGN11B^0 ,
UPAROW8B^27 + UPAROW9B^18 + UPAROW10B^9 + UPAROW11B^0 ,
B ,
ILL12B^27 + ILL13B^18 + ILL14B^9 + ILL15B^0 ,
TAB12B^27 + TAB13B^18 + TAB14B^9 + TAB15B^0 ,
LT12B^27 + LT13B^18 + LT14B^9 + LT15B^0 ,
BLANK12B^27 + BLANK13B^18 + BLANK14B^9 + BLANK15B^0 ,
SPEC12B^27 + SPEC13B^18 + SPEC14B^9 + SPEC15B^0 ,
DIGIT12B^27 + DIGIT13B^18 + DIGIT14B^9 + DIGIT15B^0 ,
UPPER12B^27 + UPPER13B^18 + UPPER14B^9 + UPPER15B^0 ,
LOWER12B^27 + LOWER13B^18 + LOWER14B^9 + LOWER15B^0 ,
FOS12B^27 + FOS13B^18 + FOS14B^9 + FOS15B^0 ,
EOB12B^27 + EOB13B^18 + EOB14B^9 + EOB15B^0 ,
REMARK12B^27 + REMARK13B^18 + REMARK14B^9 + REMARK15B^0 ,
ANDSGN12B^27 + ANDSGN13B^18 + ANDSGN14B^9 + ANDSGN15B^0 ,
LPAREN12B^27 + LPAREN13B^18 + LPAREN14B^9 + LPAREN15B^0 ,
RPAREN12B^27 + RPAREN13B^18 + RPAREN14B^9 + RPAREN15B^0 ,
COLON12B^27 + COLON13B^18 + COLON14B^9 + COLON15B^0 ,
COMMA12B^27 + COMMA13B^18 + COMMA14B^9 + COMMA15B^0 ,
DOLLAR12B^27 + DOLLAR13B^18 + DOLLAR14B^9 + DOLLAR15B^0 ,
MINUS12B^27 + MINUS13B^18 + MINUS14B^9 + MINUS15B^0 ,
SLASH12B^27 + SLASH13B^18 + SLASH14B^9 + SLASH15B^0 ,
PLUS12B^27 + PLUS13B^18 + PLUS14B^9 + PLUS15B^0 ,
ASTERISK12B^27 + ASTERISK13B^18 + ASTERISK14B^9 + ASTERISK15B^0 ,
EQUAL12B^27 + EQUAL13B^18 + EQUAL14B^9 + EQUAL15B^0 ,
LTSGN12B^27 + LTSGN13B^18 + LTSGN14B^9 + LTSGN15B^0 ,
GTSGN12B^27 + GTSGN13B^18 + GTSGN14B^9 + GTSGN15B^0 ,
NEQSGN12B^27 + NEQSGN13B^18 + NEQSGN14B^9 + NEQSGN15B^0 ,
DOT12B^27 + DOT13B^18 + DOT14B^9 + DOT15B^0 ,
SEMICOL12B^27 + SEMICOL13B^18 + SEMICOL14B^9 + SEMICOL15B^0 ,
LITSGN12B^27 + LITSGN13B^18 + LITSGN14B^9 + LITSGN15B^0 ,
OCTSGN12B^27 + OCTSGN13B^18 + OCTSGN14B^9 + OCTSGN15B^0 ,
COMNTSGN12B^27 + COMNTSGN13B^18 + COMNTSGN14B^9 + COMNTSGN15B^0 ,
DEBUGSGN12B^27 + DEBUGSGN13B^18 + DEBUGSGN14B^9 + DEBUGSGN15B^0 ,
UPAROW12B^27 + UPAROW13B^18 + UPAROW14B^9 + UPAROW15B^0 ,
B ,
ILL16B^27 + ILL17B^18 + ILL18B^9 + ILL19B ,
TAB16B^27 + TAB17B^18 + TAB18B^9 + TAB19B ,
LT16B^27 + LT17B^18 + LT18B^9 + LT19B ,
BLANK16B^27 + BLANK17B^18 + BLANK18B^9 + BLANK19B ,
SPEC16B^27 + SPEC17B^18 + SPEC18B^9 + SPEC19B ,
DIGIT16B^27 + DIGIT17B^18 + DIGIT18B^9 + DIGIT19B ,
UPPER16B^27 + UPPER17B^18 + UPPER18B^9 + UPPER19B ,
LOWER16B^27 + LOWER17B^18 + LOWER18B^9 + LOWER19B ,
FOS16B^27 + FOS17B^18 + FOS18B^9 + FOS19B ,
EOB16B^27 + EOB17B^18 + EOB18B^9 + EOB19B ,
REMARK16B^27 + REMARK17B^18 + REMARK18B^9 + REMARK19B ,
ANDSGN16B^27 + ANDSGN17B^18 + ANDSGN18B^9 + ANDSGN19B ,
LPAREN16B^27 + LPAREN17B^18 + LPAREN18B^9 + LPAREN19B ,
RPAREN16B^27 + RPAREN17B^18 + RPAREN18B^9 + RPAREN19B ,
COLON16B^27 + COLON17B^18 + COLON18B^9 + COLON19B ,
COMMA16B^27 + COMMA17B^18 + COMMA18B^9 + COMMA19B ,
DOLLAR16B^27 + DOLLAR17B^18 + DOLLAR18B^9 + DOLLAR19B ,
MINUS16B^27 + MINUS17B^18 + MINUS18B^9 + MINUS19B ,
SLASH16B^27 + SLASH17B^18 + SLASH18B^9 + SLASH19B ,
PLUS16B^27 + PLUS17B^18 + PLUS18B^9 + PLUS19B ,
ASTERISK16B^27 + ASTERISK17B^18 + ASTERISK18B^9 + ASTERISK19B ,
EQUAL16B^27 + EQUAL17B^18 + EQUAL18B^9 + EQUAL19B ,
LTSGN16B^27 + LTSGN17B^18 + LTSGN18B^9 + LTSGN19B ,
GTSGN16B^27 + GTSGN17B^18 + GTSGN18B^9 + GTSGN19B ,
NEQSGN16B^27 + NEQSGN17B^18 + NEQSGN18B^9 + NEQSGN19B ,
DOT16B^27 + DOT17B^18 + DOT18B^9 + DOT19B ,
SEMICOL16B^27 + SEMICOL17B^18 + SEMICOL18B^9 + SEMICOL19B ,
LITSGN16B^27 + LITSGN17B^18 + LITSGN18B^9 + LITSGN19B ,
OCTSGN16B^27 + OCTSGN17B^18 + OCTSGN18B^9 + OCTSGN19B ,
COMNTSGN16B^27 + COMNTSGN17B^18 + COMNTSGN18B^9 + COMNTSGN19B ,
DEBUGSGN16B^27 + DEBUGSGN17B^18 + DEBUGSGN18B^9 + DEBUGSGN19B ,
UPAROW16B^27 + UPAROW17B^18 + UPAROW18B^9 + UPAROW19B ,
B ,
ILL20B^27 ,
TAB20B^27 ,
LT20B^27 ,
BLANK20B^27 ,
SPEC20B^27 ,
DIGIT20B^27 ,
UPPER20B^27 ,
LOWER20B^27 ,
FOS20B^27 ,
EOB20B^27 ,
REMARK20B^27 ,
ANDSGN20B^27 ,
LPAREN20B^27 ,
RPAREN20B^27 ,
COLON20B^27 ,
COMMA20B^27 ,
DOLLAR20B^27 ,
MINUS20B^27 ,
SLASH20B^27 ,
PLUS20B^27 ,
ASTERISK20B^27 ,
EQUAL20B^27 ,
LTSGN20B^27 ,
GTSGN20B^27 ,
NEQSGN20B^27 ,
DOT20B^27 ,
SEMICOL20B^27 ,
LITSGN20B^27 ,
OCTSGN20B^27 ,
COMNTSGN20B^27 ,
DEBUGSGN20B^27 ,
UPAROW20B^27
);
%%%END BIG STATE PLIT%%%
SWITCHES LIST ;
%ROUTLEX%
!---------------------------------------------------------------------------
GLOBAL ROUTINE LEXICAL (STATEE) =
BEGIN % ROUTINE LEXICAL %
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-((.I/STPACK)*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-((.I/STPACK)*STPACK)+1))*STBITS + ( 36 MOD STBITS ) , STBITS , CODE >
);
% THE FIRST ENTRY IN EACH ACTION TABLE IS AN INDICATOR AS TO BIG OR SMALL
CODES - S(0) SMALL, B(1) BIG. THIS ENTRY MUST BE REFERENCED
AS [-1].
%
MAP BIG BIGSTATE [ LASTBIG ];
MAP SMAL SMALSTATE [ LASTSMAL ];
!
! --------------------------------------------------
!
! ASSOCIATE STATE NAMES TO THE STARTING POSITION OF THEIR STATE TABLES.
! THE TOTAL NUMBER OF BIGSTATES
! AND SMALL STATES MUST BE INPUT TO THE TECO MACROS BIGSTA.TEC AND
! SMALST.TEC RESPECTIVELY IN ORDER FOR THEM TO GENERATE THE PROPER SIZE PLIT
! WHICH PRESETS BIGSTATE AND SMALSTATE.
! THIS FILE MUST FOLLOW THE PLITS WHICH DEFINE THE BIG AND SMALL STATE TABLES
!
! --------------------------------------------------
!
! BINDS OF THE BIG STATES TO BIGSTATE[I]
%BIGDEF%
BIND
! STATE NAME = BIGSTATE[I]
STSTMNT = BIGSTATE [0],
STILINE= BIGSTATE [1],
STLEXEME = BIGSTATE [2],
STSKIP = BIGSTATE [3],
STCONTINUE = BIGSTATE [4],
STNOEND = BIGSTATE [5],
STEOP = BIGSTATE [6],
STTERM = BIGSTATE [7],
STCLASF2 = BIGSTATE [8],
STCLASAL1 = BIGSTATE [9],
STIFCHK = BIGSTATE [10],
STDOCHK1 = BIGSTATE [11],
STDOCHK2 = BIGSTATE [12],
STCLASAL2 = BIGSTATE [13],
STCLASAL2A = BIGSTATE [14],
STCLASF4 = BIGSTATE [15],
STDOUBLEX = BIGSTATE [16],
STGETCONST = BIGSTATE [17],
STFMTLEX = BIGSTATE [18],
%1247% STCLASAL1A = BIGSTATE [19],
%1247% STCLASAL1B = BIGSTATE [20],
% LASTBIG = ??? SET BIND APPEARING BEFORE PLIT DEFINITIONS%
BIGEND = 0 ;
!
!
! BINDS OF THE SMALL STATE NAMES TO SMALSTATE[I]
!
%SMALDEF%
BIND
! STATE NAME = SMALSTATE[I]
!
STREMARK= SMALSTATE [0],
STINIT = SMALSTATE [1],
STRETNX = SMALSTATE [2],
STNULLST = SMALSTATE [3],
STCOMNT = SMALSTATE [4],
STCALCONT = SMALSTATE [5],
STCLABSKP = SMALSTATE [6],
STCNTCONT = SMALSTATE [7],
STCITCONT = SMALSTATE [8],
STILABEL = SMALSTATE [9],
STLABSKP = SMALSTATE [10],
STILNTCONT = SMALSTATE [11],
STILITCONT = SMALSTATE [12],
STGETLIT = SMALSTATE [13],
STSKNAME = SMALSTATE [14],
STCONSTSKP = SMALSTATE [15],
STSKPHOL = SMALSTATE [16],
STCLASF3 = SMALSTATE [17],
STSPELLING = SMALSTATE [18],
STIDENT = SMALSTATE [19],
STDOT = SMALSTATE [20],
STSCANOP = SMALSTATE [21],
STBLDDBLINT = SMALSTATE [22],
STREALCON = SMALSTATE [23],
STREALCON1 = SMALSTATE [24],
STOPCHK = SMALSTATE [25],
STINTEXPONENT = SMALSTATE [26],
STINTEXP0 = SMALSTATE [27],
STINTEXP1 = SMALSTATE [28],
STHOLEX = SMALSTATE [29],
STLITLEX = SMALSTATE [30],
STLITEND = SMALSTATE [31],
STOCTQ = SMALSTATE [32],
STOCTQ0 = SMALSTATE [33],
STOCTQ1 = SMALSTATE [34],
STIFCLASIF = SMALSTATE [35],
STCSCAN = SMALSTATE [36],
STSSCAN = SMALSTATE [37],
STOPOBJ = SMALSTATE [38],
STFMTQT = SMALSTATE [39],
STFHOLCON = SMALSTATE [40],
STFHOLPKUP = SMALSTATE [41],
%[742]% STSIXDIGIT = SMALSTATE[42],
%1214% STTHENCHK = SMALSTATE[43],
%1465% STKEYSCAN = SMALSTATE[44],
%1465% STKEY1CHK = SMALSTATE[45],
%1573% STDOCHK3 = SMALSTATE[46],
% LASTSMAL = ??? SET BIND APPEARING BEFORE PLIT DEFINITIONS%
SMALEND = 0 ;
! ALL GLOBAL STATE NAMES ARE DEFINED HERE IN THE FOLLOWING FORMAT:
! BIND DUM# = PLIT( EXTNAME GLOBALLY NAMES INTERNAL-NAME )
!
! AN EXTERNAL STATE REFERENCE IS MADE WITH THE CONTENTS
BIND DUM0 = PLIT(
GSTSTMNT GLOBALLY NAMES STSTMNT ,
GSTLEXEME GLOBALLY NAMES STLEXEME ,
GSTNOEND GLOBALLY NAMES STNOEND ,
GSTEOP GLOBALLY NAMES STEOP ,
GSTCSCAN GLOBALLY NAMES STCSCAN ,
GSTSSCAN GLOBALLY NAMES STSSCAN ,
GSTOPOBJ GLOBALLY NAMES STOPOBJ ,
GSTFMTLEX GLOBALLY NAMES STFMTLEX,
GSTIFCLASIF GLOBALLY NAMES STIFCLASIF ,
%1465% GSTKSCAN GLOBALLY NAMES STKEYSCAN
);
ROUTINE
CHKXCR =
BEGIN % CHANGES ALL EXTRANEOUS CRS TO NULL AND OUTPUTS MESSAGE %
LOCAL TMP;
REGISTER CODE = 1,ACTION = 2, CHAR = 3;
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; % CHKXCR %
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!
REGISTER CHAR=3;
IF .CHAR EQL FF
THEN
BEGIN
LINEPTR_CONTPTR_.CURPTR;
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 ROUTINE SPURFF
ROUTINE SPURCR =
BEGIN % DETECTS SPURIOUS CR. RETURNS 1 IF SPUR CR ,OUTPUTS MESSAGE AND 0 IF NO SPURIOUSCR%
REGISTER CODE = 1, ACTION = 2, CHAR = 3;
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; % SPURCR%
! THIS IS THE ROUTINE WHICH WILL INITIAIZE LEXICAL
GLOBAL ROUTINE LEXINI =
BEGIN
INCOMNT _ 0;
IF CURWORD EQL 0
THEN ( % INITIALIZATION FOR FIRST PROGRAM UNIT. PICK UP LINESEQNO IF ANY %
CHARPOS _ 72;
CURPTR _ POOLBEGIN<FIRSTCHAR>;
CHARTMP _ ..CURPTR ;
RETURN LEXICAL ( STINIT )
)
ELSE
( % INITIALIZATION FOR >=2ND PROGRAM UNIT %
IF NOT .SEQLAST THEN LINELINE _ 1;
% ELSE LEAVE IT BECAUSE ITS A LINE SEQUENCE NO. %
CHARTMP _ EOS ;
%BLANK OUT THE BEGINNING 0F MULTIPLE STATEMENT LINES %
TEMP _ .LINEPTR;
UNTIL .TEMP EQL .CURPTR DO REPLACEI(TEMP," ");
!EAT ONE FORM FEED BETWEEN SUBPROGRAMS FOR READABILITY
SCANI(TEMP);
IF ..TEMP EQL FF THEN (SCANI(LINEPTR);SCANI(CURPTR));
RETURN 1
)
END;
!
! --------------------------------------------------
!
! BEGIN ROUTINE LEXICAL
!
! --------------------------------------------------
!
LABEL NEWSTATE,NEWACTION;
! STRUCTURE DEFINITION FOR STATE TABLE REFERENCES
STRUCTURE STATEREF [I] = [1] ( . ( ( ..STATEREF ) + .I ) );
!* REGISTER ACTION = 2 ;
!* REGISTER CHAR=3, CODE=1;
% THE NEXT CHARACTER IS FETCHED FROM THE INTERNAL STATEMENT
BUFFER AND PLACED IN "CHAR". THE CHARACTER CODE IS THEN
FETCHED FROM THE APPROPRIATE CODE TABLE AND PLACED IN "CODE".
%
MAP STATEREF STATE;
% AREA FOR STATE CALL STACK %
OWN STATESTACK[10],
STSTKPTR; ! CURRENT STACK POINTER
% INITIALIZE STACK POINTER %
STSTKPTR _ 0;
% RESTORE THE LAST CHARACTER TO THE REGISTERS %
CHAR _ .CHARTMP;
STATE _ .STATEE; ! PUT STATE IN A REGITER
SETCODE;
% SET LEXLINE TO THE LINENUMBER WHICH BEGINS THE LEXEME %
LEXLINE _ .LINELINE;
WHILE 1 DO
NEWSTATE:BEGIN
LABEL SMALCHAR;
SMALCHAR:
BEGIN
WHILE 1 DO
BEGIN %LOOP%
LABEL BIGCHAR;
BIGCHAR:
BEGIN
%ACTION _ STATE [ .CODE ] ;%
NSCAN ( ACTION, STATE );
WHILE 1 DO
NEWACTION:
BEGIN
IF DBUGIT
THEN
BEGIN % TRACE %
REGISTER T1;
IF ( T1_.BUGOUT AND 2 ) NEQ 0
THEN TRACE(.STATE,.CHAR,.CODE,.ACTION)
END;
%%%BEGIN LEXICAL CASE%%%
CASE .ACTION OF
SET
BEGIN ACMEOB END; ! 0
BEGIN ACMINIT END; ! 1
BEGIN ACMANYS END; ! 2
BEGIN ACMTABB END; ! 3
BEGIN ACMHOLCONDONE END; ! 4
BEGIN ACMFMTHOLPKUP END; ! 5
BEGIN ACMSTSKIP END; ! 6
BEGIN ACMHOLCON END; ! 7
BEGIN ACMREMEND END; ! 8
BEGIN ACMGOBAKNOW END; ! 9
BEGIN ACMLT END; ! 10
BEGIN ACMSTMNTFOS END; ! 11
BEGIN ACMFMTHOLCK END; ! 12
BEGIN ACMGOBAKNXT END; ! 13
BEGIN ACMEXPLT END; ! 14
BEGIN ACMLEXFOS END; ! 15
BEGIN ACMRETNOW END; ! 16
BEGIN ACMIGNCRCALC END; ! 17
BEGIN ACMCALCONT END; ! 18
BEGIN ACMCONTDIG END; ! 19
BEGIN ACMCLABSKP END; ! 20
BEGIN ACMNOEND END; ! 21
BEGIN ACMSTEOP END; ! 22
BEGIN ACMENTREMARK END; ! 23
BEGIN ACMMULTST END; ! 24
BEGIN ACMCLASF1 END; ! 25
BEGIN ACMMULTNULL END; ! 26
BEGIN ACMILLCHAR END; ! 27
BEGIN ACMCOMNT END; ! 28
BEGIN ACMDEBUG END; ! 29
BEGIN ACMCOMNTFOS END; ! 30
BEGIN ACMINTERR END; ! 31
BEGIN ACMNOCONT END; ! 32
BEGIN ACMNULLFOS END; ! 33
BEGIN ACMCITCONT END; ! 34
BEGIN ACMCLABLT END; ! 35
BEGIN ACMENTCLABSKP END; ! 36
BEGIN ACMCBUGCHK END; ! 37
BEGIN ACMENTLAB END; ! 38
BEGIN ACMILABILL END; ! 39
BEGIN ACMILABEDCK END; ! 40
BEGIN ACMILITCONT END; ! 41
BEGIN ACMILABDIG END; ! 42
BEGIN ACMILNTC END; ! 43
BEGIN ACMILNTI END; ! 44
BEGIN ACMILNTD END; ! 45
BEGIN ACMILITNC END; ! 46
BEGIN ACMILITC END; ! 47
BEGIN ACMILABLT END; ! 48
BEGIN ACMUPLOW END; ! 49
BEGIN ACMCONSTSKP END; ! 50
BEGIN ACMSKNAME END; ! 51
BEGIN ACMSKLPAREN END; ! 52
BEGIN ACMSKRPAREN END; ! 53
BEGIN ACMSKCOMMA END; ! 54
BEGIN ACMGETLIT END; ! 55
BEGIN ACMENDLIT END; ! 56
BEGIN ACMBAKTOTERM END; ! 57
BEGIN ACMSKCONBLD END; ! 58
BEGIN ACMSKPHOLX END; ! 59
BEGIN ACMSKPHOL END; ! 60
BEGIN ACMHOLTAB END; ! 61
BEGIN ACMENTERM END; ! 62
BEGIN ACMUNMATEOS END; ! 63
BEGIN ACMFMTQT1 END; ! 64
BEGIN ACMSKILL END; ! 65
BEGIN ACMCLASLT END; ! 66
BEGIN ACMCLASUNREC END; ! 67
BEGIN ACMCLILLCHAR END; ! 68
BEGIN ACMCLASBACK END; ! 69
BEGIN ACMCOMPAR END; ! 70
BEGIN ACMCLASAL1 END; ! 71
BEGIN ACMASGNMNT END; ! 72
BEGIN ACMCLASF2 END; ! 73
BEGIN ACMIFCHK END; ! 74
BEGIN ACMDOCHK END; ! 75
BEGIN ACMARITHIF END; ! 76
BEGIN ACMLOGICIF END; ! 77
BEGIN ACMUNMATUNREC END; ! 78
BEGIN ACMSTFNARRY END; ! 79
BEGIN ACMDOCHK1 END; ! 80
BEGIN ACMDOSTMNT END; ! 81
BEGIN ACMENDCHK END; ! 82
BEGIN ACMCLASF3 END; ! 83
BEGIN ACMCLASF4 END; ! 84
BEGIN ACMKEYTERM END; ! 85
BEGIN ACMUNMATKEY END; ! 86
BEGIN ACMSPELLING END; ! 87
BEGIN ACMBADCHAR END; ! 88
BEGIN ACMSINGLEX END; ! 89
BEGIN ACMDOUBLEX END; ! 90
BEGIN ACMNOTDOUB END; ! 91
BEGIN ACMMAYBDOUB END; ! 92
BEGIN ACMENTIDENT END; ! 93
BEGIN ACMPKUPID END; ! 94
BEGIN ACMENDID END; ! 95
BEGIN ACMENTDOT END; ! 96
BEGIN ACMTRYREAL END; ! 97
BEGIN ACMMISOPER END; ! 98
BEGIN ACMGETOPER END; ! 99
BEGIN ACMOPCHK END; ! 100
BEGIN ACMMISOP1 END; ! 101
BEGIN ACMENTGETCONST END; ! 102
BEGIN ACMGOTINT END; ! 103
BEGIN ACMCHECKLET END; ! 104
BEGIN ACMBILDDBLINT END; ! 105
BEGIN ACMREALCON END; ! 106
BEGIN ACMENTRLBLDD END; ! 107
BEGIN ACMGOTREAL END; ! 108
BEGIN ACMEXDBCHK END; ! 109
BEGIN ACMGOTOP END; ! 110
BEGIN ACMCHKPLMI END; ! 111
BEGIN ACMNOEXP END; ! 112
BEGIN ACMINTEXP1 END; ! 113
BEGIN ACMFMTQT END; ! 114
BEGIN ACMGOTIEXP END; ! 115
BEGIN ACMHOLCHAR END; ! 116
BEGIN ACMHOLEND END; ! 117
BEGIN ACMENTLITLEX END; ! 118
BEGIN ACMLITEDCHK END; ! 119
BEGIN ACMTIC2CHK END; ! 120
BEGIN ACMENTOCTQ END; ! 121
BEGIN ACMNOOCT END; ! 122
BEGIN ACMCHKOCPM END; ! 123
BEGIN ACMOCTQ1 END; ! 124
BEGIN ACMGOTOCT END; ! 125
BEGIN ACMNOTIC END; ! 126
BEGIN ACMSCANCHAR END; ! 127
BEGIN ACMSTRCHK END; ! 128
BEGIN ACMSTOPOCT END; ! 129
BEGIN ACMSTOPLIT END; ! 130
BEGIN ACMFLEX1 END; ! 131
BEGIN ACMFMTEOS END; ! 132
BEGIN ACMFMTCHAR END; ! 133
%[675]% BEGIN ACMRIS END; ! 134
%[742]% BEGIN ACMSTOPINT END; ! 135
%[742]% BEGIN ACMGOT6INT END; ! 136
%[742]% BEGIN ACM6DIGIT END; ! 137
%1214% BEGIN ACMTHENCHK END; ! 138
%1214% BEGIN ACMBLOCKIF END; ! 139
%1247% BEGIN ACMSUBCHK END; ! 140
%1247% BEGIN ACMSUBASSIGN END; ! 141
%1247% BEGIN ACMCLAS1A END; ! 142
%1247% BEGIN ACMSKCOLON END; ! 143
%1247% BEGIN ACMKEYSUB END; ! 144
%1465% BEGIN ACMKEYCHK END; ! 145
%1465% BEGIN ACMKEY1CHK END; ! 146
%1573% BEGIN ACMDOCHK2 END; ! 147
%1573% BEGIN ACMWHILECHK END ! 148
! BEWARE OF SKEWS! CASE STATEMENT MACROS MUST MATCH
! ACTION NAME BINDS AT %ACTDEF%
TES;
%%%END LEXICAL CASE%%%
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 %LOOP%
END; %SMALCHAR%
% GET NEXT CHARACTER AND CLASIFY FOR SMALL STATE %
IF .CHARPOS EQL 0 % CHARACTER POSITION 72 %
THEN IF .STATE NEQ STREMARK
THEN ( ENTREMARK ); % ENTER REMARK PROCESSING STATE %
CHARPOS _ .CHARPOS - 1 ;
ISCAN ( CHAR, CURPTR );
CODE _ SMALCODE;
END %NEWSTATE%
END; ! of LEXICAL
END %LEXICAL%
ELUDOM