                                                                        00000000
% F O R T R A N  C O M P I L E R   XVI.0.00                10/01/74     00001000
  COMMENT: | TITLE: B5500/B5700 MARK XVI SYSTEM RELEASE            |    00001010        
           | FILE ID: SYMBOL/FORTRAN TAPE ID: SYMBOL1/FILE000      |    00001011
           | THIS MATERIAL IS PROPRIETARY TO BURROUGHS CORPORATION |    00001012
           | AND IS NOT TO BE REPRODUCED, USED, OR DISCLOSED       |    00001013
           | EXCEPT IN ACCORDANCE WITH PROGRAM LICENSE OR UPON     |    00001014
           | WRITTEN AUTHORIZATION OF THE PATENT DIVISION OF       |    00001015
           | BURROUGHS CORPORATION, DETROIT, MICHIGAN 48232        |    00001016
           |                                                       |    00001017
           | COPYRIGHT (C)  1971, 1972, 1974                       |    00001018
           |       BURROUGHS CORPORATION                           |    00001019
           |  AA320206   AA393180   AA332366                       |;   00001020 
% BEWARE ALL YE WHO SEEK HEREIN:                                   %997-00001100
% THIS COMPILER IS A MESS.  THE CONCEPTS OF CHARACTER CONVERSION FROM   00001105
% HOLLERITH (= EBCDIC), SCANNING, AND PARSING ARE NOT CLEARLY SEPARATED 00001110
% IN THE CODE,  FOR EXAMPLE, PROCEDURE "SCAN" TRIES TO DO ALL 3 AT ONCE.00001115
% DAN ROSS    UCSC    APRIL 12, 1977                               %997-00001120
COMMENT                                                                 00001900
                        FORTRAN ERROR MESSAGES                          00002000
000   SYNTAX ERROR                                                      00003000
001   MISSING OPERATOR OR PUNCTUATION                                   00004000
002   CONFLICTING COMMON AND/OR EQUIVALENCE ALLOCATION                  00005000
003   MISSING RIGHT PARENTHESIS                                         00006000
004   ENTRY STMT ILLEGAL IN MAIN PGM OR BLOCK DATA                      00007000
005   MISSING END STATEMENT                                             00008000
006   ARITHMETIC EXPRESSION REQUIRED                                    00009000
007   LOGICAL EXPRESSION REQUIRED                                       00010000
008   TOO MANY LEFT PARENTHESES                                         00011000
009   TOO MANY RIGHT PARENTHESES                                        00012000
010   FORMAL PARAMETER ILLEGAL IN COMMON                                00013000
011   FORMAL PARAMETER ILLEGAL IN EQUIVALENCE                           00014000
012   THIS STATEMENT ILLEGAL IN BLOCK DATA SUBPROGRAM                   00015000
013   INFO ARRAY OVERFLOW                                               00016000
014   IMPROPER DO NEST                                                  00017000
015   DO LABEL PREVIOUSLY DEFINED                                       00018000
016   UNRECOGNIZED STATEMENT TYPE                                       00019000
017   ILLEGAL DO STATEMENT                                              00020000
018   FORMAT STATEMENT MUST HAVE LABEL                                  00021000
019   UNDEFINED LABEL                                                   00022000
020   MULTIPLE DEFINITION                                               00023000
021   ILLEGAL IDENTIFIER CLASS IN THIS CONTEXT                          00024000
022   UNPAIRED QUOTES IN FORMAT                                         00025000
023   NOT ENOUGH SUBSCRIPTS                                             00026000
024   TOO MANY SUBSCRIPTS                                               00027000
025   FUNCTION OR SUBROUTINE PREVIOUSLY DEFINED                         00028000
026   FORMAL PARAMETER MULTIPLY DEFINED IN HEADING                      00029000
027   ILLEGAL USE OF NAMELIST                                           00030000
028   NUMBER OF PARAMETERS INCONSISTENT                                 00031000
029   CANNOT BRANCH TO FORMAT STATEMENT                                 00032000
030   SUBROUTINE OR FUNCTION NOT DEFINED IN PROGRAM                     00033000
031   IDENTIFIER ALREADY GIVEN TYPE                                     00034000
032   ILLEGAL FORMAT SYNTAX                                             00035000
033   INCORRECT USE OF FILE                                             00036000
034   INCONSISTENT USE OF IDENTIFIER                                    00037000
035   ARRAY IDENTIFIER EXPECTED                                         00038000
036   EXPRESSION VALUE REQUIRED                                         00039000
037   ILLEGAL FILE CARD SYNTAX                                          00040000
038   ILLEGAL CONTROL ELEMENT                                           00041000
039   DECLARATION MUST PRECEDE FIRST REFERENCE                          00042000
040   INCONSISTENT USE OF LABEL AS PARAMETER                            00043000
041   NO. OF PARAMS. DISAGREES WITH PREV. REFERENCE                     00044000
042   ILLEGAL USE OF FORMAL PARAMETER                                   00045000
043   ERROR IN HOLLERITH LITERAL CHARACTER COUNT                        00046000
044   ILLEGAL ACTUAL PARAMETER                                          00047000
045   TOO MANY SEGMENTS IN SOURCE PROGRAM                               00048000
046   TOO MANY PRT ASSIGNMENTS IN SOURCE PROGRAM                        00049000
047   LAST BLOCK DECLARATION HAD LESS THAN 1024 WORDS                   00050000
048   ILLEGAL I/O LIST ELEMENT                                          00051000
049   LEFT SIDE MUST BE SIMPLE OR SUBSCRIPTED VARIABLE                  00052000
050   VARIABLE EXPECTED                                                 00053000
051   ILLEGAL USE OF .OR.                                               00054000
052   ILLEGAL USE OF .AND.                                              00055000
053   ILLEGAL USE OF .NOT.                                              00056000
054   ILLEGAL USE OF RELATIONAL OPERATOR                                00057000
055   ILLEGAL MIXED TYPES                                               00058000
056   ILLEGAL EXPRESSION STRUCTURE                                      00059000
057   ILLEGAL PARAMETER                                                 00060000
058   RECORD BLOCK GREATER THAN 1023                                    00061000
059   TOO MANY OPTIONAL FILES                                           00062000
060   FILE CARDS MUST PRECEDE SOURCE DECK                               00063000
061   BINARY WRITE STATEMENT HAS NO LIST                                00064000
062   UNDEFINED FORMAT NUMBER                                           00065000
063   ILLEGAL EXPONENT IN CONSTANT                                      00066000
064   ILLEGAL CONSTANT IN DATA STATEMENT                                00067000
065   MAIN PROGRAM MISSING                                              00068000
066   PARAMETER MUST BE ARRAY IDENTIFIER                                00069000
067   PARAMETER MUST BE EXPRESSION                                      00070000
068   PARAMETER MUST BE LABEL                                           00071000
069   PARAMETER MUST BE FUNCTION IDENTIFIER                             00072000
070   PARAMETER MUST BE FUNCTION OR SUBROUTINE ID                       00073000
071   PARAMETER MUST BE SUBROUTINE IDENTIFIER                           00074000
072   PARAMETER MUST BE ARRAY IDENTIFIER OR EXPRESSION                  00075000
073   ARITHMETIC - LOGICAL CONFLICT ON STORE                            00076000
074   ARRAYID MUST BE SUBSCRIPTED IN THIS CONTEXT                       00077000
075   MORE THAN ONE MAIN PROGRAM                                        00078000
076   ONLY COMMON ELEMENTS PERMITTED                                    00079000
077   TOO MANY FILES                                                    00080000                       
078   FORMAT OR NAMELIST TOO LONG                                       00081000                       
079   FORMAL PARAMETER MUST BE ARRAY IDENTIFIER                         00082000                       
080   FORMAL PARAMETER MUST BE SIMPLE VARIABLE                          00083000                       
081   FORMAL PARAMETER MUST BE FUNCTION IDENTIFIER                      00084000                       
082   FORMAL PARAMETER MUST BE SUBROUTINE IDENTIFIER                    00085000                       
083   FORMAL PARAMETER MUST BE FUNCTION OR SUBROUTINE                   00086000                       
084   DO OR IMPLIED DO INDEX MUST BE INTEGER OR REAL                    00087000                       
085   ILLEGAL COMPLEX CONSTANT                                          00088000                       
086   ILLEGAL MIXED TYPE STORE                                          00089000                       
087   CONSTANT EXCEEDS HARDWARE LIMITS                                  00090000                       
088   PARAMETER TYPE CONFLICTS WITH PREVIOUS USE                        00091000                       
089   COMPLEX EXPRESSION ILLEGAL IN IF STATEMENT                        00092000                       
090   COMPLEX EXPRESSION ILLEGAL IN RELATION                            00093000                       
091   TOO MANY FORMATS REFERENCED BUT NOT YET FOUND                     00094000                       
092   VARIABLE ARRAY BOUND MUST BE FORMAL VARIABLE                      00095000                       
093   ARRAY BOUND MUST HAVE INTEGER OR REAL TYPE                        00096000                       
094   COMMA OR RIGHT PARENTHESIS EXPECTED                               00097000                       
095   ARRAY ALREADY GIVEN BOUNDS                                        00098000                       
096   ONLY FORMAL ARRAYS MAY BE GIVEN VARIABLE BOUNDS                   00099000                       
097   MISSING LEFT PARENTHESIS IN IMPLIED DO                            00100000                       
098   SUBSCRIPT MUST BE INTEGER OR REAL                                 00101000                       
099   ARRAY SIZE CANNOT EXCEED 32767 WORDS                              00102000                       
100   COMMON OR EQUIV BLOCK CANNOT EXCEED 32767 WORDS                   00103000                       
101   THIS STATEMENT ILLEGAL IN LOGICAL IF                              00104000                       
102   REAL OR INTEGER TYPE REQUIRED                                     00105000                       
103   ARRAY BOUND INFORMATION REQUIRED                                  00106000                       
104   REPLACEMENT OPERATOR EXPECTED                                     00107000                       
105   IDENTIFIER EXPECTED                                               00108000                       
106   LEFT PARENTHESIS EXPECTED                                         00109000                       
107   ILLEGAL FORMAL PARAMETER                                          00110000                       
108   RIGHT PARENTHESIS EXPECTED                                        00111000                       
109   STATEMENT NUMBER EXPECTED                                         00112000                       
110   SLASH EXPECTED                                                    00113000                       
111   ENTRY STATEMENT CANNOT START PROGRAM UNIT                         00114000                       
112   ARRAY MUST BE DIMENSIONED PRIOR TO EQUIV STMT                     00115000                       
113   INTEGER CONSTANT EXPECTED                                         00116000                       
114   COMMA EXPECTED                                                    00117000                       
115   SLASH OR END OF STATEMENT EXPECTED                                00118000                       
116   FORMAT, ARRAY OR NAMELIST EXPECTED                                00119000                       
117   END OF STATEMENT EXPECTED                                         00120000                       
118   IO STATEMENT WITH NAMELIST CANNOT HAVE IO LIST                    00121000                       
119   COMMA OR END OF STATEMENT EXPECTED                                00122000                       
120   STRING TOO LONG                                                   00123000                       
121   MISSING QUOTE AT END OF STRING                                    00124000                       
122   ILLEGAL ARRAY BOUND                                               00125000                       
123   TOO MANY HANGING BRANCHES                                         00126000                       
124   TOO MANY COMMON OR EQUIVALENCE ELEMENTS                           00127000                       
125   ASTERISK EXPECTED                                                 00128000                       
126   COMMA OR SLASH EXPECTED                                           00129000                       
127   DATA SET TOO LARGE                                                00130000                       
128   TOO MANY ENTRY STATEMENTS IN THIS SUBPROGRAM                      00131000                       
129   DECIMAL WIDTH EXCEEDS FIELD WIDTH                                 00132000                       
130   UNSPECIFIED FIELD WIDTH                                           00133000                       
131   UNSPECIFIED SCALE FACTOR                                          00134000                       
132   ILLEGAL FORMAT CHARACTER                                          00135000                       
133   UNSPECIFIED DECIMAL FIELD                                         00136000                       
134   DECIMAL FIELD ILLEGAL FOR THIS SPECIFIER                          00137000                       
135   ILLEGAL LABEL                                                     00138000                       
136   UNDEFINED NAMELIST                                                00139000                       
137   MULTIPLY DEFINED ACTION LABELS                                    00140000                       
138   TOO MANY NESTED DO STATEMENTS                                     00141000                       
139   STMT FUNCTION ID AND EXPRESSION DISAGREE IN TYPE                  00142000                       
140   ILLEGAL USE OF STATEMENT FUNCTION                                 00143000                       
141   UNRECOGNIZED CONSTRUCT                                            00143001                          
142   RETURN, STOP OR CALL EXIT REQUIRED IN SUBPROGRAM                  00143002                       
143   FORMAT NUMBER USED PREVIOUSLY AS LABEL                            00143003                       
144   LABEL USED PREVIOUSLY AS FORMAT NUMBER                            00143004                       
145   NON-STANDARD RETURN REQUIRES LABEL PARAMETERS                     00143005                       
146   DOUBLE OR COMPLEX REQUIRES EVEN OFFSET                            00143006                       
147   FORMAL PARAMETER ILLEGAL IN DATA STATEMENT                        00143007                       
148   TOO MANY LOCAL VARIABLES IN SOURCE PROGRAM                        00143008                       
149   A $FREEFORM SOURCE LINE MUST HAVE < 67 COLS                       00143009                       
150   A HOL/STRING UNDER $FREEFORM MUST BE ON ONE LINE                  00143010                       
151   THIS CONSTRUCT IS ILLEGAL IN TSS FORTRAN                          00143011                       
152   ILLEGAL FILE CARD PARAMETER VALUE                                 00143012                       
153   RETURN IN MAIN PROGRAM NOT ALLOWED                                00143013                       
154   NON-POSITIVE SUBSCRIPTS ARE ILLEGAL                               00143014                       
155   NON-IDENTIFIER USED FOR NAME OF LIBRARY ROUTINE                   00143015                       
156   HYPHEN EXPECTED                                                   00143016                       
157   SEQUENCE NUMBER EXPECTED                                          00143017                       
158   TOO MANY RECURSIVE CALLS ON LIBRARY ROUTINES                      00143018                       
159   ASTERISK NOT ALLOWED IN READ STATEMENT                            00143019                       
160   ASTERISK ONLY ALLOWED IN FREE FIELD OUTPUT                        00143020                       
161   TOO MANY *-ED LIST ELEMENTS IN OUTPUT                             00143021                       
162   HOL OR QUOTED STRING GREATER THAN 7 CHARACTERS IN EXPRESSION      00143022                       
164   PLUS NOT ALLOWED IN THIS FORMAT PHRASE                            00143023                       
165   K NOT ALLOWED IN THIS FORMAT PHRASE                               00143024                       
166   $ NOT ALLOWED IN THIS FORMAT PHRASE                               00143025                       
167   INTRINSICS-NAMED FUNCT MUST HAVE PREVIOUS EXTERNAL REFERENCE.     00143026                       
168   DATA STMT COMMON ELEM MUST BE IN BLK DATA SUBPRM                  00143027                       
169   VARIABLE CANNOT BE A FORMAL PARAMETER OR IN COMMON                00143028                       
170   CURRENT SUBPROGRAM ID EXPECTED                                    00143029                       
171   SUBPROGRAM, EXTERNAL, OR ARRAY ID EXPECTED                        00143030                       
172   REPEAT, WIDTH, AND DECIMAL PARTS MUST BE LESS THAN 4091           00143031                       
173   REPEAT PART MUST BE EMPTY OR >0 AND < 4091                        00143032                       
174   IN SUBPRGM:VARBL IS USED PRIOR TO USE IN DATSTMT                  00143033                       
175   SYNTATICAL TOKEN CONTAINS TOO MANY CHARACTERS                     00143034                       
176   INTEGER VALUE OF 8 EXPECTED                                       00143035                       
177   INTEGER VALUE OF 4 EXPECTED                                       00143036                       
178   INTEGER VALUE OF 4 OR 8 EXPECTED                                  00143037                       
179   AN ALPHABETIC LETTER (A,B,C,...,Z) IS REQUIRED                    00143038                       
180   SECOND RANGE LETTER MUST BE GREATER THAN FIRST                    00143039                       
181   IMPLICIT MUST BE FIRST STATEMENT IN PROGRAM UNIT                  00143040                       
182   REAL/INTEGER/LOGICAL/COMPLEX/DOUBLEPRECISION REQ                  00143041                       
183   ILLEGAL USE OF ASTERISK FOR RUN-TIME EDITING                 %111-00143042                       
184   NO PROGRAM UNIT FOR THIS END STATEMENT                       %112-00143043                       
;                                                                       00143999                      
BEGIN                                                                   00144000                       
INTEGER ERRORCT; COMMENT MUST BE FIRST DECLARED VARIABLE;               00145000                       
INTEGER SAVETIME; COMMENT MUST BE 2 ND DECLARED VARIABLE;               00146000                       
INTEGER CARDCOUNT,ESTIMATE,SEQERRCT ;                                   00147000                       
INTEGER SWARYCT;                                                        00147500                       
REAL TWODPRTX;                                                          00148000                       
REAL INITIALSEGNO;                                                      00149000                       
REAL NEXT, FNEXT, NAME, NUMTYPE;                                        00150000                       
REAL A, B, I, J, P, T, TS, Z;                                           00151000                       
REAL RTI;          % START COMPILE TIME                                 00152000                       
REAL EXPVALUE, EXPRESULT, EXPLINK;                                      00153000                       
REAL SPLINK, FUNVAR;                                                    00155000                       
      REAL DATAPRT,DATASTRT,DATALINK,DATASKP;                           00155100                       
BOOLEAN SCANENTER ; % TRUE IFF SCAN JUST DID AN ENTER ON AN ID.         00155110                       
DEFINE NUMINTM1=                                                        00155210                       
83                                                                      00155211                       
#;% NUMINTM1 IS THE NUMBER OF INTRINSICS MINUS 1; FOR EACH NEW INTRINSIC00155212                       
%   WHICH IS ADDED, ADD 1 TO THE VALUE ON SEQ# 00155211.                00155213                       
DEFINE MAXEL=15#;                                                       00156000                       
REAL ARRAY ENTRYLINK[0:MAXEL];                                          00157000                       
REAL ELX;                                                               00158000                       
ALPHA FNEW, NNEW;                                                       00159000                       
REAL LABELMOM;                                                          00160000                       
INTEGER LOCALS,PARMS,PRTS,FLAGROUTINECOUNTER ;                          00161000                       
REAL LIMIT, VOIDTSEQ;                                                   00161010                       
REAL IDINFO, TYPE, NSEG;                                                00162000                       
REAL FX1, FX2, FX3, NX1, NX2, NX3;                                      00163000                       
INTEGER LENGTH, LOWERBOUND, GROUPPRT;                                   00164000                       
ALPHA EQVID, INTID, REALID;                                             00165000                       
INTEGER ROOT, ADR;                                                      00166000                       
INTEGER LASTMODE ;  %%% = 1 FOR $CARD; = 2 FOR $TAPE.                   00166100                       
BOOLEAN ERRORTOG,%PREVIOUS LISTED RECORD.                               00167000                       
        EOSTOG,%END OF STMT TOGGLE.                                     00168000                       
        CODETOG,%LIST CODE GENERATED..                                  00168200                       
        TAPETOG,%MERGE TAPE INPUT.                                      00168400                       
        EODS,%END OF DECLRSTMTS, RESET BY ENDS.                         00168500                       
        FILETOG,%PROCESSING FILE CARDS.                                 00168600                       
        DEBUGTOG,%TO LIST OUT ENTRING AND EXITING PROCEDURES.           00169000                       
        DESCREQ,%DESCRIPTOR REQUIRED.                                   00169020                       
        XREF,%TO CREATE XREF OF PROGRAM.                                00169030                       
        SAVETOG;%VARIOUS BOOLEANS.                                      00169050                       
DEFINE  LIBTAPE      = SAVETOG.[47:1]#,%USE TO SAVE NEW WHILE INCLUDE.  00169053                       
        SAVEDEBUGTOG = SAVETOG.[46:1]#,%SAVE DEBUGTOG WHILE IN $INCLUDE.00169054                       
        SAVECODETOG  = SAVETOG.[45:1]#,%SAVE CODETOG WHILE IN $INCLUDE. 00169055                       
        SAVEPRTTOG   = SAVETOG.[44:1]#,%SAVE PRTOG WHILE IN $INCLUDE.   00169056                       
        SAVELISTOG   = SAVETOG.[43:1]#,%SAVE LISTOG WHILE IN $INCLUDE.  00169057                       
        VOIDTOG      = SAVETOG.[42:1]#,%TO VOID CARDS OR TAPE           00169058                       
        DATASTMTFLAG = SAVETOG.[41:1]#,%WHILE IN DATA STMTS,            00169059                       
        F2TOG        = SAVETOG.[40:1]#,%ADDR REL TO F+2,                00169060                       
        CHECKTOG     = SAVETOG.[39:1]#,%SEQ # CHECK,                    00169061                       
        LISTOG       = SAVETOG.[38:1]#,%TO LIST OUTPUT,                 00169062                       
        LISTLIBTOG   = SAVETOG.[37:1]#,%TO LIST LIBRARY OUTPUT,         00169063                       
        SEQTOG       = SAVETOG.[36:1]#,%TO RESEQ INPUTS,                00169064                       
        SEQERRORS    = SAVETOG.[35:1]#,%IF SEQUENCE ERRORS.             00169065                       
        TIMETOG      = SAVETOG.[34:1]#,%TO LIST WRAPUP INFO ONLY.       00169066                       
        PRTOG        = SAVETOG.[33:1]#,%TO LIST STORAGE MAP.            00169067                       
        NEWTPTOG     = SAVETOG.[32:1]#,%CREATE NEW SYMBOLIC TAPE.       00169068                       
        SINGLETOG    = SAVETOG.[31:1]#,%TO LIST OUTPUT SINGLE SPACED.   00169069                       
        SEGOVFLAG    = SAVETOG.[30:1]#,%SEGMENT OVERFLOW.               00169070                       
        FIRSTCALL    = SAVETOG.[29:1]#,%TO LIST COMPILER HEADING.       00169071                       
        RETURNFOUND  = SAVETOG.[28:1]#,%RETURN,CALL EXIT,STOP FOUND.    00169072                       
        ENDSEGTOG    = SAVETOG.[27:1]#,%END OF SEGMENT.                 00169073                       
        LOGIFTOG     = SAVETOG.[26:1]#,%PROCESSING LOGICAL IF STMT.     00169074                       
        NOTOPIO      = SAVETOG.[25:1]#,                                 00169075                       
        DATATOG      = SAVETOG.[24:1]#,%WHILE IN DATA STMTS.            00169076                       
        FREEFTOG     = SAVETOG.[23:1]#,%FREE FIELD INPUT.               00169077                       
        SEGPTOG      = SAVETOG.[22:1]#,%DONT PAGE AFTER SUBPRGM         00169078                       
        GLOBALNAME   = SAVETOG.[21:1]#,%TO WRITE ALL IDENTIFIERS.       00169079                       
        NAMEDESC     = SAVETOG.[20:1]#,%IF GLOBALNAME OR LOCALNAME TRUE 00169080                       
        LOCALNAME    = SAVETOG.[19:1]#,%TO WRITE AN IDENTIFIER.         00169081                       
        TSSEDITOG    = SAVETOG.[18:1]#,%TSSEDIT.                        00169082                       
        UNPRINTED    = SAVETOG.[17:1]#,%TO LIST CARD,FALSE IF LISTED.   00169083                       
        DCINPUT      = SAVETOG.[16:1]#,%IF USING TSS FORTRAN.           00169084                       
        SEGSW        = SAVETOG.[15:1]#,%TO MAINTAIN LINEDICT/LINESEG.   00169085                       
        TSSMESTOG    = SAVETOG.[14:1]#,%TSSMES(ERRMES).                 00169086                       
        WARNED       = SAVETOG.[13:1]#,%IS TSSEDIT WAS EVER EVOKED.     00169087                       
        SEGSWFIXED   = SAVETOG.[12:1]#,%IF SEGSW IS NOT TO BE ALTERED.  00169088                       
        REMFIXED     = SAVETOG.[11:1]#,%IF REMOTETOG ISNT TO BE ALTERED 00169089
        REMOTETOG    = SAVETOG.[10:1]#,%PRINT & READ STMTS = REMOTE     00169090
        RANDOMTOG    = SAVETOG.[10:1]#,%IF EXPR USED FOR RANDOM I/O.    00169091                       
        VOIDTTOG     = SAVETOG.[ 9:1]#,%TO VOID TAPE RECORDS ONLY.      00169092                       
        DOLIST       = SAVETOG.[ 8:1]#,%LIST DOLLAR CARDS.              00169093                       
        HOLTOG       = SAVETOG.[ 7:1]#,%INPUT IN HOLLERITH.             00169094                       
        LISTPTOG     = SAVETOG.[ 6:1]#,%LIST PATCHES ONLY.              00169095                       
        PXREF        = SAVETOG.[ 5:1]#,%TO LIST XREF OF PROGRAM.        00169096                       
        LASTLINE     = SAVETOG.[ 4:1]#,%TO DETR TO SKIP XREF.           00169097                       
        XGLOBALS     = SAVETOG.[ 3:1]#,%TO LET XREF KNOW OF DOING GLOBAL00169098                       
        NTAPTOG      = SAVETOG.[ 2:1]#,%TO CLOSE NEWTAPE IF EVER OPENED 00169099                       
        SEENADOUB    = SAVETOG.[40:1]#,%ARRAYDEC WONT BE USING THIS     00169100                       
                                       %WHILE WE FIX DP COMMON ARRAY SZ 00169102                       
ENDSAVTOGDEF=#;                                                         00169199                       
ARRAY SSNM[0:18] ; % THESE WORDS ARE USED FOR TEMP STORAGE AND STORING  00169200                       
                   % PERMANENT FLAGGED DATA.                            00169201                       
DEFINE LASTSEQ=SSNM[0]#, LASTERR=SSNM[1]#, LINKLIST=SSNM[2]# ;          00169210                       
DEFINE VOIDSEQ=SSNM[3] # ;                                              00169220                       
ALPHA ARRAY ERRORBUFF,PRINTBUFF[0:14] ;                                 00169300                       
ARRAY INLINEINT[0:35] ;                                                 00169310                       
DEFINE XRBUFF = 150#, XRBUFFDIV3=50 #;                                  00169320                       
ARRAY XRRY[0:XRBUFF-1] ;                                                00169330                       
INTEGER SEQBASE,SEQINCR;                                                00170000                       
INTEGER SCN,LABL,NEXTSCN,NEXTCARD;                                      00174000                       
INTEGER SAVECARD;   % TO SAVE NEXTCART WHILE IN $ INCLUDE               00174100                       
INTEGER RESULT,INSERTDEPTH;                                             00174200                       
REAL INCLUDE; % CONTAINS "INCLUDE"                                      00174300                       
REAL DEBUGADR ;                                                         00174310                       
ALPHA ACR0, CHR0, INITIALNCR;                                           00175000                       
ALPHA ACR, NCR ;                                                        00176000                       
SAVE ARRAY TIPE[0:63] ;                                                 00176500                       
REAL LASTNEXT ;                                                         00176502                       
ALPHA NEXTACC, NEXTACC2;                                                00177000                       
ALPHA BLANKS;                                                           00178000                       
ALPHA XTA;                                                              00179000                       
ALPHA ARRAY EDOC[0:7, 0:127];    COMMENT HOLDS CODE EMITTED;            00180000                       
ALPHA ARRAY HOLDID[0:2];                                                00181000                       
REAL NXAVIL,STRTSEG;                                                    00182000                       
ALPHA ARRAY WOP[0:139];   % HOLDS NAME AND CODE OF WORD MODE OPERATORS  00183000                       
SAVE ALPHA ARRAY DB,TB,CB[0:9],                                         00184000                       
                 CRD[0:14];                                             00185000                       
ALPHA ARRAY XR[0:32];  INTEGER XRI;                                     00185100                       
SAVE ARRAY ACCUM, EXACCUM[0:20] ;                                       00186000                       
REAL ACCUMSTOP, EXACCUMSTOP ;                                           00186100                       
REAL DBLOW;                                                             00187000                       
REAL MAX;                                                               00188000                       
ALPHA ACR1, CHR1;                                                       00189000                       
ALPHA ARRAY PERIODWORD[0:10];                                           00190000                       
REAL ARRAY MAP[0:7];                                                    00191000                       
REAL F1, F2;                                                            00192000                       
INTEGER C1, C2;                                                         00193000                       
DEFINE                                                                  00194000                       
        RSP=14 #, RSP1=15 #, RWP=29 #,                                  00194020                       
        RSH=41 #, RSH1=42 #, RWS=83 #;                                  00194040                       
ALPHA ARRAY RESERVEDWORDSLP[0:RWP], RESLENGTHLP,LPGLOBAL[0:RSP],        00195000                       
            RESERVEDWORDS  [0:RWS], RESLENGTH           [0:RSH] ;       00195010                       
SAVE REAL ARRAY PR, OPST [0:25];  % USED IN EXPR ONLY                   00196000                       
DEFINE PARMLINK = LSTT#;                                                00197000                       
ALPHA BUFF, BUFL, SYMBOL;                                               00198000                       
INTEGER  TV, % INDEX INTO INFO FOR PRT OF LIST NAMES                    00199100                       
         SAVESUBS, %  MAX NUMBER OF SUBSCRIPTS FOR NAMELIST IDENTIFIERS 00199120                       
         NAMEIND ; %  INDEX INTO NAMLIST IDENTIFIERS ARRAY              00199130                       
ARRAY    NAMLIST[0:256]; % ARRAY TO STOKE NAMELIST IDENTIFIERS          00199200                       
ALPHA    LISTID;                                                        00199300                       
REAL ARRAY BDPRT[0:20]; REAL BDX;                                       00200000                       
DEFINE MAXSTRING = 49#;                                                 00201000                       
ALPHA ARRAY STRINGARRAY[0:MAXSTRING];                                   00202000                       
REAL STRINGSIZE;                  % NUMBER OF WORDS IN STRING           00203000                       
DEFINE LSTMAX = 256#;                                                   00204000                       
REAL ARRAY LSTT, LSTP[0:LSTMAX];                                        00205000                       
INTEGER LSTI,LSTS,LSTA;                                                 00206000                       
DEFINE MAXOPFILES = 63#, BIGGESTFILENB = 99#;                           00207000                       
ARRAY FILEINFO[0:3,0:MAXOPFILES];                                       00208000                       
DEFINE   %    SOME FILE STUFF                                           00208100                       
         SLOWV     = 2#,                                                00208110                       
         FASTV     = 1#,                                                00208120                       
         SENSPDEUNF= [1:8]#,                                            00208130                       
              SENSE= [1:1]#,                                            00208135                       
              SPDF = [2:2]#,                                            00208140                       
              EUNF = [4:5]#,                                            00208150                       
         FPBVERSION= 1#,                                                00208160                       
         FPBVERSF  = [1:8]#,                                            00208170                       
         DKAREASZ  = [9:39]#,                                           00208180                       
ENDFILDEF=#;                                                            00208490                       
INTEGER MAXFILES;                                                       00209000                       
ARRAY TEN[0:137];                                                       00210000                       
DEFINE LBRANCH = 50#;                                                   00211000                       
REAL ARRAY BRANCHES[0:LBRANCH]; REAL LAX, BRANCHX;                      00212000                        
INTEGER INXFIL,FILEARRAYPRT;                                            00213000                       
DEFINE MAXCOM=15 # ;                                                    00214000                       
INTEGER SUPERMAXCOM; %%% SUPERMAXCOM = 128|(MAXCOM+1).                  00214100                       
ALPHA ARRAY COM[0:MAXCOM,0:127] ;                                       00215000                       
REAL NEXTCOM;                                                           00216000                       
ALPHA ARRAY INFO[0:31, 0:127];                                          00217000                       
REAL ARYSZ;                                                             00218000                       
ALPHA ARRAY EXTRAINFO[0:31, 0:127];                                     00219000                       
REAL EXPT1, EXPT2, EXPT3;                                               00220000                       
DEFINE IR = [36:5]#, IC = [41:7]#;                                      00221000                       
REAL INFA,INFB,INFC;                                                    00222000                       
INTEGER NEXTINFO, GLOBALNEXTINFO, NEXTEXTRA;                            00223000                       
INTEGER NEXTSS;                                                         00224000                       
DEFINE SHX=189#, GHX=61#;                                               00225000                       
REAL ARRAY STACKHEAD[0:SHX];                                            00226000                       
REAL ARRAY GLOBALSTACKHEAD[0:GHX];                                      00227000                       
REAL LA, DT, TEST;                                                      00228000                       
ALPHA LADR1,LADR2,LADR3,LADR4,LADR5,LINFA;   INTEGER LINDX,LADDR;       00229000                       
DEFINE MAXDOS=20#;                                                      00230000                       
ALPHA ARRAY DOTEST, DOLAB[0:MAXDOS];                                    00231000                       
ALPHA LISTART;                                                          00232000                       
ALPHA ARRAY INT[0:NUMINTM1+NUMINTM1+2];                                 00233000                       
ALPHA ARRAY TYPES[0:6], KLASS[0:14];                                    00234000                       
INTEGER OP, PREC, IP, IT;                                               00235000                       
DEFINE DUMPSIZE=127 #;                                                  00237000                       
ARRAY FNNHOLD[0:DUMPSIZE];                                              00238000                       
INTEGER FNNINDEX,FNNPRT;                                                00239000                       
DEFINE MAXNBHANG = 30#;                                                 00240000                       
ARRAY FNNHANG[0:MAXNBHANG];                                             00241000                       
DEFINE INTCLASS=[6:3]#, INTPARMCLASS=[9:3]#, INTINLINE=[12:6]#,         00241010                       
       INTPRT =[24:6]#, INTPARMS   =[30:6]#, INTNUM  =[36:12]#,         00241020                       
       INAM  =[12:36]#, INTX       =[2:10]#, INTSEEN   =[2:1]# ;        00241030                       
DEFINE                                                                  00241200                       
       INSERTMAX = 20 #,  % MAX NO OF RECURSIVE CALL ALLOW ON LIB ROUT  00241220                       
       INSERTCOP = INSERTINFO[INSERTDEPTH,4] #,                         00241240                       
       INSERTMID = INSERTINFO[INSERTDEPTH,0] #,                         00241260                       
       INSERTFID = INSERTINFO[INSERTDEPTH,1] #,                         00241280                       
       INSERTINX = INSERTINFO[INSERTDEPTH,2] #,                         00241300                       
       INSERTSEQ = INSERTINFO[INSERTDEPTH,3] #;                         00241320                       
ARRAY INSERTINFO[0:INSERTMAX,0:4];                                      00241360                       
DEFINE MSRW=11 #;                                                       00241900                       
ALPHA ARRAY MESSAGE[0:MSRW,0:96] ;                                      00242000                       
BOOLEAN ARRAY MSFL[0:MSRW];                                             00242050                       
ALPHA ARRAY LINEDICT[0:7,0:127];  % LINE DICTIONARY ARRAY               00242100                       
ALPHA ARRAY LINESEG [0:11,0:127];  % LINE SEGMENT ARRAY                 00242200                       
ARRAY TSSMESA[0:15] ; %%% BIT FLAGS PRNTD ERR MESSGS ({748).            00242220                      
INTEGER NOLIN;  % NUMBER OF ENTRIES IN LINE SEGMENT                     00242300                       
REAL LASTADDR; %%% STORES LAST ADR.                                     00242700                       
INTEGER WARNCOUNT; %%% COUNTS NUMBER OF TSS WARNINGS.                   00242750                       
DEFINE CE       = [2:1]#,        %INFA                             %996-00243000                       
       LASTC    = [3:12]#,       %INFA                             %996-00244000 
       SEGNO    = [3:9]#,        %INFA                             %996-00245000 
       CLASS    = [15:5]#,       %INFA                             %996-00246000 
       EQ       = [20:1]#,       %INFA                             %996-00246100 
       SUBCLASS = [21:3]#,       %INFA                             %996-00247000 
       CLASNSUB = [14:10]#,      %INFA                             %996-00248000 
       ADJ      = [14:1]#,       %INFA                             %996-00249000 
       TWOD     = [14:1]#,       %INFA                             %996-00250000 
       FORMAL   = [13:1]#,       %INFA                             %996-00251000 
       TYPEFIXED= [12:1]#,       %INFA                             %996-00252000 
       ADDR     = [24:12]#,      %INFA                             %996-00253000 
       LINK     = [36:12]#,      %INFC                             %996-00254000 
       BASE     = [18:15]#,      %INFC                             %996-00255000 
       SIZE     = [33:15]#,      %INFC                             %996-00256000 
       BASENSIZE= [18:30]#,      %INFC                             %996-00257000 
       NEXTRA   = [2:6]#,        %INFC                             %996-00258000 
       ADINFO   = [8:10]#,       %INFC                             %996-00259000 
       RELADD   = [21:15]#,      %INFA                             %996-00260000 
       TOCE     = 2:47:1#,       %INFA                             %996-00261000 
       TOSEGNO  = 3:39:9#,       %INFA                             %996-00262000 
       TOLASTC  = 3:36:12#,      %INFA                             %996-00262100 
       TOCLASS  = 15:43:5#,      %INFA                             %996-00263000 
       TOEQ     = 20:47:1#,      %INFA                             %996-00263100 
       TOSUBCL  = 21:45:3#,      %INFA                             %996-00264000 
       TOADJ    = 14:47:1#,      %INFA                             %996-00265000 
       TOFORMAL = 13:47:1#,      %INFA                             %996-00266000 
       TOTYPE   = 12:47:1#,      %INFA                             %996-00267000 
       TOADDR   = 24:36:12#,     %INFA                             %996-00268000 
       TOLINK   = 36:36:12#,     %INFC                             %996-00269000 
       TOBASE   = 18:33:15#,     %INFC                             %996-00270000 
       TOSIZE   = 33:33:15#,     %INFC                             %996-00271000 
       TONEXTRA = 2:42:6#,       %INFC                             %996-00272000 
       TOADINFO = 8:38:10#,      %INFC                             %996-00273000 
       TORELADD = 21:33:15#,     %INFA                             %996-00274000 
    %THE FOLLOWING CLASSES APPEAR IN THE 1ST WORD OF EACH 3-WORD ENTRY  00274998 
    %OF THE "INFO" ARRAY, AND MAY BE COPIED TO INFA.CLASS.         %996-00274999 
       UNKNOWN  = 0#,                                                   00275000 
       ARRAYID  = 1#,                                                   00276000 
       VARID    = 2#,                                                   00277000 
       STMTFUNID= 3#,                                                   00278000 
       NAMELIST = 4#,                                                   00279000 
       FORMATID = 5#,                                                   00280000 
       LABELID  = 6#,                                                   00281000 
       FUNID    = 7#,                                                   00282000 
       INTRFUNID= 8#,                                                   00283000 
       EXTID    = 9#,                                                   00284000 
       SUBRID   = 10#,                                                  00285000 
       BLOCKID  = 11#,                                                  00286000 
       FILEID   = 12#,                                                  00287000 
       SUBSVAR  = 13#,                                                  00288000 
       EXPCLASS = 14#,                                                  00289000 
       SBVEXP   = 15#,                                                  00290000 
       LISTSID  = 16#,                                                  00290050 
       JUNK     = 17#,            % NOT A GENUINE CLASS            %996-00290055 
       DUMMY    = 27#,                                                  00290100 
       NUMCLASS = 28#,                                                  00291000 
       RESERVED = 29#,                                                  00292000 
       HEADER   = 30#,                                                  00293000 
       ENDCOM   = 31#,                                                  00294000 
   %THE FOLLOWING SUBCLASSES APPEAR IN THE 1ST WORD OF SOME 3-WORKD%996-00294998 
   %ENTRIES OF THE "INFO" ARRAY, AND MAY BE COPIED TO INFA.SUBCLASS.    00294999 
       INTYPE   = 1#,                                                   00295000 
       STRINGTYPE=2#,                                                   00296000 
       REALTYPE = 3#,                                                   00297000 
       LOGTYPE  = 4#,                                                   00298000 
       DOUBTYPE = 5#,                                                   00299000 
       COMPTYPE = 6#;                                                   00300000 
DEFINE   EOF= 500#, ID= 501#, NUM= 502#, PLUS= 503#, MINUS= 504#,       00301000 
         STAR= 505#, SLASH= 506#, LPAREN= 507#, RPAREN= 508#,           00302000 
         EQUAL= 509#, COMMA= 510#, SEMI= 511#, DOLLAR=0#, UPARROW=0# ;  00303000 
DEFINE THRU = STEP 1 UNTIL #;                                      %996-00316000 
DEFINE                                                                  00317000 
          ADD = 16#, BBC = 22#, BBW = 534#, BFC = 38#, BFW = 550#       00318000 
         ,CDC =168#, CHS =134#, COC =  40#, KOM =130#, DEL =  10#       00319000 
         ,DUP =261#, EQUL=581#, GBC = 278#, GBW =790#, GEQL=  21#       00320000 
         ,GFC =294#, GFW =806#, GRTR=  37#, IDV =384#, INX =  24#       00321000 
         ,ISD =532#, ISN =548#, LEQL= 533#, LND = 67#, LNG =  19#       00322000 
         ,LOD =260#, LOR = 35#, LQV = 131#, LESS=549#, MDS = 515#       00323000 
         ,MKS = 72#, MUL = 64#, NEQL=  69#, NOP = 11#, PRL =  18#       00324000 
         ,XRT = 12#, RDV =896#, RTN = 39#, RTS =167#, SND = 132#         00325000 
         , SSN = 70#, SSP = 582#, STD = 68#, SUB = 48#, XCH = 133#      00326000 
         ,XIT = 71#, ZP1 =322#, DIU =128#, STN =132#                    00327000 
         ,DIA = 45#, DIB = 49#, TRB = 53#, ISO = 37#                    00328000 
         ,AD2 =17#, SB2 = 49#, ML2 = 65#, DV2 =129#, FTC = 197#         00329000 
         ,SSF =280#, FTF =453#, CTC =709#, CTF = 965#                   00330000 
         ,TOP=262#                                                      00330010 
         ;                                                              00331000 
FORMAT FD(X100,"NEXT = ",I3,X2,2A6) ;                                   00332000 
FORMAT SEGSTRT(X63, " START OF SEGMENT **********", I4),                00333000 
       FLAGROUTINEFORMAT(X41,A6,A2,X1,2A6," (",A1,I*,")"),              00333010 
       XHEDM(X40,"CROSS REFERENCE LISTING OF MAIN PROGRAM",X41,/,       00333050 
             X40,"----- --------- ------- -- ---- -------",X41),        00333055 
       XHEDS(X38, "CROSS REFERENCE LISTING OF SUBROUTINE ",A6,X38,/,    00333060 
             X38, "----- --------- ------- -- ---------- ",A6,X38),     00333065 
       XHEDF(X35,"CROSS REFERENCE LISTING OF ",A6,A1," FUNCTION ",A6,   00333070 
       X35,/,X35,"----- --------- ------- -- ",A6,A1," -------- ",A6,   00333075 
       X35),                                                            00333076 
       XHEDG(X43,"CROSS REFERENCE LISTING OF GLOBALS",X43,/,            00333080 
             X43,"----- --------- ------- -- -------",X43),             00333085 
       XHEDB(X34,"CROSS REFERENCE LISTING OF BLOCK DATA SUBPROGRAM",X35,00333090 
         /,X34,"----- --------- ------- -- ----- ---- ----------",X35), 00333095 
       SEGEND (X70," SEGMENT",I5," IS",I5," LONG");                     00334000 
ARRAY PDPRT [0:31,0:63];                                                00335000 
REAL PDINX;        % INDEX OF LAST ENTRY IN PDPRT                       00336000 
REAL TSEGSZ;       % RUNNING COUNT OF TOTAL SEGMENT SIZE;               00337000 
         COMMENT FORMAT OF PRT&SEGMENT ENTRIES, IN PDPRT;               00338000 
DEFINE        STYPF= [1:2]#,  %  0 = PROGRAM SEGMENT-SEGMENT ENTRY ONLY 00339000 
              STYPC= 1:46:2#, %  1 = MCP INTRINSIC                      00340000 
                              %  2 = DATA SEGMENT                       00341000 
              DTYPF= [4:2]#,  %  0 = THUNK - PRT ENTRY ONLY             00342000 
              DTYPC= 4:46:2 #,%  1 = WORD MODE PROGRAM DESCRIPTOR       00343000 
                              %  2 = LABEL DESCRIPTOR                   00344000 
                              %  3 = CHARACTER MODE PROGRAM DESCRIPTOR  00345000 
              PRTAF= [8:10]#, %  ACTUAL PRT ADDRESS - PRT ENTRY         00346000 
              PRTAC= 8:38:10#,                                          00347000 
              RELADF = [18:10]#, % ADDRESS WITHIN SEGMENT -PRT ONLY     00348000 
              RELADC= 18:38:10#,                                        00349000 
              SGNOF=  [28:10]#, % SEGMENT NUMBER - BOTH                 00350000 
              SGNOC= 28:38:10#,                                         00351000 
              DKAI = [13:15]#,  % RELATIVE DISK ADDRESS - SEGMENT ENTRY 00352000 
              DKAC = 13:33:15#,                                         00353000 
              SEGSZF =[38:10]#, % SEGMENT SIZE - SEGMENT ENTRY          00354000 
              SEGSZC =38:38:10#;% MUST BE 0 IF PRT ENTRY                00355000 
DEFINE %      SOME EXTERNAL CONSTANTS                                   00355100 
          BLKCNTRLINT   = 5#,                                           00355110 
          FPLUS2        = 1538#,                                        00355120 
ENDEXTCONDEF=#;                                                         00355990 
DEFINE    PDIR = PDINX.[37:5]#,                                         00356000 
          PDIC = PDINX.[42:6]#;                                         00357000 
DEFINE CIS = CRD[0]#,    % CARD                                         00358000 
       TIS = CRD[1]#,    % TAPE                                         00359000 
       TOS = CRD[2]#,    % NEW TAPE                                     00360000 
       LOS = CRD[3]#;    % PRINTER                                      00361000 
DEFINE PWROOT=ROOT.IR,ROOT.IC #,PWI=I.IR,I.IC # ;                       00362000 
DEFINE GLOBALNEXT=NEXT#;                                                00363000 
BEGIN    % SCAN FPB TO SEE IF VARIOUS FILES ARE DISK OR TAPE            00364000 
INTEGER STREAM PROCEDURE GETFPB(Q); VALUE Q;                            00365000 
    BEGIN                                                               00366000 
         SI ~ LOC GETFPB; SI ~ SI - 7; DI ~ LOC Q; DI ~ DI + 5;         00367000 
         SKIP 3 DB; 9(IF SB THEN DS ~ SET ELSE DS ~ RESET;              00368000 
                      SKIP SB);                                         00369000 
         DI ~ LOC Q; SI ~ Q; DS ~ WDS; SI ~ Q; GETFPB ~ SI;             00370000 
    END;                                                                00371000 
INTEGER STREAM PROCEDURE GNC(Q); VALUE Q;                               00372000 
    BEGIN SI ~ Q; SI ~ SI + 7; DI ~ LOC GNC; DI ~ DI +7; DS ~CHR END;   00373000 
INTEGER FPBBASE;                                                        00374000 
        FPBBASE ~ GETFPB(3);                                            00375000 
        TIS ~ TOS ~ 50; CIS ~ LOS ~ 0;                                  00376000 
        IF GNC(FPBBASE+3) =12 THEN CIS ~ 150;    % CARD                 00377000 
        IF GNC(FPBBASE+8) =12 THEN LOS ~ 150;    % PRINTER              00378000 
        IF GNC(FPBBASE+13) = 12 THEN TOS ~ 150;    % NEW TAPE;          00379000 
        IF GNC(FPBBASE+18) =12 THEN TIS ~ 150;   % TAPE                 00380000 
    END;                                                                00381000 
BEGIN  COMMENT  INNER BLOCK;                                            00382000 
% *** DO NOT DECLARE ANY FILES PRIOR TO THIS POINT, DO NOT ALTER        00383000 
%      SEQUENCE OF FOLLOWING FILE DECLARATIONS                          00384000 
FILE CARD (5,10,CIS);                                                   00385000 
DEFINE LINESIZE = 900 #;                                                00386000 
SAVE FILE LINE DISK SERIAL [20:LINESIZE] (2,15,LOS,SAVE 10);            00387000 
SAVE FILE NEWTAPE DISK SERIAL [20:LINESIZE] "FORSYM" (2,10,TOS,SAVE 10);00388000 
FILE TAPE "FORSYM" (2,10,TIS);                                          00389000 
FILE REMOTE 19(2,10) ;                                                  00389500 
DEFINE CHUNK = 180#;                                                    00390000 
DEFINE PTR=LINE#,RITE=LINE#,CR=CARD#,TP=TAPE#;                     %515-00391000 
FILE CODE DISK RANDOM [20:CHUNK]  (4,30,SAVE ABS(SAVETIME));            00392000 
FILE LIBRARYFIL DISK RANDOM (2,10,150);                                 00392400 
DEFINE LF = LIBRARYFIL#;                                                00392600 
FILE XREFF DISK SERIAL[20:1500](2,XRBUFF) ;                             00392700 
FILE XREFG DISK SERIAL[20:1500](2,3,XRBUFF);                            00392800 
REAL DALOC;        % DISK ADDRESS                                       00393000 
LABEL POSTWRAPUP;                                                       00393100 
PROCEDURE EMITNUM(N); VALUE N; REAL N; FORWARD;                         00394000 
REAL PROCEDURE LOOKFORINTRINSIC(L);  VALUE L;  REAL L;  FORWARD ;       00394500 
PROCEDURE SEGOVF; FORWARD;                                              00395000 
DEFINE BUMPADR= IF (ADR~ADR+1)=4089 THEN SEGOVF#;                       00396000 
DEFINE BUMPLOCALS = BEGIN IF LOCALS~LOCALS+1>255 THEN BEGIN FLAG(148);  00396500 
                           LOCALS~2 END END#;                           00396510 
DEFINE BUMPPRT=BEGIN IF PRTS~PRTS+1>1023 THEN BEGIN FLAG(46);           00396600 
                           PRTS~40 END END#;                            00396610 
DEFINE EDOCI = ADR.[36:3], ADR.[39:7]#;                                 00397000 
DEFINE TWODPRT=IF TWODPRTX=0 THEN(TWODPRTX~PRTS~PRTS+1)ELSE TWODPRTX#;  00398000 
REAL PROCEDURE SEARCH(E); VALUE E; REAL E; FORWARD;                     00399010 
PROCEDURE PRINTCARD; FORWARD;                                           00400000 
INTEGER PROCEDURE FEELD(X);  VALUE X;  INTEGER X;  FORWARD ;            00400010 
ALPHA PROCEDURE NEED(T, C); VALUE T, C; ALPHA T, C; FORWARD;            00401000 
ALPHA PROCEDURE GETSPACE(S); VALUE S; ALPHA S; FORWARD;                 00402000 
PROCEDURE EQUIV(R); VALUE R; REAL R; FORWARD;                           00403000 
PROCEDURE EXECUTABLE; FORWARD;                                          00403100 
ALPHA PROCEDURE B2D(B); VALUE B; REAL B; FORWARD;                       00404000 
PROCEDURE DEBUGWORD (N); VALUE N; REAL N;      FORWARD;                 00405000 
PROCEDURE EMITL(N); VALUE N; REAL N; FORWARD;                           00406000 
PROCEDURE ADJUST;FORWARD;                                               00407000 
PROCEDURE DATIME;  FORWARD;                                             00407500 
PROCEDURE EMITB(A,C); VALUE A,C; REAL A; BOOLEAN C; FORWARD;            00408000 
PROCEDURE FIXB(N); VALUE N; REAL N; FORWARD;                            00408100 
PROCEDURE EMITO(N); VALUE N; REAL N; FORWARD;                           00409000 
PROCEDURE EMITOPDCLIT(N); VALUE N; REAL N; FORWARD;                     00410000 
PROCEDURE EMITDESCLIT(N); VALUE N; REAL N; FORWARD;                     00411000 
PROCEDURE EMITPAIR(L,OP); VALUE L,OP; INTEGER L,OP; FORWARD;            00412000 
PROCEDURE EMITN(N); VALUE N; REAL N; FORWARD;                           00413000 
PROCEDURE ARRAYDEC(I); VALUE I; REAL I; FORWARD;                        00414000 
INTEGER PROCEDURE ENTER(W, E); VALUE W, E; ALPHA W, E; FORWARD;         00415000 
REAL PROCEDURE PRGDESCBLDR(A,B,C,D); VALUE A,B,C,D; REAL A,B,C,D;       00416000 
               FORWARD;                                                 00417000 
PROCEDURE WRITEDATA(A,B,C); VALUE A,B; REAL A,B;                        00418000 
                   ARRAY C[0];      FORWARD;                            00419000 
PROCEDURE SCAN;      FORWARD;                                           00420000 
PROCEDURE SEGMENT(A,B,C,D); VALUE A,B,C;                                00421000 
         REAL A,B; BOOLEAN C; ARRAY D[0,0];    FORWARD;                 00422000 
STREAM PROCEDURE MOVESEQ(OLD,NEW);  BEGIN DI~OLD; SI~NEW; DS~WDS END ;  00422010 
PROCEDURE WRITAROW(N,ROW); VALUE N; INTEGER N; REAL ARRAY ROW[0] ;      00422100 
IF SINGLETOG THEN WRITE(LINE,N,ROW[*]) ELSE WRITE(RITE,N,ROW[*]) ;      00422110 
PROCEDURE WRITALIST(FMT,N,L1,L2,L3,L4,L5,L6,L7,L8);                     00422120 
VALUE N,L1,L2,L3,L4,L5,L6,L7,L8; INTEGER N;                             00422130  
REAL L1,L2,L3,L4,L5,L6,L7,L8; FORMAT FMT;                               00422140  
   BEGIN                                                                00422150  
   PRINTBUFF[1]~L1;                                                     00422160  
   L1~1 ;                                                               00422170  
   FOR L2~L2,L3,L4,L5,L6,L7,L8 DO PRINTBUFF[L1~L1+1]~L2 ;               00422180
   IF SINGLETOG THEN WRITE(LINE,FMT,FOR L1~1 THRU N DO PRINTBUFF[L1])   00422190 
   ELSE WRITE(RITE,FMT,FOR L1~1 THRU N DO PRINTBUFF[L1]) ;              00422200 
   END WRITALIST ;                                                      00422210  
STREAM PROCEDURE BLANKIT(A,N,P);  VALUE N,P;                            00422220  
BEGIN DI~A;  N(DS~8 LIT"        ");  P(DS~8 LIT"99999999") END ;        00422230
BOOLEAN STREAM PROCEDURE TSSMES(A,B);  VALUE B;                         00422235  
BEGIN SI~A;  SKIP B SB;  IF SB THEN ELSE BEGIN TALLY~1;  TSSMES~TALLY ; 00422240
DI~A;  SKIP B DB;  DS~SET END END OF TSSMES ;                           00422250
STREAM PROCEDURE TSSEDIT(X,P1,P2,P3,P,N);  VALUE P1,P2,P3,N ;           00422255  
BEGIN DI~P;DS~16LIT"TSS WARNING:    ";SI~X;SI~SI+2; DS~6CHR; DS~4LIT" ";00422260
P1(DS~48LIT"A TSS HOL OR QUOTED STRING MUST BE ON 1 LINE    ") ;        00422262 
P2(DS~48LIT"THIS CONSTRUCT IS ILLEGAL IN TSS FORTRAN        ") ;        00422264 
P3(DS~48LIT"THIS CONSTRUCT IS UNRESERVED IN TSS FORTRAN     ") ;        00422266 
DS~26LIT" ";  DS~8LIT"*";  DS~LIT" ";  SI~LOC N;  DS~3DEC END TSSEDIT ; 00422268
PROCEDURE TSSED(X,N);  VALUE X,N;  ALPHA X;  INTEGER N ;                00422270  
BEGIN IF NOT (LISTOG OR SEQERRORS) THEN PRINTCARD ; UNPRINTED~FALSE ;   00422275 
TSSEDIT(X,N=1,N=2,N=3,PRINTBUFF,WARNCOUNT~WARNCOUNT+1) ;                00422280 
WRITAROW(14,PRINTBUFF) END OF TSSED;                                    00422285  
PROCEDURE ERRMESS(N);  VALUE N; INTEGER N;                              00423000   
BEGIN                                                                   00424000          
                                                                        00425000
STREAM PROCEDURE PLACE(D,N,X,S,E,L);   VALUE N,E ;                      00426000          
BEGIN DI ~ D;  DS ~ 6 LIT "ERROR ";                                     00427000        
      SI ~ LOC N;  DS ~ 3 DEC;  DS ~ 5 LIT ":    ";                     00428000       
      SI ~ X;  SI ~ SI + 2;  DS ~ 6 CHR;  DS ~ 4 LIT " ";               00429000      
      SI~S;  DS~6 WDS;  DS~6 LIT" ";  SI~L;  DS~8 CHR;  DS~14 LIT" " ;  00430000    
      DS ~ 8 LIT "X";  DS ~ LIT " ";                                    00431000        
      SI ~ LOC E;  DS ~ 3 DEC;                                          00432000        
END PLACE;                                                              00433000          
STREAM PROCEDURE DCPLACE(D,N,X,S,M,P);  VALUE N,P;                      00433100          
    BEGIN DI~D;  DS~4LIT"ERR#";  SI~LOC N;  DS~3 DEC;  DS~3LIT" @ ";    00433200     
    SI~S; DS~8CHR; DS~2LIT": "; SI~X;  SI~SI+2; DS~6CHR; DS~54LIT" " ;  00433300   
    END OF DCPLACE ;                                                    00433400          
ERRORCT~ERRORCT+1;                                                      00433500          
IF NOT MSFL[N DIV 16] THEN                                              00434000          
    BEGIN                                                               00434020          
    MSFL[N DIV 16]~TRUE ;                                               00434030         
    CASE(N DIV 16)OF                                                    00434040          
BEGIN                                                                   00435000          
         FILL MESSAGE[0,*] WITH                                         00436000
"SYNTAX E","RROR    ","        ","        ","        ","        ", %000 00437000
"MISSING ","OPERATOR"," OR PUNC","TUATION ","        ","        ", %001 00438000
"CONFLICT","ING COMM","ON AND/O","R EQUIVA","LENCE AL","LOCATION", %002 00439000
"MISSING ","RIGHT PA","RENTHESI","S       ","        ","        ", %003 00440000
"ENTRY ST","MT ILLEG","AL IN MA","IN PGM O","R BLOCK ","DATA    ", %004 00441000
"MISSING ","END STAT","EMENT   ","        ","        ","        ", %005 00442000
"ARITHMET","IC EXPRE","SSION RE","QUIRED  ","        ","        ", %006 00443000
"LOGICAL ","EXPRESSI","ON REQUI","RED     ","        ","        ", %007 00444000
"TOO MANY"," LEFT PA","RENTHESE","S       ","        ","        ", %008 00445000
"TOO MANY"," RIGHT P","ARENTHES","ES      ","        ","        ", %009 00446000
"FORMAL P","ARAMETER"," ILLEGAL"," IN COMM","ON      ","        ", %010 00447000
"FORMAL P","ARAMETER"," ILLEGAL"," IN EQUI","VALENCE ","        ", %011 00448000
"THIS STA","TEMENT I","LLEGAL I","N BLOCK ","DATA SUB","PROGRAM ", %012 00449000
"INFO ARR","AY OVERF","LOW     ","        ","        ","        ", %013 00450000
"IMPROPER"," DO NEST","        ","        ","        ","        ", %014 00451000
"DO LABEL"," PREVIOU","SLY DEFI","NED     ","        ","        ", %015 00452000
0;                                                                      00453000
         FILL MESSAGE[1,*] WITH                                         00454000
"UNRECOGN","IZED STA","TEMENT T","YPE     ","        ","        ", %016 00455000
"ILLEGAL ","DO STATE","MENT    ","        ","        ","        ", %017 00456000
"FORMAT S","TATEMENT"," MUST HA","VE LABEL","        ","        ", %018 00457000
"UNDEFINE","D LABEL ","        ","        ","        ","        ", %019 00458000
"MULTIPLE"," DEFINIT","ION     ","        ","        ","        ", %020 00459000
"ILLEGAL ","IDENTIFI","ER CLASS"," IN THIS"," CONTEXT","        ", %021 00460000
"UNPAIRED"," QUOTES ","IN FORMA","T       ","        ","        ", %022 00461000
"NOT ENOU","GH SUBSC","RIPTS   ","        ","        ","        ", %023 00462000
"TOO MANY"," SUBSCRI","PTS     ","        ","        ","        ", %024 00463000
"FUNCTION"," OR SUBR","OUTINE P","REVIOUSL","Y DEFINE","D       ", %025 00464000
"FORMAL P","ARAMETER"," MULTIPL","Y DEFINE","D IN HEA","DING    ", %026 00465000
"ILLEGAL ","USE OF N","AMELIST ","        ","        ","        ", %027 00466000
"NUMBER O","F PARAME","TERS INC","ONSISTEN","T       ","        ", %028 00467000
"CANNOT B","RANCH TO"," FORMAT ","STATEMEN","T       ","        ", %029 00468000
"SUBROUTI","NE OR FU","NCTION N","OT DEFIN","ED IN PR","OGRAM   ", %030 00469000
"IDENTIFI","ER ALREA","DY GIVEN"," TYPE   ","        ","        ", %031 00470000
0;                                                                      00471000                                                         00472000 479000          
         FILL MESSAGE[2,*] WITH                                         00472000
"ILLEGAL ","FORMAT S","YNTAX   ","        ","        ","        ", %032 00473000
"INCORREC","T USE OF"," FILE   ","        ","        ","        ", %033 00474000
"INCONSIS","TENT USE"," OF IDEN","TIFIER  ","        ","        ", %034 00475000
"ARRAY ID","ENTIFIER"," EXPECTE","D       ","        ","        ", %035 00476000
"EXPRESSI","ON VALUE"," REQUIRE","D       ","        ","        ", %036 00477000
"ILLEGAL ","FILE CAR","D SYNTAX","        ","        ","        ", %037 00478000
"ILLEGAL ","CONTROL ","ELEMENT ","        ","        ","        ", %038 00479000
"DECLARAT","ION MUST"," PRECEDE"," FIRST R","EFERENCE","        ", %039 00480000
"INCONSIS","TENT USE"," OF LABE","L AS PAR","AMETER  ","        ", %040 00481000
"NO. OF P","ARAMS. D","ISAGREES"," WITH PR","EV. REFE","RENCE   ", %041 00482000
"ILLEGAL ","USE OF F","ORMAL PA","RAMETER ","        ","        ", %042 00483000
"ERROR IN"," HOLLERI","TH LITER","AL CHARA","CTER COU","NT      ", %043 00484000
"ILLEGAL ","ACTUAL P","ARAMETER","        ","        ","        ", %044 00485000
"TOO MANY"," SEGMENT","S IN SOU","RCE PROG","RAM     ","        ", %045 00486000
"TOO MANY"," PRT ASS","IGNMENTS"," IN SOUR","CE PROGR","AM      ", %046 00487000
"LAST BLO","CK DECLA","RATION H","AD LESS ","THAN 102","4 WORDS ", %047 00488000
0;                                                                      00489000
         FILL MESSAGE[3,*] WITH                                         00490000
"ILLEGAL ","I/O LIST"," ELEMENT","        ","        ","        ", %048 00491000
"LEFT SID","E MUST B","E SIMPLE"," OR SUBS","CRIPTED ","VARIABLE", %049 00492000
"VARIABLE"," EXPECTE","D       ","        ","        ","        ", %050 00493000
"ILLEGAL ","USE OF .","OR.     ","        ","        ","        ", %051 00494000
"ILLEGAL ","USE OF .","AND.    ","        ","        ","        ", %052 00495000
"ILLEGAL ","USE OF .","NOT.    ","        ","        ","        ", %053 00496000
"ILLEGAL ","USE OF R","ELATIONA","L OPERAT","OR      ","        ", %054 00497000
"ILLEGAL ","MIXED TY","PES     ","        ","        ","        ", %055 00498000
"ILLEGAL ","EXPRESSI","ON STRUC","TURE    ","        ","        ", %056 00499000
"ILLEGAL ","PARAMETE","R       ","        ","        ","        ", %057 00500000
"RECORD B","LOCK GRE","ATER THA","N 1023  ","        ","        ", %058 00501000
"TOO MANY"," OPTIONA","L FILES ","        ","        ","        ", %059 00502000
"FILE CAR","DS MUST ","PRECEDE ","SOURCE D","ECK     ","        ", %060 00503000
"BINARY W","RITE STA","TEMENT H","AS NO LI","ST      ","        ", %061 00504000
"UNDEFINE","D FORMAT"," NUMBER ","        ","        ","        ", %062 00505000
"ILLEGAL ","EXPONENT"," IN CONS","TANT    ","        ","        ", %063 00506000
0;                                                                      00507000
         FILL MESSAGE[4,*] WITH                                         00508000
"ILLEGAL ","CONSTANT"," IN DATA"," STATEME","NT      ","        ", %064 00509000
"MAIN PRO","GRAM MIS","SING    ","        ","        ","        ", %065 00510000
"PARAMETE","R MUST B","E ARRAY ","IDENTIFI","ER      ","        ", %066 00511000
"PARAMETE","R MUST B","E EXPRES","SION    ","        ","        ", %067 00512000
"PARAMETE","R MUST B","E LABEL ","        ","        ","        ", %068 00513000
"PARAMETE","R MUST B","E FUNCTI","ON IDENT","IFIER   ","        ", %069 00514000
"PARAMETE","R MUST B","E FUNCTI","ON OR SU","BROUTINE"," ID     ", %070 00515000
"PARAMETE","R MUST B","E SUBROU","TINE IDE","NTIFIER ","        ", %071 00516000
"PARAMETE","R MUST B","E ARRAY ","IDENTIFI","ER OR EX","PRESSION", %072 00517000
"ARITHMET","IC - LOG","ICAL CON","FLICT ON"," STORE  ","        ", %073 00518000
"ARRAYID ","MUST BE ","SUBSCRIP","TED IN T","HIS CONT","EXT     ", %074 00519000
"MORE THA","N ONE MA","IN PROGR","AM      ","        ","        ", %075 00520000
"ONLY COM","MON ELEM","ENTS PER","MITTED  ","        ","        ", %076 00521000
"TOO MANY"," FILES  ","        ","        ","        ","        ", %077 00522000
"FORMAT O","R NAMELI","ST TOO L","ONG     ","        ","        ", %078 00523000
"FORMAL P","ARAMETER"," MUST BE"," ARRAY I","DENTIFIE","R       ", %079 00524000
0;                                                                      00525000
         FILL MESSAGE[5,*] WITH                                         00526000
"FORMAL P","ARAMETER"," MUST BE"," SIMPLE ","VARIABLE","        ", %080 00527000
"FORMAL P","ARAMETER"," MUST BE"," FUNCTIO","N IDENTI","FIER    ", %081 00528000
"FORMAL P","ARAMETER"," MUST BE"," SUBROUT","INE IDEN","TIFIER  ", %082 00529000
"FORMAL P","ARAMETER"," MUST BE"," FUNCTIO","N OR SUB","ROUTINE ", %083 00530000
"DO OR IM","PLIED DO"," INDEX M","UST BE I","NTEGER O","R REAL  ", %084 00531000
"ILLEGAL ","COMPLEX ","CONSTANT","        ","        ","        ", %085 00532000
"ILLEGAL ","MIXED TY","PE STORE","        ","        ","        ", %086 00533000
"CONSTANT"," EXCEEDS"," HARDWAR","E LIMITS","        ","        ", %087 00534000
"PARAMETE","R TYPE C","ONFLICTS"," WITH PR","EVIOUS U","SE      ", %088 00535000
"COMPLEX ","EXPRESSI","ON ILLEG","AL IN IF"," STATEME","NT      ", %089 00536000
"COMPLEX ","EXPRESSI","ON ILLEG","AL IN RE","LATION  ","        ", %090 00537000
"TOO MANY"," FORMATS"," REFEREN","CED BUT ","NOT YET ","FOUND   ", %091 00538000
"VARIABLE"," ARRAY B","OUND MUS","T BE FOR","MAL VARI","ABLE    ", %092 00539000
"ARRAY BO","UND MUST"," HAVE IN","TEGER OR"," REAL TY","PE      ", %093 00540000
"COMMA OR"," RIGHT P","ARENTHES","IS EXPEC","TED     ","        ", %094 00541000
"ARRAY AL","READY GI","VEN BOUN","DS      ","        ","        ", %095 00542000
0;                                                                      00543000
         FILL MESSAGE[6,*] WITH                                         00544000
"ONLY FOR","MAL ARRA","YS MAY B","E GIVEN ","VARIABLE"," BOUNDS ", %096 00545000
"MISSING ","LEFT PAR","ENTHESIS"," IN IMPL","IED DO  ","        ", %097 00546000
"SUBSCRIP","T MUST B","E INTEGE","R OR REA","L       ","        ", %098 00547000
"ARRAY SI","ZE CANNO","T EXCEED"," 32767 W","ORDS    ","        ", %099 00548000
"COMMON O","R EQUIV ","BLOCK CA","NNOT EXC","EED 3276","7 WORDS ", %100 00549000
"THIS STA","TEMENT I","LLEGAL I","N LOGICA","L IF    ","        ", %101 00550000
"REAL OR ","INTEGER ","TYPE REQ","UIRED   ","        ","        ", %102 00551000
"ARRAY BO","UND INFO","RMATION ","REQUIRED","        ","        ", %103 00552000
"REPLACEM","ENT OPER","ATOR EXP","ECTED   ","        ","        ", %104 00553000
"IDENTIFI","ER EXPEC","TED     ","        ","        ","        ", %105 00554000
"LEFT PAR","ENTHESIS"," EXPECTE","D       ","        ","        ", %106 00555000
"ILLEGAL ","FORMAL P","ARAMETER","        ","        ","        ", %107 00556000
"RIGHT PA","RENTHESI","S EXPECT","ED      ","        ","        ", %108 00557000
"STATEMEN","T NUMBER"," EXPECTE","D       ","        ","        ", %109 00558000
"SLASH EX","PECTED  ","        ","        ","        ","        ", %110 00559000
"ENTRY ST","ATEMENT ","CANNOT B","EGIN PRO","GRAM UNI","T       ", %111 00560000
0;                                                                      00561000
         FILL MESSAGE[7,*] WITH                                         00562000
"ARRAY MU","ST BE DI","MENSIONE","D PRIOR ","TO EQUIV"," STMT   ", %112 00563000
"INTEGER ","CONSTANT"," EXPECTE","D       ","        ","        ", %113 00564000
"COMMA EX","PECTED  ","        ","        ","        ","        ", %114 00565000
"SLASH OR"," END OF ","STATEMEN","T EXPECT","ED      ","        ", %115 00566000
"FORMAT, ","ARRAY OR"," NAMELIS","T EXPECT","ED      ","        ", %116 00567000
"END OF S","TATEMENT"," EXPECTE","D       ","        ","        ", %117 00568000
"IO STATE","MENT WIT","H NAMELI","ST CANNO","T HAVE I","O LIST  ", %118 00569000
"COMMA OR"," END OF ","STATEMEN","T EXPECT","ED      ","        ", %119 00570000
"STRING T","OO LONG ","        ","        ","        ","        ", %120 00571000
"MISSING ","QUOTE AT"," END OF ","STRING  ","        ","        ", %121 00572000
"ILLEGAL ","ARRAY BO","UND     ","        ","        ","        ", %122 00573000
"TOO MANY"," HANGING"," BRANCHE","S       ","        ","        ", %123 00574000
"TOO MANY"," COMMON ","OR EQUIV","ALENCE E","LEMENTS ","        ", %124 00575000
"ASTERISK"," EXPECTE","D       ","        ","        ","        ", %125 00576000
"COMMA OR"," SLASH E","XPECTED ","        ","        ","        ", %126 00577000
"DATA SET"," TOO LAR","GE      ","        ","        ","        ", %127 00578000
0;                                                                      00579000
         FILL MESSAGE[8,*] WITH                                         00580000
"TOO MANY"," ENTRY S","TATEMENT","S IN THI","S SUBPRO","GRAM    ", %128 00581000
"DECIMAL ","WIDTH EX","CEEDS FI","ELD WIDT","H       ","        ", %129 00582000
"UNSPECIF","IED FIEL","D WIDTH ","        ","        ","        ", %130 00583000
"UNSPECIF","IED SCAL","E FACTOR","        ","        ","        ", %131 00584000
"ILLEGAL ","FORMAT C","HARACTER","        ","        ","        ", %132 00585000
"UNSPECIF","IED DECI","MAL FIEL","D       ","        ","        ", %133 00586000
"DECIMAL ","FIELD IL","LEGAL FO","R THIS S","PECIFIER","        ", %134 00587000
"ILLEGAL ","LABEL   ","        ","        ","        ","        ", %135 00588000
"UNDEFINE","D NAMELI","ST      ","        ","        ","        ", %136 00589000
"MULTIPLY"," DEFINED"," ACTION ","LABELS  ","        ","        ", %137 00590000
"TOO MANY"," NESTED ","DO STATE","MENTS   ","        ","        ", %138 00591000
"STMT FUN","CTION ID"," AND EXP","RESSION ","DISAGREE"," IN TYPE", %139 00592000
"ILLEGAL ","USE OF S","TATEMENT"," FUNCTIO","N       ","        ", %140 00593000
"UNRECOGN","IZED CON","STRUCT  ","        ","        ","        ", %141 00593001
"RETURN, ","STOP OR ","CALL EXI","T REQUIR","ED IN SU","BPROGRAM", %142 00593002
"FORMAT N","UMBER US","ED PREVI","OUSLY AS"," LABEL  ","        ", %143 00593003
0;                                                                      00594000
         FILL MESSAGE[9,*] WITH                                         00595000
"LABEL US","ED PREVI","OUSLY AS"," FORMAT ","NUMBER  ","        ", %144 00595001
"NON-STAN","DARD RET","URN REQU","IRES LAB","EL PARAM","ETERS   ", %145 00595002
"DOUBLE O","R COMPLE","X REQUIR","ES EVEN ","OFFSET  ","        ", %146 00595003
"FORMAL P","ARAMETER"," ILLEGAL"," IN DATA"," STATEME","NT      ", %147 00595004
"TOO MANY"," LOCAL V","ARIABLES"," IN SOUR","CE PROGR","AM      ", %148 00596000
"A $FREEF","ORM SOUR","CE LINE ","MUST HAV","E < 67 C","OLS     ", %149 00596001
"A HOL/ST","RING UND","ER $FREE","FORM MUS","T BE ON ","ONE LINE", %150 00596002
"THIS CON","STRUCT I","S ILLEGA","L IN TSS","FORTRAN ","        ", %151 00596003
"ILLEGAL ","FILE CAR","D PARAME","TER VALU","E       ","        ", %152 00596004
"RETURN I","N MAIN P","ROGRAM N","OT ALLOW","ED      ","        ", %153 00596005
"NON-POSI","TIVE SUB","SCRIPTS ","ARE ILLE","GAL     ","        ", %154 00596006
"NON-IDEN","TIFIER U","SED FOR ","NAME OF ","LIBRARY ","ROUTINE ", %155 00596007
"HYPHEN E","XPECTED ","        ","        ","        ","        ", %156 00596008
"SEQUENCE"," NUMBER ","EXPECTED","        ","        ","        ", %157 00596009
"TOO MANY"," RECURSI","VE CALLS"," ON LIBR","ARY ROUT","INE     ", %158 00596010
"ASTERISK"," NOT ALL","OWED ID ","READ STA","TEMENT  ","        ", %159 00596011
0;                                                                      00596500
         FILL MESSAGE[10,*] WITH                                        00596501
"ASTERISK"," ONLY AL","LOWED IN"," FREE FI","ELD OUTP","UT      ", %160 00596510
"TOO MANY"," *-ED LI","ST ELEME","NTS IN O","UTPUT   ","        ", %161 00596511
"HOL OR Q","UOTED ST","RING > 7"," CHARACT","ERS IN E","XPRESSN ", %162 00596512
"DECIMAL ","FIELD GR","EATER TH","AN FIELD"," WIDTH-5","        ", %163 00596513
"PLUS NOT"," ALLOWED"," IN THIS"," FORMAT ","PHRASE  ","        ", %164 00596514
"K NOT AL","LOWED IN"," THIS FO","RMAT PHR","ASE     ","        ", %165 00596515
"$ NOT AL","LOWED IN"," THIS FO","RMAT PHR","ASE     ","        ", %166 00596516
"INTRNSCS","-NAMD FU","NCT MUST"," HAV PRE","V EXTRNL"," REFERNC", %167 00596517
"DATA STM","T COMMON"," ELEM MU","ST BE IN"," BLK DAT","A SUBPRG", %168 00596518
"VARIABLE"," CANNOT ","BE A FOR","MAL PARA","METER OR"," IN CMMN", %169 00596519
"CURRENT ","SUBPROGR","AM ID EX","PECTED  ","        ","        ", %170 00596520
"SUBPROGR","AM, EXTE","RNAL, OR"," ARRAY I","D EXPECT","ED      ", %171 00596521
"REPEAT, ","WIDTH, A","ND DECIM","AL PARTS"," MUST BE"," < 4091 ", %172 00596522
"REPEAT P","ART MUST"," BE EMPT","Y OR > 0"," AND < 4","091     ", %173 00596523
"IN SUBPR","GM:VARBL"," IS USED"," PRIOR T","O USE IN"," DATSTMT", %174 00596524
"SYNTATIC","AL TOKEN"," CONTAIN","S TOO MA","NY CHARA","CTERS.  ", %175 00596525
0;                                                                      00596526
         FILL MESSAGE[11,*] WITH                                        00596527
"INTEGER ","VALUE OF"," 8 EXPEC","TED     ","        ","        ", %176 00596528
"INTEGER ","VALUE OF"," 4 EXPEC","TED     ","        ","        ", %177 00596529
"INTEGER ","VALUE OF"," 4 OR 8 ","EXPECTED","        ","        ", %178 00596530
"AN ALPHA","BETIC LE","TTER (A,","B,C,...,","Z) IS RE","QUIRED  ", %179 00596531
"SECOND R","ANGE LET","TER MUST"," BE GREA","TER THAN"," FIRST  ", %180 00596532
"IMPLICIT"," MUST BE"," FIRST S","TATEMENT"," IN PROG","RAM UNIT", %181 00596533
"REAL/INT","EGER/LOG","ICAL/COM","PLEX/DOU","BLEPRECI","SION REQ", %182 00596534
 "ILLEGAL ","USE OF A","STERISK ","FOR RUN-","TIME EDI","TING    ",%111-00596535
 "NO PROGR","AM UNIT ","FOR THIS"," END STA","TEMENT  ","        ",%112-00596536
0;                                                                      00596599                                                                        00596538
END FILL STATEMENTS;                                                    00597000
    END ;                                                               00597950
IF DCINPUT THEN                                                         00598000
    BEGIN                                                               00598020
    DCPLACE(ERRORBUFF,N,XTA,LASTSEQ,MESSAGE[N DIV 16,6|(N MOD 16)],     00598040
            IF TSSMESTOG THEN TSSMES(TSSMESA[(N-1)DIV 48],              00598050
            ENTIER((N-1) MOD 48)) ELSE FALSE) ;                         00598060
    WRITE(REMOTE,9,ERRORBUFF[*]) ;                                      00598080
    END ;                                                               00598100
IF LISTOG OR NOT DCINPUT THEN                                           00598120
    BEGIN                                                               00598140
    PLACE(ERRORBUFF,N,XTA,MESSAGE[N DIV 16,6|(N MOD 16)],ERRORCT,       00598160
          LASTERR) ;                                                    00598180
    WRITAROW(14,ERRORBUFF) ;                                            00598200
    END;                                                                00599000
MOVESEQ(LASTERR,LINKLIST) ;                                             00599500
END ERRMESS;                                                            00600000
PROCEDURE FLAGROUTINE(NAME1,NAME2,ENTERING) ;                           00600010
VALUE NAME1,NAME2,ENTERING ;                                            00600020
ALPHA NAME1,NAME2;                                                      00600030
BOOLEAN ENTERING;                                                       00600040
IF ENTERING THEN WRITALIST(FLAGROUTINEFORMAT,7,"ENTERI","NG",NAME1,     00600050
NAME2,"+",FEELD(FLAGROUTINECOUNTER~FLAGROUTINECOUNTER+1),               00600060
FLAGROUTINECOUNTER,0) ELSE                                              00600065
   BEGIN                                                                00600070
   WRITALIST(FLAGROUTINEFORMAT,7,"LEAVIN","G ",NAME1,NAME2,"-",         00600080
   FEELD(FLAGROUTINECOUNTER),FLAGROUTINECOUNTER,0) ;                    00600090
   FLAGROUTINECOUNTER~FLAGROUTINECOUNTER-1 ;                            00600100
   END ;                                                                00600110
%END OF FLAGROUTINE                                                     00600120
PROCEDURE FLAG(N); VALUE N; INTEGER N;                                  00601000
IF NOT ERRORTOG OR DEBUGTOG THEN                                        00602000
BEGIN                                                                   00603000
   IF NOT (LISTOG OR SEQERRORS OR DCINPUT) THEN PRINTCARD ;             00604000
   ERRMESS(N);                                                          00606000
   IF ERRORCT } LIMIT THEN GO TO POSTWRAPUP;                            00606500
END;                                                                    00607000
PROCEDURE FLOG(N); VALUE N; INTEGER N;                                  00608000
IF NOT ERRORTOG OR DEBUGTOG THEN                                        00609000
   BEGIN ERRORTOG ~ TRUE;                                               00610000
   IF NOT (LISTOG OR SEQERRORS OR DCINPUT) THEN PRINTCARD;              00611000
   ERRMESS(N);                                                          00613000
   IF ERRORCT } LIMIT THEN GO TO POSTWRAPUP;                            00613500
   END;                                                                 00614000
PROCEDURE FATAL(N); VALUE N; INTEGER N;                                 00615000
BEGIN                                                                   00616000
         FORMAT FATALERR("XXXXXXXX", X18,                               00617000
         "PREVIOUS ERROR IS FATAL - REMAINDER OF SUBPROGRAM IGNORED",   00618000
         X17, "XXXXXXXX");                                              00619000
         ERRORTOG ~ FALSE;                                              00620000
         FLAG(N);                                                       00621000
         WRITALIST(FATALERR,0,0,0,0,0,0,0,0,0) ;                        00622000
         WHILE NEXT ! 11 DO           % LOOK FOR END STMT               00623000
    BEGIN                                                               00624000
         WHILE NEXT ! SEMI DO SCAN;                                     00625000
         EOSTOG ~ TRUE;                                                 00626000
         SCAN;                                                          00627000
    END;                                                                00628000
         SEGMENT((ADR+4) DIV 4, NSEG, FALSE, EDOC);                     00629000
         SCAN;                                                          00630000
END FATAL;                                                              00631000
REAL STREAM PROCEDURE D2B(BCL); BEGIN SI~BCL;  DI~LOC D2B;  DS~8OCT END;00631100
REAL PROCEDURE GET(I);  VALUE I;  INTEGER I ;                           00632000
    BEGIN                                                               00633000
         GET ~ INFO[(I~I).IR,I.IC];                                     00634000
    END GET;                                                            00635000
PROCEDURE PUT(I,VLU); VALUE I,VLU; INTEGER I; REAL VLU;                 00636000
    BEGIN                                                               00637000
         INFO[(I~I).IR,I.IC] ~ VLU;                                     00638000
    END PUT;                                                            00639000
PROCEDURE GETALL(I,INFA,INFB,INFC);                                     00640000
VALUE I;  INTEGER I;  REAL INFA,INFB,INFC;                              00641000
    BEGIN                                                               00642000
         INFA ~ INFO[(I~I).IR,I.IC] ;                                   00643000
         INFB ~ INFO[(I~I+1).IR,I.IC];                                  00644000
         INFC ~ INFO[(I~I+1).IR,I.IC];                                  00645000
    END;                                                                00646000
PROCEDURE PUTC(I,V); VALUE I,V; INTEGER I; REAL V;                      00646100
IF I~I>SUPERMAXCOM THEN FATAL(124) ELSE COM[I.IR,I.IC]~V;               00646200
REAL PROCEDURE GETC(I);  VALUE I;  INTEGER I ;                          00646300
GETC~COM[(I~I).IR,I.IC];                                                00646400
PROCEDURE BAPC(V);  VALUE V;  REAL V;                                   00646500
IF NEXTCOM~NEXTCOM+1 > SUPERMAXCOM THEN FATAL(124)                      00646600
ELSE COM[NEXTCOM.IR,NEXTCOM.IC]~V ;                                     00646700
STREAM PROCEDURE MOVEW(F,T,D,M); VALUE D,M;                             00647000
    BEGIN SI ~ F; DI ~ T; D(DS ~32 WDS; DS ~ 32 WDS); DS ~ M WDS; END;  00648000
PROCEDURE CALLEQUIV(I,B,G); VALUE I,B,G; INTEGER I; REAL G; BOOLEAN B ; 00649000
BEGIN REAL A,T,R,INFA,INFC;                                             00650000
      REAL LAST,D; LABEL L;                                             00650100
PROCEDURE CORRECTINFO(R,A); VALUE R,A; INTEGER R,A;                     00651000
COMMENT  THIS PROCEDURE CORRECTS THE INFO TABLE FOR COMMON AND          00651010
           EQUIVALENCE ELEMENTS.                                        00651020
         IF ITEMS ARE IN COMMON THE INFA[EQ] BIT IS SET                 00651030
           THIS BIT IS USED TO TELL DATA STATEMENTS THAT THIS IS A      00651040
           COMMON ELEMENT AND IF NOT IN BLOCK DATA SUBPROGRAM EMIT      00651050
           SYNTAX ERROR 168.                                            00651060
         THE INFA[CE] BIT IS SET TO TELL THAT IF THE CLASS IS VARID     00651070
           EMIT CODE AS IF THIS ITEM WERE ARRAYID BUT DO NOT            00651080
           ALLOW SUBSCRIPTING;                                          00651090
BEGIN                                                                   00652000
   REAL T,I,LAST,L,REL,TWODBIT,INFA,INFB,INFC;                          00653000
   REAL CEBIT;                                                          00654000
   DEFINE LB = LOWERBOUND#;                                             00655000
   TWODBIT ~ REAL(LENGTH > 1023);                                       00656000
   CEBIT ~ REAL(LENGTH > 1);                                            00657000
   T ~ R;                                                               00658000
   DO                                                                   00659000
   BEGIN                                                                00660000
      LAST~GETC(T).LASTC-1 ;                                            00661000
      FOR I ~ T+2 STEP 1 UNTIL LAST DO                                  00662000
      BEGIN                                                             00663000
         IF GETC(I).CLASS = ENDCOM THEN I~GETC(I).LINK ;                00664000
         INFA~GET(L~GETC(I).LINK);  INFC~GET(L+2) ;                     00665000
         IF INFC    > 0 AND LB ! 0 THEN                                 00666000
         BEGIN                                                          00667000
            IF BOOLEAN(INFA.ADJ) THEN                                   00668000
               REL ~ -INFC.BASE ELSE REL~INFC.BASE;                     00669000
            PUT(L+2,-(INFC&(REL-LB)[TOBASE]));                          00670000
         END;                                                           00671000
         PUT(L,INFA&TWODBIT[TOADJ]&CEBIT[TOCE]&A[TOEQ]);                00672000
      END;                                                              00673000
   END UNTIL T~GETC(T).ADDR=R ;                                         00674000
END CORRECTINFO;                                                        00675000
   LABEL XIT;                                                           00676000
IF DEBUGTOG THEN FLAGROUTINE(" CALLE","QUIV  ",TRUE );                  00676010
COMMENT  THIS PROCEDURE MAKES THE DETERMINATION IF THIS GROUP           00676100
           IS EQUIVALENCE OR COMMON IF BOTH TREATED AS COMMON;          00676110
   T ~ I;                                                               00677000
      GROUPPRT ~ LENGTH ~ A ~ 0;                                        00678000
      LOWERBOUND ~ 32000;                                               00679000
      DO BEGIN IF GETC(T).CE=1 THEN                                     00680000
      BEGIN IF GROUPPRT ! 0 THEN                                        00681000
         BEGIN XTA~G;                                                   00682000
            FLAG(2);                                                    00683000
         END;                                                           00684000
         GROUPPRT~GET(A~GETC(T+1)).ADDR;                                00685000
      END;                                                              00686000
      IF T > R THEN  R ~ T;                                             00687000
      END UNTIL T~GETC(T).ADDR=I ;                                      00688000
      IF GROUPPRT = 0 THEN                                              00689000
         IF B THEN BEGIN BUMPPRT;GROUPPRT~PRTS END ELSE  %OWN           00689100
         BEGIN BUMPLOCALS; GROUPPRT~LOCALS + 1536 END;                  00690000
    T ~ R;                                                              00691000
    SWARYCT ~0;                                                         00691500
    SSNM[6]~LOCALS  ;   SSNM[7]~PARMS    ;   SSNM[8]~PRTS    ;          00691510
    SSNM[9]~LSTS    ;  SSNM[10]~LSTA     ;  SSNM[11]~TV      ;          00691520
   SSNM[12]~SAVESUBS;  SSNM[13]~NAMEIND  ;  SSNM[14]~LSTI    ;          00691530
   SSNM[15]~FX1     ;  SSNM[16]~FX2      ;  SSNM[17]~FX3     ;          00691540
   SSNM[18]~NX1     ;                                                   00691550
    SEENADOUB~FALSE;%                                                   00691800
    DO IF GETC(T+1) ! 0 THEN BEGIN EQUIV(T); T~R; END                   00691900
        ELSE T~GETC(T).ADDR UNTIL T = R;                                00691950
    IF GETC(T) > 0 THEN EQUIV(T);                                       00692000
    LOCALS~SSNM[6];  PARMS~SSNM[7];  PRTS~SSNM[8];  LSTS~SSNM[9] ;      00692010
    LSTA~SSNM[10];  TV~SSNM[11];  SAVESUBS~SSNM[12];  NAMEIND~SSNM[13] ;00692020
    LSTI~SSNM[14];  FX1~SSNM[15];  FX2~SSNM[16];  FX3~SSNM[17];         00692030
    NX1~SSNM[18] ;                                                      00692040
    LENGTH ~ LENGTH - LOWERBOUND;                                       00693000
    IF SEENADOUB THEN     LENGTH~LENGTH+LENGTH.[47:1];% EVEN UP LENGTH  00693500
    SEENADOUB~FALSE;                                                    00693600
    IF A = 0 THEN                                                       00694000
    BEGIN COMMENT THIS IS AN EQUIVALENCE GROUP;                         00694100
    IF SWARYCT } 1 AND LENGTH = 1 THEN LENGTH ~ 2;                      00694150
       IF LENGTH > 1 THEN                                               00694200
       BEGIN                                                            00694300
          A ~ ENTER(-0 & ARRAYID[TOCLASS] & GROUPPRT[TOADDR],           00695000
             EQVID ~ EQVID+1);                                          00696000
          PUT(A+2,0 & LENGTH[TOSIZE]);                                  00696100
       END;                                                             00696200
       CORRECTINFO(R,0);                                                00697100
       GO TO XIT;                                                       00697200
    END;                                                                00697300
    COMMENT THIS IS A COMMON BLOCK;                                     00697400
    IF T ~ (INFC ~ GET(A+2)).SIZE ! 0 THEN                              00700000
    IF T { 1023 AND LENGTH > 1023 THEN                                  00701000
       BEGIN XTA ~ GET(A+1); FLAG(47) END;                              00702000
    IF T < LENGTH THEN PUT(A+2, INFC&LENGTH[TOSIZE]) ELSE LENGTH ~ T;   00702100
    IF LENGTH = 1 THEN LENGTH ~ 2;                                      00703000
    CORRECTINFO(R,1);                                                   00704000
    XIT:                                                                00705000
    IF LENGTH > 32767 THEN BEGIN XTA ~ GET(A+1); FLAG(100) END;         00705100
IF DEBUGTOG THEN FLAGROUTINE(" CALLE","QUIV  ",FALSE) ;                 00705110
END CALLEQUIV;                                                          00706000
STREAM PROCEDURE STOSEQ(XR,SEQ,ID);  VALUE ID;                          00706010
BEGIN LOCAL T;  LABEL L1,L2 ;                                           00706015
      SI ~ LOC ID; DI ~ XR; DS ~ 7LIT"0"; DS ~ CHR; SI ~ SI+1;          00706020
      IF SC } "0" THEN                                                  00706025
      BEGIN SI~SI+4; DI~DI-2;                                           00706030
            5(IF SC= " " THEN SI~SI-1                                   00706035
              ELSE BEGIN DS~CHR; SI~SI-2; DI~DI-2; END);                00706040
      END ELSE                                                          00706045
      BEGIN DI~DI-6;                                                    00706050
            6(IF SC=" " THEN BEGIN TALLY~TALLY+1; SI~SI+1 END           00706055
              ELSE DS~CHR);                                             00706060
            T~TALLY;                                                    00706065
      END;                                                              00706070
      DI~XR; DI~DI+8; SI~SEQ;                                           00706075
      8(IF SC=" " THEN SI~SI+1 ELSE JUMP OUT TO L1);  DS~8LIT"BLANKSEQ";00706080
      GO L2;  L1:   SI~SEQ;  DS~WDS;  L2:                               00706085
      DI~DI+4; SI~LOC T; SI~SI+7; DS~CHR;                               00706090
END;                                                                    00706095
PROCEDURE ENTERX(IDENT,ADINFO); VALUE IDENT, ADINFO;                    00706120
REAL IDENT,ADINFO;                                                      00706150
BEGIN REAL R,S;                                                         00706200
      IF ADINFO.CLASS>LABELID THEN                                      00706220
         BEGIN                                                          00706240
         XR[2]~ADINFO;  STOSEQ(XR,LINKLIST,IDENT);                      00706260
         IF ADINFO.CLASS=FUNID THEN XR[2].[26:1]~S~1 ;                  00706280
         WRITE(XREFG,3,XR[*]);  XGLOBALS~TRUE;                          00706300
         END ;                                                          00706320
      IF R~XRI MOD XRBUFFDIV3=0 THEN                                    00706340
         IF XRI!0 THEN WRITE(XREFF,XRBUFF,XRRY[*]) ;                    00706350
      XRRY[(R~R+R+R)+2]~ADINFO&S[26:47:1] ;                             00706360
      STOSEQ(XRRY[R],LINKLIST,IDENT) ;                                  00706380
      IF XRI~XRI+1=1 THEN BEGIN XR[3]~IDENT;  XR[4]~XRRY[2] END;        00706450
END ENTERX;                                                             00706500
    STREAM PROCEDURE TRANSFER(W2,B,K);  VALUE K;                        00706525
         BEGIN DI~W2; SI~B; SI~SI+8; K(DS~WDS; SI~SI+16) END ;          00706530
BOOLEAN STREAM PROCEDURE CMPA(F,S);                                     00706560
BEGIN SI~F; DI ~ S; IF 8 SC { DC THEN TALLY ~ 1; CMPA~TALLY; END;       00706570
BOOLEAN PROCEDURE CMP(A,B);  ARRAY A,B[0];                              00706600
BEGIN                                                                   00706610
CMP ~ IF A[0] < B[0] THEN TRUE ELSE IF A[0] = B[0] THEN                 00706640
      IF A[2].[26:4] < B[2].[26:4] THEN TRUE ELSE                       00706650
      IF A[2].[26:4] = B[2].[26:4] THEN CMPA(A[1],B[1]) ELSE FALSE      00706660
      ELSE FALSE;                                                       00706670
END;                                                                    00706680
PROCEDURE HV(V); ARRAY V[0];                                            00706700
FILL V[*] WITH OCT777777777777777,OCT777777777777777,OCT777777777777777;00706720
BOOLEAN PROCEDURE INP(XR);  ARRAY XR[0];                                00706730
BEGIN LABEL EOF;  REAL R ;                                              00706733
IF EODS THEN READ(XREFG,3,XR[*])[EOF] ELSE                              00706735
IF IT ~ IT+1 > XRI THEN                                                 00706750
     BEGIN EOF: INP~TRUE; IT~XRI~0; END                                 00706760
ELSE BEGIN                                                              00706770
    IF R~(IT-1) MOD XRBUFFDIV3=0 THEN READ(XREFF,XRBUFF,XRRY[*]) ;      00706780
    XR[0]~XRRY[R~R+R+R];  XR[2]~XRRY[R+2];  TRANSFER(XR[1],XRRY[R],1) ; 00706800
    END ;                                                               00706810
END OF INP ;                                                            00706820
PROCEDURE VARIABLEDIMS(A,C); VALUE A, C; REAL A, C;                     00707000
BEGIN                                                                   00708000
   REAL NSUBS, BDLINK, BOUND, I;                                        00709000
   LABEL XIT;                                                           00710000
IF DEBUGTOG THEN FLAGROUTINE("VARIAB","LEDIMS",TRUE);                   00710010
   IF NSUBS ~ C.NEXTRA = 1 AND A.SUBCLASS < DOUBTYPE THEN GO TO XIT;    00711000
   BDLINK ~ C.ADINFO;                                                   00712000
   FOR I ~ 1 STEP 1 UNTIL NSUBS DO                                      00713000
   BEGIN                                                                00714000
      IF BOUND ~ EXTRAINFO[BDLINK.IR,BDLINK.IC] < 0 THEN                00715000
         EMITOPDCLIT(BOUND) ELSE EMITNUM(BOUND);                        00716000
      BDLINK ~ BDLINK -1;                                               00717000
      IF I > 1 THEN EMITO(MUL);                                         00718000
   END;                                                                 00719000
   IF A.SUBCLASS } DOUBTYPE THEN EMITPAIR(2, MUL);                      00720000
   EMITPAIR(   C.SIZE,STD);                                             00721000
   XIT:                                                                 00722000
IF DEBUGTOG THEN FLAGROUTINE("VARIAB","LEDIMS",FALSE);                  00722010
END VARIABLEDIMS;                                                       00723000
PROCEDURE EMITD(R,OP); VALUE R,OP; REAL R,OP; FORWARD;                  00723100
STREAM PROCEDURE SETPNT(W1,W2,PNT,CL,SUBC,STAR,POS,F,S,Q) ;             00723140
VALUE CL,SUBC,STAR,POS,F,S,Q ;                                          00723150
BEGIN F(SI~W1; SI~SI+2; DI~PNT ;                                        00723160
      IF SC}"0" THEN                                                    00723170
      BEGIN DS~5CHR; DS~LIT" "; DI~DI-6; DS~5FILL ;                     00723180
      END ELSE BEGIN DS~6LIT" "; DI~PNT; DS~Q CHR END);                 00723200
     S(DI~PNT; DI~DI+6; DS~LIT" ";                                      00723210
    SI ~ LOC SUBC; SI ~ SI+2; DS ~ 6 CHR; DS ~ LIT " ";                 00723230
      SI~LOC CL; SI~SI+2; DS~6CHR; DS~LIT" ");                          00723240
     DI~PNT; DI~DI+21;                                                  00723250
      POS(DI~DI+11);                                                    00723255
    SI ~ LOC STAR; SI ~ SI+7; DS ~ CHR;                                 00723265
    SI ~ W2;  DS~8CHR ;                                                 00723280
    SI ~ LOC STAR; SI ~ SI+7; DS ~ CHR;                                 00723295
END OF SETPNT;                                                          00723325
PROCEDURE PT(EOF,REC); VALUE EOF; BOOLEAN EOF; ARRAY REC[0];            00723450
BEGIN LABEL L6;  REAL L;                                                00723470
   IF EOF THEN WRITE(LINE,15,PRINTBUFF[*])                              00723520
   ELSE                                                                 00723595
    IF BOOLEAN(L~REAL(REC[0]~REC[0]&REC[2] [1:26:1]=XTA)) THEN          00723610
         BEGIN                                                          00723620
         IF IT~IT+1=9 THEN                                              00723630
              BEGIN LASTLINE~FALSE; WRITE(LINE,15,PRINTBUFF[*]) ;       00723640
L6:           BLANKIT(PRINTBUFF,15,IT~0) ;                              00723650
              END;                                                      00723660
         SETPNT(REC[0],REC[1],PRINTBUFF,KLASS[REC[2].CLASS],TYPES[REC[2]00723670
                .SUBCLASS],IF BOOLEAN(REC[2]) THEN "*" ELSE " ",IT,L-1, 00723680
                LASTLINE,6-REC[2].[27:3]) ;                             00723690
              END                                                       00723700
         ELSE BEGIN                                                     00723710
              LASTLINE~TRUE;  WRITE(RITE,15,PRINTBUFF[*]);  XTA~REC[0] ;00723720
              GO L6 ;                                                   00723730
              END ;                                                     00723740
END OF PT ;                                                             00723800                                                                        01868000
PROCEDURE CHECKINFO;                                                    00724000
BEGIN REAL I, T, A;                                                     00725000
   REAL LASTF;                                                          00725100
   REAL INFB,INFC;                                                      00726000
   LABEL NXT; ALPHA N;                                                  00727000
   FORMAT INFOF( 3(A6, X2),                                             00728000
         " ADDRESS = ", A2, A4,                                         00729000
         ", LENGTH = ", I5,                                             00730000
         ", OFFSET = ", I5),                                            00731000
      INFOT( / "LOCAL IDENTIFIERS:"),                                   00732000
      LABF(A6,X10,"LABEL    REL-ADR = ",I6,", SEGMNT = ",I5);           00733000
   IF PRTOG THEN                                                        00734000
   WRITALIST(INFOT,0,0,0,0,0,0,0,0,0) ;                                 00735000
   IF I ~ SEARCH("ERR   ") ! 0 THEN                                     00736000
      IF GET(I).CLASS = UNKNOWN THEN PUT(I+1, "......");                00737000
   IF I ~ SEARCH("END   ") ! 0 THEN                                     00738000
      IF GET(I).CLASS = UNKNOWN THEN PUT(I+1, "......");                00739000
   IF NOT DCINPUT THEN IF I~SEARCH("ZIP   ") ! 0 THEN                   00739100
      IF GET(I).CLASS=UNKNOWN THEN PUT(I+1,"......") ;                  00739200
   FOR I ~ 0 STEP 1 UNTIL NEXTCOM DO                                    00740000
   IF GETC(I).CLASS=HEADER THEN                                         00741000
                                                                        00742000
   IF GETC(I).CE=1 THEN                                                 00743000
   PUT((T~GETC(I+1).LINK+2),GET(T)&0[TOADINFO]) ;                       00744000
                                                                        00745000
   T ~ 2; WHILE T < NEXTINFO DO                                         00746000
   BEGIN                                                                00747000
      GETALL(T,A,INFB,INFC);                                            00748000
      IF I ~ A.CLASS > FILEID THEN GO TO NXT;                           00749000
      IF N ~ INFB    = "......" THEN GO TO NXT;                         00750000
      XTA ~ N;                                                          00751000
      IF I = LABELID THEN                                               00752000
      BEGIN                                                             00753000
         IF A > 0 THEN FLAG(19) ELSE                                    00754000
         IF PRTOG THEN WRITALIST(LABF,3,N,A.ADDR DIV 4,A.SEGNO,0,0,0,0, 00755000
         0) ;                                                           00755010
         GO TO NXT;                                                     00756000
      END;                                                              00757000
      IF I = FORMATID THEN                                              00758000
         IF A > 0 THEN BEGIN FLAG(62); GO TO NXT END ;                  00759000
      IF I = NAMELIST THEN                                              00760000
      IF A > 0 THEN BEGIN FLAG(136); GO TO NXT END;                     00761000
      IF I = ARRAYID THEN                                               00762000
         IF BOOLEAN(A.CE) THEN BEGIN IF A>0 THEN T~GETSPACE(T) END      00763000
         ELSE IF A<0 THEN                                               00764000
         IF BOOLEAN(A.FORMAL) THEN                                      00764020
         BEGIN IF SPLINK > 1 AND ELX > 1 THEN                           00764040
            BEGIN % THIS IS A FORMAL PARAMETER FOR A SUBROUTINE OR A    00764060
                  % FUNCTION THAT HAS ONE OR MORE ENTRY STATEMENT. THIS 00764070
                  % PARAMETER WILL BE INITIALIZED TO AN ARRAY DESCRIPTOR00764080
                  % TO 0 SO THAT IF THE PARAMETERS ARE NOT SET UP BY THE00764090
                  % CALL ANY REFERENCE TO THEM WILL CAUSE AN INVALID    00764100
                  % ADDRESS                                             00764110
              IF LASTF = 0 THEN % FIRST TIME THRU                       00764150
              BEGIN LASTF ~ A.ADDR;                                     00764200
                    EMITDESCLIT(2); EMITL(1);                           00764220
                    EMITD(50,DIA); EMITD(10,DIB); EMITD(10,TRB);        00764240
              END ELSE EMITPAIR(LASTF,LOD);                             00764260
              EMITPAIR(A.ADDR,SND);                                     00764280
            END                                                         00764300
        END                                                             00764320
        ELSE ARRAYDEC(T);                                               00765000
     IF PRTOG THEN                                                      00766000
        WRITALIST(INFOF,7,INFB,                                         00767000
        IF BOOLEAN(A.TYPEFIXED) THEN TYPES[A.SUBCLASS] ELSE "      ",   00768000
        KLASS[A.CLASS],                                                 00769000
        IF A.ADDR < 1024 AND A < 0 THEN "R+" ELSE "  ",                 00770000
        IF A < 0 THEN B2D(A.[26:10]) ELSE "NULL",                       00771000
        INFC.SIZE,                                                      00772000
        INFC.BASE,0);                                                   00773000
     IF BOOLEAN(A.CE) THEN IF A.SUBCLASS } DOUBTYPE THEN                00773100
        IF BOOLEAN(INFC.BASE) THEN FLAG(146);                           00773200
     NXT:                                                               00774000
        T ~ T+3;                                                        00775000
  END;                                                                  00776000
END CHECKINFO;                                                          00777000
PROCEDURE SEGMENTSTART;                                                 00778000
BEGIN                                                                   00779000
   NSEG ~ NXAVIL ~ NXAVIL + 1;                                          00780000
   IF LISTOG THEN WRITALIST(SEGSTRT,1,NSEG,0,0,0,0,0,0,0) ;             00781000
   DEBUGADR~ADR~-1;                                                     00782000
   IF NOT SEGOVFLAG THEN                                                00783000
   BEGIN                                                                00784000
      DATAPRT~DATASTRT~DATALINK~DATASKP~                                00784100
      LABELMOM ~ BRANCHX ~ FUNVAR ~                                     00785000
      DT ~ SPLINK ~ NEXTCOM ~ ELX ~ 0;                                  00786000
      NEXTSS ~ 1022;                                                    00787000
      INITIALSEGNO ~ NSEG;                                              00788000
      FOR I ~ 0 STEP 1 UNTIL LBRANCH DO BRANCHES[I] ~ I+1;              00789000
   FOR I~0 STEP 1 UNTIL SHX DO STACKHEAD[I] ~ 0;                        00790000
      NEXTINFO ~ LOCALS ~ 2;                                            00791000
      F2TOG ~ FALSE; RETURNFOUND ~ FALSE;                               00792000
   END;                                                                 00793000
   ENDSEGTOG ~ FALSE;                                                   00794000
   IF SEGSW THEN LINESEG[NOLIN~0,0]~0 & D2B(LASTSEQ)[10:20:28] ;        00794400
END SEGMENTSTART;                                                       00795000
PROCEDURE FIXPARAMS(I); VALUE I; INTEGER I;                             00796000
BEGIN                                                                   00797000
   REAL FMINUS, NPARMS, ELINK, LABX;                                    00798000
   REAL PLINKX, PLINK;                                                  00799000
   REAL PTYPEX, PTYPE;                                                  00800000
   REAL CL, INF;                                                        00801000
   LABEL ARRY, LOAD, INDX;                                              00802000
   REAL EWORD;                                                          00803000
IF DEBUGTOG THEN FLAGROUTINE("  FIXP","ARMS  ",TRUE);                   00803010
   EWORD ~ ENTRYLINK[I];                                                00804000
   ELINK ~ EWORD.LINK;                                                  00805000
   IF LABX ~ EWORD.CLASS > 0 THEN                                       00806000
         BEGIN                                                          00807000
         EMITO(MKS);                                                    00808000
         EMITDESCLIT(LABELMOM);                                         00809000
         EMITL(LABX);                                                   00810000
         EMITL(1); EMITL(1); EMITL(0);                                  00811000
         EMITOPDCLIT(BLKCNTRLINT);                                      00812000
         EMITL(1); EMITPAIR(FPLUS2,STD);%   F+2~TRUE FOR BLKXIT CALL    00812400
         END;                                                      %106-00813000
    FMINUS ~ 1920;                                                      00814000
    NPARMS ~ (J~GET(ELINK+2)).NEXTRA;                                   00815000
     IF NPARMS > 0 THEN                                            %106-00816000
    BEGIN                                                               00817000
       PLINKX ~ EWORD.ADDR-NPARMS+1;                                    00818000
       PTYPEX ~ J.ADINFO + NPARMS-1;                                    00819000
       FOR J ~ 1 STEP 1 UNTIL NPARMS DO                                 00820000
       BEGIN                                                            00821000
          PLINK ~ EXTRAINFO[PLINKX.IR,PLINKX.IC];                       00822000
          PTYPE ~ EXTRAINFO[PTYPEX.IR,PTYPEX.IC].CLASS;                 00823000
          FMINUS ~ FMINUS+1;                                            00824000
          IF PLINK = 0 THEN                                             00825000
          BEGIN                                                         00826000
             EMITOPDCLIT(FMINUS);                                       00827000
             EMITL(LABX ~ LABX-1);                                      00828000
             EMITDESCLIT(LABELMOM);                                     00829000
             EMITO(STD);                                                00830000
          END ELSE                                                      00831000
          BEGIN                                                         00832000
          IF CL ~ (INF ~ GET(PLINK)).CLASS = UNKNOWN THEN CL ~ VARID;   00833000
          XTA ~ GET(PLINK+1);                                           00834000
          IF PTYPE = 0 THEN EXTRAINFO[PTYPEX.IR,PTYPEX.IC].CLASS        00835000
          ~ PTYPE ~ CL;                                                 00836000
          CASE PTYPE OF                                                 00837000
          BEGIN ;                                                       00838000
          IF CL ! ARRAYID THEN FLAG(79) ELSE                            00839000
          ARRY:                                                         00840000
          BEGIN                                                         00841000
             FMINUS ~ FMINUS+1;                                         00842000
             IF INF < 0 THEN                                            00843000
             BEGIN                                                      00844000
                EMITPAIR(FMINUS, LOD);                                  00845000
                EMITPAIR(T~INF.ADDR, STD);                              00846000
                EMITOPDCLIT(FMINUS-1);                                  00847000
                EMITPAIR(T-1, STD);                                     00848000
             END;                                                       00849000
          END;                                                          00850000
          IF CL ! VARID THEN FLAG(80) ELSE                              00851000
          LOAD:                                                         00852000
          BEGIN                                                         00854000
          IF INF.SUBCLASS}DOUBTYPE AND CL=VARID THEN FMINUS~FMINUS+1;   00854100
          IF INF<0 THEN                                                 00854200
          BEGIN                                                         00854300
             EMITPAIR(FMINUS, LOD);                                     00855000
             EMITPAIR(T~INF.ADDR,STD);                                  00856000
          IF INF.SUBCLASS}DOUBTYPE AND CL=VARID THEN               %105-10856100
                BEGIN EMITOPDCLIT(FMINUS-1);                            00856200
                      EMITPAIR(T+1,STD);                                00856300
                END;                                                    00856400
          END ;                                                         00856500
          END;                                                          00857000
          ; ; ; ;                                                       00858000
          IF CL = FUNID THEN GO TO LOAD ELSE FLAG(81);                  00859000
                                                                        00859100
                                                                        00859200
                                                                        00859300
                                                                        00859400
                                                                        00859500
          ;                                                             00860000
          IF CL = FUNID OR CL = SUBRID OR CL = EXTID THEN GO TO LOAD    00861000
                ELSE FLAG(83);                                          00861100
          IF CL = SUBRID THEN GO TO LOAD ELSE FLAG(82);                 00862000
          ; ;                                                           00863000
          BEGIN                                                         00864000
             IF CL = ARRAYID THEN                                       00865000
             BEGIN                                                      00866000
                EXTRAINFO[PTYPEX.IR,PTYPEX.IC].CLASS ~ CL;              00867000
                GO TO ARRY;                                             00868000
             END;                                                       00869000
             INDX:                                                      00870000
             IF CL ! VARID THEN FLAG(80);                               00871000
             FMINUS ~ FMINUS+1;                                         00872000
             IF INF < 0 THEN                                            00873000
             BEGIN                                                      00874000
                EMITOPDCLIT(FMINUS-1);                                  00875000
                EMITDESCLIT(FMINUS);                                    00876000
                EMITPAIR(INF.ADDR, STD);                                00877000
             END;                                                       00878000
          END;                                                          00879000
          IF CL = VARID THEN GO TO LOAD ELSE FLAG(80);                  00880000
          GO TO INDX;                                                   00892000
          END CASE STATEMENT;                                           00893000
          A ~ INF.SUBCLASS;                                             00894000
          IF T ~ EXTRAINFO[PTYPEX.IR,PTYPEX.IC].SUBCLASS = 0 OR         00895000
             T = INTYPE AND A = REALTYPE THEN                           00896000
             EXTRAINFO[PTYPEX.IR,PTYPEX.IC].SUBCLASS ~ A ELSE           00897000
             IF T ! A THEN                                              00898000
             BEGIN XTA ~ GET(PLINK+1); FLAG(88) END;                    00899000
          END;                                                          00900000
          PLINKX ~ PLINKX+1;                                            00901000
          PTYPEX ~ PTYPEX-1;                                            00902000
       END;                                                             00903000
       PLINKX ~ PLINKX-NPARMS;                                          00904000
       FOR J ~ 1 STEP 1 UNTIL NPARMS DO                                 00905000
       BEGIN                                                            00906000
          PLINK ~ EXTRAINFO[PLINKX.IR,PLINKX.IC];                       00907000
          IF PLINK ! 0 THEN                                             00908000
          IF (A~GET(PLINK)).CLASS = ARRAYID THEN                        00909000
          IF T~GET(PLINK+2) <0 THEN VARIABLEDIMS(A, T);                 00910000
          PLINKX ~ PLINKX+1;                                            00911000
       END;                                                             00912000
    END;                                                                00913000
    EMITB(GET(ELINK+2).BASE & (GET(ELINK).SEGNO)[TOSEGNO], FALSE);      00914000
IF DEBUGTOG THEN FLAGROUTINE("  FIXP","ARMS  ",FALSE) ;                 00914010
END FIXPARAMS;                                                          00915000
PROCEDURE XREFCORESORT ;                                                00915100
    BEGIN                                                               00915120
    REAL F,G,H,J,K,L,T,TT,IJ,M,TN ;                                     00915140
    SAVE ARRAY A[0:XRI-1], IL,IU[0:8];                                  00915160
    ARRAY W2,W3[0:XRI-1] ;                                              00915180
    LABEL L1,L2,L3,L4,L5,L6,L11,L12,L13,L14 ;                           00915200
    DEFINE CMPARGT(A) = A.NAME=TN THEN IF (IF G~W3[H~A.[2:10]].[26:4]   00915220
                        =TT~W3[F~T.[2:10]].[26:4] THEN NOT CMPA(W2[H],  00915240
                        W2[F]) ELSE G>TT) #,                            00915260
           CMPARLS(A) = A.NAME=TN THEN IF (IF G~W3[H~T.[2:10]].[26:4]   00915280
                        =TT~W3[F~A.[2:10]].[26:4] THEN NOT CMPA(W2[H],  00915300
                        W2[F]) ELSE G>TT) #,                            00915320
           NAME = [12:36] # ;                                           00915340
    J~XRI-1;  G~XRI DIV K~XRBUFFDIV3;  H~XRBUFF ;                       00915360
    FOR L~1 STEP 1 UNTIL G DO                                           00915380
         BEGIN                                                          00915400
L11:     READ(XREFF,H,XRRY[*]);  TRANSFER(W2[T~(L-1)|50],XRRY,K) ;      00915420
         IJ~T+K-1;  TN~-3;                                              00915440
         FOR F~T STEP 1 UNTIL IJ DO                                     00915460
              BEGIN A[F]~XRRY[TN~TN+3]&F[2:38:10]; W3[F]~XRRY[TN+2] END;00915480
         END;                                                           00915500
    IF H=XRBUFF THEN IF K~XRI MOD K DIV 1!0 THEN BEGIN H~3|K;GO L11 END;00915520
    GO L4 ;                                                             00915540
L1: IF A[K~I].NAME>TN~(T~A[IJ~((L~J)+I+1).[37:10]]).NAME THEN           00915560
L12:     BEGIN A[IJ]~A[I];  A[I]~T;  TN~(T~A[IJ]).NAME END              00915580
    ELSE IF CMPARGT(A[I]) THEN GO L12 ;                                 00915600
    IF A[J].NAME<TN THEN                                                00915620
         BEGIN                                                          00915640
L14:     A[IJ]~A[J];  A[J]~T ;                                          00915660
         IF TN~(T~A[IJ]).NAME<A[I].NAME THEN                            00915680
L13:          BEGIN A[IJ]~A[I]; A[I]~T; TN~(T~A[IJ]).NAME END           00915700
         ELSE IF CMPARGT(A[I]) THEN GO L13 ;                            00915720
         END                                                            00915740
    ELSE IF CMPARLS(A[J]) THEN GO L14 ;                                 00915760
L2: IF A[L~L-1].NAME>TN THEN GO L2;  IF CMPARGT(A[L]) THEN GO L2;       00915780
L3: IF A[K~K+1].NAME<TN THEN GO L3;  IF CMPARLS(A[K]) THEN GO L3;       00915800
    IF K LEQ L THEN BEGIN DOUBLE(A[K],A[L],~,A[L],A[K]); GO L2 END ;    00915820
    IF L+K>J+I THEN BEGIN IL[M]~I; IU[M]~L; I~K END                     00915840
    ELSE BEGIN IL[M]~K; IU[M]~J; J~L END ;                              00915860
    M~M+1 ;                                                             00915880
L4: IF I+10<J THEN GO L1;                                               00915900
    IF I=0 THEN IF I<J THEN GO L1;                                      00915920
    FOR I~I+1 STEP 1 UNTIL J DO                                         00915940
         IF A[K~I-1].NAME>TN~(T~A[I]).NAME THEN                         00915960
              BEGIN                                                     00915980
L5:           A[K+1]~A[K];  IF A[K~K-1].NAME>TN THEN GO L5 ;            00916000
              IF CMPARGT(A[K]) THEN GO L5 ;                             00916020
              A[K+1]~T ;                                                00916040
              END                                                       00916060
         ELSE IF CMPARGT(A[K]) THEN GO L5 ;                             00916080
    IF (M~M-1) GEQ 0 THEN BEGIN I~IL[M]; J~IU[M]; GO L4 END ;           00916100
    G~XRI-1 ;                                                           00916120
    FOR I~ 0 STEP 1 UNTIL G DO                                          00916140
         IF BOOLEAN(L~REAL(A[I]~A[I].NAME&(TN~W3[J~A[I].[2:10]])[1:26:1]00916160
                    =XTA)) THEN                                         00916180
              BEGIN                                                     00916200
              IF IT~IT+1=9 THEN                                         00916220
                   BEGIN LASTLINE~FALSE;  WRITE(LINE,15,PRINTBUFF[*]) ; 00916240
L6:                BLANKIT(PRINTBUFF,15,IT~0) ;                         00916260
                   END ;                                                00916280
              SETPNT(A[I],W2[J],PRINTBUFF,KLASS[TN.CLASS],TYPES[TN.     00916300
                     SUBCLASS],IF BOOLEAN(TN) THEN "*" ELSE " ",IT,L-1, 00916320
                     LASTLINE,6-TN.[27:3]) ;                            00916340
              END                                                       00916360
          ELSE BEGIN                                                    00916380
              LASTLINE~TRUE;  WRITE(RITE,15,PRINTBUFF[*]);  XTA~A[I];   00916400
              GO L6;                                                    00916420
              END ;                                                     00916440
    WRITE(LINE,15,PRINTBUFF[*]);  XRI~0;                                00916460
    END OF XREFCORESORT ;                                               00916480
PROCEDURE SETUPSTACK ;                                                  00916900
BEGIN                                                                   00917000
   REAL I;                                                              00918000
   EMITOPDCLIT(16);                                                     00919000
   EMITL(1);                                                            00920000
   EMITO(ADD);                                                          00921000
   EMITL(16);                                                           00922000
   EMITO(SND);                                                          00923000
   FOR I ~ 1 STEP 1 UNTIL LOCALS DO EMITL(0);                           00924000
   CHECKINFO;                                                           00925000
   IF DATAPRT ! 0 THEN                                                  00925010
         BEGIN ADJUST; EMITOPDCLIT(DATAPRT); EMITO(LNG); EMITB(-1,TRUE);00925020
               DATASKP~LAX; EMITB(DATASTRT,FALSE); FIXB(DATALINK);      00925030
               EMITL(1); EMITPAIR(DATAPRT,STD); FIXB(DATASKP);          00925040
         END;                                                           00925050
   ADJUST;                                                              00925060
END SETUPSTACK;                                                         00926000
PROCEDURE BRANCHLIT(X,Y); VALUE X,Y; REAL X; BOOLEAN Y;                 00927000
BEGIN                                                                   00928000
    IF ADR } 4075 THEN                                                  00929000
      BEGIN ADR ~ ADR+1; SEGOVF END;                                    00930000
   ADJUST;                                                              00931000
   IF X.SEGNO!NSEG THEN BEGIN                                           00932000
      IF(PRTS+1).[37:2]=1 AND Y THEN                                    00932300
      EMITOPDCLIT(PRGDESCBLDR(2,0,(ADR+5) DIV 4+1,NSEG))                00932700
      ELSE EMITOPDCLIT(PRGDESCBLDR(2,0,(ADR+5) DIV 4,NSEG)) END         00933000
   ELSE                                                                 00934000
   EMITL((ADR+5) DIV 4 - X.LINK DIV 4) ;                                00935000
END BRANCHLIT;                                                          00936000
PROCEDURE SEGMENT(SZ,CURSEG,SEGTYP,EDOC); % WRITES OUT EDOC AS SEGMENT  00937000
    VALUE SZ,CURSEG,SEGTYP;            % UPDATES PDPRT WITH PSUEDO      00938000
    REAL SZ,CURSEG;                    % UPDATES PDPRT WITH PSUEDO      00939000
    BOOLEAN SEGTYP;     % TRUE TO WRAP UP A SUBROUTINE BLOCK            00940000
                        % FALSE TO WRAP UP A SPLIT BLOCK                00941000
    ARRAY EDOC[0,0];                   % CONTAINS DATA TO WRITE;        00942000
    BEGIN                                                               00943000
         STREAM PROCEDURE M1(F,T); BEGIN DI ~ T; SI ~ F; DS ~ 2 WDS END;00944000
         REAL T;                                                        00945000
         REAL BEGINSUB, ENDSUB, HERE;                                   00946000
         LABEL WRITEPGM;                                                00947000
         INTEGER I, CNTR;                                               00948000
IF DEBUGTOG THEN FLAGROUTINE("  SEGM","ENT   ",TRUE );                  00948010
         IF NOT SEGTYP  THEN GO TO WRITEPGM;                            00949000
         IF SPLINK > 1 AND NOT RETURNFOUND THEN                         00949100
         BEGIN XTA ~ BLANKS; FLAG(142) END;                             00949200
         IF SPLINK < 0 THEN                                             00950000
    BEGIN                                                               00951000
         ADJUST;                                                        00952000
         BDPRT[BDX~BDX+1] ~ PRGDESCBLDR(1, 0, (ADR+1) DIV 4, NSEG);     00953000
         FOR I ~ 1 STEP 1 UNTIL LOCALS DO EMITL(0);                     00954000
         CHECKINFO;                                                     00955000
                                                                        00955500
         EMITB(0&INITIALSEGNO[TOSEGNO], FALSE);                         00956000
    END                                                                 00957000
         ELSE                                                           00958000
         IF SPLINK = 1 THEN            % MAIN PROGRAM                   00959000
    BEGIN                                                               00960000
         ADJUST;                                                        00961000
         IF STRTSEG ! 0 THEN FLAG(75);                                  00962000
         STRTSEG ~ NSEG &                                               00963000
            PRGDESCBLDR(1, 0, (ADR+1) DIV 4, NSEG)[18:33:15];           00964000
         SETUPSTACK;                                                    00965000
                                                                        00965500
         EMITB(0&INITIALSEGNO[TOSEGNO], FALSE);                         00966000
    END                                                                 00967000
         ELSE                                                           00968000
         IF ELX { 1 THEN                                                00969000
    BEGIN                                                               00970000
         ADJUST;                                                        00971000
         T ~ PRGDESCBLDR(1, GET(SPLINK).ADDR, (ADR+1) DIV 4, NSEG);     00972000
         SETUPSTACK;                                                    00973000
         FIXPARAMS(0);                                                  00974000
         INFO[SPLINK.IR, SPLINK.IC].SEGNO ~ NSEG;                       00975000
    END                                                                 00976000
         ELSE                                                           00977000
    BEGIN                                                               00978000
         ADJUST;                                                        00979000
         BEGINSUB ~ (ADR+1) & NSEG[TOSEGNO];                            00980000
         EMITL(17); EMITO(STD);                                         00981000
         SETUPSTACK;                                                    00982000
         EMITOPDCLIT(17); EMITO(GFW);                                   00982100
         ENDSUB ~ ADR & NSEG[TOSEGNO];                                  00983000
         FOR I ~ 0 STEP 1 UNTIL ELX-1 DO                                00984000
    BEGIN                                                               00985000
         ADJUST;                                                        00986000
         HERE ~ (ADR+1) DIV 4;                                          00988000
         T ~ ENTRYLINK[I].LINK;                                         00989000
%VOID                                                                   00990000
         T ~ PRGDESCBLDR(1, GET(T).ADDR, HERE, NSEG);                   00991000
         BRANCHLIT(ENDSUB,FALSE);                                       00992000
         EMITB(BEGINSUB, FALSE);                                        00993000
      ADJUST;                                                           00994000
         FIXPARAMS(I);                                                  00995000
         INFO[(ENTRYLINK[I].LINK).IR,(ENTRYLINK[I].LINK).IC].SEGNO~NSEG;00995500
    END;                                                                00996000
    END;                                                                00997000
         SZ ~ (ADR+4) DIV 4;                                            00998000
         CNTR ~ 0;                                                      00999000
         CURSEG ~ NSEG;                                                 00999100
         WRITEPGM:                                                      01000000
         NSEG ~ ((T ~ SZ) + 29) DIV 30;                                 01001000
         IF DALOC DIV CHUNK < I ~ (DALOC+NSEG) DIV CHUNK                01002000
           THEN DALOC ~ CHUNK | I;  % INSURE SEGMENT DONT BREAK         01003000
                                     % ACROSS ROW                       01004000
         IF LISTOG THEN WRITALIST(SEGEND,2,CURSEG,T,0,0,0,0,0,0) ;      01005000
         PDPRT[PDIR,PDIC] ~           % PDPRT ENTRY FOR SEGMENT         01006000
            SZ&DALOC[DKAC]                                              01007000
              & GET(SPLINK)[12:14:1]                                    01007100
              &CURSEG[SGNOC];                                           01008000
         IF ERRORCT = 0 THEN                                            01009000
         DO BEGIN                                                       01010000
         FOR I~0 STEP 2 WHILE I < 30 AND CNTR < SZ DO                   01011000
         BEGIN M1(EDOC[CNTR.[38:3],CNTR.[41:7]],CODE(I));               01012000
               CNTR ~ CNTR + 2;                                         01013000
         END;                                                           01014000
         WRITE(CODE[DALOC]);                                            01015000
         DALOC ~ DALOC +1;                                              01016000
         END UNTIL CNTR } SZ;                                           01017000
         PDINX ~ PDINX +1;                                              01018000
         IF NOT SEGOVFLAG THEN                                          01018025
         IF PXREF THEN                                                  01018100
         IF(EODS~(NEXT=EOF))AND NOT XGLOBALS THEN ELSE                  01018110
         BEGIN KLASS[6]~ "LABEL ";                                      01018120
               WRITE(XREFF,XRBUFF,XRRY[*]) ;                            01018125
               IF FIRSTCALL THEN DATIME ELSE WRITE(PTR[PAGE]);          01018130
                IF SPLINK<0 THEN                                        01018135
                   BEGIN WRITE(PTR,XHEDB);REWIND(XREFF);END             01018140
                ELSE                                                    01018145
               IF EODS THEN BEGIN WRITE(PTR,XHEDG); REWIND(XREFG) END   01018150
               ELSE BEGIN REWIND(XREFF); C2~(XR[4].SUBCLASS|2+5);       01018160
                          IF IT~XR[4].CLASS=FUNID THEN WRITE(PTR,XHEDF, 01018170
                                 XR[C2],XR[C2+1],XR[3],XR[C2+12],       01018180
                                 XR[C2+13],"------")                    01018190
                          ELSE IF IT=SUBRID THEN WRITE(PTR,XHEDS,XR[3], 01018200
                                  "------") ELSE WRITE(PTR,XHEDM);      01018210
                    END;                                                01018220
               IT~XTA~0;                                                01018260
               LASTLINE ~ FALSE;                                        01018280
               BLANKIT(PRINTBUFF,15,0);                                 01018320
               IF XRI>1023 OR EODS THEN SORT(PT,INP,0,HV,CMP,3,4000)    01018330
               ELSE XREFCORESORT ;                                      01018340
               REWIND(XREFF);                                           01018350
               PXREF~IF XREF THEN TRUE ELSE FALSE;                      01018355
               KLASS[6] ~ "ERROR ";                                     01018360
               IF (NOT SEGTYP  AND EODS) OR (SEGTYP  AND LISTOG AND     01018370
                   NOT SEGPTOG) THEN WRITE (PTR[PAGE]);                 01018375
         END;                                                           01018380
         IF LISTOG AND SEGTYP AND SEGPTOG THEN WRITE(PTR[PAGE]);        01019000
         IF SEGTYP THEN                                                 01019100
              BEGIN                                                     01019110
              FOR I~12,17 STEP 1 UNTIL 24,39 STEP 1 UNTIL 41,           01019150
              50 STEP 1 UNTIL 57 DO TIPE[I]~REALID ;                    01019160
              FOR I~25,33 STEP 1 UNTIL 37 DO TIPE[I]~INTID ;            01019170
              LASTNEXT ~ 1000;                                          01019190
              END;                                                      01019200
         ENDSEGTOG ~ TRUE;                                              01020000
         TSEGSZ ~ TSEGSZ + SZ;                                          01021000
         COMMENT IF SEGSW THEN LETS ALSO WRITE OUT THE LINE SEGMENTS    01021010
                 THAT WE VE GONE TO SUCH TROUBLE BUILDING. LINESEG      01021150
                 CONTAINS A CARD SEQUENCE NUMBER(BINARY) IN [10:28]     01021200
                 AND THE WORD BOUNDARY ADDRESS OF THE FIRST CODE        01021250
                 SYLLABLE IN [38:10];                                   01021300
         IF SEGSW THEN                                                  01021350
         IF NOLIN > 0 THEN                                              01021360
         BEGIN                                                          01021400
            LINEDICT[CURSEG.IR,CURSEG.IC] ~ % UPDATE LINE DICTIONARY    01021450
             0 & NOLIN[18:33:15] & DALOC[33:33:15];%FOR THIS SEGMENT    01021500
            CNTR ~ 0; DO BEGIN                                          01021550
            FOR I ~ 0 STEP 2 WHILE I<30 AND CNTR<NOLIN DO               01021600
            BEGIN                                                       01021650
               M1(LINESEG[CNTR.[38:3],CNTR.[41:7]],CODE(I));            01021700
               CNTR~CNTR+2                                              01021750
            END;                                                        01021800
            WRITE(CODE[DALOC]);                                         01021850
            DALOC~DALOC+1;                                              01021900
            END UNTIL CNTR } NOLIN;                                     01021950
         END ;                                                          01021955
        IF NOT SEGOVFLAG THEN XRI ~ 0;                                  01021957
         IF DEBUGTOG THEN FLAGROUTINE("  SEGM","ENT   ",FALSE) ;        01021959
    END SEGMENT;                                                        01022000
PROCEDURE WRITEDATA(SZ,SEG,ARY);  % WRITES OUT TYPE 2 SEGMENTS          01023000
    VALUE SZ,SEG;                                                       01024000
    REAL SZ,SEG;                                                        01025000
    ARRAY ARY[0];                                                       01026000
    BEGIN                                                               01027000
         INTEGER T,NSEG,I,CNTR;                                         01028000
         INTEGER TYPE;                                                  01029000
         STREAM PROCEDURE M30(F,T,SZ); VALUE SZ;                        01030000
         BEGIN                                                          01031000
              SI~F; DI~T; DS~SZ WDS;                                    01032000
         END M30;                                                       01033000
         IF SZ } 0 THEN TYPE ~ 2 ELSE SZ ~ -SZ;                         01034000
         NSEG ~ (( T~SZ) +29) DIV 30;                                   01035000
         IF DALOC DIV CHUNK < I ~ (DALOC+NSEG) DIV CHUNK                01036000
           THEN DALOC ~ CHUNK | I;                                      01037000
         PDPRT[PDIR,PDIC] ~                                             01038000
           SZ&DALOC[DKAC]                                               01039000
             &TYPE[STYPC]                                               01040000
             &SEG[SGNOC];                                               01041000
         PDINX ~ PDINX +1;                                              01042000
         IF ERRORCT = 0 THEN                                            01043000
         FOR I ~ 0 STEP 30 WHILE I < SZ DO                              01044000
    BEGIN                                                               01045000
         M30(ARY[I],CODE(0),IF (SZ-I) > 30 THEN 30 ELSE (SZ-I));        01046000
         WRITE(CODE[DALOC]);                                            01047000
         DALOC ~ DALOC +1;                                              01048000
    END;                                                                01049000
         IF LISTOG THEN WRITALIST(SEGEND,2,SEG,T,0,0,0,0,0,0) ;         01050000
         TSEGSZ ~ TSEGSZ + SZ;                                          01051000
    END WRITEDATA;                                                      01052000
REAL PROCEDURE PRGDESCBLDR(DT,PRT,RELADR,SGNO);                         01053000
    VALUE DT,PRT,RELADR,SGNO;                                           01054000
    REAL  DT,PRT,RELADR,SGNO;                                           01055000
    BEGIN                                                               01056000
    FORMAT FMT("PRT=",A4,", REL-ADR=",A4,", SEG=",I4,", TYPE=",A2);     01057000
         IF PRT=0 THEN BEGIN BUMPPRT; PRT~PRTS END;                     01058000
         PDPRT[PDIR,PDIC] ~                                             01059000
            0&DT[DTYPC]                                                 01060000
             &PRT[PRTAC]                                                01061000
             &RELADR[RELADC]                                            01062000
             &SGNO[SGNOC];                                              01063000
         PDINX ~ PDINX +1;                                              01064000
         IF CODETOG THEN WRITALIST(FMT,4,B2D(PRT),B2D(RELADR),SGNO,     01065000
         IF DT=0 THEN "AE" ELSE IF DT=1 THEN "PD" ELSE "LD",0,0,0,0) ;  01066000
         PRGDESCBLDR ~ PRT;                                             01067000
    END PRGDESCBLDR;                                                    01068000
PROCEDURE EQUIV(R); VALUE R; REAL R;                                    01069000
COMMENT  THIS PROCEDURE FIXES UP THE INFO TABLE FOR THE EQUIV OR        01069100
           COMMON RING. THE FIRST ELEMENT PAST HAS AN OFFSET (DO NOT    01069110
           ALTER THIS) THE TYPE IS FIXED.  THE OFFSET IS DETERMINED     01069120
           FROM THE FIRST.  CORRECTINFO ADJUST THE OFFSET IF THERE      01069130
           IS A NEGATIVE OFFSET ON ANY ELEMENT.  THE INFA[ADJ] BIT IS   01069140
           SET IF THE ELEMENT HAS A NEGATIVE OFFSET.  IF THE ELEMENT    01069150
           APPEARED IN MORE THAN ONE EQUIVALENCE STATEMENT OR AN        01069160
           EQUIVALENCE STATEMENT AND A COMMON STATEMENT THE ELEMENTS    01069170
           ARE LINKED BY COM[LASTC] WHICH POINTS TO THE HEADER          01069180
           OF THAT STATEMENT;                                           01069190
BEGIN                                                                   01070000
   DEFINE BASS    = LOCALS    #,  % THESE DEFINES ARE USED TO REDUCE THE01071000
          REL     = PARMS     #,  % STACKSIZE OF EQUIV FOR RECURSION    01071100
          I       = PRTS      #,                                        01071200
          T       = LSTS      #,                                        01071250
          Q       = LSTA      #,                                        01071400
          LAST    = TV        #,                                        01071500
          B       = SAVESUBS  #,                                        01071600
          P       = NAMEIND   #,                                        01071700
          PRTX    = LSTI      #,                                        01071800
          C       = FX1       #,                                        01071900
          INFA    = FX2       #,                                        01072000
          INFB    = FX3       #,                                        01072100
          INFC    = NX1       #;                                        01072200
   LABEL XIT, CHECK;                                                    01073000
IF DEBUGTOG THEN FLAGROUTINE("   EQU","IV    ",TRUE) ;                  01073010
   IF GETC(R)<0 THEN GO TO XIT ;                                        01074000
   PUTC(R,-GETC(R)) ;                                                   01075000
   PRTX ~ GROUPPRT;                                                     01076000
   C~REAL(GETC(R).CE=1) ;                                               01077000
   LAST~GETC(R).LASTC-1 ;                                               01078000
   BASS~GETC(R+1);  P~0 ;                                               01079000
   FOR I ~ R+2 STEP 1 UNTIL LAST DO                                     01080000
   BEGIN IF GETC(I).CLASS=ENDCOM THEN I~GETC(I).LINK ;                  01081000
   GETALL(T~GETC(I).LINK,INFA,INFB,INFC) ;                              01082000
   IF Q~INFC.SIZE=0 THEN %   A SIMPLE VARIABLE                          01083000
      INFC.SIZE ~ Q ~ IF INFA.SUBCLASS { LOGTYPE THEN 1 ELSE 2;         01084000
   PUT(T+2,INFC);                                                       01085000
   IF INFA.SUBCLASS>LOGTYPE THEN         SEENADOUB~TRUE;                01085500
   IF BOOLEAN(C) THEN                                                   01086000
      BEGIN COM[PWI].RELADD~REL~P ;                                     01087000
         P ~ P + Q;                                                     01088000
      END ELSE COM[PWI].RELADD~REL~BASS-GETC(I).RELADD ;                01089000
      IF INFA    < 0 THEN IF INFA    .ADJ = 1 THEN                      01090000
         B ~ -INFC.BASE - REL ELSE B ~ INFC.BASE - REL;                 01091000
   END;                                                                 01092000
   FOR I ~ R+2 STEP 1 UNTIL LAST DO                                     01093000
   BEGIN IF GETC(I).CLASS=ENDCOM THEN I~GETC(I).LINK ;                  01094000
      GETALL(T~GETC(I).LINK,INFA,INFB,INFC) ;                           01095000
   IF INFA.CLASS = 1 THEN SWARYCT ~ 1;                                  01095500
      P~B+GETC(I).RELADD ;                                              01096000
      Q ~ INFC   .SIZE;                                                 01097000
      IF INFA     < 0 THEN                                              01098000
      BEGIN IF INFA    .ADJ = 1 THEN BASS ~ -INFC    .BASE ELSE         01099000
         BASS ~ INFC.BASE;                                              01100000
         IF P ! BASS THEN                                               01101000
         BEGIN XTA ~ INFB   ; FLAG(2) END;                              01102000
         GO TO CHECK;                                                   01104000
      END;                                                              01105000
      INFA    ~ -INFA    & PRTX[TOADDR];                                01108000
    IF INFA    .CLASS = UNKNOWN THEN INFA   .CLASS ~ VARID;             01109000
    INFA   .TYPEFIXED ~ 1;                                              01110000
    INFC.BASE ~ P;                                                      01111000
    PUT(T+2,INFC);                                                      01112000
    IF P < 0 THEN INFA   .ADJ ~ 1;                                      01113000
    PUT(T,INFA);                                                        01114000
    CHECK:                                                              01115000
    IF P+Q > LENGTH THEN LENGTH ~ P+Q;                                  01116000
    IF P < LOWERBOUND THEN LOWERBOUND ~ P;                              01117000
    END;                                                                01118000
    FOR I ~ R+2 STEP 1 UNTIL LAST DO                                    01119000
    BEGIN                                                               01120000
       IF GETC(I).CLASS=ENDCOM THEN I~GETC(I).LINK ;                    01121000
       IF T~GETC(I).LASTC!R THEN                                        01122000
          IF GETC(T)}0 THEN                                             01122500
               BEGIN R~R&LAST[3:33:15]&I[18:33:15] ;                    01122550
               EQUIV(T);  LAST~R.[3:15];  I~R.[18:15];  R~R.[33:15] ;   01122600
               END;                                                     01122650
    END;                                                                01123000
    XIT:                                                                01124000
IF DEBUGTOG THEN FLAGROUTINE("   EQU","IV    ",FALSE) ;                 01124010
END EQUIV;                                                              01125000
ALPHA PROCEDURE GETSPACE(S); VALUE S; ALPHA S;                          01126000
BEGIN LABEL RPLUS, FMINUS, XIT;                                         01127000
   LABEL DONE;                                                          01128000
   REAL A;                                                              01129000
   BOOLEAN OWNID;                                                       01129100
   IF OWNID ~ S < 0 THEN S~ -S;       % IN DATA STMT, THUS OWN          01129200
   IF A ~ GET(GETSPACE~S) < 0 THEN GO TO DONE;                          01130000
   IF A.CLASS GEQ 13 THEN FLAG(34) ELSE                            %104-01130500
CASE A.CLASS OF                                                         01131000
BEGIN                                                                   01132000
BEGIN                                                                   01133000
   PUT(S,A~A&VARID[TOCLASS]);                                           01134000
   PUT(S+2,(GET(S+2)   &(IF A.SUBCLASS { LOGTYPE                        01135000
       THEN 1 ELSE 2 )[TOSIZE]));                                       01136000
END;                                                                    01137000
   IF BOOLEAN(A.FORMAL) THEN BUMPLOCALS;                                01138000
;                                                                       01139000
BEGIN A.TYPEFIXED ~ 1; GO TO RPLUS END;                                 01140000
GO TO RPLUS;                                                            01141000
GO TO RPLUS;                                                            01142000
GO TO DONE;                                                             01143000
BEGIN A.TYPEFIXED ~ 1; IF BOOLEAN(A.FORMAL) THEN GO TO FMINUS           01144000
   ELSE GO TO RPLUS;                                                    01145000
END;                                                                    01146000
BEGIN A.TYPEFIXED ~ 1; GO TO RPLUS END;                                 01147000
IF BOOLEAN(A.FORMAL) THEN GO TO FMINUS ELSE GO TO RPLUS;                01148000
IF BOOLEAN(A.FORMAL) THEN GO TO FMINUS ELSE GO TO RPLUS;                01149000
GO TO RPLUS;                                                            01150000
GO TO RPLUS;                                                            01151000
END OF CASE STATEMENT;                                                  01152000
A.TYPEFIXED ~ 1;                                                        01153000
IF BOOLEAN(A.FORMAL) THEN                                               01154000
         GO TO FMINUS;                                                  01155000
IF BOOLEAN(A.CE) OR BOOLEAN(A.EQ) THEN                                  01156000
BEGIN                                                                   01157000
   PUT(S,A);                                                            01158000
   CALLEQUIV(A.ADDR,OWNID,GET(S+1)) ;                                   01159000
   GO TO DONE;                                                          01160000
END;                                                                    01161000
   A.TWOD ~ REAL(GET(S+2).SIZE > 1023);                                 01162000
FMINUS:                                                                 01163000
   IF OWNID THEN BEGIN BUMPPRT; A.ADDR~PRTS END ELSE                    01163100
    BEGIN BUMPLOCALS; A.ADDR ~ LOCALS +1536 END;                        01164000
   IF A.CLASS = VARID THEN IF A.SUBCLASS } DOUBTYPE THEN                01165000
   IF OWNID THEN BUMPPRT ELSE                                           01165100
   BUMPLOCALS;                                                          01166000
   GO TO XIT;                                                           01167000
RPLUS:                                                                  01168000
   BUMPPRT; A.ADDR~PRTS;                                                01169000
XIT:                                                                    01170000
   PUT(S, -A);                                                          01171000
DONE:                                                                   01172000
END GETSPACE;                                                           01173000
INTEGER STREAM PROCEDURE LBLSHFT(S);     VALUE S;                       01174000
    BEGIN                                                               01175000
         LOCAL T;                                                       01176000
         LABEL L;                                                       01177000
         DI ~ LOC LBLSHFT; DS ~ 8 LIT "00      ";                       01178000
         DI ~ DI - 6; SI ~LOC S; SI ~ SI + 2;                           01179000
         TALLY ~ 1; T ~ TALLY;                                          01180000
     5(T(IF SC="0" THEN BEGIN SI~SI+1; JUMP OUT 1 TO L END              01181000
      ELSE TALLY~0; T~TALLY);                                           01182000
         IF SC}"0" THEN DS~CHR ELSE IF SC=" " THEN SI~SI+1              01183000
         ELSE JUMP OUT;  L: ) ;                                         01183100
         IF SC ! " " THEN BEGIN DI ~ LOC LBLSHFT; DS ~ LIT "+" END;     01184000
    END LBLSHFT;                                                        01185000
         COMMENT EMITTERS AND CODE CONTROL;                             01186000
ALPHA PROCEDURE B2D(B); VALUE B; REAL B;                                01187000
         B2D ~ 0&B[45:45:3]&B[39:42:3]&B[33:39:3]&B[27:36:3];           01188000
PROCEDURE DEBUG(S);     % PRINTS OUT DEBUG CODE                         01189000
    VALUE S; REAL S;    % IF S<0 THEN S IS FIELD TYPE OPERATOR          01190000
    BEGIN                                                               01191000
         FORMAT FF(X35,*(33(".")),A4,":",A1,2(X2,A4),X4,A4) ;           01192000
         ALPHA CODE,MNM,SYL;                                            01193000
    REAL T;                                                             01194000
PROCEDURE SEARCH(CODE,S); VALUE S; REAL S,CODE;                         01195000
    BEGIN  % SEARCHS WOP TO FIND CODE FOR S                             01196000
    REAL N,I;                                                           01197000
    LABEL L;                                                            01198000
         N ~ 64;                                                        01199000
         FOR I ~ 66 STEP IF WOP[I] < S THEN N ELSE -N                   01200000
         WHILE N ~ N DIV 2 } 1 DO                                       01201000
         IF WOP[I] =S THEN GO TO L;                                     01202000
         I ~ 0;         % NOT FOUND                                     01203000
    L:   CODE ~ WOP[I+1];                                               01204000
    END SEARCH;                                                         01205000
         IF S < 0 THEN                                                  01206000
    BEGIN     % FIELD TYPE OPERATOR                                     01207000
         SYL ~ S;                                                       01208000
         MNM ~ B2D(S.[36:6]);                                           01209000
         IF (S ~ S.[42:6]) = 37 THEN CODE ~ "ISO " ELSE                 01210000
         IF S = 45 THEN CODE ~ "DIA " ELSE                              01211000
         IF S = 49 THEN CODE ~ "DIB " ELSE                              01212000
         IF S = 53 THEN CODE ~ "TRB ";                                  01213000
    END                                                                 01214000
         ELSE                                                           01215000
    BEGIN                                                               01216000
         IF (T ~ S.[46:2]) ! 1 THEN                                     01217000
    BEGIN                                                               01218000
         SYL ~ S;                                                       01219000
         MNM ~ B2D(S.[36:10]);                                          01220000
         IF T = 0 THEN CODE ~ "LITC"                                    01221000
         ELSE IF T =2 THEN CODE ~ "OPDC"                                01222000
         ELSE CODE ~ "DESC";                                            01223000
    END                                                                 01224000
         ELSE                                                           01225000
    BEGIN      % SEARCH WOP FOR OPERATOR NAME                           01226000
         SYL ~ S;                                                       01227000
         MNM ~ "    ";                                                  01228000
         SEARCH(CODE,S.[36:10]);                                        01229000
    END;                                                                01230000
    END;                                                                01231000
         WRITALIST(FF,6,IF ADR{DEBUGADR THEN 1 ELSE -1,B2D(ADR.[36:10]),01232000
                   B2D(ADR.[46:2]),CODE,MNM,B2D(SYL),0,0) ;             01233000
         IF DEBUGADR<ADR THEN DEBUGADR~ADR;                             01233100
    END DEBUG;                                                          01234000
PROCEDURE DEBUGWORD(N); VALUE N; REAL N; %PRINTS OUT C+ CONSTANTS       01235000
    BEGIN                                                               01236000
         STREAM PROCEDURE WB2D(F,T);                                    01237000
              BEGIN                                                     01238000
                   DI ~ T;                                              01239000
                   DI ~ DI+35; DS~10LIT"CONSTANT  " ;                   01240000
                   SI ~ F;                                              01241000
                   16(DS ~ 3 RESET; 3(IF SB THEN DS ~ SET               01242000
                                             ELSE DS ~ RESET;           01243000
                                       SKIP SB));                       01244000
              END WB2D;                                                 01247000
         ARRAY A[0:14];  FORMAT F(X63,"(DEC ",B,")") ;                  01248000
         WRITE(A[*],F,N);  WB2D(N,A) ;                                  01249000
         WRITAROW(15,A) ;                                               01250000
    END DEBUGWORD;                                                      01251000
REAL PROCEDURE GIT(Z);  % RETURNS OPERATOR IN SYLLABLE Z                01252000
    VALUE Z; REAL Z;                                                    01253000
    BEGIN                                                               01254000
         INTEGER STREAM PROCEDURE GT(S,SKP); VALUE SKP;                 01255000
         BEGIN                                                          01256000
              SI ~ S; SKP(SI ~ SI + 2);                                 01257000
              DI ~ LOC GT; DI ~ DI +6; DS ~ 2 CHR;                      01258000
         END GT;                                                        01259000
         GIT ~ GT(EDOC[Z.[36:3],Z.[39:7]],Z.[46:2]);                    01260000
    END GIT;                                                            01261000
REAL STREAM PROCEDURE SPCLBIN2DEC(N);  VALUE N ;                        01261100
    BEGIN LOCAL L; LABEL B1 ;                                           01261110
    DI~LOC L; SI~LOC N; DS~8DEC; SI~LOC L; TALLY~8 ;                    01261120
B1: IF SC="0" THEN BEGIN TALLY~TALLY+63; SI~SI+1; GO B1 END;            01261130
    DI~LOC SPCLBIN2DEC; DI~DI+2; DS~6LIT" "; DI~DI-6; N~TALLY; DS~N CHR;01261140
    END OF SPCLBIN2DEC;                                                 01261150
STREAM PROCEDURE PACK(T,F,SKP); VALUE SKP,F;                            01262000
    BEGIN     % PACKS OPERATORS INTO EDOC                               01263000
         SI ~ LOC F; SI ~ SI + 6;DI ~ T; SKP(DI ~ DI + 2);              01264000
         DS ~ 2 CHR;                                                    01265000
    END PACK;                                                           01266000
PROCEDURE EMITO(N); VALUE N; REAL N;                                    01267000
    BEGIN                                                               01268000
   BUMPADR;                                                             01269000
         PACK(EDOC[EDOCI],(N~1&N[36:38:10]),ADR.[46:2]);                01270000
         IF CODETOG THEN DEBUG(N);                                      01271000
END EMITO;                                                              01272000
PROCEDURE EMITN(P); VALUE P; REAL P;                                    01273000
BEGIN LABEL XIT;                                                        01274000
   ALPHA S;                                                             01275000
   IF S~GET(P)>0 THEN S~GET(GETSPACE(P));                               01276000
   IF S.CLASS = VARID THEN IF BOOLEAN(S.CE) THEN                        01277000
      IF BOOLEAN(S.TWOD) THEN                                           01278000
      BEGIN                                                             01279000
         EMITL( (T~GET(P+2).BASE).[33:7]);                              01280000
         EMITDESCLIT(S.ADDR);                                           01281000
         EMITO(LOD);                                                    01282000
         EMITL(T.[40:8]);                                               01283000
         EMITO(CDC);                                                    01284000
         GO TO XIT;                                                     01285000
      END ELSE                                                          01286000
      EMITNUM(GET(P+2).BASE)                                            01287000
      ELSE                                                              01288000
      IF NOT BOOLEAN(S.FORMAL) THEN IF NOT DESCREQ THEN                 01289000
      BEGIN                                                             01290000
         EMITL(S~S.ADDR);                                               01291000
         IF S.[37:2]=1 THEN %REFERENCING 2ND HALF OF PRT;               01292000
         BEGIN                                                          01293000
    IF ADR } 4087 THEN                                                  01294000
            BEGIN ADR ~ ADR+1; SEGOVF END;                              01295000
            EMITO(XRT);                                                 01296000
         END;                                                           01297000
         GO TO XIT;                                                     01298000
      END;                                                              01299000
      EMITDESCLIT(S.ADDR);                                              01300000
   XIT:                                                                 01301000
END EMITN;                                                              01302000
PROCEDURE EMITV(P); VALUE P; ALPHA P;                                   01303000
    BEGIN                                                               01304000
   ALPHA S;                                                             01305000
   IF S~ GET(P) > 0 THEN S ~ GET(GETSPACE(P));                          01306000
   IF S.CLASS = VARID THEN                                              01307000
      IF BOOLEAN(S.CE) THEN                                             01308000
         IF BOOLEAN(S.TWOD) THEN                                        01309000
            BEGIN                                                       01310000
               EMITL( (T~GET(P+2).BASE).[33:7]);                        01311000
               EMITDESCLIT(S.ADDR);                                     01312000
               EMITO(LOD);                                              01313000
               IF S.SUBCLASS } DOUBTYPE THEN                            01314000
               BEGIN                                                    01315000
                  EMITO(DUP);                                           01316000
                  EMITPAIR(T.[40:8]+1, COC);                            01317000
                  EMITO(XCH);                                           01318000
                  EMITPAIR(T.[40:8], COC);                              01319000
               END ELSE EMITPAIR(T.[40:8], COC);                        01320000
            END                                                         01321000
            ELSE                                                        01322000
            IF S.SUBCLASS } DOUBTYPE THEN                               01323000
            BEGIN                                                       01324000
               EMITNUM( (T~GET(P+2).BASE)+1);                           01325000
               EMITOPDCLIT(S.ADDR);                                     01326000
               EMITNUM(T);                                              01327000
               EMITOPDCLIT(S.ADDR);                                     01328000
            END ELSE                                                    01329000
            BEGIN                                                       01330000
               EMITNUM(GET(P+2).BASE);                                  01331000
               EMITOPDCLIT(S.ADDR);                                     01332000
            END                                                         01333000
      ELSE                                                              01334000
      IF S.SUBCLASS } DOUBTYPE THEN                                     01335000
      IF BOOLEAN(S.FORMAL) THEN                                         01336000
      BEGIN                                                             01337000
         EMITDESCLIT(S.ADDR);                                           01338000
         EMITO(DUP);                                                    01339000
         EMITPAIR(1, XCH);                                              01340000
         EMITO(INX);                                                    01341000
         EMITO(LOD);                                                    01342000
         EMITO(XCH);                                                    01343000
         EMITO(LOD);                                                    01344000
      END ELSE                                                          01345000
      BEGIN                                                             01346000
         EMITOPDCLIT(S.ADDR+1);                                         01347000
         EMITOPDCLIT(S.ADDR);                                           01348000
      END                                                               01349000
      ELSE EMITOPDCLIT(S.ADDR)                                          01350000
   ELSE EMITOPDCLIT(S.ADDR);                                            01351000
END EMITV;                                                              01352000
PROCEDURE EMITL(N); VALUE N; REAL N;                                    01353000
    BEGIN                                                               01354000
   BUMPADR;                                                             01355000
         PACK(EDOC[EDOCI],(N~0&N[36:38:10]),ADR.[46:2]);                01356000
         IF CODETOG THEN DEBUG(N);                                      01357000
END EMITL;                                                              01358000
PROCEDURE EMITD(R, OP); VALUE R, OP; REAL R, OP;                        01359000
BEGIN                                                                   01360000
   BUMPADR;                                                             01361000
   PACK(EDOC[EDOCI], (R ~ OP & R[36:42:6]), ADR.[46:2]);                01362000
   IF CODETOG THEN DEBUG(-R);                                           01363000
END EMITD;                                                              01364000
PROCEDURE EMITDDT(B,A,X);  VALUE B,A,X;  INTEGER B,A,X ;                01364010
    BEGIN % DOES DIB B, DIA A, TRB X; HANDLES [B:A:X].                  01364020
    EMITD(B~B MOD 6+B DIV 6|8,DIB);  EMITD(A~A MOD 6+A DIV 6|8,DIA) ;   01364030
    EMITD(X~X,TRB);                                                     01364035
    END OF EMITDDT ;                                                    01364040
PROCEDURE EMITPAIR(L, OP); VALUE L, OP; INTEGER L, OP;                  01365000
BEGIN                                                                   01366000
   EMITL(L);                                                            01367000
   IF L.[37:2] = 1 THEN                                                 01368000
   BEGIN                                                                01369000
    IF ADR } 4087 THEN                                                  01370000
      BEGIN ADR ~ ADR+1; SEGOVF END;                                    01371000
      EMITO(XRT);                                                       01372000
   END;                                                                 01373000
   EMITO(OP);                                                           01374000
END EMITPAIR;                                                           01375000
PROCEDURE ADJUST;                                                       01376000
         WHILE ADR.[46:2] ! 3 DO EMITO(NOP);                            01377000
PROCEDURE EMITNUM(N); VALUE N; REAL N;                                  01378000
    BEGIN                                                               01379000
         DEFINE CPLUS = 1792#;                                          01380000
         IF N.[3:6] =0 AND ABS(N) < 1024 THEN                           01381000
    BEGIN                                                               01382000
         EMITL(N);                                                      01383000
         IF N < 0 THEN EMITO(SSN);                                      01384000
    END ELSE                                                            01385000
    BEGIN                                                               01386000
    IF ADR } 4079 THEN                                                  01387000
         BEGIN ADR ~ ADR+1; SEGOVF END;                                 01388000
         EMITOPDCLIT(CPLUS +  (ADR+1).[46:1] + 1);                      01389000
         EMITL(2);                                                      01390000
         EMITO(GFW);                                                    01391000
         ADJUST;                                                        01392000
         BUMPADR;                                                       01393000
         PACK(EDOC[EDOCI],N.[1:11],ADR.[46:2]);                         01394000
         BUMPADR;                                                       01395000
         PACK(EDOC[EDOCI],N.[12:12],ADR.[46:2]);                        01396000
         BUMPADR;                                                       01397000
         PACK(EDOC[EDOCI],N.[24:12],ADR.[46:2]);                        01398000
         BUMPADR;                                                       01399000
         PACK(EDOC[EDOCI],N.[36:12],ADR.[46:2]);                        01400000
         IF N.[36:12]=49 THEN %%% IF C-REL CONSTANT LOOKS LIKE AN XRT   01400400
         EMITO(NOP);          %%% THEN INSURE AGAINST P-BIT INTERRUPT.  01400600
         IF CODETOG THEN DEBUGWORD(N);                                  01401000
     END;                                                               01402000
END EMITNUM;                                                            01403000
PROCEDURE EMITNUM2(HI,LO);VALUE HI,LO; REAL HI,LO;                      01404000
    BEGIN                                                               01405000
    BOOLEAN B;  REAL I,N;                                               01406000
    LABEL Z,X;                                                          01407000
         DEFINE CPLUS = 1792#;                                          01408000
    IF HI=0 OR LO=0 THEN BEGIN EMITNUM(LO); EMITNUM(HI); GO Z END;      01408100
         ADJUST;                                                        01409000
    IF ADR } 4077 THEN                                                  01410001
         BEGIN ADR~ADR+1; SEGOVF; ADR~-1 END;                           01411000
         EMITOPDCLIT(CPLUS + 2);   EMITOPDCLIT(CPLUS + 1);              01412000
         EMITPAIR(3,GFW);                                               01413000
    X:   FOR I ~ 0 STEP 1 UNTIL 3 DO                                    01415000
    BEGIN                                                               01416000
         CASE I OF BEGIN                                                01417000
                        N ~ HI.[ 1:11];                                 01418000
                        N ~ HI.[12:12];                                 01419000
                        N ~ HI.[24:12];                                 01420000
                        N ~ HI.[36:12];                                 01421000
                   END CASE;                                            01422000
         BUMPADR; PACK(EDOC[EDOCI],N,ADR.[46:2]);                       01423000
    END;                                                                01424000
         IF CODETOG THEN DEBUGWORD(HI);                                 01425000
         IF NOT B THEN BEGIN B~TRUE; HI~LO; GO TO X; END;               01426000
         IF N=49 THEN   %%% IF C-REL CONSTANT LOOKS LIKE AN XRT         01426400
         EMITO(NOP) ;   %%% THEN INSURE AGAINST P-BIT INTERRUPT.        01426600
Z:                                                                      01426650
    END EMITNUM2;                                                       01427000
PROCEDURE EMITLINK(N); VALUE N; REAL N; % EMITS LINKS                   01428000
    BEGIN                                                               01429000
         FORMAT FF(X35,*(33(".")),A4,":",A1,"  LINK",X10,A4,"******") ; 01430000
         BUMPADR;                                                       01431000
         PACK(EDOC[EDOCI],N,ADR.[46:2]);                                01432000
         IF CODETOG THEN                                                01433000
         WRITALIST(FF,4,IF ADR{DEBUGADR THEN 1 ELSE -1,B2D(ADR.[36:10]),01434000
                   B2D(ADR.[46:2]),B2D(N),0,0,0,0) ;                    01435000
         IF DEBUGADR<ADR THEN DEBUGADR~ADR ;                            01435010
    END EMITLINK;                                                       01436000
PROCEDURE EMITSTORE(IX, EXP); VALUE IX, EXP; REAL IX, EXP;              01437000
BEGIN                                                                   01438000
   REAL E, VT;                                                          01439000
   P ~ REAL(ERRORTOG);                                                  01440000
   ERRORTOG ~ FALSE;                                                    01441000
   E ~ GET(GETSPACE(IX));                                               01442000
   IF NOT( (VT ~ E.SUBCLASS) = LOGTYPE EQV EXP = LOGTYPE) OR            01443000
      NOT(VT = COMPTYPE EQV EXP = COMPTYPE) THEN                        01444000
      BEGIN XTA ~ GET(IX+1); FLAG(86) END;                              01445000
   IF E.CLASS = VARID THEN                                              01446000
   BEGIN                                                                01447000
      IF BOOLEAN(E.FORMAL) OR BOOLEAN(E.CE) THEN                        01448000
      BEGIN                                                             01449000
         IF VT { LOGTYPE THEN                                           01450000
         BEGIN                                                          01451000
            IF VT = INTYPE AND EXP } REALTYPE THEN EMITPAIR(1, IDV);    01452000
            EMITN(IX);                                                  01453000
            EMITO(IF VT = INTYPE THEN ISD ELSE STD);                    01454000
            IF EXP } DOUBTYPE THEN EMITO(DEL);                          01455000
         END ELSE                                                       01456000
         BEGIN                                                          01457000
            EMITN(IX);                                                  01458000
            EMITPAIR(JUNK, STN);                                        01459000
            EMITO(STD);                                                 01460000
            IF EXP < DOUBTYPE THEN EMITL(0);                            01461000
            EMITL(1);                                                   01462000
            EMITPAIR(JUNK, LOD);                                        01463000
            EMITO(INX);                                                 01464000
            EMITO(STD);                                                 01465000
         END                                                            01466000
    END ELSE                                                            01467000
    BEGIN                                                               01468000
       IF VT = INTYPE AND EXP } REALTYPE THEN EMITPAIR(1, IDV);         01469000
       EMITPAIR(E.ADDR, IF VT = INTYPE THEN ISD ELSE STD);              01470000
       IF VT { LOGTYPE THEN                                             01471000
          IF EXP } DOUBTYPE THEN EMITO(DEL) ELSE ELSE                   01472000
       BEGIN                                                            01473000
          IF EXP < DOUBTYPE THEN EMITL(0);                              01474000
          EMITPAIR(E.ADDR+1, STD);                                      01475000
       END                                                              01476000
    END                                                                 01477000
END ELSE                                                                01478000
IF E.CLASS = ARRAYID THEN                                               01479000
BEGIN                                                                   01480000
   IF VT { LOGTYPE THEN                                                 01481000
   BEGIN                                                                01482000
      IF VT = INTYPE AND EXP } REALTYPE THEN EMITPAIR(1, IDV);          01483000
      IF EXP } DOUBTYPE THEN                                            01484000
      BEGIN                                                             01485000
         EMITO(XCH);                                                    01486000
         EMITO(DEL);                                                    01487000
      END;                                                              01488000
      EMITO(XCH);                                                       01489000
      EMITO(IF VT = INTYPE THEN ISD ELSE STD);                          01490000
   END ELSE                                                             01491000
   BEGIN                                                                01492000
      IF EXP } DOUBTYPE THEN                                            01493000
      BEGIN                                                             01494000
         EMITPAIR(JUNK, STD);                                           01495000
         EMITO(XCH);                                                    01496000
         EMITOPDCLIT(JUNK);                                             01497000
         EMITO(XCH);                                                    01498000
         EMITPAIR(JUNK, STN);                                           01499000
         EMITO(STD);                                                    01500000
         EMITL(1);                                                      01501000
         EMITPAIR(JUNK, LOD);                                           01502000
         EMITO(INX);                                                    01503000
         EMITO(STD);                                                    01504000
      END ELSE                                                          01505000
      BEGIN                                                             01506000
         EMITO(XCH);                                                    01507000
         EMITPAIR(JUNK, STN);                                           01508000
         EMITO(STD);                                                    01509000
         EMITL(0);                                                      01510000
         EMITL(1);                                                      01511000
         EMITPAIR(JUNK, LOD);                                           01512000
         EMITO(INX);                                                    01513000
         EMITO(STD);                                                    01514000
      END                                                               01515000
   END                                                                  01516000
END ELSE BEGIN XTA ~ GET(IX+1); FLAG(49) END;                           01517000
ERRORTOG ~ ERRORTOG OR BOOLEAN(P);                                      01518000
END EMITSTORE;                                                          01519000
PROCEDURE EMITB(A,C); VALUE A,C; REAL A; BOOLEAN C;                     01520000
BEGIN COMMENT  GENERATES LITC AND BRANCH FROM CURRENT ADR TO ADDRESS A. 01521000
IF THE BOOLEAN C IS TRUE THEN THE BRANCH IS CONDITIONAL.  BEOREF IS     01522000
TRUE IF THE BRANCH IS BACKWARDS;                                        01523000
BOOLEAN BEOREF;                                                         01524000
         REAL SEG;                                                      01525000
    IF ADR } 4086 THEN                                                  01526000
      BEGIN ADR ~ ADR+1; SEGOVF END;                                    01527000
         IF A < 0 THEN                                                  01528000
    BEGIN                                                               01529000
         IF BRANCHX>LBRANCH THEN FATAL(123);                            01530000
         BRANCHX ~ BRANCHES[LAX~BRANCHX];                               01531000
         BRANCHES[LAX] ~ -(ADR+1);                                      01532000
         EMITLINK(0);                                                   01533000
         EMITO(IF C THEN BFC ELSE BFW);                                 01534000
         EMITO(NOP);                                                    01534100
    END ELSE                                                            01535000
    BEGIN                                                               01536000
         SEG ~ A.SEGNO;                                                 01537000
         A ~ A.LINK;                                                    01538000
         BEOREF ~ ADR > A;                                              01539000
         IF A.[46:2] =0 THEN                                            01540000
    BEGIN                                                               01541000
         IF SEG > 0 AND SEG ! NSEG THEN                                 01542000
            EMITOPDCLIT(PRGDESCBLDR(2, 0, A.[36:10], SEG))              01543000
         ELSE                                                           01544000
         EMITL(ABS((ADR+2).[36:10] - A.[36:10]));                       01545000
         IF BEOREF THEN                                                 01546000
         EMITO( IF C THEN GBC ELSE GBW) ELSE                            01547000
         EMITO( IF C THEN GFC ELSE GFW);                                01548000
    END ELSE                                                            01549000
    BEGIN                                                               01550000
         EMITL(ABS(ADR + 3 - A));                                       01551000
         IF BEOREF THEN                                                 01552000
         EMITO(IF C THEN BBC ELSE BBW) ELSE                             01553000
         EMITO(IF C THEN BFC ELSE BFW);                                 01554000
    END;                                                                01555000
  END;                                                                  01556000
END EMITB;                                                              01557000
PROCEDURE EMITDESCLIT(N); VALUE N; REAL N;                              01558000
    BEGIN                                                               01559000
         IF N.[37:2] = 1 THEN                                           01560000
         BEGIN                                                          01561000
    IF ADR } 4087 THEN                                                  01562000
            BEGIN ADR ~ ADR+1; SEGOVF END;                              01563000
            EMITO(XRT);                                                 01564000
         END;                                                           01565000
         BUMPADR;                                                       01566000
         PACK(EDOC[EDOCI],(N~3&N[36:38:10]),ADR.[46:2]);                01567000
         IF CODETOG THEN DEBUG(N);                                      01568000
END EMITDESCLIT;                                                        01569000
PROCEDURE EMITOPDCLIT(N);       VALUE N; REAL N;                        01570000
    BEGIN                                                               01571000
         IF N.[37:2] = 1 THEN                                           01572000
         BEGIN                                                          01573000
    IF ADR } 4087 THEN                                                  01574000
            BEGIN ADR ~ ADR+1; SEGOVF END;                              01575000
            EMITO(XRT);                                                 01576000
         END;                                                           01577000
         BUMPADR;                                                       01578000
         PACK(EDOC[EDOCI],(N~2&N[36:38:10]),ADR.[46:2]);                01579000
         IF CODETOG THEN DEBUG(N);                                      01580000
END EMITOPDCLIT;                                                        01581000
PROCEDURE EMITLABELDESC(N); VALUE N; ALPHA N;                           01582000
BEGIN                                                                   01583000
   LABEL XIT;                                                           01584000
   REAL T,B,C,D ;                                                       01585000
   IF N ~ LBLSHFT(XTA~N) = 0 OR N = BLANKS THEN                         01586000
   BEGIN FLAG(135); GO TO XIT END;                                      01587000
   IF T ~ SEARCH(N) = 0 THEN                                            01588000
      T ~ ENTER(0 & LABELID[TOCLASS], N) ELSE                           01588100
      IF GET(T).CLASS ! LABELID THEN                                    01588200
      BEGIN FLAG(144); GO TO XIT END;                                   01588300
   IF XREF THEN ENTERX(N,0&LABELID[TOCLASS]);                           01588400
   IF B ~(C~GET(T+2)).BASE =0 THEN                                      01589000
     IF (D~GET(T)).SEGNO!0 THEN C.BASE~B~PRGDESCBLDR(2,0,D.ADDR DIV 4,  01589010
     D.SEGNO) ELSE                                                      01589020
         BEGIN BUMPPRT; C.BASE~B~PRTS END; PUT(T+2,C);                  01590000
   EMITL(B); EMITO(MKS);                                                01591000
   EMITDESCLIT(1536);        % F+0                                      01592000
   EMITOPDCLIT(1537);        % F+1                                      01593000
   EMITV(NEED(".LABEL", INTRFUNID));                                    01594000
   XIT:                                                                 01595000
END EMITLABELDESC;                                                      01596000
COMMENT TRACEBACK, OFLOWHANGERS, AND PRTSAVER ARE                       01597000
PROCEDURES USED TO ACCUMULATE FORMAT AND NAMELIST ARRAYS;               01598000
PROCEDURE TRACEBACK(M,DEX,PRT);  VALUE M,DEX,PRT; INTEGER M,DEX,PRT;    01599000
BEGIN INTEGER I,J; REAL C;                                              01600000
   IF (C~GET(M+2)).BASE ! 0 THEN                                        01601000
   BEGIN I ~ ADR;   ADR ~ C.BASE;                                       01602000
         DO BEGIN J ~ GIT(ADR);                                         01603000
                  ADR ~ ADR - 1;                                        01604000
                  EMITL(DEX);                                           01605000
                  EMITPAIR(PRT,LOD);                                    01606000
            END UNTIL ADR ~ J = 0;                                      01607000
            ADR ~ I;                                                    01608000
   END;                                                                 01609000
INFO[M.IR,M.IC].ADDR ~ PRT; PUT(M+2,0&DEX[TOBASE]);                     01610000
END TRACEBACK;                                                          01611000
PROCEDURE OFLOWHANGERS(I);   VALUE I;   INTEGER I;                      01612000
BEGIN INTEGER J;   LABEL XIT;                                           01613000
FOR J ~ 1 STEP 1 UNTIL MAXNBHANG DO                                     01614000
IF FNNHANG[J] = 0 THEN    %  MAKE AN ENTRY                              01615000
BEGIN FNNHANG[J] ~ I;                                                   01616000
      PUT(I+2,J);                                                       01617000
      GO TO XIT;                                                        01618000
END;                                                                    01619000
XTA ~ MAXNBHANG;   %  IF WE REACH HERE WERE HURTIN                      01620000
FLAG(91);                                                               01621000
XIT:                                                                    01622000
END OFLOWHANGERS;                                                       01623000
PROCEDURE PRTSAVER(M,SZ,ARY);   VALUE M,SZ;                             01624000
INTEGER M,SZ;   ARRAY ARY[0];                                           01625000
BEGIN INTEGER I; REAL INFA;                                             01626000
LABEL SHOW,XIT;                                                         01626100
IF (INFA~GET(M)) < 0 THEN   % PREVIOUSLY DEFINED                        01627000
BEGIN XTA ~ GET(M+1);                                                   01628000
      FLAG(20); GO TO XIT;                                              01629000
END;                                                                    01630000
IF I ~ INFA   .ADDR ! 0 THEN  %  PRT ASSIGNED AT OFLOW TIME             01631000
SHOW:                                                                   01631100
BEGIN I ~ PRGDESCBLDR(1,I,0,NXAVIL ~ NXAVIL + 1);                       01632000
      WRITEDATA(SZ,NXAVIL,ARY);                                         01633000
      FNNHANG[GET(M+2).SIZE] ~ 0;                                       01634000
END ELSE   %  ADD THIS ARRAY TO HOLD                                    01635000
BEGIN IF FNNPRT=0 THEN BEGIN BUMPPRT; FNNPRT~PRTS END;                  01636000
      IF FNNINDEX + SZ > DUMPSIZE THEN   %  ARRAY WONT FIT              01637000
      IF SZ > DUMPSIZE THEN   %  ARRAY WILL NEVER FIT                   01638000
      BEGIN BUMPPRT;FNNHANG[GET(M+2).SIZE]~0; TRACEBACK(M,0,I~PRTS);    01639000
            GO TO SHOW;                                                 01640000
      END ELSE   %  DUMP OUT CURRENT HOLDINGS                           01641000
      BEGIN FNNPRT ~ PRGDESCBLDR(1,FNNPRT,0,NXAVIL ~ NXAVIL + 1);       01642000
            WRITEDATA(FNNINDEX,NXAVIL,FNNHOLD);                         01643000
            FNNINDEX ~ 0; BUMPPRT; FNNPRT ~PRTS;                        01644000
      END;                                                              01645000
      FNNHANG[GET(M + 2).SIZE] ~0;                                      01646000
      TRACEBACK(M,FNNINDEX,FNNPRT);                                     01647000
      MOVEW(ARY,FNNHOLD[FNNINDEX],SZ.[36:6],SZ);                        01648000
      FNNINDEX ~ FNNINDEX + SZ;                                         01649000
END;                                                                    01650000
PUT(M,-GET(M));         %  ID NOW ASSIGNED                              01651000
XIT:                                                                    01651100
END PRTSAVER;                                                           01652000
PROCEDURE SEGOVF;                                                       01653000
    BEGIN                                                               01654000
   REAL I, T, A, J, SADR, INFC, LABPRT;                                 01655000
   REAL SAVINS;                                                         01655100
   FOR T ~ 1 STEP 1 UNTIL MAXNBHANG DO                                  01656000
IF J~FNNHANG[T]!0 THEN BEGIN BUMPPRT;TRACEBACK(J,FNNHANG[T]~0,PRTS) END;01657000
   SEGOVFLAG ~ TRUE;                                                    01661000
BUMPPRT;                                                                01662000
   IF PRTS.[37:2]=1 THEN BEGIN                                          01662300
        PACK(EDOC[EDOCI],(T~1&XRT[36:38:10]),ADR.[46:2]);               01662500
        IF CODETOG THEN DEBUG(T); ADR~ADR+1 END;                        01662700
   PACK(EDOC[EDOCI], (T~2&PRTS[36:38:10]), ADR.[46:2]);                 01663000
   IF CODETOG THEN DEBUG(T);                                            01664000
   ADR ~ ADR+1;                                                         01665000
   PACK(EDOC[EDOCI], (T~1&BFW [36:38:10]), ADR.[46:2]);                 01666000
   IF CODETOG THEN DEBUG(T);                                            01667000
         SADR ~ ADR;                                                    01668000
   T ~ PRGDESCBLDR(2, PRTS, 0, NXAVIL+1);                               01669000
   FOR I ~ 0 STEP 1 UNTIL SHX DO                                        01670000
   BEGIN T ~ STACKHEAD[I];                                              01671000
      WHILE T ! 0 DO                                                    01672000
      BEGIN IF (A~ GET(T)).CLASS = LABELID THEN                         01673000
         IF A > 0 THEN                                                  01674000
         BEGIN                                                          01675000
            ADR ~ A.ADDR;                                               01676000
            IF LABPRT ~ (INFC~GET(T+2)).BASE = 0 THEN                   01677000
            BEGIN                                                       01678000
            BUMPPRT; LABPRT~PRTS;                                       01679000
               PUT(T+2, INFC & PRTS[TOBASE]);                           01680000
            END;                                                        01681000
            WHILE ADR ! 0 DO                                            01682000
            BEGIN J ~ GIT(ADR); ADR ~ ADR-1;                            01683000
               SAVINS~GIT(ADR+2).[36:10];                               01683100
               EMITOPDCLIT(LABPRT);                                     01684000
               EMITO(SAVINS);                                           01684100
               ADR ~ J;                                                 01685000
            END;                                                        01686000
            INFO[T.IR,T.IC].ADDR ~ 0;                                   01687000
        END;                                                            01688000
        T ~ A.LINK;                                                     01689000
      END;                                                              01690000
  END;                                                                  01691000
  FOR I ~ 0 STEP 1 UNTIL LBRANCH DO                                     01692000
  IF T ~ - BRANCHES[I] > 0 AND T < 4096 THEN                            01693000
  BEGIN                                                                 01694000
     ADR ~ T-1;                                                         01695000
               SAVINS~GIT(ADR+2).[36:10];                               01695100
  BUMPPRT; EMITOPDCLIT(PRTS);                                           01696000
               EMITO(SAVINS);                                           01696100
     BRANCHES[I] ~ - (PRTS+4096);                                       01697000
  END;                                                                  01698000
        SEGMENT((SADR+4) DIV 4,NSEG,FALSE,EDOC);                        01699000
        SEGMENTSTART;                                                   01700000
  EMITO(NOP); EMITO(NOP);                                               01701000
  SEGOVFLAG ~ FALSE;                                                    01702000
END SEGOVF;                                                             01703000
PROCEDURE ARRAYDEC(I); VALUE I; REAL I;                                 01704000
    BEGIN     % DECLARES ARRAYS WHOSE INFO INDEX IS I                   01705000
         REAL PRT,LNK,J;                                                01706000
              LABEL XIT;                                                01706010
         BOOLEAN OWNID; REAL X;                                         01706100
IF DEBUGTOG THEN FLAGROUTINE("  ARRA","YDEC  ",TRUE );                  01706110
         PRT ~ GET(I).ADDR;                                             01707000
              IF LNK ~ GET(I+2).SIZE = 0 THEN GO TO XIT ;               01708000
         IF (OWNID ~ PRT < 1536 AND DATAPRT ! 0) THEN                   01708100
    BEGIN                                                               01708200
         EMITOPDCLIT(DATAPRT); EMITO(LNG);                              01708300
         EMITB(-1, TRUE); X ~ LAX;                                      01708400
    END;                                                                01708500
         EMITO(MKS);                                                    01709000
         EMITDESCLIT(PRT);   % STACK OR PRT ADDRESS                     01710000
         IF LNK { 1023 THEN                                             01711000
    BEGIN                                                               01712000
         IF OWNID THEN EMITL(0);       % LOWER BOUND                    01712100
         EMITL(LNK);    % ARRAY SIZE                                    01713000
         EMITL(1);      % ONE DIMENSION                                 01714000
    END                                                                 01715000
         ELSE                                                           01716000
    BEGIN                                                               01717000
         J ~ (LNK + 255) DIV 256;                                       01718000
         LNK := 256;   %INCLUDE ENTIRE ARRAY SIZE IN ESTIMATE      %512-01719000
         IF OWNID THEN EMITL(0);       % FIRST LOWER BOUND              01719100
         EMITL(J);      % NUMBER OF ROWS                                01720000
         IF OWNID THEN EMITL(0);       % SECOND LOWER BOUND             01720100
         EMITL(256);    % SIZE OF EACH ROW                              01721000
         EMITL(2);      % TWO DIMENSIONS                                01722000
    END;                                                                01723000
         EMITL(1);      % ONE ARRAY                                     01724000
         EMITL(IF OWNID THEN 2 ELSE 0);  %OWN OR LOCAL                  01725000
         EMITOPDCLIT(5); % CALL BLOCK                                   01726000
         ARYSZ ~ ARYSZ + J + LNK;                                       01727000
         IF NOT(F2TOG OR OWNID) THEN                                    01728000
    BEGIN                                                               01729000
         F2TOG ~ TRUE;                                                  01730000
         EMITL(1);                                                      01731000
         EMITPAIR(FPLUS2,STD);%        F+2~TRUE                         01732000
    END;                                                                01733000
         IF OWNID THEN FIXB(X);                                         01733100
              XIT:                                                      01733105
IF DEBUGTOG THEN FLAGROUTINE("  ARRA","YDEC  ",FALSE) ;                 01733200
    END ARRAYDEC;                                                       01734000
REAL PROCEDURE SEARCH(E); VALUE E; REAL E;                              01735000
BEGIN REAL T; LABEL XIT;                                                01736000
   T ~ STACKHEAD[E MOD SHX];                                            01737000
   WHILE T ! 0 DO                                                       01738000
      IF INFO[(T+1).IR,(T+1).IC] = E THEN GO TO XIT                     01739000
      ELSE T ~ INFO[T.IR,T.IC].LINK;                                    01740000
   XIT: SEARCH ~ T;                                                     01741000
END SEARCH;                                                             01742000
INTEGER PROCEDURE GLOBALSEARCH(E); VALUE E; REAL E;                     01743000
BEGIN REAL T; LABEL XIT;                                                01744000
   T ~ GLOBALSTACKHEAD[E MOD GHX];                                      01745000
   WHILE T ! 0 DO                                                       01746000
      IF INFO[(T+1).IR,(T+1).IC] = E THEN GO TO XIT                     01747000
      ELSE T ~ INFO[T.IR,T.IC].LINK;                                    01748000
   XIT: GLOBALSEARCH ~ T;                                               01749000
END GLOBALSEARCH;                                                       01750000
PROCEDURE PURGEINFO;                                                    01751000
BEGIN REAL J;                                                           01752000
   FLAG(13);                                                            01753000
   FOR J ~ 0 STEP 1 UNTIL SHX DO STACKHEAD[J] ~ 0;                      01754000
   NEXTINFO ~ 2;                                                        01755000
   NEXTCOM ~ 0;                                                         01756000
   END;                                                                 01757000
INTEGER PROCEDURE ENTER(W, E); VALUE W, E; ALPHA W, E;                  01758000
BEGIN REAL J;                                                           01759000
   IF GLOBALNEXTINFO { NEXTINFO THEN PURGEINFO;                         01760000
   W.LINK ~ STACKHEAD[J ~ E MOD SHX];                                   01761000
   STACKHEAD[J] ~ ENTER ~ J ~ NEXTINFO;                                 01762000
   INFO[J.IR,J.IC] ~ W;                                                 01763000
   INFO[(J~J+1).IR,J.IC] ~ E;                                           01764000
   INFO[(J~J+1).IR,J.IC] ~ 0;                                           01765000
   NEXTINFO ~ NEXTINFO + 3;                                             01766000
END ENTER;                                                              01767000
INTEGER PROCEDURE GLOBALENTER(W, E); VALUE W, E; ALPHA W, E;            01768000
BEGIN REAL J;                                                           01769000
   IF GLOBALNEXTINFO { NEXTINFO THEN PURGEINFO;                         01770000
   W.LINK ~ GLOBALSTACKHEAD[J ~ E MOD GHX];                             01771000
   GLOBALSTACKHEAD[J] ~ GLOBALENTER ~ J ~ GLOBALNEXTINFO;               01772000
   INFO[J.IR,J.IC] ~ W;                                                 01773000
   INFO[(J~J+1).IR,J.IC] ~ E;                                           01774000
   INFO[(J~J+1).IR,J.IC] ~ 0;                                           01775000
   GLOBALNEXTINFO ~ GLOBALNEXTINFO - 3;                                 01776000
END GLOBALENTER;                                                        01777000
PROCEDURE LABELBRANCH(K, C); VALUE K, C; REAL K; BOOLEAN C;             01778000
BEGIN REAL TS,T,I,X;                                                    01779000
DEFINE LABL = K#;                                                       01780000
COMMENT LABELBRANCH GENERATES A "LITC ..." AND "BRANCH" FROM THE        01781000
CURRENT ADDRESS TO LABEL K.   IF THE BOOLEAN C IS TRUE                  01782000
THE BRANCH IS CONDITIONAL.  IF THE LABEL HAS NOT BEEN ENCOUNTERED       01783000
THEN THE APPROPRIATE LINKAGE IS MADE;                                   01784000
   LABEL XIT;                                                           01785000
    IF ADR } 4086 THEN                                                  01786000
   BEGIN ADR ~ ADR+1; SEGOVF END;                                       01787000
   IF LABL ~ LBLSHFT(XTA~LABL) { 0 OR LABL = BLANKS THEN                01788000
   BEGIN FLAG(135); GO TO XIT END;                                      01789000
   IF T ~ SEARCH(LABL) ! 0 THEN                                         01790000
   BEGIN TS ~ (I ~ GET(T)).ADDR;                                        01791000
      IF I.CLASS ! LABELID THEN BEGIN FLAG(144); GO TO XIT END;         01791100
      IF I > 0 THEN                                                     01792000
         BEGIN EMITLINK(TS);                                            01793000
               EMITO(IF C THEN BFC ELSE BFW);                           01794000
            PUT(T,I&(ADR-1)[TOADDR]);                                   01795000
               EMITO(NOP);                                              01795100
         END ELSE                                                       01796000
         IF I.SEGNO = NSEG THEN EMITB(TS, C) ELSE                       01799000
    BEGIN IF TS~(X~GET(T+2)).BASE = 0 THEN                              01800000
       X.BASE ~ TS ~ PRGDESCBLDR(2,0,(I.ADDR).[36:10],I.SEGNO);         01801000
       PUT(T+2,X);                                                      01802000
       EMITOPDCLIT(TS);                                                 01803000
       EMITO(IF C THEN BFC ELSE BFW);                                   01804000
    END;                                                                01805000
END ELSE                                                                01806000
    BEGIN                                                               01807000
       IF ADR < 0 THEN EMITO(NOP);                                      01808000
       EMITLINK(0);                                                     01809000
          EMITO( IF C THEN BFC ELSE BFW);                               01810000
          T ~ ENTER(0 & LABELID[TOCLASS] & (ADR-1)[TOADDR], LABL);      01811000
          EMITO(NOP);                                                   01811100
    END;                                                                01812000
    IF XREF THEN ENTERX(LABL,0&LABELID[TOCLASS]);                       01812100
    XIT:                                                                01813000
END LABELBRANCH;                                                        01814000
PROCEDURE DATASET;       % SCANS CONSTANTS IN BLOCK DATA                01815000
    BEGIN                                                               01816000
         REAL LST,CUR,LTYP,CTYP,SIZ,RPT;                                01817000
         REAL CUD;                                                      01818000
         BOOLEAN SGN;                                                   01819000
                                                                        01820000
                                                                        01821000
         DEFINE TYP = GLOBALNEXT#,                                      01822000
                TYPC = 18:33:15#;                                       01823000
         LABEL XIT,ERROR,DPP,SPP,CPP,COMM,S;                            01824000
IF DEBUGTOG THEN FLAGROUTINE("  DATA","SET   ",TRUE) ;                  01825000
         DATATOG ~ TRUE; FILETOG ~ TRUE;                                01826000
         SCAN;                                                          01827000
         LSTS ~ -1; LTYP ~77;                                           01828000
    S:   IF TYP = PLUS OR (SGN ~ TYP = MINUS ) THEN SCAN;               01829000
         IF TYP = NUM THEN                                              01830000
    BEGIN                                                               01831000
         IF NUMTYPE = STRINGTYPE AND STRINGSIZE > 1 THEN                01832000
    BEGIN                                                               01833000
         IF LTYP ! 77 THEN                                              01834000
              BEGIN  % NOT FIRST ENTRY-PUSH DOWN PRIOR NUMBER           01835000
                   IF LSTS+2 > LSTMAX THEN                              01836000
                   BEGIN FLAG(127); GO TO ERROR END;                    01837000
                   LSTT[LSTS~LSTS+1] ~ RPT&LTYP[TYPC];                  01838000
                   LSTT[LSTS~LSTS+1] ~ LST;                             01839000
                   LTYP ~ 77;                                           01840000
              END;                                                      01841000
                                                                        01841100
         IF LSTS + STRINGSIZE > LSTMAX THEN                             01842000
         BEGIN FLAG(127); GO TO ERROR END;                              01843000
                   LSTT[LSTS~LSTS+1] ~ STRINGSIZE & STRINGTYPE[TYPC]    01844000
                                          & SIZ[3:33:15];               01844100
                   MOVEW(STRINGARRAY,LSTT[LSTS~LSTS+1],                 01845000
                         STRINGSIZE.[36:6],STRINGSIZE);                 01846000
         LSTS ~ LSTS + STRINGSIZE -1;                                   01846100
         SCAN;                                                          01847000
         GO TO COMM;                                                    01848000
    END;                                                                01849000
              % GOT NUMBER                                              01850000
         IF NUMTYPE = STRINGTYPE THEN                                   01851000
    BEGIN                                                               01851100
         FNEXT ~ STRINGARRAY[0];                                        01851200
         NUMTYPE ~ INTYPE;                                              01851300
         IF SIZ = 0 THEN SIZ ~ 1;                                       01851400
    END;                                                                01851500
         CUR ~ IF SGN THEN -FNEXT ELSE FNEXT;                           01852000
         CTYP ~ NUMTYPE; CUD ~ DBLOW;                                   01853000
                                                                        01854000
         SCAN;                                                          01855000
         IF TYP = COMMA OR TYP = SLASH THEN                             01856000
    BEGIN                                                               01857000
         IF SIZ = 0 THEN SIZ ~ 1;                                       01857100
         IF CTYP = DOUBTYPE THEN                                        01858000
    BEGIN                                                               01859000
    DPP: IF LTYP ! 77 THEN                                              01860000
              BEGIN                                                     01861000
                   IF LSTS+2 > LSTMAX THEN                              01862000
                   BEGIN FLAG(127); GO TO ERROR END;                    01863000
                   LSTT[LSTS~LSTS+1] ~ RPT&LTYP[TYPC];                  01864000
                   LSTT[LSTS~LSTS+1] ~ LST;                             01865000
                   LTYP ~ 77;                                           01866000
              END;                                                      01867000
          IF LSTS+3 > LSTMAX THEN BEGIN FLAG(127); GO TO ERROR END;     01868000
          LSTT[LSTS~LSTS+1] ~ SIZ&DOUBTYPE[TYPC];                       01869000
          LSTT[LSTS~LSTS+1] ~ CUR;                                      01870000
          LSTT[LSTS~LSTS+1] ~ CUD;                                      01871000
          GO TO COMM;                                                   01872000
     END;                                                               01873000
               % SINGLE PRECISION                                       01874000
     SPP:                                                               01875000
          IF LTYP = 77 THEN                                             01876000
               BEGIN                                                    01877000
                    LST ~ CUR;                                          01878000
                    LTYP ~ CTYP;                                        01879000
                    RPT ~ SIZ;                                          01880000
                    GO TO COMM;                                         01881000
               END;                                                     01882000
          IF LTYP = CTYP THEN                                           01883000
          IF REAL(BOOLEAN(CUR) EQV BOOLEAN(LST)) = REAL(NOT FALSE) THEN 01883100
               BEGIN                                                    01884000
                    RPT ~ RPT + SIZ;                                    01885000
                    GO TO COMM;                                         01886000
               END;                                                     01887000
          IF LSTS+2 > LSTMAX THEN BEGIN FLAG(127); GO TO ERROR END;     01888000
          LSTT[LSTS~LSTS+1] ~ RPT&LTYP[TYPC];                           01889000
          LSTT[LSTS~LSTS+1] ~ LST;                                      01890000
          RPT ~ SIZ;                                                    01891000
          LST ~ CUR; LTYP ~ CTYP;                                       01892000
          GO TO COMM;                                                   01893000
     END;                                                               01894000
               % TYP ! COMMA - CHECK FOR *                              01895000
          IF TYP ! STAR THEN BEGIN FLAG(125); GO TO ERROR END;          01896000
          IF CTYP ! INTYPE THEN BEGIN FLAG(113); GO TO ERROR END;       01897000
          IF SIZ ! 0 OR SIZ ~ CUR { 0 THEN                              01898000
          BEGIN FLAG(64); GO TO ERROR END;                              01899000
          SCAN; GO TO S;                                                01900000
     END;                                                               01912000
               % TYP ! NUM AT LABEL S                                   01913000
          IF SIZ = 0 THEN SIZ ~ 1;                                      01913050
          IF NAME = "T     " OR NAME = "F     " THEN                    01913100
          BEGIN                                                         01913200
               CUR ~ REAL(NAME = "T     ");                             01913300
               CTYP ~ LOGTYPE;                                          01913400
               SCAN; GO TO SPP;                                         01913500
          END;                                                          01913600
               IF TYP ! LPAREN THEN BEGIN FLAG(64); GO TO ERROR END;    01914000
                                                                        01915000
          CPP:      % COMPLEX                                           01916000
               IF LTYP ! 77 THEN                                        01917000
                    BEGIN                                               01918000
                         IF LSTS+2 > LSTMAX THEN                        01919000
                         BEGIN FLAG(127); GO TO ERROR END;              01920000
                         LSTT[LSTS~LSTS+1] ~ RPT&LTYP[TYPC];            01921000
                         LSTT[LSTS~LSTS+1] ~ LST;                       01922000
                         LTYP ~ 77;                                     01923000
                    END;                                                01924000
               SCAN;                                                    01925000
               IF TYP = PLUS OR (SGN~TYP=MINUS) THEN SCAN;              01926000
               IF TYP ! NUM OR NUMTYPE > REALTYPE THEN                  01927000
               BEGIN FLAG(64); GO TO ERROR END;                         01928000
               IF LSTS+2 > LSTMAX THEN BEGIN FLAG(127); GO TO ERROR END;01929000
               LSTT[LSTS~LSTS+1] ~ SIZ&COMPTYPE[TYPC];                  01930000
               LSTT[LSTS~LSTS+1] ~ IF SGN THEN -FNEXT ELSE FNEXT;       01931000
               SCAN;                                                    01932000
               IF TYP ! COMMA THEN BEGIN FLAG(114); GO TO ERROR END;    01933000
               SCAN;                                                    01934000
               IF TYP = PLUS OR (SGN ~ TYP = MINUS) THEN SCAN;          01935000
               IF TYP ! NUM OR NUMTYPE > REALTYPE THEN                  01936000
               BEGIN FLAG(64); GO TO ERROR END;                         01937000
               LSTT[LSTS~LSTS+1]~IF SGN THEN - FNEXT ELSE FNEXT ;       01938000
               SCAN;                                                    01939000
               IF TYP ! RPAREN THEN BEGIN FLAG(108); GO TO ERROR END;   01940000
               SCAN;                                                    01941000
          COMM:                                                         01942000
               SIZ ~ 0;                                                 01942100
               IF TYP = COMMA THEN BEGIN SCAN; GO TO S; END;            01943000
               IF TYP = SLASH THEN GO TO XIT;                           01944000
               FLAG(126);                                               01945000
          ERROR:                                                        01946000
               LSTS ~ 0;                                                01947000
               WHILE TYP ! COMMA AND TYP ! SLASH AND TYP ! SEMI DO SCAN;01948000
               IF TYP = COMMA THEN GO TO COMM;                          01949000
          XIT:                                                          01950000
               IF LTYP ! 77 THEN                                        01951000
                    BEGIN                                               01952000
                      IF LSTS+2>LSTMAX THEN BEGIN FLAG(127); LSTS~0 END;01953000
                         LSTT[LSTS~LSTS+1] ~ RPT&LTYP[TYPC];            01954000
                         LSTT[LSTS~LSTS+1] ~ LST;                       01955000
                    END;                                                01956000
               IF LSTS+1 > LSTMAX THEN BEGIN FLAG(127); LSTS~0 END;     01957000
               LSTT[LSTS~LSTS+1]~0;                                     01958000
IF DEBUGTOG THEN FLAGROUTINE("  DATA","SET   ",FALSE);                  01959000
               DATATOG ~ FALSE; FILETOG ~ FALSE;                        01960000
END DATASET;                                                            01961000
ALPHA PROCEDURE CHECKDO;                                                01962000
BEGIN ALPHA X, T; INTEGER N;                                            01963000
STREAM PROCEDURE CKDO(A, ID, LAB);                                      01964000
BEGIN                                                                   01965000
   SI ~ A; SI ~ SI+4; DI ~ LAB; DI ~ DI+2;                              01966000
   5(IF SC } "0" THEN DS ~ CHR ELSE JUMP OUT);                          01967000
   DI ~ ID; DI ~ DI+2;                                                  01968000
   6(IF SC = ALPHA THEN DS ~ CHR ELSE JUMP OUT);                        01969000
END CKDO;                                                               01970000
   IF (XTA~HOLDID[0]).[12:24] = "FILE" THEN FLOG(37) ELSE               01971000
         IF XTA.[12:12] ! "DO" THEN FLOG(17) ELSE                       01971010
   BEGIN                                                                01972000
      X ~ T ~ BLANKS;                                                   01973000
      CKDO(HOLDID[0], X, T);                                            01974000
         IF X=BLANKS THEN FLOG(105);                                    01974500
      IF T ~ LBLSHFT(T) < 0 OR T = BLANKS THEN FLOG(17) ELSE            01975000
      TEST ~ NEED(T, LABELID);                                          01976000
      DOLAB[DT]~ T;                                                     01977000
      IF XREF THEN ENTERX(T,0&LABELID[TOCLASS]);                        01977100
         IF GET(TEST) < 0 THEN   %  TEST FOR PREV DEFINITION            01978000
      BEGIN                                                             01979000
         XTA ~ GET(TEST+1);                                             01980000
         FLAG(15);                                                      01981000
         DT ~ DT-1;                                                     01982000
      END;                                                              01983000
      IF N ~ SEARCH(X) = 0 THEN                                         01984000
      N~ENTER(TIPE[IF T~X.[12:6]!"0" THEN T ELSE 12],X);                01985000
      CHECKDO ~ GETSPACE(N);                                            01987000
      IF XREF THEN ENTERX(X,1&GET(N) [15:15:9]);                        01987100
      IF (X~GET(N)).SUBCLASS > REALTYPE OR X.CLASS ! VARID THEN         01988000
      BEGIN XTA ~ GET(N+1); FLAG(84) END;                               01989000
      IF GET(FX1).CLASS = UNKNOWN THEN PUT(FX1+1, "......");            01990000
   END;                                                                 01991000
END CHECKDO;                                                            01992000
PROCEDURE FIXB(N); VALUE N; REAL N;                                     01993000
BEGIN                                                                   01994000
   REAL T, U, FROM;                                                     01995000
   LABEL XIT, BIGJ;                                                     01996000
IF DEBUGTOG THEN FLAGROUTINE("    FI","XB    ",TRUE);                   01996010
   IF N } 10000 THEN FROM ~ N-10000 ELSE                                01997000
   IF FROM ~ - BRANCHES[N] > 4095 THEN                                  01998000
   BEGIN                                                                01999000
      ADJUST;                                                           02000000
      T ~ PRGDESCBLDR(2, FROM.LINK, (ADR+1).[36:10], NSEG);             02001000
      GO TO XIT;                                                        02002000
   END;                                                                 02003000
T ~ ADR;   ADR ~ FROM - 1;                                              02004000
IF (T + 1).[46:2] = 0 THEN GO TO BIGJ;                                  02005000
IF (U ~ T - 2 - ADR) { 1023 THEN EMITL(U) ELSE                          02006000
BEGIN ADR ~ T;   ADJUST;  T ~ ADR;  ADR ~ FROM - 1;                     02007000
BIGJ: EMITL((T+1).[36:10] - (ADR+2).[36:10]);                           02008000
      EMITO(IF BOOLEAN(GIT(FROM + 1).[36:1]) THEN GFW ELSE GFC);        02009000
END;                                                                    02010000
ADR ~ T;                                                                02011000
   XIT:                                                                 02012000
   IF N < 10000 THEN BEGIN                                              02013000
   BRANCHES[N] ~ BRANCHX;                                               02014000
   BRANCHX ~ N;                                                         02015000
   END;                                                                 02016000
IF DEBUGTOG THEN FLAGROUTINE("    FI","XB    ",FALSE);                  02016010
END FIXB;                                                               02017000
PROCEDURE DATIME;            % PRODUCES HEADING LINE FOR LISTING.       02018000
    BEGIN                                                               02019000
    INTEGER D;                                                          02020000
   FORMAT T(X9,"B 5 7 0 0    F O R T R A N    C O M P I L A T I O N   ",02021000
"XVI.0"                                                                 02022000
           ,".",A2,".",A8,"DAY, ",2(A2,"/"),A2,",",A2,":",A2," H."/);   02022500
    WRITALIST(T,7,                                                      02024000
     "16"                                                          %999-02025000
              ,TIME(6),(D~TIME(5)).[12:12],D.[24:12],D.[36:12],         02026000
            D~(D~RTI DIV 216000) MOD 10+D DIV 10|64,                    02027000
            D~(D~RTI DIV 3600 MOD 60) MOD 10+D DIV 10|64,0) ;           02028000
    IF D~LINE.TYPE=10 OR D=12 OR D=13 THEN                              02029000
         BEGIN                                                          02030000
         LOCK(LINE);  LINE.AREAS~0;  LINE.AREASIZE~0 ;                  02031000
         IF D ! 12 THEN LINE.TYPE~12;  SPACE(LINE,2) ;                  02032000
         END;                                                           02033000
    FIRSTCALL~FALSE ;                                                   02034000
    END DATIME;                                                         02039000
PROCEDURE PRINTCARD;                                                    02040000
BEGIN                                                                   02041000
   STREAM PROCEDURE MOVE(P, Q, A); VALUE A, Q;                          02042000
   BEGIN                                                                02043000
      SI ~ Q; DI ~ P;                                                   02044000
      DS ~ CHR;                                                         02045000
      DI ~ DI+11; SI ~ LOC A;                                           02046000
      DS ~ 4 DEC;                                                       02047000
   END MOVE;                                                            02048000
   STREAM PROCEDURE MOVEBACK(P);                                        02049000
   BEGIN DI ~ P; DS ~ LIT "]" END;                                      02050000
    MOVE (CRD[9],BUFL,(ADR+1).[36:10]);                                 02051000
   IF FIRSTCALL THEN DATIME;                                            02052000
   IF UNPRINTED THEN WRITAROW(15,CRD) ;                                 02053000
    MOVEBACK(CRD[9]);                                                   02054000
    IF SEQERRORS THEN WRITAROW(14,ERRORBUFF) ;                          02054010
END PRINTCARD;                                                          02055000
BOOLEAN PROCEDURE READACARD; FORWARD;                                   02056000
PROCEDURE FILEOPTION;  FORWARD;                                         02058000
BOOLEAN PROCEDURE LABELR;                                               02059000
BEGIN                                                                   02060000
LABEL XIT, LOOP;                                                        02061000
                                                                        02062000
BOOLEAN STREAM PROCEDURE CHECK(CD, LAB);                                02063000
BEGIN LABEL XIT; LOCAL T1;                                              02064000
   SI ~ CD;                                                             02065000
   IF SC ! " " THEN IF SC < "0" THEN                                    02066000
         BEGIN DI ~ LAB;   DI ~ DI + 2;                                 02067000
               DS ~ 6 CHR;  GO TO XIT;                                  02068000
         END;                                                           02069000
   DI ~LOC T1; DS ~ 6 LIT " "; DI ~ DI - 6;                             02070000
   5(IF SC } "0" THEN DS ~ CHR ELSE SI ~ SI+1);                         02071000
   DI ~LAB; DI ~DI + 2; SI ~ LOC T1;                                    02072000
    5(IF SC ! "0" THEN JUMP OUT; SI ~ SI + 1);                          02073000
   5(IF SC } "0" THEN DS ~ CHR ELSE JUMP OUT);                          02074000
   TALLY ~ 1;                                                           02075000
   XIT: CHECK ~ TALLY;                                                  02076000
END CHECK;                                                              02077000
BOOLEAN STREAM PROCEDURE BLANKCARD(CD);                                 02077100
BEGIN   LABEL XIT;                                                      02077200
   SI ~ CD;                                                             02077300
   2(36( IF SC ! " " THEN JUMP OUT 2 TO XIT ELSE SI ~ SI + 1));         02077400
   TALLY ~ 1;                                                           02077600
   XIT: BLANKCARD ~ TALLY;                                              02077700
END BLANKCARD;                                                          02077800
   LOOP:                                                                02078000
   LABL ~ BLANKS;                                                       02079000
   IF LABELR ~ NOT READACARD THEN GO TO XIT;                            02080000
      IF NOT CHECK(CRD[0],LABL) THEN                                    02081000
   BEGIN IF LABL = "FILE  " THEN FILEOPTION ELSE                        02082000
      BEGIN IF LISTOG THEN PRINTCARD;                                   02083000
         IF (XTA ~ LABL).[12:6] ! "C" THEN FLAG(135);                   02083100
      END;                                                              02083200
      GO TO LOOP;                                                       02084000
   END;                                                                 02085000
   IF ENDSEGTOG THEN IF BLANKCARD(CRD) THEN                             02086000
      BEGIN IF LISTOG THEN PRINTCARD;  GO TO LOOP END ELSE              02086500
   BEGIN SEGMENTSTART;                                                  02087000
     IF LISTOG THEN PRINTCARD;                                          02088000
     IF LABL = BLANKS THEN GO TO XIT;                                   02089000
   END ELSE                                                             02090000
   BEGIN                                                                00091000
         IF LABL = BLANKS THEN                                          02092000
          BEGIN IF LISTOG THEN PRINTCARD; GO TO XIT END;                02093000
         IF ADR > 0 THEN ADJUST;                                        02094000
         IF LISTOG THEN PRINTCARD;                                      02095000
   END;                                                                 02096000
   XIT:                                                                 02116000
END LABELR;                                                             02117000
PROCEDURE FILEOPTION;                                                   02118000
BEGIN COMMENT  THIS PROCEDURE PROCESSES THE OPTIONAL FILE CONTROL CARD. 02119000
THE WORD "FILE" APPEARS IN COL. 1 - 4.  COL. 5 AND 6 ARE BLANK.         02120000
#1 BELOW IS REQUIRED, OTHER ENTRIES MAY BE AS SPARSE AS DESIRED.        02121000
1. FILE  <NUM> = <MULTI-FILE ID> / <FILE ID>                            02122000
               OR                                                       02123000
   FILE  <NUM> = <FILE ID>                                              02124000
      THE FOLLOWING "/" IS A DOCUMMENTARY OR.                           02125000
      THE SEQUENCE OF RESERVED WORDS MUST BE MAINTAINED.                02126000
2. UNIT=PRINT/READER/PUNCH/DISK/TAPE7/TAPE9/REMOTE   (UNIT DESIGNATE).  02127000
3. UNLABELED     (FOR UNLABELED TAPES)                                  02128000
4. ALPHA     (FOR ALPHA RECORDING MODE)                                 02129000
5. BCL     (IGNORED,    FOR 3500 USE)                                   02130000
6. FIXED   (IGNORED,    FOR 3500 USE)                                   02131000
7. SAVE = <NUM>     (SAVE FACTOR IN DAYS)                               02132000
8. LOCK     (LOCK FILE AT EOJ)                                          02133000
9. RANDOM/SERIAL/UPDATE     (DISK USE)                                  02134000
10. AREA = <NUM>     (DISK RECORDS/ROW)                                 02135000
11. BLOCKING = <NUM>     (RECORD PER BLOCK)                             02136000
12. RECORD = <NUM>     (RECORD SIZE)                                    02137000
13. BUFFER = <NUM>     (# OF BUFFERS)                                   02138000
14. WORKAREA      (IGNORED, FOR 3500)  ;                                02139000
ALPHA P,KEEP;   BOOLEAN TOG,CA,TS;   LABEL XIT;                         02140000
COMMENT   INXFIL = INFC.ADINFO,  MULTI FILE ID = FILEINFO[1,INXFIL],    02141000
       FILE ID = FILEINFO[2,INXFIL],  DISK RECORDS = FILEINFO[3,INXFIL],02142000
       FILEINFO[0,INXFIL] FROM RIGHT TO LEFT IS;                        02143000
INTEGER  %  NAME           USE                            BITS          02144000
            BUFF,       %  # BUFFERS                        6           02145000
            RECORD,     %  RECORD SIZE                     12           02146000
            BLOCK,      %  BLOCK SIZE                      12           02147000
            SAVER,      %  SAVE FACTOR                     12           02148000
            SPIN,       %  REW & LOCK @ EOJ                 2           02149000
            ALPH;       %  RECORDING MODE                   1           02150000
PROCEDURE FETCH;                                                        02151000
BEGIN SCAN;  XTA ~ SYMBOL;                                              02152000
      IF NEXT=COMMA OR NEXT=MINUS THEN                                  02153000
      BEGIN SCAN;  XTA ~ SYMBOL;                                        02154000
            IF NEXT ! ID THEN  FLOG(37);                                02155000
      END;                                                              02156000
END FETCH;                                                              02157000
INTEGER STREAM PROCEDURE MAKEINT(XTA);                                  02158000
BEGIN LABEL LOOP;  LOCAL T;                                             02159000
SI ~ XTA;  SI ~ SI + 2;                                                 02160000
LOOP:  IF SC } "0" THEN                                                 02161000
     BEGIN TALLY ~ TALLY + 1;  SI ~ SI + 1; GO TO LOOP END;             02162000
T ~ TALLY; SI ~ XTA;  SI ~ SI + 2;  DI ~ LOC MAKEINT;  DS ~ T OCT;      02163000
END MAKEINT;                                                            02164000
INTEGER PROCEDURE REPLACEMENT;                                          02165000
BEGIN                                                                   02166000
FETCH;   IF NEXT = EQUAL THEN                                           02167000
BEGIN FETCH;  IF XTA.[12:6] { 11 THEN BEGIN REPLACEMENT ~ MAKEINT(XTA); 02168000
      FETCH END ELSE FLOG(37);                                          02169000
END ELSE FLOG(37);                                                      02170000
END REPLACEMENT;                                                        02171000
INTEGER STREAM PROCEDURE SRI7(S);                                       02172000
BEGIN SI ~ S;  DI ~ LOC SRI7;                                           02173000
      SI ~ SI + 2;  DI ~ DI + 1;     DS ~ 7 CHR;                        02174000
END SRI7;                                                               02175000
COMMENT * * * * * START OF CODE * * * * ;                               02176000
IF DEBUGTOG THEN FLAGROUTINE(" FILEO","PTION ", TRUE);                  02176010
ERRORTOG ~ FALSE;                                                       02176100
IF LISTOG THEN PRINTCARD;                                               02177000
XTA ~ "FILE  ";                                                         02178000
IF NSEG ! 0 THEN FLAG(60);                                              02179000
IF INXFIL ~ INXFIL + 1 > MAXOPFILES THEN                                02180000
BEGIN FLAG(59); GO TO XIT END;                                          02181000
BUMPPRT;                                                                02182000
MAXFILES ~ MAXFILES + 1;                                                02183000
FILETOG ~ TRUE;  SCN ~ 1;   %  START SCAN MAINTAINENCE                  02184000
FETCH;  IF XTA.[12:6] > 11 THEN BEGIN FLAG(37);  GO TO XIT END;         02185000
     IF XTA.[12:6] = 0 THEN BEGIN FLOG(037);  GO TO XIT END;            02185010
IF T ~ GLOBALSEARCH(P ~ 0&"."[12:42:6]&XTA[18:12:30]) ! 0 THEN FLAG(20) 02186000
ELSE BEGIN P~ GLOBALENTER(-0&PRTS[TOADDR]&FILEID[TOCLASS],P);           02187000
           PUT(P+2,GET(P+2)&INXFIL[TOADINFO]);                          02188000
           IF XREF THEN ENTERX(XTA &1[TOCE],1&FILEID[TOCLASS]);         02188100
     END;                                                               02189000
INFC ~ GET(P + 2);                                                      02190000
FETCH;   IF NEXT = EQUAL THEN FETCH ELSE                                02191000
   BEGIN FLOG(37);  GO TO XIT;  END;                                    02192000
IF NEXT = SEMI THEN                                                     02193000
BEGIN FLAG(37); GO TO XIT END                                           02194000
    ELSE FILEINFO[2,INXFIL] ~ SRI7(ACCUM[1]);                           02195000
FETCH;   IF NEXT = SLASH THEN                                           02196000
      BEGIN FILEINFO[1,INXFIL] ~ FILEINFO[2,INXFIL];   %  MULTI FILE ID 02197000
            FETCH;                                                      02198000
            IF NEXT = SEMI THEN BEGIN FLAG(37);   GO TO XIT;  END       02199000
                 ELSE FILEINFO[2,INXFIL] ~ SRI7(ACCUM[1]);              02200000
            FETCH;                                                      02201000
      END;                                                              02202000
IF XTA = "UNIT  " THEN                                                  02203000
BEGIN                                                                   02204000
   FETCH;                                                               02205000
   IF NEXT = EQUAL THEN FETCH ELSE FLOG(37);                            02206000
      INFC.LINK ~ KEEP ~ (IF TOG ~ XTA = "PRINT "                       02207000
                                OR XTA = "PRINTE" THEN 18 ELSE          02208000
                     IF CA ~ TOG ~ XTA = "READ  "                       02209000
                                OR XTA = "READER" THEN 2 ELSE           02210000
                     IF CA ~ TOG ~ XTA = "PUNCH " THEN 0 ELSE           02211000
                          IF TOG ~ XTA = "DISK  " THEN 12 ELSE          02212000
                          IF TOG ~ XTA = "TAPE  "                       02213000
                                OR XTA = "TAPE7 " THEN 2 ELSE           02214000
                               IF TOG ~ XTA = "PAPER " THEN 8 ELSE      02214100
                     IF CA ~TOG~XTA= "REMOTE" THEN 19 ELSE              02214500
                          IF TOG ~ XTA = "TAPE9 " THEN 2 ELSE 2);       02215000
   IF TOG THEN FETCH ELSE FLOG(37)                                      02216000
END ELSE INFC.LINK~KEEP~IF DCINPUT THEN 12 ELSE 2 ;                     02217000
TS~KEEP=12 ;                                                            02217050
IF XTA="BACKUP" THEN                                                    02217100
    BEGIN                                                               02217150
    FETCH;  IF KEEP!0 AND KEEP!18 THEN FLAG(37);                        02217200
    IF TOG~XTA="DISK  " THEN KEEP~IF KEEP=0 THEN 22 ELSE 15             02217250
    ELSE IF TOG~XTA="TAPE  " THEN KEEP~IF KEEP=0 THEN 20 ELSE 6         02217275
         ELSE BEGIN                                                     02217300
              TOG~XTA="ALTERN";  KEEP~IF KEEP=0 THEN 25 ELSE 16 ;       02217350
              END;                                                      02217400
    IF TOG THEN FETCH;  INFC.LINK~KEEP ;                                02217450
    END ;                                                               02217500
IF XTA = "UNLABE" THEN  %   FOR UNLABELED TAPES                         02218000
      BEGIN IF KEEP = 2 THEN INFC   .LINK ~ 9; FETCH;  END;             02219000
IF XTA = "ALPHA " THEN FETCH ELSE IF KEEP = 2 THEN ALPH ~ 1;   %  MODE  02220000
IF XTA = "BCL   " THEN FETCH;   %  FOR B3500                            02221000
IF XTA = "FIXED " THEN FETCH;   %  FOR B3500                            02222000
IF XTA = "SAVE  " THEN SAVER ~ REPLACEMENT;                             02223000
IF XTA = "LOCK  " THEN BEGIN SPIN ~ 2; FETCH END;  %  REW & LOCK AT EOJ 02224000
      IF TOG ~ XTA = "RANDOM" THEN T ~ 10 ELSE                          02225000
      IF TOG ~ XTA = "SERIAL" THEN T ~ 12 ELSE                          02226000
      IF TOG ~ XTA = "UPDATE" THEN T ~ 13;                              02227000
IF TOG THEN                                                             02228000
    BEGIN IF KEEP=12 THEN INFC.LINK~T ELSE FLAG(37); FETCH END;         02229000
IF XTA="AREA  " THEN                                                    02230000
    BEGIN                                                               02230010
    IF KEEP!12 THEN     FLAG(37);                                       02230020
    T~REPLACEMENT;                                                      02230030
    IF XTA="EU    " THEN                                                02230040
         IF I~REPLACEMENT>19 THEN FLAG(37)                              02230045
         ELSE T.EUNF~I+1;%             0 MEANS EU NOT SPECIFIED         02230050
    IF XTA="SPEED " THEN                                                02230060
         BEGIN                                                          02230070
         FETCH;                                                         02230080
         IF NEXT=EQUAL THEN                                             02230090
              BEGIN                                                     02230100
              FETCH;                                                    02230110
              IF XTA.[12:6]{SLOWV THEN                                  02230115
                   IF I~MAKEINT(XTA)>SLOWV THEN FLAG(37)                02230120
                   ELSE                                                 02230125
              ELSE IF XTA="FAST  " THEN           T.SPDF~FASTV          02230130
                   ELSE IF XTA="SLOW  " THEN      T.SPDF~SLOWV          02230140
                        ELSE FLOG(37);                                  02230150
              FETCH;                                                    02230160
              END                                                       02230170
         ELSE FLOG(37);                                                 02230180
         END;                                                           02230190
    IF XTA="SENSIT" THEN                                                02230200
         BEGIN                                                          02230210
         T.SENSE~1;                                                     02230220
         FETCH;                                                         02230230
         END;                                                           02230240
    FILEINFO[3,INXFIL]~T;                                               02230300
    END;                                                                02230400
IF XTA = "BLOCKI" THEN BLOCK ~ REPLACEMENT & 1[2:47:1];                 02231000
RECORD ~ IF XTA="RECORD" THEN REPLACEMENT ELSE IF CA THEN 10 ELSE IF TS 02232000
    AND NOT (BOOLEAN(BLOCK.[2:1])) THEN 10 & 1[2:47:1] ELSE 17;         02232010
BUFF   ~ IF XTA = "BUFFER" THEN REPLACEMENT ELSE 2;                     02233000
IF XTA = "WORKAR" THEN FETCH;  %  IGNORED, FOR 3500                     02234000
IF BUFF<1 OR BUFF>32 THEN BEGIN XTA~"BUFFER"; FLAG(152) END ;           02236000
IF RECORD<1 THEN BEGIN XTA~"RECORD"; FLAG(152)END ;                     02236010
IF SAVER>999 THEN BEGIN XTA~"SAVE  "; FLAG(152) END ;                   02236020
IF T~INFC.LINK=10 OR T=12 OR T=13 THEN %%% ARE IN DISK FILE             02237000
    BEGIN                                                               02237010
    IF BOOLEAN(RECORD.[2:1])THEN BLOCK ~ 300                            02237012
    ELSE                                                                02237015
         IF BLOCK~BLOCK|RECORD>1890 OR RECORD>1023 THEN                 02237020
              BEGIN XTA~"BK/REC"; FLAG(152)  END                        02237021
    END                                                                 02237030
ELSE IF BLOCK~BLOCK|RECORD>1023 OR RECORD>1023 THEN IF KEEP ! 2 THEN    02237040
    BEGIN XTA~"BK/REC"; FLAG(58 ) END ELSE BEGIN RECORD~257; BLOCK~0END;02237050
FILEINFO[0,INXFIL] ~ 0&BUFF[42:42:6]&RECORD[30:36:12]&BLOCK[18:36:12]   02238000
       &SAVER[6:36:12]&SPIN[4:46:2]&ALPH[3:47:1];                       02239000
XIT:  IF NEXT ! SEMI THEN                                               02240000
      BEGIN FLOG(37);  DO SCAN UNTIL NEXT = SEMI;  END;                 02241000
     FILETOG ~ FALSE;   %  END SCAN MAINTAINENCE                        02242000
      PUT(P+2,INFC);                                                    02243000
IF DEBUGTOG THEN FLAGROUTINE(" FILEO","PTION ",FALSE) ;                 02243100
END FILEOPTION;                                                         02244000
PROCEDURE DOLOPT;                                                       02245000
BEGIN                                                                   02245300
REAL STREAM PROCEDURE SCAN(BUF,ID); VALUE BUF;                          02245600
    BEGIN     LABEL     LP,LA,LE,XIT;                                   02245900
           SI ~ BUF; DI ~ ID; DS ~ 2 LIT "0";                           02246200
     LP:   IF SC = " " THEN BEGIN SI~SI+1; GO TO LP; END;               02246500
           IF SC = "," THEN BEGIN SI~SI+1; GO TO LP; END;               02246800
           IF SC = "+" THEN BEGIN DS~CHR; GO TO XIT; END;               02246900
           IF SC = "-" THEN BEGIN DS~CHR; GO TO XIT; END;               02247000
           IF SC < "A" THEN BEGIN DI ~ ID; DS ~ 8 LIT "+0000001";       02247100
LE:                               SI~SI+1;                              02247200
                                  GO TO XIT;                            02247400
                            END;                                        02247700
           IF SC="|" THEN    GO TO LE;%     THIS IS > "A"               02247800
           IF SC="!" THEN    GO TO LE;%     THIS IS > "A"               02247900
           6(IF SC = ALPHA THEN DS ~ CHR ELSE JUMP OUT);                02248000
      LA:  IF SC = ALPHA THEN BEGIN SI~SI+1; GO TO LA; END;             02248300
      XIT:                                                              02248600
           SCAN ~ SI;                                                   02248900
     END SCAN;                                                          02249200
REAL STREAM PROCEDURE GETVOID(BUF,VOIDSEQ,FR); VALUE BUF,FR;            02249500
     BEGIN LABEL L,LC,LD,LE,XIT; LOCAL TA;                              02249800
           SI ~ BUF; DI~VOIDSEQ; DS~8LIT" "; DI~VOIDSEQ;                02250100
     L:    IF SC = " " THEN BEGIN SI~SI+1; GO TO L;  END;               02250400
           TA ~ SI;                                                     02250500
           IF SC = """ THEN                                             02250700
           BEGIN 9(SI~SI+1;                                             02251000
                IF SC = """ THEN BEGIN SI~SI+1; JUMP OUT TO LC; END     02251300
                ELSE TALLY ~ TALLY + 1);                                02251600
                 TALLY~TALLY+63; SI~TA; SI~SI+1; GO TO LE;              02251900
           END;                                                         02252200
           IF SC < "0" THEN GO TO LD;                                   02252500
           DS:=8LIT"0";                                            %115-02252600
           8(SI:=SI+1; DI:=DI-1; TALLY:=TALLY+1;                   %115-02252800
             IF SC LSS "0" THEN JUMP OUT);                         %115-02252850
      LC:   SI ~ TA;                                                    02252900
      LE:  TA~TALLY; DS~TA CHR; GETVOID~SI; GO TO XIT;                  02253100
      LD:  GETVOID~SI;                                                  02253400
           FR(DS~8LIT"9");                                              02253700
     XIT:                                                               02254000
     END GETVOID;                                                       02254300
REAL STREAM PROCEDURE SEQNUM(BUF,VLU); VALUE BUF;                       02254600
     BEGIN LABEL L,LA,LC; LOCAL TA,TB;                                  02254900
           SI ~ BUF;                                                    02255200
     L:    IF SC = " " THEN BEGIN SI~SI+1; GO TO L; END;                02255500
           IF SC = "," THEN BEGIN SI~SI+1; GO TO L; END;                02255800
           TA ~ SI;                                                     02256100
           IF SC = "+" THEN                                             02256400
           BEGIN SI~SI+1;                                               02256700
     LA:         IF SC = " " THEN BEGIN SI~SI+1; GO TO LA;END;          02257400
                 TB ~ SI;                                               02257300
                 IF SC < "0" THEN BEGIN SI~TA; GO TO LC; END;           02257600
                 DI~TB;TA~DI;                                           02257900
           END;                                                         02258200
           8(IF SC < "0" THEN JUMP OUT TO LC;                           02258500
           TALLY~TALLY+1; SI~SI+1;);                                    02258800
     LC:   TB ~ TALLY; SEQNUM ~ SI;                                     02259100
           SI ~ TA; DI ~ VLU; DS ~ TB OCT;                              02259400
     END SEQNUM;                                                        02259700
REAL STREAM PROCEDURE MKABS(S);                                         02260000
     BEGIN SI ~ S; SI~SI+1; MKABS ~ SI;                                 02260300
           DI ~ S; 9(DI ~ DI + 8); DS ~ LIT "[";                        02260600
     END MKABS;                                                         02260900
STREAM PROCEDURE MOVEW(P,Q); VALUE Q;                                   02260925
BEGIN SI~P; DI ~ Q; DS~CHR; END   ;                                     02260950
    REAL BUF,ID;                                                        02261200
    BOOLEAN VAL, SAVELISTOG;                                       %511-02261500
    LABEL LP,SET,RESET;                                                 02261800
    FORMAT WARN(X18,A6," ILLEGAL CONSTRUCT ON DOLLAR CARD XXXX",X39,    02262100
               "WARNING");                                              02262400
    DEFINE GETID = BEGIN ID~ "      "; BUF ~ SCAN(BUF,ID) END#;         02262700
         SAVELISTOG ~ LISTOG;                                     %511- 02262775
         MOVEW(CRD[9],BUFL);                                            02262800
         BUF ~ MKABS(CRD[0]);                                           02263000
         GETID;                                                         02263300
         IF ID = "VOID  " THEN                                          02263600
            BEGIN BUF ~ GETVOID(BUF, VOIDSEQ,0); VOIDTOG ~ TRUE         02263900
            END ELSE                                                    02264200
         IF ID = "VOIDT " THEN                                          02264500
            BEGIN BUF ~ GETVOID(BUF, VOIDTSEQ,0); VOIDTTOG ~ TRUE       02264800
            END ELSE                                                    02265100
    BEGIN                                                               02265400
          TAPETOG.[47:1] ~ LASTMODE = 2;                           %517-02265700
         IF ID = "SET   " OR ID = "+     " THEN                         02267200
SET:        BEGIN GETID; VAL~ TRUE END                                  02267500
         ELSE                                                           02267800
         IF ID = "RESET " OR ID = "-     " THEN                         02268100
RESET:      BEGIN GETID; VAL ~ FALSE END                                02268400
         ELSE                                                           02268700
         BEGIN                                                          02269000
         TSSMESTOG ~ VAL; TSSEDITOG ~ VAL; CHECKTOG ~ VAL;         %501-02269300
         SINGLETOG~NOT VAL;  HOLTOG~VAL;                           %501-02269600
         LISTOG~VAL; CODETOG ~ DEBUGTOG ~ VAL; NEWTPTOG ~ VAL;          02269900
         PRTOG~VAL;  DOLIST~VAL;  LIBTAPE~VAL;  SEGPTOG~VAL;       %501-02270200
         LISTPTOG ~ VAL; FREEFTOG ~ XREF ~ VAL ;                        02270500
         VAL ~ TRUE;                                                    02270800
         END;                                                           02271100
LP:      IF ID > 0 THEN                                                 02271400
         BEGIN                                                          02271700
         IF ID = "TRACE " THEN                                          02272000
            BEGIN PRTOG~VAL; LISTOG~VAL; CODETOG~DEBUGTOG~VAL;          02272300
            END ELSE                                                    02272400
         IF ID = "CARD  " THEN                                          02272500
            BEGIN TAPETOG.[47:1]~NOT VAL; LASTMODE~2-REAL(VAL) END ELSE 02272510
         IF ID = "TAPE  " THEN                                          02272550
            BEGIN TAPETOG.[47:1] ~ VAL; LASTMODE ~ REAL(VAL)+1; END ELSE02272560
         IF ID = "NOSEQ " THEN SEQTOG ~ FALSE ELSE                      02272600
         IF ID = "SET   " OR ID = "+     " THEN GO TO SET ELSE          02272900
         IF ID = "RESET " OR ID = "-     " THEN GO TO RESET ELSE        02273200
         IF ID = "ONSITE" AND NOT REMFIXED THEN REMOTETOG ~ FALSE ELSE  02273500
         IF ID = "REMOTE" AND NOT REMFIXED THEN REMOTETOG ~ VAL ELSE    02273800
         IF ID = "FREEFO" THEN FREEFTOG ~ VAL ELSE                      02274100
         IF ID = "SINGLE" OR ID = "SGL   " THEN                         02274400
            BEGIN SINGLETOG ~ VAL; LISTOG ~ TRUE; END ELSE              02274700
         IF ID = "NEW   " OR ID = "NEWTAP" THEN                         02275000
            BEGIN LIBTAPE~VAL; NEWTPTOG~VAL; NTAPTOG~TRUE;         %501-02275100
            IF ID = "NEW   " THEN                                  %501-02275120
               BEGIN                                               %501-02275140
               GETID;                                              %501-02275160
               IF ID ! "TAPE  " THEN                               %501-02275180
                    GO TO LP;                                      %501-02275200
               END;                                                %501-02275220
             END ELSE                                              %501-02275240
         IF ID = "LIST  " THEN LISTOG ~ VAL ELSE                        02275300
         IF ID = "SEQXEQ" AND NOT SEGSWFIXED THEN SEGSW ~ VAL ELSE      02275600
         IF ID = "PRT   " THEN PRTOG ~ VAL ELSE                         02275900
         IF ID = "DEBUGN" THEN                                          02276200
            BEGIN LISTOG~VAL; CODETOG~VAL; PRTOG ~ VAL END ELSE         02276500
         IF ID = "TIME  " THEN TIMETOG ~ VAL ELSE                       02276800
         IF ID = "ERRMES" THEN TSSMESTOG ~ VAL ELSE                     02277100
         IF ID = "TSSEDI" THEN TSSEDITOG ~ VAL ELSE                     02277400
         IF ID = "LISTLI" THEN LISTLIBTOG ~ VAL ELSE                    02277700
         IF(ID = "SEGMEN" OR ID = "SEG   ") AND VAL THEN                02278000
            BEGIN ADR~ADR+1; SEGOVF; END ELSE                           02278300
         IF ID = "PAGE  " AND VAL THEN WRITE(LINE[PAGE]) ELSE           02278600
         IF ID = "VOID  " THEN                                          02278900
            BEGIN VOIDTOG ~ VAL;                                        02279200
                  IF VAL THEN BUF ~ GETVOID(BUF,VOIDSEQ,1);             02279300
            END ELSE                                                    02279500
         IF ID = "VOIDT " THEN                                          02279800
            BEGIN VOIDTTOG ~ VAL;                                       02280100
                   IF VAL THEN BUF ~ GETVOID(BUF,VOIDTSEQ,1);           02280300
            END ELSE                                                    02280400
         IF ID = "LIMIT " THEN                                          02280700
            BEGIN LIMIT ~ IF VAL THEN 0 ELSE @60;                       02281000
                  BUF ~ SEQNUM(BUF,LIMIT);                              02281300
                  IF LIMIT LEQ ERRORCT THEN GO TO POSTWRAPUP;           02281600
            END ELSE                                                    02282500
         IF ID = "XREF  " THEN                                          02282800
            BEGIN                                                       02282850
                  PXREF ~ TRUE; XREF ~ VAL;                             02282900
            END ELSE                                                    02282950
         IF ID = "SEQ   " THEN                                          02283100
         BEGIN SEQTOG ~ VAL;                                            02283200
               IF VAL THEN                                              02283300
            BEGIN SEQBASE ~ SEQINCR ~ 0;                                02283400
                  BUF ~ SEQNUM(BUF,SEQBASE);                            02283700
                  BUF ~ SEQNUM(BUF,SEQINCR);                            02284000
                  IF SEQINCR { 0 THEN SEQINCR ~ 1000;                   02284600
         END END ELSE                                                   02284900
         IF ID = "LISTDO" THEN DOLIST ~ VAL ELSE                        02285200
         IF ID = "HOL   " THEN HOLTOG ~ VAL ELSE                        02285500
         IF ID = "CHECK " THEN CHECKTOG ~ VAL ELSE                      02285800
         IF ID = "NEWPAG" THEN SEGPTOG ~ VAL ELSE                  %501-02286100
         IF ID = "LISTP " THEN LISTPTOG ~ VAL ELSE                      02286400
         BEGIN IF FIRSTCALL THEN DATIME;                                02286700
               IF UNPRINTED THEN BEGIN PRINTCARD; UNPRINTED~FALSE END;  02287000
               IF SINGLETOG THEN WRITE(LINE,WARN,ID)                    02287300
               ELSE WRITE(RITE,WARN,ID);                                02287600
         END                                                            02287900
         ;                                                              02288200
         GETID;                                                         02288500
         GO TO LP;                                                      02288800
         END;                                                           02289100
    END;                                                                02289400
         IF DOLIST OR LISTOG OR SAVELISTOG THEN                    %511-02289450
            IF UNPRINTED THEN PRINTCARD;                           %517-02289500
    UNPRINTED ~ TRUE;                                                   02289600
END DOLOPT;                                                             02289700
STREAM PROCEDURE NEWSEQ(A,B); VALUE B;                                  02317000
    BEGIN                                                               02318000
         SI ~ LOC B; DI ~ A; DS ~ 8 DEC;                                02319000
    END NEWSEQ;                                                         02320000
INTEGER STREAM PROCEDURE SEQCHK(T,C);                                   02321000
    BEGIN                                                               02322000
         SI ~ T; DI ~ C;                                                02323000
         IF 8 SC < DC THEN TALLY ~ 4 ELSE                               02324000
    BEGIN                                                               02325000
         SI ~ SI - 8; DI ~ DI - 8;                                      02326000
         IF 8 SC =DC THEN TALLY ~ 2                                     02327000
                     ELSE TALLY ~ 3;                                    02328000
    END;                                                                02329000
         SEQCHK ~ TALLY;                                                02330000
    END SEQCHK;                                                         02331000
BOOLEAN PROCEDURE READACARD;                                            02332000
BEGIN                                                                   02333000
DEFINE FLAGI(FLAGI1) = BEGIN FLAG(FLAGI1); GO TO E4A;END #;             02333050
REAL STREAM PROCEDURE SCANINC(BUF,ID,RESULT,N,M);                       02333100
    VALUE BUF,M,N;                                                      02333120
    BEGIN                                                               02333140
         LOCAL TA;                                                      02333160
         LABEL LP,LQ,XIT;                                               02333180
         DI := RESULT; DI := DI +7;                                     02333200
         SI := BUF;                                                     02333210
     LP: IF SC = " " THEN BEGIN SI := SI + 1; GO TO LP; END;            02333220
         IF SC = ALPHA THEN ELSE BEGIN DS:=LIT "1"; DI:=ID; DS:=2LIT"0";02333240
              DS := CHR; DS := 5LIT" ";GO TO XIT; END;                  02333260
         IF SC LSS "0" THEN DS:=LIT "2" ELSE DS:=LIT "3";          %400-02333270
         N (DI:=ID; DS:=8 LIT "0       "; DI:=DI-7;                %400-02333280
            7(IF SC=ALPHA THEN DS~CHR ELSE JUMP OUT 2 TO XIT);          02333300
          JUMP OUT TO XIT);                                             02333320
         M ( 8 ( IF SC LSS "0" THEN JUMP OUT 2 TO LQ;              %400-02333360
                 IF SC GTR "9" THEN JUMP OUT 2 TO LQ;              %400-02333370
              SI:=SI+1; TALLY:=TALLY+1));                          %400-02333380
     LQ: TA := TALLY;                                                   02333400
         SI := SI - TA;                                                 02333420
         DI := ID;                                                      02333440
         DS := TA OCT;                                                  02333460
    XIT:  SCANINC := SI;                                                02333500
    END SCANINC;                                                        02333520
REAL STREAM PROCEDURE MKABS(S);                                         02333540
    BEGIN SI := S; SI := SI + 1;  MKABS := SI;  END;                    02333550
STREAM PROCEDURE MOVE(P, Q); VALUE Q;                                   02334000
BEGIN SI ~ P; DI ~ Q; DS ~ CHR;                                         02335000
   DI ~ P; DS ~ LIT "]";                                                02336000
END MOVE;                                                               02337000
STREAM PROCEDURE MOVEC(C,B);   VALUE B;                                 02337100
BEGIN SI~B; DI~C; DS~CHR; END;                                          02337200
BOOLEAN STREAM PROCEDURE GETCOL1(BUF);                                  02338000
    BEGIN                                                               02339000
         SI ~ BUF; IF SC = "$" THEN TALLY ~ 1;                          02340000
         GETCOL1 ~ TALLY;                                               02341000
    END;                                                                02342000
STREAM PROCEDURE TSSEDITS(C,P);  BEGIN SI~C;  DI~P;  DS~10WDS;  SI~C ;  02342010
IF SC="C" THEN BEGIN DI~P;  DI~DI+1;  DS~LIT"-" END ELSE                02342020
IF SC!"$" THEN BEGIN SI~SI+5;  IF SC!" " THEN IF SC!"0" THEN BEGIN DI~P;02342030
DS~6LIT"-     " END END END OF TSSEDITS ;                               02342040
STREAM PROCEDURE MOVEW(F,T,B,R); VALUE B, R;                            02343000
    BEGIN                                                               02344000
         LABEL XIT;                                                     02345000
         SI ~ F; DI ~ T;                                                02346000
         B(                                                             02347000
         2(40( IF SC = ALPHA THEN DS ~ CHR ELSE                         02348000
              IF SC = " " THEN DS ~ CHR ELSE                            02349000
              IF SC = "%" THEN BEGIN DS ~ LIT "("; SI ~ SI+1 END ELSE   02350000
              IF SC = "[" THEN BEGIN DS ~ LIT ")"; SI ~ SI+1 END ELSE   02351000
              IF SC = "#" THEN BEGIN DS ~ LIT "="; SI ~ SI+1 END ELSE   02352000
              IF SC = "&" THEN BEGIN DS ~ LIT "+"; SI ~ SI+1 END ELSE   02353000
              IF SC = "@" THEN BEGIN DS ~ LIT """; SI ~ SI+1 END ELSE   02354000
              IF SC = ":" THEN BEGIN DS ~ LIT """; SI ~ SI+1 END ELSE   02354100
              IF SC = "<" THEN BEGIN DS ~ LIT "+"; SI ~ SI+1 END ELSE   02355000
              IF SC = ">" THEN BEGIN DS ~ LIT "="; SI ~ SI+1 END ELSE   02356000
         DS ~ CHR )); JUMP OUT TO XIT);                                 02357000
         DS ~ 10 WDS;                                                   02358000
    XIT:                                                                02359000
         SI~LOC R;  SI~SI+7;  DI~DI+1 ;                                 02360000
         DS~CHR ;                                                       02361000
    END MOVEW;                                                          02362000
ALPHA STREAM PROCEDURE DCMOVEW(F,T,B,FIL,R); VALUE B,FIL,R;             02362010
    BEGIN LOCAL C;  LABEL L1,L2,L3,L4 ;                                 02362020
    SI~F;  DI~T;  2(SI~SI+36;  DS~36LIT" ");  C~SI;  DS~8CHR ;          02362030
    SI~LOC   R; SI~SI+6; DS~2CHR; DI~C; DS~8LIT"]";TALLY~33;SI~F;       02362033
    IF SC = " " THEN     %%% IT MIGHT BE A FILES CARD.                  02362034
         BEGIN SI~SI+1; IF SC="F" THEN                                  02362035
         BEGIN     DI~LOC FIL; DI~DI+2; IF 5SC=DC THEN                  02362036
         BEGIN DI~F; SI~LOC FIL; SI~SI+2; DS~6CHR ; GO TO L1; END       02362037
         ELSE SI~F END ELSE SI~F  END                                   02362038
    ELSE IF SC = "F" THEN BEGIN DI~LOC FIL;DI~DI+2;IF 6SC=DC THEN GO L1 02362040
               ELSE SI~F;END                                            02362041
    ELSE IF SC="-" THEN                                                 02362042
         BEGIN %%% IT IS A CONTINUATION CARD.                           02362044
         SI~SI+1;  DI~T;  DS~6LIT"     *" ;                             02362050
         5(IF SC=" " THEN SI~SI+1 ELSE JUMP OUT); GO TO L2 ;            02362060
         END                                                            02362063
    ELSE IF SC="C" THEN                                                 02362066
         BEGIN %%% IT MIGHT BE A COMMENT CARD.                          02362070
         SI~SI+1;  IF SC="-" THEN GO TO L1 ELSE SI~F ;                  02362080
         END ;                                                          02362090
    IF SC!"$" THEN %%% IT IS NOT A COMMENT CARD, NOR IS IT A $ CARD,    02362100
         BEGIN     %%% NOR A CONTINUATION CARD, NOR A FILES CARD.       02362110
         2(33(IF SC=" " THEN SI~SI+1 ELSE JUMP OUT 2 TO L3)); L3:  DI~T;02362120
         5(IF SC=" " THEN SI~SI+1 ELSE IF SC}"0" THEN IF SC{"9"         02362130
           THEN DS~CHR ELSE JUMP OUT ELSE JUMP OUT) ;                   02362140
         DI~T;  DI~DI+6;  IF SC=" " THEN SI~SI+1 ;                      02362150
         END                                                            02362160
    ELSE                                                                02362170
         BEGIN                                                          02362180
         L1:  SI~F;  DI~T;  TALLY~36 ;                                  02362190
         END ;                                                          02362200
    L2:  C~TALLY ;                                                      02362210
    B(2(C(IF SC>">" THEN DS~CHR ELSE IF SC<"[" THEN DS~CHR ELSE         02362220
          IF SC="%" THEN BEGIN DS~LIT"("; SI~SI+1 END ELSE              02362230
          IF SC="#" THEN BEGIN DS~LIT"="; SI~SI+1 END ELSE              02362235
          IF SC="&" THEN BEGIN DS~LIT"+"; SI~SI+1 END ELSE              02362240
          IF SC="@" THEN BEGIN DS~LIT"""; SI~SI+1 END ELSE              02362245
          IF SC=":" THEN BEGIN DS~LIT"""; SI~SI+1 END ELSE              02362250
          IF SC="<" THEN BEGIN DS~LIT"+"; SI~SI+1 END ELSE              02362255
          IF SC=">" THEN BEGIN DS~LIT"="; SI~SI+1 END ELSE              02362260
          IF SC="[" THEN BEGIN DS~LIT")"; SI~SI+1 END ELSE              02362265
          IF SC="]" THEN JUMP OUT 3 TO L4 ELSE DS~CHR));JUMP OUT TO L4);02362270
    2(C(IF SC="]" THEN JUMP OUT 2 TO L4 ELSE DS~CHR)) ;                 02362275
    L4:  DI~LOC DCMOVEW;  DS~8LIT"00      ";  DI~DI-6 ;                 02362280
    6(IF SC="]" THEN JUMP OUT ELSE DS~CHR) ;                            02362285
    END OF DCMOVEW ;                                                    02362290
STREAM PROCEDURE SEQERR(BUFF, NEW, OLD);                                02362300
BEGIN                                                                   02362400
         DI ~ BUFF; DS ~ 18 LIT "SEQUENCE ERROR    ";                   02362450
         SI ~ NEW; DS ~ LIT""";                                         02362500
         DS ~ 8 CHR; DS ~ LIT """;                                      02362550
         DS ~ 3 LIT " < ";                                              02362600
         SI ~ OLD; DS ~ LIT """;                                        02362650
         DS ~ 8 CHR; DS ~ LIT """;                                      02362700
         DS ~ 59 LIT " ";                                               02362750
         DS ~ 8 LIT "X"; DS ~ 4 LIT " ";                                02362800
END SEQERR;                                                             02362850
STREAM PROCEDURE DCMOVE(E,C,A,N); VALUE A,N;                            02362855
BEGIN SI~C; DI~E; DS~10WDS; DS~4CHR; SI~LOC A; DS~4DEC;                 02362860
      N(DS~8LIT"   PATCH"); END;                                        02362865
     REAL BUF,ID;                                                       02362900
     BOOLEAN NOWRI;  LABEL ENDPB, E4B;                                  02362902
     LABEL LIBADD, ENDPA, E4A, E4, STRTA;                               02362950
     LABEL E1,E2,E3,STRT,ENDP,XIT;                                      02363000
     UNPRINTED~TRUE;                                                    02363100
     GO TO STRT;                                                        02364000
LIBADD:                                                                 02364100
     XTA := BLANKS;                                                     02364130
     IF INSERTDEPTH = -1 THEN SAVECARD ~ NEXTCARD;                      02364160
     MOVE (CRD[9],BUFL);                                                02364240
                                                                        02364280
     IF (INSERTDEPTH ~ INSERTDEPTH + 1) GTR INSERTMAX THEN              02364300
          FLAG(158);                                                    02364320
     NEWTPTOG ~ FALSE;                                                  02364330
     INSERTINX ~ -1;                                                    02364340
     INSERTCOP ~ 0;                                                     02364350
     BLANKIT(SSNM[5],1,0);                                              02364360
     BUF ~ SCANINC(BUF,INSERTMID,RESULT,1,0);                           02364380
     IF RESULT = 1 AND INSERTMID = "+     "THEN                         02364381
     BEGIN BUF~SCANINC(BUF,ID,RESULT,1,0);                              02364382
           IF ID = "COPY   " THEN INSERTCOP ~ 1                         02364383
           ELSE FLAG(155);                                              02364384
           BUF~SCANINC(BUF,INSERTMID,RESULT,1,0);                       02364385
     END;                                                               02364386
     IF RESULT NEQ 2 THEN FLAGI (155);                                  02364400
          BUF := SCANINC(BUF,ID,RESULT,0,1);                       %107-02364420
     IF RESULT = 1  THEN IF ID = "/     " THEN                          02364440
     BEGIN BUF := SCANINC(BUF,INSERTFID,RESULT,1,0);                    02364460
            IF RESULT NEQ 2 THEN FLAGI(155);                            02364480
           BUF := SCANINC(BUF,ID,RESULT,0,1);                           02364500
      END ELSE INSERTFID := TIME(-1) ELSE INSERTFID := TIME(-1);        02364520
     IF RESULT = 3 THEN                                                 02364540
      BEGIN NEWSEQ(SSNM[5],ID);                                         02364560
           BUF := SCANINC(BUF,ID,RESULT,0,1);                           02364580
            IF RESULT NEQ   1 THEN FLAGI(156);                          02364600
            IF ID = "]     " THEN NEWSEQ (INSERTSEQ,99999999)      %400-02364605
            ELSE BEGIN                                             %400-02364610
           BUF ~ SCANINC(BUF,ID,RESULT,0,1);                            02364620
            IF RESULT NEQ   3 THEN FLAGI(157);                          02364640
            NEWSEQ (INSERTSEQ,ID);                                      02364660
            END                                                    %400-02364670
      END ELSE IF ID = "]     " THEN NEWSEQ(INSERTSEQ,999999999)        02364680
          ELSE FLAGI(157);                                              02364700
     IF INSERTDEPTH > 0 THEN CLOSE (LF,RELEASE);                        02364720
     FILL LF WITH     INSERTMID,INSERTFID;                              02364740
     DO BEGIN                                                           02364760
          READ (LF[INSERTINX ~ INSERTINX+1],10,DB[*])[E4];              02364780
          END UNTIL SEQCHK(SSNM[5],DB[9]) NEQ 3;                        02364800
     NEWTPTOG ~ BOOLEAN(INSERTCOP);                                     02364810
     IF NOT NEWTPTOG THEN                                               02364811
     BEGIN                                                              02364815
     IF SEQTOG THEN                                                     02364820
     BEGIN NEWSEQ(CRD[9],SEQBASE); MOVE(CRD[9],BUFL);                   02364830
           SEQBASE~SEQBASE+SEQINCR;                                     02364840
     END;     MOVEC(CRD[9],BUFL);                                       02364850
     IF LIBTAPE AND(INSERTDEPTH = 0 ) THEN WRITE(NEWTAPE,10,CRD[*]);    02364860
     END;                                                      %511-    02364885
     IF LISTOG OR DOLIST THEN PRINTCARD;                       %511-    02364890
     NEXTCARD:=7;                                                       02364900
     GO TO STRT;                                                        02364910
    E1:  IF NEXTCARD=1 THEN IF TAPETOG THEN                             02365000
            BEGIN                                                       02366000
            NEXTCARD~5;  READ(TP,10,TB[*])[E2];  GO TO STRT ;           02367000
            END                                                         02368000
         ELSE                                                           02369000
            BEGIN                                                       02370000
            NEXTCARD:=6;                                                02371000
         IF GETCOL1(CRD[0]) THEN BEGIN BUF := MKABS(CRD[0]);            02371002
            BUF:=SCANINC(BUF,ID,RESULT,1,0); IF ID NEQ INCLUDE          02371004
            THEN BLANKIT(CRD,9,1); END;                                 02371006
            GO TO ENDP ;                                                02371010
            END ;                                                       02371020
         NEXTCARD ~ 5; GO TO ENDP;                                      02372000
    E2:  IF NEXTCARD = 5 THEN                                           02372010
            BEGIN                                                       02372020
             NEXTCARD:=6;                                               02372030
         IF GETCOL1(CRD[0]) THEN BEGIN BUF := MKABS(CRD[0]);            02372040
            BUF:=SCANINC(BUF,ID,RESULT,1,0); IF ID NEQ INCLUDE          02372050
            THEN BLANKIT(CRD,9,1); END;                                 02372060
            END                                                         02373000
         ELSE IF NEXTCARD!2 THEN NEXTCARD~1 ELSE                        02373010
            BEGIN                                                       02373020
            NEXTCARD~1;  TAPETOG~BOOLEAN(2);  READ(CR,10,CB[*])[E1] ;   02373030
            END ;                                                       02373040
    IF VOIDTTOG THEN IF SEQCHK(CRD[0],VOIDTSEQ) < 4                %114-02373045
           THEN VOIDTTOG~FALSE                                     %114-02373100
            ELSE BEGIN VOIDTTOG~FALSE; GO TO STRT; END;            %114-02373200
         GO TO ENDP ;                                                   02374000
    E4B: NOWRI ~TRUE;                                                   02374050
         IF SEQTOG THEN NEWSEQ(CRD[9],SEQBASE);                         02374053
         IF NEWTPTOG THEN IF TSSEDITOG THEN                             02374055
         BEGIN TSSEDITS(CRD,PRINTBUFF); WRITE(NEWTAPE,10,PRINTBUFF[*]); 02374060
         END ELSE WRITE(NEWTAPE,10,CRD[*]);                             02374065
    E4:  CLOSE (LF,RELEASE);                                            02374100
         NEWTPTOG~ SAVETOG;                                             02374110
         IF (INSERTDEPTH := INSERTDEPTH - 1) = -1 THEN                  02374150
              BEGIN NEXTCARD ~ SAVECARD; GO TO ENDPA; END               02374200
              ELSE NEWTPTOG ~ BOOLEAN(INSERTCOP);                       02374300
          FILL LF WITH INSERTMID,INSERTFID;                             02374450
          READ(LF[INSERTINX := INSERTINX + 1],10,DB[*])[E4];            02374470
          IF SEQCHK(INSERTSEQ,DB[9]) = 4 THEN GO TO E4;                 02374500
          GO TO ENDP;                                                   02374520
     E4A:                                                               02374560
         NEWTPTOG~SAVETOG;                                              02374580
          IF (INSERTDEPTH ~ INSERTDEPTH-1) = -1 THEN NEXTCARD~SAVECARD  02374600
          ELSE NEWTPTOG ~ BOOLEAN(INSERTCOP);                           02374680
     STRT:                                                              02375000
     STRTA:                                                             02375600
          IF NEXTCARD=6 THEN GO XIT ;                                   02376000
          CARDCOUNT ~ CARDCOUNT+1;                                      02377000
          IF NEXTCARD = 1 THEN                                          02378000
     BEGIN     % CARD ONLY                                              02379000
          IF(NOT DCINPUT OR TSSEDITOG)AND NOT FREEFTOG                  02380000
          THEN MOVEW(CB,CRD,HOLTOG,IF DCINPUT THEN "D" ELSE "R")        02380100
          ELSE IF SSNM[4]~DCMOVEW(CB,CRD,HOLTOG,"FILE  ",IF FREEFTOG    02380125
                  THEN " R" ELSE " D") ! "      " THEN                  02380150
               BEGIN XTA~SSNM[4] ;                                      02380175
              MOVESEQ(SSNM[4],LASTSEQ);  MOVESEQ(LASTSEQ,CRD[9]) ;      02380200
              IF LISTOG THEN                                            02380210
                   BEGIN IF FIRSTCALL THEN DATIME ;                     02380220
                   DCMOVE(PRINTBUFF,CRD,(ADR+1).[36:10],0);             02380230
                   WRITAROW(11,PRINTBUFF);  UNPRINTED~FALSE ;           02380240
                   END ;                                                02380250
              FLOG(149);  MOVESEQ(LASTSEQ,SSNM[4]) ;                    02380300
              END ;                                                     02380400
         IF GETCOL1(CRD[0]) THEN                                        02381000
    BEGIN                                                               02382000
         BUF := MKABS(CRD[0]);                                          02382200
         BUF := SCANINC(BUF,ID,RESULT,1,0);                             02382300
         IF ID NEQ INCLUDE THEN                                         02382400
    BEGIN                                                               02382500
         DOLOPT;                                                        02383000
         IF REAL(TAPETOG)=3 THEN READ(TP) ;                             02383010
         READ(CR,10,CB[*])[E1];                                         02384000
         IF NOT TAPETOG THEN GO TO STRT;                                02385000
         READ(TP,10,TB[*])[E2];                                         02386000
         NEXTCARD ~ SEQCHK(TB[9], CB[9]);                               02387000
         GO TO STRT;                                                    02388000
    END;                                                                02389000
    END;                                                                02389100
         IF LISTPTOG THEN                                               02389200
         BEGIN IF FIRSTCALL THEN DATIME;                                02389300
               IF SEQTOG THEN NEWSEQ(CRD[9],SEQBASE);                   02389400
               DCMOVE(PRINTBUFF,CRD,(ADR+1).[36:10],1);                 02389500
               WRITAROW (12,PRINTBUFF); UNPRINTED ~ FALSE;              02389600
         END;                                                           02389700
         READ(CR,10,CB[*])[E1];                                         02390000
         GO TO ENDP;                                                    02391000
    END;                                                                02392000
         IF NEXTCARD = 5 THEN                                           02393000
    BEGIN                                                               02394000
         MOVEW(TB,CRD,HOLTOG,"T") ;                                     02395000
          READ(TP, 10, TB[*])[E2];                                      02396000
         IF VOIDTTOG THEN IF SEQCHK(CRD[9],VOIDTSEQ) < 4 THEN           02396100
            VOIDTTOG ~ FALSE ELSE GO TO STRT;                           02396200
         GO TO ENDP;                                                    02397000
    END;                                                                02398000
         IF NEXTCARD { 3 THEN                                           02399000
    BEGIN     % CARD OVER TAPE                                          02400000
         IF(NOT DCINPUT OR TSSEDITOG)AND NOT FREEFTOG                   02401000
         THEN MOVEW(CB,CRD,HOLTOG,IF DCINPUT THEN "D" ELSE "R")         02401100
         ELSE IF SSNM[4]~DCMOVEW(CB,CRD,HOLTOG,"FILE  ",IF FREEFTOG     02401125
                 THEN " R" ELSE " D") ! "      " THEN                   02401150
              BEGIN XTA~SSNM[4] ;                                       02401175
              MOVESEQ(SSNM[4],LASTSEQ);  MOVESEQ(LASTSEQ,CRD[9] );      02401200
              IF LISTOG THEN                                            02401210
                   BEGIN IF FIRSTCALL THEN DATIME;                      02401220
                   DCMOVE(PRINTBUFF,CRD,(ADR+1).[36:10],0);             02401230
                   WRITAROW(11,PRINTBUFF);  UNPRINTED~FALSE ;           02401240
                   END;                                                 02401250
              FLOG(149);  MOVESEQ(LASTSEQ,SSNM[4]) ;                    02401300
              END;                                                      02401400
         IF NEXTCARD =2 THEN READ(TP,10,TB[*])[E2];                     02402000
         IF GETCOL1(CRD) THEN                                           02403000
    BEGIN                                                               02404000
         BUF ~ MKABS(CRD[0]);                                           02404200
              BUF ~ SCANINC(BUF,ID,RESULT,1,0);                         02404300
         IF ID NEQ INCLUDE THEN                                         02404400
    BEGIN                                                               02404500
         DOLOPT;                                                        02405000
         READ(CR,10,CB[*])[E3];                                         02406000
         NEXTCARD ~ SEQCHK(TB[9], CB[9]);                               02407000
         GO TO STRT;                                                    02408000
         E3: NEXTCARD~5;  GO TO STRT;                                   02408500
    END;                                                                02409000
    END;                                                                02409100
         IF LISTPTOG THEN                                               02409200
         BEGIN IF FIRSTCALL THEN DATIME;                                02409300
               IF SEQTOG THEN NEWSEQ(CRD[9],SEQBASE);                   02409400
               DCMOVE(PRINTBUFF,CRD,(ADR+1).[36:10],1);                 02409500
               WRITAROW (12,PRINTBUFF); UNPRINTED ~ FALSE;              02409600
         END;                                                           02409700
         READ(CR,10,CB[*])[E1];                                         02410000
         NEXTCARD ~ SEQCHK(TB[9], CB[9]);                               02411000
         GO TO ENDP;                                                    02412000
    END;                                                                02413000
              % TAPE BEFORE CARD                                        02414000
         IF NEXTCARD = 7 THEN                                           02414100
    BEGIN                                                               02414150
         IF(NOT DCINPUT OR TSSEDITOG)AND NOT FREEFTOG                   02414175
         THEN MOVEW(DB,CRD,HOLTOG,"L") ELSE IF XTA~DCMOVEW(DB,CRD,      02414200
              HOLTOG,"FILE  ",IF FREEFTOG THEN " R" ELSE " D")          02414225
                 ! "      " THEN FLOG(149);                             02414250
         IF GETCOL1(CRD[0]) THEN                                        02414260
    BEGIN                                                               02414270
         BUF ~ MKABS(CRD[0]);                                           02414280
              BUF ~ SCANINC(BUF,ID,RESULT,1,0);                         02414290
         IF ID = INCLUDE THEN GO TO LIBADD;                             02414300
    END;                                                                02414310
         READ(LF[INSERTINX~INSERTINX+1],10,DB[*])[E4B];                 02414370
         IF SEQCHK(INSERTSEQ,DB[9]) = 4 THEN GO TO E4B;                 02414380
         IF GETCOL1(CRD[0]) THEN BEGIN DOLOPT; GO TO STRT; END;         02414382
         GO TO ENDP;                                                    02414390
    END;                                                                02414400
         MOVEW(TB,CRD,HOLTOG,"T") ;                                     02415000
         READ(TP,10,TB[*])[E2];                                         02416000
         IF VOIDTTOG THEN IF SEQCHK(CRD[9],VOIDTSEQ) < 4 THEN           02416100
           VOIDTTOG~FALSE ELSE BEGIN NEXTCARD~SEQCHK(TB[9],CB[9]); %114-02416200
                                      GO TO STRT; END;             %114-02416300
         NEXTCARD ~ SEQCHK(TB[9], CB[9]);                               02417000
    ENDP:                                                               02418000
         IF NEXTCARD NEQ 7 THEN                                         02418100
         IF VOIDTOG THEN IF SEQCHK(CRD[9],VOIDSEQ) < 4 THEN             02419000
             VOIDTOG ~ FALSE ELSE GO TO STRT;                           02419050
         IF GETCOL1(CRD[0]) THEN                                        02419100
    BEGIN                                                               02419150
         BUF ~ MKABS(CRD[0]);                                           02419200
         BUF ~ SCANINC(BUF,ID,RESULT,1,0);                              02419250
         IF ID = INCLUDE THEN GO TO LIBADD ELSE GO TO STRT;             02419300
    END;                                                                02419325
         SEQERRORS ~ FALSE;                                             02420000
         IF NEXTCARD = 7 THEN                                           02420010
            BEGIN MOVESEQ(LASTSEQ,CRD[9]); GO TO ENDPA; END;            02420011
         IF CHECKTOG AND SEQERRCT=0 THEN SEQERRCT~1 ;                   02420015
         IF CHECKTOG THEN IF SEQCHK(LASTSEQ,CRD[9])=3 THEN              02420020
            BEGIN                                                       02420030
            SEQERR(ERRORBUFF,CRD[9],LASTSEQ) ;                          02420040
            MOVESEQ(LASTSEQ,CRD[9]) ;                                   02420050
            IF SEQTOG THEN                                              02420053
               BEGIN NEWSEQ(CRD[9],SEQBASE);SEQBASE~SEQBASE+SEQINCR END;02420057
            MOVESEQ(LINKLIST,CRD[9]);                                   02420060
            MOVE(CRD[9],BUFL) ;                                         02420070
            SEQERRCT~SEQERRCT+1 ;                                       02420080
            SEQERRORS~TRUE ;                                            02420090
            IF NOT LISTOG THEN PRINTCARD ;                              02420100
            END                                                         02420110
         ELSE MOVESEQ(LASTSEQ,CRD[9]) ELSE MOVESEQ(LASTSEQ,CRD[9]) ;    02420120
                                                                        02420150
                                                                        02420200
                                                                        02420250
                                                                        02420300
                                                                        02420350
                                                                        02420400
                                                                        02420450
                                                                        02420500
ENDPA:                                                                  02420550
         IF SEQTOG THEN                                                 02421000
         BEGIN                                                          02422000
         NEWSEQ(CRD[9],SEQBASE);                                        02423000
         SEQBASE ~ SEQBASE + SEQINCR;                                   02424000
         END;                                                           02425000
   IF NOWRI THEN GO TO ENDPB;                                           02425100
   IF NEWTPTOG THEN IF TSSEDITOG THEN BEGIN TSSEDITS(CRD,PRINTBUFF) ;   02426000
   WRITE(NEWTAPE,10,PRINTBUFF[*]) END ELSE WRITE(NEWTAPE,10,CRD[*]) ;   02426005
ENDPB:                                                                  02426008
   IF NOT SEQERRORS THEN                                                02426010
      BEGIN                                                             02426020
      MOVESEQ(LINKLIST,CRD[9]) ;                                        02426030
      MOVE(CRD[9],BUFL) ;                                               02426040
      END ;                                                             02427000
   NCR ~ INITIALNCR;                                                    02428000
   READACARD ~ TRUE;                                                    02429000
XIT:                                                                    02430000
   SEGSWFIXED ~ TRUE ;                                                  02431000
   REMFIXED~TRUE ;                                                      02431005
   IF TSSEDITOG THEN WARNED~TRUE ;                                      02431100
   IF LISTOG AND FIRSTCALL THEN DATIME;                                 02432000
   IF SEGSW THEN %%% ENTER SEQ# AND ADR TO LINESEG ARRAY.               02432100
      BEGIN IF LASTADDR!ADR THEN BEGIN NOLIN~NOLIN+1;  LASTADDR~ADR END;02432200
      LINESEG[NOLIN.IR,NOLIN.IC]~0 & D2B(LASTSEQ)[10:20:28] & (ADR+3)   02432300
      [38:36:10] ;                                                      02432400
      END ;                                                             02432500
END READACARD;                                                          02433000
INTEGER STREAM PROCEDURE CONVERT(NUB,SIZE,P,CHAR); VALUE P;             02434000
    BEGIN                                                               02435000
    LOCAL T;                                                            02436000
         SI ~ P;                                                        02437000
         8(IF SC < "0" THEN JUMP OUT;                                   02438000
             SI ~ SI + 1; TALLY ~ TALLY + 1);                           02439000
         CONVERT ~ SI;                                                  02440000
         DI ~ CHAR; DS ~ 7 LIT "0"; DS ~ CHR;                           02441000
         T ~ TALLY;                                                     02442000
         SI ~ P; DI ~ NUB; DS ~ T OCT;                                  02443000
         DI ~ SIZE ; SI ~ LOC T; DS ~ WDS;                              02444000
    END CONVERT;                                                        02445000
PROCEDURE SCAN;                                                         02446000
BEGIN                                                                   02447000
BOOLEAN STREAM PROCEDURE ADVANCE(NCR, ACR, CHAR, NCRV, ACRV);           02448000
VALUE NCRV, ACRV, CHAR;                                                 02449000
BEGIN LABEL LOOP;                                                       02450000
   LABEL DIG, ALPH, BK1, BK2, SPEC;                                     02451000
   DI ~ ACRV;                                                           02452000
   SI ~ CHAR; SI ~ SI+8;                                                02453000
   IF SC ! " " THEN                                                     02454000
      IF SC } "0" THEN BEGIN SI ~ NCRV; GO TO BK1 END ELSE              02455000
                       BEGIN SI ~ NCRV; GO TO BK2 END;                  02456000
   SI ~ NCRV;                                                           02457000
   LOOP:                                                                02458000
   IF SC = " " THEN BEGIN SI~SI+1; GO TO LOOP END;                      02459000
   IF SC } "0" THEN                                                     02460000
   BEGIN                                                                02461000
      DIG: DS ~ CHR;                                                    02462000
      BK1: IF SC = " " THEN BEGIN SI ~ SI+1; GO TO BK1 END;             02463000
      IF SC } "0" THEN GO TO DIG;                                       02464000
      GO TO SPEC;                                                       02465000
   END;                                                                 02466000
   IF SC = ALPHA THEN                                                   02467000
   BEGIN                                                                02468000
      ALPH: DS ~ CHR;                                                   02469000
      BK2: IF SC = " " THEN BEGIN SI ~ SI+1; GO TO BK2 END;             02470000
      IF SC = ALPHA THEN GO TO ALPH;                                    02471000
   END;                                                                 02472000
   SPEC:                                                                02473000
   ACRV ~ DI;                                                           02474000
   DS ~ 6 LIT " ";                                                      02475000
   IF SC = "]" THEN                                                     02476000
   BEGIN TALLY ~ 1; SI ~ LOC ACRV;                                      02477000
      DI ~ ACR; DS ~ WDS;                                               02478000
      DI ~ CHAR; DS ~ LIT ";";                                          02479000
   END ELSE                                                             02480000
   BEGIN DI ~ CHAR; DS ~ CHR;                                           02481000
      ACRV ~ SI; SI ~ LOC ACRV;                                         02482000
      DI ~ NCR; DS ~ WDS;                                               02483000
   END;                                                                 02484000
   ADVANCE ~ TALLY;                                                     02485000
END ADVANCE;                                                            02486000
BOOLEAN PROCEDURE CONTINUE;                                             02487000
BEGIN                                                                   02487200
LABEL LOOP;                                                             02487400
BOOLEAN STREAM PROCEDURE CONTIN(CD);                                    02487600
BEGIN SI~CD;  IF SC!"C" THEN IF SC!"$" THEN BEGIN SI~SI+5;  IF SC!" "   02488000
THEN IF SC!"0" THEN BEGIN TALLY~1;  CONTIN~TALLY END END END OF CONTIN ;02489000
BOOLEAN STREAM PROCEDURE COMNT(CD,T);  VALUE T;                         02489200
BEGIN LABEL L ;                                                         02489400
   SI ~ CD; IF SC = "C" THEN BEGIN T(SI~SI+1;  IF SC="-" THEN TALLY~1   02489600
   ELSE JUMP OUT TO L);  TALLY~1;  L: END;  COMNT~TALLY ;               02490000
END COMNT;                                                              02490200
BOOLEAN STREAM PROCEDURE DCCONTIN(CD);                                  02490400
BEGIN                                                                   02490500
    SI ~ CD; IF SC = "-" THEN TALLY ~ 1;                                02490600
    DCCONTIN ~ TALLY;                                                   02491000
END DCCONTIN;                                                           02491200
LOOP:    IF NOT(CONTINUE ~                                              02491400
           IF(DCINPUT AND NOT TSSEDITOG)OR FREEFTOG THEN                02491600
              IF NEXTCARD < 4 THEN DCCONTIN(CB)                         02491650
              ELSE IF NEXTCARD = 7 THEN DCCONTIN(DB)ELSE CONTIN(TB)     02491700
           ELSE IF NEXTCARD = 7 THEN CONTIN(DB)                         02491800
           ELSE IF NEXTCARD < 4 THEN CONTIN(DB) ELSE                    02492000
           CONTIN(TB)) THEN                                             02492200
         IF(IF NEXTCARD < 4 THEN                                        02492400
               COMNT(CB,(DCINPUT AND NOT TSSEDITOG) OR FREEFTOG)        02492450
            ELSE IF NEXTCARD = 7 THEN                                   02492500
               COMNT(CB,(DCINPUT AND NOT TSSEDITOG) OR FREEFTOG)        02492550
         ELSE COMNT(TB,0) AND NEXTCARD ! 6) THEN                        02492600
         BEGIN                                                          02493000
           IF READACARD THEN IF LISTOG THEN PRINTCARD;                  02493200
            GO TO LOOP;                                                 02493400
         END;                                                           02493600
END CONTINUE;                                                           02494000
PROCEDURE SCANX(EOF1, EOF2, EOS1, EOS2, OK1, OK2);                      02495000
   VALUE        EOF1, EOF2, EOS1, EOS2, OK1, OK2;                       02496000
   INTEGER      EOF1, EOF2, EOS1, EOS2, OK1, OK2;                       02497000
BEGIN LABEL LOOP, LOOP0 ;                                               02498000
   LOOP0:                                                               02498100
   EXACCUM[1] ~ BLANKS;                                                 02499000
   ACR ~ ACR1;                                                          02500000
   LOOP:                                                                02501000
   IF ADVANCE(NCR, ACR, CHR1, NCR, ACR) THEN                            02502000
      IF CONTINUE THEN                                                  02503000
%                                                                       02504000
         IF READACARD THEN                                              02505000
              BEGIN                                                     02506000
              IF LISTOG THEN PRINTCARD ;                                02506010
              IF ACR.[33:15]}EXACCUMSTOP THEN                           02506020
                   BEGIN XTA~BLANKS; FLOG(175); GO LOOP0 END ;          02506030
              GO LOOP ;                                                 02506040
               END                                                      02506050
          ELSE SCN ~ IF EXACCUM[1] = BLANKS THEN EOF1 ELSE EOF2         02507000
       ELSE SCN ~ IF EXACCUM[1] = BLANKS THEN EOS1 ELSE EOS2            02508000
    ELSE SCN ~ IF EXACCUM[1] = BLANKS THEN OK1 ELSE OK2;                02509000
END SCANX;                                                              02510000
DEFINE CHAR = ACCUM[0]#;                                                02511000
DEFINE T=SYMBOL#;                                                       02512000
INTEGER N;                                                              02513000
BOOLEAN STREAM PROCEDURE CHECKEXP(NCR, NCRV, A); VALUE NCRV;            02514000
BEGIN                                                                   02515000
   SI ~ NCRV;                                                           02516000
   IF SC = "*" THEN                                                     02517000
   BEGIN DI ~ A; DI ~ DI+2; DS ~ 2 LIT "*"; SI ~ SI+1; NCRV ~ SI;       02518000
      TALLY ~ 1; CHECKEXP ~ TALLY;                                      02519000
      SI ~ LOC NCRV; DI ~ NCR; DS ~ WDS  END;                           02520000
END CHECKEXP;                                                           02521000
PROCEDURE CHECKRESERVED;                                                02522000
BEGIN LABEL RESWD, XIT, FOUND1, FOUND2, DONE;                           02523000
BOOLEAN STREAM PROCEDURE COMPLETECHECK(A,B,N);  VALUE N ;               02523100
    BEGIN LABEL L ;                                                     02523200
    SI~A; SI~SI-2; DI~B; N(IF SC!DC THEN JUMP OUT TO L); TALLY~1;       02523300
    L: COMPLETECHECK~TALLY ;                                            02523400
    END OF COMPLETECHECK;                                               02523500
STREAM PROCEDURE XFER(FROM, T1, T2, N, M); VALUE FROM, N, M;            02524000
BEGIN SI ~ FROM; DI ~ T1; DI ~ DI+2;                                    02525000
   DS ~ M CHR;                                                          02526000
   SI ~ FROM; SI ~ SI+N;                                                02527000
   DI ~ T2; DI ~ DI+2;                                                  02528000
   DS ~ 6 CHR;                                                          02529000
END XFER;                                                               02530000
STREAM PROCEDURE XFERA(FROM, NEXT1, NEXT2);                             02531000
   VALUE FROM;                                                          02532000
BEGIN SI ~ FROM; SI ~ SI+6;                                             02533000
   DI ~ NEXT1; DI ~ DI+2;                                               02534000
   5(IF SC } "0" THEN DS ~ CHR ELSE JUMP OUT);                          02535000
   SI ~ SI+2;                                                           02536000
   DI ~ NEXT2; DI ~ DI+2;                                               02537000
   6(IF SC = ALPHA THEN DS ~ CHR ELSE JUMP OUT);                        02538000
END XFERA;                                                              02539000
BOOLEAN STREAM PROCEDURE CHECKFUN(FROM, TOO, N); VALUE FROM, N;         02540000
BEGIN SI ~ FROM; SI ~ SI +N;                                            02541000
   IF SC = "0" THEN                                                     02542000
   BEGIN SI ~ SI+1;                                                     02543000
      IF SC = "N" THEN                                                  02544000
      BEGIN SI ~ SI+1; TALLY ~ 1;                                       02545000
         DI ~ TOO; DI ~ DI+2;                                           02546000
         DS ~ 6 CHR;                                                    02547000
      END;                                                              02548000
   END;                                                                 02549000
   CHECKFUN ~ TALLY;                                                    02550000
END CHECKFUN;                                                           02551000
BOOLEAN STREAM PROCEDURE MORETHAN6(P);                                  02552000
BEGIN SI ~ P;                                                           02553000
   IF SC ! " " THEN TALLY ~ 1;                                          02554000
   MORETHAN6 ~ TALLY;                                                   02555000
END MORETHAN6;                                                          02556000
INTEGER I; ALPHA ID;                                                    02557000
INTEGER STOR ;                                                          02557100
   IF ACCUM[1] = "      " THEN                                          02558000
   BEGIN XTA ~ CHAR; FLOG(16); GO TO XIT END;                           02559000
   IF CHAR = "=     " OR CHAR = "#     " THEN GO TO XIT;                02560000
   IF CHAR = "~     " THEN GO TO XIT;                                   02560100
   IF CHAR ! "(     " AND CHAR ! "%     " THEN GO TO RESWD;             02561000
   IF MORETHAN6(ACCUM[2]) THEN GO TO RESWD;                             02562000
   COMMENT  AT THIS POINT WE HAVE <ID> ( .                              02563000
   THIS MUST BE ONE OF THE FOLLOWING:                                   02564000
   ASSIGNEMNT STATEMENT WITH SUBSCRIPTED VARIABLE AT THE LEFT.          02565000
   STATEMENT FUNCTION DECLARATION.                                      02566000
CALL, REAL, ENTRY, GO TO, READ, WRITE, FORMAT, IF, DATA, CHAIN, PRINT OR02567000
  PUNCH;                                                                02567100
   IF I ~ SEARCH(T) > 0 THEN                                            02568000
         IF GET(I).CLASS = ARRAYID THEN GO TO XIT;                      02569000
   ID ~ T; ID.[36:12] ~ "  ";                                           02570000
    FOR I~0 THRU RSP DO IF RESERVEDWORDSLP[I]=ID THEN IF (IF STOR       02571000
    ~RESLENGTHLP[I]-4<1 THEN TRUE ELSE COMPLETECHECK(ACCUM[2],          02571100
    RESERVEDWORDSLP[I+RSP1],STOR)) THEN GO FOUND1 ;                     02572000
   GO TO XIT;                                                           02573000
   FOUND1:                                                              02574000
   NEXT ~ LPGLOBAL[I];                                                  02575000
   T ~ "      ";                                                        02576000
   XFER(ACR0, T, NEXTACC, I~RESLENGTHLP[I], IF I> 6 THEN 6 ELSE I);     02577000
   GO TO DONE;                                                          02578000
   RESWD:                                                               02579000
   COMMENT  AT THIS POINT WE KNOW THE <ID> MUST BE A SPECIAL WORD       02580000
   TO IDENTIFY THE STATEMENT TYPE;                                      02581000
   ID ~ T; ID.[36:12] ~ "  ";                                           02582000
   IF T = "ASSIGN" THEN                                                 02583000
   BEGIN                                                                02584000
      NEXTSCN ~ SCN; SCN ~ 14;                                          02585000
      NEXTACC ~ NEXTACC2 ~ "      ";                                    02586000
      XFERA(ACR0, NEXTACC, NEXTACC2);                                   02587000
      NEXT ~ 1;                                                         02588000
      GO TO XIT;                                                        02589000
   END;                                                                 02590000
    FOR I~1 THRU RSH DO IF RESERVEDWORDS[I]=ID THEN IF (IF STOR~        02591000
    RESLENGTH[I]-4<1 THEN TRUE ELSE COMPLETECHECK(ACCUM[2],RESERVEDWORDS02591100
    [I+RSH1],IF STOR>8 THEN 8 ELSE STOR)) THEN GO FOUND2 ;              02592000
   XTA ~ T; FLOG(16); GO TO XIT;                                        02593000
   FOUND2:                                                              02594000
   NEXT ~ I+1;                                                          02695000
   T ~ "      ";                                                        02696000
   XFER(ACR0, T, NEXTACC, I~RESLENGTH  [I], IF I> 6 THEN 6 ELSE I);     02697000
   DONE: NEXTSCN ~ SCN;                                                 02698000
   SCN ~ 6;                                                             02699000
   IF NEXTACC = "FUNCTI" THEN                                           02600000
      IF CHECKFUN(ACR0, NEXTACC, I+6) THEN SCN ~ 13;                    02601000
   XIT:                                                                 02602000
   EOSTOG~FALSE;                                                        02603000
END CHECKRESERVED;                                                      02604000
BOOLEAN PROCEDURE CHECKOCTAL;                                           02605000
BEGIN                                                                   02606000
   INTEGER S, T; LABEL XIT;                                             02607000
INTEGER STREAM PROCEDURE COUNT(ACRV,T);   VALUE ACRV,T ;                02608000
   BEGIN                                                                02609000
   LOCAL A,B;   SI~LOC T;   SI~SI+7 ;                                   02610000
   IF SC="1" THEN BEGIN SI~ACRV;IF SC="0" THEN SI~SI+1 END ELSE SI~ACRV;02611000
   IF SC!" " THEN                                                       02612000
      BEGIN A~SI;                                                       02613000
    17(IF SC>"7" THEN BEGIN TALLY~17; JUMP OUT END ELSE IF SC < "0" THEN02614000
      BEGIN IF SC!" " THEN TALLY~17; JUMP OUT END; SI~SI+1;             02614010
      TALLY~TALLY+1) ;                                                  02614015
      B~TALLY;   SI~LOC B;   SI~SI+7 ;                                  02614020
      IF SC="+" THEN BEGIN SI~A; IF SC>"3" THEN TALLY~17 END;           02614030
      END ;                                                             02614040
   COUNT~TALLY ;                                                        02614050
   END OF COUNT ;                                                       02614060
ALPHA STREAM PROCEDURE CONV(ACRV, S, T); VALUE ACRV, S, T;              02615000
BEGIN SI ~ ACRV; IF SC = "0" THEN SI ~ SI+1;                            02616000
   DI ~ LOC CONV; SKIP S DB;                                            02617000
   T(SKIP 3 SB; 3(IF SB THEN DS ~ SET ELSE DS ~ RESET; SKIP 1 SB));     02618000
END CONV;                                                               02619000
   IF T~COUNT(ACR0,1) = 0 THEN                                          02620000
   BEGIN S ~ 1;                                                         02620100
      IF T ~ CHAR ! "+     " AND T ! "&     " THEN                      02620200
      IF T = "-     " THEN S ~ -1 ELSE GO TO XIT;                       02621000
      SCANX(4, 4, 3, 3, 10, 10);                                        02621100
      IF SCN ! 10 THEN GO TO XIT;                                       02622000
      IF T~COUNT(ACR1,2) = 0 OR T > 16 THEN GO TO XIT ;                 02622100
      FNEXT ~ CONV(ACR1, (16-T)|3, T);                                  02622200
      IF S < 0 THEN FNEXT ~ -FNEXT;                                     02623000
   END ELSE IF T < 17 THEN FNEXT~CONV(ACR0,(16-T)|3,T) ELSE GO TO XIT ; 02623100
   CHECKOCTAL ~ TRUE;                                                   02624000
   NEXT ~ NUM;                                                          02625000
   NUMTYPE ~ REALTYPE;                                                  02626000
   XIT:                                                                 02627000
END CHECKOCTAL;                                                         02628000
PROCEDURE HOLLERITH;                                                    02629000
BEGIN                                                                   02630000
   REAL T, COL1, T2, ENDP;                                              02631000
   LABEL XIT;                                                           02632000
   INTEGER STREAM PROCEDURE STRCNT(S,D,SZ); VALUE S,SZ;                 02633000
    BEGIN                                                               02634000
         SI ~ S; DI ~ D;DS ~ 8 LIT "00      "; DI ~ D;                  02635000
         DI ~ D; DI ~ DI + 2; DS ~SZ CHR; STRCNT ~ SI;                  02636000
    END STRCNT;                                                         02637000
   INTEGER STREAM PROCEDURE RSTORE(S,D,SKP,SZ);                         02638000
         VALUE S, SKP, SZ;                                              02639000
    BEGIN                                                               02640000
         DI ~ D;                                                        02641000
         SI ~ S; DI ~DI + SKP; DS ~ SZ CHR; RSTORE ~ SI;                02642000
    END RSTORE;                                                         02643000
   F1 ~ FNEXT;                                                          02644000
   NUMTYPE ~ STRINGTYPE;                                                02645000
   T ~ 0 & NCR[30:33:15] & NCR[45:30:3];                                02646000
   COL1 ~ 0 & INITIALNCR[30:33:15];                                     02647000
   ENDP ~ COL1 + 72;                                                    02648000
   STRINGSIZE ~ 0;                                                      02649000
   WHILE F1 >0 DO                                                       02650000
   BEGIN                                                                02651000
    T2 ~ IF F1 > 6 THEN 6 ELSE F1;                                      02652000
      IF STRINGSIZE > MAXSTRING THEN                                    02653000
         BEGIN FLAG(120); STRINGSIZE ~ 0 END;                           02654000
    IF T+T2> ENDP THEN IF DCINPUT OR FREEFTOG THEN                      02655000
         BEGIN XTA~BLANKS;  FLOG(150);  GO TO XIT END                   02655500
    ELSE BEGIN                                                          02656000
      IF TSSEDITOG THEN IF NOT DCINPUT THEN TSSED(BLANKS,1) ;           02656100
      NCR ~ STRCNT(NCR, STRINGARRAY[STRINGSIZE], ENDP-T);               02657000
      IF NOT CONTINUE THEN                                              02658000
%                                                                       02659000
         BEGIN FLOG(43); GO TO XIT END;                                 02660000
      IF READACARD THEN;                                                02661000
      IF LISTOG THEN PRINTCARD;                                         02662000
      NCR ~ RSTORE(NCR,STRINGARRAY[STRINGSIZE],ENDP-T+2,T2-(ENDP-T));   02663000
      STRINGSIZE ~ STRINGSIZE+1;                                        02664000
      F1 ~ F1 - T2;                                                     02665000
      T ~ COL1 + 6 + T2 - (ENDP - T);                                   02666000
    END ELSE                                                            02667000
    BEGIN                                                               02668000
       NCR ~ STRCNT(NCR, STRINGARRAY[STRINGSIZE], T2);                  02669000
       STRINGSIZE ~ STRINGSIZE +1;                                      02670000
       T ~ T +T2;                                                       02671000
       F1 ~ F1 - T2;                                                    02672000
    END;                                                                02673000
    END;                                                                02674000
    NUMTYPE ~ STRINGTYPE;                                               02675000
    SCN ~ 1;                                                            02676000
    XIT:                                                                02677000
END HOLLERITH;                                                          02678000
PROCEDURE QUOTESTRING;                                                  02679000
BEGIN                                                                   02680000
   REAL C;                                                              02681000
   LABEL XIT;                                                           02682000
   ALPHA STREAM PROCEDURE STRINGWORD(S,D,SKP,SZ,C);                     02683000
   VALUE S,SKP,SZ;                                                      02684000
   BEGIN                                                                02685000
      LABEL QT, XIT;                                                    02686000
      DI ~ D; SI ~ S;                                                   02687000
      DI ~ DI+SKP; DI ~ DI+2;                                           02688000
      TALLY ~ SKP;                                                      02689000
      SZ( IF SC = """ THEN JUMP OUT TO QT;                              02690000
          IF SC = ":" THEN JUMP OUT TO QT;                              02691000
          IF SC = "@" THEN JUMP OUT TO QT;                              02692000
          IF SC = "]" THEN JUMP OUT TO XIT;                             02693000
          DS ~ CHR; TALLY ~ TALLY+1);                                   02694000
      GO TO XIT;                                                        02695000
      QT: TALLY ~ TALLY+7; SI ~ SI+1;                                   02696000
      XIT: STRINGWORD ~ SI; S ~ TALLY;                                  02697000
      SI ~ LOC S; DI ~ C; DS ~ WDS;                                     02698000
   END STRINGWORD;                                                      02799000
   STRINGSIZE ~ 0;                                                      02700000
   DO                                                                   02701000
   BEGIN                                                                02702000
      IF STRINGSIZE > MAXSTRING THEN                                    02703000
      BEGIN FLAG(120); STRINGSIZE ~ 0 END;                              02704000
      STRINGARRAY[STRINGSIZE] ~ BLANKS;                                 02705000
      NCR ~ STRINGWORD(NCR, STRINGARRAY[STRINGSIZE], 0, 6, C);          02706000
      IF C<6 THEN IF DCINPUT OR FREEFTOG                                02707000
                  THEN BEGIN XTA~BLANKS; FLOG(150); GO TO XIT END       02707500
      ELSE BEGIN                                                        02708000
      IF TSSEDITOG THEN IF NOT DCINPUT THEN TSSED(BLANKS,1) ;           02708100
      IF NOT CONTINUE THEN                                              02709000
%                                                                       02710000
         BEGIN FLOG(121); GO TO XIT END;                                02711000
         IF READACARD THEN;                                             02712000
         IF LISTOG THEN PRINTCARD;                                      02713000
         NCR ~ STRINGWORD(NCR, STRINGARRAY[STRINGSIZE  ],C,6-C,C);      02714000
      END;                                                              02715000
      STRINGSIZE ~ STRINGSIZE + 1;                                      02716000
   END UNTIL C } 7;                                                     02717000
   IF C = 7 THEN STRINGSIZE ~ STRINGSIZE-1;                             02718000
   FNEXT ~ STRINGSIZE;                                                  02719000
   NEXT ~ NUM;                                                          02720000
   SYMBOL ~ NAME ~ STRINGARRAY[0];                                      02721000
   NUMTYPE ~ STRINGTYPE;                                                02722000
   SCN ~ 1;                                                             02723000
   XIT:                                                                 02724000
END QUOTESTRING;                                                        02725000
PROCEDURE CHECKPERIOD;                                                  02726000
BEGIN                                                                   02727000
LABEL FRACTION, XIT, EXPONENT, EXPONENTSIGN;                            02728000
LABEL NUMFINI, FPLP, CHKEXP;                                            02729000
ALPHA S, T, I, TS;                                                      02730000
 INTEGER C2;                                                            02730050
BOOLEAN CON;                                                            02730100
 IF T ~ CHAR ! ".     " THEN GO TO CHKEXP;                              02731000
SCANX(4, 9, 3, 8, 10, 11);                                              02732000
IF T ~ EXACCUM[1] = "      " THEN                                       02733000
  BEGIN IF NUMTYPE ! DOUBTYPE THEN NUMTYPE ~ REALTYPE; GO TO XIT END;   02733500
IF T = "E     " OR T = "D     " THEN GO TO EXPONENTSIGN;                02734000
IF T.[12:6] { 9 THEN GO TO FRACTION;                                    02735000
IF T.[18:6] { 9 THEN                                                    02736000
BEGIN                                                                   02737000
   IF S ~ T.[12:6] ! "E" AND S ! "D" THEN                               02738000
      BEGIN XTA ~ T; FLOG(63); GO TO XIT END;                           02739000
   EXACCUM[1].[12:6] ~ 0;                                               02740000
   I ~ 1; GO TO EXPONENT;                                               02741000
END;                                                                    02742000
IF EXACCUM[0] ! ".     " THEN GO TO XIT;                                02743000
FOR I ~ 0 STEP 1 UNTIL 10 DO                                            02744000
   IF T = PERIODWORD[I] THEN                                            02745000
   BEGIN EXACCUM[2] ~ I; SCN ~ 12; GO TO XIT END;                       02746000
GO TO XIT;                                                              02747000
FRACTION: NEXT ~ NUM;                                                   02748000
IF NUMTYPE !DOUBTYPE THEN NUMTYPE ~ REALTYPE;  XTA ~ ACR1;              02749000
FPLP:                                                                   02750000
F1 ~ 0;                                                                 02751000
XTA  ~ CONVERT(F1,C1,XTA ,TS);                                          02752000
C2 ~ C2 + C1;                                                           02753000
IF (F2 ~ FNEXT|TEN[C1]+F1) { MAX                                        02754000
 THEN FNEXT ~ F2                                                        02755000
 ELSE BEGIN                                                             02756000
      NUMTYPE ~ DOUBTYPE;                                               02757000
       CON ~ TRUE;                                                      02757100
      DOUBLE(FNEXT,DBLOW,TEN[C1],TEN[69+C1],|,                          02758000
             F1,0,+,~,FNEXT,DBLOW);                                     02759000
      END;                                                              02760000
IF TS { 9 THEN GO TO FPLP;                                              02761000
F1 ~ 0;                                                                 02762000
IF T ~ EXACCUM[0] ! "E     " AND T ! "D     " THEN                      02763000
BEGIN IF SCN = 8 THEN SCN ~ 3 ELSE SCN ~ 10;                            02764000
   GO TO NUMFINI;                                                       02765000
END;                                                                    02766000
CHKEXP:  FNEXT ~ FNEXT | 1.0;                                           02767000
F1 ~ 0;                                                                 02768000
I ~ 1;                                                                  02769000
SCANX(4, 4, 3, 3, 20, 10);                                              02770000
IF SCN = 20 THEN                                                        02771000
EXPONENTSIGN:                                                           02772000
BEGIN IF S ~ EXACCUM[0] ! "+     " AND S ! "&     " THEN                02773000
      IF S = "-     " THEN I ~ -1 ELSE                                  02774000
         BEGIN XTA ~ S; FLOG(63); SCN ~ 10; GO TO XIT END;              02775000
      SCANX(4, 4, 3, 3, 10, 10);                                        02776000
   END;                                                                 02777000
   IF (S ~ EXACCUM[1]).[12:6] > 9 THEN                                  02778000
   BEGIN XTA ~ IF S ! BLANKS THEN S ELSE T; FLOG(63); GO TO XIT END;    02778100
   EXPONENT:                                                            02779000
   IF NUMTYPE ! DOUBTYPE THEN NUMTYPE ~ REALTYPE;                       02779500
IF T.[12:6] = "D" THEN NUMTYPE ~ DOUBTYPE;                              02780000
   IF SCN = 8 THEN SCN ~ 3 ELSE IF SCN = 11 THEN SCN ~ 10;              02781000
   XTA ~ ACR1;                                                          02782000
   XTA  ~ CONVERT(F1,C1,XTA ,TS);                                       02783000
   IF I < 0 THEN F1 ~ -F1;                                              02784000
   NUMFINI:                                                             02785000
   C1 ~ F1 - C2;                                                        02786000
   IF I ~ (ABS(C1+(FNEXT.[3:6]&FNEXT[1:2:1]))) > 63 OR((ABS(C1) = I OR  02787000
       FNEXT } 5) AND ABS(F1) } 69)                                     02787500
    THEN BEGIN XTA ~ T; FLOG(87); GO TO XIT; END;                       02788000
   IF NUMTYPE ! DOUBTYPE THEN                                           02789000
   BEGIN                                                                02790000
      IF C1} 0 THEN FNEXT ~ FNEXT | TEN[C1]                             02791000
               ELSE FNEXT ~ FNEXT / TEN[-C1];                           02792000
   END ELSE                                                             02793000
   BEGIN                                                                02794000
      IF C1 } 0                                                         02795000
         THEN DOUBLE(FNEXT,DBLOW,TEN[C1],TEN[69+C1],|,~,FNEXT,DBLOW)    02796000
         ELSE DOUBLE(FNEXT,DBLOW,TEN[-C1],TEN[69-C1],/,~,FNEXT,DBLOW);  02797000
      IF CON THEN IF DBLOW.[9:33] = MAX.[9:33] THEN                     02797100
       IF FNEXT.[3:6] LSS 14                                            02797150
         THEN IF BOOLEAN(FNEXT.[2:1]) THEN                              02797200
           BEGIN DBLOW ~ 0; FNEXT ~ FNEXT + 1&FNEXT[2:2:7]; END;        02797300
   END;                                                                 02798000
   XIT:                                                                 02799000
END CHECKPERIOD;                                                        02800000
LABEL LOOP0, NUMBER ;                                                   02801000
LABEL L,XIT;                                                            02802000
LABEL L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11,L12,L13,L14,L15,L16,L17,       02802100
      L18,L19,L20,L21,BK ;                                              02802200
SWITCH CASEL~L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11,L12,L13,L14,L15,        02802300
              L16,L17,L18,L19,L20,L21 ;                                 02802400
LABEL LOOP, CASESTMT;                                              %994-02803000
LABEL CASE0,CASE1,CASE2,CASE3,CASE4,CASE5,CASE6,CASE7;             %994-02803100
LABEL CASE8,CASE9,CASE10,CASE11,CASE12,CASE13,CASE14;              %994-02803200
PREC~NEXT~FNEXT~REAL(SCANENTER~FALSE) ;                                 02804000
CASESTMT:                                                               02805000
CASE SCN OF                                                             02806000
BEGIN                                                                   02807000
CASE0:                                                             %994-02807999
GO TO IF LABELR THEN CASE5 ELSE CASE1;                                  02808000
CASE1:                                                                  02809000
BEGIN                                                                   02810000
   LOOP0:                                                               02810100
   ACR ~ ACR0;                                                          02811000
   ACCUM[1] ~ BLANKS;                                                   02812000
   LOOP:                                                                02813000
   IF ADVANCE(NCR, ACR, CHR0, NCR, ACR) THEN                            02814000
      IF CONTINUE THEN                                                  02815000
%                                                                       02816000
         IF READACARD THEN                                              02817000
              BEGIN                                                     02818000
              IF LISTOG THEN PRINTCARD ;                                02818010
              IF ACR.[33:15]}ACCUMSTOP THEN                             02818020
                   BEGIN XTA~BLANKS; FLOG(175); GO LOOP0 END ;          02818030
              GO LOOP ;                                                 02818040
              END                                                       02818050
         ELSE IF T ~ ACCUM[1] = "      " THEN GO TO CASE5 ELSE SCN ~ 4  02819000
      ELSE IF T ~ ACCUM[1] = "      " THEN                              02820000
            GO TO CASE3 ELSE SCN ~ 3                                    02821000
   ELSE IF T ~ ACCUM[1] = "      " THEN GO TO CASE2 ELSE SCN ~ 2;       02822000
END;                                                                    02823000
CASE2:                                                                  02824000
BEGIN T ~ CHAR; SCN ~ 1 END;                                            02825000
CASE3:                                                                  02826000
BEGIN T ~ ";     "; NEXT ~ SEMI; SCN ~ 0;                               02827000
      IF EOSTOG THEN IF LOGIFTOG THEN BEGIN LOGIFTOG ~ FALSE; XTA ~ T;  02827100
                  FLAG(101); END;                                       02827200
      GO TO XIT;                                                        02827300
END;                                                                    02827400
CASE4:                                                             %994-02827999
BEGIN T ~ ";     "; NEXT ~ SEMI; SCN ~ 5; GO TO XIT END;                02828000
CASE5:                                                                  02829000
BEGIN T ~ "<EOF> "; NEXT ~ EOF; EOSTOG ~ FALSE; GO TO XIT END;          02830000
CASE6:                                                             %994-02830999
BEGIN T ~ ACCUM[1] ~ NEXTACC; SCN ~ NEXTSCN;                            02831000
   IF T = "      " THEN GO TO CASESTMT;                                 02832000
END;                                                                    02833000
CASE7:                                                             %994-02833999
BEGIN EOSTOG ~ TRUE;                                                    02834000
   IF LABELR THEN GO TO CASE5 ELSE GO TO CASE1;                         02835000
END;                                                                    02836000
CASE8:                                                             %994-02836999
BEGIN T ~ EXACCUM[1]; SCN ~ 3 END;                                      02837000
CASE9:                                                             %994-02837999
BEGIN T ~ EXACCUM[1]; SCN ~ 4 END;                                      02838000
CASE10:                                                            %994-02838999
BEGIN T ~ CHAR ~ EXACCUM[0]; SCN ~ 1  END;                              02839000
CASE11:                                                            %994-02839999
BEGIN T ~ EXACCUM[1]; SCN ~ 10 END;                                     02840000
CASE12:                                                            %994-02840999
BEGIN T ~ EXACCUM[1]; SCN ~ 1;                                          02841000
   IF N ~ EXACCUM[2] { 1 THEN                                           02842000
   BEGIN NEXT ~ NUM; FNEXT ~ N; GO TO XIT END;                          02843000
   NEXT ~ 0;                                                            02844000
   OP ~ N-1;                                                            02845000
   PREC ~ IF N { 4 THEN N-1 ELSE 4;                                     02846000
   GO TO XIT;                                                           02847000
END;                                                                    02848000
CASE13:                                                            %994-02848999
BEGIN T ~ "FUNCTI"; NEXT ~ 16; SCN ~ 6; GO TO XIT END;                  02849000
CASE14:                                                            %994-02849999
BEGIN T ~ ACCUM[1] ~ NEXTACC;                                           02850000
   NEXTACC ~ NEXTACC2; SCN ~ 6;                                         02851000
END;                                                                    02852000
END OF CASE STATEMENT;                                                  02853000
IF NOT FILETOG THEN                                                     02854000
   IF EOSTOG THEN                                                       02855000
      BEGIN                                                             02856000
         NEXT ~ 0;                                                      02857000
         IF T = ";     " THEN GO TO CASESTMT;                           02858000
         CHECKRESERVED;                                                 02859000
         IF NEXT > 0 THEN GO TO XIT;                                    02860000
      END;                                                              02861000
IF (IDINFO~TIPE[T.[12:6]])>0 THEN                                       02862000
    BEGIN                                                               02862100
BK: NEXT~ID ;                                                           02862200
    IF NOT FILETOG THEN                                                 02862300
         IF SCANENTER~((FNEXT~SEARCH(T))=0) THEN FNEXT~ENTER(IDINFO,T)  02862400
         ELSE IF GET(FNEXT).CLASS=DUMMY THEN FNEXT~GET(FNEXT+2).BASE ;  02862500
    GO XIT ;                                                            02862600
    END ;                                                               02862700
GO CASEL[-IDINFO];    % SEE INITIALIZATION OF "TIPE". LINE 03433100%993-02862800
L1:      %DIGITS                                                   %993-02863000
BEGIN NUMTYPE ~ INTYPE; NEXT ~ NUM;  XTA ~ ACR0;                        02864000
    FNEXT ~ DBLOW ~ C1 ~ 0;                                             02865000
   XTA  ~ CONVERT(FNEXT,C1,XTA ,TS);                                    02866000
   WHILE TS { 9 DO                                                      02867000
      BEGIN                                                             02868000
         XTA  ~ CONVERT(F1,C1,XTA ,TS);                                 02869000
         IF (F2 ~ FNEXT|TEN[C1]+F1) { MAX                               02870000
          THEN FNEXT ~ F2                                               02871000
           ELSE BEGIN                                                   02872000
                   NUMTYPE ~ DOUBTYPE;                                  02873000
                   DOUBLE(FNEXT,DBLOW,TEN[C1],TEN[69+C1],|,             02874000
                          F1,0,+,~,FNEXT,DBLOW);                        02875000
               END;                                                     02876000
      END;                                                              02877000
   IF CHAR = ".     " OR CHAR = "E     " OR CHAR = "D     " THEN        02878000
    CHECKPERIOD                                                         02879000
   ELSE IF CHAR = "H     " THEN HOLLERITH;                              02883000
   GO TO XIT;                                                           02884000
END;                                                                    02885000
L2:      % >                                                      %993- 02898100
BEGIN PREC ~ 4; OP ~ 7; GO TO XIT END;                                  02899000
L3:      % }                                                      %993- 02899100
BEGIN PREC ~ 4; OP ~ 8; GO TO XIT END;                                  02900000
L4:      % & OR +                                                 %993- 02900100
BEGIN PREC ~ 5; OP ~ 10; NEXT ~ PLUS; GO TO XIT END;                    02901000
L5:      % .                                                      %993- 02910100
BEGIN                                                                   02911000
    FNEXT ~ DBLOW ~ C1 ~ 0; NUMTYPE ~ REALTYPE;                         02912000
   CHECKPERIOD;                                                         02913000
      T ~ EXACCUM[1];                                                   02914000
   IF SCN = 12 THEN                                                     02915000
   BEGIN SCN ~ 1;                                                       02916000
   IF N ~ EXACCUM[2] { 1 THEN                                           02917000
   BEGIN                                                                02918000
      NEXT ~ NUM; FNEXT ~ N;                                            02919000
      NUMTYPE ~ LOGTYPE; GO TO XIT;                                     02920000
   END;                                                                 02921000
   NEXT ~ 0;                                                            02922000
   OP ~ N-1;                                                            02923000
   PREC ~ IF N { 4 THEN N-1 ELSE 4;                                     02924000
   GO TO XIT;                                                           02924100
END;                                                                    02925000
   IF NEXT ! NUM THEN BEGIN NEXT ~ NUM; XTA ~ T; FLOG(141) END;         02925100
   GO TO XIT;                                                           02926000
END;                                                                    02927000
L6:      % % OR (                                                  %993-02929100
BEGIN NEXT ~ LPAREN; GO TO XIT END;                                     02930000
L7:      % <                                                       %993-02930100
BEGIN PREC ~ OP ~ 4; GO TO XIT END;                                     02931000
L8:      % LETTER 0                                                %993-02938100
BEGIN IF DATATOG THEN IF CHECKOCTAL THEN GO TO XIT;                     02939000
    IDINFO~TIPE[12];  GO BK ;                                           02939100
END;                                                                    02939200
L9:      % $                                                       %993-02942100
BEGIN NEXT ~ DOLLAR; GO TO XIT END;                                     02943000
L10:     % *                                                       %993-02943100
IF CHECKEXP(NCR, NCR, T) THEN                                           02944000
BEGIN PREC ~ 9; OP ~ 15; NEXT ~ UPARROW; GO TO XIT END ELSE             02945000
L11:                                                                    02945100
BEGIN PREC ~ 7; OP ~ 13; NEXT ~ STAR; GO TO XIT END;                    02946000
L12:     % -                                                       %993-02946100
BEGIN PREC ~ 5; OP ~ 11; NEXT ~ MINUS; GO TO XIT END;                   02947000
L13:     % ) OR [                                                  %993-02947100
BEGIN NEXT ~ RPAREN; GO TO XIT END;                                     02948000
L14:     % ;                                                       %993-02948100
BEGIN NEXT ~ SEMI; GO TO XIT END;                                       02949000
L15:     % {                                                       %993-02949100
BEGIN PREC ~ 4; OP ~ 5; GO TO XIT END;                                  02950000
L16:     % /                                                       %993-02951100
BEGIN PREC ~ 7; OP ~ 14; NEXT ~ SLASH; GO TO XIT END;                   02952000
L17:     % ,                                                       %993-02960100
BEGIN NEXT ~ COMMA; GO TO XIT END;                                      02961000
L18:     % !                                                       %993-02962100
BEGIN PREC ~ 4; OP ~ 9; GO TO XIT END;                                  02963000
L19:     % = OR ~ OR #                                            %993- 02963100
BEGIN NEXT ~ EQUAL; GO TO XIT END;                                      02964000
L20:     % ]                                                       %993-02964100
BEGIN XTA ~ T; FLAG(0); GO TO CASESTMT END;                             02965000
L21:     % " OR : OR @                                             %993-02965100
BEGIN QUOTESTRING; GO TO XIT END;                                       02966000
XIT:                                                                    02971000
IF DEBUGTOG THEN WRITALIST(FD,3,NEXT,T,"      ",0,0,0,0,0) ;            02972000
                                                                        02973000
   XTA ~ NAME ~ T;                                                      02974000
END SCAN;                                                               02975000
PROCEDURE WRAPUP;                                                       02976000
         COMMENT WRAPUP OF COMPILIATION;                                02977000
    BEGIN                                                               02978000
ARRAY PRT[0:7,0:127],                                                   02979000
  SEGDICT[0:7,0:127],                                                   02980000
     SEG0[0:29];                                                        02981000
ARRAY FILES[0:BIGGESTFILENB];                                           02982000
INTEGER THEBIGGEST;                                                     02983000
SAVE ARRAY FPB[0:1022]; % FILE PARAMETER BLOCK                          02984000
REAL FPS,FPE;           % START AND END OF FPB                          02985000
REAL GSEG,PRI,FID,MFID,IDNM,FILTYP,FPBI;                                02986000
BOOLEAN ALF;                                                            02987000
REAL PRTADR, SEGMNT, LNK, TSEGSZ, T1, I, FPBSZ;                         02988000
    DEFINE                                                              02988900
         SPDEUN= FPBSZ#,                                                02988910
    ENDDEF=#;                                                           02988990
ARRAY INTLOC[0:150];                                                    02989000
REAL J;                                                                 02990000
FORMAT SEGUS(A6, "  IS SEGMENT ", I4,                                   02991000
         ", PRT IS ", A4, ".");                                         02992000
LIST SEGLS(IDNM,NXAVIL,T1);                                             02993000
LABEL LA, ENDWRAPUP;                                                    02997000
 LABEL QQQDISKDEFAULT;                                             %503-02997010
                   COMMENT FORMAT OF SEGMENT DICTIONARY -RUN TIME ;     02998000
DEFINE        SGTYPF= [1:2]#, %0 = PROGRAM SEGMENTS                     02999000
              SGTYPC= 1:46:2#,%1 = MCP INTRINSIC                        03000000
                              %2 = DATA SEGMENT                         03001000
              PRTLINKF= [8:10]#,  % LINK TO FIRT PRT ENTRY              03002000
              PRTLINKC= 8:38:10#,                                       03003000
              SGLCF   = [18:15]#, % SEGMENT SIZE                        03004000
              SGLCC   = 23:38:10#,                                      03005000
              DKADRF  = [33:15]#, % RELATIVE DISK ADDRESS OF SEGMENT    03006000
                                  % OR MCP INTRINSIC NUMBER             03007000
              DKADRC  = 33:13:15#;                                      03008000
         COMMENT FORMAT OF FIRST SEGMENT OF CODE FILE- RUN TIME;        03009000
COMMENT SEGO[0:29]                                                      03010000
              WORD      CONTENTS                                        03011000
               0        LOCATION OF SEGMENT DICTIONARY                  03012000
               1        SIZE OF SEGMENT DICTIONARY                      03013000
               2        LOCATION OF PRT                                 03014000
               3        SIZE OF PRT                                     03015000
               4        LOCATION OF FILE PARAMETER BLOCK                03016000
               5        SIZE OF FILE PARAMETER BLOCK                    03017000
               6        STARTING SEGMENT NUMBER                         03018000
               7-[2:1] IND FORTRAN FAULT DEC                            03018100
               7-[18:15] NUMBER OF FILES                                03019000
               7-[33:15] CORE REQUIRED/64                               03020000
              ;                                                         03021000
         COMMENT FORMAT OF PRT;                                         03022000
           %  FLGF = [0:4] = 1101 = SET BY STREAM                       03023000
DEFINE        MODEF =[4:2]#,  % 0 = THUNK                               03024000
              MODEC=4:46:2#,  % 1 = WORD MODE PROGRAM DESCRIPTOR        03025000
                              % 2 = LABEL DESCRIPTOR                    03026000
                              % 3 = CHARACTER MODE PROGRAM DESCRIPTOR   03027000
              STOPF =[6:1]#,  % STOPPER = 1 FOR LAST DESCRIPTOR IN      03028000
              STOPC=6:47:1#,  % CHAIN OF SAME SEGMENT DESCRIPTORS       03029000
              LINKF =[7:11]#, % IF STOP = 0 THEN PRTLINK                03030000
              LINKC=7:37:11#, %             ELSE LINK TO SEGDICT        03031000
              FFF   =[18:15]#,% INDEX INTO SEGMENT DICTIONARY           03032000
              FFC   =18:33:15#,                                         03033000
              SINX = [33:15]#;% RELATIVE ADDRESS INTO SEGMENT           03034000
DEFINE        PDR = [37:5]#,                                            03035000
              PDC = [42:6]#;                                            03036000
REAL STREAM PROCEDURE MKABS(F);                                         03037000
    BEGIN                                                               03038000
         SI ~ F; MKABS ~ SI;                                            03039000
    END MKABS;                                                          03040000
REAL STREAM PROCEDURE BUILDFPB(DEST,FILNUM,FILTYP,MFID,FID,IDSZ,        03041000
                                  IDNM,SPDEUN);                         03042000
     VALUE     DEST,IDSZ,SPDEUN;                                        03043000
     BEGIN                                                              03044000
          DI ~ DEST;                                                    03045000
          SI ~ FILNUM; SI ~ SI + 6; DS ~ 2 CHR;                         03046000
          SI ~ FILTYP; SI ~ SI + 7; DS ~ CHR;                           03047000
          SI ~ MFID; SI ~ SI + 1; DS ~ 7 CHR;                           03048000
          SI ~ FID; SI ~ SI + 1; DS ~ 7 CHR;                            03049000
          SI ~ LOC IDSZ; SI ~ SI + 7; DS ~ CHR;                         03050000
          SI ~ IDNM; SI ~ SI + 1; DS ~ IDSZ CHR;                        03051000
          SI~LOC SPDEUN;SI~SI+6;DS~2 CHR;%   DISK SPEED & EU NUMBER+1   03051200
          BUILDFPB ~ DI;                                                03052000
          DS ~ 2 LIT "0";                                               03053000
     END BUILDFPB;                                                      03054000
REAL STREAM PROCEDURE GITSZ(F);                                         03055000
    BEGIN                                                               03056000
         SI ~ F; SI ~SI + 7; TALLY ~ 7;                                 03057000
         3(IF SC ! " " THEN JUMP OUT;                                   03058000
           SI ~SI - 1; TALLY ~ TALLY + 63;);                            03059000
         GITSZ ~ TALLY;                                                 03060000
    END GITSZ;                                                          03061000
STREAM PROCEDURE MOVE(F,T,SZ); VALUE SZ;                                03062000
    BEGIN                                                               03063000
         SI ~ F; DI ~T; DS ~ SZ WDS;                                    03064000
         END MOVE;                                                      03065000
INTEGER PROCEDURE MOVEANDBLOCK(FROM,SIZE); VALUE SIZE;                  03066000
    ARRAY FROM[0,0]; INTEGER SIZE;                                      03067000
    BEGIN                                                               03068000
         REAL T,NSEGS,J,I;                                              03069000
    STREAM PROCEDURE M2(F,T); BEGIN SI~F; DI~T; DS ~ 2 WDS; END M2;     03070000
         NSEGS ~ (SIZE+29) DIV 30;                                      03071000
         IF DALOC DIV CHUNK < T ~ (DALOC + NSEGS) DIV CHUNK             03072000
           THEN DALOC ~ CHUNK | T;                                      03073000
         MOVEANDBLOCK ~ DALOC;                                          03074000
         DO BEGIN FOR J ~ 0 STEP 2 WHILE J < 30 AND I<SIZE DO           03075000
          BEGIN                                                         03076000
              M2(FROM[I.[36:5],I.[41:7]],CODE(J));                      03077000
              I ~ I+2;                                                  03078000
          END;                                                          03079000
              WRITE(CODE[DALOC]);                                       03080000
              DALOC ~ DALOC + 1;                                        03081000
            END UNTIL I } SIZE;                                         03082000
    END MOVEANDBLOCK;                                                   03083000
STREAM PROCEDURE MDESC(VLU,PRT); VALUE VLU;                             03084000
    BEGIN                                                               03085000
         DI ~ LOC VLU; DS ~ SET;   % FLAG BIT                           03086000
         DI ~ PRT; SI ~ LOC VLU; DS ~ WDS;                              03087000
    END MDESC;                                                          03088000
INTEGER STREAM PROCEDURE MAKEINT(S);                                    03089000
BEGIN LABEL LOOP;     LOCAL T;                                          03090000
SI ~ S;   SI ~ SI + 3;                                                  03091000
LOOP: IF SC } "0" THEN                                                  03092000
      BEGIN TALLY ~ TALLY + 1;   SI ~ SI + 1;  GO TO LOOP;   END;       03093000
T ~ TALLY;   SI ~ S;  SI ~ SI + 3;  DI ~ LOC MAKEINT;  DS ~ T OCT;      03094000
END MAKEINT;                                                            03095000
LABEL FOUND;                                                            03096000
FORMAT                                                                  03097000
         FILEF(A1, A6, X1,                                              03098000
         "FILE IDENTIFIER, PRT IS ", A4, "."),                          03099000
         BLOKF(A6, X5, "COMMON BLOCK, PRT IS ", A4,                     03100000
              ", LENGTH IS ", I5, " WORDS.");                           03101000
         COMMENT DUMP OUT ACCUMULATED FORMAT AND NAME ARRAYS;           03102000
            IF FNNINDEX ! 0 THEN                                        03103000
            BEGIN FNNPRT ~ PRGDESCBLDR(1,FNNPRT,0,NXAVIL ~ NXAVIL + 1); 03104000
                  WRITEDATA(FNNINDEX,NXAVIL,FNNHOLD);                   03105000
            END;                                                        03106000
             IF SAVESUBS > 0 THEN                                       03106100
               BEGIN T1 ~ GET(T ~ GLOBALSEARCH(".SUBAR")+2);            03106125
                     PUT(T,T1~T1&SAVESUBS[TOSIZE]);                     03106150
               END;                                                     03106175
         T1~PRGDESCBLDR(1,23,0,NSEG~NXAVIL~NXAVIL+1) ; % BUILD TPAR     03106200
         FILL LSTT[*] WITH 21(0),8("        ") ;       % R+23           03106205
         WRITEDATA(29,NXAVIL,LSTT) ;                                    03106210
         PDPRT[(PDINX-1).[37:5],(PDINX-1).[42:6]].[6:1]~1 ; % SAVE BIT  03106215
         T1 ~ PRGDESCBLDR(1,22,0,NSEG ~ NXAVIL ~ NXAVIL + 1);           03107000
         WRITEDATA (138,NXAVIL,TEN);   % POWERS OF TEN TABLE            03108000
         IF  LSTI > 0 THEN                                              03109000
    BEGIN                                                               03110000
         WRITEDATA(LSTI, NXAVIL ~ NXAVIL+1, LSTP);                      03111000
         LSTA ~ PRGDESCBLDR(1, LSTA, 0, NXAVIL);                        03112000
    END;                                                                03113000
         IF TWODPRTX ! 0 THEN                                           03114000
    BEGIN                                                               03115000
         FILL LSTT[*] WITH                                              03116000
         OCT0000000421410010,                                           03117000
         OCT0301001301412025,                                           03118000
         OCT2021010442215055,                                           03119000
         OCT2245400320211025,                                           03120000
         OCT0106177404310415,                                           03121000
         OCT1025042112350000;                                           03122000
         T ~ PRGDESCBLDR(0, TWODPRTX, 0, NXAVIL ~ NXAVIL+1);            03123000
         WRITEDATA(-6, NXAVIL, LSTT);                                   03124000
    END;                                                                03125000
              COMMENT DECLARE GLOBAL FILES AND ARRAYS;                  03126000
         FPS ~ FPE ~ MKABS(FPB);                                        03127000
         SEGMENTSTART;                                                  03128000
         F2TOG ~ TRUE;                                                  03129000
         GSEG ~ NSEG;                                                   03130000
         FPBI ~ 0;                                                      03131000
         EMITL(0); EMITL(2); EMITO(SSF);                                03132000
         EMITL(1);           % SET BLOCK COUNTER TO 1                   03133000
         EMITL(16); EMITO(STD);                                         03134000
         EMITL(0); EMITOPDCLIT(23); EMITO(DEL);                         03138000
         EMITL(REAL(HOLTOG)); EMITPAIR(21,STD);                         03139000
         I ~ GLOBALNEXTINFO;  WHILE I < 4093 DO                         03140000
    BEGIN                                                               03141000
         I ~ I+3;                                                       03142000
         GETALL(I,INFA,INFB,INFC);                                      03143000
     IF INFA.CLASS = FILEID THEN   %SEE COMMENTS ON LINE 02118000  %992-03144000
    BEGIN                                                               03145000
         FPBI ~ FPBI + 1;                                               03146000
         PRI ~ INFA   .ADDR;                                            03147000
         IF (XTA ~ INFB   ).[18:6] < 10 THEN                            03148000
    BEGIN                                                               03149000
         IF XTA ~ MAKEINT(XTA) > BIGGESTFILENB THEN FLAG(77) ELSE       03150000
         FILES[XTA] ~ PRI;                                              03151000
         IF XTA > THEBIGGEST THEN THEBIGGEST ~ XTA;                     03152000
    END;                                                                03153000
         EMITO(MKS);                                                    03154000
         IF J ~ INFC   .ADINFO ! 0 THEN   %  OPTION FILE                03155000
    BEGIN FILTYP ~ INFC   .LINK;                                        03156000
         IDNM ~ "      "&"FILE"[6:24:24]&INFB[30:18:18];                03157000
         T1 ~ GITSZ(IDNM);                                              03158000
         FID ~ FILEINFO[2,J];                                           03159000
         MFID ~ FILEINFO[1,J];                                          03160000
         IF FILTYP}10 AND (T~FILEINFO[3,J].DKAREASZ)!0 THEN             03161000
              BEGIN %%% SET UP <DISK FILE DESCRIPTION>;                 03162000
              SPDEUN~FILEINFO[3,J].SENSPDEUNF;                          03162005
              B~IF (B~((J~FILEINFO[0,J]).[18:12])/(IF A~J.[30:12]{0 THEN03162007
                 1 ELSE A)){0 THEN 1 ELSE B ;                           03162014
                    %%% B=ORIGINAL "BLOCKING" SIZE = # LOGRECS/PHYSREC. 03162020
              A~ENTIER(B|ENTIER(T/(20|B)+.999999999)+.5) ;              03162030
                    %%% T="AREA" SIZE = # LOGRECS IN TOTAL FILE.        03162040
                    %%% A=# LOGRECS PER ROW.                            03162050
              B~ENTIER(T/A+.999999999) ;                                03162060
                    %%% B = # ROWS IN FILE.                             03162070
                    %%% EQUIVALENT ALGOL FILE DESCRIPTION = [B:A].      03162080
                    %%% THE ABOVE LOGIC YIELDS: SHORTEST ROW CONTAINING 03162090
                    %%% AN INTEGER NUMBER OF PHYSICAL RECORDS AND WHICH 03162100
                    %%% REQUIRES 20 OR FEWER ROWS FOR THE TOTAL AREA, T.03162110
              EMITNUM(B); EMITNUM(A) ;                                  03162120
              END ELSE                                                  03162129
              BEGIN EMITL(0); EMITL(0);                                 03163000
                    J ~ FILEINFO[0,J]; % THIS ONE HAS ALL THE GOODIES   03164000
              END;                                                      03164010
 QQQDISKDEFAULT:                                                   %503-03164045
         ESTIMATE~ESTIMATE+(J.[42:6])|(IF A~J.[18:12]=0 THEN J.[30:12]  03164050
              ELSE A) ;                                                 03164100
         EMITL(J.[4:2]);   %  LOCK                                      03165000
         EMITL(FPBI);   %   FILE PARAM INDEX                            03166000
                                                                        03167000
         EMITDESCLIT(PRI);   %  PRT OF FILE                             03168000
         EMITL(J.[42:6]);   %  # BUFFERS                                03169000
         EMITL(J.[3:1]);  %  RECORDING MODE                             03170000
         EMITNUM(J.[30:12]) ;  % RECORD SIZE                            03171000
         EMITNUM(J.[18:12]) ;  % BLOCK SIZE                             03172000
         EMITNUM(J.[ 6:12]) ;  % SAVE FACTOR                            03173000
    END ELSE                                                            03174000
    BEGIN                                                               03175000
         ALF ~TRUE;                                                     03176000
         IF(FILTYP~INFC.LINK=2 OR FILTYP=12)AND INFB.[18:6]{9 THEN      03177000
           IDNM ~ 0&"FILE"[6:24:24]&INFB[30:18:18]                      03178000
              ELSE                                                      03179000
    BEGIN                                                               03180000
         ALF ~ FALSE;                                                   03181000
              IF (IDNM ~ "    "&INFB[6:18:30]) = "READR  " THEN         03182000
                  IDNM ~ "READER ";                                     03183000
    END;                                                                03184000
IF IDNM="READER " OR IDNM="FILE5  " THEN IDNM~"CARD   " ELSE       %503-03184010
IF IDNM="FILE6  " THEN BEGIN IDNM~"PRINTER";FILTYP~18;END ELSE     %503-03184020
 BEGIN                                                             %503-03184030
 EMITL(20);  EMITL(600);  FILTYP~12;  %20 | 600 REC DISK           %503-03184040
    J~0&2[42:42:6]&10[30:36:12]&300[18:36:12];                     %503-03184050
 FID~IDNM;  MFID~"FORTEMP";  T1~GITSZ(IDNM);                       %503-03184054
     GO TO QQQDISKDEFAULT;                                         %503-03184060
 END;                                                              %503-03184070
        T1 ~ GITSZ(IDNM);                                               03185000
        FID ~ IDNM;                                                     03186000
        MFID ~ 0;                                                       03187000
     IF DCINPUT AND ALF THEN BEGIN                                      03187100
        EMITL(20);           % DISK ROWS                                03187200
        EMITL(100);          % DISK RECORD PER ROW                      03187300
        EMITL(2);            % REWIND AND LOCK                          03187400
        EMITL(FPBI);         % FILE NUMBER                              03187450
        EMITDESCLIT(PRI);    % PRT OF FILE                              03187500
        EMITL(2);            % NUMBER OF BUFFERS                        03187550
        EMITL(1);            % RECORDING MODE                           03187600
        EMITL(10);           % RECORD SIZE                              03187650
        EMITL(30);           % BLOCK SIZE                               03187700
        EMITL(1);            % SAVE FACTOR                              03187750
     END ELSE                                                           03187800
     BEGIN                                                              03187900
        EMITL(0);      % DISK ROWS                                      03188000
        EMITL(0);      % DISK RECORDS PER ROW                           03189000
        EMITL(0);      % REWIND & RELEASE                               03190000
        EMITL(FPBI);   % FILE NUMBER                                    03191000
                                                                        03192000
        EMITDESCLIT(PRI);  % PRT OF FILE                                03193000
        EMITL(2);      % 2 BUFFERS                                      03194000
        EMITL(REAL(ALF));                                               03195000
        EMITL(IF FILTYP = 0 THEN 10 ELSE 17);                           03196000
        EMITL(0);     % 15 WORD BUFFERS                                 03197000
        EMITL(0);      % SAVE FACTOR (SCRATCH BY DEFAULT)               03198000
     END;                                                               03198500
   END;                                                                 03199000
        EMITL(11);     % INPUT OR OUTPUT                                03200000
        EMITL(8);      % SWITCH CODE FOR BLOCK                          03201000
        EMITOPDCLIT(5);  % CALL BLOCK                                   03202000
        FPE~BUILDFPB(FPE,FPBI,FILTYP,MFID,FID,T1,IDNM,SPDEUN);          03203000
        IF PRTOG THEN WRITALIST(FILEF,3,IDNM.[6:6],IDNM,B2D(PRI),       03204000
        0,0,0,0,0) ;                                                    03204010
   END                                                                  03205000
        ELSE                                                            03206000
        IF INFA.CLASS = BLOCKID THEN                                    03207000
   BEGIN                                                                03208000
        IF PRTOG THEN WRITALIST(BLOKF,3,INFB,B2D(INFA.ADDR),            03209000
        INFC.SIZE,0,0,0,0,0) ;                                          03210000
        IF INFA < 0 THEN ARRAYDEC(I);                                   03211000
   END;                                                                 03212000
        IF (T1 ~ INFA   .CLASS) } FUNID                                 03213000
         AND T1 { SUBRID THEN                                           03214000
   BEGIN                                                                03215000
        PRI ~ 0;                                                        03216000
        IF INFA   .SEGNO = 0 THEN                                       03217000
   BEGIN                                                                03218000
        A~0;  B~NUMINTM1 ;                                              03219000
        WHILE A+1 < B DO                                                03220000
        BEGIN                                                           03221000
           PRI ~ REAL(BOOLEAN(A+B) AND BOOLEAN(1022));                  03222000
           IF IDNM ~ INT[PRI] = INFB THEN GO TO FOUND;                  03223000
           IF INFB < IDNM THEN B ~ PRI.[36:11] ELSE A ~ PRI.[36:11];    03224000
        END;                                                            03225000
        IF IDNM ~ INT[PRI~(A+B)|2-PRI] = INFB THEN GO TO FOUND;         03226000
        XTA ~ INFB; FLAG(30);                                           03227000
        GO TO LA;                                                       03228000
   FOUND:                                                               03229000
        IF (T1~INT[PRI+1].INTPARMS)!0                                   03230000
        AND INFC     < 0                                                03231000
        THEN IF T1 ! INFC.NEXTRA THEN                                   03232000
           BEGIN XTA ~ INFB   ; FLAG(28); END;                          03233000
        IF (FID~INTLOC[MFID~INT[PRI+1].INTNUM])=0 THEN                  03234000
   BEGIN                                                                03235000
        PDPRT[PDIR,PDIC] ~                                              03236000
          0&1[STYPC]                                                    03237000
           &MFID[DKAC]                                                  03238000
           &(FID ~ INTLOC[MFID] ~ NXAVIL ~ NXAVIL + 1)[SGNOC]           03239000
           &1[SEGSZC];                                                  03240000
        PDINX ~ PDINX + 1;                                              03241000
   END;                                                                 03242000
        T1 ~ PRGDESCBLDR(1,INFA   .ADDR,0,FID);                         03243000
        IF PRTOG THEN WRITALIST(SEGUS,3,IDNM,FID,B2D(T1),0,0,0,0,0) ;   03244000
        IF INT[PRI+1] < 0 THEN                                          03245000
   BEGIN                                                                03246000
        T1 ~ PRGDESCBLDR(1,INT[PRI+1].INTPRT,0,FID);                    03247000
        INT[PRI+1] ~ ABS(INT[PRI + 1]);                                 03248000
   END;                                                                 03249000
   END                                                                  03250000
        ELSE IF PRTOG THEN WRITALIST(SEGUS,3,INFB,                      03251000
        INFA.SEGNO,B2D(INFA.ADDR),0,0,0,0,0) ;                          03252000
   END;                                                                 03253000
   LA:                                                                  03254000
   END;                                                                 03255000
COMMENT MUST FOLLOW THE FOR STATEMENT;                                  03256000
IF FILEARRAYPRT ! 0 THEN                                                03257000
BEGIN   %  BUILDING OBJECT TIME FILE SEARCH ARRAY                       03258000
      J ~ PRGDESCBLDR(1,FILEARRAYPRT,0,NXAVIL ~ NXAVIL + 1);            03259000
      WRITEDATA(THEBIGGEST + 1,NXAVIL,FILES);                           03260000
END;                                                                    03261000
         XTA ~ BLANKS;                                                  03262000
         IF NXAVIL > 1023 THEN FLAG(45);                                03263000
         IF PRTS > 1023 THEN FLAG(46);                                  03264000
         IF STRTSEG = 0 THEN FLAG(65);                                  03265000
         PRI ~ 0;                                                       03266000
         WHILE (IDNM ~ INT[PRI]) ! 0 DO                                 03267000
         IF INT[PRI+1] } 0 THEN PRI ~ PRI + 2 ELSE                      03268000
    BEGIN                                                               03269000
         IF (FID~INTLOC[MFID~INT[PRI+1].INTNUM])=0 THEN                 03270000
    BEGIN                                                               03271000
         PDPRT[PDIR,PDIC] ~                                             03272000
           0&1[STYPC]                                                   03273000
            &MFID[DKAC]                                                 03274000
            &(FID ~ INTLOC[MFID] ~ NXAVIL ~ NXAVIL + 1)[SGNOC]          03275000
            &1[SEGSZC];                                                 03276000
         PDINX ~ PDINX + 1;                                             03277000
    END;                                                                03278000
         T1 ~ PRGDESCBLDR(1,INT[PRI + 1].INTPRT,0,FID);                 03279000
         PRI ~ PRI+2;                                                   03280000
    END;                                                                03281000
         FOR I ~ 1 STEP 1 UNTIL BDX DO                                  03282000
         BEGIN EMITO(MKS); EMITOPDCLIT(BDPRT[I]) END;                   03283000
         EMITO(MKS);                                                    03284000
         EMITOPDCLIT(STRTSEG.[18:15]);                                  03285000
         T ~ PRGDESCBLDR(1,0,0,NSEG);                                   03288000
         SEGMENT((ADR+4) DIV 4,NSEG,FALSE,EDOC);                        03289000
         IF ERRORCT ! 0 THEN GO TO ENDWRAPUP;                           03290000
         FILL SEG0[*] WITH                                              03291000
              OCT020005,     % BLOCK                                    03292000
              OCT220014,     % WRITE                                    03293000
              OCT230015,     % READ                                     03294000
              OCT240016;     % FILE CONTROL                             03295000
              COMMENT INTRINSIC FUNCTIONS;                              03296000
         FOR I ~ 0 STEP 1 UNTIL 3 DO                                    03297000
    BEGIN                                                               03298000
         T1 ~ PRGDESCBLDR(1,SEG0[I].[36:12],0,                          03299000
                           NSEG ~ NXAVIL ~ NXAVIL + 1);                 03300000
         PDPRT[PDIR,PDIC] ~                                             03301000
           0&1[STYPC]                                                   03302000
            &(SEG0[I].[30:6])[DKAC]                                     03303000
            &NXAVIL[SGNOC]                                              03304000
            &1[SEGSZC];                                                 03305000
         PDINX ~ PDINX + 1;                                             03306000
    END;                                                                03307000
              COMMENT GENERATE PRT AND SEGMENT DICTIONARY;              03308000
         PRT[0,41] ~ PDPRT[0,0] & 63[10:42:6];  % USED FOR FAULT OPTN   03308100
         FOR I ~ 1 STEP 1 UNTIL PDINX-1 DO                              03309000
         IF (T1~PDPRT[I.PDR,I.PDC]).SEGSZF = 0 THEN                     03310000
    BEGIN           % PRT ENTRY                                         03311000
         PRTADR ~T1.PRTAF;                                              03312000
         SEGMNT ~T1.SGNOF;                                              03313000
         LNK ~ SEGDICT[SEGMNT.[36:5], SEGMNT.[41:7]].PRTAF;             03314000
         MDESC(T1.RELADF&SEGMNT[FFC]                                    03315000
             &(REAL(LNK=0))[STOPC]                                      03316000
             &(IF LNK=0 THEN SEGMNT ELSE LNK)[LINKC]                    03317000
              &(T1.DTYPF)[MODEC]                                        03318000
              &5[1:45:3],                                               03319000
              PRT[PRTADR.[36:5],PRTADR.[41:7]]);                        03320000
         SEGDICT[SEGMNT.[36:5],SEGMNT.[41:7]].PRTLINKF ~ PRTADR;        03321000
    END                                                                 03322000
         ELSE                                                           03323000
    BEGIN          % SEGMENT DICTIONARY ENTRY                           03324000
         SEGMNT ~ T1.SGNOF;                                             03325000
         SEGDICT[SEGMNT.[36:5],SEGMNT.[41:7]]~                          03326000
         SEGDICT[SEGMNT.[36:5],SEGMNT.[41:7]]                           03327000
             &T1[SGLCC]                                                 03328000
             &T1[DKADRC]                                                03329000
             & T1[4:12:1]                                               03329100
             &T1[6:6:1]                                                 03329200
             &T1[1:1:2];                                                03330000
         TSEGSZ ~ TSEGSZ + T1.SEGSZF;                                   03331000
    END;                                                                03332000
              COMMENT WRITE OUT FILE PARAMETER BLOCK;                   03333000
         FPBSZ ~ ((FPE.[33:15] - FPS) | 8 + FPE.[30:3] + 9) DIV 8;      03334000
         I ~ (FPBSZ + 29) DIV 30;                                       03335000
         IF DALOC DIV CHUNK < T1 ~ (DALOC +I) DIV CHUNK                 03336000
           THEN DALOC ~ CHUNK | T1;                                     03337000
         SEG0[4] ~ DALOC;                                               03338000
         SEG0[5] ~ FPBSZ;                                               03339000
         SEG0[5].FPBVERSF~FPBVERSION;                                   03340000
         FOR I ~ 0 STEP 30 WHILE I < FPBSZ DO                           03341000
    BEGIN                                                               03342000
         MOVE(FPB[I],CODE(0),IF (FPBSZ-I) } 30                          03343000
                             THEN 30 ELSE (FPBSZ-I));                   03344000
         WRITE(CODE[DALOC]);                                            03345000
         DALOC ~ DALOC + 1;                                             03346000
    END;                                                                03347000
         SEG0[2] ~ MOVEANDBLOCK(PRT,PRTS+1); % WRITES OUT PRT           03348000
                                            % SAVES ADDRESS OF PRT      03349000
         SEG0[3] ~ PRTS + 1;     % SIZE OF PRT                          03350000
         SEG0[0] ~ MOVEANDBLOCK(SEGDICT,NXAVIL + 1); % WRITE SEG DICT   03351000
         SEG0[1] ~ NXAVIL + 1;         % SIZE OF SEGMENT DICTIONARY     03352000
         SEG0[6] ~ -GSEG;   % FIRST SEGMENT TO EXECUTE                  03353000
         SEG0[7].[33:15] ~ FPBI;   % NUMBER OF FILES                    03354000
         SEG0[7].[18:15] ~ ESTIMATE ~ IF   % CORE ESTIMATE              03355000
           ( I ~                                                        03356000
           ESTIMATE+60+ %%% OPTION FILE BUFF SIZES + DEFAULT BUFF SIZES.03356100
           PRTS + 512   % PRT AND STACK SIZE                            03357000
          +TSEGSZ       % TOTAL SIZE OF CODE                            03358050
          + 1022   % FOR INTRINSICS                                     03358050
          +ARYSZ        % TOTAL ARRAY SIZE                              03359000
          + (MAXFILES | 28) % SIZE OF ALL FIBS                          03360000
          +FPBSZ        % SIZE OF FILE PARAMETER BLOCK                  03361000
          + (IF ESTIMATE = 0 THEN 0 ELSE (ESTIMATE + 1000))             03361100
          + (NXAVIL + 1)     % SIZE OF SEGMENT DICTIONARY               03362000
          ) > 32768 THEN 510 ELSE (I DIV 64);                           03363000
         COMMENT IF SEGSW THEN UPDATE LINDICT, SEG0[0] & WRITE IT ;     03363100
         SEG0[7].[2:1] ~ 1;  % USED FOR FORTRAN FAULT DEC;              03363150
       IF SEGSW THEN                                                    03363200
       BEGIN                                                            03363300
         FOR I ~ NXAVIL + 1 STEP -1 UNTIL 1 DO                          03363400
          IF LINEDICT[I.IR,I.IC] = 0 THEN % INDICATE NO LINE SEGMENT    03363500
             LINEDICT[I.IR,I.IC] ~ -1;   % FOR THIS SEGMENT             03363600
         SEG0[0] ~ SEG0[0] & (MOVEANDBLOCK(LINEDICT,NXAVIL+1))[TOBASE]; 03363700
       END;                                                             03363800
         WRITE(CODE[0],30,SEG0[*]);                                     03364000
         IF ERRORCT = 0 AND SAVETIME } 0 THEN LOCK(CODE);               03365000
    ENDWRAPUP:                                                          03366000
         LOCK(TAPE);       %RW/L TAPE FILE OR LOCK DISK            %502-03366100
         IF NTAPTOG THEN LOCK(NEWTAPE,*); %RW/L TAPE OR CRUNCH DISK%502-03366200
    END WRAPUP;                                                         03367000
PROCEDURE INITIALIZATION;                                               03368000
BEGIN COMMENT   INITIALIZATION;                                         03369000
ALPHA STREAM PROCEDURE MKABS(P);                                        03370000
BEGIN SI ~ P; MKABS ~ SI END;                                           03371000
STREAM PROCEDURE BLANKOUT(CRD, N); VALUE N;                             03372000
BEGIN DI ~ CRD; N(DS ~ LIT " ") END;                                    03373000
BLANKOUT(CRD[10], 40);                                                  03374000
BLANKOUT(LASTSEQ, 8);                                                   03374100
BLANKOUT(LASTERR,8) ;                                                   03374200
INITIALNCR ~ MKABS(CRD[0])&6[30:45:3];                                  03375000
CHR0       ~ MKABS(ACCUM[0])& 2[30:45:3];                               03376000
ACR0 ~ CHR0+1;                                                          03377000
ACR1 ~ (CHR1~MKABS(EXACCUM[0]) & 2[30:45:3]) +1;                        03378000
ACCUMSTOP~MKABS(ACCUM[11]);  EXACCUMSTOP~MKABS(EXACCUM[11]) ;           03378100
BUFL ~ MKABS(BUFF) & 2[30:45:3];                                        03379000
NEXTCARD ~ 1;                                                           03380000
GLOBALNEXTINFO ~ 4093;                                                  03381000
PDINX ~ 1;                                                              03381100
LASTNEXT~1000 ;                                                         03381200
PRTS ~ 41; % CURRENTLY . . . . . LAST USED PRT                          03382000
READ(CR, 10, CB[*]);                                                    03383000
LISTOG~TRUE;  SINGLETOG~TRUE; CHECKTOG ~ FALSE;  %DEFAULT       %501-   03384000
FIRSTCALL ~ TRUE;                                                       03385000
IF BOOLEAN(ERRORCT.[46:1]) THEN LISTOG ~ FALSE;                         03385100
IF BOOLEAN(ERRORCT.[47:1]) THEN DCINPUT ~ TRUE;                         03385200
ERRORCT ~ 0;                                                            03385300
IF DCINPUT THEN SEGSW ~ TRUE;                                           03385350
IF DCINPUT THEN REMOTETOG ~ TRUE;                                       03385355
LIMIT~IF DCINPUT THEN 20 ELSE 100 ;                                     03385360
IF SEGSW THEN SEGSWFIXED ~ TRUE;                                        03385400
EXTRAINFO[0,0] ~ 0 & EXPCLASS[TOCLASS];                                 03386000
NEXTEXTRA ~ 1;                                                          03387000
LASTMODE ~ 1;                                                           03387100
DALOC ~ 1;                                                              03388000
TYPE ~ -1;                                                              03389000
   MAP[0] ~ MAP[2] ~ MAP[4] ~ MAP[7] ~ -10;                             03390000
   MAP[5] ~ 1; MAP[6] ~ 2;                                              03391000
FILL XR[*] WITH 0,0,0,0,0,0,0,                                          03391100
    "INTEGE","R    R","      ","      "," REAL ","      ",              03391200
    "LOGICA","L    L","DOUBLE","      ","COMPLE","X    X",              03391300
    "------","-    -","      ","      "," ---- ","      ",              03391450
    "------","-    -","------","      ","------","-    -";              03391450
FILL TYPES[*] WITH "      ","INTGER","      ","REAL  ",                 03392000
   "LOGCAL", "DOUBLE", "COMPLX";                                        03393000
FILL KLASS[*] WITH                                                      03394000
   "NULL  ", "ARRAY ", "VARBLE", "STFUN ",                              03395000
   "NAMLST", "FORMAT", "ERROR ", "FUNCTN",                              03396000
   "INTRSC", "EXTRNL", "SUBRTN", "COMBLK",                              03397000
   "FILE  ";                                                            03398000
FILL RESERVEDWORDSLP[*] WITH                                            03399000
   "CALL  ","ENTR  ","FORM  ","GOTO  ","IF    ","READ  ",               03400000
   "REAL  ","WRIT  ","DATA  ","CLOS  ","LOCK  ","PURG  ","CHAI  ",      03401000
   "PRIN  ","PUNC  ",                                                   03401100
   0,"Y       ","AT      ",0,0,0,0,"E       ",0,"E       ",0,"E       ",03401200
   "N       ","T       ","H       ";                                    03401300
FILL RESERVEDWORDS[*] WITH                                              03402000
   "ASSI  ","BACK  ","BLOC  ","CALL  ","COMM  ","COMP  ","CONT  ",      03403000
   "DATA  ","DIME  ","DOUB  ","END   ","ENDF  ","ENTR  ","EQUI  ",      03404000
   "EXTE  ","FUNC  ","GOTO  ","INTE  ","LOGI  ","NAME  ","PAUS  ",      03405000
   "PRIN  ","PROG  ","PUNC  ","READ  ","REAL  ","RETU  ","REWI  ",      03406000
   "STOP  ","SUBR  ","WRIT  ",                                          03407000
   "CLOS  ","LOCK  ","PURG  ",                                          03407100
   0,0,0,                                                               03407101
   "FIXF  ","VARY  ","AUXM  ","RELE  ",                                 03407102
   "IMPL  ",                                                            03407103
   "GN      ","SPACE   ","KDATA   ",0,"ON      ","LEX     ","INUE    ", 03407200
   0,"NSION   ","LEPRECIS",0,"ILE     ","Y       ","VALENCE ","RNAL    "03407300
   ,"TION    ",0,"GER     ","CAL     ","LIST    ","E       ","T       ",03407400
   "RAM     ","H       ",0,0,"RN      ","ND      ",0,"OUTINE  ",        03407500
   "E       ","E       ",0,"E       ",0,0,0,"D       ","ING     ",      03407600
   "EM      ","ASE     "                                                03407601
  ,"ICIT    "                                                           03407602
   ;                                                                    03407990
FILL RESLENGTHLP[*] WITH                                                03408000
   4,5,6,4,2,4,4,5,4,5,4,5,5,5,5;                                       03409000
FILL LPGLOBAL[*] WITH                                                   03410000
    4, 13, 36, 17, 35, 25,                                              03411000
   26, 31,  8, 32, 33, 34, 37, 22, 24;                                  03411100
FILL RESLENGTH[*] WITH                                                  03412000
   0, 9, 9, 4, 6,                                                       03413000
   7, 8, 4, 9, 15,                                                      03414000
   3, 7, 5, 11, 8,                                                      03415000
   8, 4, 7, 7, 8,                                                       03416000
   5, 5, 7, 5, 4,                                                       03417000
   4, 6, 6, 4, 10, 5,                                                   03418000
   5, 4, 5, 0, 0, 0, 5, 7, 6, 7                                         03418100
  ,8                                                                    03418101
    ;                                                                   03418990
         FILL WOP[*] WITH                                               03419000
         "LITC","    ",                                                 03420000
         "OPDC","DESC",                                                 03421000
  10,"DEL ", 11,"NOP ", 12,"XRT ", 16,"ADD ", 17,"AD2 ", 18,"PRL ",     03422000
  19,"LNG ", 21,"GEQ ", 22,"BBC ", 24,"INX ", 35,"LOR ", 37,"GTR ",     03423000
  38,"BFC ", 39,"RTN ", 40,"COC ", 48,"SUB ", 49,"SB2 ", 64,"MUL ",     03424000
  65,"ML2 ", 67,"LND ", 68,"STD ", 69,"NEQ ", 70,"SSN ", 71,"XIT ",     03425000
  72,"MKS ",                                                            03426000
 128,"DIV ",129,"DV2 ",130,"COM ",131,"LQV ",132,"SND ",133,"XCH ",     03427000
 134,"CHS ",167,"RTS ",168,"CDC ",197,"FTC ",260,"LOD ",261,"DUP ",     03428000
 278,"GBC ",280,"SSF ",294,"GFC ",322,"ZP1 ",384,"IDV ",453,"FTF ",     03429000
 515,"MDS ",532,"ISD ",533,"LEQ ",534,"BBW ",548,"ISN ",549,"LSS ",     03430000
 550,"BFW ",581,"EQL ",582,"SSP ",584,"ECM ",709,"CTC ",790,"GBW ",     03431000
 806,"GFW ",896,"RDV ",965,"CTF ",                                      03432000
         1023,1023,1023,1023,1023,1023,1023,1023,1023,1023,1023, 1023;  03433000
FILL TIPE[*] WITH 10(-1),-19,-21,OCT300000000,-21,-2,-3,-4,             03433100
                  8(OCT300000000),OCT100000000,-5,-13,-4,-6,-7,-19,-11, 03433110
                  5(OCT100000000),-8,3(OCT300000000),-9,-10,-12,-13,-14,03433120
                  -15,-100,-16,8(OCT300000000),-17,-6,-18,-19,-20,-21 ; 03433130
FILL PERIODWORD[*] WITH                                                 03434000
   "FALSE ", "TRUE  ", "OR    ", "AND   ", "NOT   ",                    03435000
   "LT    ", "LE    ", "EQ    ", "GT    ", "GE    ", "NE    ";          03436000
ACCUM[0] ~ EXACCUM[0] ~ ";     ";                                       03437000
INCLUDE := "NCLUDE" & "I"[6:42:6];                                      03437100
INSERTDEPTH := -1;                                                      03437110
FILL TEN[*] WITH   %  POWERS OF TEN TO PRT 22                           03438000
    OCT1141000000000000,    OCT1131200000000000,    OCT1121440000000000,03439000
    OCT1111750000000000,    OCT1102342000000000,    OCT1073032400000000,03440000
    OCT1063641100000000,    OCT1054611320000000,    OCT1045753604000000,03441000
    OCT1037346545000000,    OCT1011124027620000,    OCT0001351035564000,03442000
    OCT0011643245121000,    OCT0022214116345200,    OCT0032657142036440,03443000
    OCT0043432772446150,    OCT0054341571157602,    OCT0065432127413542,03444000
    OCT0076740555316473,    OCT0111053071060221,    OCT0121265707274265,03445000
    OCT0131543271153342,    OCT0142074147406233,    OCT0152513201307702,03446000
    OCT0163236041571663,    OCT0174105452130240,    OCT0205126764556310,03447000
    OCT0216354561711772,    OCT0231004771627437,    OCT0241206170175346,03448000
    OCT0251447626234640,    OCT0261761573704010,    OCT0272356132665012,03449000
    OCT0303051561442215,    OCT0313664115752660,    OCT0324641141345435,03450000
    OCT0336011371636744,    OCT0347413670206535,    OCT0361131664625026,03451000
    OCT0371360241772234,    OCT0401654312370703,    OCT0412227375067064,03452000
    OCT0422675274304701,    OCT0433454553366061,    OCT0444367706263475,03453000
    OCT0455465667740415,    OCT0467003245730520,    OCT0501060411731664,03454000
    OCT0511274514320241,    OCT0521553637404312,    OCT0532106607305374,03455000
    OCT0542530351166673,    OCT0553256443424452,    OCT0564132154331565,03456000
    OCT0575160607420123,    OCT0606414751324147,    OCT0621012014361120,03457000
    OCT0631214417455344,    OCT0641457523370635,    OCT0651773450267004,03458000
    OCT0662372362344605,    OCT0673071057035747,    OCT0703707272645341,03459000
    OCT0714671151416631,    OCT0726047403722377,    OCT0737461304707077,03460000
    OCT0751137556607071,    OCT0761367512350710,    OCT0771665435043072,03461000
    OCT0000000000000000,    OCT0000000000000000,    OCT0000000000000000,03462000
    OCT0000000000000000,    OCT0000000000000000,    OCT0000000000000000,03463000
    OCT0000000000000000,    OCT0000000000000000,    OCT0000000000000000,03464000
    OCT0000000000000000,    OCT0000000000000000,    OCT0000000000000000,03465000
    OCT0000000000000000,    OCT0000000000000000,    OCT0000000000000000,03466000
    OCT0000000000000000,    OCT0000000000000000,    OCT0004000000000000,03467000
    OCT0001000000000000,    OCT0001720000000000,    OCT0004304000000000,03468000
    OCT0007365000000000,    OCT0005262200000000,    OCT0004536640000000,03469000
    OCT0001666410000000,    OCT0000244112000000,    OCT0000315134400000,03470000
    OCT0000400363500000,    OCT0000450046042000,    OCT0006562057452400,03471000
    OCT0004316473365100,    OCT0005402212262320,    OCT0006702654737004,03472000
    OCT0004463430126605,    OCT0007600336154346,    OCT0001540425607437,03473000
    OCT0004070533151347,    OCT0005106662003641,    OCT0005033043640461,03474000
    OCT0002241654610575,    OCT0002712227752734,    OCT0001474675745524,03475000
    OCT0002014055337051,    OCT0004417070626663,    OCT0007522706774440,03476000
    OCT0003447470573550,    OCT0006361406732502,    OCT0005005571052122,03477000
    OCT0006207127264547,    OCT0001650755141700,    OCT0006223150372260,03478000
    OCT0007670002470733,    OCT0007646003207120,    OCT0005617404050743,03479000
    OCT0001163305063137,    OCT0007420166277771,    OCT0001732422375777,03480000
    OCT0002321127075377,    OCT0003005354714677,    OCT0005606650100057,03481000
    OCT0007150422120072,    OCT0003002526544103,    OCT0001603254275130,03482000
    OCT0004144127354356,    OCT0007175155247451,    OCT0007034410521363,03483000
    OCT0007664351264566,    OCT0003641443541723,    OCT0004611754472310;03484000
FILL INLINEINT[*] WITH % FILLS MUST BE IN ASCENDING ORDER FOR           03484100
                       % BINARY SEARCH IN FUNCTION AND DOITINLINE.      03484120
                       % INLINEINT[I].[1:1] = 1 ONCE CODE FOR INTRINSIC 03484122
                       %                        HAS BEEN EMITTED INLINE.03484124
                       % INLINEINT[I].[2:10]=INDEX INTO 2-ND WORD OF THE03484126
                       %                     CORR ENTRY IN INT.         03484128
                       % INLINEINT[I].[12:36]=NAME OF INTRINSIC.        03484130
%********FIRST FILL MUST BE NUMBER OF INTRINSICS ******************     03484140
34,                                                                     03484160
"00ABS   ",                                                             03484180
"00AIMAG ",                                                             03484200
"00AINT  ",                                                             03484220
"00AMAX0 ",                                                             03484224
"00AMAX1 ",                                                             03484228
"00AMIN0 ",                                                             03484232
"00AMIN1 ",                                                             03484236
"00AMOD  ",                                                             03484240
"00AND   ",                                                             03484260
"00CMPLX ",                                                             03484280
"00COMPL ",                                                             03484300
"00CONJG ",                                                             03484320
"00DABS  ",                                                             03484340
"00DBLE  ",                                                             03484360
"00DIM   ",                                                             03484380
"00DSIGN ",                                                             03484400
"00EQUIV ",                                                             03484420
"00FLOAT ",                                                             03484440
"00IABS  ",                                                             03484460
"00IDIM  ",                                                             03484480
"00IDINT ",                                                             03484500
"00IFIX  ",                                                             03484520
"00INT   ",                                                             03484540
"00ISIGN ",                                                             03484560
"00MAX0  ",                                                             03484564
"00MAX1  ",                                                             03484568
"00MIN0  ",                                                             03484572
"00MIN1  ",                                                             03484576
"00MOD   ",                                                             03484580
"00OR    ",                                                             03484600
"00REAL  ",                                                             03484620
"00SIGN  ",                                                             03484640
"00SNGL  ",                                                             03484660
"00TIME  ",                                                             03484680
 0 ;                                                                    03484990
         FILL INT [*] WITH                                              03485000
COMMENT THESE NAMES (1-ST WORD OF EACH TWO-WORD ENTRY) MUST BE IN       03486000
         ASCENDING ORDER FOR BINARY LOOKUPS.                            03486010
         THE SECOND WORD HAS THE FOLLOWING FORMAT:                      03486020
         .[1:1] = 0 IF THE INTRINSIC DOES NOT HAVE A PERMANENT PRT      03486030
                    LOCATION, OTHERWISE = 1.  MAY BE RESET BY           03486040
                    WRAPUP.  SEE .[18:6] BELOW.                         03486050
         .[2:1] = .INTSEEN = 1 IFF INTRINSICS FUNCTION HAS BEEN SEEN.   03486055
         .[6:3] = .INTCLASS = CLASS OF THE INTRINSIC.                   03486060
         .[9:3] = .INTPARMCLASS = CLASS OF PARAMETERS.                  03486070
         .[12:6] = .INTINLINE = INDEX FOR DOITINLINE IF !0, OTHERWISE   03486080
                                DO IT VIA INTRINSIC CALL.               03486090
         .[24:6] = .INTPRT = FIXED PRT LOCATION. SEE .[1:1] ABOVE.      03486100
         .[30:6] = .INTPARMS = NUMBER OF PARAMETERS REQUIRED BY THE INT.03486110
         .[36:12] = .INTNUM = INTRINSICS NUMBER.                        03486120
         THE FIELDS .[3:3] AND .[18:6] ARE SO FAR UNUSED.               03486130
;                                                                       03486140
%                                                                       03486144
%***********************************************************************03486145
%*********  IF YOU ADD AN INTRINSIC, BE SURE TO CHANGE NUMINTM1  *******03486146
%*********  AT SEQUENCE NUMBER 00155211.......THANK YOU.         *******03486147
%***********************************************************************03486148
%                                                                       03486149
"ABS   ", OCT0033010000010007,                                          03487000
"AIMAG ", OCT0036020000010074,                                          03488000
"AINT  ", OCT0033030000010054,                                          03489000
"ALGAMA", OCT0033000000010127,                                          03490000
"ALOG10", OCT0033000000010103,                                          03491000
"ALOG  ", OCT2033000035010017,                                          03492000
"AMAX0 ", OCT0031250000000031,                                          03493000
"AMAX1 ", OCT0033250000000031,                                          03494000
"AMIN0 ", OCT0031250000000032,                                          03495000
"AMIN1 ", OCT0033250000000032,                                          03496000
"AMOD  ", OCT0033040000020063,                                          03497000
"AND   ", OCT0033050000020130,                                          03498000
"ARCOS ", OCT0033000000010117,                                          03499000
"ARSIN ", OCT2033000032010116,                                          03500000
"ATAN2 ", OCT2033000044020114,                                          03501000
"ATAN  ", OCT2033000037010016,                                          03501500
"CABS  ", OCT2036000045010053,                                          03502000
"CCOS  ", OCT0066000000010110,                                          03503000
"CEXP  ", OCT0066000000010100,                                          03504000
"CLOG  ", OCT0066000000010102,                                          03505000
"CMPLX ", OCT0063060000020075,                                          03506000
"COMPL ", OCT0033070000010132,                                          03507000
"CONCAT", OCT0033000000050140,                                          03508000
"CONJG ", OCT0066110000010076,                                          03509000
"COSH  ", OCT0033000000010121,                                          03510000
"COS   ", OCT0033000000010015,                                          03511000
"COTAN ", OCT0033000000010112,                                          03512000
"CSIN  ", OCT0066000000010106,                                          03513000
"CSQRT ", OCT0066000000010124,                                          03514000
"DABS  ", OCT0055010000010052,                                          03515000
"DATAN2", OCT0055000000020115,                                          03516000
"DATAN ", OCT2055000041010113,                                          03517000
"DBLE  ", OCT0053120000010062,                                          03518000
"DCOS  ", OCT0055000000010107,                                          03519000
"DEXP  ", OCT2055000047010077,                                          03520000
"DIM   ", OCT0033100000020072,                                          03521000
"DLOG10", OCT0055000000010104,                                          03522000
"DLOG  ", OCT2055000042010101,                                          03522500
"DMAX1 ", OCT0055000000000066,                                          03523000
"DMIN1 ", OCT0055000000000067,                                          03524000
"DMOD  ", OCT2055000046020065,                                          03525000
"DSIGN ", OCT0055130000020071,                                          03526000
"DSIN  ", OCT2055000043010105,                                          03527000
"DSQRT ", OCT2055000050010123,                                          03528000
"EQUIV ", OCT0033140000020133,                                          03529000
"ERF   ", OCT0033000000010125,                                          03530000
"EXP   ", OCT2033000033010020,                                          03531000
"FLOAT ", OCT0031150000010060,                                          03532000
"GAMMA ", OCT2033000040010126,                                          03533000
"IABS  ", OCT0011010000010007,                                          03534000
"IDIM  ", OCT0011100000020072,                                          03535000
"IDINT ", OCT0015240000010057,                                          03536000
"IFIX  ", OCT0013030000010054,                                          03537000
"INT   ", OCT0013030000010054,                                          03538000
"ISIGN ", OCT0011160000020070,                                          03539000
".ERR. ", OCT2000000030000134,                                          03540000
".FBINB", OCT0000000000000160,                                          03540500
".FINAM", OCT0000000000000154,                                          03541000
".FONAM", OCT0000000000000155,                                          03542000
".FREFR", OCT0000000000000146,                                          03543000
".FREWR", OCT0000000000000153,                                          03544000
".FTINT", OCT0000000000000050,                                          03545000
".FTNIN", OCT0000000000000156,                                          03546000
".FTNOU", OCT0000000000000157,                                          03547000
".FTOUT", OCT0000000000000051,                                          03548000
".LABEL", OCT0000000000000021,                                          03549000
".MATH ", OCT0000000000000055,                                          03550000
".MEMHR", OCT0000000000000164,                                          03550500
".XTOI ", OCT0000000000000056,                                          03551000
"MAX0  ", OCT0011250000000135,                                          03552000
"MAX1  ", OCT0013250000000135,                                          03553000
"MIN0  ", OCT0011250000000136,                                          03554000
"MIN1  ", OCT0013250000000136,                                          03555000
"MOD   ", OCT0011170000020137,                                          03556000
"OR    ", OCT0033200000020131,                                          03557000
"REAL  ", OCT0036210000010073,                                          03558000
"SIGN  ", OCT0033160000020070,                                          03559000
"SINH  ", OCT0033000000010120,                                          03560000
"SIN   ", OCT2033000034010014,                                          03561000
"SNGL  ", OCT0035230000010061,                                          03562000
"SQRT  ", OCT2033000031010013,                                          03563000
"TANH  ", OCT0033000000010122,                                          03563010
"TAN   ", OCT2033000036010111,                                          03563020
"TIME  ", OCT0031220000010064,                                          03563030
 0;                                                                     03563900
BLANKS~INLINEINT[MAX~0] ;                                               03563910
FOR SCN~1 STEP 1 UNTIL BLANKS DO                                        03563920
    BEGIN                                                               03563930
    EQVID~INLINEINT[SCN];  WHILE INT[MAX]!EQVID DO MAX~MAX+2 ;          03563940
    INLINEINT[SCN].INTX~MAX+1 ;                                         03563950
    END ;                                                               03563960
INTID.SUBCLASS ~ INTYPE;                                                03564000
REALID.SUBCLASS ~ REALTYPE;                                             03565000
EQVID ~ ".EQ000";                                                       03566000
LISTID ~ ".LI000";                                                      03567100
BLANKS ~ "      ";                                                      03568000
ENDSEGTOG ~ TRUE;                                                       03569000
SCN ~ 7;                                                                03570000
MAX ~ REAL(NOT FALSE).[9:39];                                           03571000
SUPERMAXCOM~128|(MAXCOM+1) ;                                            03571100
SEGPTOG ~ FALSE;   %INHIBIT PAGE SKIP AFTER SUBROUTINES           %501- 03571300
END   INITIALIZATION;                                                   03572000
ALPHA PROCEDURE NEED(T, C); VALUE T, C; ALPHA T, C;                     03573000
BEGIN INTEGER N;  REAL ELBAT;                                           03574000
   REAL X;                                                              03574100
   LABEL XIT, CHECK;                                                    03575000
   ALPHA INFA, INFB, INFC;                                              03576000
COMMENT NEED RETURNS THE ELBAT WORD FOR THE IDENTIFIER T.               03577000
IF THIS IS THE FIRST OCCURRENCE OF T THEN AN INFO WORD IS BUILT AND     03578000
GIVEN THEN CLASS C;                                                     03579000
   ELBAT.CLASS ~ C;                                                     03580000
   XTA ~ T;                                                             03581000
   IF C { LABELID THEN                                                  03582000
      BEGIN                                                             03583000
         IF N ~ SEARCH(T) = 0 THEN N ~ ENTER(ELBAT, T) ELSE             03584000
         IF ELBAT ~  GET(N).CLASS = UNKNOWN                             03585000
           THEN PUT(N,GET(N)&C[TOCLASS])                                03586000
         ELSE IF ELBAT ! C THEN FLOG(21);                               03587000
         GO TO XIT;                                                     03588000
     END;                                                               03589000
  IF N ~ SEARCH(T) = 0 THEN                                             03590000
     BEGIN                                                              03591000
        IF N ~ GLOBALSEARCH(T) ! 0 THEN GO TO CHECK;                    03592000
        N ~ GLOBALENTER(ELBAT, T);                                      03593000
        GO TO XIT;                                                      03594000
    END;                                                                03595000
  GETALL(N,INFA,INFB,INFC);                                             03596000
  IF INFA.CLASS = DUMMY THEN BEGIN N ~ INFC.BASE; GO TO CHECK END;      03596100
  IF BOOLEAN(INFA.   FORMAL) THEN GO TO CHECK;                          03597000
  IF INFA.CLASS ! UNKNOWN THEN                                          03598000
  BEGIN                                                                 03599000
     IF N ~ GLOBALSEARCH(T) ! 0 THEN GO TO CHECK;                       03600000
     ELBAT.SUBCLASS ~ INFA.SUBCLASS;                                    03601000
     N ~ GLOBALENTER(ELBAT, T);                                         03602000
     GO TO XIT;                                                         03603000
  END;                                                                  03604000
  PUT(N, INFA & DUMMY[TOCLASS]);                                        03605000
  ELBAT.SUBCLASS ~ INFA   .SUBCLASS;                                    03606000
  IF X ~ GLOBALSEARCH(T) = 0 THEN X ~ GLOBALENTER(ELBAT, T);            03607000
  PUT(N+2, INFC & X[TOBASE]); N ~ X;                                    03607100
  CHECK:                                                                03608000
  INFA ~ GET(N);                                                        03609000
  IF ELBAT ~ INFA   .CLASS = UNKNOWN THEN                               03610000
     BEGIN INFO[N.IR,N.IC].CLASS ~ C; GO TO XIT END;                    03611000
  IF ELBAT ! C THEN                                                     03612000
     IF ELBAT = EXTID AND                                               03613000
        (C = SUBRID OR C = FUNID) THEN                                  03614000
        INFO[N.IR,N.IC].CLASS ~ C                                       03615000
     ELSE IF (ELBAT=SUBRID OR ELBAT= FUNID) AND C = EXTID THEN          03616000
     ELSE FLOG(21);                                                     03617000
  XIT: NEED ~ GETSPACE(N);                                              03618000
  XTA ~ NAME;     % RESTORE XTA FOR DIAGNOSTIC PURPOSES                 03618100
END NEED;                                                               03619000
INTEGER PROCEDURE EXPR(B); VALUE B; BOOLEAN B; FORWARD;                 03620000
PROCEDURE SPLIT(A); VALUE A; REAL A;                                    03621000
BEGIN                                                                   03622000
      EMITPAIR(JUNK, ISN);                                              03623000
      EMITD(40, DIA);                                                   03624000
      EMITD(18, ISO);                                                   03625000
      EMITDESCLIT(A);                                                   03626000
      EMITO(LOD);                                                       03627000
      EMITOPDCLIT(JUNK);                                                03628000
      EMITPAIR(255,CHS);                                                03629000
      EMITO(LND);                                                       03630000
END SPLIT;                                                              03631000
BOOLEAN PROCEDURE SUBSCRIPTS(LINK,FROM); VALUE LINK,FROM;               03632000
INTEGER LINK, FROM;                                                     03633000
BEGIN INTEGER I, NSUBS, BDLINK;                                         03634000
   LABEL CONSTRUCT, XIT;                                                03635000
REAL SUM, PROD, BOUND;                                                  03636000
REAL INFA,INFB,INFC;                                                    03637000
REAL SAVENSEG,SAVEADR ;                                                 03637100
INTEGER INDX;                                                           03637200
REAL INFD;                                                              03637300
BOOLEAN TOG, VARF;                                                      03638000
REAL SAVIT;                                                             03639000
DEFINE SS = LSTT#;                                                      03640000
                                                                        03641000
                                                                        03642000
IF DEBUGTOG THEN FLAGROUTINE(" SUBSC","RIPTS ",TRUE ) ;                 03643000
   SAVIT ~ IT;                                                          03644000
   LINK ~ GETSPACE(LINK);                                               03645000
GETALL(LINK,INFA,INFB,INFC);                                            03646000
   IF INFA.CLASS ! ARRAYID THEN                                         03647000
      BEGIN XTA ~ INFB; FLOG(35); GO TO XIT END;                        03648000
   NSUBS ~ INFC.NEXTRA;                                                 03649000
   IF FROM = 4 THEN                                                     03649100
     BEGIN IF NSUBS GTR SAVESUBS THEN SAVESUBS ~ NSUBS;                 03649200
           IF NSUBS GTR NAMLIST[0] THEN NAMLIST[0] ~ NSUBS;             03649230
           NAMLIST[NAMEIND].[1:8] ~ NSUBS;                              03649250
           INFD ~ GET(NEED(".SUBAR",BLOCKID)).ADDR;                     03649300
     END;                                                               03649400
   BDLINK ~ INFC.ADINFO-NSUBS+1;                                        03650000
   VARF ~ INFC < 0;                                                     03651000
   FOR I ~ 1 STEP 1 UNTIL NSUBS DO                                      03652000
   BEGIN                                                                03653000
      IT~IT+1;  SAVENSEG~NSEG;  SAVEADR~ADR ;                           03654000
      IF EXPR(TRUE) > REALTYPE THEN FLAG(98);                           03655000
      IF ADR=SAVEADR THEN FLAG(36) ;                                    03655500
      IF VARF THEN                                                      03656000
         IF EXPRESULT=NUMCLASS AND NSEG=SAVENSEG THEN                   03657000
         BEGIN                                                          03658000
            ADR~SAVEADR ;                                               03659000
            EMITNUM(EXPVALUE-1);                                        03660000
         END ELSE EMITPAIR(1, SUB)                                      03661000
      ELSE                                                              03662000
      IF EXPRESULT=NUMCLASS AND NSEG = SAVENSEG AND FROM NEQ 4 THEN     03663000
         BEGIN                                                          03664000
         ADR~SAVEADR;   IF SS[IT]~EXPVALUE{0 THEN FLAG(154) ;           03664100
         END                                                            03664200
      ELSE SS[IT] ~ @9;                                                 03665000
      IF FROM = 4 THEN                                                  03665010
         BEGIN IF VARF THEN BEGIN EMITO(DUP); EMITPAIR(1,ADD); END;     03665100
               EMITL(INDX); INDX ~ INDX+1;                              03665200
               EMITDESCLIT(INFD);                                       03665300
               EMITO(IF VARF THEN STD ELSE STN);                        03665400
         END;                                                           03665500
      IF I < NSUBS THEN                                                 03666000
      BEGIN                                                             03667000
         IF GLOBALNEXT ! COMMA THEN                                     03668000
            BEGIN XTA ~ INFB; FLOG(23) END;                             03669000
         SCAN;                                                          03670000
      END;                                                              03671000
   END;                                                                 03672000
   IF GLOBALNEXT ! RPAREN THEN BEGIN XTA ~ INFB; FLOG(24); END          03673000
      ELSE IF FROM < 2 THEN                                             03673100
         BEGIN SCAN; IF PREC > 0 THEN FROM ~ 1; END;                    03673200
   SUM ~ 0;                                                             03674000
   TOG ~ VARF;                                                          03675000
   IF VARF THEN                                                         03676000
   FOR I ~ NSUBS-1 STEP -1 UNTIL 1 DO                                   03677000
   BEGIN                                                                03678000
      IF BOUND ~ EXTRAINFO[(BDLINK~BDLINK+1).IR,BDLINK.IC] < 0 THEN     03679000
         EMITOPDCLIT(BOUND) ELSE EMITNUM(BOUND);                        03680000
      EMITO(MUL);                                                       03681000
      EMITO(ADD);                                                       03682000
   END                                                                  03683000
   ELSE                                                                 03684000
   FOR I ~ NSUBS STEP -1 UNTIL 1 DO                                     03685000
   BEGIN                                                                03686000
      IF I = 1 THEN BOUND ~ 1 ELSE                                      03687000
         BOUND ~ EXTRAINFO[(BDLINK~BDLINK+1).IR,BDLINK.IC];             03688000
      IF T ~ SS[SAVIT+I] < @9 THEN                                      03689000
         BEGIN                                                          03690000
            SUM ~ (SUM+T-1)|BOUND;                                      03691000
            IF TOG THEN PROD ~ PROD|BOUND;                              03692000
         END                                                            03693000
      ELSE                                                              03694000
      BEGIN                                                             03695000
         IF TOG THEN BEGIN EMITNUM(PROD); EMITO(MUL); EMITO(ADD) END    03696000
         ELSE TOG ~ TRUE;                                               03697000
         PROD ~ BOUND;                                                  03698000
         SUM ~ (SUM-1)|BOUND;                                           03699000
      END;                                                              03700000
   END;                                                                 03701000
   IF VARF THEN T ~ @9;                                                 03702000
   IF INFA.SUBCLASS } DOUBTYPE THEN                                     03703000
   BEGIN                                                                03704000
      IF TOG THEN                                                       03705000
      BEGIN                                                             03706000
         IF T < @9 THEN EMITNUM(2|PROD) ELSE EMITL(2);                  03707000
         EMITO(MUL);                                                    03708000
      END;                                                              03709000
      SUM ~ SUM|2;                                                      03710000
   END ELSE                                                             03711000
   IF T < @9 AND TOG THEN BEGIN EMITNUM(PROD); EMITO(MUL) END;          03712000
   IF BOOLEAN(INFA.CE) THEN                                             03713000
      SUM ~ SUM + INFC.BASE ELSE                                        03714000
      IF BOOLEAN(INFA.FORMAL) THEN                                      03715000
         BEGIN EMITOPDCLIT(INFA.ADDR-1);                                03716000
            IF TOG THEN EMITO(ADD) ELSE TOG ~ TRUE;                     03717000
         END;                                                           03718000
   IF BOOLEAN(INFA.TWOD) AND FROM > 0 THEN                              03719000
   BEGIN                                                                03720000
      IF SUM = 0 THEN                                                   03721000
         IF TOG THEN ELSE                                               03722000
         BEGIN                                                          03723000
            EMITL(0);                                                   03724000
            EMITDESCLIT(INFA.ADDR);                                     03725000
            EMITO(LOD);                                                 03726000
            EMITL(0);                                                   03727000
            GO TO CONSTRUCT;                                            03728000
         END                                                            03729000
      ELSE                                                              03730000
         IF TOG THEN                                                    03731000
         BEGIN                                                          03732000
            EMITNUM(ABS(SUM));                                          03733000
            IF SUM < 0 THEN EMITO(SUB) ELSE EMITO(ADD);                 03734000
         END ELSE                                                       03735000
         BEGIN                                                          03736000
            EMITL(SUM.[33:7]);                                          03737000
            EMITDESCLIT(INFA.ADDR);                                     03738000
            EMITO(LOD);                                                 03739000
            EMITL(SUM.[40:8]);                                          03740000
            GO TO CONSTRUCT;                                            03741000
         END;                                                           03742000
      SPLIT(INFA.ADDR);                                                 03743000
      CONSTRUCT:                                                        03744000
      IF BOOLEAN(FROM) THEN                                             03745000
      BEGIN                                                             03746000
         IF INFA.SUBCLASS } DOUBTYPE THEN                               03747000
         BEGIN                                                          03748000
            EMITO(CDC);                                                 03749000
            EMITO(DUP);                                                 03750000
            EMITPAIR(1, XCH);                                           03751000
            EMITO(INX);                                                 03752000
            EMITO(LOD);                                                 03753000
            EMITO(XCH);                                                 03754000
            EMITO(LOD);                                                 03755000
         END ELSE EMITO(COC);                                           03756000
      END ELSE EMITO(CDC);                                              03757000
   END ELSE                                                             03758000
   BEGIN                                                                03759000
   IF SUM = 0 THEN IF NOT TOG THEN EMITL(0) ELSE                        03760000
   ELSE                                                                 03761000
   BEGIN                                                                03762000
      IF TOG THEN                                                       03763000
         BEGIN                                                          03764000
            EMITNUM(ABS(SUM));                                          03765000
            IF SUM < 0 THEN EMITO(SUB) ELSE EMITO(ADD);                 03766000
         END                                                            03767000
      ELSE EMITNUM(SUM);                                                03768000
   END;                                                                 03769000
   IF FROM > 0 THEN                                                     03770000
      IF BOOLEAN (FROM) THEN                                            03771000
         IF INFA.SUBCLASS } DOUBTYPE THEN                               03772000
         BEGIN                                                          03773000
            EMITDESCLIT(INFA.ADDR);                                     03774000
            EMITO(DUP);                                                 03775000
            EMITPAIR(1,XCH);                                            03776000
            EMITO(INX);                                                 03777000
            EMITO(LOD);                                                 03778000
            EMITO(XCH);                                                 03779000
            EMITO(LOD);                                                 03780000
         END ELSE EMITV(LINK) ELSE                                      03781000
   BEGIN DESCREQ ~ TRUE; EMITN(LINK); DESCREQ ~ FALSE END;              03782000
   END;                                                                 03783000
   XIT:                                                                 03784000
   IT ~ SAVIT;                                                          03785000
   SUBSCRIPTS ~ BOOLEAN(FROM);                                          03785100
IF DEBUGTOG THEN FLAGROUTINE(" SUBSC","RIPTS ",FALSE) ;                 03786000
END SUBSCRIPTS;                                                         03787000
BOOLEAN PROCEDURE BOUNDS(LINK); VALUE LINK; REAL LINK;                  03788000
BEGIN                                                                   03789000
    COMMENT CALLED  TO PROCESS ARRAY BOUNDS;                            03790000
    BOOLEAN VARF, SINGLETOG;                                       %109-03791000
   DEFINE FNEW = LINK#;                                                 03792000
    REAL T, NSUBS, INFA, INFB, INFC, FIRSTSS;                           03793000
    LABEL LOOP;                                                         03794000
                                                                        03795000
                                                                        03796000
IF DEBUGTOG THEN FLAGROUTINE("   BOU","NDS   ",TRUE );                  03797000
    GETALL(FNEW, INFA, INFB, INFC);                                     03798000
    FIRSTSS ~ NEXTSS;                                                   03799000
   IF LINK < 0 THEN BEGIN SINGLETOG ~ TRUE; LINK ~ ABS(LINK) END;  %109-03799500
    LOOP:                                                               03800000
    IF NEXT = ID THEN                                                   03801000
    BEGIN                                                               03802000
         T ~ GET(FNEXT ~ GETSPACE(FNEXT));                              03802100
         IF T.CLASS ! VARID OR NOT BOOLEAN(T.FORMAL) THEN FLAG(92) ELSE 03803000
         IF T.SUBCLASS > REALTYPE THEN FLAG(93);                        03804000
         T ~ -T.ADDR;                                                   03805000
         VARF ~ TRUE;                                                   03806000
    END ELSE                                                            03807000
    IF NEXT = NUM THEN                                                  03808000
    BEGIN                                                               03809000
         IF NUMTYPE!INTYPE THEN FLAG(113);                              03810000
         IF T~FNEXT=0 THEN FLAG(122) ;                                  03810010
         IF NOT VARF THEN IF NSUBS = 0 THEN LENGTH ~ FNEXT ELSE         03812000
              LENGTH ~ LENGTH|FNEXT;                                    03813000
    END ELSE FLOG(122);                                                 03814000
    EXTRAINFO[NEXTSS.IR,NEXTSS.IC] ~ T;                                 03815000
    NEXTSS ~ NEXTSS-1;                                                  03816000
    NSUBS ~ NSUBS+1;                                                    03817000
    SCAN;                                                               03818000
    IF NEXT = COMMA THEN BEGIN SCAN; GO TO LOOP END;                    03819000
    IF NEXT ! RPAREN THEN FLOG(94);                                     03820000
    XTA ~ INFB;                                                         03821000
    IF INFA.CLASS = ARRAYID THEN FLAG(95);                              03822000
    INFA.CLASS ~ ARRAYID;                                               03823000
   IF VARF THEN                                                         03827000
   BEGIN                                                                03828000
       IF NOT BOOLEAN(INFA.FORMAL) THEN FLAG(96);                       03829000
      IF NSUBS > 1 OR INFA     .SUBCLASS } DOUBTYPE THEN                03830000
         BEGIN BUMPLOCALS;LENGTH~LOCALS + 1536;BOUNDS~TRUE END ELSE     03831000
         LENGTH    ~-EXTRAINFO[FIRSTSS.IR,FIRSTSS.IC];                  03832000
   END ELSE                                                             03833000
    IF NOT SINGLETOG AND INFA.SUBCLASS > LOGTYPE THEN              %109-03834000
         BEGIN LENGTH ~ 2 | LENGTH; BOUNDS ~ TRUE END;             %109-03834500
    IF LENGTH > 32767 THEN FLAG(99);                                    03835000
    INFC ~ LENGTH & NSUBS[TONEXTRA] & FIRSTSS[TOADINFO];                03836000
   IF VARF THEN INFC ~ -INFC;                                           03837000
    PUT(FNEW, INFA); PUT(FNEW+2, INFC);                                 03838000
    SCAN;                                                               03839000
IF DEBUGTOG THEN FLAGROUTINE("   BOU","NDS   ",FALSE) ;                 03840000
END BOUNDS;                                                             03841000
PROCEDURE PARAMETERS(LINK); VALUE LINK; REAL LINK;                      03842000
BEGIN                                                                   03843000
                                                                        03844000
                                                                        03845000
   LABEL LOOP;                                                          03846000
   REAL NPARMS, EX, INFC, PTYPE;                                        03847000
   ALPHA EXPNAME;                                                       03848000
   BOOLEAN CHECK, INTFID;                                               03849000
   BOOLEAN NOTZEROP;                                                    03850000
   REAL SAVIT;                                                          03851000
   DEFINE PARMTYPE = LSTT#;                                             03852000
   SAVIT ~ IT ~ IT+1;                                                   03853000
IF DEBUGTOG THEN FLAGROUTINE(" PARAM","ETERS ",TRUE ) ;                 03854000
   INFC ~ GET(LINK+2);                                                  03855000
   IF CHECK ~ BOOLEAN(INFC.[1:1]) THEN                                  03856000
   BEGIN                                                                03857000
      EX ~ INFC.ADINFO;                                                 03858000
      NOTZEROP ~ INFC.NEXTRA ! 0;                                       03859000
      INTFID ~ INFC.[36:12] = 1;                                        03859500
   END;                                                                 03860000
   LOOP:                                                                03861000
   BEGIN SCAN;                                                          03862000
      EXPNAME ~ NAME;                                                   03863000
      IF GLOBALNEXT = 0 AND NAME = "$     " THEN                        03864000
         BEGIN EXPRESULT ~ LABELID; SCAN;                               03866000
            IF GLOBALNEXT ! NUM THEN FLAG(44);                          03867000
            EMITLABELDESC(NAME);                                        03868000
            PTYPE ~ 0;                                                  03869000
            SCAN;                                                       03870000
         END                                                            03871000
      ELSE PTYPE ~ EXPR(CHECK AND EXTRAINFO[EX.IR,EX.IC].CLASS          03872000
         = EXPCLASS AND INTFID);                                        03873000
      IF EXPRESULT = NUMCLASS THEN                                      03874000
         IF PTYPE = STRINGTYPE THEN                                     03875000
         BEGIN                                                          03876000
            ADR ~ ADR - 1;                                              03876500
            PTYPE ~ INTYPE;                                             03877000
            EXPRESULT ~ SUBSVAR;                                        03878000
            IF STRINGSIZE = 1 AND                                       03879000
               (T ~ EXTRAINFO[EX.IR,EX.IC].CLASS = VARID OR             03880000
               T = EXPCLASS) THEN                                       03881000
            BEGIN                                                       03882000
               EXPRESULT ~ EXPCLASS;                                    03883000
               EMITNUM(STRINGARRAY[0]);                                 03884000
            END ELSE                                                    03885000
            BEGIN                                                       03886000
            EXPRESULT~ARRAYID;                                          03887000
            EMITPAIR(PRGDESCBLDR(1,0,0,NXAVIL~NXAVIL+1), LOD);          03888000
            EMITL(0);                                                   03889000
            WRITEDATA(STRINGSIZE, NXAVIL, STRINGARRAY);                 03890000
            END;                                                        03891000
         END ELSE EXPRESULT ~ EXPCLASS;                                 03892000
      PARMTYPE[IT] ~ 0 & EXPRESULT[TOCLASS] & PTYPE[TOSUBCL];           03893000
      XTA ~ EXPNAME;                                                    03894000
      IF TSSEDITOG THEN IF (EXPRESULT=FUNID OR EXPRESULT=SUBRID OR      03894050
      EXPRESULT=EXTID) AND NOT DCINPUT THEN TSSED(XTA,2);               03894060
      IF DCINPUT THEN IF EXPRESULT=FUNID OR EXPRESULT=SUBRID            03894100
      OR EXPRESULT=EXTID THEN FLAG(151) ;                               03894200
      IF CHECK THEN                                                     03895000
         BEGIN                                                          03896000
         IF T ~ EXTRAINFO[EX.IR,EX.IC].CLASS ! EXPRESULT THEN           03897000
         CASE T OF                                                      03898000
         BEGIN                                                          03899000
         EXTRAINFO[EX.IR,EX.IC] ~ 0 & EXPRESULT[TOCLASS]                03900000
            & PTYPE[TOSUBCL];                                           03901000
         IF EXPRESULT ! SUBSVAR THEN FLAG(66);                          03902000
         IF EXPRESULT = SUBSVAR THEN                                    03903000
            IF NOT INTFID THEN                                          03903100
            BEGIN  EMITO(CDC);                                          03903150
               IF PTYPE } DOUBTYPE THEN EMITL(0);                       03903200
               END ELSE                                                 03903400
          ELSE                                                          03903500
            IF EXPRESULT = EXPCLASS THEN                                03904000
               BEGIN IF PTYPE } DOUBTYPE THEN EMITO(XCH);               03904100
                     EXTRAINFO[EX.IR,EX.IC].CLASS ~ EXPCLASS            03904200
               END ELSE FLAG(67);                                       03905000
         ; ; ;                                                          03906000
         FLAG(68);                                                      03907000
         IF EXPRESULT = EXTID THEN                                      03908000
            PUT(EXPLINK,GET(EXPLINK)&FUNID[TOCLASS]) ELSE               03909000
            FLAG(69);                                                   03910000
         ;                                                              03911000
         IF EXPRESULT = FUNID OR EXPRESULT = SUBRID THEN                03912000
            EXTRAINFO[EX.IR,EX.IC] ~ EXPRESULT ELSE FLAG(70);           03913000
         IF EXPRESULT = EXTID THEN                                      03914000
            PUT(EXPLINK,GET(EXPLINK)&SUBRID[TOCLASS]) ELSE              03915000
            FLAG(71);                                                   03916000
         ; ;                                                            03917000
         IF EXPRESULT = ARRAYID THEN EXTRAINFO[EX.IR,EX.IC].CLASS       03918000
            ~ ARRAYID ELSE                                              03919000
            IF EXPRESULT = VARID THEN                                   03920000
            BEGIN                                                       03921000
               EXTRAINFO[EX.IR,EX.IC].CLASS ~ SBVEXP;                   03922000
               EMITL(0)                                                 03923000
            END ELSE                                                    03924000
            IF EXPRESULT = EXPCLASS THEN                                03925000
            BEGIN                                                       03926000
               EXTRAINFO[EX.IR,EX.IC].CLASS ~ SBVEXP;                   03927000
               IF PTYPE } DOUBTYPE THEN EMITO(XCH) ELSE EMITL(0);       03928000
            END ELSE FLAG(72);                                          03929000
         IF EXPRESULT = SUBSVAR THEN                                    03930000
            IF NOT INTFID THEN                                          03930100
               BEGIN EMITO(CDC);                                        03930200
                     IF PTYPE } DOUBTYPE THEN EMITL(0)                  03930300
               END                                                      03930400
            ELSE                                                        03930500
           ELSE IF EXPRESULT = VARID THEN                               03930600
                IF NOT INTFID THEN                                      03930650
               IF PTYPE } DOUBTYPE THEN EMITL(0)  ELSE  ELSE            03930700
               ELSE FLAG(67);                                           03930800
         IF EXPRESULT = VARID THEN                                      03931000
            EMITL(0) ELSE                                               03932000
         IF EXPRESULT = EXPCLASS THEN                                   03933000
            IF PTYPE } DOUBTYPE THEN EMITO(XCH) ELSE EMITL(0)           03934000
         ELSE IF EXPRESULT ! SUBSVAR THEN FLAG(67);                     03935000
         END OF CASE STATEMENT                                          03936000
         ELSE IF PTYPE } DOUBTYPE THEN                                  03936100
              IF EXPRESULT = VARID THEN EMITL(0)                        03936200
              ELSE IF EXPRESULT = EXPCLASS AND NOT INTFID               03936300
                   THEN EMITO(XCH);                                     03936400
      IF T ~ EXTRAINFO[EX.IR,EX.IC].SUBCLASS = 0 OR                     03937000
         (T = INTYPE AND PTYPE = REALTYPE AND                           03938000
         GET(LINK).SEGNO = 0) THEN                                      03939000
            EXTRAINFO[EX.IR,EX.IC].SUBCLASS ~ PTYPE ELSE                03940000
         IF NOT(T = PTYPE OR T = REALTYPE AND PTYPE = INTYPE ) THEN     03941000
            FLAG(88);                                                   03942000
         END OF CHECK                                                   03943000
         ELSE IF PTYPE } DOUBTYPE THEN                                  03943100
              IF EXPRESULT = VARID THEN EMITL(0)                        03943200
              ELSE IF EXPRESULT = EXPCLASS THEN EMITO(XCH);             03943300
   IF NOTZEROP THEN EX ~ EX+1;                                          03944000
      IT ~ IT+1;                                                        03945000
   END;                                                                 03946000
   IF GLOBALNEXT = COMMA THEN GO TO  LOOP;                              03947000
   NPARMS ~ IT - SAVIT;                                                 03948000
   IF GLOBALNEXT ! RPAREN THEN FLOG(108);                               03949000
   IF NOT CHECK THEN                                                    03950000
   BEGIN                                                                03951000
   INFC ~ GET(LINK+2);                                                  03952000
   INFC ~ -(INFC & NPARMS[TONEXTRA]                                     03953000
          & NEXTEXTRA[TOADINFO]);                                       03954000
   PUT(LINK+2,INFC);                                                    03955000
      FOR I ~ SAVIT STEP 1 UNTIL IT-1 DO                                03956000
      BEGIN                                                             03957000
         EXTRAINFO[NEXTEXTRA.IR,NEXTEXTRA.IC] ~ PARMTYPE[I];            03958000
         NEXTEXTRA ~ NEXTEXTRA+1;                                       03959000
      END;                                                              03960000
   END                                                                  03961000
   ELSE                                                                 03962000
   IF T ~ GET(LINK+2).NEXTRA > 0 AND T ! NPARMS OR                      03963000
      T=0 AND INTFID AND NPARMS < 2 OR                                  03964000
      T = 0 AND  NOT INTFID THEN                                        03964500
   BEGIN XTA ~ GET(LINK+1); FLAG(28) END;                               03965000
IF DEBUGTOG THEN FLAGROUTINE(" PARAM","ETERS ",FALSE) ;                 03966000
   IT ~ SAVIT-1;                                                        03967000
END PARAMETERS;                                                         03968000
PROCEDURE STMTFUNREF(LINK); VALUE LINK; REAL LINK;                      03969000
BEGIN                                                                   03970000
         REAL I, PARMLINK, NPARMS, SEG;                                 03971000
IF DEBUGTOG THEN FLAGROUTINE(" STMTF","UNREF ",TRUE);                   03971010
         PARMLINK ~ GET(LINK+2).[36:12];                                03972000
         DO                                                             03973000
    BEGIN                                                               03974000
         SCAN;                                                          03975000
         IF A~EXPR(TRUE) ! B~GET(PARMLINK).SUBCLASS THEN                03976000
     IF A > REALTYPE OR B > REALTYPE THEN                          %108-03977000
         BEGIN XTA ~ NNEW; FLAG(88) END;                                03978000
         PARMLINK ~ PARMLINK-3;                                         03979000
         NPARMS ~ NPARMS+1;                                             03980000
    END  UNTIL NEXT ! COMMA;                                            03981000
         IF NEXT ! RPAREN THEN FLAG(108);                               03982000
         SCAN;                                                          03983000
         GETALL(LINK, INFA, XTA, INFC);                                 03984000
         IF NPARMS ! INFC.NEXTRA THEN FLAG(28);                         03985000
         SEG ~ INFA.SEGNO;                                              03986000
         BRANCHLIT(INFC.BASE&SEG[TOSEGNO],FALSE);                       03987000
         EMITB(INFA.ADDR & SEG[TOSEGNO], FALSE);                        03988000
         ADJUST;                                                        03989000
 IF DEBUGTOG THEN FLAGROUTINE(" STMTF","UNREF ",FALSE);                 03989010
 END STMTFUNREF;                                                        03990000
 BOOLEAN PROCEDURE DOITINLINE(LNK);  VALUE LNK;  REAL LNK ;             03990010
     BEGIN                                                              03990020
     REAL C,I,C1,C2,C3,C4,C5 ;                                          03990030
     LABEL HUNT,FOUND,XIT,AIMAG,AINT,CMPLX,LOOP,DDT111,SNGL ;           03990040
     DEFINE OPTYPE=LSTT#,  E0=EMITO#,  EP=EMITPAIR#,  EOL=EMITOPDCLIT# ;03990045
     IF DEBUGTOG THEN FLAGROUTINE("DOITIN","LINE  ",TRUE);              03990047
     C1~1;  C2~INLINEINT[0];  C3~GET(ABS(LNK)+1) ;                      03990050
 HUNT:                                                                  03990060
     IF (C~INLINEINT[I~(C1+C2).[36:11]].INAM)<C3 THEN C1~I+1            03990070
     ELSE IF C>C3 THEN C2~I-1 ELSE GO FOUND ;                           03990080
     IF C1<C2 THEN GO HUNT ;                                            03990082
     IF INLINEINT[C1].INAM!C3 THEN                                      03990084
          BEGIN                                                         03990086
          IF LNK<0 THEN DOITINLINE~BOOLEAN(LOOKFORINTRINSIC(-LNK)) ;    03990088
          GO XIT ;                                                      03990090
          END ;                                                         03990092
     I~C1 ;                                                             03990094
 FOUND:                                                                 03990096
     C1~(C~INT[C2~(C4~INLINEINT[I]).INTX]).INTPARMCLASS ;               03990098
     IF LNK<0 THEN                                                      03990100
          BEGIN                                                         03990102
          I~-LNK;  DOITINLINE~BOOLEAN(LNK~NEED(C3,FUNID)) ;             03990104
          IF (C2~GET(LNK+2))<0 THEN GO XIT ;                            03990105
          PUT(LNK+2,-(C2&(I~C.INTPARMS)[TONEXTRA]&NEXTEXTRA[TOADINFO]));03990108
          FOR I~I STEP -1 UNTIL 1 DO                                    03990112
               BEGIN                                                    03990114
               EXTRAINFO[NEXTEXTRA.IR,NEXTEXTRA.IC]~0&EXPCLASS[TOCLASS] 03990116
                                                      &C1[TOSUBCL] ;    03990117
               NEXTEXTRA~NEXTEXTRA+1 ;                                  03990118
               END ;                                                    03990120
          INFO[LNK.IR,LNK.IC].SUBCLASS~C.INTCLASS ;                     03990122
          GO XIT ;                                                      03990124
          END ;                                                         03990126
     IF BOOLEAN(LNK.[2:1]) THEN                                         03990127
     STACKHEAD[GET((NEXTINFO~NEXTINFO-3)+1) MOD SHX]~GET(NEXTINFO).LINK;03990128
     LNK~C.INTINLINE;  INT[C2].INTSEEN~1;  DOITINLINE~TRUE ;            03990130
     IF C4>0 THEN INLINEINT[I]~-C4;  I~0 ;                              03990132
     IF XREF THEN ENTERX(C3,0&FUNID[TOCLASS]&C[21:6:3]);                03990134
     IF GLOBALNEXT!LPAREN THEN BEGIN FLOG(106); GO XIT END ;            03990136
 LOOP:    SCAN;  C5~XTA ;                                               03990140
     IF I=0 THEN                                                        03990145
          IF LNK=10 THEN EMITL(0) ELSE IF LNK=21 THEN EMITDESCLIT(2) ;  03990150
     IF (C4~EXPR(TRUE))!C1 AND (C1!REALTYPE OR C4!INTYPE) THEN          03990160
          BEGIN XTA~C5; FLAG(88); C2~-2 END ;                           03990165
     I~I+1;  IF GLOBALNEXT=COMMA THEN GO LOOP ;                         03990170
     IF GLOBALNEXT!RPAREN THEN BEGIN FLOG(108); C2~-2 END;  SCAN ;      03990180
     IF I!C.INTPARMS THEN IF C.INTPARMS!0 OR I<2 THEN                   03990190
          BEGIN XTA~C3;  FLAG(28);  C2~-2 END ;                         03990195
     OPTYPE[IT]~C.INTCLASS;  IF C2<0 THEN GO XIT ;                      03990200
     CASE (LNK-1) OF                                                    03990210
          BEGIN                                                         03990220
          E0(SSP) ; % @1: ABS, DABS, IABS.                              03990230
 AIMAG:   E0(DEL) ; % @2: AIMAG.                                        03990240
 AINT:    EP(1,IDV) ; % @3: AINT, IFIX, INT.                            03990250
          E0(RDV) ; % @4: AMOD.                                         03990260
          E0(LND) ; % @5: LOGICAL AND.                                  03990270
 CMPLX:   E0(XCH) ; % @6: CMPLX.                                        03990280
          E0(LNG) ; % @7: LOGICAL COMPLIMENT (NEGATION).                03990290
                                                                        03990291
          BEGIN % @10: DIM, IDIM.                                       03990300
          E0(SUB);  E0(DUP);  EP(0,LESS) ;                              03990310
          IF ADR>4082 THEN BEGIN ADR~ADR+1; SEGOVF END ;                03990315
          EP(2,BFC);  E0(DEL);  EMITL(0) ;                              03990320
          END ;                                                         03990330
                                                                        03990331
          BEGIN E0(XCH); E0(CHS); GO CMPLX END ; % @11: CONJG.          03990340
          ; % @12: DBLE (SOME CODE ALREADY EMITTED ABOVE).              03990350
                                                                        03990351
          BEGIN E0(XCH); E0(DEL) ; % @13: DSIGN.                        03990360
 DDT111:  EMITDDT(1,1,1) ;                                              03990370
          END;                                                          03990380
                                                                        03990381
          E0(LQV) ; % @14: LOGICAL EQUIVALENCE.                         03990390
          ; % @15: FLOAT.                                               03990400
          GO DDT111 ; % @16: ISIGN, SIGN.                               03990410
          BEGIN E0(RDV); GO AINT END ; % @17: MOD.                      03990420
          E0(LOR) ; % @20: LOGICAL OR.                                  03990430
          BEGIN E0(XCH); GO AIMAG END ; % @21: REAL.                    03990440
          EP(1,KOM) ; % @22: TIME.                                      03990450
                                                                        03990460
          BEGIN % @23: SNGL.                                            03990470
 SNGL:    EP(9,SND);  E0(XCH);  EMITDDT(47,9,1);  EMITL(0) ;            03990480
          EMITDDT(9,9,38); EOL(9); EMITO(ADD); IF LNK=20 THEN GO AINT ; 03990490
          END ;                                                         03990500
                                                                        03990510
          GO SNGL ; % @24: IDINT.                                       03990520
                                                                        03990530
          BEGIN % @25: AMAX0,AMAX1,AMIN0,AMIN1,MAX0,MAX1,MIN0,MIN1.     03990535
                %      SOME CODE ALREADY EMITTED ABOVE.                 03990540
          IF ADR>4068 THEN BEGIN ADR~ADR+1; SEGOVF END ;                03990542
          EP(9,STD); E0(DUP); EOL(9) ;                                  03990545
          E0(IF C3.[24:6]="A" OR C3.[24:6]="X" THEN LESS ELSE GRTR) ;   03990550
          EP(2,BFC); E0(DEL); EOL(9); E0(XCH); E0(TOP); E0(LNG) ;       03990555
         EP(14,BBC); E0(DEL); IF C3="MIN1  " OR C3="MAX1  " THEN GO AINT03990560
          END ;                                                         03990565
                                                                        03990566
          END OF CASE STATEMENT ;                                       03990800
 XIT:                                                                   03990810
     IF DEBUGTOG THEN FLAGROUTINE("DOITIN","LINE  ",FALSE) ;            03990815
     END OF DOITINLINE ;                                                03990820
REAL PROCEDURE LOOKFORINTRINSIC(L); VALUE L; REAL L;                    03991000
BEGIN                                                                   03992000
   ALPHA ID, I, X, NPARMS;                                              03993000
   REAL T;                                                              03994000
   LABEL FOUND, XIT;                                                    03995000
IF DEBUGTOG THEN FLAGROUTINE("LOOKFO","RINTRN",TRUE);                   03995010
   LOOKFORINTRINSIC ~ L ~ NEED(ID ~ GET(L+1),FUNID);                    03996000
   IF GET(L+2) < 0 THEN GO TO XIT; % PARAMETER INFO KNOWN               03996050
   COMMENT B MUST BE SET TO K/2, WHERE K IS THE INDEX OF THE LAST       03996100
   INTRINSIC NAME IN THE ARRAY INT;                                     03996200
         A~0;  B~NUMINTM1 ;                                             03997000
         WHILE A+1 < B DO                                               03998000
         BEGIN                                                          03999000
            I ~ REAL(BOOLEAN(A+B) AND BOOLEAN(1022));                   04000000
            IF Z ~ INT[I] = ID THEN GO TO FOUND;                        04001000
            IF ID < Z THEN B ~ I.[36:11] ELSE A ~ I.[36:11];            04002000
         END;                                                           04003000
         IF ID = INT[I~(A+B)|2-I] THEN GO TO FOUND;                     04004000
   GO TO XIT;                                                           04005000
   FOUND:                                                               04006000
    NPARMS~(X~INT[I+1]).INTPARMS;  INT[I+1].INTSEEN~1 ;                 04007000
    INFO[L.IR,L.IC].SUBCLASS~X.INTCLASS ;                               04008000
   PUT(L+2,-(1&NEXTEXTRA[TOADINFO]&NPARMS[TONEXTRA]));                  04009000
   IF NPARMS = 0 THEN NPARMS ~ 1;                                       04010000
    T~X.INTPARMCLASS ;                                                  04011000
   FOR I ~ 1 STEP 1 UNTIL NPARMS DO                                     04012000
   BEGIN                                                                04013000
      EXTRAINFO[NEXTEXTRA.IR,NEXTEXTRA.IC] ~                            04014000
         0 & EXPCLASS[TOCLASS] & T[TOSUBCL];                            04015000
      NEXTEXTRA ~ NEXTEXTRA + 1;                                        04016000
   END;                                                                 04017000
   XIT:                                                                 04018000
IF DEBUGTOG THEN FLAGROUTINE("LOOKFO","RINTRN",FALSE ) ;                04018010
END LOOKFORINTRINSIC;                                                   04019000
INTEGER PROCEDURE EXPR(VALREQ); VALUE VALREQ; BOOLEAN VALREQ;           04020000
BEGIN LABEL LOOP, STACK, XIT, NOSCAN; REAL T;                           04021000
   LABEL ARRY;                                                          04022000
LABEL HERE ;                                                            04022010
                                                                        04023000
                                                                        04024000
   REAL SAVIT, SAVIP;                                                   04025000
   BOOLEAN CNSTSEENLAST;       %FOR HANDLING CONSTANT              %113-04025500
   REAL SAVEADR;               %EXPONENTS                          %113-04025600
   DEFINE OPTYPE = LSTT#;                                               04026000
REAL EXPRESLT,EXPLNK;                                                   04027000
   REAL EXPV;                                                           04028000
    REAL TM ;                                                           04028010
    DEFINE E0=EMITO#, EP=EMITPAIR#, EOL=EMITOPDCLIT#,                   04028020
           ES1(OP)=BEGIN E0(XCH); EP(9,STD); E0(OP) END #,              04028030
           ES2=BEGIN  EP(9,STD); E0(XCH);  EP(17,SND); E0(MUL) END # ;  04028040
    LABEL CTYP, DTYP, RLESSC, DLESSC, CLESSD, CLESSC, RPLUSD, DTIMESC,  04028050
          CTIMESR, CDIVBYD, CTIMESR1, CTIMESR2, DLESSC1 ;               04028060
    LABEL SPECCHAR, RELATION;                                           04029000
   REAL LINK;                                                           04030000
   DEFINE T1 = EXPT1#, T2 = EXPT2#, CODE = EXPT3#;                      04031000
COMMENT THE FOLLOWING TABLE GIVES THE PRECEDENCE (PREC) AND             04032000
OPERATOR NUMBER (OP) OF THE ARITHMETIC AND LOGICAL OPERATORS.           04033000
         OPERATOR            PREC      OP                               04034000
         **                  9         15                               04035000
         UNARY -             8         12                               04036000
         /                   7         14                               04037000
         *                   7         13                               04038000
         -                   5         11                               04039000
         +                   5         10                               04040000
         .NE.                4         9                                04041000
         .GE.                4         8                                04042000
         .GT.                4         7                                04043000
         .EQ.                4         6                                04044000
         .LE.                4         5                                04045000
         .LT.                4         4                                04046000
         .NOT.               3         3                                04047000
         .AND.               2         2                                04048000
         .OR.                1         1                                04049000
         THE UNARY PLUS IS IGNORED;                                     04050000
PROCEDURE MATH(D, C, T); VALUE D, C, T; REAL D, C, T;                   04051000
BEGIN                                                                   04052000
   EMITO(MKS);                                                          04053000
   EMITL(C);                                                            04054000
   EMITV(NEED(".MATH ", INTRFUNID));                                    04055000
   EMITO(DEL);                                                          04056000
   IF D = 2 THEN EMITO(DEL);                                            04057000
   OPTYPE[IT~IT-1] ~ T;                                                 04058000
END MATH;                                                               04059000
   NNEW ~ NAME;                                                         04060000
IF DEBUGTOG THEN FLAGROUTINE(" EXPRE","SSION ",TRUE ) ;                 04061000
   OPTYPE[SAVIT ~IT ~ IT+1] ~                                           04062000
   PR[SAVIP~IP~IP+1] ~ OPST[IP] ~ 0;                                    04063000
   IF GLOBALNEXT = PLUS THEN GO TO LOOP;                                04064000
   IF GLOBALNEXT = MINUS THEN                                           04065000
   BEGIN PREC ~ 8; OP ~ 12; GO TO STACK END;                            04066000
   IF PREC > 0 THEN GO TO STACK;                                        04067000
   LINK~(EXPLNK~FNEXT)&REAL(SCANENTER)[2:47:1] ;                        04068000
   GO TO NOSCAN;                                                        04069000
   LOOP: SCAN;                                                          04070000
   LINK ~ FNEXT;                                                        04071000
   NOSCAN:                                                              04072000
   CNSTSEENLAST~FALSE;                                             %113-04072500
   IF GLOBALNEXT = ID THEN                                              04073000
   BEGIN                                                                04074000
      IF IP ! SAVIP THEN EXPRESLT ~ EXPCLASS;                           04074100
      OPTYPE[IT~IT+1] ~ (A~GET(LINK)).SUBCLASS;                         04075000
      SCAN;                                                             04076000
      IF NOT RANDOMTOG THEN                                             04076050
      IF NEXT=EQUAL THEN BEGIN NEXT~0; OP~6; PREC~4 END ;               04076100
      IF GLOBALNEXT = ID OR GLOBALNEXT = NUM THEN                       04077000
         BEGIN FLOG(1); GO TO XIT END;                                  04078000
      IF NOT VALREQ AND PREC > 0 THEN VALREQ ~ TRUE;                    04078100
      IF GLOBALNEXT ! LPAREN THEN                                       04079000
      BEGIN                                                             04080000
         LINK ~ GETSPACE(LINK);                                         04081000
         T ~ (A~GET(LINK)).CLASS;                                       04082000
         IF XREF THEN ENTERX(GET(LINK+1),0&A[15:15:9]);                 04082100
         IF EXPRESLT = 0 THEN EXPRESLT ~ T;                             04083000
         IF VALREQ THEN                                                 04084000
            IF T = VARID THEN EMITV(LINK) ELSE                          04085000
               BEGIN XTA ~ GET(LINK+1); FLAG(50) END                    04086000
         ELSE                                                           04087000
         BEGIN                                                          04088000
            IF T = VARID THEN                                           04089000
               IF GLOBALNEXT > SLASH AND EXPRESLT = VARID THEN          04090000
               BEGIN                                                    04091000
                  DESCREQ~TRUE; EMITN(LINK); DESCREQ ~ FALSE;           04092000
                  GO TO XIT;                                            04093000
               END ELSE EMITV(LINK)                                     04094000
            ELSE                                                        04095000
            BEGIN                                                       04096000
               IF T = ARRAYID THEN                                      04097000
               BEGIN                                                    04098000
                  IF BOOLEAN(A.CE) THEN                                 04099000
                     EMITNUM(GET(LINK+2).BASE) ELSE                     04100000
                     IF BOOLEAN(A.FORMAL) THEN                          04101000
                       EMITOPDCLIT(A.ADDR-1) ELSE                       04102000
                      EMITL(0);                                         04103000
                  GO TO ARRY;                                           04104000
               END ELSE EMITPAIR(A.ADDR,LOD);                           04105000
               GO TO XIT;                                               04106000
            END;                                                        04107000
         END;                                                           04108000
         GO TO SPECCHAR;                                                04109000
      END;                                                              04110000
      IF A.CLASS ! ARRAYID THEN                                         04111000
      BEGIN COMMENT FUNCTION REFERENCE;                                 04112000
         EXPRESLT ~ EXPCLASS;                                           04112100
         IF A.CLASS = STMTFUNID THEN                                    04113000
              BEGIN                                                     04114000
              IF XREF THEN ENTERX(GET(LINK+1),0&A[15:15:9]);            04114050
              STMTFUNREF(LINK) ;                                        04114100
              IF NEXT=EQUAL THEN IF NOT RANDOMTOG THEN                  04114200
                   BEGIN NEXT~0; OP~6; PREC~4 END ;                     04114300
              GO TO SPECCHAR ;                                          04114400
              END ;                                                     04114500
            IF A.CLASS=EXTID OR GET(TM~GLOBALSEARCH(GET(LINK+1))).CLASS=04114520
              EXTID THEN LINK~REAL(DOITINLINE(-LINK)) ELSE              04114530
            IF A.CLASS<FUNID AND TM=0 THEN                              04115000
              IF DOITINLINE(LINK) THEN GO HERE ELSE                     04115010
                LINK ~ LOOKFORINTRINSIC(LINK) ELSE                      04116000
                LINK ~ NEED(GET(LINK+1),FUNID);                         04117000
              IF XREF THEN ENTERX(GET(LINK+1),0&GET(LINK)[15:15:9]);    04117100
             EMITO(MKS);                                                04118000
                                                                        04119000
          PARAMETERS(LINK);                                             04120000
          IF ERRORTOG THEN GO TO XIT ELSE SCAN;                         04121000
          EMITV(LINK );                                                 04122000
          IF OPTYPE[IT] ~ GET(LINK).SUBCLASS } DOUBTYPE THEN            04123000
             EMITOPDCLIT(JUNK);                                         04124000
HERE:     IF NEXT=EQUAL THEN                                            04124100
               IF NOT RANDOMTOG THEN BEGIN NEXT~0; PREC~4; OP~6 END ;   04124200
       END ELSE                                                         04125000
       BEGIN COMMENT ARRAY REFERENCE;                                   04126000
          IF XREF THEN ENTERX(GET(LINK+1),0&A[15:15:9]);                04126100
          SCAN;                                                         04127000
          VALREQ ~ SUBSCRIPTS(LINK,REAL(VALREQ));                       04128000
          IF ERRORTOG THEN GO TO XIT;                                   04129000
          IF NEXT=EQUAL THEN IF NOT RANDOMTOG THEN                      04129100
               BEGIN NEXT~0; OP~6; PREC~4 END ;                         04129200
          IF EXPRESLT = 0 THEN EXPRESLT  ~ SUBSVAR;                     04130000
          IF NOT VALREQ THEN                                            04131000
          BEGIN                                                         04132000
             IF GLOBALNEXT > SLASH AND EXPRESLT = SUBSVAR THEN          04133000
             BEGIN                                                      04134000
                ARRY:                                                   04135000
                IF BOOLEAN((A~GET(LINK)).TWOD) THEN                     04136000
                BEGIN                                                   04137000
                   EMITPAIR(TWODPRT, LOD);                              04138000
                   T ~ A.ADDR;                                          04139000
                   IF T { 1023 THEN                                     04140000
                   BEGIN                                                04141000
                      EMITL(T.[38:10]);                                 04142000
                      EMITDESCLIT(10);                                  04143000
                   END ELSE                                             04144000
                   BEGIN                                                04145000
                      EMITL(T.[40:8]);                                  04146000
                      EMITDESCLIT(1536);                                04147000
                      EMITO(INX);                                       04148000
                   END;                                                 04149000
                   EMITO(CTF);                                          04150000
                END ELSE EMITPAIR(A.ADDR,LOD);                          04151000
                EMITO(XCH);                                             04152000
                GO TO XIT;                                              04153000
             END;                                                       04154000
             IF BOOLEAN((A~GET(LINK)).TWOD) THEN                        04155000
             BEGIN                                                      04156000
                SPLIT(A.ADDR);                                          04157000
                IF A.SUBCLASS } DOUBTYPE THEN                           04158000
                BEGIN                                                   04159000
                   EMITO(CDC);                                          04160000
                   EMITO(DUP);                                          04161000
                   EMITPAIR(1, XCH);                                    04162000
                   EMITO(INX);                                          04163000
                   EMITO(LOD);                                          04164000
                   EMITO(XCH);                                          04165000
                   EMITO(LOD);                                          04166000
                END ELSE EMITO(COC);                                    04167000
             END ELSE                                                   04168000
             EMITV(LINK);                                               04169000
          END;                                                          04170000
       END ARRAY REFERENCE;                                             04171000
       GO TO SPECCHAR;                                                  04172000
    END;                                                                04173000
    IF GLOBALNEXT = NUM THEN                                            04174000
    BEGIN                                                               04175000
       IF NUMTYPE = STRINGTYPE THEN                                     04176000
          IF VALREQ THEN                                                04177000
          BEGIN                                                         04177200
          NUMTYPE~INTYPE ;                                              04177400
          IF STRINGSIZE=1 THEN FNEXT~STRINGARRAY[0]                     04177500
          ELSE BEGIN                                                    04177550
              IF STRINGSIZE>2 OR STRINGARRAY[1].[18:30]!"      " THEN   04177575
                 FLAG(162) ;                                            04177600
              IF (FNEXT~STRINGARRAY[1].[12:6]&STRINGARRAY[0][6:12:36])  04177700
                .[6:6]>7 THEN NUMTYPE~REALTYPE ;                        04177800
              END ;                                                     04177900
         END;                                                           04178000
   SAVEADR~ADR; CNSTSEENLAST~TRUE;                                 %113-04178500
      IF NUMTYPE = DOUBTYPE THEN                                        04179000
         EMITNUM2(FNEXT,DBLOW) ELSE EMITNUM (FNEXT);                    04180000
      OPTYPE[IT~IT+1] ~ NUMTYPE;                                        04181000
      IF EXPRESLT  = 0 THEN                                             04182000
      BEGIN EXPRESLT  ~ NUMCLASS; EXPV    ~ FNEXT END;                  04183000
      SCAN;                                                             04184000
      IF NOT RANDOMTOG THEN                                             04184050
      IF NEXT=EQUAL THEN BEGIN NEXT~0; OP~6; PREC~4 END;                04184100
      IF NOT VALREQ AND PREC > 0 THEN VALREQ ~ TRUE;                    04184200
      IF GLOBALNEXT = ID OR GLOBALNEXT = NUM THEN                       04185000
         BEGIN FLOG(1); GO TO XIT END;                                  04186000
   END;                                                                 04187000
   SPECCHAR:                                                            04188000
   IF GLOBALNEXT = LPAREN THEN                                          04189000
   BEGIN                                                                04190000
      SCAN;                                                             04191000
      OPTYPE[IT~IT+1] ~ EXPR(TRUE);                                     04192000
                                                                        04193000
      IF GLOBALNEXT = COMMA AND EXPRESULT = NUMCLASS THEN               04194000
         BEGIN                                                          04195000
            IF OPTYPE[IT] > REALTYPE THEN FLAG(85);                     04196000
            SCAN;                                                       04197000
            IF EXPR(TRUE) > REALTYPE                                    04198000
               OR EXPRESULT ! NUMCLASS THEN FLAG(85);                   04198100
            EMITO(XCH);                                                 04199000
            OPTYPE[IT] ~ COMPTYPE;                                      04200000
            IF EXPRESLT = 0 THEN EXPRESLT ~ NUMCLASS;                   04201000
         END ELSE EXPRESLT ~ EXPCLASS;                                  04202000
      IF GLOBALNEXT ! RPAREN THEN                                       04203000
      BEGIN FLOG(108); GO TO XIT END;                                   04204000
      GO TO LOOP;                                                       04205000
    END;                                                                04206000
    WHILE PR[IP] } PREC DO                                              04207000
 BEGIN                                                                  04208000
    IF IT { SAVIT THEN GO TO XIT;                                       04208100
    CODE ~ MAP[T1~OPTYPE[IT-1]]|3 + MAP[T2~OPTYPE[IT]];                 04209000
    CASE OPST[IP] OF                                                    04210000
 BEGIN                                                                  04211000
    GO TO XIT;                                                          04212000
    BEGIN                                                               04213000
       IF T1 = LOGTYPE AND T2 = LOGTYPE THEN EMITO(LOR)                 04214000
          ELSE FLAG(51);                                                04215000
       IT ~ IT-1;                                                       04216000
    END;                                                                04217000
    BEGIN                                                               04218000
       IF T1 = LOGTYPE AND T2 = LOGTYPE THEN EMITO(LND)                 04219000
          ELSE FLAG(52);                                                04220000
       IT ~ IT-1;                                                       04221000
    END;                                                                04222000
    IF T2 = LOGTYPE THEN EMITO(LNG) ELSE FLAG(53);                      04223000
    BEGIN T ~ LESS; GO TO RELATION END;                                 04224000
    BEGIN T ~ LEQL; GO TO RELATION END;                                 04225000
    BEGIN T ~ EQUL; GO TO RELATION END;                                 04226000
    BEGIN T ~ GRTR; GO TO RELATION END;                                 04227000
    BEGIN T ~ GEQL; GO TO RELATION END;                                 04228000
    BEGIN T ~ NEQL;                                                     04229000
       RELATION:                                                        04230000
       IF CODE < 0 THEN FLAG(54) ELSE                                   04231000
       CASE CODE OF                                                     04232000
       BEGIN   ;                                                        04233000
          BEGIN                                                         04234000
               E0(CHS); EP(9,STD); E0(XCH); EOL(9); E0(XCH); EP(0,XCH) ;04235000
               E0(AD2) ;                                                04236000
          END;                                                          04238000
          FLAG(90);                                                     04239000
          BEGIN EMITPAIR(0, XCH); EMITO(SB2) END;                       04240000
          EMITO(SB2);                                                   04241000
          FLAG(90);                                                     04242000
          FLAG(90);                                                     04243000
          FLAG(90);                                                     04244000
          IF T! EQUL AND T! NEQL THEN FLAG(54)                     %103-04245000
          ELSE                                                     %103-04245100
              BEGIN                                                %103-04245200
              EP(9,STD); E0(XCH); EOL(9); E0(T);                   %103-04245300
              EP(9,STD ); E0(T); EOL(9);                           %103-04245400
              T~(IF T=EQUL THEN LND ELSE LOR); CODE~0;             %103-04245500
              END;                                                 %103-04245600
       END RELATION CASE STATEMENT;                                     04246000
       IF CODE > 0 THEN                                                 04247000
       BEGIN EMITO(XCH); EMITO(DEL); EMITL(0) END;                      04248000
       EMITO(T);                                                        04249000
       OPTYPE[IT~IT-1] ~ LOGTYPE;                                       04250000
    END;                                                                04251000
    IF CODE < 0 THEN BEGIN FLAG(53); IT ~ IT-1 END ELSE                 04252000
    CASE CODE OF                                                        04253000
    BEGIN                                                               04254000
       BEGIN                                                            04255000
          EMITO(ADD);                                                   04256000
          IF T1 = INTYPE AND T2 = INTYPE THEN IT ~ IT-1 ELSE            04257000
             OPTYPE[IT~IT-1] ~ REALTYPE;                                04258000
       END;                                                             04259000
       BEGIN TM~AD2 ;                                                   04260000
 RPLUSD: EP(9,STD); E0(XCH); EOL(9); E0(XCH); EP(0,XCH); E0(TM) ;       04260010
 DTYP:   OPTYPE[IT~IT-1]~DOUBTYPE ;                                     04260020
       END ;                                                            04260030
       BEGIN TM~ADD; GO RLESSC END ;                                    04261000
       BEGIN                                                            04262000
          EMITPAIR(0, XCH);                                             04263000
          EMITO(AD2);                                                   04264000
          IT ~ IT-1;                                                    04265000
       END;                                                             04266000
       BEGIN EMITO(AD2); IT ~ IT-1 END;                                 04267000
       BEGIN TM~ADD; GO DLESSC END ;                                    04268000
       BEGIN EMITO(ADD); IT ~ IT-1 END;                                 04269000
       BEGIN TM~ADD; GO CLESSD END ;                                    04270000
       BEGIN TM~ADD; GO CLESSC END ;                                    04271000
    END ADD CASE STATEMENT;                                             04272000
    IF CODE < 0 THEN BEGIN FLAG(55); IT ~ IT-1 END ELSE                 04273000
    CASE CODE OF                                                        04274000
    BEGIN                                                               04275000
       BEGIN                                                            04276000
          EMITO(SUB);                                                   04277000
          IF T1 = INTYPE AND T2 = INTYPE THEN IT ~ IT-1 ELSE            04278000
             OPTYPE[IT~IT-1] ~ REALTYPE;                                04279000
       END;                                                             04280000
       BEGIN E0(CHS); TM~AD2; GO RPLUSD END;                            04281000
       BEGIN TM~SUB ;                                                   04282000
 RLESSC:  ES1(TM); GO DLESSC1 ;                                         04282010
       END ;                                                            04282030
       BEGIN                                                            04283000
          EMITPAIR(0, XCH);                                             04284000
          EMITO(SB2);                                                   04285000
          IT ~ IT-1;                                                    04286000
       END;                                                             04287000
       BEGIN EMITO(SB2); IT ~ IT-1 END;                                 04288000
       BEGIN TM~SUB ;                                                   04289000
 DLESSC:  ES1(TM); E0(XCH); E0(DEL) ;                                   04289005
 DLESSC1: EOL(9); IF TM=SUB THEN E0(CHS); GO CTIMESR2 ;                 04289007
       END ;                                                            04289010
       BEGIN EMITO(SUB); IT ~ IT-1 END;                                 04290000
       BEGIN TM~SUB ;                                                   04291000
 CLESSD:  E0(XCH); E0(DEL); E0(TM) ;                                    04291010
 CTYP:    OPTYPE[IT~IT-1]~COMPTYPE ;                                    04291015
       END ;                                                            04291020
       BEGIN TM~SUB ;                                                   04292000
 CLESSC:  ES1(TM); GO CTIMESR1 ;                                        04292010
       END ;                                                            04292020
    END SUBTRACT CASE STATEMENT;                                        04293000
    BEGIN % HANDLE NEGATIVE NUMBERS CASE STATEMENT.                     04293100
    EXPV~-EXPV ;                                                        04293200
    IF T2 { REALTYPE THEN EMITO(CHS) ELSE                               04294000
    IF T2 = LOGTYPE THEN FLAG(55) ELSE                                  04295000
    IF T2 = DOUBTYPE THEN EMITO(CHS) ELSE                               04296000
    IF T2 = COMPTYPE THEN                                               04297000
    BEGIN                                                               04298000
       EMITO(CHS); EMITO(XCH);                                          04299000
       EMITO(CHS); EMITO(XCH);                                          04300000
    END ELSE FLAG(55);                                                  04301000
    END OF NEG NUMBERS CASE STATEMNT ;                                  04301100
    IF CODE < 0 THEN BEGIN FLAG(55); IT ~ IT-1 END ELSE                 04302000
    CASE CODE OF                                                        04303000
    BEGIN                                                               04304000
       BEGIN                                                            04305000
          EMITO(MUL);                                                   04306000
          IF T1 = INTYPE AND T2 = INTYPE THEN IT ~ IT-1 ELSE            04307000
             OPTYPE[IT~IT-1] ~ REALTYPE;                                04308000
       END;                                                             04309000
       BEGIN TM~ML2; GO RPLUSD END ;                                    04310000
       BEGIN ES2; GO DTIMESC END ;                                      04311000
       BEGIN                                                            04312000
          EMITPAIR(0, XCH);                                             04313000
          EMITO(ML2);                                                   04314000
          IT ~ IT-1;                                                    04315000
       END;                                                             04316000
       BEGIN EMITO(ML2); IT ~ IT-1 END;                                 04317000
       BEGIN ES2; E0(XCH); E0(DEL) ;                                    04318000
 DTIMESC: EOL(9); EOL(17); E0(MUL); GO CTYP ;                           04318010
       END ;                                                            04318020
       BEGIN TM~MUL ;                                                   04319000
 CTIMESR: EP(9,SND); E0(TM) ;                                           04319010
 CTIMESR1:E0(XCH); EOL(9); E0(TM) ;                                     04319020
 CTIMESR2:E0(XCH); GO CTYP ;                                            04319030
       END ;                                                            04319040
       BEGIN TM~MUL; GO CDIVBYD END ;                                   04320000
       MATH(2, 26, COMPTYPE);                                           04321000
    END MULTIPLY CASE STATEMENT;                                        04322000
    IF CODE < 0 THEN BEGIN FLAG(55); IT ~ IT-1 END ELSE                 04323000
    CASE CODE OF                                                        04324000
    BEGIN                                                               04325000
       IF T1 = INTYPE AND T2 = INTYPE THEN                              04326000
       BEGIN EMITO(IDV); IT ~ IT-1 END ELSE                             04327000
       BEGIN EMITO(DIU); OPTYPE[IT~IT-1] ~ REALTYPE END;                04328000
       BEGIN                                                            04329000
       EP(9,STD); EP(17,STD); EP(0,XCH); EOL(17); EOL(9); E0(DV2) ;     04329010
       GO DTYP ;                                                        04329020
       END ;                                                            04329030
       MATH(1, 29, COMPTYPE);                                           04330000
       BEGIN                                                            04331000
          EMITPAIR(0, XCH);                                             04332000
          EMITO(DV2);                                                   04333000
          IT ~ IT-1;                                                    04334000
       END;                                                             04335000
       BEGIN EMITO(DV2); IT ~ IT-1 END;                                 04336000
       MATH(2, 32, COMPTYPE);                                           04337000
       BEGIN TM~DIU; GO CTIMESR END ;                                   04338000
       BEGIN TM~DIU ;                                                   04339000
 CDIVBYD: E0(XCH); E0(DEL); GO CTIMESR ;                                04339010
       END ;                                                            04339020
       MATH(2, 35, COMPTYPE);                                           04340000
    END OF DIVIDE CASE STATEMENT;                                       04341000
    IF CODE < 0 THEN BEGIN FLAG(55); IT ~ IT-1 END ELSE                 04342000
    BEGIN                                                               04343000
    IF CODE = 0 AND T2 = INTYPE AND                                     04344000
       CNSTSEENLAST THEN                                           %113-04345000
    BEGIN                                                               04346000
       IF T1 = INTYPE AND T2 = INTYPE THEN IT ~ IT-1 ELSE               04347000
       OPTYPE[IT~IT-1] ~ REALTYPE;                                      04348000
       EXPV~LINK;                                                 %113- 04349000
       A~1; ADR~SAVEADR;                                          %113- 04350000
       WHILE EXPV  DIV 2 ! 0 DO                                         04351000
       BEGIN                                                            04352000
          EMITO(DUP);                                                   04353000
          IF BOOLEAN(EXPV) THEN BEGIN A~A+1; EMITO(DUP) END;            04354000
          EMITO(MUL);                                                   04355000
          EXPV ~ EXPV DIV 2;                                            04356000
       END;                                                             04357000
       IF EXPV = 0 THEN BEGIN EMITO(DEL); EMITL(1) END ELSE             04358000
       WHILE A ~ A-1 ! 0 DO EMITO(MUL);                                 04359000
    END ELSE                                                            04360000
    BEGIN                                                               04361000
       EMITO(MKS);                                                      04362000
       EMITL(CODE);                                                     04363000
       EMITV(NEED(".XTOI ", INTRFUNID));                                04364000
       CASE CODE OF                                                     04365000
       BEGIN                                                            04366000
          BEGIN EMITO(DEL); OPTYPE[IT~IT-1]~IF (T1=INTYPE AND T2=INTYPE)04367000
                                 THEN INTYPE ELSE REALTYPE END;         04367500
          BEGIN EMITO(DEL); OPTYPE[IT~IT-1] ~ DOUBTYPE END;             04368000
          BEGIN EMITO(DEL); OPTYPE[IT~IT-1]~COMPTYPE END ;              04369000
          BEGIN EMITO(DEL); IT ~ IT-1 END;                              04370000
          BEGIN EMITO(DEL); EMITO(DEL); IT ~ IT-1 END;                  04371000
          BEGIN EMITO(DEL); EMITO(DEL); OPTYPE[IT~IT-1]~COMPTYPE END ;  04372000
          BEGIN EMITO(DEL); IT ~ IT-1 END;                              04373000
          BEGIN EMITO(DEL); EMITO(DEL); IT ~ IT-1 END;                  04374000
          BEGIN EMITO(DEL); EMITO(DEL); IT~IT-1 END ;                   04375000
       END OF POWER CASE STATEMENT;                                     04376000
    END;                                                                04377000
 END;                                                                   04378000
       END;                                                             04379000
       IP ~ IP-1;                                                       04380000
    END;                                                                04381000
    EXPRESLT ~ EXPCLASS;                                                04381100
    STACK:                                                              04382000
    PR[IP~IP+1] ~ PREC;                                                 04383000
    OPST[IP] ~ OP;                                                      04384000
                                                                        04385000
    IF PREC > 0 AND PREC { 4 THEN                                       04386000
    BEGIN                                                               04387000
       SCAN; LINK ~ FNEXT;                                              04388000
       IF NEXT = PLUS THEN GO TO LOOP;                                  04389000
       IF NEXT ! MINUS THEN GO TO NOSCAN;                               04390000
       PREC ~ 8; OP ~ 12;                                               04391000
       GO TO STACK;                                                     04392000
    END;                                                                04393000
    GO TO LOOP;                                                         04394000
    XIT: IF IP ! SAVIP THEN FLOG(56);                                   04395000
    IP ~ SAVIP-1;                                                       04396000
    EXPR ~ OPTYPE[IT];                                                  04397000
    IF OPTYPE[IT-1] ! 0 THEN FLOG(56);                                  04398000
    IT ~ SAVIT-1;                                                       04399000
    EXPRESULT ~ EXPRESLT;                                               04400000
    EXPVALUE ~ EXPV;                                                    04401000
    EXPLINK ~ EXPLNK;                                                   04402000
 IF DEBUGTOG THEN FLAGROUTINE(" EXPRE","SSION ",FALSE) ;                04403000
 END EXPR;                                                              04404000
PROCEDURE FAULT (X);                                                    04404050
    VALUE X;                                                            04404100
    REAL X;                                                             04404125
    BEGIN REAL LINK; LABEL XIT;                                         04404150
         SCAN; IF GLOBALNEXT ! LPAREN THEN BEGIN FLAG(106); GO XIT END; 04404200
         SCAN; IF GLOBALNEXT ! ID THEN BEGIN FLAG(66); GO TO XIT END;   04404250
         IF X = 1 THEN PDPRT[0,0] ~ PDPRT[0,0] & 1[44:47:1] ELSE        04404275
         PDPRT[0,0] ~ PDPRT [0,0] & 1[43  :47:1];                       04404300
         EMITOPDCLIT(41);   EMITO(DUP);                                 04404325
         IF X = 1 THEN BEGIN EMITL(2); EMITO(XCH); EMITL(1) END         04404350
                       ELSE EMITL(6);                                   04404375
         EMITO(LND);                                                    04404425
         IF X = 2 THEN EMITL(3);                                        04404435
         EMITO(SUB);                                                    04404450
         IF X = 2 THEN                                                  04404475
           BEGIN EMITO(DUP); EMITL(3); EMITO(SSN) ;EMITO(EQUL); EMITL(2)04404500
                ;EMITO(BFC) ; EMITO(DEL);EMITL(2);                      04404525
           END;                                                         04404550
         LINK ~ GET(GETSPACE(FNEXT)); EMITPAIR(LINK.ADDR,ISD);          04404570
         IF X = 1 THEN EMITL(30) ELSE EMITL(25);                        04404600
         EMITO(LND); EMITL(41);EMITO(STD);                              04404625
         SCAN; IF GLOBALNEXT ! RPAREN THEN FLAG(108);                   04404650
         SCAN;                                                          04404660
    XIT:                                                                04404675
    END FAULT;                                                          04404700
PROCEDURE SUBREF;                                                       04405000
BEGIN REAL LINK,INFC;                                                   04406000
    REAL ACCIDENT;                                                      04406010
    LABEL XIT;                                                          04406020
IF DEBUGTOG THEN FLAGROUTINE("   SUB","REF   ",TRUE ) ;                 04406025
IF TSSEDITOG THEN IF NAME="ZIP   " AND NOT DCINPUT THEN TSSED(NAME,3) ; 04406030
   IF NAME = "EXIT  " THEN                                              04407000
   BEGIN                                                                04408000
      RETURNFOUND ~ TRUE;                                               04408100
      EMITL(1);                                                         04409000
      EMITPAIR(16,STD);                                                 04410000
      EMITPAIR(10,KOM);                                                 04411000
      EMITPAIR( 5, KOM);                                                04412000
      PUT(FNEXT+1, "......");                                           04413000
      SCAN;                                                             04414000
   END ELSE IF NAME="ZIP   " AND NOT DCINPUT THEN                       04415000
   BEGIN                                                                04415010
      EMITO(MKS);                                                       04415011
      EMITL(0); EMITL(0); % DUMMY FILE AND FORMAT                       04415020
      EMITPAIR(-1,SSN);                                                 04415021
      EMITB(-1,FALSE); LADR1~LAX; ADJUST; DESCREQ~FALSE;                04415030
    IF ADR } 4085 THEN BEGIN ADR~ADR+1; SEGOVF END;                     04415040
      ACCIDENT~PRGDESCBLDR(0,0,ADR.[36:10]+1,NSEG);                     04415050
      EMITOPDCLIT(19);                                                  04415070
      EMITO(GFW);                                                       04415080
      LISTART ~ ADR&NSEG[TOSEGNO]; ADJUST;SCAN;                         04415090
      IF GLOBALNEXT!LPAREN THEN BEGIN FLAG(106);GO TO XIT END;          04415100
      SCAN; IF GLOBALNEXT!ID THEN BEGIN FLAG(66); GO TO XIT END;        04415110
      LINDX ~ FNEXT; SCAN; XTA ~ GET(LINDX+1);                          04415120
      IF GLOBALNEXT!RPAREN THEN BEGIN FLAG(108); GO TO XIT END;         04415130
      LINDX ~ GETSPACE(LINDX);                                          04415140
      IF T~(LINFA~GET(LINDX)).CLASS!ARRAYID THEN                        04415150
                  BEGIN FLAG(66); GO TO XIT END;                        04415160
      IF XREF THEN ENTERX(XTA,0&LINFA[15:15:9]);                        04415165
      EMITPAIR(LADDR~LINFA.ADDR,LOD);                                   04415170
      IF BOOLEAN(LINFA.FORMAL) THEN                                     04415180
         BEGIN                                                          04415190
         IF T ~ GET(LINDX+2)<0 THEN EMITOPDCLIT(T.SIZE)                 04415200
         ELSE EMITNUM(T.SIZE); EMITOPDCLIT(LADDR-1); EMITO(CTF) END     04415210
      ELSE EMITNUM(GET(LINDX+2).BASENSIZE); EMITL(18); EMITO(STD);;     04415220
      EMITL(LINFA.CLASNSUB&0[44:47:1]); EMITL(19); EMITO(STD);          04415230
      BRANCHLIT(LISTART,TRUE); EMITL(19); EMITO(STD);                   04415240
      EMITO(RTS); ADJUST;                                               04415250
      EMITL(1); EMITO(CHS); EMITL(19); EMITO(STD);                      04415260
      EMITDESCLIT(19); EMITO(RTS); FIXB(LADR1); DESCREQ~FALSE;          04415270
      EMITPAIR(ACCIDENT,LOD); EMITOPDCLIT(7); EMITO(FTF);               04415280
      EMITL(6);      %  EDITCODE 6 FOR ZIP                              04415290
      EMITV(NEED(".FTOUT",INTRFUNID));  SCAN                            04415300
    END ELSE IF NAME = "OVERFL" THEN FAULT(2)                           04415310
    ELSE IF NAME = "DVCHK " THEN FAULT(1)                               04415320
    ELSE                                                                04415330
   BEGIN                                                                04416000
   LINK ~ NEED(NAME, SUBRID);                                           04417000
   IF XREF THEN ENTERX(XTA,0&GET(LINK)[15:15:5]);                       04417100
   EMITO(MKS);                                                          04418000
   SCAN;                                                                04419000
   IF GLOBALNEXT = LPAREN THEN                                          04420000
      BEGIN PARAMETERS(LINK); SCAN END ELSE                             04421000
         IF NOT BOOLEAN((INFC~GET(LINK+2)).[1:1]) THEN                  04422000
      PUT(LINK+2,-INFC) ELSE                                            04423000
   IF INFC.NEXTRA ! 0 THEN                                              04424000
      BEGIN XTA ~ GET(LINK+1); FLAG(28) END;                            04425000
   EMITV(LINK);                                                         04426000
                                                                        04426500
                                                                        04426700
   END;                                                                 04427000
    XIT:                                                                04427010
IF DEBUGTOG THEN FLAGROUTINE("   SUB","REF   ",FALSE) ;                 04427025
END SUBREF;                                                             04428000
PROCEDURE DECLAREPARMS(FNEW); VALUE FNEW; REAL FNEW;                    04429000
BEGIN                                                                   04430000
   REAL I, T, NLABELS, INFA, INFB, INFC;                                04431000
IF DEBUGTOG THEN FLAGROUTINE("DECLAR","EPARMS",TRUE ) ;                 04431010
   INFA ~ GET(FNEW);                                                    04432000
   IF INFA.SEGNO ! 0 THEN BEGIN XTA ~ NNEW; FLAG(25) END;               04433000
   INFA.SEGNO ~ NSEG; PUT(FNEW,INFA);                                   04434000
   ENTRYLINK[ELX] ~ 0 & FNEW[TOLINK] & NEXTSS[TOADDR];                  04435000
   FOR I ~ 1 STEP 1 UNTIL PARMS DO                                      04436000
   BEGIN                                                                04437000
   EXTRAINFO[NEXTSS.IR,NEXTSS.IC] ~ PARMLINK[I];                        04438000
   NEXTSS ~ NEXTSS-1;                                                   04439000
   IF T ~ PARMLINK[I] ! 0 THEN                                          04440000
      BEGIN                                                             04441000
         GETALL(T,INFA,INFB,INFC);                                      04442000
         IF BOOLEAN(INFA   .FORMAL) THEN                                04443000
         BEGIN                                                          04443100
            IF INFA.SEGNO = ELX THEN                                    04444000
            BEGIN XTA ~ INFB   ; FLAG(26) END;                          04445000
         END ELSE IF (INFA < 0 AND INFA.ADDR < 1024) OR BOOLEAN(INFA.CE)04445100
                  THEN BEGIN XTA ~ INFB; FLAG(107) END;                 04445200
         INFA    ~ INFA   & 1[TOFORMAL] & ELX[TOSEGNO];                 04446000
         INFC   .BASE ~ I;                                              04447000
         PUT(T,INFA); PUT(T+2,INFC);                                    04448000
      END ELSE NLABELS ~ NLABELS+1;                                     04449000
   END;                                                                 04450000
   IF NLABELS > 0 THEN                                                  04451000
   BEGIN ENTRYLINK[ELX  ].CLASS ~ NLABELS;                              04452000
      IF LABELMOM=0 THEN BEGIN BUMPLOCALS; LABELMOM~LOCALS+1536 END;    04453000
   END;                                                                 04454000
   GETALL(FNEW,INFA,INFB,INFC);                                         04455000
   IF BOOLEAN(INFC.[1:1]) THEN                                          04456000
      BEGIN                                                             04457000
         IF INFC.NEXTRA ! PARMS THEN                                    04458000
            BEGIN XTA ~ INFB; FLOG(41);                                 04459000
               PARMS ~ INFC.NEXTRA;                                     04460000
            END;                                                        04461000
         T ~ INFC.ADINFO;                                               04462000
         FOR I ~ 1 STEP 1 UNTIL PARMS DO                                04463000
         IF NOT(PARMLINK[I] = 0 EQV                                     04464000
            EXTRAINFO[(T+I-1).IR,(T+I-1).IC].CLASS = LABELID) THEN      04465000
            BEGIN IF PARMLINK[I] = 0 THEN XTA ~ "*     "                04466000
               ELSE XTA ~ GET(PARMLINK[I]+1);                           04467000
               FLAG(40);                                                04468000
            END;                                                        04469000
      END                                                               04470000
      ELSE                                                              04471000
      BEGIN                                                             04472000
         IF PARMS = 0 THEN INFC ~ -INFC ELSE                            04473000
         INFC ~ -(INFC & PARMS[TONEXTRA]                                04474000
            & NEXTEXTRA[TOADINFO]);                                     04475000
         PUT(FNEW+2,INFC);                                              04476000
         FOR I ~ 1 STEP 1 UNTIL PARMS DO                                04477000
         BEGIN                                                          04478000
            EXTRAINFO[NEXTEXTRA.IR,NEXTEXTRA.IC] ~ 0 &                  04479000
               (IF PARMLINK[I] = 0 THEN LABELID ELSE 0)[TOCLASS];       04480000
            NEXTEXTRA ~ NEXTEXTRA+1;                                    04481000
         END;                                                           04482000
      END;                                                              04483000
   IF ELX ~ ELX+1 > MAXEL THEN BEGIN FLAG(128); ELX ~ 0 END;            04484000
IF DEBUGTOG THEN FLAGROUTINE("DECLAR","EPARMS",FALSE) ;                 04484010
END DECLAREPARMS;                                                       04485000
PROCEDURE IOLIST(LEVEL);   REAL LEVEL;                                  04486000
BEGIN ALPHA LADR2,T;                                                    04487000
BOOLEAN A;                                                              04487050
INTEGER INDX,I,BDLINK,NSUBS;                                            04487100
      LABEL ROUND,XIT,ERROR,LOOP,SCRAM;                                 04488000
INTEGER STREAM PROCEDURE CNTNAM(IDEN); VALUE IDEN;                      04488100
BEGIN  LABEL  XIT;                                                      04488200
       SI ~ LOC IDEN; SI ~ SI +  3; TALLY ~ 1;                          04488300
       5(IF SC = " " THEN JUMP OUT TO XIT;SI ~ SI+1;TALLY ~ TALLY+1);   04488400
       XIT:  CNTNAM ~ TALLY;                                            04488500
END CNTNAM;                                                             04488600
                                                                        04489000
                                                                        04490000
IF DEBUGTOG THEN FLAGROUTINE("   IOL","IST   ",TRUE ) ;                 04491000
ROUND:  DESCREQ ~ TRUE;                                                 04492000
        LOCALNAME ~ FALSE;                                              04492100
IF GLOBALNEXT = SEMI THEN GO TO XIT;                                    04493000
IF GLOBALNEXT = STAR THEN                                               04493100
    BEGIN IF NOT NAMEDESC THEN                                          04493150
              TV ~ ENTER(0&LISTSID[TOCLASS],LISTID~LISTID+1);           04493200
         LOCALNAME ~ TRUE; NAMEDESC ~ TRUE; SCAN;                       04493300
    END;                                                                04493350
IF GLOBALNEXT = ID THEN                                                 04494000
BEGIN LINDX ~ FNEXT;                                                    04495000
      SCAN; XTA ~ GET(LINDX+1);                                         04496000
      IF GLOBALNEXT = EQUAL THEN       %RETURN TO CALLER                04497000
      BEGIN IF (LINFA~GET(GETSPACE(LINDX))).CLASS ! VARID THEN FLAG(50);04498000
            SCRAM: IF (LEVEL ~ LEVEL-1) < 0 THEN FLOG(97);              04498100
            GO TO XIT;                                                  04498200
      END;                                                              04499000
                                                                        04500000
      IF DATASTMTFLAG AND SPLINK } 0 THEN        %DECLARE OWN           04500100
      BEGIN                                                             04500200
         IF BOOLEAN(GET(LINDX).FORMAL) THEN FLAG(147);                  04500300
         IF SPLINK>1 THEN                                               04500310
              IF GET(LINDX).ADDR>1023 THEN       FLAG(174);             04500320
         LINDX ~ GETSPACE(-LINDX);                                      04500400
         IF BOOLEAN(GET(LINDX).EQ) THEN FLAG(168);                      04500420
      END ELSE LINDX ~ GETSPACE(LINDX);                                 04500500
      IF T ~ (LINFA~GET(LINDX)).CLASS > VARID THEN FLAG(50);            04500600
      IF XREF THEN ENTERX(XTA,C2&LINFA[15:15:9]);                       04500655
      IF GLOBALNAME OR LOCALNAME THEN                                   04500700
         IF NAMEIND~ NAMEIND+1 GTR LSTMAX THEN FLOG(161)                04500725
         ELSE NAMLIST[NAMEIND] ~ XTA & CNTNAM(XTA)[9:45:3];             04500750
      IF T = ARRAYID THEN                                               04501000
        IF GLOBALNEXT ! LPAREN THEN                                     04502000
        BEGIN IF SPLINK ! 1 THEN                                        04503000
              BEGIN                                                     04503004
              EMITL(0);                                                 04503008
              EMITPAIR(LADDR ~ LINFA.ADDR,LOD);                         04503010
              EMITO(FTC);                                               04503020
              EMITDESCLIT(2);                                           04503030
              EMITO(INX);                                               04503040
              EMITO(LOD);                                               04503050
              END ELSE EMITPAIR(LADDR-LINFA.ADDR,LOD);                  04503055
            NSUBS ~ (T ~ GET (LINDX+2)).NEXTRA;                         04503100
            IF GLOBALNAME OR LOCALNAME THEN                             04503125
            BEGIN                                                       04503150
           IF NSUBS GTR SAVESUBS THEN SAVESUBS ~ NSUBS;                 04503160
           IF NSUBS GTR NAMLIST[0] THEN NAMLIST[0] ~ NSUBS;             04503170
                   NAMLIST[NAMEIND].[1:8] ~ NSUBS;                      04503175
            INDX ~ -1;                                                  04503180
            INFA ~ GET(NEED(".SUBAR",BLOCKID)).ADDR;                    04503190
            BDLINK ~ T.ADINFO+1;                                        04503200
            END;                                                        04503225
            IF BOOLEAN (LINFA.FORMAL) THEN                              04504000
            BEGIN                                                       04505000
                  IF T LSS 0 THEN EMITOPDCLIT(T.SIZE)                   04505200
                  ELSE EMITNUM(T.SIZE);                                 04506000
                  EMITOPDCLIT(LADDR-1);                                 04507000
                  EMITO(CTF);                                           04508000
            END ELSE EMITNUM(T.BASENSIZE);                              04509000
            IF GLOBALNAME OR LOCALNAME THEN                             04509050
              FOR I ~ 1 STEP 1 UNTIL NSUBS DO                           04509100
              BEGIN IF T ~ EXTRAINFO[(BDLINK~BDLINK-1).IR,              04509150
                    BDLINK.IC] LSS 0 THEN EMITOPDCLIT(T)                04509200
                    ELSE EMITNUM(T);                                    04509250
                    EMITNUM(INDX ~ INDX+1);                             04509300
                    EMITDESCLIT(INFA);                                  04509350
                    EMITO(STD);                                         04509400
              END;                                                      04509450
            EMITL(18);  EMITO(STD);                                     04510000
        END ELSE                                                        04511000
            BEGIN SCAN;                                                 04512000
                  A ~(IF GLOBALNAME OR LOCALNAME                        04513000
                  THEN SUBSCRIPTS(LINDX,4) ELSE SUBSCRIPTS(LINDX,2));   04513100
                  SCAN;                                                 04514000
            END                                                         04515000
      ELSE EMITN(LINDX);                                                04516000
      IF GLOBALNAME OR LOCALNAME THEN                                   04516100
      BEGIN EMITOPDCLIT(18); EMITNUM(NAMEIND);                          04516200
            EMITD(43,DIA); EMITD(3,DIB); EMITD(15,TRB);                 04516300
            EMITL(18); EMITO(STD);                                      04516350
      END;                                                              04516400
      EMITL(LINFA.CLASNSUB&0[44:47:1]);                                 04517000
      EMITL(20);  EMITO(STD);                                           04518000
    IF ADR > 4083 THEN                                                  04518100
         BEGIN ADR~ADR+1;  SEGOVF END ;                                 04518200
      BRANCHLIT(LISTART,TRUE);                                          04519000
      EMITL(19);  EMITO(STD);                                           04520000
      EMITO(RTS); ADJUST;                                               04521000
      GO TO LOOP;                                                       04522000
END;                                                                    04523000
IF GLOBALNEXT = LPAREN THEN   %  RECURSE ON (                           04524000
BEGIN EMITB(-1,FALSE);                                                  04525000
      ADJUST;                                                           04526000
      LADR2 ~ (ADR + 1)&LAX[TOADDR]&NSEG[TOSEGNO];                      04527000
      SCAN;  LEVEL ~ LEVEL + 1;                                         04528000
      IOLIST(LEVEL);                                                    04529000
      IF GLOBALNEXT ! EQUAL THEN  %  PHONY IMP DO                       04530000
      BEGIN BRANCHES[T ~ LADR2.ADDR] ~ BRANCHX;                         04531000
            BRANCHX ~ T;                                                04532000
            IF GLOBALNEXT ! RPAREN THEN GO TO ERROR;                    04533000
            SCAN;  GO TO LOOP;                                          04534000
      END;                                                              04535000
      IF XREF THEN ENTERX(GET(LINDX+1),1&LINFA[15:15:9]);               04535500
      IF LINFA.SUBCLASS > REALTYPE THEN                                 04536000
      BEGIN XTA ~ GET(LINDX + 1);                                       04537000
            FLAG(84);                                                   04538000
      END;                                                              04539000
      EMITB(-1,FALSE);                                                  04540000
      LADR3 ~ LAX;                                                      04541000
      FIXB(LADR2.ADDR);                                                 04542000
      DESCREQ ~ FALSE;                                                  04543000
      SCAN;  IF EXPR(TRUE) > REALTYPE THEN FLAG(102);  % INITIAL VALUE  04544000
      EMITN(LINDX);      EMITO(STD);                                    04545000
      EMITB(LADR2,FALSE);                                               04546000
      IF GLOBALNEXT ! COMMA THEN GO TO ERROR;                           04547000
      ADJUST;                                                           04548000
      LADR4 ~ (ADR + 1)&NSEG[TOSEGNO];                                  04549000
      SCAN;  IF EXPR(TRUE) > REALTYPE THEN FLAG(102) ELSE EMITO(GRTR);  04550000
      EMITB(LADR2,TRUE);                                                04551000
      EMITB(-1,FALSE);                                                  04552000
      LADR5 ~ LAX;                                                      04553000
      FIXB(LADR3);                                                      04554000
      IF GLOBALNEXT ! COMMA THEN EMITL(1)                               04555000
      ELSE BEGIN SCAN; IF EXPR(TRUE) > REALTYPE THEN FLAG(102); END;    04556000
      EMITV(LINDX);  EMITO(ADD);                                        04557000
      EMITN(LINDX);      EMITO(SND);                                    04558000
      EMITB(LADR4,FALSE);                                               04559000
      FIXB(LADR5);                                                      04560000
      IF GLOBALNEXT = RPAREN THEN SCAN ELSE GO TO ERROR;                04561000
 LOOP:  IF GLOBALNEXT = SEMI OR GLOBALNEXT = SLASH THEN GO TO XIT;      04562000
           IF GLOBALNEXT = RPAREN THEN GO TO SCRAM;                     04563000
             IF GLOBALNEXT = COMMA THEN                                 04564000
             BEGIN SCAN;                                                04565000
                   IF GLOBALNEXT = SEMI THEN GO TO ERROR;               04566000
                   GO TO ROUND;                                         04567000
             END;                                                       04568000
 ERROR: XTA ~ NAME;                                                     04569000
        FLAG(94);                                                       04570000
        IF GLOBALNEXT = SEMI THEN GO TO XIT;                            04571000
        SCAN;                                                           04572000
        IF GLOBALNEXT = ID THEN GO TO ROUND;                            04573000
        ERRORTOG ~ TRUE; GO TO XIT;                                     04574000
 END;                                                                   04575000
 IF GLOBALNEXT = RPAREN THEN GO TO SCRAM ELSE                           04576000
   IF GLOBALNEXT ! SLASH THEN GO TO ERROR;                              04577000
 XIT: IF DEBUGTOG THEN FLAGROUTINE("   IOL","IST   ",FALSE) ;           04578000
 END IOLIST;                                                            04579000
 INTEGER PROCEDURE FILECHECK(FILENAME,FILETYPE);                        04580000
 VALUE FILENAME,FILETYPE;   ALPHA FILENAME;   INTEGER FILETYPE;         04581000
 BEGIN COMMENT  THIS PROCEDURE RETURNS THE PRT CELL ALLOCATED TO        04582000
 THE FILE FILENAME... A CELL IS CREATED IF NONE EXISTS;                 04583000
 IF DEBUGTOG THEN FLAGROUTINE(" FILEC","HECK  ",TRUE);                  04583010
 EMITL(IF NOTOPIO THEN 2 ELSE 5);   %  FOR IO DESCRIPTOR                04584000
 IF T ~ GLOBALSEARCH(FILENAME) = 0 THEN   %  FILE UNDECLARED            04585000
 BEGIN  MAXFILES ~ MAXFILES + 1;                                        04586000
 BUMPPRT;                                                               04586500
 I ~ GLOBALENTER(-0&(FILECHECK~PRTS)[TOADDR]                            04587000
                    &FILEID[TOCLASS],FILENAME)+2;                       04588000
 INFO[I.IR,I.IC]. LINK ~ FILETYPE;                                      04589000
 END ELSE    %  FILE ALREADY EXISTS                                     04590000
 FILECHECK ~  GET(T).ADDR;                                              04591000
 IF DEBUGTOG THEN FLAGROUTINE(" FILEC","HECK  ",FALSE) ;                04591010
 END FILECHECK;                                                         04592000
 PROCEDURE INLINEFILE;                                                  04593000
 BEGIN COMMENT THIS PROCEDURE GENERATES THE CODE TO BRING UP THE FILE...04594000
   IF THE FILE IS AN INTEGER THEN FILECHECK IS CALLED, IF THE FILE      04595000
   IS NOT AN INTEGER THEN IN-LINE CODE IS GENERATED FOR OBJECT TIME     04596000
   ANALYSIS;                                                            04597000
 REAL TEST;                                                             04598000
 COMMENT IF LAST INSTRUCTION WAS A LIT CALL THEN WE HAVE SEEN REFERENCE 04599000
 TO AN INTEGER FILE ID;                                                 04600000
 IF DEBUGTOG THEN FLAGROUTINE(" INLIN","EFILE ",TRUE ) ;                04600010
 TEST~ADR ;                                                             04601000
 IF EXPR(TRUE)>REALTYPE THEN FLAG(102)                                  04602000
 ELSE IF EXPRESULT=NUMCLASS THEN                                        04602500
          BEGIN XTA~NNEW ;                                              04603000
          IF EXPVALUE}1.0@5 OR EXPVALUE{0.5 THEN FLAG(33)               04603500
          ELSE BEGIN                                                    04604000
               IF ADR<TEST THEN % EXPR GOT SEGOVFL--ASSUME NO WRAPAROUND04604010
                    EMITO(DEL)                                          04604020
               ELSE ADR~TEST;                                           04604025
               TEST~SPCLBIN2DEC(C1~EXPVALUE);                           04604030
               IF XREF THEN ENTERX(TEST&1[TOCE],0&FILEID[TOCLASS]) ;    04604040
               EMITDESCLIT(FILECHECK(0&"."[12:42:6]&TEST[18:12:30],     04604050
                           IF DCINPUT THEN 12 ELSE 2)) ;                04604060
               END ;                                                    04604070
           END ELSE                                                     04604080
COMMENT  NOT INTEGER FILE... GENERATE OBJECT TIME CODE;                 04605000
     BEGIN EMITPAIR(17,ISN) ;                                           04606000
     IF FILEARRAYPRT=0 THEN BEGIN BUMPPRT;FILEARRAYPRT~PRTS END;        04607000
     EMITOPDCLIT(FILEARRAYPRT);                                         04608000
     EMITO(DUP);   EMITL(0);   EMITO(EQUL);                             04609000
       COMMENT NEED 7 CONSECUTIVE SYLLABLES;                            04610000
   IF ADR } 4082 THEN                                                   04611000
     BEGIN ADR ~ ADR + 1;                                               04612000
           SEGOVF;                                                      04613000
     END;                                                               04614000
     EMITL(3+FILEARRAYPRT.[38:1]);%CONSIDER POSSIBLE XRT                04615000
     EMITO(BFC);                  % BRANCH AROUND TERMINATION CODE      04615100
     EMITL(1);   EMITO(CHS);   EMITOPDCLIT(FILEARRAYPRT);  %  INV INDEX 04616000
     EMITO(LOD);   EMITL(IF NOTOPIO THEN 2 ELSE 5);   EMITO(CDC);       04617000
END;                                                                    04618000
IF DEBUGTOG THEN FLAGROUTINE(" INLIN","EFILE ",FALSE) ;                 04618010
END INLINEFILE;                                                         04619000
PROCEDURE FILECONTROL(N); VALUE N; REAL N;                              04619010
BEGIN    COMMENT COMPILES ALL CALLS ON ALGOL FILE CONTROL;              04619020
         EODS~TRUE ;                                                    04619025
         EXECUTABLE ;                                                   04619027
         SCAN; EMITO(MKS);                                              04619030
         EMITL(N); EMITL(0);                                            04619040
         NOTOPIO ~ TRUE;                                                04619050
         INLINEFILE ;                                                   04619060
         EMITL(4); EMITOPDCLIT(14);                                     04619070
         NOTOPIO ~ FALSE;                                               04619080
END FILECONTROL;                                                        04619090
PROCEDURE FORMATER;                                                     04620000
BEGIN                                                                   04621000
COMMENT FORMATER COMPILES A PSEUDO CODE USED BY THE OBJECT TIME         04621500
         FORMATING ROUTINES TO PRODUCE DESIRED I/O. USUALLY, THERE IS   04622000
         ONE WORD OF PSEUDO CODE PRODUCED FOR EACH EDITING PHRASE. IN   04622500
         ADDITION ONE WORD IS PRODUCED FOR EACH RIGHT PARENTHESIS AND   04623000
         SLASH GROUP.                                                   04623500
         THE 47TH BIT OF THE FIRST WORD IS SET IF THERE ARE LIST        04624000
         ELEMENT PHRASES IN THE FORMAT STATEMENT.                       04624500
         THERE ARE FOUR GROUPS OF PHRASES:                              04625000
         GROUP 1 = F, E, D, G           = REPEAT WIDTH DECIMAL          04625500
         GROUP 2 = I, J, A, O, L, T, C, = REPEAT WIDTH                  04626000
                   X, P                                                 04626100
         GROUP 3 = H                    = REPEAT SPECIAL PURPOSE        04626500
         GROUP 4 = ), /                 = CONTROL REPEAT LINK           04627000
         WORD FOR GROUP 1:                                              04627500
              CODE    =  [ 1: 5]                                        04628000
              REPEAT  =  [ 6:12]                                        04628500
              WIDTH   =  [18:12]                                        04629000
              DEDIMAL =  [30:12]                                        04629500
         WORD FOR GROUP 2:                                              04630000
              CODE    =  [ 1: 5]                                        04630500
              REPEAT  =  [ 6:12]                                        04631000
              WIDTH   =  [18:12]                                        04631500
              SIGN    = [41: 1]                                         04631600
              FOR P, X AND T REPEAT = 1                                 04631625
              P: SIGN = SIGN OF SCALE                                   04631650
         WORD FOR GROUP 3:                                              04632000
              CODE    =  [ 1: 5]                                        04632500
              REPEAT  =  [ 6:12]                                        04633000
              H: STRING STARTS AT BIT 18 AND CONTINUES TO END OF STRING 04635500
                 REPEAT = NUMBER OF STRING CHARACTERS                   04635600
         WORD FOR GROUP 4:                                              04636000
              CODE    =  [ 1: 5]                                        04636500
              REPEAT  =  [ 6:12]                                        04637000
              LINK    =  [18:12]                                        04637500
              DECIMAL =  [30:12]                                        04638000
              CNTROL  =  [47: 1]                                        04638500
              ): LINK NUMBER OF WORD - 1 BACK TO 1ST PHRASE AFTER       04639000
                     LEFT PAREN                                         04639500
                 REPEAT = REPEAT OF ASSOCIATED LEFT PAREN               04639600
                 OUTER MOST RIGHT PAREN                                 04640000
                   A. DECIMAL ! 0                                       04640500
                   B. LINKS TO LEFT PAREN OF LAST PREVIOUS RIGHT PAREN  04641000
              /: REPEAT = NUMBER OF SLASHES.                            04641500
         ;                                                              04642000
DEFINE   APHASE =  6 #,                                                 04642500
         VPHRASE = 30 #,                                                04642510
         LPPHRASE = 29 #,                                               04642520
         CPHASE = 15 #,                                                 04642600
         DPHASE = 14 #,                                                 04643000
         EPHASE = 13 #,                                                 04643500
         FPHASE = 12 #,                                                 04644000
         GPHASE = 11 #,                                                 04644500
         HPHASE =  2 #,                                                 04645000
         IPHASE = 10 #,                                                 04645500
         JPHASE =  9 #,                                                 04646000
         LPHASE =  8 #,                                                 04646500
         OPHASE =  7 #,                                                 04647000
         PPHASE =  3 #,                                                 04647500
         TPHASE =  5 #,                                                 04648000
         XPHASE =  4 #,                                                 04648500
         RTPARN =  0 #,                                                 04649000
         SLASH  =  1 #,                                                 04649500
         TOCODE    =  1:43: 5 #,                                        04650000
         TOREPEAT  =  6:36:12 #,                                        04650500
         TOWIDTH   = 18:36:12 #,                                        04651000
         TOLINK    = 18:36:12 #,                                        04651500
         TODECIMAL = 30:36:12 #,                                        04652000
         TOCNTRL   = 47:47: 1 #,                                        04652500
         TONUM     = 42:43: 1 #,                                        04653000
         TOSIGN    = 41:47: 1 #,                                        04653500
         WSA       = LSTT #;                                            04654000
REAL J, T;                                                              04655000
LABEL KK,SL,FL ;                                                        04655100
FORMAT FM(//"PHRASE#     CODE   REPEAT    WIDTH  DECIMAL",X2,           04655400
          ".[41:1]  .[42:4]  .[42:5]  .[44:1]  .[45:1]",X2,             04655410
          ".[46.1],  .[46:2]  .[47:1]"/) ;                              04655420
INTEGER D,I,  CODE,REPEAT,WIDTH,DECIMAL,TOTAL,SLCNT,SAVLASTLP,          04655500
        PARENCT,SAVTOTAL;                                               04656000
BOOLEAN VRB,ASK ;                                                       04656100
BOOLEAN LISTEL, HF, ZF, QF, PF, MINUSP, FEELD, STRINGF;                 04656500
BOOLEAN COMMAS, DOLLARS, PLUSP, STR;                                    04656600
LABEL ROUND,NOPLACE,NUM,NUL,LP,RP,ENDER,NOEND,FALL,SEMIC,NUL1;          04657000
LABEL NEWWD, ROUND1;                                                    04657100
ALPHA STREAM PROCEDURE GETCHAR(NCRV, T); VALUE NCRV;                    04657500
BEGIN SI ~ NCRV; DI ~ T; DI ~ DI+7; DS ~ CHR; GETCHAR ~ SI;             04658000
END GETCHAR;                                                            04658500
BOOLEAN PROCEDURE CONTINUE;                                             04659000
BEGIN                                                                   04659500
LABEL LOOP;                                                             04660000
BOOLEAN STREAM PROCEDURE CONTIN(CD);                                    04660500
BEGIN SI~CD; IF SC ! "C" THEN IF SC ! "$" THEN BEGIN SI~SI+5;           04661000
      IF SC ! " " THEN IF SC ! "0" THEN BEGIN TALLY~1;                  04661500
      CONTIN ~ TALLY END END                                            04662000
END OF CONTIN;                                                          04662500
BOOLEAN STREAM PROCEDURE COMNT(CD,T); VALUE T;                          04663000
BEGIN LABEL L;                                                          04663500
   SI~CD; IF SC = "C" THEN BEGIN T(SI~SI+1; IF SC="-" THEN              04664000
   TALLY~1 ELSE JUMP OUT TO L); TALLY~1; L: END; COMNT~TALLY;           04664500
END COMNT;                                                              04665000
BOOLEAN STREAM PROCEDURE DCCONTIN(CD);                                  04665500
BEGIN SI~CD; IF SC = "-" THEN TALLY ~ 1; DCCONTIN~TALLY;                04666000
END DCCONTIN;                                                           04666500
LOOP:   IF NOT(CONTINUE ~                                               04667000
         IF DCINPUT AND NOT TSSEDITOG OR FREEFTOG THEN                  04667500
              IF NEXTCARD<4 THEN DCCONTIN(CB)                           04667600
              ELSE IF NEXTCARD=7 THEN DCCONTIN(DB) ELSE CONTIN(TB)      04668000
         ELSE IF NEXTCARD<4 THEN CONTIN(CB)                             04668500
              ELSE IF NEXTCARD=7 THEN CONTIN(DB) ELSE CONTIN(TB))       04668600
         THEN IF(IF NEXTCARD < 4 THEN                                   04669000
                COMNT(CB,DCINPUT AND NOT TSSEDITOG OR FREEFTOG)         04669500
                ELSE IF NEXTCARD = 7 THEN                               04670000
                COMNT(DB,DCINPUT AND NOT TSSEDITOG OR FREEFTOG)         04670100
         ELSE COMNT(TB,0) AND NEXTCARD!6) THEN                          04670500
         BEGIN                                                          04671000
           IF READACARD THEN IF LISTOG THEN PRINTCARD;                  04671500
           GO TO LOOP;                                                  04672000
         END;                                                           04672500
END CONTINUE;                                                           04673000
STREAM PROCEDURE STORECHAR(ARY,POSIT,CHAR);VALUE POSIT;                 04673500
BEGIN SI ~CHAR; SI ~ SI + 7;                                            04674000
      DI ~ ARY; DI ~ DI + POSIT;                                        04674500
      DS ~ CHR;                                                         04675000
END STORECHAR;                                                          04675500
ALPHA STREAM PROCEDURE BACKNCR(NCRV); VALUE NCRV;                       04676000
BEGIN SI~NCRV; SI ~ SI-1; BACKNCR ~ SI; END BACKNCR;                    04676500
COMMENT ******** START OF CODE **************;                          04677000
IF XTA ~ LABL = BLANKS THEN FLAG(18) ELSE                               04677500
IF D~ SEARCH(LABL) = 0 THEN                                             04678000
   D~ ENTER(0 & FORMATID[TOCLASS], LABL) ELSE                           04678500
   IF GET(D).CLASS ! FORMATID THEN BEGIN D~0;FLAG(143) END;             04679000
IF XREF THEN ENTERX(LABL,1&FORMATID[TOCLASS]);                          04679400
LABL ~ BLANKS;                                                          04679500
NCR ~ BACKNCR(NCR);                                                     04680000
WSA[0] ~ TOTAL ~ 1;                                                     04680500
ROUND1: XTA ~ BLANKS;                                                   04680700
ROUND: NCR ~ GETCHAR(NCR,T);                                            04681000
       IF T = "]" THEN GO TO NOPLACE;                                   04681002
       XTA ~ T & XTA[12:18:30];                                         04681004
       T~IF (T="&" OR T="<") AND                                        04681010
          (HOLTOG OR NOT(HF OR STRINGF)) THEN "+" ELSE                  04681020
       IF (T="@" OR T=":") AND (HOLTOG OR NOT HF) THEN """              04681030
                ELSE T;                                                 04681060
       IF NOT (HF OR STRINGF) THEN                                      04681100
          IF T = " " THEN GO TO ROUND                                   04681120
          ELSE IF T="," THEN GO SL ;                                    04681140
       IF HF THEN                                                       04683000
       BEGIN                                                            04683500
           STORECHAR(WSA[TOTAL],I,T);                                   04684000
           IF HF ~ REPEAT ~ REPEAT - 1 ! 0 THEN                         04684500
           IF I ~ I+1 = 8 THEN                                          04685000
           BEGIN IF TOTAL ~ TOTAL +1 > LSTMAX THEN GO TO NUL;           04685500
                 WSA[TOTAL] ~ I ~ 0; GO TO ROUND;                       04686000
           END ELSE GO TO ROUND ELSE GO TO NUL1;                        04686500
       END;                                                             04687500
      IF NOT STRINGF THEN                                               04687510
      IF SLCNT > 0 THEN                                                 04687520
      IF T = "/" THEN BEGIN SLCNT ~ SLCNT+1; GO TO ROUND; END           04687530
      ELSE                                                              04687550
      BEGIN WSA[TOTAL] ~ 0 & SLCNT[TOREPEAT] & SLASH[TOCODE];           04687560
            IF NOT STR THEN                                             04687580
            IF REPEAT < 16 AND WSA[TOTAL-1].[42:6] = 0 THEN             04687590
              WSA[TOTAL~TOTAL-1] ~ WSA[TOTAL] & SLCNT[42:44:4]          04687600
                        & 1[46:47:1];                                   04687620
             COMMAS~DOLLARS~BOOLEAN(SLCNT~0);  NCR~BACKNCR(NCR) ;       04687650
            GO TO NUL1;                                                 04687655
      END;                                                              04687660
       IF NOT QF THEN IF T = """ THEN IF STRINGF ~ NOT STRINGF THEN     04688000
        BEGIN IF CODE > 4 THEN BEGIN STRINGF ~ FALSE;                   04688500
           NCR ~ BACKNCR(NCR); GO TO ENDER END;                         04689000
          SAVTOTAL ~ TOTAL; J~0; I~3; QF ~ TRUE;                        04689500
          WSA[TOTAL] ~ 0 & HPHASE[TOCODE];                              04690000
          GO TO ROUND;                                                  04690500
        END ELSE                                                        04691000
         BEGIN                                                          04691500
           WSA[SAVTOTAL] ~ WSA[SAVTOTAL] & J[TOREPEAT];                 04692000
            IF  I = 0 THEN TOTAL ~ TOTAL - 1;                           04693000
           CODE ~ HPHASE;                                               04693200
           GO TO ENDER;                                                 04693500
         END;                                                           04694000
       IF STRINGF THEN                                                  04694500
        BEGIN                                                           04695000
          STORECHAR(WSA[TOTAL],I,T);                                    04695550
          J ~ J + 1; QF ~ FALSE;                                        04696000
          IF I ~ I+1 = 8 THEN                                           04696500
        BEGIN                                                           04697000
          IF TOTAL ~ TOTAL +1> LSTMAX THEN GO TO NUL;                   04697500
          I ~ WSA[TOTAL] ~ 0;                                           04698000
        END;                                                            04698500
         GO TO ROUND;                                                   04699000
        END;                                                            04699500
CASE T OF                                                               04707000
BEGIN                                                                   04707500
     BEGIN ZF ~ TRUE;                              % 0                  04708000
      NUM: DECIMAL ~ 10 | DECIMAL + T;                                  04708500
           IF ASK THEN                                                  04708510
              BEGIN FLAG(183);                                     %111-04708515
FL:           DO BEGIN NCR~GETCHAR(NCR,T); XTA~T&XTA[12:18:30] END      04708520
              UNTIL T!"*" AND T>9 AND T!" " ;                           04708525
              NCR~BACKNCR(NCR);  XTA~BLANKS&XTA[18:12:30] ;             04708530
              END                                                       04708535
           ELSE                                                         04708540
           IF DECIMAL>4090 THEN BEGIN FLAG(172); DECIMAL~1 END ;        04708550
           IF CODE = 0 THEN REPEAT ~ DECIMAL                            04709500
           ELSE IF PF THEN BEGIN IF DECIMAL>WIDTH AND WIDTH!0 AND CODE! 04710000
                   VPHRASE THEN FLAG(129) END ELSE WIDTH~DECIMAL ;      04710500
           GO TO ROUND;                                                 04712000
     END;                                                               04712500
     GO TO NUM; GO TO NUM; GO TO NUM;               % 1 2 3             04713000
     GO TO NUM; GO TO NUM; GO TO NUM;               % 4 5 6             04713500
     GO TO NUM; GO TO NUM; GO TO NUM;               % 7 8 9             04714000
     ; ; ; ; ; ;                                    % # @ Q : > }       04714500
     BEGIN PLUSP ~ TRUE; GO TO ROUND; END;          % +                 04714600
     BEGIN CODE ~ APHASE; GO TO NOEND END;          % A                 04715000
     ;                                              % B                 04715500
     BEGIN CODE ~ CPHASE; GO TO NOEND END;          % C                 04715600
     BEGIN CODE ~ DPHASE; GO TO NOEND END;          % D                 04716000
     BEGIN CODE ~ EPHASE; GO TO NOEND END;          % E                 04716500
     BEGIN CODE ~ FPHASE; GO TO NOEND END;          % F                 04717000
     BEGIN CODE ~ GPHASE; GO TO NOEND END;          % G                 04717500
     BEGIN IF REPEAT = 0 THEN FLOG(130);            % H                 04718000
           IF ASK THEN BEGIN FLOG(32 ); GO SEMIC END ;                  04718100
           HF ~ TRUE; I ~ 3; CODE ~ HPHASE;                             04719000
           WSA[TOTAL] ~ 0 & HPHASE[TOCODE] & REPEAT[TOREPEAT];          04719500
           GO TO ROUND;                                                 04720000
     END;                                                               04720500
     BEGIN CODE ~ IPHASE; GO TO NOEND END;          % I                 04721000
     BEGIN IF CODE < 11 OR CODE=15 THEN FLOG(134);  % .                 04721500
           IF CODE=0 OR PF THEN FLOG(32) ;                              04722000
           PF~TRUE;  DECIMAL~0;  ASK~ZF~FALSE ;                         04722500
           GO TO ROUND;                                                 04723000
     END;                                                               04723500
     GO TO RP;                                      % [                 04724000
     ;                                              % &                 04724500
     LP:                                                                04725000
     BEGIN IF CODE ! 0 THEN FLOG(32);               % (                 04725500
           IF ASK THEN REPEAT~4095;  IF REPEAT=0 AND ZF THEN FLAG(173) ;04725550
           NAMLIST[SAVLASTLP ~ PARENCT ~ PARENCT+1] ~ 0 & TOTAL[TOWIDTH]04726000
           &(IF REPEAT{0 AND PARENCT>1 THEN 1 ELSE REPEAT)[TOREPEAT] ;  04726500
           IF ASK THEN                                                  04726510
              BEGIN ASK~VRB~FALSE ;                                     04726520
              WSA[TOTAL]~32&LPPHRASE[TOCODE]&4095[TOREPEAT] ;           04726530
              IF (TOTAL~TOTAL+1)>LSTMAX THEN GO NUL ;                   04726540
              END ;                                                     04726550
           ZF~BOOLEAN(REPEAT~DECIMAL~0) ;                               04727500
           STR ~ TRUE;                                                  04727600
           GO TO ROUND1;                                                04728000
     END;                                                               04728500
     ; ; ;                                          % < ~ |             04729000
     BEGIN CODE~JPHASE; WIDTH~-1; GO NOEND END ;    % J                 04729500
     BEGIN                                          % K                 04730000
     IF COMMAS OR CODE!0 THEN BEGIN FLAG(32); COMMAS~TRUE END           04730100
     ELSE BEGIN COMMAS~TRUE ;                                           04730110
KK:       DO BEGIN NCR~GETCHAR(NCR,T); XTA~T&XTA[12:18:30] END          04730120
          UNTIL T!" " ;                                                 04730125
          IF (T<17 OR (T>25 AND T<33) OR (T>42 AND T<50) OR T>57)       04730130
          THEN BEGIN FLAG(32) ;                                         04730135
               IF T="*" OR T<10 THEN BEGIN DECIMAL~1; GO FL END ;       04730137
               END ;                                                    04730139
          NCR~BACKNCR(NCR);  XTA~BLANKS&XTA[18:12:30] ;                 04730140
          END ;                                                         04730145
     GO ROUND ;                                                         04730150
     END OF K ;                                                         04730160
     BEGIN CODE ~ LPHASE; GO TO NOEND; END;         % L                 04730500
     ; ;                                            % M N               04731000
     BEGIN CODE ~ OPHASE; GO TO NOEND; END;         % O                 04731500
     BEGIN WSA[TOTAL] ~ 0 & PPHASE[TOCODE]          % P                 04732000
            & REAL(VRB)[42:47:1]                                        04732100
            & REAL(MINUSP)[TOSIGN] & REPEAT[TOWIDTH]&1[TOREPEAT];       04732500
            MINUSP ~ PLUSP ~ FALSE;                                     04733000
            IF (DECIMAL = 0 AND NOT ZF) THEN FLOG(131);                 04733500
            GO TO NUL1;                                                 04734500
     END;                                                               04735000
     ; ;                                            % Q R               04735500
     BEGIN IF DOLLARS OR CODE!0 THEN FLAG(32)       % $                 04735600
     ELSE BEGIN DOLLARS~TRUE; GO KK END ;                               04735610
     DOLLARS~TRUE;  GO ROUND ;                                          04735620
     END OF DOLLAR SIGN ;                                               04735630
     IF NOT ASK THEN                                % *                 04735700
         BEGIN                                                          04735710
          IF ZF OR DECIMAL NEQ 0 THEN FLAG(183); DECIMAL:=4095;    %111-04735715
         IF CODE=0 THEN REPEAT~DECIMAL                                  04735720
         ELSE IF NOT PF THEN WIDTH~DECIMAL ;                            04735730
         VRB := ASK := LISTEL := TRUE; GO ROUND;                   %101-04735740
          END ELSE BEGIN DECIMAL:=4095; FLAG(183); GO FL END ;     %111-04735750
     BEGIN MINUSP ~ TRUE; GO TO ROUND; END;         % -                 04736000
     RP:                                                                04736500
     BEGIN IF FEELD THEN BEGIN NCR ~ BACKNCR(NCR);  % )                 04737000
              GO TO ENDER; END;                                         04737500
          IF DECIMAL ! 0 THEN FLAG(32);                                 04737600
           I ~ IF PARENCT = 1 THEN IF SAVLASTLP > 1 THEN 2 ELSE 1       04738500
                ELSE PARENCT;                                           04739000
           WSA[TOTAL]~(J~NAMLIST[I])&(TOTAL+1-J~J.[18:12])[TOLINK]      04739500
              & (IF PARENCT ~ PARENCT-1 = 0 THEN 77 ELSE 0)[TODECIMAL]; 04740000
           IF WSA[J].[1:5]=LPPHRASE AND PARENCT!0 THEN                  04740100
              BEGIN WSA[J].[18:12]~TOTAL-J; WSA[TOTAL].[18:12]~TOTAL-J ;04740110
              END ;                                                     04740115
           NAMLIST[I].[6:12] ~ 0;                                       04740500
           CODE ~ HPHASE;                                               04740600
           GO TO NUL1;                                                  04742000
     END;                                                               04742500
     ; ;                                            % ; LEQ             04743000
     GO TO ROUND;                                   % BLANKS            04743500
     BEGIN SLCNT ~ 1;                               % /                 04744000
SL:        IF CODE=0 THEN IF ASK OR ZF OR DECIMAL!0 THEN                04744100
              BEGIN FLAG(32);  ASK~ZF~BOOLEAN(DECIMAL~0) END ;          04744110
           IF CODE<5 THEN IF T="," THEN GO ROUND1 ELSE GO ROUND ELSE GO 04744500
                                                         ENDER ;        04744505
     END;                                                               04745000
     ;                                              % S                 04745500
     BEGIN IF REPEAT ! 0 THEN FLAG(32);             % T                 04746000
           CODE ~ TPHASE;                                               04746050
           GO TO NOEND;                                                 04746100
     END;                                                               04746150
     ;                                              % U                 04746500
     BEGIN VRB~TRUE; CODE~VPHRASE; WIDTH~-1; GO NOEND END ; % V         04746750
     ;                                              % W                 04746800
     BEGIN IF REPEAT = 0 THEN FLOG(130);            % X                 04747000
           IF STR THEN                                                  04747200
    NEWWD:    WSA[TOTAL] ~ 0 & XPHASE[TOCODE] & REPEAT[TOWIDTH]         04747400
                             & 1[TOREPEAT]                              04747600
                              & REAL(VRB)[42:47:1]                      04747700
           ELSE                                                         04747800
              BEGIN                                                     04748000
                   IF (J~WSA[TOTAL-1]).[42:6]>0 OR (I~J.[1:5])=RTPARN   04748800
                      OR (REPEAT}32 AND I!XPHASE) THEN GO NEWWD ;       04749000
                   IF I=XPHASE AND (I~J.[18:12]+REPEAT){4090 THEN       04749200
                         WSA[TOTAL~TOTAL-1] ~ J & I[TOWIDTH]            04749400
                      ELSE IF REPEAT } 32 THEN GO TO NEWWD              04749600
                 ELSE WSA[TOTAL~TOTAL-1] ~ J & REPEAT[TONUM]            04749800
                                             & 1[TOCNTRL];              04750000
           END;                                                         04751000
           GO TO NUL1;                                                  04752000
     END;                                                               04752500
     ; ;                                            % Y Z               04753000
     GO SL ;                                        % ,                 04753500
     GO TO LP;                                      % %                 04754000
     ; ; ;                                          % ! = ] "           04754500
END OF CASE STATEMENT;                                                  04755000
FLOG(132);   %  ILLEGAL CHARACTER;                                      04755500
GO TO FALL;                                                             04756000
ENDER: IF CODE > 4 THEN                                                 04756500
       BEGIN IF WIDTH=0 THEN FLAG(130) ;                                04757000
             IF CODE=VPHRASE THEN                                       04757400
                   BEGIN                                                04757410
                   IF WIDTH=-1 THEN IF PF THEN FLAG(130)ELSE WIDTH~     04757420
                   DECIMAL~4094 ELSE                                    04757425
                   IF NOT PF THEN DECIMAL~4094 ;                        04757430
                   END                                                  04757440
             ELSE                                                       04757450
             IF CODE > 10 AND CODE ! 15 THEN                            04757500
               IF (DECIMAL = 0 AND NOT ZF) OR NOT PF THEN FLAG(133)     04758000
             ELSE ELSE DECIMAL ~ 0;                                     04758100
             IF REPEAT=0 THEN REPEAT~1 ;                                04758400
             IF WIDTH=-1 THEN WIDTH~0 ;                                 04758410
             WSA[TOTAL] ~ 0 & CODE[TOCODE] & WIDTH[TOWIDTH]             04758500
                            & REPEAT[TOREPEAT] & DECIMAL[TODECIMAL]     04759000
                            & REAL(COMMAS) [44:47:1]                    04759100
                            & REAL(VRB)[42:47:1]                        04759150
                            & REAL(DOLLARS)[45:47:1];                   04759200
       END ELSE IF DECIMAL ! 0 THEN FLAG(32);                           04760000
NUL1:  IF PLUSP THEN FLAG(164);                                         04760500
       IF CODE!VPHRASE THEN                                             04760550
       BEGIN                                                            04760560
       IF DOLLARS AND(CODE < 9 OR CODE > 14) THEN FLAG(166);            04760600
       IF COMMAS AND NOT(CODE = 10 OR CODE = 12 OR CODE = 9)            04760700
          THEN FLAG(165);                                               04760800
       END;                                                             04760850
       VRB~                                                             04760890
       ERRORTOG ~ FEELD ~ PF ~ PLUSP ~ DOLLARS ~ COMMAS ~ STR ~ FALSE;  04760900
       IF CODE = HPHASE THEN STR ~ TRUE;                                04760940
       CODE ~ REPEAT ~ WIDTH ~ 0;                                       04760980
       XTA ~ BLANKS;                                                    04761000
       GO TO FALL;                                                      04761500
NOEND: IF FEELD THEN FLAG(32);                                          04762000
       IF CODE ! TPHASE THEN LISTEL ~ TRUE ELSE REPEAT ~ 1;             04762500
       IF REPEAT=0 AND ZF THEN FLAG(173) ;                              04762510
       FEELD ~ TRUE;                                                    04763000
FALL: IF MINUSP THEN BEGIN FLAG(32); MINUSP ~ FALSE END;                04763500
       ASK~ZF~FALSE ;                                                   04764000
NUL:  DECIMAL ~ 0;                                                      04764500
      IF PARENCT = 0 THEN BEGIN SCN ~ 1; GO TO SEMIC END;               04765000
       IF CODE < 5 THEN                                                 04765500
      IF TOTAL ~ TOTAL+1 > LSTMAX THEN                                  04766000
           BEGIN FLOG(78);TOTAL ~ TOTAL-2; GO TO SEMIC; END;            04766500
GO TO ROUND;                                                            04767000
NOPLACE: IF(DCINPUT OR FREEFTOG) AND (STRINGF OR HF) THEN FLOG(150);    04767500
         IF TSSEDITOG THEN IF (STRINGF OR HF) AND NOT DCINPUT           04768000
         THEN TSSED(XTA,1);                                             04769000
         IF CONTINUE THEN IF READACARD THEN                             04769500
            BEGIN IF LISTOG THEN PRINTCARD; GO TO ROUND; END;           04769500
SCN ~ 0; NEXT ~ SEMI;                                                   04770000
SEMIC:                                                                  04770500
IF SCN = 1 THEN SCAN;                                                   04771000
IF STRINGF THEN FLAG(22);                                               04771500
IF NOT LISTEL THEN WSA[0] ~ 0;                                          04772000
IF PARENCT ! 0 THEN FLAG(IF PARENCT < 0 THEN 9 ELSE 8);                 04772500
IF D ! 0 THEN PRTSAVER(D,TOTAL+1,WSA);                                  04772600
IF DEBUGTOG THEN BEGIN                                                  04772605
     WRITE(LINE,FM) ;                                                   04772610
      FOR I~0 STEP 1 UNTIL TOTAL DO BEGIN                               04772615
    WRITE(LINE,[13]//,I,(J~WSA[I]).[1:5],J.[6:12],J.[18:12],J.[30:12],  04772620
                      J.[41:1],J.[42:4],J.[42:5],J.[44:1],J.[45:1],     04772625
                      J.[46:1],J.[46:2],J.[47:1]) ;                     04772630
    IF J.[1:5]=2 THEN I~I+(J.[6:12]+2).[36:9] ;                         04772635
     END ;                                                              04772640
    WRITE(LINE[DBL]) ;                                                  04772645
    END OF DEBUGSTUFF ;                                                 04772650
END FORMATER;                                                           04773000
PROCEDURE EXECUTABLE;                                                   04773010
BEGIN LABEL XIT; REAL T, J, TS, P;                                      04773020
         IF SPLINK < 0 THEN FLAG(12);                                   04773030
         IF LABL =  BLANKS THEN GO TO XIT;                              04773040
         IF T ~ SEARCH(XTA ~ LABL) = 0 THEN                             04773050
         T ~ ENTER(-0 & LABELID[TOCLASS] & (ADR+1)[TOADDR] &            04773060
            NSEG[TOSEGNO], LABL) ELSE                                   04773070
    BEGIN  IF (P ~ GET(T)).CLASS ! LABELID THEN                         04773080
          BEGIN FLAG(144); GO TO XIT END;                               04773090
         IF P < 0 THEN BEGIN FLAG(20); GO TO XIT END;                   04773100
         TS ~ P.ADDR;                                                   04773110
         WHILE TS ! 0 DO                                                04773120
         BEGIN J ~ GIT(TS); FIXB(TS+10000); TS ~ J END;                 04773130
         PUT(T, P~-P & (ADR+1)[TOADDR] & NSEG[TOSEGNO]);                04773140
         IF (T ~ GET(T+2)).BASE ! 0 THEN                                04773150
         T ~ PRGDESCBLDR(2, T.BASE, (ADR+1).[36:10], NSEG);             04773160
    END;                                                                04773170
         IF XREF THEN ENTERX(LABL,1&LABELID[TOCLASS]);                  04773175
    XIT:                                                                04773180
END EXECUTABLE;                                                         04773190
PROCEDURE IOCOMMAND(N);   VALUE N;   REAL N;                            04774000
COMMENT  N    COMMAND                                                   04775000
         0    READ                                                      04776000
         1    WRITE                                                     04777000
         2    PRINT                                                     04778000
         3    PUNCH                                                     04779000
         4    BACKSPACE                                                 04780000
                                                                        04781000
                                                                        04782000
         7    DATA;                                                     04783000
BEGIN LABEL XIT,SUCH,LISTER,NOFORM,FORMER,WRAP,DAAT,NF;                 04784000
LABEL LISTER1;                                                          04784200
    BOOLEAN SUCHTOG, RDTRIN, FREEREAD;                                  04785000
      BOOLEAN FORMARY, NOFORMT;                                         04785020
    BOOLEAN NAMETOG;                                                    04785050
DEFINE DATATOG = DATASTMTFLAG#;                                         04785100
REAL T, ACCIDENT, EDITCODE;                                             04786000
REAL DATAB;                                                             04786100
PROCEDURE ACTIONLABELS(UNSEEN);   VALUE UNSEEN;   BOOLEAN UNSEEN;       04787000
BEGIN LABEL EOF,ERR,RATA,XIT,ACTION,MULTI;                              04788000
      BOOLEAN BACK,GOTERR,GOTEOF;                                       04789000
IF UNSEEN THEN SCAN;                                                    04790000
EOF:  IF GOTEOF THEN GO TO MULTI;                                       04791000
      IF BACK ~ NAME = "END   " THEN GO TO ACTION;                      04792000
ERR:  IF GOTERR THEN GO TO MULTI;                                       04793000
      IF NAME ! "ERR   " THEN IF GOTEOF THEN                            04794000
      BEGIN MULTI: XTA ~ NAME;  FLOG(137);                              04795000
                   GO TO XIT;                                           04796000
      END ELSE GO TO RATA;                                              04797000
ACTION: SCAN;                                                           04798000
      IF NEXT = EQUAL THEN SCAN ELSE GO TO RATA;                        04799000
      IF NEXT ! NUM THEN GO TO RATA;                                    04800000
      IF XREF THEN ENTERX(NAME,0&LABELID[TOCLASS]);                     04800100
      IF BACK THEN NX1 ~ NAME ELSE NX2 ~ NAME;                          04801000
      SCAN; IF NEXT = RPAREN THEN GO TO XIT;                            04802000
            IF NEXT = COMMA THEN SCAN ELSE GO TO RATA;                  04803000
      IF BACK THEN                                                      04804000
      BEGIN BACK ~ NOT ( GOTEOF ~ TRUE);                                04805000
            GO TO ERR;                                                  04806000
      END;                                                              04807000
      GOTERR ~ TRUE;                                                    04808000
      GO TO EOF;                                                        04809000
RATA: XTA ~ NAME;  FLOG(0);                                             04810000
XIT:                                                                    04811000
END ACTIONLABELS;                                                       04812000
IF DEBUGTOG THEN FLAGROUTINE(" IOCOM","MAND  ",TRUE );                  04812010
EODS~N!7 ;                                                              04812020
C2 ~ IF N = 0 OR N = 7 THEN 1 ELSE 0;                                   04812050
SCAN; IF NEXT = SEMI THEN BEGIN FLOG(0); GO TO XIT END;                 04813000
IF N = 7 THEN                                                           04814000
BEGIN DATATOG ~ TRUE;                                                   04815000
      IF LOGIFTOG THEN FLAG(101);                                       04816000
         LABL ~ BLANKS;                                                 04816100
      IF SPLINK } 0 THEN     %NOT BLOCK DATA STMT                       04816110
      BEGIN                                                             04816120
         IF DATAPRT=0 THEN BEGIN                                        04816130
              DATAPRT~PRTS~PRTS+1; ADJUST;                              04816135
              DATASTRT~(ADR+1)&NSEG[TOSEGNO] END                        04816136
         ELSE FIXB(DATALINK);                                           04816137
         EMITOPDCLIT(DATAPRT); EMITO(LNG);                              04816140
         EMITB(-1, TRUE); DATAB ~ LAX;                                  04816150
      END;                                                              04816160
      GO TO DAAT;                                                       04817000
END;                                                                    04818000
         EXECUTABLE;                                                    04819000
EMITO(MKS);                                                             04820000
IF N = 4 THEN                                                           04825100
BEGIN                                                                   04825200
      INLINEFILE;                                                       04826000
      BEGIN EMITL(0);  EMITL(0);  EMITL(0);  EMITL(0);                  04832000
            EMITL(5);  EMITL(0);  EMITL(0);                             04833000
            EMITV(NEED(".FBINB",INTRFUNID));                            04834000
      END;                                                              04835000
      GO TO XIT;                                                        04836000
END;                                                                    04837000
EDITCODE ~ NX1 ~ NX1 ~ 0;                                               04838000
IF RDTRIN ~                                                             04839000
        N = 0 THEN IF NEXT = LPAREN THEN GO TO SUCH                     04840000
   ELSE EMITDESCLIT(FILECHECK(".5    ",2+17|REAL                   %503-04841000
                                                       (REMOTETOG)))    04841100
ELSE IF N = 1 THEN IF NEXT ! LPAREN THEN FLAG(33)                       04842000
                   ELSE GO TO SUCH                                      04843000
     ELSE IF N = 2 THEN                                            %503-04844000
        EMITDESCLIT(FILECHECK(".6    ",2+17|REAL                   %503-04845000
                                                       (REMOTETOG)))    04845100
                                                                        04846000
                   ELSE EMITDESCLIT(FILECHECK(".PUNCH",0));             04847000
IF RDTRIN THEN EMITL(0) ELSE EMITPAIR(1,SSN);                           04848000
GO TO FORMER;                                                           04849000
SUCH:    SCAN;  RANDOMTOG~SUCHTOG~TRUE;  INLINEFILE ;                   04850000
         RANDOMTOG~FREEREAD~FALSE ;                                     04850100
      IF NEXT = EQUAL THEN   %  RANDOM KEY                              04852000
      BEGIN SCAN;                                                       04853000
            IF EXPR(TRUE) > REALTYPE THEN FLAG(102);                    04854000
            IF RDTRIN THEN EMITPAIR(1,ADD);                             04855000
      END ELSE IF RDTRIN THEN EMITL(0) ELSE EMITPAIR(1,SSN);            04856000
      IF NEXT = RPAREN THEN GO TO NF;                                   04857000
      IF NEXT ! COMMA THEN BEGIN FLOG(114); GO TO XIT END;              04858000
      SCAN;                                                             04859000
      IF NEXT = ID THEN                                                 04860000
            IF NAME = "ERR   " OR NAME = "END   " THEN                  04861000
            BEGIN ACTIONLABELS(FALSE);                                  04862000
              NF: IF RDTRIN THEN EMITL(0) ELSE EMITPAIR(1,SSN);         04863000
                  EMITL(0);                                             04863100
                  NOFORMT ~ TRUE;                                       04863500
                  SCAN;  GO TO NOFORM;                                  04864000
            END;                                                        04865000
FORMER: IF ADR } 4085 THEN                                              04866000
    BEGIN ADR ~ ADR+1; SEGOVF END;                                      04866100
    IF NEXT = NUM THEN     % FORMAT NUMBER                              04866200
    BEGIN EDITCODE ~ 1;                                                 04867000
          IF TEST ~ LBLSHFT(NAME) { 0 THEN                              04868000
          BEGIN FLAG(135); GO TO LISTER END;                            04869000
          IF I ~ SEARCH(TEST) = 0 THEN  %  NEVER SEEN                   04870000
          OFLOWHANGERS(I~ENTER(0&FORMATID[TOCLASS], TEST)) ELSE         04871000
          IF GET(I).CLASS ! FORMATID THEN                               04871100
          BEGIN FLAG(143); GO TO LISTER END;                            04871200
          IF XREF THEN ENTERX(TEST,0&FORMATID[TOCLASS]);                04873000
          IF GET(I).ADDR = 0 THEN                                       04874000
          BEGIN EMITLINK((INFC ~ GET(I + 2)).BASE);                     04875000
                PUT(I + 2,INFC&ADR[TOBASE]);                            04876000
                EMITL(0); EMITL(0); EMITO(NOP);                         04877000
          END ELSE                                                      04878000
          BEGIN EMITL(GET(I+ 2).BASE);                                  04879000
                EMITPAIR(GET(I).ADDR,LOD);                              04880000
          END;                                                          04881000
          GO TO LISTER;                                                 04882000
END ELSE IF RDTRIN THEN IF(FREEREAD := NEXT=SLASH) THEN GO TO LISTER    04883000
ELSE BEGIN IF NEXT NEQ ID THEN BEGIN FLOG(116);GO TO XIT; END;END       04883100
 ELSE IF NEXT NEQ ID THEN                                               04883150
  BEGIN IF NEXT = STAR THEN                                             04883200
        BEGIN NAMEDESC := TRUE; GLOBALNAME := TRUE;                     04883300
              TV := ENTER(0&LISTSID[TOCLASS],LISTID:=LISTID+1);         04883350
              SCAN;                                                     04883400
        END;                                                            04883450
        IF NEXT = LPAREN THEN                                           04883500
        BEGIN SCAN; IF EXPR(TRUE) GTR REALTYPE THEN FLAG(120) ;         04883550
              SCAN; END ELSE EMITL(0);                                  04883600
        IF GLOBALNAME AND (FREEREAD := NEXT = SLASH) OR FREEREAD THEN   04883650
             GO TO LISTER ELSE BEGIN FLOG(110); GO TO XIT; END;         04883700
  END;                                                                  04883750
      GETALL(I ~ FNEXT,INFA,INFB,INFC);                                 04884000
      IF T ~ INFA.CLASS = ARRAYID THEN  %  FORMAT ARRAY                 04885000
      BEGIN EDITCODE ~ 1;                                               04886000
         FORMARY ~ TRUE;                                                04886050
         T ~ EXPR(FALSE);                                               04886100
         ADR ~ ADR-1; % ELIMINATE XCH EMITTED BY EXPR                   04887000
         IF EXPRESULT ! ARRAYID THEN FLOG(116);                         04887100
         GO TO LISTER1; % SCAN ALREADY DONE IN EXPR                     04888000
      END ELSE                                                          04889000
      IF T = NAMELIST THEN                                              04890000
       BEGIN NAMETOG := TRUE;                                           04890100
        IF INFA.ADDR = 0 THEN   %  REFERENCED, NOT DEF                  04891000
        BEGIN EMITLINK(INFC.BASE);                                      04892000
              PUT(I+ 2,(INFC ~ INFC&ADR[TOBASE]));                      04893000
              EMITL(0); EMITL(0); EMITO(NOP);                           04894000
        END ELSE                                                        04895000
        BEGIN EMITL(INFC.BASE);                                         04896000
              EMITPAIR(INFA.ADDR,LOD);                                  04897000
        END                                                             04898000
       END                                                              04898100
      ELSE IF T = UNKNOWN THEN   %  ASSUME NAMELIST                     04899000
      BEGIN PUT(I,(INFA ~ INFA&NAMELIST[TOCLASS]));                     04900000
            NAMETOG := TRUE;                                            04900100
            OFLOWHANGERS(I);                                            04901000
            EMITLINK(0);  PUT(I + 2,INFC&ADR[TOBASE]);                  04902000
            EMITL(0); EMITL(0); EMITO(NOP);                             04903000
      END ELSE BEGIN XTA ~ INFB; FLOG(116); GO TO XIT END;              04904000
      SCAN;                                                             04905000
      IF NEXT = COMMA THEN ACTIONLABELS(TRUE);                          04906000
      IF SUCHTOG THEN                                                   04907000
         IF NEXT ! RPAREN THEN FLOG(108) ELSE SCAN;                     04908000
      IF NEXT ! SEMI THEN BEGIN FLOG(118); GO TO XIT END;               04909000
      EMITL(0);   EDITCODE ~ 4;   EMITOPDCLIT(7);   EMITO(FTC);         04910000
      GO TO WRAP;                                                       04911000
LISTER:  SCAN;                                                          04912000
         IF FREEREAD THEN IF NOT RDTRIN THEN                            04912100
         BEGIN IF NEXT ! SLASH THEN EMITO(SSN) ELSE SCAN;               04912200
               IF NEXT = LPAREN THEN                                    04912300
         BEGIN SCAN; IF EXPR(TRUE) > REALTYPE THEN FLAG(120);SCAN       04912400
               END ELSE EMITL(0);                                       04912500
         END;                                                           04912600
LISTER1:                                                                04912700
      IF SUCHTOG THEN                                                   04913000
      BEGIN IF NEXT = COMMA THEN ACTIONLABELS(TRUE);                    04914000
      IF NEXT = RPAREN THEN SCAN ELSE BEGIN FLOG(108); GO TO XIT END;   04915000
      END ELSE IF NEXT=COMMA THEN SCAN ELSE IF RDTRIN THEN              04916000
         IF NEXT!SEMI THEN FLOG(114);                                   04916100
NOFORM: IF NEXT=SEMI THEN                                               04917000
      BEGIN IF FREEREAD THEN FLOG(061) ELSE EMITL(0); GO TO WRAP END;   04917100
      IF (NEXT NEQ LPAREN) AND (NEXT NEQ ID) AND (NEXT NEQ STAR) THEN   04918000
                 GO TO XIT;                                             04918100
      EDITCODE ~ EDITCODE + 2;                                          04919000
DAAT: EMITB(-1,FALSE);  LADR1 ~ LAX;  ADJUST;  DESCREQ ~ TRUE;          04920000
    IF ADR } 4085 THEN                                                  04920100
      BEGIN ADR ~ ADR+1; SEGOVF; ADJUST END;                            04920200
      ACCIDENT ~ PRGDESCBLDR(0,0,ADR.[36:10] + 1,NSEG);                 04921000
      EMITOPDCLIT(19);   EMITO(GFW);                                    04922000
      LISTART ~ ADR&NSEG[TOSEGNO];    ADJUST;                           04923000
      LA ~ 0;   IOLIST(LA);                                             04924000
      EMITL(1);   EMITO(CHS);   EMITL(19);   EMITO(STD);                04925000
      EMITDESCLIT(19);   EMITO(RTS);                                    04926000
      FIXB(LADR1);   DESCREQ ~ FALSE;                                   04927000
      IF DATATOG THEN                                                   04928000
      BEGIN DATASET;                                                    04929000
            IF NEXT = SLASH THEN SCAN ELSE                              04930000
            BEGIN FLOG(110); GO TO XIT END;                             04931000
      IF LSTA = 0 THEN BEGIN BUMPPRT; LSTA~PRTS END;                    04932000
            IF (LSTMAX - LSTI) { LSTS THEN                              04933000
            BEGIN WRITEDATA(LSTI,NXAVIL ~ NXAVIL + 1,LSTP);             04934000
                  LSTA ~ PRGDESCBLDR(1,LSTA,0,NXAVIL);                  04935000
         LSTI ~ 0; BUMPPRT; LSTA~PRTS;                                  04936000
            END;                                                        04937000
            MOVEW(LSTT,LSTP[LSTI],(LSTS ~ LSTS + 1).[36:6],LSTS);       04938000
            EMITO(MKS);   EMITL(LSTI);   EMITPAIR(LSTA,LOD);            04939000
            LSTI ~ LSTI + LSTS;                                         04940000
            EMITPAIR(ACCIDENT,LOD);  EMITOPDCLIT(7);  EMITO(FTF);       04941000
            EMITL(6);  EMITL(0);  EMITL(0);                             04942000
            EMITV(NEED(".FBINB",INTRFUNID));                            04943000
            IF NEXT = COMMA THEN                                        04944000
            BEGIN SCAN; GO TO DAAT END;                                 04945000
            IF SPLINK } 0 THEN BEGIN                                    04946000
            EMITB(-1,FALSE); DATALINK~LAX;                              04946500
                  FIXB(DATAB) END;                                      04946600
            GO TO XIT;                                                  04947000
      END;                                                              04948000
      EMITPAIR(ACCIDENT,LOD);  EMITOPDCLIT(7);  EMITO(FTF);             04949000
WRAP: IF NOT FREEREAD AND NOT NAMETOG THEN EMITL(EDITCODE);             04950000
IF RDTRIN THEN                                                          04951000
BEGIN IF NX1 = 0 THEN EMITL(0) ELSE EMITLABELDESC(NX1);                 04952000
      IF NX2 = 0 THEN EMITL(0) ELSE EMITLABELDESC(NX2);                 04953000
      IF FREEREAD THEN EMITV(NEED(".FREFR", INTRFUNID))                 04954000
        ELSE IF NAMETOG THEN EMITV(NEED(".FINAM",INTRFUNID))            04954050
        ELSE IF FORMARY THEN EMITV(NEED(".FTINT",INTRFUNID))            04954100
        ELSE IF NOFORMT THEN EMITV(NEED(".FBINB",INTRFUNID))            04954150
              ELSE EMITV(NEED(".FTNIN",INTRFUNID));                     04954200
END ELSE                                                                04955000
IF FREEREAD THEN                                                        04956000
    BEGIN                                                               04956005
    IF NAMEDESC THEN                                                    04956010
         BEGIN                                                          04956020
              PRTSAVER(TV,NAMEIND+1,NAMLIST);                           04956040
              EMITL(GET(TV+2).BASE);                                    04956100
              EMITPAIR(GET(TV).ADDR,LOD);                               04956200
              IF NAMLIST[0] = 0 THEN EMITL(0)                           04956500
              ELSE EMITPAIR(GET(GLOBALSEARCH(".SUBAR")).ADDR,LOD);      04956550
              NAMLIST[0] := NAMEIND := 0;                               04956600
         END ELSE BEGIN EMITL(0);EMITL(0);EMITL(0);END;                 04956650
     EMITV(NEED(".FREWR",INTRFUNID))                                    04956700
     END ELSE IF NAMETOG THEN EMITV(NEED(".FONAM",INTRFUNID))           04956750
              ELSE IF FORMARY THEN EMITV(NEED(".FTOUT",INTRFUNID))      04956800
                   ELSE BEGIN                                           04956900
                        IF NX1=0 THEN EMITL(0) ELSE EMITLABELDESC(NX1); 04956910
                        IF NX2=0 THEN EMITL(0) ELSE EMITLABELDESC(NX2); 04956920
                   IF NOFORMT THEN EMITV(NEED(".FBINB",INTRFUNID)) ELSE 04956925
                        EMITV(NEED(".FTNOU",INTRFUNID));                04956930
                        END;                                            04956940
XIT:                                                                    04957000
    IF NAMEDESC THEN IF RDTRIN THEN FLAG(159)                           04957050
                    ELSE IF NOT FREEREAD THEN FLAG(160);                04957055
    DATATOG := FALSE;  NAMEDESC := FALSE; GLOBALNAME := FALSE;          04957100
IF DEBUGTOG THEN FLAGROUTINE(" IOCOM","MAND  ",FALSE);                  04957110
END IOCOMMAND;                                                          04958000
PROCEDURE STMTFUN(LINK); VALUE LINK; REAL LINK;                         04959000
BEGIN                                                                   04960000
         DEFINE PARAM = LSTT#;                                          04961000
         REAL SAVEBRAD, I;                                              04962000
         REAL INFA, INFC, NPARMS, TYPE, PARMLINK, BEGINSUB, RETURN;     04963000
         LABEL XIT,TIX ;                                                04964000
         IF SPLINK < 0 THEN FLAG(12);                                   04964100
         LABL ~ BLANKS;                                                 04964200
         FILETOG ~ TRUE; % PREVENTS SCANNER FROM ENTERING IDS IN INFO   04965000
         IF XREF THEN ENTERX(GET(LINK+1),0&STMTFUNID[TOCLASS]           04965100
              &(GET(LINK))[21:21:3]);                                   04965200
         DO                                                             04966000
    BEGIN                                                               04967000
         SCAN;                                                          04968000
         IF NEXT ! ID THEN BEGIN FLOG(107); GO TO XIT END;              04969000
         PARAM[NPARMS~NPARMS+1] ~ NAME;                                 04970000
         SCAN;                                                          04971000
    END  UNTIL NEXT ! COMMA;                                            04972000
         IF NEXT ! RPAREN THEN FLOG(108) ELSE SCAN;                     04973000
                                                                        04974000
         IF NEXT ! EQUAL THEN BEGIN FLOG(104); GO TO XIT END;           04975000
         EMITB(-1,FALSE); SAVEBRAD ~ LAX; % BRANCH AROUND ST FUN        04976000
         ADJUST;                                                        04977000
         BEGINSUB ~ ADR+1;                                              04978000
         BUMPLOCALS; EMITPAIR(RETURN~LOCALS+1536,STD);                  04979000
         FOR I ~ NPARMS STEP -1 UNTIL 1 DO                              04980000
    BEGIN                                                               04981000
         IF T ~ SEARCH(PARAM[I]) ! 0 THEN                               04982000
              TYPE ~ GET(T).SUBCLASS ELSE                               04983000
              IF T~PARAM[I].[12:6] < "I" OR T > "N" THEN                04984000
              TYPE ~ REALTYPE ELSE TYPE ~ INTYPE;                       04985000
         EMITSTORE(          ENTER(0&VARID[TOCLASS]&1[TOTYPE]           04986000
              &TYPE[TOSUBCL], PARAM[I]), TYPE);                         04987000
         IF XREF THEN ENTERX(NAME,0&VARID[TOCLASS]&TYPE[TOSUBCL]);      04987100
    END;                                                                04988000
         PARMLINK ~ NEXTINFO-3;                                         04989000
         GETALL(LINK, INFA, XTA, INFC);                                 04990000
         FILETOG ~ FALSE;                                               04991000
         SCAN;                                                          04992000
         IF (TYPE~(INFA~GET(LINK)).SUBCLASS)=LOGTYPE OR TYPE=COMPTYPE OR04993000
            (I~EXPR(TRUE))=LOGTYPE OR I=COMPTYPE THEN                   04993500
              BEGIN IF I!TYPE THEN FLAG(139); GO TIX END ;              04993510
         IF TYPE=REALTYPE OR TYPE=INTYPE THEN                           04993530
              BEGIN                                                     04993540
              IF I=DOUBTYPE THEN BEGIN EMITO(XCH); EMITO(DEL) END;      04993550
              IF TYPE=INTYPE THEN IF I!INTYPE THEN EMITPAIR(1,IDV) ;    04993560
              GO TIX ;                                                  04993570
              END ;                                                     04993580
         IF I!DOUBTYPE THEN EMITPAIR(0,XCH) ;                           04993590
TIX:                                                                    04993595
         EMITOPDCLIT(RETURN) ;                                          04994000
         EMITO(GFW);                                                    04995000
         FIXB(SAVEBRAD);                                                04996000
         IF INFA.CLASS ! UNKNOWN THEN FLAG(140);                        04997000
         PUT(LINK, -INFA & 1[TOTYPE] & NSEG[TOSEGNO]                    04998000
         & STMTFUNID[TOCLASS] & BEGINSUB[TOADDR]);                      04999000
         PUT(LINK+2, -(0 & NPARMS[TONEXTRA] & ADR[TOBASE]               05000000
              & PARMLINK[36:36:12]));                                   05001000
         PARMLINK ~ PARMLINK+4;                                         05002000
         FOR I ~ 1 STEP 1 UNTIL NPARMS DO                               05003000
              PUT(PARMLINK ~ PARMLINK-3, "......");                     05004000
    XIT:                                                                05005000
         FILETOG ~ FALSE;                                               05006000
END STMTFUN;                                                            05007000
PROCEDURE ASSIGNMENT;                                                   05008000
BEGIN                                                                   05009000
         LABEL XIT;                                                     05010000
BOOLEAN CHCK;                                                           05010500
BOOLEAN I;                                                              05010600
IF DEBUGTOG THEN FLAGROUTINE(" ASSIG","NMENT ",TRUE ) ;                 05011000
         FX1 ~ FNEXT;                                                   05012000
         SCAN;                                                          05013000
         IF NEXT = LPAREN THEN                                          05014000
    BEGIN                                                               05015000
CHCK~TRUE;                                                              05015500
         IF GET(FX1).CLASS = UNKNOWN THEN                               05016000
         IF EODS THEN                                                   05017000
            BEGIN  XTA ~ GET(FX1+1);  FLOG(035) ;                       05017010
            PUT(FX1,GET(FX1) & ARRAYID[TOCLASS]) ;                      05017020
            PUT(FX1+2,GET(FX1+2) & 1[TONEXTRA]) ;                       05017030
            END                                                         05017040
         ELSE BEGIN STMTFUN(FX1);  GO TO XIT END ;                      05017050
         IF XREF THEN ENTERX(GET(FX1+1),1&GET(FX1) [15:15:9]);          05017055
         EODS ~ TRUE ;                                                  05017060
         EXECUTABLE;                                                    05017100
         SCAN;                                                          05018000
         I ~ SUBSCRIPTS(FX1,2);                                         05019000
         SCAN;                                                          05020000
    END ELSE                                                            05021000
    BEGIN                                                               05022000
         EODS~TRUE ;                                                    05022010
         EXECUTABLE;                                                    05022100
         IF T ~ GET(FX1).CLASS = ARRAYID THEN                           05023000
         BEGIN XTA ~ GET(FX1+1); FLAG(74) END;                          05024000
         MOVEW(ACCUM[1],HOLDID[0],0,3);                                 05025000
         IF XREF THEN IF HOLDID[0].[12:12] ! "DO" THEN                  05025100
           ENTERX(GET(FX1+1),1&GET(FX1)[21:21:3]&VARID[TOCLASS]);       05025200
    END;                                                                05026000
         IF NEXT ! EQUAL THEN BEGIN FLAG(104); GO TO XIT END;           05027000
         SCAN;                                                          05028000
         IF NEXT=SEMI OR NEXT=COMMA THEN BEGIN FLOG(0); GO TO XIT; END; 05028010
         FX2 ~ EXPR(TRUE);                                              05029000
         IF NEXT NEQ COMMA THEN IF HOLDID[0] = "DO" THEN IF XREF THEN   05029200
           ENTERX(HOLDID[0] ,1&GET(FX1)[21:21:3]&VARID[TOCLASS]);       05029400
         IF NEXT = COMMA THEN IF CHCK THEN FLOG(56) ELSE                05030000
         IF HOLDID[0].[12:12] ! "DO" THEN FLOG(56) ELSE                 05030100
    BEGIN                                                               05031000
         IF LOGIFTOG THEN FLAG(101);                                    05032000
         IF FX2 > REALTYPE THEN FLAG(102);                              05033000
         IF DT ~ DT+1 > MAXDOS THEN BEGIN DT ~ 1; FLAG(138) END;        05034000
         EMITN(FX1~ CHECKDO);                                           05035000
         EMITO(STD);                                                    05036000
          SCAN;                                                         05037000
          IF NEXT=SEMI THEN BEGIN FLAG(36); GO TO XIT END;              05038000
          IF (ACCUM[0] = ",     " OR ACCUM[0] = ";     ") AND           05038900
          GLOBALNEXT=NUM AND ABS(FNEXT) > 1023 THEN                     05039000
              BEGIN                                                     05040000
              IF EXPR(TRUE) > REALTYPE THEN FLAG(102);                  05041000
              IDINFO:=REALID;FNEXT:=ENTER(IDINFO,"2FNV00"&DT[36:36:12]);05041100
              EMITN(FNEXT:=GETSPACE(FNEXT)); EMITO(STD);                05041200
              EMITB(-1,FALSE); LADR1:=LAX; ADJUST;                      05041300
              LADR2 ~ (ADR+1) & NSEG[TOSEGNO]; EMITV(FNEXT);            05041400
              END                                                       05041450
         ELSE BEGIN                                                     05041500
              EMITB(-1,FALSE); LADR1:=LAX; ADJUST;                      05041600
              LADR2:=(ADR+1)&NSEG[TOSEGNO];                             05041700
              IF EXPR(TRUE) > REALTYPE THEN FLAG(102) ;                 05041800
              END ;                                                     05042000
         EMITO(GRTR);                                                   05043000
         EMITB(-1, TRUE);                                               05044000
         LADR3 ~ LAX;                                                   05045000
         EMITB(-1, FALSE);                                              05046000
         ADJUST;                                                        05047000
         DOTEST[DT] ~ (ADR+1) & LAX[TOADDR] & NSEG[TOSEGNO];            05048000
         IF NEXT ! COMMA THEN EMITL(1) ELSE                             05049000
    BEGIN                                                               05050000
         SCAN;                                                          05051000
         IF NEXT=SEMI THEN BEGIN FLAG(36);  GO TO XIT END ;             05051100
         IF EXPR(TRUE) > REALTYPE THEN FLAG(102);                       05052000
    END;                                                                05053000
         EMITV(FX1);                                                    05054000
         EMITO(ADD);                                                    05055000
         EMITN(FX1);                                                    05056000
         EMITO(STN);                                                    05057000
         EMITB(LADR2, FALSE);                                           05058000
         FIXB(LADR1);                                                   05059000
         FIXB(LADR3);                                                   05060000
    END ELSE EMITSTORE(FX1, FX2);                                       05061000
    XIT:                                                                05062000
IF DEBUGTOG THEN FLAGROUTINE(" ASSIG","NMENT ",FALSE ) ;                05062010
END ASSIGNMENT;                                                         05063000
BOOLEAN PROCEDURE RINGCHECK;                                            05063100
COMMENT  THIS PROCEDURE PREVENTS THE POSSIBILITY OF DELINKING A         05063110
           HEADER FROM THE HEADER RING;                                 05063120
    BEGIN                                                               05063200
         INTEGER I;                                                     05063250
         I~A;                                                           05063300
         DO                                                             05063350
         IF I ~ GETC(I).ADDR = ROOT THEN RINGCHECK ~ TRUE               05063400
         UNTIL I = A;                                                   05063450
    END RINGCHECK;                                                      05063500
PROCEDURE SETLINK(INFADDR); VALUE INFADDR; INTEGER INFADDR;             05063600
COMMENT  THIS PROCEDURE LINKS AN ELEMENT TO ITS PREVIOUS HEADER;        05063601
BEGIN                                                                   05063610
    INTEGER LAST,I; REAL COML; LABEL XIT;                               05063620
XIT:                                                                    05063625
    LAST ~(GETC(INFADDR).LASTC)-1;                                      05063630
    FOR I ~ INFADDR+2 STEP 1 UNTIL LAST                                 05063640
    DO BEGIN IF GETC(I).CLASS = ENDCOM THEN I~GETC(I).LINK;             05063650
             IF FX1 = (COML~GETC(I)).LINK THEN                          05063660
                   IF INFADDR~COML.LASTC=A THEN COM[PWI].LASTC~ROOT     05063670
                   ELSE GO XIT ;                                        05063680
       END;                                                             05063710
END SETLINK;                                                            05063730
PROCEDURE DIMENSION;                                                    05064000
BEGIN                                                                   05065000
    LABEL L, LOOP, ERROR ;                                              05066000
    BOOLEAN DOUBLED, SINGLETOG;                                    %109-05066005
IF DEBUGTOG THEN FLAGROUTINE(" DIMEN","SION  ",TRUE ) ;                 05066010
         IF LOGIFTOG THEN FLAG(101);                                    05067000
         LABL ~ BLANKS;                                                 05067100
         IF NEXT=STAR THEN IF TYPE!DOUBTYPE THEN                        05067210
              BEGIN                                                     05067220
              SCAN ;                                                    05067230
              IF NEXT=NUM AND NUMTYPE=INTYPE THEN                       05067240
                   BEGIN                                                05067250
                   IF FNEXT=4 THEN                                      05067260
                        BEGIN                                           05067270
                        SINGLETOG ~ TRUE;                          %109-05067275
                        IF TYPE=COMPTYPE THEN FLAG(176);  GO L ;        05067280
                        END ;                                           05067290
                   IF FNEXT=8 THEN                                      05067300
                        BEGIN                                           05067310
                        IF TYPE=REALTYPE THEN TYPE~DOUBTYPE             05067320
                        ELSE IF TYPE!COMPTYPE THEN FLAG(177) ;          05067330
                        GO L ;                                          05067340
                        END ;                                           05067350
                   END ;                                                05067360
              FLAG(IF TYPE=REALTYPE THEN 178                            05067370
                   ELSE 177-REAL(TYPE=COMPTYPE)) ;                      05067380
L:            NCR~REAL(NCR.[30:3]!0)+3"677777"+NCR;  SCN~1;  SCAN ;     05067390
              END ;                                                     05067420
     LOOP:     DOUBLED~FALSE;                                           05068000
         IF NEXT ! ID THEN  BEGIN FLOG(105); GO TO ERROR END;           05068100
         FX1 ~ IF SINGLETOG THEN -FNEXT ELSE FNEXT;                %109-05069000
         IF TYPE } DOUBTYPE THEN   %  FIX ARRAY TYPE OFR                05069100
          PUT(FX1,GET(FX1)&TYPE[TOSUBCL]); % BOUNDS ROUTINE             05069200
         IF XREF THEN BEGIN INFA ~ 0&GET(FX1)[15:15:9];                 05069300
                            IF TYPE>0 THEN INFA.SUBCLASS~TYPE;          05069400
                      END;                                              05069500
         XTA ~ INFB ~ NAME;                                             05070000
         SCAN;                                                          05071000
         IF  XREF THEN                                                  05071100
         BEGIN IF INFA.CLASS = UNKNOWN THEN                             05071200
                  INFA.CLASS~IF NEXT=LPAREN THEN ARRAYID ELSE VARID;    05071300
               ENTERX(INFB,INFA);                                       05071400
         END;                                                           05071500
         IF NEXT=LPAREN THEN BEGIN SCAN; DOUBLED~BOUNDS(FX1) END ELSE   05072000
         IF TYPE = -1 THEN FLOG(103);                                   05073000
         GETALL(FX1, INFA, XTA, INFC);                                  05074000
         IF TYPE > 0 THEN                                               05075000
         IF BOOLEAN(INFA.TYPEFIXED) THEN FLAG(31) ELSE                  05076000
    BEGIN                                                               05077000
         IF TYPE > LOGTYPE THEN                                         05078000
         IF GET(FX1+2) <0 THEN                                          05078200
         BEGIN                                                          05078400
         IF NOT DOUBLED AND INFA.CLASS=1 THEN                           05078500
              BEGIN                                                     05078800
              BUMPLOCALS;                                               05079000
              LENGTH~LOCALS + 1536;                                     05079200
              PUT(FX1+2,INFC & LENGTH[TOSIZE]);                         05079400
              END                                                       05079600
         END ELSE IF NOT DOUBLED THEN                                   05079800
              BEGIN IF INFC.SIZE > 16383 THEN FLAG(99);                 05079900
              PUT(FX1+2,INFC & (2 | INFC.SIZE)[TOSIZE]);                05080000
              END;                                                      05080100
         PUT (FX1,INFA & 1[TOTYPE] & TYPE[TOSUBCL]);                    05080500
    END;                                                                05081000
         IF INFA < 0 THEN FLAG(39) ELSE                                 05082000
         IF TYPE = -2 THEN                                              05083000
    BEGIN                                                               05084000
         BAPC(INFA&FX1[TOLINK]&1[TOCE]&ROOT[TOLASTC]);                  05085000
         IF BOOLEAN(INFA.CE) THEN FLAG(2);                              05086000
         IF BOOLEAN(INFA.EQ) THEN                                       05086100
    BEGIN                                                               05087000
         COM[NEXTCOM.IR,NEXTCOM.IC].LASTC ~ A ~ INFA.ADDR;              05088000
         B~GETC(ROOT).ADDR ;                                            05089000
         SETLINK(A);                                                    05089050
         IF NOT RINGCHECK THEN                                          05089100
    BEGIN                                                               05089200
         COM[PWROOT].ADDR~GETC(A).ADDR ;                                05090000
         PUTC(A,GETC(A)&B[TOADDR]&7[TOSUBCL]) ;                         05091000
    END                                                                 05091100
    END  ELSE                                                           05092000
         PUT(FX1, INFA & 1[TOCE] & ROOT[TOADDR]);                       05093000
         IF BOOLEAN(INFA.FORMAL) THEN FLAG(10);                         05094000
    END;                                                                05095000
         IF ERRORTOG THEN                                               05096000
    ERROR:                                                              05096100
         WHILE NEXT ! COMMA AND NEXT ! SEMI AND NEXT ! SLASH DO SCAN;   05097000
         IF NEXT = COMMA THEN BEGIN SCAN; GO TO LOOP END;               05098000
IF DEBUGTOG THEN FLAGROUTINE(" DIMEN","SION  ",FALSE );                 05098010
END DIMENSION;                                                          05099000
PROCEDURE FORMALPP(PARMSREQ, CLASS); VALUE PARMSREQ, CLASS;             05100000
         BOOLEAN PARMSREQ; REAL CLASS;                                  05101000
BEGIN                                                                   05102000
    LABEL LOOP, XIT;                                                    05103000
IF DEBUGTOG THEN FLAGROUTINE("  FORM","ALPP  ",TRUE ) ;                 05103010
         PARMS ~ 0;                                                     05104000
         SCAN;                                                          05105000
         IF NEXT ! ID THEN BEGIN FLOG(105); GO TO XIT END;              05106000
         IF CLASS = FUNID THEN                                          05106100
         IF FUNVAR = 0 THEN                                             05107000
         BEGIN                                                          05107020
         IF TYPE > 0 THEN                                               05107030
         IF FUNVAR ~ GLOBALSEARCH(NAME) ! 0 THEN                        05107040
         IF BOOLEAN((T ~ GET(FUNVAR)).TYPEFIXED) AND TYPE ! T.SUBCLASS  05107050
              THEN FLAG(31);                                            05107060
         PUT(FUNVAR ~ FNEXT,GET(FNEXT) & VARID[TOCLASS]);               05107100
         END;                                                           05107160
         FNEW ~ NEED(NNEW ~ NAME, CLASS);                               05108000
         ENTERX(NAME,IF CLASS = FUNID THEN                              05108100
              1&GET(FNEW)[15:15:9] ELSE 1&GET(FNEW)[15:15:5]);          05108200
         SCAN;                                                          05109000
         IF NEXT ! LPAREN THEN                                          05110000
              IF PARMSREQ THEN FLOG(106) ELSE ELSE                      05111000
    BEGIN                                                               05112000
    LOOP:                                                               05113000
         SCAN;                                                          05114000
         IF NEXT = ID THEN PARMLINK[PARMS ~ PARMS+1] ~ FNEXT ELSE       05115000
         IF NEXT=STAR AND CLASS!FUNID THEN PARMLINK[PARMS~PARMS+1]~0ELSE05116000
             FLOG(107);                                                 05117000
         IF XREF THEN ENTERX(NAME,IF NEXT = STAR THEN 0 ELSE            05117100
                 0&GET(FNEXT)[15:15:9]);                                05117150
         SCAN;                                                          05118000
         IF NEXT = COMMA THEN GO TO LOOP;                               05119000
         IF NEXT ! RPAREN THEN FLOG(108);                               05120000
         SCAN;                                                          05121000
    END;                                                                05122000
         IF NOT ERRORTOG THEN DECLAREPARMS(FNEW);                       05123000
    XIT:                                                                05124000
IF DEBUGTOG THEN FLAGROUTINE("  FORM","ALPP  ",FALSE) ;                 05124010
END FORMALPP;                                                           05125000
PROCEDURE ENDS; FORWARD;                                                05125100
PROCEDURE FUNCTION ;                                                    05126000
BEGIN                                                                   05127000
         REAL A,B,C,I;  LABEL FOUND ;                                   05127100
         IF SPLINK NEQ 0 THEN BEGIN FLAG(5); ENDS; SEGMENTSTART; END;   05128000
         LABL ~ BLANKS;                                                 05128100
         FORMALPP(TRUE, FUNID);                                         05129000
         GETALL(FNEW, INFA, INFB, INFC);                                05130000
         B~NUMINTM1 ;                                                   05130100
         WHILE A+1<B DO                                                 05130110
              BEGIN                                                     05130115
              IF C~INT[I~REAL(BOOLEAN(A+B) AND BOOLEAN(1022))]=INFB     05130120
              THEN GO FOUND ;                                           05130125
              IF INFB<C THEN B~I.[36:11] ELSE A~I.[36:11] ;             05130130
              END ;                                                     05130135
         IF INFB=INT[I~(A+B)|2-I] THEN GO FOUND ;                       05130140
         IF FALSE THEN                                                  05130145
FOUND:   IF BOOLEAN(INT[I+1].INTSEEN) THEN BEGIN XTA~INFB; FLAG(167)END;05130150
         IF TYPE<0 THEN TYPE~INFA.SUBCLASS&1[2:47:1] ;                  05131000
         PUT(SPLINK ~ FNEW, INFA & 1[TOTYPE] & TYPE[TOSUBCL]);          05132000
         PUT(FUNVAR, GET(FUNVAR) & VARID[TOCLASS] & 1[TOTYPE] &         05133000
              TYPE[TOSUBCL]);                                           05134000
END FUNCTION;                                                           05135000
PROCEDURE STATEMENT; FORWARD;                                           05136000
PROCEDURE ASSIGN;                                                       05137000
BEGIN                                                                   05138000
         LABEL XIT;                                                     05138100
         EODS~TRUE ;                                                    05138110
         EXECUTABLE;                                                    05139000
         SCAN;                                                          05140000
         IF NEXT ! NUM THEN BEGIN FLOG(109); GO TO XIT END;             05141000
         IF XREF THEN ENTERX(FNEXT,0&LABELID[TOCLASS]);                 05141500
         EMITNUM(FNEXT);                                                05142000
         SCAN;                                                          05143000
         IF NEXT ! ID THEN BEGIN FLOG(105); GO TO XIT END;              05144000
         IF XREF THEN ENTERX(XTA,1&GET(FNEXT)[15:15:9]);                05144100
         EMITN(FNEXT);                                                  05145000
         EMITO(STD);                                                    05146000
         SCAN;                                                          05147000
    XIT:                                                                05147100
END ASSIGN;                                                             05148000
PROCEDURE BLOCKDATA;                                                    05149000
BEGIN                                                                   05150000
         IF SPLINK NEQ 0 THEN BEGIN FLAG(5); ENDS; SEGMENTSTART; END;   05151000
         LABL ~ BLANKS;                                                 05151100
         SCAN;                                                          05152000
         SPLINK ~ -1;                                                   05153000
END BLOCKDATA;                                                          05154000
PROCEDURE CALL;                                                         05155000
BEGIN                                                                   05156000
         EODS~TRUE ;                                                    05156010
         EXECUTABLE;                                                    05157000
         SCAN;                                                          05158000
         SUBREF;                                                        05159000
END CALL;                                                               05160000
PROCEDURE COMMON;                                                       05161000
COMMENT  THIS PROCEDURE MAKES THE COM ENTRY FOR COMMON ITEMS AND SETS   05161100
           THE CE BIT IN BOTH THE COM AND INFO TABLES AND LINKS         05161110
           THE HEADS OF CHAINS;                                         05161120
BEGIN                                                                   05162000
         LABEL LOOP, BLOCK;                                             05163000
         TYPE ~ -2;                                                     05164000
         SCAN;                                                          05165000
         IF NEXT = ID THEN                                              05166000
    BEGIN                                                               05167000
         Z ~ NEED(".BLNK.", BLOCKID);                                   05168000
         IF XREF THEN ENTERX("BLANK.",0&BLOCKID[TOCLASS]);              05168100
         GO TO BLOCK;                                                   05169000
    END;                                                                05170000
    LOOP:                                                               05171000
         IF NEXT ! SLASH THEN FLOG(110);                                05172000
         SCAN;                                                          05173000
         IF NEXT = SLASH THEN Z ~ NEED(".BLNK.", BLOCKID) ELSE          05174000
    BEGIN                                                               05175000
         IF NEXT ! ID THEN FLOG(105) ELSE                               05176000
%  FORCE UNIQUE NAME BY APPENDING 1 TO NAME (2ND CHAR OF WORD)          05176500
         BEGIN Z ~ NEED(NAME&"1"[6:42:6],BLOCKID);                      05177000
               IF XREF THEN ENTERX(NAME,0&BLOCKID[TOCLASS]);            05177100
               SCAN;                                                    05177200
         END;                                                           05178000
         IF NEXT ! SLASH THEN FLOG(110);                                05179000
    END;                                                                05180000
         SCAN;                                                          05181000
    BLOCK:                                                              05182000
         IF (T~GET(Z+2)).ADINFO = 0 THEN                                05183000
    BEGIN                                                               05184000
         IF NEXTCOM~NEXTCOM+1>SUPERMAXCOM THEN                          05185000
            BEGIN ROOT~0;  FATAL(124) END                               05186000
         ELSE ROOT~NEXTCOM ;                                            05186100
         PUTC(ROOT,0&HEADER[TOCLASS]&1[TOCE]&ROOT[TOADDR]) ;            05186200
         BAPC(Z);                                                       05187000
    END ELSE                                                            05188000
    BEGIN                                                               05189000
         ROOT ~ T.ADINFO;                                               05190000
         COM[(T~GETC(ROOT).LASTC).IR,T.IC].LINK~NEXTCOM+1 ;             05191000
         IF COM[PWROOT]<0 THEN FLAG(2) ;                                05191100
    END;                                                                05192000
         DIMENSION;                                                     05193000
         BAPC(0&ENDCOM[TOCLASS]) ;                                      05194000
         COM[PWROOT].LASTC~NEXTCOM ;                                    05195000
         PUT(T~GETC(ROOT+1)+2,GET(T)&ROOT[TOADINFO]) ;                  05196000
         IF NEXT ! SEMI THEN GO TO LOOP;                                05197000
END COMMON;                                                             05198000
PROCEDURE ENDS;                                                         05211000
BEGIN                                                                   05212000
       IF SPLINK=0 THEN FLAG(184) ELSE                             %112-05212005
       BEGIN                                                       %112-05212007
         EODS~FALSE ;                                                   05212010
         IF LOGIFTOG THEN FLAG(101);                                    05213000
         LABL ~ BLANKS;                                                 05213100
         IF SPLINK < 0 THEN EMITO(XIT) ELSE EMITPAIR(0, KOM);           05214000
         SEGMENT((ADR+4) DIV 4, NSEG, TRUE, EDOC);                      05215000
       END;                                                        %112-05216000
END ENDS;                                                               05217000
PROCEDURE ENTRY;                                                        05218000
BEGIN                                                                   05219000
         REAL SP;                                                       05220000
         IF SPLINK = 0 THEN FLAG(111) ELSE                              05221000
         IF SPLINK = 1 THEN BEGIN ELX ~ 0; FLAG(4) END;                 05222000
         LABL ~ BLANKS;                                                 05222100
         ADJUST ;                                                       05222500
         SP ~ GET(SPLINK);                                              05223000
         FORMALPP( (T~SP.CLASS) = FUNID, T);                            05224000
         GETALL(FNEW, INFA, INFB, INFC);                                05225000
         IF INFA.CLASS = FUNID THEN                                     05226000
              PUT(FNEW, INFA & 1[TOTYPE] & (SP.SUBCLASS)[TOSUBCL]);     05227000
         PUT(FNEW+2, INFC & (ADR+1)[TOBASE]);                           05228000
END ENTRY;                                                              05229000
PROCEDURE EQUIVALENCE;                                                  05230000
COMMENT  THIS PROCEDURE MAKES THE COM ENTRY FOR EQUIV ITEMS AND SETS    05230100
           THE EQ BIT IN BOTH THE COM AND INFO TABLES AND LINKS         05230110
           THE HEADS OF CHAINS;                                         05230120
BEGIN                                                                   05231000
         REAL P, Q, R, S;                                               05232000
         BOOLEAN FIRST,PCOMM;                                           05232050
         LABEL XIT;                                                     05232100
         IF LOGIFTOG THEN FLAG(101);                                    05233000
         LABL ~ BLANKS;                                                 05233100
         DO                                                             05234000
    BEGIN                                                               05235000
         FIRST ~ FALSE;                                                 05235500
         SCAN;                                                          05236000
         IF NEXT ! LPAREN THEN BEGIN FLOG(106); GO TO XIT END;          05237000
         IF NEXTCOM~NEXTCOM+1>SUPERMAXCOM THEN                          05238000
            BEGIN ROOT~0;  FATAL(124) END                               05238100
         ELSE ROOT~NEXTCOM ;                                            05238200
         PUTC(ROOT,0&HEADER[TOCLASS]&ROOT[TOADDR]) ;                    05238300
         BAPC(0); Q~0 ;                                                 05239000
         DO                                                             05240000
    BEGIN                                                               05241000
         SCAN;                                                          05242000
         IF NEXT ! ID THEN BEGIN FLOG(105); GO TO XIT END;              05243000
         IF XREF THEN ENTERX(NAME,0&GET(FNEXT)[15:15:9]);               05243200
         FX1 ~ FNEXT;                                                   05244000
         LENGTH ~ 0;                                                    05245000
         SCAN;                                                          05246000
         IF NEXT = LPAREN THEN                                          05247000
    BEGIN                                                               05248000
         IF GET(FX1).CLASS ! ARRAYID THEN                               05249000
         BEGIN XTA ~ GET(FX1+1); FLOG(112) END;                         05250000
         R ~ 0; P ~ 1;                                                  05251000
         S ~ GET(FX1+2).ADINFO;                                         05252000
         DO                                                             05253000
    BEGIN                                                               05254000
         SCAN;                                                          05255000
         IF NEXT ! NUM OR NUMTYPE ! INTYPE THEN FLAG(113);              05256000
         LENGTH ~ LENGTH + P|(FNEXT-1);                                 05257000
         P ~ P|EXTRAINFO[(S+R).IR,(S+R).IC] ;                           05258000
         R ~ R-1;                                                       05259000
         SCAN;                                                          05260000
    END  UNTIL NEXT ! COMMA;                                            05261000
         IF NEXT ! RPAREN THEN BEGIN FLOG(108); GO TO XIT END;          05262000
         IF R!-1 THEN IF R~R+GET(FX1+2).NEXTRA!0 THEN                   05262200
            BEGIN  XTA~GET(FX1+1);  FLAG(IF R>0 THEN 23 ELSE 24) END ;  05262300
         SCAN;                                                          05263000
    END;                                                                05264000
         IF (INFA~GET(FX1)) < 0 THEN                                    05265000
         BEGIN XTA ~ GET(FX1+1); FLAG(39) END ELSE                      05266000
    BEGIN                                                               05267000
         IF INFA.SUBCLASS > LOGTYPE THEN LENGTH ~ 2|LENGTH ;            05267100
         BAPC(INFA&FX1[TOLINK]&LENGTH[TORELADD]&1[TOEQ]&ROOT[TOLASTC]); 05268000
         IF(PCOMM~BOOLEAN(INFA.CE)) OR BOOLEAN(INFA.EQ) THEN            05269000
    BEGIN                                                               05270000
         IF FIRST AND PCOMM THEN BEGIN XTA~GET(FX1+1); FLAG(2) END      05270100
         ELSE IF NOT FIRST THEN FIRST ~ PCOMM;                          05270200
         PUT(FX1,INFA & 1[TOEQ]);                                       05270500
         COM[NEXTCOM.IR,NEXTCOM.IC].LASTC ~ A ~ INFA.ADDR;              05271000
         B~GETC(ROOT).ADDR ;                                            05272000
         SETLINK(A);                                                    05272050
         IF NOT RINGCHECK THEN                                          05272100
    BEGIN                                                               05272200
         COM[PWROOT].ADDR~GETC(A).ADDR ;                                05273000
         PUTC(A,GETC(A)&B[TOADDR]&7[TOSUBCL]) ;                         05274000
    END                                                                 05274200
    END  ELSE                                                           05275000
         PUT(FX1,INFA & 1[TOEQ] & ROOT[TOADDR]);                        05276000
         IF LENGTH > Q THEN Q ~ LENGTH;                                 05277000
         IF BOOLEAN(INFA.FORMAL) THEN                                   05278000
         BEGIN XTA ~ GET(FX1+1); FLAG(11) END;                          05279000
    END;                                                                05280000
    END  UNTIL NEXT ! COMMA;                                            05281000
         IF NEXT ! RPAREN THEN BEGIN FLOG(108); GO TO XIT END;          05282000
         SCAN;                                                          05283000
         PUTC(ROOT+1,Q);                                                05284000
         BAPC(0&ENDCOM[TOCLASS]) ;                                      05285000
         COM[PWROOT].LASTC~NEXTCOM ;                                    05286000
    END  UNTIL NEXT ! COMMA;                                            05287000
    XIT:                                                                05287100
END EQUIVALENCE;                                                        05288000
PROCEDURE EXTERNAL;                                                     05289000
BEGIN                                                                   05290000
         IF SPLINK < 0 THEN FLAG( 12);                                  05291000
         IF LOGIFTOG THEN FLAG(101);                                    05292000
         LABL ~ BLANKS;                                                 05292100
         DO                                                             05293000
    BEGIN                                                               05294000
         SCAN;                                                          05295000
         IF NEXT ! ID THEN FLOG(105) ELSE                               05296000
         BEGIN T ~ NEED(NAME,EXTID);                                    05297000
               IF XREF THEN ENTERX(NAME,0&GET(T)[15:15:9]);             05297300
               SCAN;                                                    05297500
         END;                                                           05297800
                                                                        05298000
    END  UNTIL NEXT ! COMMA;                                            05299000
END EXTERNAL;                                                           05300000
PROCEDURE CHAIN;                                                        05300100
BEGIN                                                                   05300150
    LABEL  AGN, XIT;                                                    05300160
    REAL  T1;                                                           05300170
    DEFINE FLG(FLG1) = BEGIN FLOG(FLG1); GO TO XIT END#;                05300180
    EXECUTABLE;                                                         05300182
    SCAN;                                                               05300184
    T1 ~ 2;                                                             05300190
    IF FALSE THEN                                                       05300210
 AGN: IF GLOBALNEXT ! COMMA THEN FLG(28);                               05300220
    SCAN;                                                               05300230
    IF EXPR(TRUE)  >  REALTYPE THEN FLG(102);                           05300240
    IF (T1 ~ T1 - 1) ! 0 THEN GO TO AGN;                                05300250
    IF GLOBALNEXT ! RPAREN THEN FLG(3);                                 05300260
    EMITPAIR(37,KOM);                                                   05300270
    SCAN;                                                               05300280
    IF GLOBALNEXT ! SEMI THEN FLOG(117);                                05300290
 XIT: WHILE GLOBALNEXT ! SEMI DO SCAN;                                  05300300
END CHAIN;                                                              05300310
PROCEDURE GOTOS;                                                        05301000
BEGIN    LABEL XIT;                                                     05302000
         REAL ASSIGNEDID;                                               05302100
         EODS~TRUE ;                                                    05302110
         EXECUTABLE;                                                    05303000
         SCAN;                                                          05304000
         IF NEXT = NUM THEN                                             05305000
    BEGIN                                                               05306000
         LABELBRANCH(NAME, FALSE);                                      05307000
         SCAN;                                                          05308000
         GO TO XIT;                                                     05309000
    END;                                                                05310000
         IF NEXT = ID THEN                                              05311000
    BEGIN                                                               05312000
         ASSIGNEDID ~ FNEXT;                                            05313000
         IF XREF THEN ENTERX(XTA,0&GET(FNEXT)[15:15:9]);                05313200
         SCAN;                                                          05313300
         IF NEXT ! COMMA THEN FLOG(114);                                05313600
         SCAN;                                                          05314000
         IF NEXT ! LPAREN THEN FLOG(106);                               05314300
         DO                                                             05314600
    BEGIN                                                               05315000
         SCAN;                                                          05315300
         IF NEXT ! NUM THEN FLOG(109);                                  05315600
         EMITV(ASSIGNEDID);                                             05316000
         EMITNUM(FNEXT);                                                05316300
         EMITO(NEQL);                                                   05316600
         LABELBRANCH(NAME, TRUE);                                       05317000
         SCAN;                                                          05317300
    END  UNTIL NEXT ! COMMA;                                            05317600
         IF NEXT ! RPAREN THEN FLOG(108);                               05318000
         SCAN;                                                          05318200
         EMITPAIR(1, SSN);   % CAUSE INVALID INDEX TERMINATION          05318400
         EMITDESCLIT(10);                                               05318600
         GO TO XIT;                                                     05319000
    END;                                                                05320000
         IF NEXT ! LPAREN THEN FLOG(106);                               05321000
         P ~ 0;                                                         05322000
         DO                                                             05323000
    BEGIN                                                               05324000
         SCAN;                                                          05325000
         IF NEXT ! NUM THEN BEGIN FLOG(109); GO TO XIT END;             05326000
         LSTT[P~P+1] ~ NAME;                                            05327000
         SCAN;                                                          05328000
    END  UNTIL NEXT ! COMMA;                                            05329000
         IF NEXT ! RPAREN THEN BEGIN FLOG(108); GO TO XIT END;          05330000
         SCAN;                                                          05331000
         IF NEXT ! COMMA THEN BEGIN FLOG(114); GO TO XIT END;           05332000
         SCAN;                                                          05333000
         IT ~ P+1;           % DONT LET EXPR WIPE OUT LSTT              05334000
         IF EXPR(TRUE) > REALTYPE THEN FLOG(102);                       05335000
         EMITPAIR(JUNK, ISN);                                           05336000
         EMITPAIR(1,LESS);                                              05337000
         EMITOPDCLIT(JUNK);                                             05338000
         EMITPAIR(P,GRTR);                                              05339000
         EMITO(LOR);                                                    05340000
         EMITOPDCLIT(JUNK);                                             05341000
         EMITL(3);                                                      05342000
         EMITO(MUL);                                                    05343000
                                                                        05344000
    IF ADR+3|P > 4085 THEN BEGIN ADR~ADR+1; SEGOVF END;                 05345000
         EMITO(BFC);                                                    05346000
         EMITPAIR(1, SSN);                                              05347000
         EMITDESCLIT(10);                                               05348000
         FOR I ~ 1 STEP 1 UNTIL P DO                                    05349000
    BEGIN                                                               05349100
         J ~ ADR; LABELBRANCH(LSTT[I], FALSE);                          05349200
         IF ADR-J = 2 THEN EMITO(NOP);                                  05349300
    END;                                                                05349400
    XIT:                                                                05350000
         IT ~ 0;                                                        05351000
END GOTOS;                                                              05352000
PROCEDURE IFS;                                                          05353000
BEGIN    REAL TYPE, LOGIFADR, SAVELABL;                                 05354000
         EODS~TRUE;                                                     05354010
         EXECUTABLE;                                                    05355000
         SCAN;                                                          05356000
         IF NEXT ! LPAREN THEN FLOG(106);                               05357000
         SCAN;                                                          05358000
         IF TYPE ~ EXPR(TRUE) = COMPTYPE THEN FLAG(89);                 05359000
         IF NEXT ! RPAREN THEN FLOG(108);                               05360000
         IF TYPE = LOGTYPE THEN                                         05361000
    BEGIN                                                               05362000
         EMITB(-1, TRUE);                                               05363000
         LOGIFADR ~ LAX;                                                05364000
         LOGIFTOG ~ TRUE; EOSTOG ~ TRUE;                                05365000
         SAVELABL ~ LABL; LABL ~ BLANKS;                                05365100
         STATEMENT;                                                     05366000
         LABL ~ SAVELABL;                                               05366100
         LOGIFTOG ~ FALSE; EOSTOG ~ FALSE;                              05367000
         FIXB(LOGIFADR);                                                05368000
    END ELSE                                                            05369000
    BEGIN                                                               05370000
         IF TYPE = DOUBTYPE THEN                                        05371000
         BEGIN EMITO(XCH); EMITO(DEL) END;                              05372000
         SCAN;                                                          05373000
         IF NEXT ! NUM THEN FLOG(109);                                  05374000
         FX1 ~ FNEXT; NX1 ~ NAME;                                       05375000
         SCAN;                                                          05376000
         IF NEXT ! COMMA THEN FLOG(114);                                05377000
         SCAN;                                                          05378000
         IF NEXT ! NUM THEN FLOG(109);                                  05379000
         FX2 ~ FNEXT; NX2 ~ NAME;                                       05380000
         SCAN;                                                          05381000
         IF NEXT ! COMMA THEN FLOG(114);                                05382000
         SCAN;                                                          05383000
         IF NEXT ! NUM THEN FLOG(109);                                  05384000
         FX3 ~ FNEXT; NX3 ~ NAME;                                       05385000
         SCAN;                                                          05386000
         IF FX2 = FX3 THEN                                              05387000
    BEGIN                                                               05388000
         EMITPAIR(0,GEQL);                                              05389000
         LABELBRANCH(NX1, TRUE);                                        05390000
         LABELBRANCH(NX3, FALSE);                                       05391000
         IF XREF THEN ENTERX(NX2,0&LABELID[TOCLASS]);                   05391200
    END ELSE                                                            05392000
         IF FX1 = FX3 THEN                                              05393000
    BEGIN                                                               05394000
         EMITPAIR(0,NEQL);                                              05395000
         LABELBRANCH(NX2, TRUE);                                        05396000
         LABELBRANCH(NX1, FALSE);                                       05397000
         IF XREF THEN ENTERX(NX3,0&LABELID[TOCLASS]);                   05397200
    END ELSE                                                            05398000
         IF FX1 = FX2 THEN                                              05399000
    BEGIN                                                               05400000
         EMITPAIR(0,LEQL);                                              05401000
         LABELBRANCH(NX3, TRUE);                                        05402000
         LABELBRANCH(NX1, FALSE);                                       05403000
         IF XREF THEN ENTERX(NX2,0&LABELID[TOCLASS]);                   05403200
    END ELSE                                                            05404000
    BEGIN                                                               05405000
         EMITO(DUP);                                                    05406000
         EMITPAIR(0,NEQL);                                              05407000
         EMITB(-1,TRUE);                                                05408000
         EMITPAIR(0,LESS);                                              05409000
         LABELBRANCH(NX3, TRUE);                                        05410000
         LABELBRANCH(NX1, FALSE);                                       05411000
         FIXB(LAX);                                                     05412000
         EMITO(DEL);                                                    05413000
         LABELBRANCH(NX2, FALSE);                                       05414000
    END;                                                                05415000
    END;                                                                05416000
END IFS;                                                                05417000
PROCEDURE NAMEL;                                                        05430000
BEGIN LABEL NIM,XIT,ELMNT,WRAP;                                         05431000
         IF SPLINK < 0 THEN FLAG(12);                                   05432000
         IF LOGIFTOG THEN FLAG(101);                                    05433000
         LABL ~ BLANKS;                                                 05433100
      SCAN;  IF NEXT ! SLASH THEN FLOG(110);                            05434000
NIM:  SCAN;  IF NEXT ! ID THEN BEGIN FLOG(105);  GO TO XIT END;         05435000
      IF J ~ (INFA ~ GET(LADR2 ~ FNEXT)).CLASS = UNKNOWN THEN           05436000
      PUT(LADR2,INFA&NAMELIST[TOCLASS])                                 05437000
      ELSE IF J ! NAMELIST THEN                                         05438000
      BEGIN XTA ~ GET(LADR2 + 1);                                       05439000
            FLAG(20);                                                   05440000
      END;                                                              05441000
      LSTT[LSTS ~ LADR1 ~ 0] ~ NAME;                                    05442000
      IF XREF THEN ENTERX(NAME,0&NAMELIST[TOCLASS]);                    05442500
      SCAN;  IF NEXT ! SLASH THEN FLOG(110);                            05443000
ELMNT: SCAN; IF NEXT ! ID THEN BEGIN FLOG(105); GO TO XIT END;          05444000
      LADR1 ~ LADR1 + 1;                                                05445000
      IF (T ~ GET(FNEW ~ GETSPACE(FNEXT)).CLASS) > VARID THEN FLAG(48); 05446000
      GETALL(FNEW,INFA,INFB,INFC);                                      05447000
      IF XREF THEN ENTERX(INFB,0&INFA[15:15:9]);                        05447500
      IF LSTS ~ LSTS+1 = LSTMAX THEN BEGIN FLOG(78); GO TO XIT END ELSE 05448000
      LSTT[LSTS] ~ NAME&INFA.CLASNSUB[2:38:10]&0[8:47:1];               05448500
      IF T = ARRAYID THEN                                               05449000
      BEGIN J ~ INFC.ADINFO;                                            05450000
            I ~ INFC.NEXTRA;                                            05451000
            IF LSTS + I + 1 > LSTMAX THEN                               05451100
            BEGIN FLOG(78);  GO TO XIT END;                             05451200
            LSTT[LSTS ~ LSTS + 1] ~ 0&I[1:42:6]   %  # DIMENSIONS       05452000
                                     &INFA.ADDR[7:37:11]   %  REL ADR   05453000
                                     &INFC.BASE[18:33:15]   %  BASE     05454000
                                     &INFC.SIZE[33:33:15];   %  SIZE    05455000
            FOR T ~ J STEP -1 UNTIL J - I + 1 DO                        05456000
            LSTT[LSTS ~ LSTS + 1] ~ EXTRAINFO[T.IR,T.IC];               05457000
      END ELSE BEGIN LSTT[LSTS~LSTS+1]~0&(INFA.ADDR)[7:37:11];          05458000
      IF BOOLEAN(INFA.CE) THEN LSTT[LSTS]~LSTT[LSTS]&INFC.BASE[18:33:15]05458400
                                       &INFC.SIZE[33:33:15] END;        05458600
      SCAN;  IF NEXT = COMMA THEN GO TO ELMNT;                          05459000
      IF NEXT ! SEMI AND NEXT ! SLASH THEN FLOG(115);                   05460000
      LSTT[LSTS + 1] ~ 0;                                               05461000
      LSTT[0].[2:10] ~ LADR1;                                           05462000
      PRTSAVER(LADR2,LSTS + 2,LSTT);                                    05463000
      IF NEXT ! SEMI THEN GO TO NIM;                                    05464000
XIT:                                                                    05465000
END NAMEL;                                                              05466000
PROCEDURE PAUSE;                                                        05467000
IF DCINPUT THEN BEGIN XTA~"PAUSE ";   FLOG(151) END ELSE                05467100
BEGIN                                                                   05468000
         EODS~TRUE ;                                                    05468010
         IF TSSEDITOG THEN TSSED("PAUSE ",2) ;                          05468100
         EXECUTABLE;                                                    05469000
         SCAN;                                                          05470000
         IF NEXT = SEMI THEN EMITL(0) ELSE                              05471000
         IF NEXT = NUM THEN                                             05472000
    BEGIN                                                               05473000
         EMITNUM(NAME);                                                 05474000
         SCAN;                                                          05475000
    END;                                                                05476000
         EMITPAIR(33, KOM);                                             05477000
         EMITO(DEL);                                                    05477100
END PAUSE;                                                              05478000
PROCEDURE TYPIT(TYP,TMPNXT);  VALUE TYP;  REAL TYP,TMPNXT ;             05479000
    BEGIN                                                               05480000
    TYPE~TYP;  SCAN ;                                                   05480010
    IF NEXT=16 THEN BEGIN TMPNXT~16; FUNCTION END ELSE DIMENSION ;      05480020
    END OF TYPIT ;                                                      05480040
DEFINE COMPLEX             =TYPIT(COMPTYPE,TEMPNEXT) #,                 05481000
       LOGICAL             =TYPIT(LOGTYPE ,TEMPNEXT) #,                 05482000
       DOUBLEPRECISION     =TYPIT(DOUBTYPE,TEMPNEXT) #,                 05483000
       INTEGERS            =TYPIT(INTYPE  ,TEMPNEXT) #,                 05484000
       REALS               =TYPIT(REALTYPE,TEMPNEXT) #;                 05484500
PROCEDURE STOP;                                                         05485000
BEGIN                                                                   05486000
         RETURNFOUND ~ TRUE;                                            05486100
         EODS~TRUE;                                                     05486110
         EXECUTABLE;                                                    05487000
         COMMENT INITIAL SCAN ALREADY DONE;                             05488000
         EMITL(1);                                                      05489000
         EMITPAIR(16,STD);                                              05490000
         EMITPAIR(10, KOM);                                             05491000
         EMITPAIR(5, KOM);                                              05492000
         WHILE NEXT ! SEMI DO SCAN;                                     05493000
END STOP;                                                               05494000
PROCEDURE RETURN;                                                       05495000
BEGIN LABEL EXIT;                                                       05496000
         REAL T, XITCODE;                                               05497000
         RETURNFOUND ~ TRUE;                                            05497100
         EODS~TRUE ;                                                    05497110
         EXECUTABLE;                                                    05498000
                                                                        05498100
                                                                        05498200
         SCAN;                                                          05499000
         IF SPLINK=0 OR SPLINK=1 THEN                                   05499100
              BEGIN XTA~"RETURN"; FLOG(153); GO EXIT END ;              05500000
         IF NEXT = SEMI THEN                                            05501000
    BEGIN                                                               05502000
         IF (T ~ GET(SPLINK)).CLASS = FUNID THEN                        05503000
    BEGIN                                                               05504000
         EMITV(FUNVAR);                                                 05505000
         IF T.SUBCLASS > LOGTYPE THEN EMITPAIR(JUNK, STD);              05506000
         XITCODE ~ RTN;                                                 05507000
    END  ELSE XITCODE ~ XIT;                                            05508000
    IF ADR } 4077 THEN                                                  05509000
         BEGIN ADR ~ ADR+1; SEGOVF END;                                 05510000
         EMITOPDCLIT(1538);       % F+2                                 05511000
         EMITPAIR(3, BFC);                                              05512000
         EMITPAIR(10, KOM);                                             05513000
         EMITO(XITCODE);                                                05514000
         EMITOPDCLIT(16);                                               05515000
         EMITPAIR(1, SUB);                                              05516000
         EMITPAIR(16, STD);                                             05517000
         EMITO(XITCODE);                                                05518000
         GO TO EXIT;                                                    05519000
    END;                                                                05520000
         IF LABELMOM = 0 THEN FLOG(145);                                05520100
         IF EXPR(TRUE) > REALTYPE THEN FLAG(102);                       05521000
         IF EXPRESULT = NUMCLASS THEN                                   05521100
         BEGIN IF XREF THEN ENTERX(EXPVALUE,0&LABELID[TOCLASS]);        05521200
               ADR ~ ADR-1;EMITL(EXPVALUE-1)                            05521400
         END ELSE                                                       05521600
         EMITPAIR(1, SUB);                                              05522000
         EMITOPDCLIT(LABELMOM);                                         05523000
         EMITO(MKS);                                                    05524000
         EMITL(9);                                                      05525000
         EMITOPDCLIT(5);                                                05526000
                                                                        05527000
    EXIT:                                                               05528000
END RETURN;                                                             05529000
PROCEDURE IMPLICIT ;                                                    05529100
    BEGIN                                                               05529105
    REAL R1,R2,R3,R4 ;                                                  05529110
    LABEL R,A,X,L ;                                                     05529120
  IF NOT(LASTNEXT=42 OR LASTNEXT=1000 OR LASTNEXT=30               %110-05529130
          OR LASTNEXT=16 OR LASTNEXT = 11)                         %110-05529131
    THEN BEGIN FLOG(181); FILETOG~TRUE; GO X END ;                      05529140
R:  EOSTOG~ERRORTOG~TRUE; FILETOG~FALSE ;                               05529210
    MOVEW(ACCUM[3],ACCUM[2],0,3); SCAN; ERRORTOG~FALSE; FILETOG~TRUE ;  05529215
    IF R1~IF R3~NEXT=18 THEN INTID ELSE IF R3=26 THEN REALID ELSE 0&    05529220
          (IF R3=10 THEN DOUBTYPE ELSE IF R3=19 THEN LOGTYPE ELSE IF R3=05529230
           6 THEN COMPTYPE ELSE 0)[TOSUBCL]=0 THEN                      05529240
                   BEGIN FLOG(182); GO X END ;                          05529250
    SCN~2;  SCAN ;                                                      05529260
    IF NEXT = STAR THEN IF R3!10 THEN                                   05529270
         BEGIN SCAN ;                                                   05529280
         IF NEXT=NUM AND NUMTYPE=INTYPE THEN                            05529290
              BEGIN                                                     05529300
              IF FNEXT=4 THEN BEGIN IF R3=6 THEN FLAG(176); GO L END ;  05529310
              IF FNEXT=8 THEN                                           05529320
                   BEGIN                                                05529330
                   IF R3=26 THEN R1~0&DOUBTYPE[TOSUBCL]                 05529340
                   ELSE IF R3!6 THEN FLAG(177) ;                        05529350
                   GO L;                                                05529360
                   END ;                                                05529370
              END ;                                                     05529380
         FLAG(IF R3=26 THEN 178 ELSE 177-REAL(R3=6)) ;                  05529390
L:       NCR~REAL(NCR.[30:3]!0)+3"677777"+NCR;  SCN~1;  SCAN ;          05529400
         END ;                                                          05529410
    IF NEXT!LPAREN THEN BEGIN FLOG(106); GO X END ;                     05529420
A:  SCAN;  R4~ERRORCT ;                                                 05529430
    IF R2~NAME.[12:6]<17 OR (R2>25 AND R2<33) OR (R2>41 AND R2<50)      05529440
       OR R2>57 OR NAME.[18:30]!"     " THEN FLAG(179) ;                05529450
    SCAN ;                                                              05529460
    IF NEXT!MINUS THEN                                                  05529470
         BEGIN IF ERRORCT=R4 THEN TIPE[IF R2!"0" THEN R2 ELSE 12]~R1 END05529475
    ELSE BEGIN                                                          05529480
         SCAN ;                                                         05529490
         IF R3~NAME.[12:6]<17 OR (R3>25 AND R3<33) OR (R3>41 AND R3<50) 05529500
            OR R3>57 OR NAME.[18:30]!"     " THEN FLAG(179) ;           05529510
         IF R3 LEQ R2 THEN FLAG(180) ;                                  05529520
         IF ERRORCT=R4 THEN FOR R2~R2 STEP 1 UNTIL R3 DO                05529530
              BEGIN                                                     05529540
              IF R2>25 AND R2<33 THEN R2~33 ELSE IF R2>41 AND R2<50     05529550
                                                 THEN R2~50 ;           05529560
              TIPE[IF R2!"0" THEN R2 ELSE 12]~R1 ;                      05529570
              END ;                                                     05529580
         SCAN ;                                                         05529590
         END ;                                                          05529600
    IF NEXT=COMMA THEN GO A ;                                           05529610
    IF NEXT!RPAREN THEN BEGIN FLOG(108); GO X END ;                     05529620
    SCAN; IF NEXT=COMMA THEN GO R ;                                     05529630
    IF NEXT!SEMI THEN BEGIN FLOG(117); GO X END ;                       05529635
    IF SPLINK > 1 THEN                                                  05529640
         BEGIN                                                          05529650
         IF BOOLEAN(TYPE.[2:1]) THEN IF GET(SPLINK).CLASS=FUNID THEN    05529660
               BEGIN                                                    05529670
               INFO[SPLINK.IR,SPLINK.IC].SUBCLASS~R3~TIPE[IF R3~GET(    05529680
                    SPLINK+1).[12:6]!"0" THEN R3 ELSE 12].SUBCLASS ;    05529690
               INFO[FUNVAR.IR,FUNVAR.IC].SUBCLASS~R3 ;                  05529700
               END ;                                                    05529710
         IF R1~GET(SPLINK+2)<0 THEN                                     05529720
              FOR R2~R1.NEXTRA-1+R1~R1.ADINFO STEP -1 UNTIL R1 DO       05529730
                   IF R3~PARMLINK[R2-R1+1]!0 THEN                       05529740
                        BEGIN                                           05529750
                        EXTRAINFO[R2.IR,R2.IC].SUBCLASS~R4~TIPE[IF R4~  05529760
                             GET(R3+1).[12:6]!"0" THEN R4 ELSE 12]      05529770
                             .SUBCLASS ;                                05529780
                        INFO[R3.IR,R3.IC].SUBCLASS~R4 ;                 05529790
                        END ;                                           05529800
         END ;                                                          05529810
X:  WHILE NEXT!SEMI DO SCAN; FILETOG~FALSE ;                            05529820
    END OF IMPLICIT ;                                                   05529830
PROCEDURE SUBROUTINE;                                                   05530000
BEGIN                                                                   05531000
         IF SPLINK NEQ 0 THEN BEGIN FLAG(5); ENDS; SEGMENTSTART; END;   05532000
         LABL ~ BLANKS;                                                 05532100
         FORMALPP(FALSE, SUBRID);                                       05533000
         SPLINK ~ FNEW;                                                 05534000
END SUBROUTINE;                                                         05535000
PROCEDURE MEMHANDLER(N);  VALUE N;  REAL N ;                            05535010
    BEGIN                                                               05535020
    REAL A ;                                                            05535030
    LABEL L1,L2,L3,XIT ;                                                05535040
    IF DEBUGTOG THEN FLAGROUTINE(" MEMHA","NDLER ",TRUE) ;              05535045
    IF N LEQ 2 THEN                                                     05535050
         BEGIN % FIXED=1, VARYING=2.                                    05535060
         N~IF N=1 THEN 6 ELSE 0 ;                                       05535070
L1:      SCAN;                                                          05535080
         IF NEXT!ID THEN BEGIN FLOG(105); GO XIT END ;                  05535090
         IF (A~GET(GETSPACE(FNEXT))).CLASS!ARRAYID THEN                 05535100
              BEGIN FLOG(35); GO XIT END ;                              05535110
         IF XREF THEN ENTERX(XTA,0&A[15:15:9]) ;                        05535120
         IF BOOLEAN(A.EQ) OR BOOLEAN(A.FORMAL) THEN FLAG(169)           05535130
         ELSE BEGIN                                                     05535140
              EMITO(MKS);  EMITPAIR(A.ADDR,LOD);  EMITL(N) ;            05535150
              EMITV(NEED(".MEMHR",INTRFUNID)) ;                         05535160
              END ;                                                     05535170
         SCAN;  IF NEXT=COMMA THEN GO L1 ;                              05535180
         END                                                            05535190
    ELSE IF N=3 THEN                                                    05535200
              BEGIN % AUXMEMED FUNCTION OR SUBROUTINE.                  05535210
              SCAN ;                                                    05535220
              IF NEXT!ID THEN BEGIN FLOG(105); GO XIT END ;             05535225
              IF GET(FNEXT+1)!GET(SPLINK+1) THEN                        05535230
                   BEGIN FLOG(170); GO XIT END ;                        05535235
              PUT(SPLINK,GET(SPLINK)&1[TOADJ]) ;                        05535240
              IF XREF THEN ENTERX(XTA,0&GET(FNEXT)[15:15:9]);  SCAN ;   05535250
              END                                                       05535420
         ELSE BEGIN % RELEASE.                                          05535430
L2:           SCAN ;                                                    05535440
              IF NEXT!ID THEN BEGIN FLOG(105); GO XIT END ;             05535450
              IF (A~GET(GETSPACE(FNEXT))).CLASS=ARRAYID THEN            05535460
                   BEGIN                                                05535470
                   IF BOOLEAN(A.EQ) OR BOOLEAN(A.FORMAL) THEN FLAG(169) 05535480
                   ELSE BEGIN                                           05535490
                        EMITO(MKS);  EMITPAIR(A.ADDR,LOD) ;             05535500
                        EMITPAIR(1,SSN) ;                               05535510
                        EMITV(NEED(".MEMHR",INTRFUNID)) ;               05535520
                        END ;                                           05535530
L3:                IF XREF THEN ENTERX(XTA,0&A[15:15:9]) ;              05535540
                   END                                                  05535550
              ELSE IF A.CLASS}BLOCKID OR A.CLASS{LABELID THEN           05535560
                        BEGIN FLOG(171); GO XIT END                     05535570
                   ELSE BEGIN                                           05535575
                        EMITPAIR(A.ADDR,LOD);  EMITPAIR(38,KOM) ;       05535580
                        EMITO(DEL);  GO L3 ;                            05535585
                        END ;                                           05535590
              SCAN;  IF NEXT=COMMA THEN GO L2 ;                         05535595
              END ;                                                     05535600
XIT:IF DEBUGTOG THEN FLAGROUTINE(" MEMHA","NDLER ",FALSE) ;             05535605
    END OF MEMHANDLER ;                                                 05535610
PROCEDURE STATEMENT;                                                    05536000
BEGIN LABEL DOL1, XIT;                                                  05537000
      REAL TEMPNEXT ;                                                   05537100
      BOOLEAN ENDTOG;                                              %112-05537200
         DO SCAN UNTIL NEXT ! SEMI;                                     05538000
         IF NEXT=ID THEN ASSIGNMENT ELSE IF NEXT LEQ RSH1 THEN          05539000
         CASE(TEMPNEXT~NEXT) OF                                         05540000
    BEGIN                                                               05541000
         FLOG(16);                                                      05542000
         ASSIGN;                                                        05543000
         IOCOMMAND(4);      %BACKSPACE                                  05544000
         BLOCKDATA;                                                     05545000
         CALL;                                                          05546000
         COMMON;                                                        05547000
         COMPLEX;                                                       05548000
         BEGIN EXECUTABLE; SCAN END;      % CONTINUE                    05549000
         IOCOMMAND(7);   %  DATA                                        05550000
         BEGIN SCAN; TYPE ~ -1; DIMENSION END;                          05551000
         DOUBLEPRECISION;                                               05552000
         BEGIN ENDS; ENDTOG:=TRUE; SCAN END;                       %112-05553000
         FILECONTROL(1);   %ENDFILE                                     05554000
         ENTRY;                                                         05555000
         EQUIVALENCE;                                                   05556000
         EXTERNAL;                                                      05557000
         BEGIN TYPE ~ -1; FUNCTION END;                                 05558000
         GOTOS;                                                         05559000
         INTEGERS;                                                      05560000
         LOGICAL;                                                       05561000
         NAMEL;                                                         05562000
         PAUSE;                                                         05563000
         IOCOMMAND(2);     %PRINT                                       05564000
         ;                                                              05565000
         IOCOMMAND(3);     %PUNCH                                       05566000
         IOCOMMAND(0);     %READ                                        05567000
         REALS;                                                         05568000
         RETURN;                                                        05569000
         FILECONTROL(0);   %REWIND                                      05570000
         BEGIN SCAN; STOP END;                                          05571000
         SUBROUTINE;                                                    05572000
         IOCOMMAND(1);     %WRITE                                       05573000
         FILECONTROL(7);   %CLOSE                                       05573100
         FILECONTROL(6);   %LOCK                                        05573200
         FILECONTROL(4);   %PURGE                                       05573300
         IFS;                                                           05574000
         FORMATER;                                                      05575000
         CHAIN;                                                         05575100
         MEMHANDLER(1) ; %FIXED                                         05576000
         MEMHANDLER(2) ; %VARYING                                       05576100
         MEMHANDLER(3) ; %AUXMEM FOR SUBPROGRAMS                        05576200
         MEMHANDLER(4) ; %RELEASE                                       05577000
         IMPLICIT ;                                                     05577100
    END ELSE IF NEXT=EOF THEN GO XIT ELSE BEGIN NEXT~0; FLOG(16) END ;  05578000
         LASTNEXT.[33:15]~TEMPNEXT ;                                    05578100
         IF NOT ENDTOG THEN IF SPLINK=0 THEN SPLINK:=1;            %112-05579000
         ENDTOG:=FALSE;                                            %112-05579100
         IF LABL ! BLANKS THEN                                          05580000
    BEGIN                                                               05581000
         IF DT ! 0 THEN                                                 05582000
    BEGIN                                                               05583000
    DOL1: IF LABL = DOLAB[TEST ~ DT] THEN                               05584000
    BEGIN                                                               05585000
         EMITB(DOTEST[DT], FALSE);                                      05586000
         FIXB(DOTEST[DT].ADDR);                                         05587000
         IF DT ~ DT-1 > 0 THEN GO TO DOL1;                              05588000
    END ELSE                                                            05589000
         WHILE TEST ~ TEST-1 > 0 DO                                     05590000
         IF DOLAB[TEST] = LABL THEN FLAG(14);                           05591000
    END;                                                                05592000
         LABL ~ BLANKS;                                                 05592100
    END;                                                                05593000
                                                                        05594000
         IF NEXT ! SEMI THEN                                            05595000
    BEGIN                                                               05596000
         FLAG(117);                                                     05597000
         DO SCAN UNTIL NEXT=SEMI OR NEXT=EOF ;                          05598000
    END;                                                                05599000
         ERRORTOG ~ FALSE;                                              05600000
         EOSTOG ~ TRUE;                                                 05601000
    XIT:                                                                05602000
END STATEMENT;                                                          05603000
BOOLEAN STREAM PROCEDURE FLAGLAST(BUFF,ERR) ;                           05603010
   BEGIN                                                                05603020
   LOCAL A;   SI~ERR;  8(IF SC!" " THEN JUMP OUT;SI~SI+1;TALLY~TALLY+1);05603030
   A~TALLY;   SI~LOC A;   SI~SI+7 ;                                     05603040
   IF SC<"8" THEN                                                       05603050
      BEGIN   TALLY~1;   FLAGLAST~TALLY ;                               05603060
      DI~BUFF;DS~46 LIT"LAST SYNTAX ERROR OCCURRED AT SEQUENCE NUMBER ";05603070
      DS~LIT""";   SI~ERR;   DS~8 CHR;   DS~LIT""";                     05603080
       DS~32 LIT "                                ";               %510-05603081
       DS~32 LIT "                                ";               %510-05603082
      END                                                               05603090
   END FLAGLAST ;                                                       05603100
INTEGER PROCEDURE FEELD(X);   VALUE X;   INTEGER X;                     05603110
FEELD~IF X<10 THEN 1 ELSE IF X<100 THEN 2 ELSE IF X<1000 THEN 3 ELSE IF 05603120
X<10000 THEN 4 ELSE IF X<100000 THEN 5 ELSE IF X<1000000 THEN 6 ELSE 7; 05603130
FORMAT EOC1(/ "NUMBER OF SYNTAX ERRORS DETECTED = ",I*,".",X*,          05604000
            "NUMBER OF SEQUENCE ERRORS DETECTED = ",I*,"."),            05605000
       EOC2("PRT SIZE = ",I*,";   TOTAL SEGMENT SIZE = ",I*,            05606000
            " WORDS;  DISK SIZE = ",I*," SEGS;  NO. PRGM. SEGS = ",I*,  05607000
            "."),                                                       05607010
       EOC3("ESTIMATED CORE STORAGE REQUIREMENT = ",I*," WORDS;",       05608000
            "  COMPILATION TIME = ",I*," MIN, ",I*," SECS;",            05608010
            "  NO. CARDS = ",I*,"."),                                   05608020
       EOC4("ESTIMATED CORE STORAGE REQUIREMENT = ",I*," WORDS;"        05608030
            "  COMPILATION TIME = ",I*," SECS;  NO. CARDS = ",I*,"."),  05608040
       EOC5("NUMBER OF TSS WARNINGS DETECTED = ",I*,".") ;              05608050
COMMENT  MAIN DRIVER FOR FORTRAN COMPILER BEGINS HERE;                  05609000
RTI ~ TIME(1);                                                          05610000
INITIALIZATION;                                                         05611000
         DO STATEMENT UNTIL NEXT = EOF;                                 05612000
  IF NOT ENDSEGTOG THEN IF SPLINK NEQ 0                            %112-05612100
     THEN BEGIN XTA:=BLANKS; FLAG(5); ENDS END;                    %112-05612200
         WRAPUP;                                                        05613000
POSTWRAPUP:                                                             05613900
IF TIMETOG THEN IF FIRSTCALL THEN DATIME;                               05614000
IF NOT FIRSTCALL THEN                                                   05615000
   BEGIN                                                                05616000
   WRITE(RITE,EOC1,FEELD(ERRORCT),ERRORCT,IF SEQERRCT=0 THEN 99 ELSE    05617000
   5,FEELD(SEQERRCT-1),SEQERRCT-1) ;                                    05618000
   IF WARNED AND NOT DCINPUT THEN WRITE(RITE,EOC5,FEELD(WARNCOUNT),     05618100
   WARNCOUNT) ;                                                         05618110
   WRITE(RITE,EOC2,FEELD(PRTS),PRTS,FEELD(TSEGSZ),TSEGSZ,FEELD(DALOC-1),05619000
   DALOC-1,FEELD(NXAVIL),NXAVIL) ;                                      05619010
   IF C1~(TIME(1)-RTI)/60 > 59 THEN WRITE(RITE,EOC3,FEELD(64|ESTIMATE), 05619020
   64|ESTIMATE,FEELD(C1 DIV 60),C1 DIV 60,FEELD(C1 MOD 60),C1 MOD 60,   05619030
   FEELD(CARDCOUNT-1),CARDCOUNT-1) ELSE WRITE(RITE,EOC4,FEELD(ESTIMATE  05619040
   |64),ESTIMATE|64,FEELD(C1),C1,FEELD(CARDCOUNT-1),CARDCOUNT-1) ;      05619045
   IF ERRORCT>0 THEN IF FLAGLAST(ERRORBUFF,LASTERR) THEN WRITE(RITE,15, 05619050
   ERRORBUFF[*]) ;                                                      05619100
   END ;                                                                05619200
END INNER BLOCK;                                                        05620000
END.                                                                    05621000