(FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00001 M,M/-SP=M 00001 C;+ 00002 C - . . . F L E 00003 C****NAME: PROGRAM FLECS (...FLE) 00004 C IDENT: /30JUN1/ 00005 C FILE: [201,13]M.FLX 00006 C TKB: [201,13]FLETKB.CMD 00007 C 00008 C****PURPOSE: FLECS FORTRAN PREPROCESSOR 00009 C 00010 C****RESTRICTIONS: 00011 C 00012 C SYSTEM: RSX11M V3.2 00013 C LANGUAGE: FLECS/FORTRAN 00014 C AUTHOR: TERRY BEYER 00015 C DATE: 20-NOV-74 00016 C REVISIONS: 00017 C 11-SEP-75 (MK) COMMENT OUT PROCEDURE "GENERATE-PROCEDURE-DISPATCH- 00018 C AREA" & ITS CALL IN "COMPILE-END" TO SHORTEN FLECS. 00019 C SEE NOTE 1. CHANGE MARGINS. SEE NOTE 2. 00020 C 25-JAN-80 (MAO) DEFINE "!" AS IN-LINE COMMENT CHAR; PUT IN /PARAM/. 00021 C 26-JAN-80 (MAO) ADDED COMMENTS 00022 C 20-FEB-80 (MAO) ADD CODE FOR ALECS; NOTE ALL ALECS LINES ARE DELIMITED 00023 C C 00024 C C ALECS VVVVV 00025 C ALECS CODE 00026 C C ALECS ^^^^^ 00027 C C 00028 C IF YOU DO NOT WANT ALECS, SIMPLY COMMENT OUT THE DELIMITED LINES. 00029 C 00030 C 30-APR-80 (MAO) REPLACE "CALL EXIT" BY "CALL EXFLE" 00031 C CONVERT FROM 11D TO 11M 00032 C 22-JUN-81 (MAO) ENABLE FLECS DIRECTIVES 00033 C 22-JUN-81 (MAO) ADD .PAGE DIRECTIVE 00034 C 26-JUN-81 (MAO) FOR # IN COL 1, REPLACE BY BLANK FOR FTN FILE 00035 C 29-JUN-81 (MAO) ADD .INCLUDE DIRECTIVE 00036 C 30-JUN-81 (MAO) ADD .PASSx AND .NAME DIRECTIVES 00037 C 00038 C****CALLING SEQUENCE: MCR>FLE OUT/[-]FU,LIST/[-]SP=IN 00039 C 00040 C INPUT: 00041 C 00042 C IN =NAME OF FILE CONTAINING FLECS SOURCE (DEFAULT EXTENSION=.FLX). 00043 C 00044 C OUTPUT: 00045 C 00046 C LIST =NAME OF FILE TO RECEIVE FLECS LISTING, OPTIONAL. THE SWITCH 00047 C /SP OR /-SP [DEFAULT] MAY ALSO BE GIVEN FOR SPOOLING/NO 00048 C SPOOLING OF OUTPUT (DEFAULT EXTENSION=.FLL). 00049 C OUT =NAME OF FILE TO RECEIVE FORTRAN OUTPUT, OPTIONAL. THE SWITCH 00050 C /FU OR /-FU [DEFAULT] MAY ALSO BE GIVEN. /FU PUTS ALL COMMENT 00051 C LINES AND FLECS LINES (AS COMMENTS) INTO THE OUTPUT FTN FILE 00052 C (DEFAULT EXTENSION=.FTN). 00053 C 00054 C CMN BLOCK I/O: BLANK COMMON, /PARAM/ 00055 C (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00002 M,M/-SP=M 00056 C****DIALOG: NONE 00057 C 00058 C RESOURCES: 00059 C LIBRARIES: NONE 00060 C OTHER SUBR: [201,13]ANALYZ,CATNUM,CATSTR,CATSUB,CLOSEF,CPYSTR,CPYSUB 00061 C EXFLE,HASH,LIST,NEWNO,OPENF,PUT,PUTNUM,STREQ, 00062 C STRLT 00063 C ALEBRI,ALEDO,ALEINV,ALERTS,ALESXP,LAMPFI, 00064 C PUTLBL,PUTLOG 00065 C DISK FILES: FILES SPECIFIED IN INPUT LINE 00066 C DEVICES: TI:1:2, DISK:3:4:5 00067 C SGAS: NONE 00068 C EVENT FLAGS: NONE 00069 C SYSTEM DIR: NONE 00070 C LENGTH/PAR: 00071 C 00072 C****NOTES: 00073 C 1. IN ORDER TO SHORTEN THE TRANSLATOR, THE PROCEDURE "GENERATE- 00074 C PROCEDURE-DISPATCH-AREA" AND ITS CALL IN "COMPILE-END" HAVE BEEN 00075 C COMMENTED OUT. THEY MUST BE RE-INSTATED IF IT IS DESIRED TO 00076 C GENERATE A TRANSLATOR THAT WILL GENERATE LONG OR COMPUTED PRO- 00077 C CEDURE LINKAGES (LONG=.TRUE. OR COGOTO=.TRUE.). 00078 C 00079 C 2. THE NUMBER OF COLUMNS ALLOWED IN THE LISTING FOR MARGIN AND LINE 00080 C NUMBER HAS BEEN INCREASED FROM 6 TO 10. THIS AFFECTS THE COM- 00081 C PUTATION OF "WWIDTH" AND "REFNO" IN "PERFORM-INITIALIZATION". 00082 C 00083 C;- 00084 PROGRAM FLECS 00085 C 00086 C MAIN PROGRAM FOR FLECS TRANSLATOR 00087 C USES SUBROUTINE ANALYZ AND LIST 00088 C 00089 C 00090 C--------------------------------------- 00091 C 00092 C FLECS TRANSLATOR (PRELIMINARY VERSION 22) 00093 C (FOR A MORE PRECISE VERSION NUMBER, SEE THE STRING SVER) 00094 C 00095 C AUTHOR -- TERRY BEYER 00096 C 00097 C ADDRESS -- COMPUTING CENTER 00098 C UNIVERSITY OF OREGON 00099 C EUGENE, OREGON 97405 00100 C 00101 C TELEPHONE -- (503) 686-4416 00102 C 00103 C DATE -- NOVEMBER 20, 1974 00104 C 00105 C--------------------------------------- 00106 C 00107 C DISCLAIMER 00108 C 00109 C NEITHER THE AUTHOR NOR THE UNIVERSITY OF OREGON SHALL BE 00110 C LIBAL FOR ANY DIRECT OR INDIRECT, INCIDENTAL, CONSEQUENTIAL, (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00003 M,M/-SP=M 00111 C OR SPECIFIC DAMAGES OF ANY KIND OR FROM ANY CAUSE WHATSOEVER 00112 C ARISING OUT OF OR IN ANY WAY CONNECTED WITH THE USE OR 00113 C PERFORMANCE OF THIS PROGRAM. 00114 C 00115 C--------------------------------------- 00116 C 00117 C PERMISSION 00118 C 00119 C THIS PROGRAM IS IN THE PUBLIC DOMAIN AND MAY BE ALTERED 00120 C OR REPRODUCED WITHOUT EXPLICIT PERMISSION OF THE AUTHOR. 00121 C 00122 C--------------------------------------- 00123 C 00124 C NOTE TO THE PROGRAMMER WHO WISHES TO ALTER THIS CODE 00125 C 00126 C 00127 C THE PROGRAM BELOW IS THE RESULT OF ABOUT SIX MONTHS OF 00128 C RAPID EVOLUTION IN ADDITION TO BEING THE FIRST SUCH 00129 C PROGRAM I HAVE EVER WRITTEN. YOU WILL FIND IT IS UNCOMMENTED, 00130 C AND IN MANY PLACES OBSCURE. THE LOGIC IS FREQUENTLY 00131 C BURIED UNDER A PILE OF PATCHES WHICH BARELY TOLERATE EACH 00132 C OTHER S EXISTENCE. 00133 C 00134 C I PLAN TO WRITE A CLEANER, SMALLER, AND FASTER VERSION OF 00135 C THIS PROGRAM WHEN GIVEN THE OPPORTUNITY. IT WAS NEVER 00136 C MY INTENT TO PRODUCE A PROGRAM MAINTAINABLE BY ANYONE OTHER 00137 C THAN MYSELF ON THIS FIRST PASS. NEVERTHLESS PLEASE 00138 C ACCEPT MY APOLOGIES FOR THE CONDITION OF THE CODE BELOW. 00139 C I WOULD PREFER IT IF YOU WOULD CONTACT ME AND WAIT FOR 00140 C THE NEWER VERSION BEFORE MAKING ANY BUT THE MOST NECESSARY 00141 C CHANGES TO THIS PROGRAM. YOU WILL PROBABLY SAVE YOURSELF 00142 C MUCH TIME AND GRIEF. 00143 C 00144 C--------------------------------------- 00145 C 00146 C SPECIAL NOTES FOR THE PDP-11 00147 C 00148 C 00149 C 1. DUE TO A RESTRICTION IN THE DOS FORTRAN COMPILER, 00150 C ALL DATA STATEMENTS HAVE BEEN COMMENTED OUT IN THEIR 00151 C ORIGINAL LOCATIONS AND HAVE BEEN REPRODUCED IN A BLOCK 00152 C AT THE END OF THE OTHER DECLARATIONS. 00153 C 00154 C 2. DUE TO THE INABILITY OF THE DOS FORTRAN COMPILER TO 00155 C CORRECTLY INTERPRET THE STATEMENT CALLNO=CALLNO+1 00156 C THE VARIABLE CALLNO HAS BEEN RENAMED TO NOCALL 00157 C 00158 C--------------------------------------- 00159 C 00160 C THE FOLLOWING IS FOR THE LAMPF VERSION OF FLECS 00161 C 00162 INTEGER DTYPE !22-JUN-81 (MAO) 00163 COMMON/DIR/DTYPE !22-JUN-81 (MAO) 00164 C 00165 LOGICAL PASFLG !30JUN81MAO (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00004 M,M/-SP=M 00166 INTEGER CNDLVL !30JUN81MAO 00167 INTEGER OFFLVL !30JUN81MAO 00168 INTEGER COND !30JUN81MAO 00169 INTEGER CNDVAL !30JUN81MAO 00170 COMMON/COND/PASFLG,CNDLVL,OFFLVL,COND,CNDVAL(4,10) !30JUN81MAO 00171 C 00172 C INTEGER DECLARATIONS 00173 C 00174 C 00175 INTEGER POUND !26-JUN-81 (MAO) 00176 INTEGER TDIR !22-JUN-81 (MAO) 00177 INTEGER TOFF !30JUN81MAO 00178 INTEGER DPAGE !22-JUN-81 (MAO) 00179 INTEGER DPIF,DPUNL,DPEND !30JUN81MAO 00180 INTEGER DNAME !30JUN81MAO 00181 INTEGER DINCL !29-JUN-81MAO 00182 INTEGER UDIR !29-JUN-81MAO 00183 INTEGER ACSEQ , ACTION, AELSE , AFSEQ , AGCONT, AGGOTO 00184 INTEGER AGRET , AGSTNO, AMSEQ ,ASSEQ , ATSEQ 00185 INTEGER BLN , NOCALL, CHC , CHSPAC, CHZERO 00186 INTEGER CINLIN !25-JAN-80 00187 INTEGER CLASS , CONTNO, DUMMY , ELSNO , ENDNO , ENTNO 00188 INTEGER ERRCL , ERROR , ERRSTK, ERSTOP, EXTYPE, FLXNO 00189 INTEGER FORTCL, GGOTON, GOTONO, GSTNO , HASH , HOLDNO 00190 INTEGER I , ITEMP , J , L , LEVEL , LINENO 00191 INTEGER LL , LP , LR , LT 00192 INTEGER LISTCL, LOOPNO, LSTLEV, LWIDTH, MAJCNT 00193 INTEGER MAX , MAXSTK, MINCNT, MLINE , NCHPWD, NEWNO 00194 INTEGER NEXTNO, NUNITS, NXIFNO, OFFSET, OFFST2, P 00195 INTEGER PARAM1, PARAM2, PARAM3, PARAM4, PDUMMY, PENT 00196 INTEGER PARAM5 !25-JAN-80 00197 INTEGER PRIME , PTABLE, Q , QM , QP , READ 00198 INTEGER REFNO , RETNO , RETRY , S , SAFETY, SASSN1 00199 INTEGER SASSN2, SB , SB5I1 , SB6 , SB6I , SB7 , SBGOTO 00200 INTEGER SCONT 00201 INTEGER SCOMMA, SCP , SDASH , SDOST , SDUM , SEEDNO, SEQ 00202 INTEGER SETUP , SFLX , SFORCE, SGOTO , SGOTOI, SGUP1 00203 INTEGER SGOTOP 00204 INTEGER SGUP2 , SHOLD , SIF , SIFP , SIFPN , SLIST 00205 INTEGER SNE , SOURCE, SPB , SPGOTO, SPINV , SPUTGO 00206 INTEGER SRP , SRTN , SSPACR, SST , SSTMAX, SSTOP 00207 INTEGER SRPCI 00208 INTEGER STACK , STNO , SVER , TCEXP , TCOND , TDO 00209 INTEGER TELSE , TEND , TESTNO, TEXEC , TFIN , TFORT 00210 INTEGER TIF , TINVOK, TMAX , TOP , TOPNO , TOPTYP 00211 INTEGER TRUNTL, TRWHIL, TSELCT, TTO , TUNLES, TUNTIL 00212 INTEGER TWHEN , TWHILE, UDO , UEXP , UFORT , ULEN 00213 INTEGER UOWSE , UPINV , USTART, UTYPE , WWIDTH 00214 C 00215 C--------------------------------------- 00216 C 00217 C LOGICAL DECLARATIONS 00218 C 00219 C 00220 LOGICAL ALECS !20-FEB-80 (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00005 M,M/-SP=M 00221 LOGICAL COGOTO, FAKE , LONG 00222 LOGICAL DONE , ENDFIL, ENDPGM, ERLST , FIRST , FOUND , INSERT 00223 LOGICAL NOPGM , NOTFLG, PASS , SAVED ,SHORT , STREQ , STRLT 00224 C 00225 C--------------------------------------- 00226 C 00227 C ARRAY DECLARATIONS 00228 C 00229 C 00230 C ARRAYS WHICH HOLD RESULTS OF SCANNERS ANALYSIS 00231 DIMENSION UTYPE(3), USTART(3), ULEN(3) 00232 C 00233 C STACK/TABLE AREA AND POINTER TO TOP OF STACK 00234 DIMENSION STACK(2000) 00235 C 00236 C SYNTAX ERROR STACK AND TOP POINTER 00237 DIMENSION ERRSTK(5) 00238 C 00239 C--------------------------------------- 00240 C 00241 C COMMON DECLARATIONS 00242 C (SEE ALSO PARAMETERS BELOW) 00243 C 00244 C 00245 C THE FOLLOWING VARIABLES ARE COMMON TO TWO OR MORE SUBPROGRAMS 00246 COMMON BLN , CLASS , DONE , ENDFIL, ENDPGM, ERLST 00247 COMMON ERROR , ERRSTK, ERSTOP, EXTYPE, FIRST , FLXNO 00248 COMMON FOUND , HOLDNO, LEVEL , LINENO, LSTLEV, MAJCNT 00249 COMMON MINCNT, MLINE , NOPGM , NUNITS, PASS , PTABLE, QP 00250 COMMON REFNO , SAVED , SFLX , SHOLD , SLIST , SOURCE 00251 COMMON SPINV , SPUTGO, SST , STACK , TOP , ULEN 00252 COMMON USTART, UTYPE , WWIDTH 00253 C 00254 C--------------------------------------- 00255 C 00256 C MNEMONIC DECLARATIONS 00257 C 00258 C 00259 C I/O CLASS CODES FOR USE WITH SUBROUTINE PUT 00260 C DATA FORTCL /1/, LISTCL /2/, ERRCL /3/ 00261 C 00262 C ACTION CODES FOR USE ON ACTION STACK 00263 C DATA ACSEQ/1/, AELSE/2/, AFSEQ/3/, AGCONT/4/, AGGOTO/5/ 00264 C DATA AGSTNO/6/, AMSEQ/7/, AGRET/8/, ASSEQ/9/, ATSEQ/10/ 00265 C 00266 C TYPE CODES USED BY SCANNERS 00267 C DATA UEXP/1/, UFORT/2/, UOWSE/3/, UPINV/4/, UDO/5/ 00268 C DATA UDIR/6/ !29-JUN-81MAO 00269 C 00270 C TYPE CODES ASSIGNED TO THE VARIABLE CLASS 00271 C DATA TCEXP/1/, TELSE/2/, TEND/3/, TEXEC/4/, TFIN/5/, TTO/6/ 00272 C DATA TDIR/7/ !22-JUN- 00273 C DATA TOFF/8/ !30JUN81 00274 C 00275 C TYPE CODES ASSIGNED TO THE VARIABLE EXTYPE (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00006 M,M/-SP=M 00276 C DATA TCOND/1/, TDO/2/, TFORT/3/, TIF/4/, TINVOK/5/, TRUNTL/6/ 00277 C DATA TRWHIL/7/, TSELCT/8/, TUNLES/9/, TUNTIL/10/, TWHEN/11/ 00278 C DATA TWHILE/12/ 00279 C 00280 C TYPE CODES ASSIGNED TO THE VARIABLE DTYPE 00281 C DATA DPAGE/1/, DINCL/2/ !29-JUN-81MAO 00282 C DATA DPIF/3/, DPUNL/4/, DPEND/5/, DNAME/6/ !30JUN81MAO 00283 C 00284 C CODES INDICATING SOURCE OF NEXT STATEMENT 00285 C IN SUBROUTINE ANALYZ 00286 C DATA SETUP /1/, RETRY /2/, READ /3/ 00287 C 00288 C--------------------------------------- 00289 C 00290 C 00291 C PARAMETERS 00292 C 00293 C THE FOLLOWING VARIABLES ARE PARAMETERS FOR THE PROGRAM. 00294 C THE MEANING OF EACH IS GIVEN BRIEFLY BELOW. FOR MORE INFORMATION 00295 C ON THE EFFECT OF THESE PARAMETERS, CONSULT THE SYSTEM MODIFICATION 00296 C GUIDE. 00297 C 00298 C INTEGER VALUE OF THE CHARACTER C 00299 C DATA CHC /67/ 00300 C 00301 C INTEGER VALUE OF IN-LINE COMMENT CHARACTER "!" !25-JAN-80 00302 C DATA CINLIN /33/ !25-JAN-80 00303 C 00304 C LISTING WIDTH IN CHARACTERS 00305 C DATA LWIDTH /132/ 00306 C 00307 C SIZE OF THE MAIN STACK 00308 C DATA MAXSTK /2000/ 00309 C 00310 C NUMBER OF CHARACTERS PER WORD (PER INTEGER) IN A FORMAT 00311 C DATA NCHPWD /2/ 00312 C 00313 C SIZE OF HASH TABLE FOR PROCEDURE NAMES - SHOULD BE PRIME. 00314 C DATA PRIME /53/ 00315 C 00316 C SAFETY MARGIN BETWEEN TOP AND MAX AT BEGINNING OF EACH LOOP 00317 C DATA SAFETY /35/ 00318 C 00319 C SEED FOR GENERATION OF STATEMENT NUMBERS 00320 C DATA SEEDNO /32760/ 00321 C 00322 C CAUSES LONG FORM OF ASSIGNED GO TO TO BE GENERATED 00323 C DATA LONG /.FALSE./ 00324 C 00325 C CAUSES SHORT FORM OF ASSIGNED GO TO TO BE GENERATED 00326 C DATA SHORT /.TRUE./ 00327 C 00328 C CAUSES FAKE LONG FORM OF ASSIGNED GO TO TO BE GENERATED 00329 C DATA FAKE /.FALSE./ 00330 C (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00007 M,M/-SP=M 00331 C CAUSES COMPUTED GO TO'S TO BE GENERATED 00332 C DATA COGOTO /.FALSE./ 00333 C 00334 C INTEGER VALUE OF THE CHARACTER SPACE 00335 C DATA CHSPAC /32/ 00336 C 00337 C INTEGER VALUE OF THE CHARACTER CODE FOR ZERO 00338 C DATA CHZERO /48/ 00339 C 00340 C THE PARAMETERS NCHPWD, CHZERO, CHSPAC, AND CHC 00341 C ARE COMMUNICATED TO VARIOUS 00342 C SUBPROGRAMS VIA THE FOLLOWING COMMON (SEE PERFORM-INITIALIZATION) 00343 C COMMON /PARAM/ NCHPWD, CHZERO, CHSPAC, CHC, CINLIN !25-JAN-80 00344 COMMON /PARAM/ PARAM1, PARAM2, PARAM3, PARAM4, PARAM5 !25-JAN-80 00345 C 00346 C--------------------------------------- 00347 C 00348 C STRING DECLARATIONS 00349 C 00350 C 00351 C THE FOLLOWING ARRAYS ARE USED FOR STORAGE OF WORKING STRINGS 00352 C AND CORRESPOND TO STRINGS OF THE LENGTHS INDICATED. 00353 C THE SIZES GIVEN BELOW ARE EXCESSIVE AND SHOULD BE 00354 C BE REDUCED AFTER CAREFUL ANALYSIS (NO TIME NOW). 00355 C 00356 C SFLX 100 CHARACTERS 00357 DIMENSION SFLX (51) 00358 C SHOLD 100 CHARACTERS 00359 DIMENSION SHOLD (51) 00360 C SLIST 200 CHARACTERS 00361 DIMENSION SLIST (101) 00362 C SPINV 80 CHARACTERS 00363 DIMENSION SPINV (41) 00364 C SPUTGO 20 CHARACTERS 00365 DIMENSION SPUTGO (11) 00366 C SST 200 CHARACTERS 00367 DIMENSION SST (101) 00368 C DATA SSTMAX /200/ 00369 C 00370 C THE FOLLOWING STRINGS REPRESENT CONSTANTS 00371 C 00372 C SASSN1 // ASSIGN // 00373 DIMENSION SASSN1 (8) 00374 C DATA SASSN1 / 13, 2H , 2H , 2H , 2HAS, 2HSI, 2HGN, 1H / 00375 C SASSN2 // TO I// 00376 DIMENSION SASSN2 (4) 00377 C DATA SASSN2 / 5, 2H T, 2HO , 1HI/ 00378 C SB // // 00379 DIMENSION SB (2) 00380 C DATA SB / 1, 1H / 00381 C SB5I1 // 1// 00382 DIMENSION SB5I1 (4) 00383 C DATA SB5I1 / 6, 2H , 2H , 2H 1/ 00384 C SB6 // // 00385 DIMENSION SB6 (4) (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00008 M,M/-SP=M 00386 C DATA SB6 / 6, 2H , 2H , 2H / 00387 C SB7 // // 00388 DIMENSION SB7 (5) 00389 C DATA SB7 / 7, 2H , 2H , 2H , 1H / 00390 C SB6I // I// 00391 DIMENSION SB6I (5) 00392 C DATA SB6I / 7, 2H , 2H , 2H , 1HI/ 00393 C SBGOTO // GO TO // 00394 DIMENSION SBGOTO (5) 00395 C DATA SBGOTO / 7, 2H G, 2HO , 2HTO, 1H / 00396 C SCOMMA //,// 00397 DIMENSION SCOMMA (2) 00398 C DATA SCOMMA / 1, 1H,/ 00399 C SCONT //CONTINUE// 00400 DIMENSION SCONT (5) 00401 C DATA SCONT / 8, 2HCO, 2HNT, 2HIN, 2HUE/ 00402 C SCP //,(// 00403 DIMENSION SCP (2) 00404 C DATA SCP / 2, 2H,(/ 00405 C SDOST // DO // 00406 DIMENSION SDOST (6) 00407 C DATA SDOST / 9, 2H , 2H , 2H , 2HDO, 1H / 00408 C SDASH //----------------------------------------// 00409 DIMENSION SDASH (21) 00410 C DATA SDASH / 40, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H-- 00411 C 1 , 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H-- 00412 C 1 , 2H--, 2H--, 2H--, 2H--/ 00413 C SDUM //DUMMY-PROCEDURE// 00414 DIMENSION SDUM (9) 00415 C DATA SDUM / 15, 2HDU, 2HMM, 2HY-, 2HPR, 2HOC, 2HED, 2HUR, 1HE/ 00416 C SEQ //=// 00417 DIMENSION SEQ (2) 00418 C DATA SEQ / 1, 1H=/ 00419 C SFORCE // CONTINUE// 00420 DIMENSION SFORCE (8) 00421 C DATA SFORCE / 14, 2H , 2H , 2H , 2HCO, 2HNT, 2HIN, 2HUE/ 00422 C SGOTO // GO TO // 00423 DIMENSION SGOTO (7) 00424 C DATA SGOTO / 12, 2H , 2H , 2H , 2HGO, 2H T, 2HO / 00425 C SGOTOI // GO TO I// 00426 DIMENSION SGOTOI (8) 00427 C DATA SGOTOI / 13, 2H , 2H , 2H , 2HGO, 2H T, 2HO , 1HI/ 00428 C SGOTOP // GO TO (// 00429 DIMENSION SGOTOP (8) 00430 C DATA SGOTOP / 13, 2H , 2H , 2H , 2HGO, 2H T, 2HO , 1H(/ 00431 C SGUP1 //***** TRANSLATOR HAS USED UP ITS ALLOTED SPACE FOR TABLES// 00432 DIMENSION SGUP1 (30) 00433 C DATA SGUP1 / 57, 2H**, 2H**, 2H* , 2HTR, 2HAN, 2HSL, 2HAT, 2HOR 00434 C 1 , 2H H, 2HAS, 2H U, 2HSE, 2HD , 2HUP, 2H I, 2HTS 00435 C 1 , 2H A, 2HLL, 2HOT, 2HED, 2H S, 2HPA, 2HCE, 2H F 00436 C 1 , 2HOR, 2H T, 2HAB, 2HLE, 1HS/ 00437 C SGUP2 //***** TRANSLATION MUST TERMINATE IMMEDIATELY// 00438 DIMENSION SGUP2 (23) 00439 C DATA SGUP2 / 44, 2H**, 2H**, 2H* , 2HTR, 2HAN, 2HSL, 2HAT, 2HIO 00440 C 1 , 2HN , 2HMU, 2HST, 2H T, 2HER, 2HMI, 2HNA, 2HTE (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00009 M,M/-SP=M 00441 C 1 , 2H I, 2HMM, 2HED, 2HIA, 2HTE, 2HLY/ 00442 C SIF // IF// 00443 DIMENSION SIF (5) 00444 C DATA SIF / 8, 2H , 2H , 2H , 2HIF/ 00445 C SIFP // IF(// 00446 DIMENSION SIFP (6) 00447 C DATA SIFP / 9, 2H , 2H , 2H , 2HIF, 1H(/ 00448 C SIFPN // IF(.NOT.// 00449 DIMENSION SIFPN (8) 00450 C DATA SIFPN / 14, 2H , 2H , 2H , 2HIF, 2H(., 2HNO, 2HT./ 00451 C SNE //.NE.// 00452 DIMENSION SNE (3) 00453 C DATA SNE / 4, 2H.N, 2HE./ 00454 C SPB //) // 00455 DIMENSION SPB (2) 00456 C DATA SPB / 2, 2H) / 00457 C SPGOTO //) GO TO // 00458 DIMENSION SPGOTO (5) 00459 C DATA SPGOTO / 8, 2H) , 2HGO, 2H T, 2HO / 00460 C SRP //)// 00461 DIMENSION SRP (2) 00462 C DATA SRP / 1, 1H)/ 00463 C SRPCI //), I// 00464 DIMENSION SRPCI (3) 00465 C DATA SRPCI / 4, 2H),, 2H I/ 00466 C SRTN // RETURN// 00467 DIMENSION SRTN (7) 00468 C DATA SRTN / 12, 2H , 2H , 2H , 2HRE, 2HTU, 2HRN/ 00469 C SSPACR //. // 00470 DIMENSION SSPACR (3) 00471 C DATA SSPACR / 3, 2H. , 1H / 00472 C SSTOP // CALL EXIT// 00473 DIMENSION SSTOP (9) 00474 C DATA SSTOP / 15, 2H , 2H , 2H , 2HCA, 2HLL, 2H E, 2HXI, 1HT/ 00475 C SVER //(FLECS VERSION 22.38)// 00476 DIMENSION SVER (12) 00477 C DATA SVER / 21, 2H(F, 2HLE, 2HCS, 2H V, 2HER, 2HSI, 2HON, 2H 2 00478 C 1 , 2H2., 2H38, 1H)/ 00479 C 00480 C--------------------------------------- 00481 C 00482 C THE DATA DECLARATIONS FOLLOW 00483 C 00484 C 00485 DATA POUND/"43/ !# SIGN FOR COLUMN 1 !26-JUN-81 (MAO) 00486 DATA FORTCL /1/, LISTCL /2/, ERRCL /3/ 00487 DATA ACSEQ/1/, AELSE/2/, AFSEQ/3/, AGCONT/4/, AGGOTO/5/ 00488 DATA AGSTNO/6/, AMSEQ/7/, AGRET/8/, ASSEQ/9/, ATSEQ/10/ 00489 DATA UEXP/1/, UFORT/2/, UOWSE/3/, UPINV/4/, UDO/5/ 00490 DATA UDIR/6/ !29-JUN- 00491 DATA TCEXP/1/, TELSE/2/, TEND/3/, TEXEC/4/, TFIN/5/, TTO/6/ 00492 DATA TDIR /7/ !22-JUN- 00493 DATA TOFF /8/ !30JUN81 00494 DATA TCOND/1/, TDO/2/, TFORT/3/, TIF/4/, TINVOK/5/, TRUNTL/6/ 00495 DATA TRWHIL/7/, TSELCT/8/, TUNLES/9/, TUNTIL/10/, TWHEN/11/ (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00010 M,M/-SP=M 00496 DATA TWHILE/12/ 00497 DATA DPAGE /1/ !22-JUN- 00498 DATA DINCL /2/ !29-JUN- 00499 DATA DPIF /3/, DPUNL /4/, DPEND /5/ !30JUN81 00500 DATA DNAME /6/ !30JUN81 00501 DATA SETUP /1/, RETRY /2/, READ /3/ 00502 DATA CHC /67/ 00503 DATA CINLIN /33/ !25-JAN-80 00504 DATA LWIDTH /132/ 00505 DATA MAXSTK /2000/ 00506 DATA NCHPWD /2/ 00507 DATA PRIME /53/ 00508 DATA SAFETY /35/ 00509 DATA SEEDNO /32760/ 00510 DATA LONG /.FALSE./ 00511 DATA SHORT /.TRUE./ 00512 DATA FAKE /.FALSE./ 00513 DATA COGOTO /.FALSE./ 00514 DATA CHSPAC /32/ 00515 DATA CHZERO /48/ 00516 DATA SSTMAX /200/ 00517 DATA SASSN1 / 13, 2H , 2H , 2H , 2HAS, 2HSI, 2HGN, 1H / 00518 DATA SASSN2 / 5, 2H T, 2HO , 1HI/ 00519 DATA SB / 1, 1H / 00520 DATA SB5I1 / 6, 2H , 2H , 2H 1/ 00521 DATA SB6 / 6, 2H , 2H , 2H / 00522 DATA SB7 / 7, 2H , 2H , 2H , 1H / 00523 DATA SB6I / 7, 2H , 2H , 2H , 1HI/ 00524 DATA SBGOTO / 7, 2H G, 2HO , 2HTO, 1H / 00525 DATA SCOMMA / 1, 1H,/ 00526 DATA SCONT / 8, 2HCO, 2HNT, 2HIN, 2HUE/ 00527 DATA SCP / 2, 2H,(/ 00528 DATA SDOST / 9, 2H , 2H , 2H , 2HDO, 1H / 00529 DATA SDASH / 40, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H-- 00530 1 , 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H-- 00531 1 , 2H--, 2H--, 2H--, 2H--/ 00532 DATA SDUM / 15, 2HDU, 2HMM, 2HY-, 2HPR, 2HOC, 2HED, 2HUR, 1HE/ 00533 DATA SEQ / 1, 1H=/ 00534 DATA SFORCE / 14, 2H , 2H , 2H , 2HCO, 2HNT, 2HIN, 2HUE/ 00535 DATA SGOTO / 12, 2H , 2H , 2H , 2HGO, 2H T, 2HO / 00536 DATA SGOTOI / 13, 2H , 2H , 2H , 2HGO, 2H T, 2HO , 1HI/ 00537 DATA SGOTOP / 13, 2H , 2H , 2H , 2HGO, 2H T, 2HO , 1H(/ 00538 DATA SGUP1 / 57, 2H**, 2H**, 2H* , 2HTR, 2HAN, 2HSL, 2HAT, 2HOR 00539 1 , 2H H, 2HAS, 2H U, 2HSE, 2HD , 2HUP, 2H I, 2HTS 00540 1 , 2H A, 2HLL, 2HOT, 2HED, 2H S, 2HPA, 2HCE, 2H F 00541 1 , 2HOR, 2H T, 2HAB, 2HLE, 1HS/ 00542 DATA SGUP2 / 44, 2H**, 2H**, 2H* , 2HTR, 2HAN, 2HSL, 2HAT, 2HIO 00543 1 , 2HN , 2HMU, 2HST, 2H T, 2HER, 2HMI, 2HNA, 2HTE 00544 1 , 2H I, 2HMM, 2HED, 2HIA, 2HTE, 2HLY/ 00545 DATA SIF / 8, 2H , 2H , 2H , 2HIF/ 00546 DATA SIFP / 9, 2H , 2H , 2H , 2HIF, 1H(/ 00547 DATA SIFPN / 14, 2H , 2H , 2H , 2HIF, 2H(., 2HNO, 2HT./ 00548 DATA SNE / 4, 2H.N, 2HE./ 00549 DATA SPB / 2, 2H) / 00550 DATA SPGOTO / 8, 2H) , 2HGO, 2H T, 2HO / (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00011 M,M/-SP=M 00551 DATA SRP / 1, 1H)/ 00552 DATA SRPCI / 4, 2H),, 2H I/ 00553 DATA SRTN / 12, 2H , 2H , 2H , 2HRE, 2HTU, 2HRN/ 00554 DATA SSPACR / 3, 2H. , 1H / 00555 DATA SSTOP / 15, 2H , 2H , 2H , 2HCA, 2HLL, 2H E, 2HXI, 1HT/ 00556 DATA SVER / 21, 2H(F, 2HLE, 2HCS, 2H V, 2HER, 2HSI, 2HON, 2H 2 00557 1 , 2H2., 2H38, 1H)/ 00558 C 00559 C--------------------------------------- 00560 C 00561 C MAIN PROGRAM 00562 C 00563 PERFORM-INITIALIZATION 00564 REPEAT UNTIL (DONE) 00565 . NOCALL=NOCALL+1 !ONE MORE CALL MADE TO OPENF 00566 . CALL OPENF(NOCALL,DONE,SVER) !GET CMD LINE, OPEN FTN,FLL,FLX 00567 . UNLESS (DONE) 00568 . . ENDFIL=.FALSE. 00569 . . MINCNT=0 !NUMBER OF WARNINGS 00570 . . MAJCNT=0 !NUMBER OF ERRORS 00571 . . LINENO=0 !INITIALIZE LINE # FOR FLX FILE 00572 . . REPEAT UNTIL (ENDFIL) 00573 . . . PREPARE-TO-PROCESS-PROGRAM 00574 . . . PROCESS-PROGRAM !STAYS IN HERE UNTIL HITS "END" 00575 . . ...FIN 00576 . . CALL CLOSEF(MINCNT,MAJCNT) !CLOSE FLX,FTN,FLL FILES 00577 . ...FIN 00578 ...FIN 00579 CALL EXFLE !MAO, 30-APR-80 ---------------------------------------- 00580 TO CHANGE-PAGE-HEADER-NAME !30JUN81 00581 C . 00582 C . PROCESS .NAME DIRECTIVE 00583 C . 00584 . CALL CPYSUB (SST,SFLX,USTART(1),ULEN(1)) 00585 . CALL NEWNAM (SST(1),SST(2)) 00586 ...FIN!to change-page-header-name ---------------------------------------- 00587 TO COMPILE-CEXP !HANDLE CONDITIONAL SUBCLAUSE EXPRESSION 00588 . GENERATE-BRANCH-AROUND-AND-ESTABLISH-NEXT-NUMBER 00589 . SET-UP-STATEMENT-NUMBER !IF STMNT # ON FLX LINE, PUT IN NEXT 00590 . WHEN (UTYPE(1).EQ.UEXP) !NORMAL CLAUSE 00591 . . GOTONO=NEWNO(0) 00592 . . STACK(TOP-2)=GOTONO 00593 . . PUT-IF-NOT-GOTO !IF(.NOT.(L))GOTO 'GOTONO' 00594 . ...FIN 00595 . ELSE STACK(TOP-2)=0 !OTHERWISE CLAUSE 00596 . COMPLETE-ACTION 00597 ...FIN ---------------------------------------- (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00012 M,M/-SP=M 00598 TO COMPILE-CONDITIONAL 00599 C . 00600 C . HANDEL CONDITIONAL STATEMENT--NOTE GENERATES NO CODE, MERELY 00601 C . SETS UP STACK FOR FOLLOWING SUBCLAUSES 00602 C . 00603 . TOP=TOP+4 00604 . STACK(TOP)=ACSEQ 00605 . STACK(TOP-1)=LINENO 00606 . STACK(TOP-2)=0 00607 . STACK(TOP-3)=0 00608 . LEVEL=LEVEL+1 00609 . SET-UP-STATEMENT-NUMBER !IF STMNT # ON FLX LINE, PUT IN NEXTNO 00610 ...FIN ---------------------------------------- 00611 TO COMPILE-DO !DO(), DO()FORT OR DO()C-O-A 00612 C . 00613 C ALECS VVVVV 00614 . WHEN(ALECS) 00615 . . FORCE-OUT-LABELS 00616 . . GSTNO=NEWNO(0) 00617 . . PUSH-GSTNO !LOOP EXIT LABEL 00618 . . NEXTNO=NEWNO(0) !START OF SCOPE LABEL 00619 . . CONTNO=NEWNO(0) !LOOP NON-EXIT LABEL 00620 . . PUSH-GCONT 00621 C . . 00622 . . CALL ALEDO(SST,SFLX,USTART(1),ULEN(1),CONTNO,NEXTNO,GSTNO, 00623 1. . LINENO,MAJCNT,FORTCL,ERRCL) 00624 . ...FIN 00625 . ELSE 00626 C ALECS ^^^^^ 00627 C . . 00628 . . CONTNO=NEWNO(0) 00629 . . PUSH-GCONT !COMMAND TO GENERATE TERMINATING CONTINUE 00630 . . CALL CPYSTR(SST,SDOST) 00631 . . CALL CATNUM(SST,CONTNO) 00632 . . CALL CATSTR(SST,SB) 00633 . . CALL CATSUB(SST,SFLX,USTART(1)+1,ULEN(1)-2) 00634 . . STNO=FLXNO 00635 . . FLXNO=0 00636 . . PUT-STATEMENT !"DO 'CONTNO' [CONTROL FROM FLX LESS PAREN]" 00637 C . . 00638 C ALECS VVVVV 00639 . ...FIN 00640 C ALECS ^^^^^ 00641 C . 00642 . COMPLETE-ACTION 00643 ...FIN ---------------------------------------- 00644 TO COMPILE-ELSE !HANDLE ELSE, ELSE FORT OR ELSE C-O-A 00645 . TOP=TOP-2 (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00013 M,M/-SP=M 00646 . SET-UP-STATEMENT-NUMBER !IF STMNT # ON ELSE, PUT IN NEXTNO 00647 . WHEN (NUNITS.EQ.1) !ELSE FORT OR ELSE C-O-A 00648 . . WHEN (UTYPE(1).EQ.UPINV) COMPILE-INVOKE !ELSE C-O-A 00649 . . ELSE 00650 . . . CALL CPYSUB(SST,SFLX,USTART(1),ULEN(1)) 00651 . . . UNLESS (STREQ(SST,SCONT)) COMPILE-FORTRAN 00652 . . ...FIN 00653 . ...FIN 00654 . ELSE PUSH-FINSEQ !PLAIN ELSE 00655 ...FIN ---------------------------------------- 00656 TO COMPILE-END !HAVE HIT FORTRAN END IN FLX 00657 . WHEN (CNDLVL.NE.0) ERROR=404 !30JUN81 00658 . ELSE !30JUN81 00659 . . SORT-TABLE !TABLE OF PROCEDURE NAMES 00660 C . . IF (LONG.OR.COGOTO) GENERATE-PROCEDURE-DISPATCH-AREA !11-SEP-75 00661 . . PUT-COPY 00662 . . IF (ENDFIL) ERROR=25 00663 . . ENDPGM=.TRUE. 00664 . ...FIN!else !30JUN81MAO 00665 ...FIN ---------------------------------------- 00666 TO COMPILE-EXEC !TRANSLATE EXECUTABLE FLECS STMNT 00667 . SELECT (EXTYPE) 00668 . . (TFORT) PUT-COPY !PURE FORTRAN LINE, JUST OUTPUT IT 00669 . . (TIF) COMPILE-IF 00670 . . (TUNLES) COMPILE-UNLESS 00671 . . (TWHEN) COMPILE-WHEN 00672 . . (TWHILE) COMPILE-WHILE 00673 . . (TUNTIL) COMPILE-UNTIL 00674 . . (TRWHIL) COMPILE-RWHILE 00675 . . (TRUNTL) COMPILE-RUNTIL 00676 . . (TINVOK) COMPILE-INVOKE !PROCEDURE INVOKATION 00677 . . (TCOND) COMPILE-CONDITIONAL 00678 . . (TSELCT) COMPILE-SELECT 00679 . . (TDO) COMPILE-DO 00680 . ...FIN 00681 ...FIN ---------------------------------------- 00682 TO COMPILE-FORTRAN !FORTRAN LINE FOUND ON A FLECS LINE 00683 . STNO=FLXNO !IF STMNT # ON FLX LINE, PUT IT ON THIS LINE 00684 . CALL CPYSTR(SST,SB6) !PUT IN 6 BLANKS 00685 . WHEN (UTYPE(1).EQ.UFORT) J=1 00686 . ELSE J=2 00687 . CALL CATSUB(SST,SFLX,USTART(J),ULEN(J)) !ADD ON FORTRAN LINE 00688 . PUT-STATEMENT !PUT OUT LINE WITH STNO (IF IT EXISTS) 00689 ...FIN ---------------------------------------- (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00014 M,M/-SP=M 00690 TO COMPILE-IF 00691 C . 00692 C ALECS VVVVV 00693 . WHEN(ALECS) FINISH-IF-UNLESS 00694 . ELSE 00695 C ALECS ^^^^^ 00696 C . . 00697 . . WHEN (NUNITS.EQ.2.AND.UTYPE(2).EQ.UFORT) PUT-COPY !PLAIN FORT IF 00698 . . ELSE FINISH-IF-UNLESS !FLECS IF OR UNLESS 00699 C . . 00700 C ALECS VVVVV 00701 . ...FIN 00702 C ALECS ^^^^^ 00703 C . 00704 ...FIN ---------------------------------------- 00705 TO COMPILE-INVOKE !PROCEDURE INVOCATION 00706 . FIND-ENTRY !FIND THE PROCEDURE IN THE PROCEDURE TABLE 00707 . ENTNO=STACK(PENT+1) !START OF PROCEDURE STMNT # 00708 . RETNO=NEWNO(0) !WHERE TO RETURN FROM THIS CALL 00709 . MAX=MAX-(1+OFFSET) 00710 . STACK(MAX+1)=STACK(PENT+3) 00711 . STACK(PENT+3)=MAX+1 00712 . STACK(MAX+2)=LINENO 00713 . IF (LONG.OR.COGOTO) STACK(MAX+3)=RETNO 00714 C . 00715 C ALECS VVVVV 00716 . WHEN(ALECS) 00717 . . FORCE-OUT-LABELS 00718 . . CALL ALEINV(ENTNO,LINENO,FORTCL) 00719 . ...FIN 00720 . ELSE 00721 C ALECS ^^^^^ 00722 C . . 00723 . . WHEN (COGOTO) 00724 . . . STACK(PENT-2)=STACK(PENT-2)+1 00725 . . . CALL CPYSTR(SST,SB6I) 00726 . . . CALL CATNUM(SST,ENTNO) 00727 . . . CALL CATSTR(SST,SEQ) 00728 . . . CALL CATNUM(SST,STACK(PENT-2)) 00729 . . ...FIN 00730 . . ELSE 00731 . . . CALL CPYSTR(SST,SASSN1) 00732 . . . CALL CATNUM(SST,RETNO) 00733 . . . CALL CATSTR(SST,SASSN2) 00734 . . . CALL CATNUM(SST,ENTNO) !ASSIGN 'RETNO' TO I'ENTNO 00735 . . ...FIN 00736 . . STNO=FLXNO 00737 . . PUT-STATEMENT !PUT OUT ASSIGN STMNT 00738 . . GOTONO=ENTNO 00739 . . PUT-GOTO !GOTO 'ENTNO' 00740 . . NEXTNO=RETNO !NEXT STMNT #=RETURN PLACE FROM PROCEDURE (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00015 M,M/-SP=M 00741 C . . 00742 C ALECS VVVVV 00743 . ...FIN 00744 C ALECS ^^^^^ 00745 C . 00746 ...FIN ---------------------------------------- 00747 TO COMPILE-RUNTIL !HANDEL REPEAT UNTIL AS REPEAT WHILE(.NOT. 00748 . NOTFLG=.FALSE. 00749 . COMPILE-RWHILE 00750 ...FIN ---------------------------------------- 00751 TO COMPILE-RWHILE !REPEAT WHILE OR REPEAT UNTIL 00752 . SET-UP-STATEMENT-NUMBER !PUT # FROM FLX LINE INTO NEXTNO 00753 . TESTNO=NEWNO(0) !# ON IF(.NOT. 00754 . TOPNO=NEWNO(0) !# AT TOP OF SCOPE 00755 . ENDNO=NEWNO(0) !# PAST END OF LOOP 00756 . GOTONO=TOPNO 00757 . PUT-GOTO !PUT OUT GOTO 'TOPNO' 00758 . STNO=TESTNO 00759 . GOTONO=ENDNO 00760 . PUT-IF-NOT-GOTO !PUT OUT IF()GOTO 'ENDNO' 00761 . GSTNO=ENDNO 00762 . PUSH-GSTNO !STACK CMD TO GENERATE GOTO TARGET STMNT # 00763 . GGOTON=TESTNO 00764 . PUSH-GGOTO !STACK CMD TO GENERATE GOTO 'TESTNO' 00765 . NEXTNO=TOPNO !NEXT STMNT #=TOPNO 00766 . COMPLETE-ACTION 00767 ...FIN ---------------------------------------- 00768 TO COMPILE-SELECT !PROCESS SELECT(E) 00769 . SET-UP-STATEMENT-NUMBER !IF # ON FLX LINE, PUT INTO NEXTNO 00770 . LEVEL=LEVEL+1 00771 . L=(ULEN(1)-1)/NCHPWD+6 !PREPARE TO STORE EXPRESSION ON STACK 00772 . TOP=TOP+L+1 00773 . WHEN (TOP+SAFETY.LT.MAX) 00774 . . STACK(TOP)=ASSEQ 00775 . . STACK(TOP-1)=LINENO 00776 . . STACK(TOP-2)=0 00777 . . STACK(TOP-3)=0 00778 . . STACK(TOP-4)=L 00779 . . STACK(TOP-L)=0 00780 . . CALL CATSUB(STACK(TOP-L),SFLX,USTART(1),ULEN(1)) !PUT EXP ON STAC 00781 . ...FIN 00782 . ELSE GIVE-UP !STACK OVERFLOW--HOPELESS 00783 ...FIN ---------------------------------------- (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00016 M,M/-SP=M 00784 TO COMPILE-SEQ-FIN !FIN AT END OF CONDITIONAL OR SELECT 00785 . LEVEL=LEVEL-1 00786 . SET-UP-STATEMENT-NUMBER !IF # ON FLX LINE, PUT IN NEXTNO 00787 . STNO=STACK(TOP-2) 00788 . UNLESS (STNO.EQ.0) PUT-CONTINUE !WILL=0 IF WAS A OTHERWISE 00789 . FORCE-NEXT-NUMBER !USE UP NEXTNO 00790 . NEXTNO=STACK(TOP-3) !GET # BEYOND END OF CONDITIONAL 00791 . POP-STACK 00792 ...FIN ---------------------------------------- 00793 TO COMPILE-SEXP !PROCESS SELECT SUBCLAUSE 00794 . GENERATE-BRANCH-AROUND-AND-ESTABLISH-NEXT-NUMBER 00795 . SET-UP-STATEMENT-NUMBER !IF STMNT # ON FLX LINE, PUT IN NEXTNO 00796 . WHEN (UTYPE(1).EQ.UEXP) !NORMAL EXPRESSION 00797 C . . 00798 C ALECS VVVVV 00799 . . WHEN(ALECS) 00800 . . . FORCE-OUT-LABELS 00801 . . . I=STACK(TOP-4) 00802 . . . NXIFNO=NEWNO(0) 00803 . . . STACK(TOP-2)=NXIFNO 00804 . . . CALL ALESXP(SST,SFLX,USTART(1),ULEN(1),STACK(TOP-I), 00805 1. . . NXIFNO,LINENO,FORTCL) 00806 . . ...FIN 00807 . . ELSE 00808 C ALECS ^^^^^ 00809 C . . . 00810 . . . CALL CPYSTR(SST,SIFP) 00811 . . . CALL CATSUB(SST,SFLX,USTART(1),ULEN(1)) 00812 . . . CALL CATSTR(SST,SNE) 00813 . . . I=STACK(TOP-4) 00814 . . . CALL CATSTR(SST,STACK(TOP-I)) 00815 . . . CALL CATSTR(SST,SPGOTO) 00816 . . . NXIFNO=NEWNO(0) 00817 . . . STACK(TOP-2)=NXIFNO 00818 . . . CALL CATNUM(SST,NXIFNO) !"IF((E1.NE.(E))GOTO NXIFNO" 00819 . . . STNO=0 00820 . . . PUT-STATEMENT 00821 C . . . 00822 C ALECS VVVVV 00823 . . ...FIN 00824 C ALECS ^^^^^ 00825 C . . 00826 . ...FIN 00827 . ELSE STACK(TOP-2)=0 !FOR (OTHERWISE) 00828 . COMPLETE-ACTION 00829 ...FIN ---------------------------------------- 00830 TO COMPILE-SIMPLE-FIN 00831 C . 00832 C . FOR IF() OR UNLESS() OR WHEN() OR ELSE (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00017 M,M/-SP=M 00833 C . 00834 . SET-UP-STATEMENT-NUMBER 00835 . LEVEL=LEVEL-1 00836 . TOP=TOP-2 00837 ...FIN ---------------------------------------- 00838 TO COMPILE-TO !PROCESS TO C-O-A, TO C-O-A FORT OR TO C-O-A A-B 00839 . FIND-ENTRY 00840 . WHEN(STACK(PENT+2).NE.0) !THIS PROCEDURE NEVER REFERENCED(?) 00841 . . ERROR=26 00842 . . MLINE=STACK(PENT+2) 00843 . . ENTNO=NEWNO(0) 00844 . ...FIN 00845 . ELSE !GET ENTRY LABEL 00846 . . ENTNO=STACK(PENT+1) 00847 . . STACK(PENT+2)=LINENO 00848 . ...FIN 00849 . SET-UP-STATEMENT-NUMBER !IF STMNT # ON FLX LINE, PUT INTO NEXTNO 00850 . FORCE-NEXT-NUMBER !--> 'ENTNO' CONTINUE 00851 . NEXTNO=ENTNO 00852 . FORCE-NEXT-NUMBER 00853 . TOP=TOP+2 00854 . STACK(TOP)=AGRET 00855 . WHEN (SHORT.OR.FAKE) STACK(TOP-1)=ENTNO !SHORT .T. IN THIS VERSI 00856 . ELSE STACK(TOP-1)=STACK(PENT-1) 00857 . UTYPE(1)=0 00858 . COMPLETE-ACTION 00859 ...FIN ---------------------------------------- 00860 TO COMPILE-UNLESS 00861 C . 00862 C ALECS VVVVV 00863 . WHEN(ALECS) 00864 . . NOTFLG=.FALSE. 00865 . . FINISH-IF-UNLESS 00866 . ...FIN 00867 . ELSE 00868 C ALECS ^^^^^ 00869 C . . 00870 . . WHEN (NUNITS.EQ.2.AND.UTYPE(2).EQ.UFORT) !UNLESS()FORT 00871 . . . CALL CPYSTR(SST,SIFPN) 00872 . . . CALL CATSUB(SST,SFLX,USTART(1),ULEN(1)) 00873 . . . CALL CATSTR(SST,SPB) 00874 . . . CALL CATSUB(SST,SFLX,USTART(2),ULEN(2)) 00875 . . . STNO=FLXNO 00876 . . . PUT-STATEMENT 00877 . . ...FIN 00878 . . ELSE !UNLESS() OR UNLESS()C-O-A 00879 . . . NOTFLG=.FALSE. 00880 . . . FINISH-IF-UNLESS 00881 . . ...FIN (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00018 M,M/-SP=M 00882 C . . 00883 C ALECS VVVVV 00884 . ...FIN 00885 C ALECS ^^^^^ 00886 C . 00887 ...FIN ---------------------------------------- 00888 TO COMPILE-UNTIL !PROCESS AS WHILE(.NOT. 00889 . NOTFLG=.FALSE. 00890 . COMPILE-WHILE 00891 ...FIN ---------------------------------------- 00892 TO COMPILE-WHEN !PROCESS WHEN(), WHEN()FORT OR WHEN()C-O-A 00893 . ENDNO=NEWNO(0) !PAST END OF WHEN-ELSE 00894 . ELSNO=NEWNO(0) !START OF ELSE 00895 . GSTNO=ENDNO 00896 . PUSH-GSTNO !STACK CMD TO PUT OUT STMNT # FOR GOTO TARGET 00897 . TOP=TOP+2 00898 . STACK(TOP-1)=LINENO 00899 . STACK(TOP)=AELSE !STACK CMD TO LOOK FOR ELSE 00900 . GSTNO=ELSNO 00901 . PUSH-GSTNO !PUT ELSE STMNT # ON STACK 00902 . GGOTON=ENDNO 00903 . PUSH-GGOTO !STACK CMD TO GENERATE GOTO AT END OF WHEN CLAUS 00904 . GOTONO=ELSNO !WHERE TO GO IF LOGICAL CONDITION FALSE 00905 . STNO=FLXNO 00906 . FLXNO=0 00907 . PUT-IF-NOT-GOTO !IF(.NOT.(L))GOTO 'ELSENO' 00908 . COMPLETE-ACTION 00909 ...FIN ---------------------------------------- 00910 TO COMPILE-WHILE 00911 . CONDITIONAL !GET STMNT # FOR HEAD OF LOOP 00912 . . (FLXNO.NE.0) 00913 . . . LOOPNO=FLXNO 00914 . . . FLXNO=0 00915 . . ...FIN 00916 . . (NEXTNO.NE.0) 00917 . . . LOOPNO=NEXTNO 00918 . . . NEXTNO=0 00919 . . ...FIN 00920 . . (OTHERWISE) 00921 . . . LOOPNO=NEWNO(0) 00922 . . ...FIN 00923 . ...FIN 00924 . ENDNO=NEWNO(0) 00925 . GSTNO=ENDNO 00926 . PUSH-GSTNO !STMNT # FOR END OF LOOP ONTO STACK 00927 . GGOTON=LOOPNO (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00019 M,M/-SP=M 00928 . PUSH-GGOTO !PUSH CMD TO GENERATE GOTO 'LOOPNO' 00929 . GOTONO=ENDNO 00930 . STNO=LOOPNO 00931 . PUT-IF-NOT-GOTO 00932 . COMPLETE-ACTION 00933 ...FIN ---------------------------------------- 00934 TO COMPLETE-ACTION 00935 C . 00936 C . FOR ALL FLECS LINES OF THE FORMS (), ()FORT, ()C-O-A, 00937 C . C-O-A FORT OR C-O-A A-B DO FINAL PROCESSING 00938 C . 00939 . CONDITIONAL 00940 . . (NUNITS.EQ.1) PUSH-FINSEQ !() 00941 . . (UTYPE(2).EQ.UPINV) COMPILE-INVOKE !PROCEDURE INVOKE ON LIN 00942 . . (OTHERWISE) !FORT ON THE LINE 00943 . . . CALL CPYSUB(SST,SFLX,USTART(2),ULEN(2)) !IS IT JUST "CONTINUE"? 00944 . . . UNLESS (STREQ(SST,SCONT)) COMPILE-FORTRAN 00945 . . ...FIN 00946 . ...FIN 00947 ...FIN ---------------------------------------- 00948 TO FIND-ENTRY !LOCATE PROCEDURE DFN ON STACK 00949 . WHEN (UTYPE(1).EQ.UPINV) J=1 00950 . ELSE J=2 00951 . CALL CPYSUB(SPINV,SFLX,USTART(J),ULEN(J)) 00952 . WHEN (STREQ(SPINV,SDUM)) 00953 . . PENT=PDUMMY 00954 . . STACK(PENT+2)=0 00955 . ...FIN 00956 . ELSE 00957 . . P=MAXSTK-HASH(SPINV,PRIME) 00958 . . FOUND=.FALSE. 00959 . . UNLESS(STACK(P).EQ.0) 00960 . . . REPEAT UNTIL(STACK(P).EQ.0.OR.FOUND) 00961 . . . . P=STACK(P) 00962 . . . . IF (STREQ(SPINV,STACK(P+4))) FOUND=.TRUE. 00963 . . . ...FIN 00964 . . ...FIN 00965 . . WHEN (FOUND) PENT=P 00966 . . ELSE !NOT THERE, CREATE NEW ENTRY 00967 . . . TMAX=MAX-(4+OFFST2+(SPINV(1)+NCHPWD-1)/NCHPWD) 00968 . . . WHEN (TMAX.LE.TOP+SAFETY) 00969 . . . . PENT=PDUMMY 00970 . . . . STACK(PENT+2)=0 00971 . . . ...FIN 00972 . . . ELSE 00973 . . . . MAX=TMAX 00974 . . . . PENT=MAX+OFFST2 00975 . . . . IF (LONG.OR.COGOTO) STACK(PENT-1)=NEWNO(0) 00976 . . . . IF (COGOTO) STACK(PENT-2)=0 (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00020 M,M/-SP=M 00977 . . . . STACK(PENT)=0 00978 . . . . STACK(P)=PENT 00979 . . . . STACK(PENT+1)=NEWNO(0) 00980 . . . . STACK(PENT+2)=0 00981 . . . . STACK(PENT+3)=0 00982 . . . . CALL CPYSTR(STACK(PENT+4),SPINV) 00983 . . . ...FIN 00984 . . ...FIN 00985 . ...FIN 00986 ...FIN ---------------------------------------- 00987 TO FINISH-IF-UNLESS !FLECS IF OR UNLESS 00988 . GOTONO=NEWNO(0) !GET STMNT # TO GOTO 00989 . STNO=FLXNO 00990 . FLXNO=0 00991 . PUT-IF-NOT-GOTO !IF([.NOT.](L))GOTO 00992 . GSTNO=GOTONO 00993 . PUSH-GSTNO 00994 . COMPLETE-ACTION 00995 ...FIN ---------------------------------------- 00996 TO FORCE-NEXT-NUMBER 00997 C . 00998 C . IF THERE IS A STMNT # IN NEXTNO TO BE USED AS TARGET OF A GOTO 00999 C . PUT IT OUT NOW ON A CONTINUE STMNT 01000 C . 01001 . IF (NEXTNO.NE.0) 01002 C . . 01003 C ALECS VVVVV 01004 . . WHEN(ALECS)CALL PUTLBL(NEXTNO,LINENO,FORTCL) 01005 . . ELSE 01006 C ALECS ^^^^^ 01007 C . . . 01008 . . . CALL PUTNUM(SFORCE,NEXTNO) 01009 . . . CALL PUT(LINENO,SFORCE,FORTCL) 01010 C . . . 01011 C ALECS VVVVV 01012 . . ...FIN 01013 C ALECS ^^^^^ 01014 C . . 01015 . . NEXTNO=0 01016 . ...FIN 01017 ...FIN ---------------------------------------- 01018 TO FORCE-OUT-LABELS !30JUN81 01019 C . 01020 C . DIRECTIVES MAY NEED TO PUT OUT ALL OUTSTANDING LINE #S 01021 C . (ALSO NECESSARY FOR ALECS SUBR). 01022 C . (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00021 M,M/-SP=M 01023 . FORCE-NEXT-NUMBER !USE UP NEXTNO 01024 . IF(STNO.NE.0) 01025 . . NEXTNO=STNO 01026 . . FORCE-NEXT-NUMBER 01027 . . STNO=0 01028 . ...FIN 01029 . IF (FLXNO.NE.0) 01030 . . NEXTNO=FLXNO 01031 . . FORCE-NEXT-NUMBER 01032 . . FLXNO=0 01033 . ...FIN!if 01034 ...FIN ---------------------------------------- 01035 TO GENERATE-BRANCH-AROUND-AND-ESTABLISH-NEXT-NUMBER 01036 C . 01037 C . USED BY CONDITIONAL AND SELECT LOGIC SUBCLAUSES 01038 C . 01039 . ENDNO=STACK(TOP-3) 01040 . WHEN (ENDNO.EQ.0) !.T. FOR FIRST SUBCLAUSE SEEN 01041 . . STACK(TOP-3)=NEWNO(0) 01042 . ...FIN 01043 . ELSE !FOR 2ND AND THEREAFTER NEED GOTO FOR PREVIOUS SUBCLAUSE 01044 . . GOTONO=ENDNO 01045 . . PUT-GOTO 01046 . ...FIN 01047 . CONDITIONAL 01048 . . (NEXTNO.EQ.0) NEXTNO=STACK(TOP-2) 01049 . . (STACK(TOP-2).EQ.0) CONTINUE 01050 . . (OTHERWISE) 01051 . . . FORCE-NEXT-NUMBER 01052 . . . NEXTNO=STACK(TOP-2) 01053 . . ...FIN 01054 . ...FIN 01055 ...FIN ---------------------------------------- 01056 TO GENERATE-CONTINUE !DO LOOP TERMINATING CONTINUE 01057 C . 01058 C ALECS VVVVV 01059 . WHEN(ALECS) 01060 . . FORCE-OUT-LABELS 01061 . . CALL ALEBRI(STACK(TOP-1),LINENO,FORTCL) 01062 . ...FIN 01063 . ELSE 01064 C ALECS ^^^^^ 01065 C . . 01066 . . STNO=STACK(TOP-1) 01067 . . PUT-CONTINUE 01068 C . . 01069 C ALECS VVVVV 01070 . ...FIN 01071 C ALECS ^^^^^ (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00022 M,M/-SP=M 01072 C . 01073 . TOP=TOP-2 01074 ...FIN ---------------------------------------- 01075 TO GENERATE-GOTO 01076 C . 01077 C . GENERATE A GOTO, EG FROM END OF WHEN CLAUSE TO PAST END OF FIN 01078 C . 01079 . GOTONO=STACK(TOP-1) 01080 . PUT-GOTO 01081 . TOP=TOP-2 01082 ...FIN 01083 C 01084 C COMMENT OUT FOLLOWING PROCEDURE TO SHORTEN FLECS !11-SEP-75 01085 C 01086 C TO GENERATE-PROCEDURE-DISPATCH-AREA 01087 C P=PTABLE 01088 C UNTIL (P.EQ.0) 01089 C WHEN (STACK(P+2).NE.0) 01090 C WHEN (LONG) 01091 C CALL CPYSTR(SST,SGOTOI) 01092 C CALL CATNUM(SST,STACK(P+1)) 01093 C CALL CATSTR(SST,SCP) 01094 C FIN 01095 C ELSE CALL CPYSTR(SST,SGOTOP) 01096 C Q=STACK(P+3) 01097 C STNO=STACK(P-1) 01098 C WHEN(Q.EQ.0) CALL CATNUM(SST,STACK(P+1)) 01099 C ELSE 01100 C REPEAT UNTIL (Q.EQ.0) 01101 C IF (SST(1).GT.SSTMAX-6) 01102 C PUT-STATEMENT 01103 C CALL CPYSTR(SST,SB5I1) 01104 C FIN 01105 C CALL CATNUM(SST,STACK(Q+2)) 01106 C CALL CATSTR(SST,SCOMMA) 01107 C Q=STACK(Q) 01108 C FIN 01109 C SST(1)=SST(1)-1 01110 C FIN 01111 C WHEN (LONG) CALL CATSTR(SST,SRP) 01112 C ELSE 01113 C IF(SST(1).GT.SSTMAX-9) 01114 C PUT-STATEMENT 01115 C CALL CPYSTR(SST,SB5I1) 01116 C FIN 01117 C CALL CATSTR(SST,SRPCI) 01118 C CALL CATNUM(SST,STACK(P+1)) 01119 C FIN 01120 C PUT-STATEMENT 01121 C FIN 01122 C ELSE 01123 C CALL CPYSTR(SST,SSTOP) (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00023 M,M/-SP=M 01124 C STNO=STACK(P+1) 01125 C PUT-STATEMENT 01126 C FIN 01127 C P=STACK(P) 01128 C FIN 01129 C FIN ---------------------------------------- 01130 TO GENERATE-RETURN-FROM-PROC 01131 . STNO=0 01132 C . 01133 C ALECS VVVVV 01134 . WHEN(ALECS) 01135 . . FORCE-OUT-LABELS 01136 . . CALL ALERTS(LINENO,FORTCL) 01137 . ...FIN 01138 . ELSE 01139 C ALECS ^^^^^ 01140 C . . 01141 . . CALL CPYSTR(SST,SGOTOI) 01142 . . IF (LONG.OR.COGOTO) SST(1)=SST(1)-1 01143 . . CALL CATNUM(SST,STACK(TOP-1)) !GOTO I# 01144 . . IF (FAKE) !NOT IN THIS VERSION 01145 . . . CALL CATSTR(SST,SCP) 01146 . . . CALL CATNUM(SST,STACK(TOP-1)) 01147 . . . CALL CATSTR(SST,SRP) 01148 . . ...FIN 01149 . . PUT-STATEMENT 01150 C . . 01151 C ALECS VVVVV 01152 . ...FIN 01153 C ALECS ^^^^^ 01154 C . 01155 . TOP=TOP-2 01156 ...FIN ---------------------------------------- 01157 TO GENERATE-STATEMENT-NUMBER 01158 C . 01159 C . PUT SAVED GOTO TARGET # INTO NEXTNO SO IT WILL APPEAR ON 01160 C . NEXT STMNT 01161 C . 01162 . FORCE-NEXT-NUMBER 01163 . NEXTNO=STACK(TOP-1) 01164 . TOP=TOP-2 01165 ...FIN ---------------------------------------- 01166 TO GIVE-UP !ABORT ON STACK OVERFLOW 01167 . CALL PUT(0,SGUP1,ERRCL) 01168 . CALL PUT(0,SGUP2,ERRCL) 01169 . CALL CLOSEF(MINCNT,-1) (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00024 M,M/-SP=M 01170 . CALL EXFLE !MAO, 30-APR-80 01171 ...FIN 01172 C 01173 C THE FOLLOWING PROCEDURE IS NOT USED IF LINE IN 01174 C "TO PREPARE-TO PROCESS-PROGRAM" IS COMMENTED OUT 30JUN81M 01175 C 01176 C TO LIST-DASHES 01177 C CALL PUT(0,SB,LISTCL) !BLANK LINE 01178 C CALL PUT(0,SDASH,LISTCL) !DASH LINE 01179 C CALL PUT(0,SB,LISTCL) !BLANK LINE 01180 C FIN ---------------------------------------- 01181 TO OPEN-INCLUDE-FILE !29-JUN- 01182 C . 01183 C . PROCESS .INCLUDE name 01184 C . 01185 . CALL CPYSUB (SST,SFLX,USTART(1),ULEN(1)) 01186 . CALL OPNINC (SST(1),SST(2),ERROR) 01187 . IF (ERROR.NE.0) ERROR=ERROR+300 01188 ...FIN!to open-include-file ---------------------------------------- 01189 TO PERFORM-INITIALIZATION !CALLED ONCE PER EXECUTION OF FL 01190 C . 01191 C ALECS VVVVV 01192 . CALL LAMPFI(ALECS,CHC,CINLIN) !20-FEB-80 01193 C ALECS ^^^^^ 01194 C . 01195 . NOCALL=0 !# OF TIMES OPENF HAS BEEN CALLED 01196 . PARAM1=NCHPWD !# OF CHARACTERS PER INTEGER WORD 01197 . PARAM2=CHZERO 01198 . PARAM3=CHSPAC 01199 . PARAM4=CHC !COMMENT CHARACTER 01200 . PARAM5=CINLIN !IN-LINE COMMENT CHAR !25-JAN-80 01201 . BLN=0 01202 . WWIDTH=LWIDTH-10 !11-SEP-75 01203 . REFNO=(LWIDTH-16)/7 !11-SEP-75 01204 . CONDITIONAL 01205 . . (SHORT.OR.FAKE) 01206 . . . OFFSET=1 01207 . . . OFFST2=1 01208 . . ...FIN 01209 . . (COGOTO) 01210 . . . OFFSET=2 01211 . . . OFFST2=3 01212 . . ...FIN 01213 . . (OTHERWISE) 01214 . . . OFFSET=2 01215 . . . OFFST2=3 01216 . . ...FIN 01217 . ...FIN 01218 . NOTFLG=.TRUE. (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00025 M,M/-SP=M 01219 . ERLST=.FALSE. 01220 ...FIN ---------------------------------------- 01221 TO POP-STACK 01222 . TOPTYP=STACK(TOP) 01223 . SELECT (TOPTYP) 01224 . . (ASSEQ) TOP=TOP-STACK(TOP-4)-1 01225 . . (ACSEQ) TOP=TOP-4 01226 . . (AGGOTO) TOP=TOP-2 01227 . . (AGCONT) TOP=TOP-2 01228 . . (AFSEQ) TOP=TOP-2 01229 . . (AELSE) TOP=TOP-2 01230 . . (AGSTNO) TOP=TOP-2 01231 . . (ATSEQ) TOP=TOP-1 01232 . . (AMSEQ) TOP=TOP-1 01233 . . (AGRET) TOP=TOP-2 01234 . ...FIN 01235 ...FIN ---------------------------------------- 01236 TO PREPARE-TO-PROCESS-PROGRAM 01237 . DUMMY=NEWNO(SEEDNO) !INITIALIZE STMNT # GENERATOR 01238 . ENDPGM=.FALSE. 01239 . MAX=MAXSTK-(PRIME+OFFSET+3) 01240 . PDUMMY=MAX+OFFSET 01241 . DO (I=MAX,MAXSTK) STACK(I)=0 01242 . TOP=1 !START OF STACK 01243 . STACK(TOP)=AMSEQ !INITIAL CMD IS LOOK FOR FLECS MAIN LINE OR FORT 01244 . ERROR=0 01245 . FIRST=.TRUE. !THIS IS FIRST READ ON THIS FILE 01246 . NOPGM=.FALSE. 01247 . NEXTNO=0 !STMNT # FOR NEXT STMNT PUT IN FTN FILE 01248 . SOURCE=READ !GET INPUT FROM FILE 01249 . LEVEL=0 01250 . LSTLEV=0 01251 . PASFLG=.TRUE. !30JUN81 01252 . CNDLVL=0 !30JUN81MAO 01253 . OFFLVL=0 !30JUN81MAO 01254 C . 01255 C . NEXT LINE PREVENTS .NAME name FROM WORKING FOR 1ST PAGE 01256 C . OF FLL FILE. THUS IT WAS COMMENTED OUT. 30JUN81MAO 01257 C . 01258 C . LIST-DASHES 01259 ...FIN ---------------------------------------- 01260 TO PROCESS-DIRECTIVE !22-JUN-81 01261 C . 01262 C . PROCESS THE FLECS DIRECTIVES 01263 C . 01264 . SELECT (DTYPE) (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00026 M,M/-SP=M 01265 . . (DPAGE) PUT-OUT-NEW-PAGE 01266 . . (DINCL) OPEN-INCLUDE-FILE !29-JUN-81MAO 01267 . . (DPIF) PROCESS-PASSIF !30JUN81 01268 . . (DPUNL) PROCESS-PASSUNLESS !30JUN81 01269 . . (DPEND) PROCESS-PASSEND !30JUN81 01270 . . (DNAME) CHANGE-PAGE-HEADER-NAME !30JUN81 01271 . ...FIN!select 01272 ...FIN!to process-directive ---------------------------------------- 01273 TO PROCESS-PASSEND !process .PASSEND !30JUN81 01274 . FORCE-OUT-LABELS !just to be safe 01275 . WHEN (CNDLVL.EQ.0) ERROR=401 !extra .PASSEND 01276 . ELSE 01277 . . IF (CNDLVL.EQ.OFFLVL) PASFLG=.TRUE. !back on 01278 . . CNDLVL=CNDLVL-1 01279 . ...FIN!else 01280 ...FIN!to process-passend ---------------------------------------- 01281 TO PROCESS-PASSIF !process .PASSIF name !30JUN81MAO 01282 C . 01283 . FORCE-OUT-LABELS !MUST do this, vital if turning off output! 01284 . CNDLVL=CNDLVL+1 !one more level of conditional 01285 . IF (PASFLG) !are we passing code? (If not skip below 01286 C . . 01287 C . . Is the conditional name defined? 01288 C . . 01289 . . CALL CPYSUB (SST,SFLX,USTART(1),ULEN(1)) !get the name 01290 . . IF (SST(1).GT.6) !name too long, truncate 01291 . . . SST(1)=6 01292 . . . ERROR=402 01293 . . ...FIN!if 01294 . . IF (SST(1).LT.1) ERROR=403 !no name given! 01295 . . IF (ERROR.EQ.0) 01296 . . . I=1 01297 . . . FOUND=.FALSE. 01298 . . . UNTIL (I.GT.COND .OR. FOUND) 01299 . . . . FOUND=STREQ (SST,CNDVAL(1,I)) 01300 . . . . I=I+1 01301 . . . ...FIN!until 01302 . . . 01303 . . . UNLESS (NOTFLG) FOUND=.NOT.FOUND !invert for .PASSUNLESS 01304 . . . 01305 . . . UNLESS (FOUND) !if wrong sense, turn off passing 01306 . . . . PASFLG=.FALSE. 01307 . . . . OFFLVL=CNDLVL 01308 . . . ...FIN!unless 01309 . . ...FIN!if 01310 . ...FIN!if 01311 ...FIN!to process-passif ---------------------------------------- (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00027 M,M/-SP=M 01312 TO PROCESS-PASSUNLESS !process .PASSUNLESS !30JUN81 01313 . NOTFLG=.FALSE. !signal really PASSUNLESS 01314 . PROCESS-PASSIF !process 01315 . NOTFLG=.TRUE. !reset to default value 01316 ...FIN!to process-passunless ---------------------------------------- 01317 TO PROCESS-PROGRAM 01318 . REPEAT UNTIL (ENDPGM) !IE. HIT END STATEMENT 01319 . . IF(TOP+SAFETY.GT.MAX) GIVE-UP 01320 . . ACTION=STACK(TOP) !ON FIRST PASS=AMSEQ 01321 . . SELECT (ACTION) 01322 . . . (AGGOTO) GENERATE-GOTO 01323 . . . (AGRET) GENERATE-RETURN-FROM-PROC 01324 . . . (AGCONT) GENERATE-CONTINUE 01325 . . . (AGSTNO) GENERATE-STATEMENT-NUMBER 01326 . . . (OTHERWISE) 01327 . . . . CALL ANALYZ !GET INPUT AND FIGURE OUT WHAT NEEDS DOING 01328 . . . . SELECT (ACTION) 01329 . . . . . (AFSEQ) !A FIN IS OUTSTANDING 01330 . . . . . . SELECT(CLASS) 01331 . . . . . . . (TDIR) PROCESS-DIRECTIVE !22-JUN-81 MAO 01332 . . . . . . . (TEXEC) COMPILE-EXEC 01333 . . . . . . . (TFIN) COMPILE-SIMPLE-FIN 01334 . . . . . . . (TEND) ERROR=1 01335 . . . . . . . (TELSE) ERROR=10 01336 . . . . . . . (TTO) ERROR=13 01337 . . . . . . . (TCEXP) ERROR=19 01338 . . . . . . . (TOFF)CONTINUE !30JUN81 01339 . . . . . . ...FIN 01340 . . . . . ...FIN 01341 . . . . . (AMSEQ) !LOOK FOR MAIN STMNT OR FORT 01342 . . . . . . SELECT(CLASS) 01343 . . . . . . . (TDIR) PROCESS-DIRECTIVE !22-JUN-81 MAO 01344 . . . . . . . (TEXEC) COMPILE-EXEC 01345 . . . . . . . (TEND) 01346 . . . . . . . . WHEN (NOPGM) ENDPGM=.TRUE. 01347 . . . . . . . . ELSE COMPILE-END 01348 . . . . . . . ...FIN 01349 . . . . . . . (TFIN) ERROR=5 01350 . . . . . . . (TELSE) ERROR=8 01351 . . . . . . . (TTO) 01352 . . . . . . . . STACK(TOP)=ATSEQ !NOTE TOP NOT SHIFTED!!-->ONLY PROC DFN LEGAL 01353 . . . . . . . . COMPILE-TO 01354 . . . . . . . ...FIN 01355 . . . . . . . (TCEXP) ERROR=17 01356 . . . . . . . (TOFF)CONTINUE !30JUN81 01357 . . . . . . ...FIN 01358 . . . . . ...FIN 01359 . . . . . (ASSEQ) !LOOKING FOR SELECT SUBCLAUSE 01360 . . . . . . SELECT (CLASS) 01361 . . . . . . . (TDIR) PROCESS-DIRECTIVE !22-JUN-81 MAO 01362 . . . . . . . (TCEXP) COMPILE-SEXP (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00028 M,M/-SP=M 01363 . . . . . . . (TFIN) COMPILE-SEQ-FIN 01364 . . . . . . . (TEND) ERROR=3 01365 . . . . . . . (TELSE) ERROR=12 01366 . . . . . . . (TTO) ERROR=15 01367 . . . . . . . (TEXEC) ERROR=23 01368 . . . . . . . (TOFF)CONTINUE !30JUN81 01369 . . . . . . ...FIN 01370 . . . . . ...FIN 01371 . . . . . (ACSEQ) !LOOKING FOR A CONDITIONAL SUBCLAUSE 01372 . . . . . . SELECT(CLASS) 01373 . . . . . . . (TDIR) PROCESS-DIRECTIVE !22-JUN-81 MAO 01374 . . . . . . . (TCEXP) COMPILE-CEXP 01375 . . . . . . . (TFIN) COMPILE-SEQ-FIN !FIN TERMINATING CONDITIONAL 01376 . . . . . . . (TEND) ERROR=2 01377 . . . . . . . (TELSE) ERROR=11 01378 . . . . . . . (TTO) ERROR=14 01379 . . . . . . . (TEXEC) ERROR=22 01380 . . . . . . . (TOFF)CONTINUE !30JUN81 01381 . . . . . . ...FIN 01382 . . . . . ...FIN 01383 . . . . . (AELSE) !NEED ELSE NEXT 01384 . . . . . . SELECT(CLASS) 01385 . . . . . . . (TDIR) PROCESS-DIRECTIVE !22-JUN-81 MAO 01386 . . . . . . . (TELSE) COMPILE-ELSE 01387 . . . . . . . (TEND) ERROR=4 01388 . . . . . . . (TFIN) ERROR=7 01389 . . . . . . . (TTO) ERROR=16 01390 . . . . . . . (TCEXP) ERROR=20 01391 . . . . . . . (TEXEC) ERROR=24 01392 . . . . . . . (TOFF)CONTINUE !30JUN81 01393 . . . . . . ...FIN 01394 . . . . . ...FIN 01395 . . . . . (ATSEQ) !ONLY TO OR DIRECTIVE OR END LEGAL 01396 . . . . . . SELECT (CLASS) 01397 . . . . . . . (TDIR) PROCESS-DIRECTIVE !22-JUN-81 MAO 01398 . . . . . . . (TTO) COMPILE-TO 01399 . . . . . . . (TEND) COMPILE-END 01400 . . . . . . . (TFIN) ERROR=6 01401 . . . . . . . (TELSE) ERROR=9 01402 . . . . . . . (TCEXP) ERROR=18 01403 . . . . . . . (TEXEC) ERROR=21 01404 . . . . . . . (TOFF)CONTINUE !30JUN81 01405 . . . . . . ...FIN 01406 . . . . . ...FIN 01407 . . . . ...FIN 01408 . . . . UNLESS (NOPGM .OR. CLASS.EQ.TOFF) CALL LIST !30JUN81MAO 01409 . . . ...FIN 01410 . . ...FIN 01411 . ...FIN 01412 ...FIN ---------------------------------------- 01413 TO PUSH-FINSEQ !FOR IF(), UNLESS(), WHEN() OR ELSE< 01414 . TOP=TOP+2 (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00029 M,M/-SP=M 01415 . STACK(TOP-1)=LINENO 01416 . STACK(TOP)=AFSEQ 01417 . LEVEL=LEVEL+1 01418 ...FIN ---------------------------------------- 01419 TO PUSH-GCONT !TERMINATING CONTINUE FOR DO 01420 . TOP=TOP+2 01421 . STACK(TOP-1)=CONTNO 01422 . STACK(TOP)=AGCONT 01423 ...FIN ---------------------------------------- 01424 TO PUSH-GGOTO !PUT CMD TO GENERAGE A GOTO 'GGOTON' ON STACK 01425 . TOP=TOP+2 01426 . STACK(TOP-1)=GGOTON 01427 . STACK(TOP)=AGGOTO 01428 ...FIN ---------------------------------------- 01429 TO PUSH-GSTNO !PUT STMNT # THAT IS TARGET OF GOTO ON STACK 01430 . TOP=TOP+2 01431 . STACK(TOP-1)=GSTNO 01432 . STACK(TOP)=AGSTNO 01433 ...FIN ---------------------------------------- 01434 TO PUT-CONTINUE !PUT OUT "'STNO' CONTINUE" 01435 . FORCE-NEXT-NUMBER !MAKE SURE NEXTNO IS USED UP 01436 C . 01437 C ALECS VVVVV 01438 . WHEN(ALECS)CALL PUTLBL(STNO,LINENO,FORTCL) 01439 . ELSE 01440 C ALECS ^^^^^ 01441 C . . 01442 . . CALL PUTNUM(SFORCE,STNO) 01443 . . CALL PUT(LINENO,SFORCE,FORTCL) 01444 C . . 01445 C ALECS VVVVV 01446 . ...FIN 01447 C ALECS ^^^^^ 01448 C . 01449 . STNO=0 01450 ...FIN ---------------------------------------- 01451 TO PUT-COPY !PUT A LINE INTO FTN FILE FROM STRING SFLX 01452 C . 01453 C . IF "#" IN COL 1, REMOVE FOR OUTPUT TO FTN FILE. 01454 C . (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00030 M,M/-SP=M 01455 . CALL CPYSTR (SST,SFLX) !26JUN81MAO 01456 . CALL GETCH (SST(2),1,I) !# IN COL 1? !26-JUN-81(MAO) 01457 . IF (I.EQ.POUND)CALL PUTCH (SST(2),1,CHSPAC) !BLANK OUT !26JUN81MAO 01458 . CONDITIONAL 01459 . . (NEXTNO.EQ.0) CALL PUT(LINENO,SST,FORTCL) !26JUN81MAO 01460 . . (FLXNO.NE.0.OR.PASS) !WAS SOMETHING IN COL1-5 OF FLX LINE 01461 . . . FORCE-NEXT-NUMBER 01462 . . . CALL PUT(LINENO,SST,FORTCL) !26JUN81MAO 01463 . . ...FIN 01464 . . (OTHERWISE) !PUT NEXTNO ON LINE AND OUTPUT IT 01465 C . . . 01466 C ALECS VVVVV 01467 . . . WHEN(ALECS) 01468 . . . . CALL PUTLBL(NEXTNO,LINENO,FORTCL) 01469 . . . . CALL PUT(LINENO,SST,FORTCL) !26JUN81MAO 01470 . . . ...FIN 01471 . . . ELSE 01472 C ALECS ^^^^^ 01473 C . . . . 01474 . . . . CALL PUTNUM(SST,NEXTNO) 01475 . . . . CALL PUT(LINENO,SST,FORTCL) 01476 C . . . . 01477 C ALECS VVVVV 01478 . . . ...FIN 01479 C ALECS ^^^^^ 01480 C . . . 01481 . . . NEXTNO=0 01482 . . ...FIN 01483 . ...FIN 01484 ...FIN ---------------------------------------- 01485 TO PUT-GOTO !PUT OUT A GOTO 'GOTONO' 01486 C . 01487 C ALECS VVVVV 01488 . WHEN(ALECS) 01489 . . FORCE-OUT-LABELS 01490 . . CALL ALEBRI(GOTONO,LINENO,FORTCL) 01491 . ...FIN 01492 . ELSE 01493 C ALECS ^^^^^ 01494 C . . 01495 . . CALL CPYSTR(SPUTGO,SGOTO) 01496 . . CALL CATNUM(SPUTGO,GOTONO) 01497 . . IF (NEXTNO.NE.0) 01498 . . . CALL PUTNUM(SPUTGO,NEXTNO) 01499 . . . NEXTNO=0 01500 . . ...FIN 01501 . . CALL PUT(LINENO,SPUTGO,FORTCL) 01502 C . . 01503 C ALECS VVVVV 01504 . ...FIN 01505 C ALECS ^^^^^ 01506 C . (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00031 M,M/-SP=M 01507 ...FIN ---------------------------------------- 01508 TO PUT-IF-NOT-GOTO 01509 C . 01510 C . PUT OUT IF(.NOT.())GOTO OR IF()GOTO 01511 C . 01512 C ALECS VVVVV 01513 . WHEN(ALECS) 01514 . . FORCE-OUT-LABELS 01515 . . CALL PUTLOG(SFLX,USTART(1),ULEN(1),NOTFLG,GOTONO,LINENO, 01516 1. . MAJCNT,FORTCL,ERRCL) 01517 . ...FIN 01518 . ELSE 01519 C ALECS ^^^^^ 01520 C . . 01521 . . WHEN(NOTFLG) CALL CPYSTR(SST,SIFPN) 01522 . . ELSE CALL CPYSTR(SST,SIF) 01523 . . CALL CATSUB(SST,SFLX,USTART(1),ULEN(1)) 01524 . . WHEN (NOTFLG) CALL CATSTR(SST,SPGOTO) 01525 . . ELSE CALL CATSTR(SST,SBGOTO) 01526 . . CALL CATNUM(SST,GOTONO) 01527 . . PUT-STATEMENT 01528 C . . 01529 C ALECS VVVVV 01530 . ...FIN 01531 C ALECS ^^^^^ 01532 C . 01533 . NOTFLG=.TRUE. 01534 ...FIN ---------------------------------------- 01535 TO PUT-OUT-NEW-PAGE !22-JUN-81 MAO 01536 C . 01537 C . .PAGE FORCES A NEW PAGE 01538 C . 01539 . CALL NEWPG 01540 ...FIN!to put-out-new-page ---------------------------------------- 01541 TO PUT-STATEMENT !PUT OUTPUT IN FTN FILE 01542 . UNLESS (NEXTNO.EQ.0) !MUST USE UP NEXTNO 01543 . . WHEN (STNO.EQ.0) 01544 . . . STNO=NEXTNO 01545 . . . NEXTNO=0 01546 . . ...FIN 01547 . . ELSE FORCE-NEXT-NUMBER 01548 . ...FIN 01549 . UNLESS (STNO.EQ.0) 01550 C . . 01551 C ALECS VVVVV 01552 . . WHEN(ALECS)CALL PUTLBL(STNO,LINENO,FORTCL) (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00032 M,M/-SP=M 01553 . . ELSE 01554 C ALECS ^^^^^ 01555 C . . . 01556 . . . CALL PUTNUM(SST,STNO) 01557 C . . . 01558 C ALECS VVVVV 01559 . . ...FIN 01560 C ALECS ^^^^^ 01561 C . . 01562 . . STNO=0 01563 . ...FIN 01564 C . 01565 C . PUT OUT FORTRAN LINE, WITH CONTINUATION LINES IF >72 COLUMNS 01566 C . 01567 . WHEN (SST(1).LE.72) CALL PUT(LINENO,SST,FORTCL) 01568 . ELSE 01569 . . CALL CPYSUB (SLIST,SST,1,72) 01570 . . CALL PUT(LINENO,SLIST,FORTCL) 01571 . . S=73 01572 . . L=66 01573 . . REPEAT UNTIL (S.GT.SST(1)) 01574 . . . IF(S+L-1.GT.SST(1)) L=SST(1)-S+1 01575 . . . CALL CPYSTR(SLIST,SB5I1) 01576 . . . CALL CATSUB(SLIST,SST,S,L) 01577 . . . CALL PUT(LINENO,SLIST,FORTCL) 01578 . . . S=S+66 01579 . . ...FIN 01580 . ...FIN 01581 ...FIN ---------------------------------------- 01582 TO REVERSE-LIST 01583 . LL=0 01584 . LR=STACK(LP) 01585 . UNTIL (LR.EQ.0) 01586 . . LT=STACK(LR) 01587 . . STACK(LR)=LL 01588 . . LL=LR 01589 . . LR=LT 01590 . ...FIN 01591 . STACK(LP)=LL 01592 ...FIN ---------------------------------------- 01593 TO SET-UP-STATEMENT-NUMBER 01594 . IF (FLXNO.NE.0) !IF IS STMNT # ON LINE FROM FLX FILE 01595 . . FORCE-NEXT-NUMBER !USE UP NEXTNO AS 'NEXTNO' CONTINUE 01596 . . NEXTNO=FLXNO 01597 . . FLXNO=0 01598 . ...FIN 01599 ...FIN ---------------------------------------- (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00033 M,M/-SP=M 01600 TO SORT-TABLE 01601 . P=MAX 01602 . STACK(MAX)=0 01603 . ITEMP=MAXSTK-PRIME+1 01604 . DO (I=ITEMP,MAXSTK) 01605 . . UNLESS (STACK(I).EQ.0) 01606 . . . STACK(P)=STACK(I) 01607 . . . REPEAT UNTIL (STACK(P).EQ.0) 01608 . . . . P=STACK(P) 01609 . . . . LP=P+3 01610 . . . . REVERSE-LIST 01611 . . . ...FIN 01612 . . ...FIN 01613 . ...FIN 01614 . Q=MAX-1 01615 . STACK(Q)=0 01616 . UNTIL (STACK(MAX).EQ.0) 01617 . . P=STACK(MAX) 01618 . . STACK(MAX)=STACK(P) 01619 . . QM=Q 01620 . . QP=STACK(QM) 01621 . . INSERT=.FALSE. 01622 . . UNTIL (INSERT) 01623 . . . CONDITIONAL 01624 . . . . (QP.EQ.0) INSERT=.TRUE. 01625 . . . . (STRLT(STACK(P+4),STACK(QP+4))) INSERT=.TRUE. 01626 . . . . (OTHERWISE) 01627 . . . . . QM=QP 01628 . . . . . QP=STACK(QM) 01629 . . . . ...FIN 01630 . . . ...FIN 01631 . . ...FIN 01632 . . STACK(P)=QP 01633 . . STACK(QM)=P 01634 . ...FIN 01635 . PTABLE=STACK(Q) 01636 ...FIN 01637 END ---------------------------------------- PROCEDURE CROSS-REFERENCE TABLE 00580 CHANGE-PAGE-HEADER-NAME 01270 00587 COMPILE-CEXP 01374 00598 COMPILE-CONDITIONAL 00677 00611 COMPILE-DO 00679 (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00034 M,M/-SP=M 00644 COMPILE-ELSE 01386 00656 COMPILE-END 01347 01399 00666 COMPILE-EXEC 01332 01344 00682 COMPILE-FORTRAN 00651 00944 00690 COMPILE-IF 00669 00705 COMPILE-INVOKE 00648 00676 00941 00747 COMPILE-RUNTIL 00675 00751 COMPILE-RWHILE 00674 00749 00768 COMPILE-SELECT 00678 00784 COMPILE-SEQ-FIN 01363 01375 00793 COMPILE-SEXP 01362 00830 COMPILE-SIMPLE-FIN 01333 00838 COMPILE-TO 01353 01398 00860 COMPILE-UNLESS 00670 00888 COMPILE-UNTIL 00673 00892 COMPILE-WHEN 00671 00910 COMPILE-WHILE 00672 00890 00934 COMPLETE-ACTION 00596 00642 00766 00828 00858 00908 00932 00994 (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00035 M,M/-SP=M 00948 FIND-ENTRY 00706 00839 00987 FINISH-IF-UNLESS 00693 00698 00865 00880 00996 FORCE-NEXT-NUMBER 00789 00850 00852 01023 01026 01031 01051 01162 01435 01461 01547 01595 01018 FORCE-OUT-LABELS 00615 00717 00800 01060 01135 01274 01283 01489 01514 01035 GENERATE-BRANCH-AROUND-AND-ESTABLISH-NEXT-NUMBER 00588 00794 01056 GENERATE-CONTINUE 01324 01075 GENERATE-GOTO 01322 01130 GENERATE-RETURN-FROM-PROC 01323 01157 GENERATE-STATEMENT-NUMBER 01325 01166 GIVE-UP 00782 01319 01181 OPEN-INCLUDE-FILE 01266 01189 PERFORM-INITIALIZATION 00563 01221 POP-STACK 00791 01236 PREPARE-TO-PROCESS-PROGRAM 00573 01260 PROCESS-DIRECTIVE 01331 01343 01361 01373 01385 01397 01273 PROCESS-PASSEND 01269 01281 PROCESS-PASSIF 01267 01314 01312 PROCESS-PASSUNLESS 01268 01317 PROCESS-PROGRAM (FLECS VERSION 22.38) 18-NOV-82 16:09:31 PAGE 00036 M,M/-SP=M 00574 01413 PUSH-FINSEQ 00654 00940 01419 PUSH-GCONT 00620 00629 01424 PUSH-GGOTO 00764 00903 00928 01429 PUSH-GSTNO 00617 00762 00896 00901 00926 00993 01434 PUT-CONTINUE 00788 01067 01451 PUT-COPY 00661 00668 00697 01485 PUT-GOTO 00739 00757 01045 01080 01508 PUT-IF-NOT-GOTO 00593 00760 00907 00931 00991 01535 PUT-OUT-NEW-PAGE 01265 01541 PUT-STATEMENT 00636 00688 00737 00820 00876 01149 01527 01582 REVERSE-LIST 01610 01593 SET-UP-STATEMENT-NUMBER 00589 00609 00646 00752 00769 00786 00795 00834 00849 01600 SORT-TABLE 00659 (FLECS VERSION 22.38) M,M/-SP=M