Trailing-Edge
-
PDP-10 Archives
-
decuslib10-07
-
43,50445/10c.flx
There are 2 other files named 10c.flx in the archive. Click here to see a list.
01273 SUBROUTINE FLECS
01950 C FLECS TRANSLATOR (PRELIMINARY VERSION 22)
02000 C (FOR A MORE PRECISE VERSION NUMBER, SEE THE STRING SVER)
02050 C
02100 C AUTHOR -- TERRY BEYER
02150 C
02200 C ADDRESS -- COMPUTING CENTER
02250 C UNIVERSITY OF OREGON
02300 C EUGENE, OREGON 97405
02350 C
02400 C TELEPHONE -- (503) 686-4416
02450 C
02500 C DATE -- NOVEMBER 20, 1974
02550 C
02600 C---------------------------------------
02650 C
02700 C DISCLAIMER
02750 C
02800 C NEITHER THE AUTHOR NOR THE UNIVERSITY OF OREGON SHALL BE
02850 C LIBAL FOR ANY DIRECT OR INDIRECT, INCIDENTAL, CONSEQUENTIAL,
02900 C OR SPECIFIC DAMAGES OF ANY KIND OR FROM ANY CAUSE WHATSOEVER
02950 C ARISING OUT OF OR IN ANY WAY CONNECTED WITH THE USE OR
03000 C PERFORMANCE OF THIS PROGRAM.
03100 C
03150 C---------------------------------------
03200 C
03250 C PERMISSION
03300 C
03350 C THIS PROGRAM IS IN THE PUBLIC DOMAIN AND MAY BE ALTERED
03400 C OR REPRODUCED WITHOUT EXPLICIT PERMISSION OF THE AUTHOR.
03450 C
03500 C---------------------------------------
03550 C
03600 C NOTE TO THE PROGRAMMER WHO WISHES TO ALTER THIS CODE
03650 C
03700 C
03750 C THE PROGRAM BELOW IS THE RESULT OF ABOUT SIX MONTHS OF
03800 C RAPID EVOLUTION IN ADDITION TO BEING THE FIRST SUCH
03850 C PROGRAM I HAVE EVER WRITTEN. YOU WILL FIND IT IS UNCOMMENTED,
03900 C AND IN MANY PLACES OBSCURE. THE LOGIC IS FREQUENTLY
03950 C BURIED UNDER A PILE OF PATCHES WHICH BARELY TOLERATE EACH
04000 C OTHER S EXISTENCE.
04050 C
04100 C I PLAN TO WRITE A CLEANER, SMALLER, AND FASTER VERSION OF
04150 C THIS PROGRAM WHEN GIVEN THE OPPORTUNITY. IT WAS NEVER
04200 C MY INTENT TO PRODUCE A PROGRAM MAINTAINABLE BY ANYONE OTHER
04250 C THAN MYSELF ON THIS FIRST PASS. NEVERTHLESS PLEASE
04300 C ACCEPT MY APOLOGIES FOR THE CONDITION OF THE CODE BELOW.
04350 C I WOULD PREFER IT IF YOU WOULD CONTACT ME AND WAIT FOR
04400 C THE NEWER VERSION BEFORE MAKING ANY BUT THE MOST NECESSARY
04450 C CHANGES TO THIS PROGRAM. YOU WILL PROBABLY SAVE YOURSELF
04500 C MUCH TIME AND GRIEF.
05700 C
05750 C---------------------------------------
05800 C
05850 C INTEGER DECLARATIONS
05900 C
05950 C
06050 INTEGER ACSEQ , ACTION, AELSE , AFSEQ , AGCONT, AGGOTO
06100 INTEGER AGRET , AGSTNO, AMSEQ , ASSEQ , ATSEQ , BLN
06250 INTEGER CALLNO, CH , CHC , CHSPAC, CHTYP
06500 INTEGER CHTYPE, CHZERO, CLASS , CONTNO, CPOS , CSAVE
06550 INTEGER CURSOR, CWD , DUMMY , ELSNO , ENDNO , ENTNO
06600 INTEGER ERRCL , ERROR , ERRSTK, ERSTOP, ERTYPE, EXTYPE
06650 INTEGER FLXNO , FORTCL, GGOTON, GOTONO, GSTNO , HASH
06700 INTEGER HOLDNO, I , ITEMP , J , KCOND , KDO
06750 INTEGER KELSE , KEND , KFIN , KIF , KREPT , KSELCT
06800 INTEGER KTO , KUNLES, KUNTIL, KWHEN , KWHILE, L
06850 INTEGER LEN , LEVEL , LINENO, LISTCL, LL , LOOPNO
06900 INTEGER LP , LR , LSTLEV, LT , LWIDTH, MAJCNT
06950 INTEGER MAX , MAXSTK, MINCNT, MLINE , NCHPWD, NEWNO
07000 INTEGER NEXTNO, NUNITS, NXIFNO, OFFSET, OFFST2, P
07050 INTEGER PARAM1, PARAM2, PARAM3, PARAM4, PCNT , PDUMMY
07100 INTEGER PENT , PRIME , PTABLE, Q , QM , QP
07150 INTEGER READ , REFNO , RETNO , RETRY , S , SAFETY
07200 INTEGER SASSN1, SASSN2, SB , SB2 , SB4 , SB5
07250 INTEGER SB5I1 , SB6 , SB6I , SB7 , SBGOTO, SCOMMA, SCOND
07260 INTEGER SCONT
07300 INTEGER SCP , SDASH , SDOST , SDUM , SEEDNO, SELSE , SEQ
07350 INTEGER SEND , SENDER, SETUP , SFIN , SFLX , SFORCE
07400 INTEGER SFSPCR, SGOTO , SGOTOI, SGUP1 , SGUP2 , SHOLD
07410 INTEGER SGOTOP
07450 INTEGER SICOND, SIELSE, SIF , SIFIN , SIFIN2, SIFP
07500 INTEGER SIFPN , SIGN , SINSRT, SINS2 , SITODM, SIWHEN, SLIST
07550 INTEGER SLP , SMULER, SNDER1, SNDER2, SNE , SNIER1
07600 INTEGER SNIER2, SOURCE, SOWSE , SP , SPB , SPGOTO
07650 INTEGER SPINV , SPUTGO, SRP , SRTN , SSPACR, SST
07660 INTEGER SRPCI
07700 INTEGER SSTMAX, SSTOP , STABH , STACK , START , STNO
07750 INTEGER STODUM, SVER , SWHEN , SXER1 , SXER2 , SXER3
07800 INTEGER SXER4 , SXER5 , TABLCL, TBLANK, TCEXP , TCOND
07850 INTEGER TDIGIT, TDO , TELSE , TEND , TEOL , TESTNO
07900 INTEGER TEXEC , TFIN , TFORT , THYPHN, TIF , TINVOK
07950 INTEGER TLETTR, TLP , TMAX , TOP , TOPNO , TOPTYP
08000 INTEGER TOTHER, TRP , TRUNTL, TRWHIL, TSELCT, TTO
08050 INTEGER TUNLES, TUNTIL, TWHEN , TWHILE, UDO , UEXP
08100 INTEGER UFORT , ULEN , UOWSE , UPINV , USTART, UTYPE
08150 INTEGER WWIDTH
11700 C
11750 C---------------------------------------
11800 C
11850 C LOGICAL DECLARATIONS
11900 C
11950 C
12025 LOGICAL COGOTO, FAKE , LONG
12050 LOGICAL BADCH , CONT , DONE , ENDFIL, ENDPGM, ERLST
12100 LOGICAL FIRST , FOUND , INDENT, INSERT, INVOKE, MINER
12150 LOGICAL NDERR , NIERR , NOPGM , NOTFLG, PASS , SAVED , SHORT
12200 LOGICAL STREQ , STRLT
12700 C
12750 C---------------------------------------
12800 C
12850 C ARRAY DECLARATIONS
12900 C
12950 C
13000 C ARRAYS WHICH HOLD RESULTS OF SCANNERS ANALYSIS
13050 DIMENSION UTYPE(3), USTART(3), ULEN(3)
13100 C
13150 C STACK/TABLE AREA AND POINTER TO TOP OF STACK
13200 DIMENSION STACK(2000)
13250 C
13300 C SYNTAX ERROR STACK AND TOP POINTER
13350 DIMENSION ERRSTK(5)
14250 C
14300 C---------------------------------------
14350 C
14400 C MNEMONIC DECLARATIONS
14450 C
14500 C
14550 C I/O CLASS CODES FOR USE WITH SUBROUTINE PUT
14600 C DATA FORTCL /1/, LISTCL /2/, ERRCL /3/
14700 C
14750 C ACTION CODES FOR USE ON ACTION STACK
14800 C DATA ACSEQ/1/, AELSE/2/, AFSEQ/3/, AGCONT/4/, AGGOTO/5/
14850 C DATA AGSTNO/6/, AMSEQ/7/, AGRET/8/, ASSEQ/9/, ATSEQ/10/
14950 C
15000 C TYPE CODES USED BY SCANNERS
15050 C DATA UEXP/1/, UFORT/2/, UOWSE/3/, UPINV/4/, UDO/5/
15150 C
15200 C TYPE CODES OF CHARACTERS (SUPPLIED BY CHTYPE)
15250 C WARNING - LOGIC IS SENSITIVE TO THE ORDER OF THESE VALUES.
15300 C DATA TLETTR/1/, TDIGIT/2/, THYPHN/3/, TLP/4/, TRP/5/
15350 C DATA TBLANK/6/, TOTHER/7/, TEOL/8/
15450 C
15500 C TYPE CODES ASSIGNED TO THE VARIABLE CLASS
15550 C DATA TCEXP/1/, TELSE/2/, TEND/3/, TEXEC/4/, TFIN/5/, TTO/6/
15650 C
15700 C TYPE CODES ASSIGNED TO THE VARIABLE EXTYPE
15750 C DATA TCOND/1/, TDO/2/, TFORT/3/, TIF/4/, TINVOK/5/, TRUNTL/6/
15800 C DATA TRWHIL/7/, TSELCT/8/, TUNLES/9/, TUNTIL/10/, TWHEN/11/
15850 C DATA TWHILE/12/
15900 C
15950 C CODES INDICATING SOURCE OF NEXT STATEMENT
16150 C IN ANALYZE-NEXT-STATEMENT
16250 C DATA SETUP /1/, RETRY /2/, READ /3/
16350 C
16400 C---------------------------------------
16450 C
16500 C
16550 C PARAMETERS
16600 C
16650 C THE FOLLOWING VARIABLES ARE PARAMETERS FOR THE PROGRAM.
16700 C THE MEANING OF EACH IS GIVEN BRIEFLY BELOW. FOR MORE INFORMATION
16750 C ON THE EFFECT OF THESE PARAMETERS, CONSULT THE SYSTEM MODIFICATION
16800 C GUIDE.
16900 C
16950 C INTEGER VALUE OF THE CHARACTER C
17200 C DATA CHC /67/
17350 C
17400 C LISTING WIDTH IN CHARACTERS
17450 C DATA LWIDTH /132/
17500 C
17550 C SIZE OF THE MAIN STACK
17600 C DATA MAXSTK /2000/
17700 C
17750 C NUMBER OF CHARACTERS PER WORD (PER INTEGER) IN A FORMAT
18000 C DATA NCHPWD /5/
18250 C
18300 C SIZE OF HASH TABLE FOR PROCEDURE NAMES - SHOULD BE PRIME.
18350 C DATA PRIME /53/
18450 C
18500 C SAFETY MARGIN BETWEEN TOP AND MAX AT BEGINNING OF EACH LOOP
18550 C DATA SAFETY /35/
18600 C
18650 C SEED FOR GENERATION OF STATEMENT NUMBERS
18800 C DATA SEEDNO /100000/
18972 C
18974 C CAUSES LONG FORM OF ASSIGNED GO TO TO BE GENERATED
18978 C DATA LONG /.FALSE./
19050 C
19100 C CAUSES SHORT FORM OF ASSIGNED GO TO TO BE GENERATED
19350 C DATA SHORT /.TRUE./
19404 C
19406 C CAUSES FAKE LONG FORM OF ASSIGNED GO TO TO BE GENERATED
19412 C DATA FAKE /.FALSE./
19422 C
19424 C CAUSES COMPUTED GO TO'S TO BE GENERATED
19430 C DATA COGOTO /.FALSE./
19500 C
19550 C INTEGER VALUE OF THE CHARACTER SPACE
19800 C DATA CHSPAC /32/
19950 C
20000 C INTEGER VALUE OF THE CHARACTER CODE FOR ZERO
20250 C DATA CHZERO /48/
20400 C
20450 C THE PARAMETERS NCHPWD, CHZERO, CHSPAC, AND CHC
20500 C ARE COMMUNICATED TO VARIOUS
20550 C SUBPROGRAMS VIA THE FOLLOWING COMMON (SEE PERFORM-INITIALIZATION)
20650 C COMMON /PARAM/ NCHPWD, CHZERO, CHSPAC, CHC
20700 COMMON /PARAM/ PARAM1, PARAM2, PARAM3, PARAM4
21000 C
21050 C---------------------------------------
21100 C
21150 C STRING DECLARATIONS
21200 C
21250 C
21300 C THE FOLLOWING ARRAYS ARE USED FOR STORAGE OF WORKING STRINGS
21350 C AND CORRESPOND TO STRINGS OF THE LENGTHS INDICATED.
21400 C THE SIZES GIVEN BELOW ARE EXCESSIVE AND SHOULD BE
21450 C BE REDUCED AFTER CAREFUL ANALYSIS (NO TIME NOW).
21500 C
21600 C SFLX 100 CHARACTERS
21601 DIMENSION SFLX (21)
21650 C SHOLD 100 CHARACTERS
21651 DIMENSION SHOLD (21)
21700 C SLIST 200 CHARACTERS
21701 DIMENSION SLIST (41)
21750 C SPINV 80 CHARACTERS
21751 DIMENSION SPINV (17)
21800 C SPUTGO 20 CHARACTERS
21801 DIMENSION SPUTGO (5)
21850 C SST 200 CHARACTERS
21851 DIMENSION SST (41)
21900 C DATA SSTMAX /200/
21950 C
22000 C THE FOLLOWING STRINGS REPRESENT CONSTANTS
22050 C
22150 C SASSN1 // ASSIGN //
22151 DIMENSION SASSN1 (4)
22152 C DATA SASSN1 / 13, 5H , 5H ASSI, 3HGN /
22200 C SASSN2 // TO I//
22201 DIMENSION SASSN2 (2)
22202 C DATA SASSN2 / 5, 5H TO I/
22300 C SB // //
22301 DIMENSION SB (2)
22302 C DATA SB / 1, 1H /
22400 C SB2 // //
22401 DIMENSION SB2 (2)
22402 C DATA SB2 / 2, 2H /
22450 C SB4 // //
22451 DIMENSION SB4 (2)
22452 C DATA SB4 / 4, 4H /
22600 C SB5 // //
22601 DIMENSION SB5 (2)
22602 C DATA SB5 / 5, 5H /
22700 C SB5I1 // 1//
22701 DIMENSION SB5I1 (3)
22702 C DATA SB5I1 / 6, 5H , 1H1/
22800 C SB6 // //
22801 DIMENSION SB6 (3)
22802 C DATA SB6 / 6, 5H , 1H /
22850 C SB7 // //
22851 DIMENSION SB7 (3)
22852 C DATA SB7 / 7, 5H , 2H /
22920 C SB6I // I//
22921 DIMENSION SB6I (3)
22922 C DATA SB6I / 7, 5H , 2H I/
22950 C SBGOTO // GO TO //
22951 DIMENSION SBGOTO (3)
22952 C DATA SBGOTO / 7, 5H GO T, 2HO /
23000 C SCOMMA //,//
23001 DIMENSION SCOMMA (2)
23002 C DATA SCOMMA / 1, 1H,/
23100 C SCOND // CONDITIONAL//
23101 DIMENSION SCOND (5)
23102 C DATA SCOND / 17, 5H , 5H COND, 5HITION, 2HAL/
23160 C SCONT //CONTINUE//
23161 DIMENSION SCONT (3)
23162 C DATA SCONT / 8, 5HCONTI, 3HNUE/
23200 C SCP //,(//
23201 DIMENSION SCP (2)
23202 C DATA SCP / 2, 2H,(/
23300 C SDOST // DO //
23301 DIMENSION SDOST (3)
23302 C DATA SDOST / 9, 5H , 4H DO /
23400 C SDASH //----------------------------------------//
23401 DIMENSION SDASH (9)
23402 C DATA SDASH / 40, 5H-----, 5H-----, 5H-----, 5H-----, 5H-----
23403 C 1 , 5H-----, 5H-----, 5H-----/
23500 C SDUM //DUMMY-PROCEDURE//
23501 DIMENSION SDUM (4)
23502 C DATA SDUM / 15, 5HDUMMY, 5H-PROC, 5HEDURE/
23600 C SELSE // ELSE CONTINUE//
23601 DIMENSION SELSE (5)
23602 C DATA SELSE / 19, 5H , 5H ELSE, 5H CONT, 4HINUE/
23700 C SEND // END//
23701 DIMENSION SEND (3)
23702 C DATA SEND / 9, 5H , 4H END/
23800 C SENDER //***** END STATEMENT IS MISSING//
23801 DIMENSION SENDER (7)
23802 C DATA SENDER / 30, 5H*****, 5H END , 5HSTATE, 5HMENT , 5HIS MI
23803 C 1 , 5HSSING/
23850 C SFIN // FIN//
23851 DIMENSION SFIN (3)
23852 C DATA SFIN / 9, 5H , 4H FIN/
23920 C SEQ //=//
23921 DIMENSION SEQ (2)
23922 C DATA SEQ / 1, 1H=/
23950 C SFORCE // CONTINUE//
23951 DIMENSION SFORCE (4)
23952 C DATA SFORCE / 14, 5H , 5H CONT, 4HINUE/
24050 C SFSPCR //...//
24051 DIMENSION SFSPCR (2)
24052 C DATA SFSPCR / 3, 3H.../
24150 C SGOTO // GO TO //
24151 DIMENSION SGOTO (4)
24152 C DATA SGOTO / 12, 5H , 5H GO T, 2HO /
24200 C SGOTOI // GO TO I//
24201 DIMENSION SGOTOI (4)
24202 C DATA SGOTOI / 13, 5H , 5H GO T, 3HO I/
24225 C SGOTOP // GO TO (//
24226 DIMENSION SGOTOP (4)
24227 C DATA SGOTOP / 13, 5H , 5H GO T, 3HO (/
24250 C SGUP1 //***** TRANSLATOR HAS USED UP ITS ALLOTED SPACE FOR TABLES//
24251 DIMENSION SGUP1 (13)
24252 C DATA SGUP1 / 57, 5H*****, 5H TRAN, 5HSLATO, 5HR HAS, 5H USED
24253 C 1 , 5H UP I, 5HTS AL, 5HLOTED, 5H SPAC, 5HE FOR
24254 C 1 , 5H TABL, 2HES/
24300 C SGUP2 //***** TRANSLATION MUST TERMINATE IMMEDIATELY//
24301 DIMENSION SGUP2 (10)
24302 C DATA SGUP2 / 44, 5H*****, 5H TRAN, 5HSLATI, 5HON MU, 5HST TE
24303 C 1 , 5HRMINA, 5HTE IM, 5HMEDIA, 4HTELY/
24400 C SICOND //***** (CONDITIONAL OR SELECT IS APPARENTLY MISSING)//
24401 DIMENSION SICOND (12)
24402 C DATA SICOND / 54, 5H*****, 5H (, 5HCONDI, 5HTIONA, 5HL OR
24403 C 1 , 5HSELEC, 5HT IS , 5HAPPAR, 5HENTLY, 5H MISS
24404 C 1 , 4HING)/
24500 C SIELSE //***** (ELSE NECESSARY TO MATCH LINE //
24501 DIMENSION SIELSE (9)
24502 C DATA SIELSE / 39, 5H*****, 5H (, 5HELSE , 5HNECES, 5HSARY
24503 C 1 , 5HTO MA, 5HTCH L, 4HINE /
24600 C SIF // IF//
24601 DIMENSION SIF (3)
24602 C DATA SIF / 8, 5H , 3H IF/
24700 C SIFIN //***** (FIN NECESSARY TO MATCH LINE //
24701 DIMENSION SIFIN (9)
24702 C DATA SIFIN / 38, 5H*****, 5H (, 5HFIN N, 5HECESS, 5HARY T
24703 C 1 , 5HO MAT, 5HCH LI, 3HNE /
24750 C SIFIN2 //ASSUMED ABOVE)//
24751 DIMENSION SIFIN2 (4)
24752 C DATA SIFIN2 / 14, 5HASSUM, 5HED AB, 4HOVE)/
24850 C SIFP // IF(//
24851 DIMENSION SIFP (3)
24852 C DATA SIFP / 9, 5H , 4H IF(/
24900 C SIFPN // IF(.NOT.//
24901 DIMENSION SIFPN (4)
24902 C DATA SIFPN / 14, 5H , 5H IF(., 4HNOT./
25000 C SIGN //***** (NO CONTROL PHRASE FOR FIN TO MATCH)//
25001 DIMENSION SIGN (10)
25002 C DATA SIGN / 45, 5H*****, 5H (, 5HNO CO, 5HNTROL, 5H PHRA
25003 C 1 , 5HSE FO, 5HR FIN, 5H TO M, 5HATCH)/
25050 C SINSRT //***** STATEMENT(S) NEEDED BEFORE LINE //
25051 DIMENSION SINSRT (9)
25052 C DATA SINSRT / 38, 5H*****, 5H STAT, 5HEMENT, 5H(S) N, 5HEEDED
25053 C 1 , 5H BEFO, 5HRE LI, 3HNE /
25100 C SINS2 //ASSUMED BELOW//
25101 DIMENSION SINS2 (4)
25102 C DATA SINS2 / 13, 5HASSUM, 5HED BE, 3HLOW/
25150 C SITODM //***** (ONLY TO AND END ARE VALID AT THIS POINT)//
25151 DIMENSION SITODM (11)
25152 C DATA SITODM / 50, 5H*****, 5H (, 5HONLY , 5HTO AN, 5HD END
25153 C 1 , 5H ARE , 5HVALID, 5H AT T, 5HHIS P, 5HOINT)/
25200 C SIWHEN //***** (WHEN TO MATCH FOLLOWING ELSE)//
25201 DIMENSION SIWHEN (9)
25202 C DATA SIWHEN / 39, 5H*****, 5H (, 5HWHEN , 5HTO MA, 5HTCH F
25203 C 1 , 5HOLLOW, 5HING E, 4HLSE)/
25300 C SLP //(//
25301 DIMENSION SLP (2)
25302 C DATA SLP / 1, 1H(/
25400 C SNE //.NE.//
25401 DIMENSION SNE (2)
25402 C DATA SNE / 4, 4H.NE./
25500 C SOWSE //(OTHERWISE)//
25501 DIMENSION SOWSE (4)
25502 C DATA SOWSE / 11, 5H(OTHE, 5HRWISE, 1H)/
25600 C SPB //) //
25601 DIMENSION SPB (2)
25602 C DATA SPB / 2, 2H) /
25700 C SPGOTO //) GO TO //
25701 DIMENSION SPGOTO (3)
25702 C DATA SPGOTO / 8, 5H) GO , 3HTO /
25800 C SMULER //***** (PROCEDURE ALREADY DEFINED ON LINE //
25801 DIMENSION SMULER (10)
25802 C DATA SMULER / 44, 5H*****, 5H (, 5HPROCE, 5HDURE , 5HALREA
25803 C 1 , 5HDY DE, 5HFINED, 5H ON L, 4HINE /
25850 C SNDER1 //***** THE NEXT PROCEDURES WERE INVOKED ON//
25851 DIMENSION SNDER1 (10)
25852 C DATA SNDER1 / 42, 5H*****, 5H THE , 5HNEXT , 5H PROC, 5HEDURE
25853 C 1 , 5HS WER, 5HE INV, 5HOKED , 2HON/
25900 C SNDER2 //***** THE LINES GIVEN BUT WERE NEVER DEFINED//
25901 DIMENSION SNDER2 (10)
25902 C DATA SNDER2 / 44, 5H*****, 5H THE , 5HLINES, 5H GIVE, 5HN BUT
25903 C 1 , 5H WERE, 5H NEVE, 5HR DEF, 4HINED/
26000 C SNIER1 //***** THE FOLLOWING PROCEDURES WERE DEFINED ON//
26001 DIMENSION SNIER1 (11)
26002 C DATA SNIER1 / 46, 5H*****, 5H THE , 5HFOLLO, 5HWING , 5HPROCE
26003 C 1 , 5HDURES, 5H WERE, 5H DEFI, 5HNED O, 1HN/
26050 C SNIER2 //***** THE LINES GIVEN BUT WERE NEVER INVOKED//
26051 DIMENSION SNIER2 (10)
26052 C DATA SNIER2 / 44, 5H*****, 5H THE , 5HLINES, 5H GIVE, 5HN BUT
26053 C 1 , 5H WERE, 5H NEVE, 5HR INV, 4HOKED/
26200 C SRP //)//
26201 DIMENSION SRP (2)
26202 C DATA SRP / 1, 1H)/
26275 C SRPCI //), I//
26276 DIMENSION SRPCI (2)
26277 C DATA SRPCI / 4, 4H), I/
26300 C SRTN // RETURN//
26301 DIMENSION SRTN (4)
26302 C DATA SRTN / 12, 5H , 5H RETU, 2HRN/
26400 C SSPACR //. //
26401 DIMENSION SSPACR (2)
26402 C DATA SSPACR / 3, 3H. /
26500 C STABH // PROCEDURE CROSS-REFERENCE TABLE//
26501 DIMENSION STABH (9)
26502 C DATA STABH / 37, 5H , 5H PROC, 5HEDURE, 5H CROS, 5HS-REF
26503 C 1 , 5HERENC, 5HE TAB, 2HLE/
26550 C STODUM // TO DUMMY-PROCEDURE//
26551 DIMENSION STODUM (6)
26552 C DATA STODUM / 24, 5H , 5H TO D, 5HUMMY-, 5HPROCE, 4HDURE/
26700 C SSTOP // STOP//
26701 DIMENSION SSTOP (3)
26702 C DATA SSTOP / 10, 5H , 5H STOP/
26950 C SVER //(FLECS VERSION 22.35)//
26951 DIMENSION SVER (6)
26952 C DATA SVER / 21, 5H(FLEC, 5HS VER, 5HSION , 5H22.35, 1H)/
27100 C SWHEN // WHEN (.TRUE.) STOP//
27101 DIMENSION SWHEN (6)
27102 C DATA SWHEN / 24, 5H , 5H WHEN, 5H (.TR, 5HUE.) , 4HSTOP/
27350 C SXER1 //***** (INVALID CHARACTER IN STATEMENT NUMBER FIELD)//
27351 DIMENSION SXER1 (12)
27352 C DATA SXER1 / 54, 5H*****, 5H (, 5HINVAL, 5HID CH, 5HARACT
27353 C 1 , 5HER IN, 5H STAT, 5HEMENT, 5H NUMB, 5HER FI
27354 C 1 , 4HELD)/
27400 C SXER2 //***** (RECOGNIZABLE STATEMENT FOLLOWED BY GARBAGE)//
27401 DIMENSION SXER2 (12)
27402 C DATA SXER2 / 53, 5H*****, 5H (, 5HRECOG, 5HNIZAB, 5HLE ST
27403 C 1 , 5HATEME, 5HNT FO, 5HLLOWE, 5HD BY , 5HGARBA
27404 C 1 , 3HGE)/
27450 C SXER3 //***** (LEFT PAREN DOES NOT FOLLOW CONTROL WORD)//
27451 DIMENSION SXER3 (11)
27452 C DATA SXER3 / 50, 5H*****, 5H (, 5HLEFT , 5HPAREN, 5H DOES
27453 C 1 , 5H NOT , 5HFOLLO, 5HW CON, 5HTROL , 5HWORD)/
27500 C SXER4 //***** (MISSING RIGHT PAREN)//
27501 DIMENSION SXER4 (7)
27502 C DATA SXER4 / 30, 5H*****, 5H (, 5HMISSI, 5HNG RI, 5HGHT P
27503 C 1 , 5HAREN)/
27550 C SXER5 //***** (VALID PROCEDURE NAME DOES NOT FOLLOW TO)//
27551 DIMENSION SXER5 (11)
27552 C DATA SXER5 / 50, 5H*****, 5H (, 5HVALID, 5H PROC, 5HEDURE
27553 C 1 , 5H NAME, 5H DOES, 5H NOT , 5HFOLLO, 5HW TO)/
27650 C
27700 C THE FOLLWING ARRAYS HOLD STRINGS USED BY THE KEYWORD SCANNER
27750 C
27800 C KCOND //CONDITIONAL//
27801 DIMENSION KCOND (4)
27802 C DATA KCOND / 11, 5HCONDI, 5HTIONA, 1HL/
27850 C KDO //DO//
27851 DIMENSION KDO (2)
27852 C DATA KDO / 2, 2HDO/
27900 C KELSE //ELSE//
27901 DIMENSION KELSE (2)
27902 C DATA KELSE / 4, 4HELSE/
27950 C KEND //END//
27951 DIMENSION KEND (2)
27952 C DATA KEND / 3, 3HEND/
28000 C KFIN //FIN//
28001 DIMENSION KFIN (2)
28002 C DATA KFIN / 3, 3HFIN/
28050 C KIF //IF//
28051 DIMENSION KIF (2)
28052 C DATA KIF / 2, 2HIF/
28100 C KREPT //REPEAT//
28101 DIMENSION KREPT (3)
28102 C DATA KREPT / 6, 5HREPEA, 1HT/
28150 C KSELCT //SELECT//
28151 DIMENSION KSELCT (3)
28152 C DATA KSELCT / 6, 5HSELEC, 1HT/
28200 C KTO //TO//
28201 DIMENSION KTO (2)
28202 C DATA KTO / 2, 2HTO/
28250 C KUNLES //UNLESS//
28251 DIMENSION KUNLES (3)
28252 C DATA KUNLES / 6, 5HUNLES, 1HS/
28300 C KUNTIL //UNTIL//
28301 DIMENSION KUNTIL (2)
28302 C DATA KUNTIL / 5, 5HUNTIL/
28350 C KWHEN //WHEN//
28351 DIMENSION KWHEN (2)
28352 C DATA KWHEN / 4, 4HWHEN/
28400 C KWHILE //WHILE//
28401 DIMENSION KWHILE (2)
28402 C DATA KWHILE / 5, 5HWHILE/
30001 DATA FORTCL /1/, LISTCL /2/, ERRCL /3/
30002 DATA ACSEQ/1/, AELSE/2/, AFSEQ/3/, AGCONT/4/, AGGOTO/5/
30003 DATA AGSTNO/6/, AMSEQ/7/, AGRET/8/, ASSEQ/9/, ATSEQ/10/
30004 DATA UEXP/1/, UFORT/2/, UOWSE/3/, UPINV/4/, UDO/5/
30005 DATA TLETTR/1/, TDIGIT/2/, THYPHN/3/, TLP/4/, TRP/5/
30006 DATA TBLANK/6/, TOTHER/7/, TEOL/8/
30007 DATA TCEXP/1/, TELSE/2/, TEND/3/, TEXEC/4/, TFIN/5/, TTO/6/
30008 DATA TCOND/1/, TDO/2/, TFORT/3/, TIF/4/, TINVOK/5/, TRUNTL/6/
30009 DATA TRWHIL/7/, TSELCT/8/, TUNLES/9/, TUNTIL/10/, TWHEN/11/
30010 DATA TWHILE/12/
30011 DATA SETUP /1/, RETRY /2/, READ /3/
30012 DATA CHC /67/
30013 DATA LWIDTH /132/
30014 DATA MAXSTK /2000/
30015 DATA NCHPWD /5/
30016 DATA PRIME /53/
30017 DATA SAFETY /35/
30018 DATA SEEDNO /100000/
30019 DATA LONG /.FALSE./
30020 DATA SHORT /.TRUE./
30021 DATA FAKE /.FALSE./
30022 DATA COGOTO /.FALSE./
30023 DATA CHSPAC /32/
30024 DATA CHZERO /48/
30025 DATA SSTMAX /200/
30026 DATA SASSN1 / 13, 5H , 5H ASSI, 3HGN /
30027 DATA SASSN2 / 5, 5H TO I/
30028 DATA SB / 1, 1H /
30029 DATA SB2 / 2, 2H /
30030 DATA SB4 / 4, 4H /
30031 DATA SB5 / 5, 5H /
30032 DATA SB5I1 / 6, 5H , 1H1/
30033 DATA SB6 / 6, 5H , 1H /
30034 DATA SB7 / 7, 5H , 2H /
30035 DATA SB6I / 7, 5H , 2H I/
30036 DATA SBGOTO / 7, 5H GO T, 2HO /
30037 DATA SCOMMA / 1, 1H,/
30038 DATA SCOND / 17, 5H , 5H COND, 5HITION, 2HAL/
30039 DATA SCONT / 8, 5HCONTI, 3HNUE/
30040 DATA SCP / 2, 2H,(/
30041 DATA SDOST / 9, 5H , 4H DO /
30042 DATA SDASH / 40, 5H-----, 5H-----, 5H-----, 5H-----, 5H-----
30043 1 , 5H-----, 5H-----, 5H-----/
30044 DATA SDUM / 15, 5HDUMMY, 5H-PROC, 5HEDURE/
30045 DATA SELSE / 19, 5H , 5H ELSE, 5H CONT, 4HINUE/
30046 DATA SEND / 9, 5H , 4H END/
30047 DATA SENDER / 30, 5H*****, 5H END , 5HSTATE, 5HMENT , 5HIS MI
30048 1 , 5HSSING/
30049 DATA SFIN / 9, 5H , 4H FIN/
30050 DATA SEQ / 1, 1H=/
30051 DATA SFORCE / 14, 5H , 5H CONT, 4HINUE/
30052 DATA SFSPCR / 3, 3H.../
30053 DATA SGOTO / 12, 5H , 5H GO T, 2HO /
30054 DATA SGOTOI / 13, 5H , 5H GO T, 3HO I/
30055 DATA SGOTOP / 13, 5H , 5H GO T, 3HO (/
30056 DATA SGUP1 / 57, 5H*****, 5H TRAN, 5HSLATO, 5HR HAS, 5H USED
30057 1 , 5H UP I, 5HTS AL, 5HLOTED, 5H SPAC, 5HE FOR
30058 1 , 5H TABL, 2HES/
30059 DATA SGUP2 / 44, 5H*****, 5H TRAN, 5HSLATI, 5HON MU, 5HST TE
30060 1 , 5HRMINA, 5HTE IM, 5HMEDIA, 4HTELY/
30061 DATA SICOND / 54, 5H*****, 5H (, 5HCONDI, 5HTIONA, 5HL OR
30062 1 , 5HSELEC, 5HT IS , 5HAPPAR, 5HENTLY, 5H MISS
30063 1 , 4HING)/
30064 DATA SIELSE / 39, 5H*****, 5H (, 5HELSE , 5HNECES, 5HSARY
30065 1 , 5HTO MA, 5HTCH L, 4HINE /
30066 DATA SIF / 8, 5H , 3H IF/
30067 DATA SIFIN / 38, 5H*****, 5H (, 5HFIN N, 5HECESS, 5HARY T
30068 1 , 5HO MAT, 5HCH LI, 3HNE /
30069 DATA SIFIN2 / 14, 5HASSUM, 5HED AB, 4HOVE)/
30070 DATA SIFP / 9, 5H , 4H IF(/
30071 DATA SIFPN / 14, 5H , 5H IF(., 4HNOT./
30072 DATA SIGN / 45, 5H*****, 5H (, 5HNO CO, 5HNTROL, 5H PHRA
30073 1 , 5HSE FO, 5HR FIN, 5H TO M, 5HATCH)/
30074 DATA SINSRT / 38, 5H*****, 5H STAT, 5HEMENT, 5H(S) N, 5HEEDED
30075 1 , 5H BEFO, 5HRE LI, 3HNE /
30076 DATA SINS2 / 13, 5HASSUM, 5HED BE, 3HLOW/
30077 DATA SITODM / 50, 5H*****, 5H (, 5HONLY , 5HTO AN, 5HD END
30078 1 , 5H ARE , 5HVALID, 5H AT T, 5HHIS P, 5HOINT)/
30079 DATA SIWHEN / 39, 5H*****, 5H (, 5HWHEN , 5HTO MA, 5HTCH F
30080 1 , 5HOLLOW, 5HING E, 4HLSE)/
30081 DATA SLP / 1, 1H(/
30082 DATA SNE / 4, 4H.NE./
30083 DATA SOWSE / 11, 5H(OTHE, 5HRWISE, 1H)/
30084 DATA SPB / 2, 2H) /
30085 DATA SPGOTO / 8, 5H) GO , 3HTO /
30086 DATA SMULER / 44, 5H*****, 5H (, 5HPROCE, 5HDURE , 5HALREA
30087 1 , 5HDY DE, 5HFINED, 5H ON L, 4HINE /
30088 DATA SNDER1 / 42, 5H*****, 5H THE , 5HNEXT , 5H PROC, 5HEDURE
30089 1 , 5HS WER, 5HE INV, 5HOKED , 2HON/
30090 DATA SNDER2 / 44, 5H*****, 5H THE , 5HLINES, 5H GIVE, 5HN BUT
30091 1 , 5H WERE, 5H NEVE, 5HR DEF, 4HINED/
30092 DATA SNIER1 / 46, 5H*****, 5H THE , 5HFOLLO, 5HWING , 5HPROCE
30093 1 , 5HDURES, 5H WERE, 5H DEFI, 5HNED O, 1HN/
30094 DATA SNIER2 / 44, 5H*****, 5H THE , 5HLINES, 5H GIVE, 5HN BUT
30095 1 , 5H WERE, 5H NEVE, 5HR INV, 4HOKED/
30096 DATA SRP / 1, 1H)/
30097 DATA SRPCI / 4, 4H), I/
30098 DATA SRTN / 12, 5H , 5H RETU, 2HRN/
30099 DATA SSPACR / 3, 3H. /
30100 DATA STABH / 37, 5H , 5H PROC, 5HEDURE, 5H CROS, 5HS-REF
30101 1 , 5HERENC, 5HE TAB, 2HLE/
30102 DATA STODUM / 24, 5H , 5H TO D, 5HUMMY-, 5HPROCE, 4HDURE/
30103 DATA SSTOP / 10, 5H , 5H STOP/
30104 DATA SVER / 21, 5H(FLEC, 5HS VER, 5HSION , 5H22.35, 1H)/
30105 DATA SWHEN / 24, 5H , 5H WHEN, 5H (.TR, 5HUE.) , 4HSTOP/
30106 DATA SXER1 / 54, 5H*****, 5H (, 5HINVAL, 5HID CH, 5HARACT
30107 1 , 5HER IN, 5H STAT, 5HEMENT, 5H NUMB, 5HER FI
30108 1 , 4HELD)/
30109 DATA SXER2 / 53, 5H*****, 5H (, 5HRECOG, 5HNIZAB, 5HLE ST
30110 1 , 5HATEME, 5HNT FO, 5HLLOWE, 5HD BY , 5HGARBA
30111 1 , 3HGE)/
30112 DATA SXER3 / 50, 5H*****, 5H (, 5HLEFT , 5HPAREN, 5H DOES
30113 1 , 5H NOT , 5HFOLLO, 5HW CON, 5HTROL , 5HWORD)/
30114 DATA SXER4 / 30, 5H*****, 5H (, 5HMISSI, 5HNG RI, 5HGHT P
30115 1 , 5HAREN)/
30116 DATA SXER5 / 50, 5H*****, 5H (, 5HVALID, 5H PROC, 5HEDURE
30117 1 , 5H NAME, 5H DOES, 5H NOT , 5HFOLLO, 5HW TO)/
30118 DATA KCOND / 11, 5HCONDI, 5HTIONA, 1HL/
30119 DATA KDO / 2, 2HDO/
30120 DATA KELSE / 4, 4HELSE/
30121 DATA KEND / 3, 3HEND/
30122 DATA KFIN / 3, 3HFIN/
30123 DATA KIF / 2, 2HIF/
30124 DATA KREPT / 6, 5HREPEA, 1HT/
30125 DATA KSELCT / 6, 5HSELEC, 1HT/
30126 DATA KTO / 2, 2HTO/
30127 DATA KUNLES / 6, 5HUNLES, 1HS/
30128 DATA KUNTIL / 5, 5HUNTIL/
30129 DATA KWHEN / 4, 4HWHEN/
30130 DATA KWHILE / 5, 5HWHILE/
30341 C
30342 C---------------------------------------
30343 C
30344 C MAIN PROGRAM
30345 C
30350 PERFORM-INITIALIZATION
30400 REPEAT UNTIL (DONE)
30700 CALLNO=CALLNO+1
30750 CALL OPENF(CALLNO,DONE,SVER)
30900 UNLESS (DONE)
30950 ENDFIL=.FALSE.
30960 MINCNT=0
30961 MAJCNT=0
30975 LINENO=0
31000 REPEAT UNTIL (ENDFIL)
31050 PREPARE-TO-PROCESS-PROGRAM
31100 PROCESS-PROGRAM
31150 FIN
31200 CALL CLOSEF(MINCNT,MAJCNT)
31250 FIN
31300 FIN
31315 CALL EXIT
31700 TO ANALYZE-ERRORS-AND-LIST
31800 CONDITIONAL
31850 (SOURCE.EQ.SETUP) SOURCE=RETRY
31900 (ERROR.EQ.0.AND.ERSTOP.EQ.0)
31950 SOURCE=READ
32000 LIST-FLEX
32050 FIN
32100 (OTHERWISE)
32150 MINER=(((ERROR.GE.5).AND.(ERROR.LE.6)).OR.
32200 1 ((ERROR.GE.13).AND.(ERROR.LE.15)))
32225 MINER=MINER.OR.((ERROR.GE.1).AND.(ERROR.LE.3))
32250 WHEN (MINER) MINCNT=MINCNT+1
32300 ELSE MAJCNT=MAJCNT+1
32350 WHEN (ERROR.EQ.0) ERTYPE=1
32400 ELSE
32450 CONDITIONAL
32500 (ERROR.LE.3) INSERT-FIN
32550 (ERROR.EQ.4) INSERT-ELSE
32600 (ERROR.LE.6) ERTYPE=3
32650 (ERROR.EQ.7) INSERT-ELSE
32700 (ERROR.EQ.8) INSERT-WHEN
32750 (ERROR.EQ.9) INSERT-TO-DUMMY-PROCEDURE
32800 (ERROR.EQ.10) INSERT-WHEN-OR-FIN
32850 (ERROR.LE.12) INSERT-FIN
32900 (ERROR.LE.15) INSERT-FIN
32950 (ERROR.EQ.16) INSERT-ELSE
33000 (ERROR.EQ.17) INSERT-CONDITIONAL
33050 (ERROR.EQ.18) INSERT-TO-DUMMY-PROCEDURE
33100 (ERROR.LE.19) INSERT-CONDITIONAL
33150 (ERROR.EQ.20) INSERT-ELSE
33200 (ERROR.EQ.21) INSERT-TO-DUMMY-PROCEDURE
33250 (ERROR.LE.23) INSERT-FIN
33300 (ERROR.EQ.24) INSERT-ELSE
33350 (ERROR.EQ.25) ERTYPE=4
33400 (ERROR.EQ.26) ERTYPE=5
33450 FIN
33500 FIN
33550 SOURCE=READ
33600 SELECT (ERTYPE)
33650 (1)
33700 CALL PUT(-LINENO,SHOLD,ERRCL)
33750 DO (I=1,ERSTOP)
33800 SELECT (ERRSTK(I))
33850 (1) CALL PUT(0,SXER1,ERRCL)
33900 (2) CALL PUT(0,SXER2,ERRCL)
33950 (3) CALL PUT(0,SXER3,ERRCL)
34000 (4) CALL PUT(0,SXER4,ERRCL)
34050 (5) CALL PUT(0,SXER5,ERRCL)
34100 FIN
34150 FIN
34200 FIN
34250 (2) SOURCE=SETUP
34300 (3)
34350 CALL PUT(-LINENO,SFLX,ERRCL)
34400 CALL PUT(0,SIGN,ERRCL)
34450 FIN
34500 (4) CALL PUT(0,SENDER,ERRCL)
34550 (5)
34600 CALL PUT(LINENO,SFLX,ERRCL)
34650 CALL CPYSTR(SST,SMULER)
34700 CALL CATNUM(SST,MLINE)
34750 CALL CATSTR(SST,SRP)
34800 CALL PUT(0,SST,ERRCL)
34850 FIN
34900 FIN
34950 FIN
35000 FIN
35050 IF (ENDPGM)
35100 PROCESS-TABLE
35150 LIST-BLANK-LINE
35200 CALL PUT(0,SVER,LISTCL)
35250 FIN
35350 FIN
35750 TO ANALYZE-NEXT-STATEMENT
35850 SELECT (SOURCE)
35900 (READ) READ-NEXT-STATEMENT
35950 (SETUP) CONTINUE
36000 (RETRY)
36050 LINENO=HOLDNO
36100 CALL CPYSTR(SFLX,SHOLD)
36150 FIN
36200 FIN
36250 ERROR=0
36300 SAVED=.FALSE.
36350 NUNITS=0
36400 ERSTOP=0
36450 CURSOR=0
36500 CWD=2
36550 CPOS=0
36600 CLASS=0
36650 SCAN-STATEMENT-NUMBER
36700 SCAN-CONTINUATION
36750 WHEN (CONT.OR.PASS)
36800 CLASS=TEXEC
36850 EXTYPE=TFORT
36900 FIN
36950 ELSE SCAN-KEYWORD
37000 SELECT (CLASS)
37050 (TEXEC)
37100 SELECT (EXTYPE)
37150 (TFORT) CONTINUE
37200 (TINVOK) SCAN-GARBAGE
37250 (TCOND) SCAN-GARBAGE
37300 (TSELCT)
37350 SCAN-CONTROL
37400 IF(NUNITS.GT.1)
37450 NUNITS=1
37500 CURSOR=USTART(2)
37550 RESET-GET-CHARACTER
37600 SCAN-GARBAGE
37650 FIN
37700 FIN
37750 (OTHERWISE) SCAN-CONTROL
37800 FIN
37850 FIN
37900 (TFIN) SCAN-GARBAGE
37950 (TEND) CONTINUE
38000 (TELSE) SCAN-PINV-OR-FORT
38050 (TTO)
38100 CSAVE=CURSOR
38150 SCAN-PINV
38200 WHEN(FOUND) SCAN-PINV-OR-FORT
38250 ELSE
38300 ERSTOP=ERSTOP+1
38350 ERRSTK(ERSTOP)=5
38400 SAVE-ORIGINAL-STATEMENT
38450 SFLX(1)=CSAVE
38500 CALL CATSTR(SFLX,SDUM)
38550 CURSOR=CSAVE
38600 RESET-GET-CHARACTER
38650 SCAN-PINV
38700 FIN
38750 FIN
38800 (TCEXP) SCAN-CONTROL
38850 FIN
38900 IF(ERSTOP.GT.0) CLASS=0
38950 LSTLEV=LEVEL
39050 FIN
39150 TO COMPILE-CEXP
39200 GENERATE-BRANCH-AROUND-AND-ESTABLISH-NEXT-NUMBER
39250 SET-UP-STATEMENT-NUMBER
39300 WHEN (UTYPE(1).EQ.UEXP)
39350 GOTONO=NEWNO(0)
39400 STACK(TOP-2)=GOTONO
39450 PUT-IF-NOT-GOTO
39500 FIN
39550 ELSE STACK(TOP-2)=0
39822 COMPLETE-ACTION
39850 FIN
39900 TO COMPILE-CONDITIONAL
39950 TOP=TOP+4
40000 STACK(TOP)=ACSEQ
40050 STACK(TOP-1)=LINENO
40100 STACK(TOP-2)=0
40150 STACK(TOP-3)=0
40200 LEVEL=LEVEL+1
40250 SET-UP-STATEMENT-NUMBER
40300 FIN
40350 TO COMPILE-DO
40400 CONTNO=NEWNO(0)
40450 PUSH-GCONT
40500 CALL CPYSTR(SST,SDOST)
40550 CALL CATNUM(SST,CONTNO)
40600 CALL CATSTR(SST,SB)
40650 CALL CATSUB(SST,SFLX,USTART(1)+1,ULEN(1)-2)
40700 STNO=FLXNO
40750 FLXNO=0
40800 PUT-STATEMENT
40850 COMPLETE-ACTION
40900 FIN
40950 TO COMPILE-ELSE
41000 TOP=TOP-2
41050 SET-UP-STATEMENT-NUMBER
41100 WHEN (NUNITS.EQ.1)
41150 WHEN (UTYPE(1).EQ.UPINV) COMPILE-INVOKE
41203 ELSE
41204 CALL CPYSUB(SST,SFLX,USTART(1),ULEN(1))
41205 UNLESS (STREQ(SST,SCONT)) COMPILE-FORTRAN
41206 FIN
41250 FIN
41300 ELSE PUSH-FINSEQ
41350 FIN
41400 TO COMPILE-END
41450 SORT-TABLE
41500 IF (LONG.OR.COGOTO) GENERATE-PROCEDURE-DISPATCH-AREA
41800 PUT-COPY
41900 IF (ENDFIL) ERROR=25
41950 ENDPGM=.TRUE.
42000 FIN
42050 TO COMPILE-EXEC
42100 SELECT (EXTYPE)
42150 (TFORT) PUT-COPY
42200 (TIF) COMPILE-IF
42250 (TUNLES) COMPILE-UNLESS
42300 (TWHEN) COMPILE-WHEN
42350 (TWHILE) COMPILE-WHILE
42400 (TUNTIL) COMPILE-UNTIL
42450 (TRWHIL) COMPILE-RWHILE
42500 (TRUNTL) COMPILE-RUNTIL
42550 (TINVOK) COMPILE-INVOKE
42600 (TCOND) COMPILE-CONDITIONAL
42650 (TSELCT) COMPILE-SELECT
42700 (TDO) COMPILE-DO
42750 FIN
42800 FIN
42850 TO COMPILE-FORTRAN
42900 STNO=FLXNO
42950 CALL CPYSTR(SST,SB6)
43000 WHEN (UTYPE(1).EQ.UFORT) J=1
43050 ELSE J=2
43100 CALL CATSUB(SST,SFLX,USTART(J),ULEN(J))
43150 PUT-STATEMENT
43200 FIN
43250 TO COMPILE-IF
43300 WHEN (NUNITS.EQ.2.AND.UTYPE(2).EQ.UFORT) PUT-COPY
43350 ELSE FINISH-IF-UNLESS
43400 FIN
43450 TO COMPILE-INVOKE
43500 FIND-ENTRY
43550 ENTNO=STACK(PENT+1)
43600 RETNO=NEWNO(0)
43650 MAX=MAX-(1+OFFSET)
43700 STACK(MAX+1)=STACK(PENT+3)
43750 STACK(PENT+3)=MAX+1
43800 STACK(MAX+2)=LINENO
43850 IF (LONG.OR.COGOTO) STACK(MAX+3)=RETNO
43852 WHEN (COGOTO)
43854 STACK(PENT-2)=STACK(PENT-2)+1
43856 CALL CPYSTR(SST,SB6I)
43858 CALL CATNUM(SST,ENTNO)
43860 CALL CATSTR(SST,SEQ)
43862 CALL CATNUM(SST,STACK(PENT-2))
43864 FIN
43866 ELSE
43900 CALL CPYSTR(SST,SASSN1)
43950 CALL CATNUM(SST,RETNO)
44000 CALL CATSTR(SST,SASSN2)
44050 CALL CATNUM(SST,ENTNO)
44052 FIN
44100 STNO=FLXNO
44150 PUT-STATEMENT
44200 GOTONO=ENTNO
44250 PUT-GOTO
44300 NEXTNO=RETNO
44350 FIN
44400 TO COMPILE-RUNTIL
44450 NOTFLG=.FALSE.
44500 COMPILE-RWHILE
44550 FIN
44600 TO COMPILE-RWHILE
44650 SET-UP-STATEMENT-NUMBER
44700 TESTNO=NEWNO(0)
44750 TOPNO=NEWNO(0)
44800 ENDNO=NEWNO(0)
44850 GOTONO=TOPNO
44900 PUT-GOTO
44950 STNO=TESTNO
45000 GOTONO=ENDNO
45050 PUT-IF-NOT-GOTO
45100 GSTNO=ENDNO
45150 PUSH-GSTNO
45200 GGOTON=TESTNO
45250 PUSH-GGOTO
45300 NEXTNO=TOPNO
45350 COMPLETE-ACTION
45400 FIN
45450 TO COMPILE-SELECT
45500 SET-UP-STATEMENT-NUMBER
45550 LEVEL=LEVEL+1
45600 L=(ULEN(1)-1)/NCHPWD+6
45650 TOP=TOP+L+1
45700 WHEN (TOP+SAFETY.LT.MAX)
45750 STACK(TOP)=ASSEQ
45800 STACK(TOP-1)=LINENO
45850 STACK(TOP-2)=0
45900 STACK(TOP-3)=0
45950 STACK(TOP-4)=L
46000 STACK(TOP-L)=0
46050 CALL CATSUB(STACK(TOP-L),SFLX,USTART(1),ULEN(1))
46100 FIN
46150 ELSE GIVE-UP
46200 FIN
46250 TO COMPILE-SEQ-FIN
46300 LEVEL=LEVEL-1
46350 SET-UP-STATEMENT-NUMBER
46400 STNO=STACK(TOP-2)
46450 UNLESS (STNO.EQ.0) PUT-CONTINUE
46500 FORCE-NEXT-NUMBER
46550 NEXTNO=STACK(TOP-3)
46600 POP-STACK
46650 FIN
46700 TO COMPILE-SEXP
46750 GENERATE-BRANCH-AROUND-AND-ESTABLISH-NEXT-NUMBER
46800 SET-UP-STATEMENT-NUMBER
46850 WHEN (UTYPE(1).EQ.UEXP)
46900 CALL CPYSTR(SST,SIFP)
46950 CALL CATSUB(SST,SFLX,USTART(1),ULEN(1))
47000 CALL CATSTR(SST,SNE)
47050 I=STACK(TOP-4)
47100 CALL CATSTR(SST,STACK(TOP-I))
47150 CALL CATSTR(SST,SPGOTO)
47200 NXIFNO=NEWNO(0)
47250 STACK(TOP-2)=NXIFNO
47300 CALL CATNUM(SST,NXIFNO)
47350 STNO=0
47400 PUT-STATEMENT
47450 FIN
47500 ELSE STACK(TOP-2)=0
47550 COMPLETE-ACTION
47600 FIN
47650 TO COMPILE-SIMPLE-FIN
47700 SET-UP-STATEMENT-NUMBER
47750 LEVEL=LEVEL-1
47800 TOP=TOP-2
47850 FIN
47900 TO COMPILE-TO
47950 FIND-ENTRY
48000 WHEN(STACK(PENT+2).NE.0)
48050 ERROR=26
48100 MLINE=STACK(PENT+2)
48150 ENTNO=NEWNO(0)
48200 FIN
48250 ELSE
48300 ENTNO=STACK(PENT+1)
48350 STACK(PENT+2)=LINENO
48400 FIN
48450 SET-UP-STATEMENT-NUMBER
48500 FORCE-NEXT-NUMBER
48550 NEXTNO=ENTNO
48570 FORCE-NEXT-NUMBER
48600 TOP=TOP+2
48650 STACK(TOP)=AGRET
48700 WHEN (SHORT.OR.FAKE) STACK(TOP-1)=ENTNO
48750 ELSE STACK(TOP-1)=STACK(PENT-1)
48800 UTYPE(1)=0
48850 COMPLETE-ACTION
48900 FIN
48950 TO COMPILE-UNLESS
49000 WHEN (NUNITS.EQ.2.AND.UTYPE(2).EQ.UFORT)
49050 CALL CPYSTR(SST,SIFPN)
49100 CALL CATSUB(SST,SFLX,USTART(1),ULEN(1))
49150 CALL CATSTR(SST,SPB)
49200 CALL CATSUB(SST,SFLX,USTART(2),ULEN(2))
49250 STNO=FLXNO
49300 PUT-STATEMENT
49350 FIN
49400 ELSE
49450 NOTFLG=.FALSE.
49500 FINISH-IF-UNLESS
49550 FIN
49600 FIN
49650 TO COMPILE-UNTIL
49700 NOTFLG=.FALSE.
49750 COMPILE-WHILE
49800 FIN
49850 TO COMPILE-WHEN
49900 ENDNO=NEWNO(0)
49950 ELSNO=NEWNO(0)
50000 GSTNO=ENDNO
50050 PUSH-GSTNO
50100 TOP=TOP+2
50150 STACK(TOP-1)=LINENO
50200 STACK(TOP)=AELSE
50250 GSTNO=ELSNO
50300 PUSH-GSTNO
50350 GGOTON=ENDNO
50400 PUSH-GGOTO
50450 GOTONO=ELSNO
50500 STNO=FLXNO
50550 FLXNO=0
50600 PUT-IF-NOT-GOTO
50650 COMPLETE-ACTION
50700 FIN
50750 TO COMPILE-WHILE
50800 CONDITIONAL
50850 (FLXNO.NE.0)
50900 LOOPNO=FLXNO
50950 FLXNO=0
51000 FIN
51050 (NEXTNO.NE.0)
51100 LOOPNO=NEXTNO
51150 NEXTNO=0
51200 FIN
51250 (OTHERWISE)
51300 LOOPNO=NEWNO(0)
51350 FIN
51400 FIN
51450 ENDNO=NEWNO(0)
51500 GSTNO=ENDNO
51550 PUSH-GSTNO
51600 GGOTON=LOOPNO
51650 PUSH-GGOTO
51700 GOTONO=ENDNO
51750 STNO=LOOPNO
51800 PUT-IF-NOT-GOTO
51850 COMPLETE-ACTION
51900 FIN
51950 TO COMPLETE-ACTION
52000 CONDITIONAL
52050 (NUNITS.EQ.1) PUSH-FINSEQ
52100 (UTYPE(2).EQ.UPINV) COMPILE-INVOKE
52170 (OTHERWISE)
52171 CALL CPYSUB(SST,SFLX,USTART(2),ULEN(2))
52172 UNLESS (STREQ(SST,SCONT)) COMPILE-FORTRAN
52173 FIN
52200 FIN
52250 FIN
52300 TO FIND-ENTRY
52350 WHEN (UTYPE(1).EQ.UPINV) J=1
52400 ELSE J=2
52450 CALL CPYSUB(SPINV,SFLX,USTART(J),ULEN(J))
52500 WHEN (STREQ(SPINV,SDUM))
52550 PENT=PDUMMY
52600 STACK(PENT+2)=0
52650 FIN
52700 ELSE
52750 P=MAXSTK-HASH(SPINV,PRIME)
52800 FOUND=.FALSE.
52850 UNLESS(STACK(P).EQ.0)
52900 REPEAT UNTIL(STACK(P).EQ.0.OR.FOUND)
52950 P=STACK(P)
53000 IF (STREQ(SPINV,STACK(P+4))) FOUND=.TRUE.
53050 FIN
53100 FIN
53150 WHEN (FOUND) PENT=P
53200 ELSE
53250 TMAX=MAX-(4+OFFST2+(SPINV(1)+NCHPWD-1)/NCHPWD)
53300 WHEN (TMAX.LE.TOP+SAFETY)
53350 PENT=PDUMMY
53400 STACK(PENT+2)=0
53450 FIN
53500 ELSE
53550 MAX=TMAX
53600 PENT=MAX+OFFST2
53650 IF (LONG.OR.COGOTO) STACK(PENT-1)=NEWNO(0)
53652 IF (COGOTO) STACK(PENT-2)=0
53700 STACK(PENT)=0
53750 STACK(P)=PENT
53800 STACK(PENT+1)=NEWNO(0)
53850 STACK(PENT+2)=0
53900 STACK(PENT+3)=0
53950 CALL CPYSTR(STACK(PENT+4),SPINV)
54000 FIN
54050 FIN
54100 FIN
54150 FIN
54200 TO FINISH-IF-UNLESS
54250 GOTONO=NEWNO(0)
54300 STNO=FLXNO
54325 FLXNO=0
54350 PUT-IF-NOT-GOTO
54400 GSTNO=GOTONO
54450 PUSH-GSTNO
54500 COMPLETE-ACTION
54550 FIN
54600 TO FORCE-NEXT-NUMBER
54650 IF (NEXTNO.NE.0)
54700 CALL PUTNUM(SFORCE,NEXTNO)
54750 CALL PUT(LINENO,SFORCE,FORTCL)
54800 NEXTNO=0
54850 FIN
54900 FIN
54950 TO GENERATE-BRANCH-AROUND-AND-ESTABLISH-NEXT-NUMBER
55000 ENDNO=STACK(TOP-3)
55050 WHEN (ENDNO.EQ.0)
55100 STACK(TOP-3)=NEWNO(0)
55150 FIN
55200 ELSE
55250 GOTONO=ENDNO
55300 PUT-GOTO
55350 FIN
55400 CONDITIONAL
55450 (NEXTNO.EQ.0) NEXTNO=STACK(TOP-2)
55500 (STACK(TOP-2).EQ.0) CONTINUE
55550 (OTHERWISE)
55600 FORCE-NEXT-NUMBER
55650 NEXTNO=STACK(TOP-2)
55700 FIN
55750 FIN
55800 FIN
56150 TO GENERATE-CONTINUE
56200 STNO=STACK(TOP-1)
56250 PUT-CONTINUE
56300 TOP=TOP-2
56350 FIN
56400 TO GENERATE-GOTO
56450 GOTONO=STACK(TOP-1)
56500 PUT-GOTO
56550 TOP=TOP-2
56600 FIN
56650 TO GENERATE-PROCEDURE-DISPATCH-AREA
56700 P=PTABLE
56750 UNTIL (P.EQ.0)
56800 WHEN (STACK(P+2).NE.0)
56825 WHEN (LONG)
56850 CALL CPYSTR(SST,SGOTOI)
56900 CALL CATNUM(SST,STACK(P+1))
56950 CALL CATSTR(SST,SCP)
56960 FIN
56970 ELSE CALL CPYSTR(SST,SGOTOP)
57000 Q=STACK(P+3)
57050 STNO=STACK(P-1)
57100 WHEN(Q.EQ.0) CALL CATNUM(SST,STACK(P+1))
57150 ELSE
57200 REPEAT UNTIL (Q.EQ.0)
57250 IF (SST(1).GT.SSTMAX-6)
57300 PUT-STATEMENT
57350 CALL CPYSTR(SST,SB5I1)
57400 FIN
57450 CALL CATNUM(SST,STACK(Q+2))
57500 CALL CATSTR(SST,SCOMMA)
57550 Q=STACK(Q)
57600 FIN
57650 SST(1)=SST(1)-1
57700 FIN
57750 WHEN (LONG) CALL CATSTR(SST,SRP)
57760 ELSE
57762 IF(SST(1).GT.SSTMAX-9)
57764 PUT-STATEMENT
57766 CALL CPYSTR(SST,SB5I1)
57768 FIN
57770 CALL CATSTR(SST,SRPCI)
57780 CALL CATNUM(SST,STACK(P+1))
57790 FIN
57800 PUT-STATEMENT
57850 FIN
57900 ELSE
57950 CALL CPYSTR(SST,SSTOP)
58000 STNO=STACK(P+1)
58050 PUT-STATEMENT
58100 FIN
58150 P=STACK(P)
58200 FIN
58250 FIN
58300 TO GENERATE-RETURN-FROM-PROC
58350 STNO=0
58400 CALL CPYSTR(SST,SGOTOI)
58450 IF (LONG.OR.COGOTO) SST(1)=SST(1)-1
58500 CALL CATNUM(SST,STACK(TOP-1))
58530 IF (FAKE)
58532 CALL CATSTR(SST,SCP)
58534 CALL CATNUM(SST,STACK(TOP-1))
58536 CALL CATSTR(SST,SRP)
58538 FIN
58550 PUT-STATEMENT
58600 TOP=TOP-2
58650 FIN
58700 TO GENERATE-STATEMENT-NUMBER
58750 FORCE-NEXT-NUMBER
58800 NEXTNO=STACK(TOP-1)
58850 TOP=TOP-2
58900 FIN
59000 TO GET-CHARACTER
59050 CURSOR=CURSOR+1
59100 CPOS=CPOS+1
59150 IF (CPOS.GT.NCHPWD)
59200 CWD=CWD+1
59250 CPOS=1
59300 FIN
59350 WHEN(CURSOR.GT.SFLX(1)) CHTYPE=TEOL
59400 ELSE
59450 CALL GETCH(SFLX(CWD),CPOS,CH)
59500 CHTYPE=CHTYP(CH)
59550 FIN
59600 FIN
59700 TO GIVE-UP
59750 CALL PUT(0,SGUP1,ERRCL)
59800 CALL PUT(0,SGUP2,ERRCL)
59850 CALL CLOSEF(MINCNT,-1)
59900 C THE FOLLOWING KLUDGE KEEPS MANY FORTRAN COMPILERS HAPPY
59950 C SINCE FLECS GENERATES A GOTO AT THE END OF THIS PROCEDURE
60200 IF (.TRUE.) CALL EXIT
60350 FIN
60450 TO INSERT-CONDITIONAL
60500 PREPARE-FOR-INSERTION
60550 CALL CPYSTR(SFLX,SCOND)
60600 CALL PUT(0,SICOND,ERRCL)
60650 FIN
60700 TO INSERT-ELSE
60750 PREPARE-FOR-INSERTION
60800 CALL CPYSTR(SFLX,SELSE)
60850 CALL CPYSTR(SLIST,SIELSE)
60900 CALL CATNUM(SLIST,STACK(TOP-1))
60950 CALL CATSTR(SLIST,SRP)
61000 CALL PUT(0,SLIST,ERRCL)
61050 FIN
61100 TO INSERT-FIN
61150 PREPARE-FOR-INSERTION
61200 CALL CPYSTR(SFLX,SFIN)
61250 CALL CPYSTR(SLIST,SIFIN)
61300 WHEN (STACK(TOP-1).EQ.0) CALL CATSTR(SLIST,SIFIN2)
61350 ELSE
61400 CALL CATNUM(SLIST,STACK(TOP-1))
61450 CALL CATSTR(SLIST,SRP)
61500 FIN
61550 CALL PUT(0,SLIST,ERRCL)
61600 FIN
61650 TO INSERT-TO-DUMMY-PROCEDURE
61700 PREPARE-FOR-INSERTION
61750 CALL CPYSTR(SFLX,STODUM)
61800 CALL PUT(0,SITODM,ERRCL)
61850 FIN
61900 TO INSERT-WHEN
61950 PREPARE-FOR-INSERTION
62000 CALL CPYSTR(SFLX,SWHEN)
62050 CALL PUT(0,SIWHEN,ERRCL)
62100 FIN
62105 TO INSERT-WHEN-OR-FIN
62106 CONDITIONAL
62107 (TOP.LE.7) INSERT-WHEN
62108 (STACK(TOP-6).EQ.AELSE) INSERT-FIN
62109 (OTHERWISE) INSERT-WHEN
62110 FIN
62111 FIN
62200 TO LIST-BLANK-LINE
62220 LSTLEV=LEVEL
62250 WHEN (LSTLEV.EQ.0) CALL PUT(BLN,SB,LISTCL)
62300 ELSE
62350 CALL CPYSTR(SLIST,SB6)
62400 DO (I=1,LSTLEV) CALL CATSTR(SLIST,SSPACR)
62450 WHEN (SLIST(1).GT.WWIDTH) CALL PUT(BLN,SP,LISTCL)
62500 ELSE CALL PUT(BLN,SLIST,LISTCL)
62550 FIN
62600 BLN=0
62650 FIN
62750 TO LIST-COMMENT-LINE
62800 CURSOR=1
62850 RESET-GET-CHARACTER
62900 INDENT=.TRUE.
62950 I=2
63000 REPEAT WHILE (I.LE.6.AND.INDENT)
63050 GET-CHARACTER
63100 IF (CHTYPE.NE.TBLANK.AND.CHTYPE.NE.TEOL) INDENT=.FALSE.
63150 I=I+1
63200 FIN
63250 WHEN (INDENT)
63300 LSTLEV=LEVEL
63325 CLASS=0
63350 LIST-FLEX
63450 FIN
63500 ELSE CALL PUT(LINENO,SFLX,LISTCL)
63550 FIN
63650 TO LIST-DASHES
63700 CALL PUT(0,SB,LISTCL)
63750 CALL PUT(0,SDASH,LISTCL)
63800 CALL PUT(0,SB,LISTCL)
63850 FIN
63950 TO LIST-FLEX
64000 IF (CLASS.EQ.TTO) LIST-DASHES
64050 IF (SFLX(1).LT.7) CALL CATSTR(SFLX,SB7)
64100 CALL CPYSUB(SLIST,SFLX,1,6)
64150 UNLESS(LSTLEV.EQ.0)
64200 DO (I=1,LSTLEV) CALL CATSTR(SLIST,SSPACR)
64250 FIN
64300 IF(CLASS.EQ.TFIN)
64350 SLIST(1)=SLIST(1)-SSPACR(1)
64400 CALL CATSTR(SLIST,SFSPCR)
64450 FIN
64500 CALL CATSUB(SLIST,SFLX,7,SFLX(1)-6)
64550 IF (SLIST(1).GT.WWIDTH) CALL CPYSTR(SLIST,SFLX)
64600 WHEN (ERLST)
64650 CALL PUT(LINENO,SLIST,ERRCL)
64700 ERLST=.FALSE.
64750 FIN
64800 ELSE CALL PUT(LINENO,SLIST,LISTCL)
64850 FIN
64950 TO PERFORM-INITIALIZATION
65200 CALLNO=0
65350 PARAM1=NCHPWD
65400 PARAM2=CHZERO
65450 PARAM3=CHSPAC
65500 PARAM4=CHC
65650 BLN=0
65700 WWIDTH=LWIDTH-6
65750 REFNO=(LWIDTH-12)/7
65800 CONDITIONAL
65805 (SHORT.OR.FAKE)
65810 OFFSET=1
65815 OFFST2=1
65820 FIN
65825 (COGOTO)
65830 OFFSET=2
65835 OFFST2=3
65840 FIN
65845 (OTHERWISE)
65850 OFFSET=2
65855 OFFST2=3
65860 FIN
65865 FIN
65900 NOTFLG=.TRUE.
65950 ERLST=.FALSE.
66000 FIN
66050 TO POP-STACK
66100 TOPTYP=STACK(TOP)
66150 SELECT (TOPTYP)
66200 (ASSEQ) TOP=TOP-STACK(TOP-4)-1
66250 (ACSEQ) TOP=TOP-4
66300 (AGGOTO) TOP=TOP-2
66350 (AGCONT) TOP=TOP-2
66400 (AFSEQ) TOP=TOP-2
66450 (AELSE) TOP=TOP-2
66500 (AGSTNO) TOP=TOP-2
66550 (ATSEQ) TOP=TOP-1
66600 (AMSEQ) TOP=TOP-1
66650 (AGRET) TOP=TOP-2
66700 FIN
66750 FIN
66850 TO PREPARE-FOR-INSERTION
66900 ERTYPE=2
66950 SAVE-ORIGINAL-STATEMENT
67000 LINENO=0
67050 IF (SOURCE.EQ.READ)
67100 CALL CPYSTR(SST,SINSRT)
67150 WHEN (HOLDNO.GT.0) CALL CATNUM(SST,HOLDNO)
67200 ELSE CALL CATSTR(SST,SINS2)
67250 CALL PUT(0,SST,ERRCL)
67300 FIN
67350 FIN
67450 TO PREPARE-TO-PROCESS-PROGRAM
67500 DUMMY=NEWNO(SEEDNO)
67550 ENDPGM=.FALSE.
67600 MAX=MAXSTK-(PRIME+OFFSET+3)
67650 PDUMMY=MAX+OFFSET
67700 DO (I=MAX,MAXSTK) STACK(I)=0
67750 TOP=1
67800 STACK(TOP)=AMSEQ
67900 ERROR=0
67950 FIRST=.TRUE.
68000 NOPGM=.FALSE.
68025 NEXTNO=0
68050 SOURCE=READ
68150 LEVEL=0
68200 LSTLEV=0
68250 LIST-DASHES
68300 FIN
68350 TO PROCESS-PROGRAM
68400 REPEAT UNTIL (ENDPGM)
68450 IF(TOP+SAFETY.GT.MAX) GIVE-UP
68500 ACTION=STACK(TOP)
68550 SELECT (ACTION)
68600 (AGGOTO) GENERATE-GOTO
68650 (AGRET) GENERATE-RETURN-FROM-PROC
68700 (AGCONT) GENERATE-CONTINUE
68750 (AGSTNO) GENERATE-STATEMENT-NUMBER
68800 (OTHERWISE)
68900 ANALYZE-NEXT-STATEMENT
69100 SELECT (ACTION)
69150 (AFSEQ)
69200 SELECT(CLASS)
69250 (TEXEC) COMPILE-EXEC
69300 (TFIN) COMPILE-SIMPLE-FIN
69350 (TEND) ERROR=1
69400 (TELSE) ERROR=10
69450 (TTO) ERROR=13
69500 (TCEXP) ERROR=19
69550 FIN
69600 FIN
69650 (AMSEQ)
69700 SELECT(CLASS)
69750 (TEXEC) COMPILE-EXEC
69800 (TEND)
69850 WHEN (NOPGM) ENDPGM=.TRUE.
69900 ELSE COMPILE-END
69950 FIN
70000 (TFIN) ERROR=5
70050 (TELSE) ERROR=8
70100 (TTO)
70200 STACK(TOP)=ATSEQ
70250 COMPILE-TO
70300 FIN
70350 (TCEXP) ERROR=17
70400 FIN
70450 FIN
70500 (ASSEQ)
70550 SELECT (CLASS)
70600 (TCEXP) COMPILE-SEXP
70650 (TFIN) COMPILE-SEQ-FIN
70700 (TEND) ERROR=3
70750 (TELSE) ERROR=12
70800 (TTO) ERROR=15
70850 (TEXEC) ERROR=23
70900 FIN
70950 FIN
71000 (ACSEQ)
71050 SELECT(CLASS)
71100 (TCEXP) COMPILE-CEXP
71150 (TFIN) COMPILE-SEQ-FIN
71200 (TEND) ERROR=2
71250 (TELSE) ERROR=11
71300 (TTO) ERROR=14
71350 (TEXEC) ERROR=22
71400 FIN
71450 FIN
71500 (AELSE)
71550 SELECT(CLASS)
71600 (TELSE) COMPILE-ELSE
71650 (TEND) ERROR=4
71700 (TFIN) ERROR=7
71750 (TTO) ERROR=16
71800 (TCEXP) ERROR=20
71850 (TEXEC) ERROR=24
71900 FIN
71950 FIN
72000 (ATSEQ)
72050 SELECT (CLASS)
72100 (TTO) COMPILE-TO
72150 (TEND) COMPILE-END
72200 (TFIN) ERROR=6
72250 (TELSE) ERROR=9
72300 (TCEXP) ERROR=18
72350 (TEXEC) ERROR=21
72400 FIN
72450 FIN
72500 FIN
72600 UNLESS (NOPGM) ANALYZE-ERRORS-AND-LIST
72800 FIN
72850 FIN
72900 FIN
72950 FIN
73050 TO PROCESS-TABLE
73100 UNLESS (PTABLE.EQ.0)
73150 TABLCL=LISTCL
73200 LIST-DASHES
73250 CALL PUT(0,STABH,LISTCL)
73300 CALL PUT(0,SB,LISTCL)
73350 P=PTABLE
73400 NDERR=.FALSE.
73450 NIERR=.FALSE.
73500 REPEAT UNTIL (P.EQ.0)
73551 IF (STACK(P+2).EQ.0)
73552 NDERR=.TRUE.
73553 MAJCNT=MAJCNT+1
73554 FIN
73601 IF (STACK(P+3).EQ.0)
73602 NIERR=.TRUE.
73603 MINCNT=MINCNT+1
73604 FIN
73750 PRODUCE-ENTRY-LISTING
73800 P=STACK(P)
73850 FIN
73900 IF (NDERR)
73950 CALL PUT(0,SNDER1,ERRCL)
74000 CALL PUT(0,SNDER2,ERRCL)
74050 LIST-BLANK-LINE
74100 P=PTABLE
74150 TABLCL=ERRCL
74200 REPEAT UNTIL (P.EQ.0)
74250 IF (STACK(P+2).EQ.0) PRODUCE-ENTRY-LISTING
74300 P=STACK(P)
74350 FIN
74400 FIN
74450 IF (NIERR)
74500 CALL PUT(0,SNIER1,ERRCL)
74550 CALL PUT(0,SNIER2,ERRCL)
74600 LIST-BLANK-LINE
74650 P=PTABLE
74700 TABLCL=ERRCL
74750 REPEAT UNTIL (P.EQ.0)
74800 IF(STACK(P+3).EQ.0) PRODUCE-ENTRY-LISTING
74850 P=STACK(P)
74900 FIN
74950 FIN
75000 FIN
75050 FIN
75100 TO PRODUCE-ENTRY-LISTING
75150 CALL CPYSTR(SST,SB6)
75200 UNLESS (STACK(P+2).EQ.0) CALL PUTNUM(SST,STACK(P+2))
75250 CALL CATSTR(SST,STACK(P+4))
75300 CALL PUT(0,SST,TABLCL)
75350 QP=STACK(P+3)
75400 UNTIL (QP.EQ.0)
75450 CALL CPYSTR(SST,SB4)
75500 I=1
75550 UNTIL(QP.EQ.0.OR.I.GT.REFNO)
75600 CALL CATSTR(SST,SB2)
75650 CALL CATNUM(SST,STACK(QP+1))
75700 I=I+1
75750 QP=STACK(QP)
75800 FIN
75850 CALL PUT(0,SST,TABLCL)
75900 FIN
75950 CALL PUT(0,SB,LISTCL)
76000 FIN
76100 TO PUSH-FINSEQ
76150 TOP=TOP+2
76200 STACK(TOP-1)=LINENO
76250 STACK(TOP)=AFSEQ
76300 LEVEL=LEVEL+1
76350 FIN
76400 TO PUSH-GCONT
76450 TOP=TOP+2
76500 STACK(TOP-1)=CONTNO
76550 STACK(TOP)=AGCONT
76600 FIN
76650 TO PUSH-GGOTO
76700 TOP=TOP+2
76750 STACK(TOP-1)=GGOTON
76800 STACK(TOP)=AGGOTO
76850 FIN
76900 TO PUSH-GSTNO
76950 TOP=TOP+2
77000 STACK(TOP-1)=GSTNO
77050 STACK(TOP)=AGSTNO
77100 FIN
77150 TO PUT-CONTINUE
77200 FORCE-NEXT-NUMBER
77250 CALL PUTNUM(SFORCE,STNO)
77300 CALL PUT(LINENO,SFORCE,FORTCL)
77350 STNO=0
77400 FIN
77450 TO PUT-COPY
77500 CONDITIONAL
77550 (NEXTNO.EQ.0) CALL PUT(LINENO,SFLX,FORTCL)
77600 (FLXNO.NE.0.OR.PASS)
77650 FORCE-NEXT-NUMBER
77700 CALL PUT(LINENO,SFLX,FORTCL)
77850 FIN
77900 (OTHERWISE)
77925 CALL CPYSTR(SST,SFLX)
77950 CALL PUTNUM(SST,NEXTNO)
77975 CALL PUT(LINENO,SST,FORTCL)
78000 NEXTNO=0
78050 FIN
78100 FIN
78150 FIN
78200 TO PUT-GOTO
78250 CALL CPYSTR(SPUTGO,SGOTO)
78300 CALL CATNUM(SPUTGO,GOTONO)
78350 IF (NEXTNO.NE.0)
78400 CALL PUTNUM(SPUTGO,NEXTNO)
78450 NEXTNO=0
78500 FIN
78550 CALL PUT(LINENO,SPUTGO,FORTCL)
78600 FIN
78650 TO PUT-IF-NOT-GOTO
78700 WHEN(NOTFLG) CALL CPYSTR(SST,SIFPN)
78750 ELSE CALL CPYSTR(SST,SIF)
78800 CALL CATSUB(SST,SFLX,USTART(1),ULEN(1))
78850 WHEN (NOTFLG) CALL CATSTR(SST,SPGOTO)
78900 ELSE CALL CATSTR(SST,SBGOTO)
78950 CALL CATNUM(SST,GOTONO)
79000 PUT-STATEMENT
79050 NOTFLG=.TRUE.
79100 FIN
79150 TO PUT-STATEMENT
79200 UNLESS (NEXTNO.EQ.0)
79250 WHEN (STNO.EQ.0)
79300 STNO=NEXTNO
79350 NEXTNO=0
79400 FIN
79450 ELSE FORCE-NEXT-NUMBER
79500 FIN
79550 UNLESS (STNO.EQ.0)
79600 CALL PUTNUM(SST,STNO)
79650 STNO=0
79700 FIN
79750 WHEN (SST(1).LE.72) CALL PUT(LINENO,SST,FORTCL)
79800 ELSE
79850 CALL CPYSUB (SLIST,SST,1,72)
79900 CALL PUT(LINENO,SLIST,FORTCL)
79950 S=73
80000 L=66
80050 REPEAT UNTIL (S.GT.SST(1))
80100 IF(S+L-1.GT.SST(1)) L=SST(1)-S+1
80150 CALL CPYSTR(SLIST,SB5I1)
80200 CALL CATSUB(SLIST,SST,S,L)
80250 CALL PUT(LINENO,SLIST,FORTCL)
80300 S=S+66
80350 FIN
80400 FIN
80450 FIN
80550 TO READ-NEXT-STATEMENT
80600 REPEAT UNTIL (FOUND)
80650 CALL GET(LINENO,SFLX,ENDFIL)
80700 IF (FIRST)
80750 FIRST=.FALSE.
80800 IF(ENDFIL) NOPGM=.TRUE.
80850 FIN
80900 IF (ENDFIL)
80950 CALL CPYSTR(SFLX,SEND)
81000 LINENO=0
81050 FIN
81100 CALL GETCH(SFLX(2),1,CH)
81150 CONDITIONAL
81200 (SFLX(1).EQ.0)
81250 BLN=LINENO
81300 LIST-BLANK-LINE
81350 FOUND=.FALSE.
81400 FIN
81450 (CH.EQ.CHC)
81500 LIST-COMMENT-LINE
81550 FOUND=.FALSE.
81600 FIN
81650 (OTHERWISE) FOUND=.TRUE.
81700 FIN
81750 FIN
81800 FIN
81850 TO RESET-GET-CHARACTER
81900 CURSOR=CURSOR-1
81950 CWD=(CURSOR-1)/NCHPWD+2
82000 CPOS=CURSOR-(CWD-2)*NCHPWD
82050 GET-CHARACTER
82100 FIN
82200 TO REVERSE-LIST
82250 LL=0
82300 LR=STACK(LP)
82350 UNTIL (LR.EQ.0)
82400 LT=STACK(LR)
82450 STACK(LR)=LL
82500 LL=LR
82550 LR=LT
82600 FIN
82650 STACK(LP)=LL
82700 FIN
82800 TO SAVE-ORIGINAL-STATEMENT
82850 UNLESS (SAVED)
82900 SAVED=.TRUE.
82950 HOLDNO=LINENO
83000 CALL CPYSTR(SHOLD,SFLX)
83050 FIN
83100 FIN
83200 TO SCAN-CONTINUATION
83250 GET-CHARACTER
83300 CONDITIONAL
83350 (CHTYPE.EQ.TEOL) CONT=.FALSE.
83400 (CH.EQ.CHZERO.OR.CH.EQ.CHSPAC) CONT=.FALSE.
83450 (OTHERWISE) CONT=.TRUE.
83500 FIN
83550 FIN
83600 TO SCAN-CONTROL
83650 WHILE (CHTYPE.EQ.TBLANK) GET-CHARACTER
83700 START=CURSOR
83750 IF (CHTYPE.NE.TLP)
83800 ERSTOP=ERSTOP+1
83850 ERRSTK(ERSTOP)=3
83900 SAVE-ORIGINAL-STATEMENT
83950 CALL CPYSTR(SST,SFLX)
84000 SFLX(1)=START-1
84050 CALL CATSTR(SFLX,SLP)
84100 CALL CATSUB(SFLX,SST,START,SST(1)-START-1)
84150 FIN
84200 PCNT=1
84250 FOUND=.TRUE.
84300 REPEAT UNTIL (PCNT.EQ.0.OR..NOT.FOUND)
84350 GET-CHARACTER
84400 SELECT (CHTYPE)
84450 (TRP) PCNT=PCNT-1
84500 (TLP) PCNT=PCNT+1
84550 (TEOL) FOUND=.FALSE.
84600 FIN
84650 FIN
84700 UNLESS (FOUND)
84750 ERSTOP=ERSTOP+1
84800 ERRSTK(ERSTOP)=4
84850 SAVE-ORIGINAL-STATEMENT
84900 DO (I=1,PCNT) CALL CATSTR(SFLX,SRP)
84950 CURSOR=SFLX(1)
85000 RESET-GET-CHARACTER
85050 FIN
85100 GET-CHARACTER
85150 NUNITS=NUNITS+1
85200 UTYPE(NUNITS)=UEXP
85250 USTART(NUNITS)=START
85300 ULEN(NUNITS)=CURSOR-START
85350 CALL CPYSUB(SST,SFLX,START,CURSOR-START)
85400 IF(STREQ(SST,SOWSE)) UTYPE(NUNITS)=UOWSE
85450 SCAN-PINV-OR-FORT
85500 FIN
85550 TO SCAN-GARBAGE
85600 WHILE (CHTYPE.EQ.TBLANK) GET-CHARACTER
85650 IF(CHTYPE.NE.TEOL)
85700 ERSTOP=ERSTOP+1
85750 ERRSTK(ERSTOP)=2
85800 SAVE-ORIGINAL-STATEMENT
85850 SFLX(1)=CURSOR-1
85900 FIN
85950 FIN
86000 TO SCAN-KEYWORD
86050 GET-CHARACTER
86100 WHILE (CHTYPE.EQ.TBLANK) GET-CHARACTER
86150 SELECT (CHTYPE)
86200 (TLETTR)
86250 START=CURSOR
86300 INVOKE=.FALSE.
86350 BADCH=.FALSE.
86400 REPEAT UNTIL (BADCH)
86450 GET-CHARACTER
86500 CONDITIONAL
86550 (CHTYPE.LE.TDIGIT) CONTINUE
86600 (CHTYPE.EQ.THYPHN) INVOKE=.TRUE.
86650 (OTHERWISE) BADCH=.TRUE.
86700 FIN
86750 FIN
86800 LEN=CURSOR-START
86850 WHEN (INVOKE)
86900 CLASS=TEXEC
86950 EXTYPE=TINVOK
87000 NUNITS=1
87050 UTYPE(1)=UPINV
87100 USTART(1)=START
87150 ULEN(1)=LEN
87200 FIN
87250 ELSE
87300 CALL CPYSUB(SST,SFLX,START,LEN)
87350 CLASS=TEXEC
87400 EXTYPE=TFORT
87450 SELECT (SST(1))
87500 (2)
87550 CONDITIONAL
87600 (STREQ(SST,KIF)) EXTYPE=TIF
87650 (STREQ(SST,KTO)) CLASS=TTO
87700 (STREQ(SST,KDO))
87750 WHILE(CHTYPE.EQ.TBLANK) GET-CHARACTER
87800 WHEN (CHTYPE.EQ.TDIGIT) EXTYPE=TFORT
87850 ELSE EXTYPE=TDO
87900 FIN
87950 FIN
88000 FIN
88050 (3)
88100 CONDITIONAL
88150 (STREQ(SST,KFIN)) CLASS=TFIN
88200 (STREQ(SST,KEND))
88250 IF (CHTYPE.EQ.TEOL) CLASS=TEND
88300 FIN
88350 FIN
88400 FIN
88450 (4)
88500 CONDITIONAL
88550 (STREQ(SST,KWHEN)) EXTYPE=TWHEN
88600 (STREQ(SST,KELSE)) CLASS=TELSE
88650 FIN
88700 FIN
88750 (5)
88800 CONDITIONAL
88850 (STREQ(SST,KWHILE)) EXTYPE=TWHILE
88900 (STREQ(SST,KUNTIL)) EXTYPE=TUNTIL
88950 FIN
89000 FIN
89050 (6)
89100 CONDITIONAL
89150 (STREQ(SST,KREPT))
89200 WHILE(CHTYPE.EQ.TBLANK) GET-CHARACTER
89250 START=CURSOR
89300 WHILE(CHTYPE.EQ.TLETTR) GET-CHARACTER
89350 LEN=CURSOR-START
89400 CALL CPYSUB(SST,SFLX,START,LEN)
89450 CONDITIONAL
89500 (STREQ(SST,KWHILE)) EXTYPE=TRWHIL
89550 (STREQ(SST,KUNTIL)) EXTYPE=TRUNTL
89600 FIN
89650 FIN
89700 (STREQ(SST,KSELCT)) EXTYPE=TSELCT
89750 (STREQ(SST,KUNLES)) EXTYPE=TUNLES
89800 FIN
89850 FIN
89900 (11)
89950 IF (STREQ(SST,KCOND)) EXTYPE=TCOND
90000 FIN
90050 FIN
90100 FIN
90150 FIN
90200 (TLP) CLASS=TCEXP
90250 (OTHERWISE)
90300 CLASS=TEXEC
90350 EXTYPE=TFORT
90400 FIN
90450 FIN
90500 FIN
90550 TO SCAN-PINV
90600 WHILE(CHTYPE.EQ.TBLANK) GET-CHARACTER
90650 FOUND=.FALSE.
90700 IF(CHTYPE.EQ.TLETTR)
90750 START=CURSOR
90800 REPEAT UNTIL (CHTYPE.GT.THYPHN)
90850 GET-CHARACTER
90900 IF(CHTYPE.EQ.THYPHN) FOUND=.TRUE.
90950 FIN
91000 FIN
91050 IF (FOUND)
91100 NUNITS=NUNITS+1
91150 UTYPE(NUNITS)=UPINV
91200 USTART(NUNITS)=START
91250 ULEN(NUNITS)=CURSOR-START
91300 FIN
91350 FIN
91400 TO SCAN-PINV-OR-FORT
91450 WHILE (CHTYPE.EQ.TBLANK) GET-CHARACTER
91500 UNLESS (CHTYPE.EQ.TEOL)
91550 CSAVE=CURSOR
91600 SCAN-PINV
91650 WHEN(FOUND) SCAN-GARBAGE
91700 ELSE
91750 NUNITS=NUNITS+1
91800 UTYPE(NUNITS)=UFORT
91850 USTART(NUNITS)=CSAVE
91900 ULEN(NUNITS)=SFLX(1)+1-CSAVE
91950 FIN
92000 FIN
92050 FIN
92100 TO SCAN-STATEMENT-NUMBER
92150 FLXNO=0
92175 PASS=.FALSE.
92200 DO (I=1,5)
92250 GET-CHARACTER
92300 SELECT (CHTYPE)
92350 (TBLANK) CONTINUE
92400 (TDIGIT) FLXNO=FLXNO*10+CH-CHZERO
92450 (TEOL) CONTINUE
92500 (OTHERWISE) PASS=.TRUE.
92800 FIN
92850 FIN
93300 FIN
93400 TO SET-UP-STATEMENT-NUMBER
93450 IF (FLXNO.NE.0)
93500 FORCE-NEXT-NUMBER
93550 NEXTNO=FLXNO
93600 FLXNO=0
93650 FIN
93700 FIN
93750 TO SORT-TABLE
93800 P=MAX
93850 STACK(MAX)=0
93900 ITEMP=MAXSTK-PRIME+1
93950 DO (I=ITEMP,MAXSTK)
94000 UNLESS (STACK(I).EQ.0)
94050 STACK(P)=STACK(I)
94100 REPEAT UNTIL (STACK(P).EQ.0)
94110 P=STACK(P)
94120 LP=P+3
94130 REVERSE-LIST
94140 FIN
94150 FIN
94200 FIN
94250 Q=MAX-1
94300 STACK(Q)=0
94350 UNTIL (STACK(MAX).EQ.0)
94400 P=STACK(MAX)
94450 STACK(MAX)=STACK(P)
94500 QM=Q
94550 QP=STACK(QM)
94600 INSERT=.FALSE.
94650 UNTIL (INSERT)
94700 CONDITIONAL
94720 (QP.EQ.0) INSERT=.TRUE.
94740 (STRLT(STACK(P+4),STACK(QP+4))) INSERT=.TRUE.
94760 (OTHERWISE)
94780 QM=QP
94800 QP=STACK(QM)
94820 FIN
94840 FIN
94860 FIN
94880 STACK(P)=QP
94900 STACK(QM)=P
95200 FIN
95250 PTABLE=STACK(Q)
95300 FIN
95400 END