Google
 

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