---------------------------------------- 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) ----------------------------------------