Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
decus/20-0124/10c.lst
There is 1 other file named 10c.lst 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
----------------------------------------
PROCEDURE CROSS-REFERENCE TABLE
31700 ANALYZE-ERRORS-AND-LIST
72600
35750 ANALYZE-NEXT-STATEMENT
68900
39150 COMPILE-CEXP
71100
39900 COMPILE-CONDITIONAL
42600
40350 COMPILE-DO
42700
40950 COMPILE-ELSE
71600
41400 COMPILE-END
69900 72150
42050 COMPILE-EXEC
69250 69750
42850 COMPILE-FORTRAN
41205 52172
43250 COMPILE-IF
42200
43450 COMPILE-INVOKE
41150 42550 52100
44400 COMPILE-RUNTIL
42500
44600 COMPILE-RWHILE
42450 44500
45450 COMPILE-SELECT
42650
46250 COMPILE-SEQ-FIN
70650 71150
46700 COMPILE-SEXP
70600
47650 COMPILE-SIMPLE-FIN
69300
47900 COMPILE-TO
70250 72100
48950 COMPILE-UNLESS
42250
49650 COMPILE-UNTIL
42400
49850 COMPILE-WHEN
42300
50750 COMPILE-WHILE
42350 49750
51950 COMPLETE-ACTION
39822 40850 45350 47550 48850 50650 51850 54500
52300 FIND-ENTRY
43500 47950
54200 FINISH-IF-UNLESS
43350 49500
54600 FORCE-NEXT-NUMBER
46500 48500 48570 55600 58750 77200 77650 79450 93500
54950 GENERATE-BRANCH-AROUND-AND-ESTABLISH-NEXT-NUMBER
39200 46750
56150 GENERATE-CONTINUE
68700
56400 GENERATE-GOTO
68600
56650 GENERATE-PROCEDURE-DISPATCH-AREA
41500
58300 GENERATE-RETURN-FROM-PROC
68650
58700 GENERATE-STATEMENT-NUMBER
68750
59000 GET-CHARACTER
63050 82050 83250 83650 84350 85100 85600 86050 86100 86450 87750 89200 89300 90600 90850 91450 92250
59700 GIVE-UP
46150 68450
60450 INSERT-CONDITIONAL
33000 33100
60700 INSERT-ELSE
32550 32650 32950 33150 33300
61100 INSERT-FIN
32500 32850 32900 33250 62108
61650 INSERT-TO-DUMMY-PROCEDURE
32750 33050 33200
61900 INSERT-WHEN
32700 62107 62109
62105 INSERT-WHEN-OR-FIN
32800
62200 LIST-BLANK-LINE
35150 74050 74600 81300
62750 LIST-COMMENT-LINE
81500
63650 LIST-DASHES
64000 68250 73200
63950 LIST-FLEX
32000 63350
64950 PERFORM-INITIALIZATION
30350
66050 POP-STACK
46600
66850 PREPARE-FOR-INSERTION
60500 60750 61150 61700 61950
67450 PREPARE-TO-PROCESS-PROGRAM
31050
68350 PROCESS-PROGRAM
31100
73050 PROCESS-TABLE
35100
75100 PRODUCE-ENTRY-LISTING
73750 74250 74800
76100 PUSH-FINSEQ
41300 52050
76400 PUSH-GCONT
40450
76650 PUSH-GGOTO
45250 50400 51650
76900 PUSH-GSTNO
45150 50050 50300 51550 54450
77150 PUT-CONTINUE
46450 56250
77450 PUT-COPY
41800 42150 43300
78200 PUT-GOTO
44250 44900 55300 56500
78650 PUT-IF-NOT-GOTO
39450 45050 50600 51800 54350
79150 PUT-STATEMENT
40800 43150 44150 47400 49300 57300 57764 57800 58050 58550 79000
80550 READ-NEXT-STATEMENT
35900
81850 RESET-GET-CHARACTER
37550 38600 62850 85000
82200 REVERSE-LIST
94130
82800 SAVE-ORIGINAL-STATEMENT
38400 66950 83900 84850 85800
83200 SCAN-CONTINUATION
36700
83600 SCAN-CONTROL
37350 37750 38800
85550 SCAN-GARBAGE
37200 37250 37600 37900 91650
86000 SCAN-KEYWORD
36950
90550 SCAN-PINV
38150 38650 91600
91400 SCAN-PINV-OR-FORT
38000 38200 85450
92100 SCAN-STATEMENT-NUMBER
36650
93400 SET-UP-STATEMENT-NUMBER
39250 40250 41050 44650 45500 46350 46800 47700 48450
93750 SORT-TABLE
41450
(FLECS VERSION 22.35)
----------------------------------------