(FLECS VERSION 22.38) 18-NOV-82 16:05:52 PAGE 00001 A,A/-SP=A 00001 C;+ 00002 C - A N A L Y Z 00003 C****NAME: SUBROUTINE ANALYZ 00004 C IDENT: /17AUG1/ 00005 C FILE: [201,13]A.FLX 00006 C TKB: 00007 C 00008 C****PURPOSE: OBTAIN AND ANALYZE NEXT FLECS STATEMENT 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 25-JAN-80 (MAO) MAKE COMMENTS ON FLECS LINES LEGAL IF PRECEEDED 00018 C BY AN EXCLAIMATION POINT. 00019 C 26-JAN-80 (MAO) COMMENT CODE 00020 C 14-FEB-80 (MAO) ALLOW COMMENTS IN FTN OUTPUT, ADD /MACVAL/ 00021 C 20-FEB-80 (MAO) ADD ALECS CODE; NOTE ALL ALECS CODE IS DELIMITED BY 00022 C C 00023 C C ALECS VVVVV 00024 C ALECS CODE 00025 C C ALECS ^^^^^ 00026 C C 00027 C IF YOU DO NOT WANT ALECS, SIMPLY COMMENT OUT THE DELIMITED LINES. 00028 C 15-SEP-80 (MAO) TREAT FORMFEED AS A COMMENT LINE 00029 C 22-JUN-81 (MAO) ENABLE FLECS DIRECTIVES 00030 C 22-JUN-81 (MAO) ADD .PAGE DIRECTIVE 00031 C 22-JUN-81 (MAO) TREATE ALECS .END PROCESSING AS A DIRECTIVE 00032 C 29-JUN-81 (MAO) ADD .INCLUDE PROCESSING 00033 C 30-JUN-81 (MAO) ADD .PASSx DIRECTIVES 00034 C 30-JUN-81 (MAO) ADD .NAME DIRECTIVE 00035 C 17-AUG-81 (MAO) MAKE SURE MACRO-11 .IF IS NOT TREATED AS FLECS CMD 00036 C 00037 C****CALLING SEQUENCE: CALL ANALYZ 00038 C 00039 C INPUT: NONE 00040 C 00041 C OUTPUT: NONE 00042 C 00043 C CMN BLOCK I/O: BLANK COMMON, /PARAM/, /MACVAL/ 00044 C 00045 C****DIALOG: NONE 00046 C 00047 C RESOURCES: 00048 C LIBRARIES: NONE 00049 C OTHER SUBR: [201,13]CATSTR,CATSUB,CHTYP,CPYSTR,CPYSUB,GET,GETCH,PUT, 00050 C PUTCH,STREQ 00051 C DISK FILES: NONE 00052 C DEVICES: NONE 00053 C SGAS: NONE 00054 C EVENT FLAGS: NONE 00055 C SYSTEM DIR: NONE (FLECS VERSION 22.38) 18-NOV-82 16:05:52 PAGE 00002 A,A/-SP=A 00056 C LENGTH/PAR: 00057 C 00058 C****NOTES: 00059 C 1. NONSTANDARD FEATURE: A COMMENT MAY BE PUT ON A FLECS LINE 00060 C IF IT IS PRECEDED BY AN EXCLAIMATION POINT, EG. 00061 C 00062 C WHEN(I.GT.J) !WILL ONLY HAPPEN FOR ABNORMAL DATA 00063 C 00064 C;- 00065 SUBROUTINE ANALYZ 00066 C 00067 C SUBROUTINE TO OBTAIN AND ANALYZE NEXT FLECS STATEMENT 00068 C 00069 C 00070 C--------------------------------------- 00071 C 00072 C FLECS TRANSLATOR (PRELIMINARY VERSION 22) 00073 C (FOR A MORE PRECISE VERSION NUMBER, SEE THE STRING SVER) 00074 C 00075 C AUTHOR -- TERRY BEYER 00076 C 00077 C ADDRESS -- COMPUTING CENTER 00078 C UNIVERSITY OF OREGON 00079 C EUGENE, OREGON 97405 00080 C 00081 C TELEPHONE -- (503) 686-4416 00082 C 00083 C DATE -- NOVEMBER 20, 1974 00084 C 00085 C--------------------------------------- 00086 C 00087 C DISCLAIMER 00088 C 00089 C NEITHER THE AUTHOR NOR THE UNIVERSITY OF OREGON SHALL BE 00090 C LIBAL FOR ANY DIRECT OR INDIRECT, INCIDENTAL, CONSEQUENTIAL, 00091 C OR SPECIFIC DAMAGES OF ANY KIND OR FROM ANY CAUSE WHATSOEVER 00092 C ARISING OUT OF OR IN ANY WAY CONNECTED WITH THE USE OR 00093 C PERFORMANCE OF THIS PROGRAM. 00094 C 00095 C--------------------------------------- 00096 C 00097 C SPECIAL NOTES FOR THE PDP-11 00098 C 00099 C 00100 C 1. DUE TO A RESTRICTION IN THE DOS FORTRAN COMPILER, 00101 C ALL DATA STATEMENTS HAVE BEEN COMMENTED OUT IN THEIR 00102 C ORIGINAL LOCATIONS AND HAVE BEEN REPRODUCED IN A BLOCK 00103 C AT THE END OF THE OTHER DECLARATIONS. 00104 C 00105 C 2. DUE TO THE INABILITY OF THE DOS FORTRAN COMPILER TO 00106 C CORRECTLY INTERPRET THE STATEMENT CALLNO=CALLNO+1 00107 C THE VARIABLE CALLNO HAS BEEN RENAMED TO NOCALL 00108 C 00109 C--------------------------------------- 00110 C (FLECS VERSION 22.38) 18-NOV-82 16:05:52 PAGE 00003 A,A/-SP=A 00111 C FOLLOWING FOR LAMPF VERSION OF FLECS--14-FEB-80 00112 C 00113 INTEGER DTYPE !22-JUN-81 00114 COMMON/DIR/DTYPE !22-JUN-81 00115 C 00116 LOGICAL PASFLG !30JUN81MAO 00117 INTEGER CNDLVL !30JUN81MAO 00118 INTEGER OFFLVL !30JUN81MAO 00119 INTEGER COND !30JUN81MAO 00120 INTEGER CNDVAL !30JUN81MAO 00121 COMMON/COND/PASFLG,CNDLVL,OFFLVL,COND,CNDVAL(4,10) !30JUN81MAO 00122 C 00123 C ALECS VVVVV 00124 LOGICAL*2 ALECS,LSTFUL !14-FEB-80 00125 INTEGER*2 TYPIN,TYPLST,TYPOUT,CHCMNT !14-FEB-80 00126 COMMON/MACVAL/ALECS,TYPIN,TYPLST,TYPOUT,CHCMNT,LSTFUL !14-FEB-80 00127 C 00128 INTEGER SAEND 00129 C ALECS ^^^^^ 00130 C 00131 C 00132 C--------------------------------------- 00133 C 00134 C INTEGER DECLARATIONS 00135 C 00136 C 00137 INTEGER FORMFD !MAO15-SEP-80 00138 INTEGER DIRCH !MAO22-JUN-81 00139 INTEGER KPAGE !MAO22-JUN-81 00140 INTEGER KPIF,KPUNL,KPEND !30JUN81MAO 00141 INTEGER KNAME !30JUN81MAO 00142 INTEGER TDIR !MAO22-JUN-81 00143 INTEGER TOFF !30JUN81MAO 00144 INTEGER DPAGE !MAO22-JUN-81 00145 INTEGER KINCL,DINCL,UDIR !29-JUN-81MAO 00146 INTEGER DPIF,DPUNL,DPEND !30JUN81MAO 00147 INTEGER DNAME !30JUN81MAO 00148 INTEGER BLN , CH , CHC , CHSPAC, CHTYP , CHTYPE 00149 INTEGER CINLIN !25-JAN-80 00150 INTEGER CHZERO, CLASS , CPOS , CSAVE , CURSOR, CWD 00151 INTEGER ERRCL , ERROR , ERRSTK, ERSTOP 00152 INTEGER EXTYPE, FLXNO , FORTCL, HOLDNO, I , KCOND 00153 INTEGER KDO , KELSE , KEND , KFIN , KIF , KREPT 00154 INTEGER KSELCT, KTO , KUNLES, KUNTIL, KWHEN , KWHILE 00155 INTEGER LEN , LEVEL , LINENO, LISTCL, LSTLEV, MAJCNT 00156 INTEGER MINCNT, MLINE , NCHPWD, NUNITS, PCNT , PTABLE, QP 00157 INTEGER READ , REFNO ,RETRY , SB , SB5 , SB6 00158 INTEGER SB7 , SDASH , SDUM , SEND , SETUP , SFLX 00159 INTEGER SFSPCR, SHOLD , SLIST , SLP , SOURCE, SOWSE 00160 INTEGER SP , SPINV , SPUTGO, SRP , SSPACR, SST 00161 INTEGER SSTMAX, STACK , START , TBLANK, TCEXP , TCOND 00162 INTEGER TDIGIT, TDO , TELSE , TEND , TEOL , TEXEC 00163 INTEGER TFIN , TFORT , THYPHN, TIF , TINVOK, TLETTR 00164 INTEGER TLP , TOP , TOTHER, TRP , TRUNTL, TRWHIL 00165 INTEGER TSELCT, TTO , TUNLES, TUNTIL, TWHEN , TWHILE (FLECS VERSION 22.38) 18-NOV-82 16:05:52 PAGE 00004 A,A/-SP=A 00166 INTEGER UDO , UEXP , UFORT , ULEN , UOWSE , UPINV 00167 INTEGER USTART, UTYPE , WWIDTH 00168 C 00169 C 00170 C--------------------------------------- 00171 C 00172 C LOGICAL DECLARATIONS 00173 C 00174 C 00175 LOGICAL DRCTV !22-JUN-81 MAO 00176 LOGICAL BADCH , CONT , DONE ,ENDFIL, ENDPGM, ERLST , FIRST 00177 LOGICAL FOUND , INDENT, INVOKE, NOPGM , PASS , SAVED , STREQ 00178 C 00179 C--------------------------------------- 00180 C 00181 C ARRAY DECLARATIONS 00182 C 00183 C 00184 C ARRAYS WHICH HOLD RESULTS OF SCANNERS ANALYSIS 00185 DIMENSION UTYPE(3), USTART(3), ULEN(3) 00186 C 00187 C STACK/TABLE AREA AND POINTER TO TOP OF STACK 00188 DIMENSION STACK(2000) 00189 C 00190 C SYNTAX ERROR STACK AND TOP POINTER 00191 DIMENSION ERRSTK(5) 00192 C 00193 C--------------------------------------- 00194 C 00195 C COMMON DECLARATIONS 00196 C (SEE ALSO PARAMETERS BELOW) 00197 C 00198 C 00199 C THE FOLLOWING VARIABLES ARE COMMON TO TWO OR MORE SUBPROGRAMS 00200 COMMON BLN , CLASS , DONE , ENDFIL, ENDPGM, ERLST 00201 COMMON ERROR , ERRSTK, ERSTOP, EXTYPE, FIRST , FLXNO 00202 COMMON FOUND , HOLDNO, LEVEL , LINENO, LSTLEV, MAJCNT 00203 COMMON MINCNT, MLINE , NOPGM , NUNITS, PASS , PTABLE, QP 00204 COMMON REFNO , SAVED , SFLX , SHOLD , SLIST , SOURCE 00205 COMMON SPINV , SPUTGO, SST , STACK , TOP , ULEN 00206 COMMON USTART, UTYPE , WWIDTH 00207 C 00208 C--------------------------------------- 00209 C 00210 C MNEMONIC DECLARATIONS 00211 C 00212 C 00213 C I/O CLASS CODES FOR USE WITH SUBROUTINE PUT 00214 C DATA FORTCL /1/, LISTCL /2/, ERRCL /3/ 00215 C 00216 C TYPE CODES USED BY SCANNERS 00217 C DATA UEXP/1/, UFORT/2/, UOWSE/3/, UPINV/4/, UDO/5/ 00218 C DATA UDIR/6/ !29-JUN- 00219 C 00220 C TYPE CODES OF CHARACTERS (SUPPLIED BY CHTYPE) (FLECS VERSION 22.38) 18-NOV-82 16:05:52 PAGE 00005 A,A/-SP=A 00221 C WARNING - LOGIC IS SENSITIVE TO THE ORDER OF THESE VALUES. 00222 C DATA TLETTR/1/, TDIGIT/2/, THYPHN/3/, TLP/4/, TRP/5/ 00223 C DATA TBLANK/6/, TOTHER/7/, TEOL/8/ 00224 C 00225 C TYPE CODES ASSIGNED TO THE VARIABLE CLASS 00226 C DATA TCEXP/1/, TELSE/2/, TEND/3/, TEXEC/4/, TFIN/5/, TTO/6/ 00227 C DATA TDIR /7/ !22-JUN- 00228 C DATA TOFF /8/ !30JUN81 00229 C 00230 C TYPE CODES ASSIGNED TO THE VARIABLE EXTYPE 00231 C DATA TCOND/1/, TDO/2/, TFORT/3/, TIF/4/, TINVOK/5/, TRUNTL/6/ 00232 C DATA TRWHIL/7/, TSELCT/8/, TUNLES/9/, TUNTIL/10/, TWHEN/11/ 00233 C DATA TWHILE/12/ 00234 C 00235 C TYPE CODES ASSIGNED TO THE VARIABLE DTYPE 00236 C 00237 C DATA DPAGE /1/, DINCL /2/ !29-JUN- 00238 C DATA DPIF /3/, DPUNL /4/, DPEND /5/ !30JUN81 00239 C DATA DNAME /6/ !30JUN81 00240 C 00241 C CODES INDICATING SOURCE OF NEXT STATEMENT 00242 C IN ANALYZE-NEXT-STATEMENT 00243 C DATA SETUP /1/, RETRY /2/, READ /3/ 00244 C 00245 C--------------------------------------- 00246 C 00247 C 00248 C PARAMETERS 00249 C 00250 C THE FOLLOWING VARIABLES ARE PARAMETERS FOR THE PROGRAM. 00251 C THE MEANING OF EACH IS GIVEN BRIEFLY BELOW. FOR MORE INFORMATION 00252 C ON THE EFFECT OF THESE PARAMETERS, CONSULT THE SYSTEM MODIFICATION 00253 C GUIDE. 00254 C THE PARAMETERS NCHPWD, CHZERO, CHSPAC, AND CHC ARE SUPPLIED 00255 C BY THE MAIN PROGRAM VIA THE FOLLOWING COMMON 00256 COMMON /PARAM/ NCHPWD, CHZERO, CHSPAC, CHC, CINLIN !25-JAN-80 00257 C 00258 C--------------------------------------- 00259 C 00260 C STRING DECLARATIONS 00261 C 00262 C 00263 C THE FOLLOWING ARRAYS ARE USED FOR STORAGE OF WORKING STRINGS 00264 C AND CORRESPOND TO STRINGS OF THE LENGTHS INDICATED. 00265 C THE SIZES GIVEN BELOW ARE EXCESSIVE AND SHOULD BE 00266 C BE REDUCED AFTER CAREFUL ANALYSIS (NO TIME NOW). 00267 C 00268 C SFLX 100 CHARACTERS 00269 DIMENSION SFLX (51) 00270 C SHOLD 100 CHARACTERS 00271 DIMENSION SHOLD (51) 00272 C SLIST 200 CHARACTERS 00273 DIMENSION SLIST (101) 00274 C SPINV 80 CHARACTERS 00275 DIMENSION SPINV (41) (FLECS VERSION 22.38) 18-NOV-82 16:05:52 PAGE 00006 A,A/-SP=A 00276 C SPUTGO 20 CHARACTERS 00277 DIMENSION SPUTGO (11) 00278 C SST 200 CHARACTERS 00279 DIMENSION SST (101) 00280 C DATA SSTMAX /200/ 00281 C 00282 C THE FOLLOWING STRINGS REPRESENT CONSTANTS 00283 C 00284 C SB // // 00285 DIMENSION SB (2) 00286 C DATA SB / 1, 1H / 00287 C SB5 // // 00288 DIMENSION SB5 (4) 00289 C DATA SB5 / 5, 2H , 2H , 1H / 00290 C SB6 // // 00291 DIMENSION SB6 (4) 00292 C DATA SB6 / 6, 2H , 2H , 2H / 00293 C SB7 // // 00294 DIMENSION SB7 (5) 00295 C DATA SB7 / 7, 2H , 2H , 2H , 1H / 00296 C SDASH //----------------------------------------// 00297 DIMENSION SDASH (21) 00298 C DATA SDASH / 40, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H-- 00299 C 1 , 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H-- 00300 C 1 , 2H--, 2H--, 2H--, 2H--/ 00301 C SDUM //DUMMY-PROCEDURE// 00302 DIMENSION SDUM (9) 00303 C DATA SDUM / 15, 2HDU, 2HMM, 2HY-, 2HPR, 2HOC, 2HED, 2HUR, 1HE/ 00304 C SEND // END// 00305 DIMENSION SEND (6) 00306 C DATA SEND / 9, 2H , 2H , 2H , 2HEN, 1HD/ 00307 C SFSPCR //...// 00308 DIMENSION SFSPCR (3) 00309 C DATA SFSPCR / 3, 2H.., 1H./ 00310 C SLP //(// 00311 DIMENSION SLP (2) 00312 C DATA SLP / 1, 1H(/ 00313 C SOWSE //(OTHERWISE)// 00314 DIMENSION SOWSE (7) 00315 C DATA SOWSE / 11, 2H(O, 2HTH, 2HER, 2HWI, 2HSE, 1H)/ 00316 C SRP //)// 00317 DIMENSION SRP (2) 00318 C DATA SRP / 1, 1H)/ 00319 C SSPACR //. // 00320 DIMENSION SSPACR (3) 00321 C DATA SSPACR / 3, 2H. , 1H / 00322 C 00323 C THE FOLLWING ARRAYS HOLD STRINGS USED BY THE KEYWORD SCANNER 00324 C 00325 C KCOND //CONDITIONAL// 00326 DIMENSION KCOND (7) 00327 C DATA KCOND / 11, 2HCO, 2HND, 2HIT, 2HIO, 2HNA, 1HL/ 00328 C KDO //DO// 00329 DIMENSION KDO (2) 00330 C DATA KDO / 2, 2HDO/ (FLECS VERSION 22.38) 18-NOV-82 16:05:52 PAGE 00007 A,A/-SP=A 00331 C KELSE //ELSE// 00332 DIMENSION KELSE (3) 00333 C DATA KELSE / 4, 2HEL, 2HSE/ 00334 C KEND //END// 00335 DIMENSION KEND (3) 00336 C DATA KEND / 3, 2HEN, 1HD/ 00337 C KFIN //FIN// 00338 DIMENSION KFIN (3) 00339 C DATA KFIN / 3, 2HFI, 1HN/ 00340 C KIF //IF// 00341 DIMENSION KIF (2) 00342 C DATA KIF / 2, 2HIF/ 00343 C KNAME //NAME// 00344 DIMENSION KNAME(3) !30JUN81 00345 C DATA KNAME / 4, 2HNA, 2HME/ 00346 C KINCL //INCLUDE// 00347 DIMENSION KINCL(5) !29JUN81 00348 C DATA KINCL /7, 2HIN, 2HCL, 2HUD, 1HE/ 00349 C KPAGE //PAGE// 00350 DIMENSION KPAGE(3) !22-JUN-81 (MAO) 00351 C DATA KPAGE / 4, 2HPA, 2HGE/ 00352 C KPEND //PASSEND// 00353 DIMENSION KPEND(5) !30JUN81 00354 C DATA KPEND / 7, 2HPA, 2HSS, 2HEN, 1HD/ 00355 C KPIF //PASSIF// 00356 DIMENSION KPIF (4) !30JUN81 00357 C DATA KPIF /6, 2HPA, 2HSS, 2HIF/ 00358 C KPUNL //PASSUNLESS// 00359 DIMENSION KPUNL(6) !30JUN81 00360 C DATA KPUNL / 10, 2HPA, 2HSS, 2HUN, 2HLE, 2HSS/ 00361 C KREPT //REPEAT// 00362 DIMENSION KREPT (4) 00363 C DATA KREPT / 6, 2HRE, 2HPE, 2HAT/ 00364 C KSELCT //SELECT// 00365 DIMENSION KSELCT (4) 00366 C DATA KSELCT / 6, 2HSE, 2HLE, 2HCT/ 00367 C KTO //TO// 00368 DIMENSION KTO (2) 00369 C DATA KTO / 2, 2HTO/ 00370 C KUNLES //UNLESS// 00371 DIMENSION KUNLES (4) 00372 C DATA KUNLES / 6, 2HUN, 2HLE, 2HSS/ 00373 C KUNTIL //UNTIL// 00374 DIMENSION KUNTIL (4) 00375 C DATA KUNTIL / 5, 2HUN, 2HTI, 1HL/ 00376 C KWHEN //WHEN// 00377 DIMENSION KWHEN (3) 00378 C DATA KWHEN / 4, 2HWH, 2HEN/ 00379 C KWHILE //WHILE// 00380 DIMENSION KWHILE (4) 00381 C DATA KWHILE / 5, 2HWH, 2HIL, 1HE/ 00382 C 00383 C 00384 C ALECS VVVVV 00385 C SAEND // .END// (FLECS VERSION 22.38) 18-NOV-82 16:05:52 PAGE 00008 A,A/-SP=A 00386 DIMENSION SAEND(6) 00387 C DATA SAEND /10, 2H ,2H ,2H ,2H.E,2HND/ 00388 C ALECS ^^^^^ 00389 C 00390 C 00391 C--------------------------------------- 00392 C 00393 C THE DATA DECLARATIONS FOLLOW 00394 C 00395 C 00396 DATA FORMFD/"14/ !MAO15-SEP-80 00397 DATA DIRCH /"56/ !DIRECTIVE FLAG CHARACTER !22-JUN-81 MAO 00398 DATA FORTCL /1/, LISTCL /2/, ERRCL /3/ 00399 DATA UEXP/1/, UFORT/2/, UOWSE/3/, UPINV/4/, UDO/5/ 00400 DATA UDIR/6/ !29JUN81 00401 DATA TLETTR/1/, TDIGIT/2/, THYPHN/3/, TLP/4/, TRP/5/ 00402 DATA TBLANK/6/, TOTHER/7/, TEOL/8/ 00403 DATA TCEXP/1/, TELSE/2/, TEND/3/, TEXEC/4/, TFIN/5/, TTO/6/ 00404 DATA TDIR/7/ !22-JUN- 00405 DATA TOFF/8/ !30JUN81 00406 DATA TCOND/1/, TDO/2/, TFORT/3/, TIF/4/, TINVOK/5/, TRUNTL/6/ 00407 DATA TRWHIL/7/, TSELCT/8/, TUNLES/9/, TUNTIL/10/, TWHEN/11/ 00408 DATA TWHILE/12/ 00409 DATA DPAGE/1/ !22-JUN- 00410 DATA DINCL/2/ !29JUN81 00411 DATA DPIF /3/, DPUNL /4/, DPEND /5/ !30JUN81 00412 DATA DNAME /6/ !30JUN81 00413 DATA SETUP /1/, RETRY /2/, READ /3/ 00414 DATA SSTMAX /200/ 00415 DATA SB / 1, 1H / 00416 DATA SB5 / 5, 2H , 2H , 1H / 00417 DATA SB6 / 6, 2H , 2H , 2H / 00418 DATA SB7 / 7, 2H , 2H , 2H , 1H / 00419 DATA SDASH / 40, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H-- 00420 1 , 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H-- 00421 1 , 2H--, 2H--, 2H--, 2H--/ 00422 DATA SDUM / 15, 2HDU, 2HMM, 2HY-, 2HPR, 2HOC, 2HED, 2HUR, 1HE/ 00423 DATA SEND / 9, 2H , 2H , 2H , 2HEN, 1HD/ 00424 DATA SFSPCR / 3, 2H.., 1H./ 00425 DATA SLP / 1, 1H(/ 00426 DATA SOWSE / 11, 2H(O, 2HTH, 2HER, 2HWI, 2HSE, 1H)/ 00427 DATA SRP / 1, 1H)/ 00428 DATA SSPACR / 3, 2H. , 1H / 00429 DATA KCOND / 11, 2HCO, 2HND, 2HIT, 2HIO, 2HNA, 1HL/ 00430 DATA KDO / 2, 2HDO/ 00431 DATA KELSE / 4, 2HEL, 2HSE/ 00432 DATA KEND / 3, 2HEN, 1HD/ 00433 DATA KFIN / 3, 2HFI, 1HN/ 00434 DATA KIF / 2, 2HIF/ 00435 DATA KINCL /7, 2HIN, 2HCL, 2HUD, 1HE/ !29JUN81 00436 DATA KNAME / 4, 2HNA, 2HME/ !30JUN81 00437 DATA KPEND / 7, 2HPA, 2HSS, 2HEN, 1HD/ !30JUN81 00438 DATA KPIF /6, 2HPA, 2HSS, 2HIF/ !30JUN81 00439 DATA KPUNL / 10, 2HPA, 2HSS, 2HUN, 2HLE, 2HSS/ !30JUN81 00440 DATA KPAGE/ 4, 2HPA, 2HGE/ !22-JUN-81 MAO (FLECS VERSION 22.38) 18-NOV-82 16:05:52 PAGE 00009 A,A/-SP=A 00441 DATA KREPT / 6, 2HRE, 2HPE, 2HAT/ 00442 DATA KSELCT / 6, 2HSE, 2HLE, 2HCT/ 00443 DATA KTO / 2, 2HTO/ 00444 DATA KUNLES / 6, 2HUN, 2HLE, 2HSS/ 00445 DATA KUNTIL / 5, 2HUN, 2HTI, 1HL/ 00446 DATA KWHEN / 4, 2HWH, 2HEN/ 00447 DATA KWHILE / 5, 2HWH, 2HIL, 1HE/ 00448 C 00449 C 00450 C ALECS VVVVV 00451 DATA SAEND /10, 2H ,2H ,2H ,2H.E,2HND/ 00452 C ALECS ^^^^^ 00453 C 00454 C 00455 C--------------------------------------- 00456 C 00457 C BODY OF SUBROUTINE FOLLOWS 00458 C 00459 SELECT (SOURCE) 00460 C . 00461 C . VALUES FOR SOURCE ARE SET IN MAIN OR LIST: 00462 C . =READ IN MAIN AT INITIALIZATION 00463 C . =READ IN LIST IF NO ERRORS OR IF RECOVERABLE ERROR SUCH AS 00464 C . GENERATING MISSING FIN, BUT THREW OUT INPUT LINE 00465 C . =SETUP IN LIST IF MISSING SELECT, ETC BEING INSERTED NOW 00466 C . AND OLD LINE BEING HELD FOR LATER TRANSLATION. 00467 C . =RETRY IN LIST IF SETUP ON LAST PASS 00468 C . 00469 . (READ) READ-NEXT-STATEMENT !GET FROM FLX FILE 00470 . (SETUP) CONTINUE 00471 . (RETRY) !REDO OLD LINE 00472 . . LINENO=HOLDNO 00473 . . CALL CPYSTR(SFLX,SHOLD) 00474 . ...FIN 00475 ...FIN 00476 ERROR=0 00477 SAVED=.FALSE. !HAVE NOT YET SAVED AN OLD LINE 00478 NUNITS=0 !# OF UNITS OF INFO IN LINE 00479 ERSTOP=0 !# OF ERRORS FOUND FOR THIS LINE 00480 CURSOR=0 !POSITION IN LINE OF CHARACTER SCAN 00481 CWD=2 !WORD IN LINE BEING LOOKED AT (WORD 1=CHARACTER COUNT) 00482 CPOS=0 !POSITION IN CWD OF CHARACTER 00483 CLASS=0 !TYPE OF STATEMENT FOUND 00484 SCAN-STATEMENT-NUMBER !CHECK COL 1-5 00485 SCAN-CONTINUATION !CHECK COL 6 00486 WHEN (CONT.OR.PASS) 00487 C . 00488 C . NON-NUMBER IN COL 1-5 OR NON-(ZERO OR BLANK) IN COL 6 00489 C . 00490 . CLASS=TEXEC !EXECUTABLE 00491 . EXTYPE=TFORT !PURE FORTRAN 00492 ...FIN 00493 ELSE SCAN-KEYWORD !IS THERE A FLECS KEYWORD IN THE LINE? 00494 00495 WHEN (.NOT.PASFLG) !30JUN81 (FLECS VERSION 22.38) 18-NOV-82 16:05:52 PAGE 00010 A,A/-SP=A 00496 C . 00497 C . IGNORE EVERYTHING BUT END, .PASSIF, .PASSUNLESS OR .PASSEND 00498 C . 00499 . CONDITIONAL 00500 . . (CLASS.EQ.TEND) 00501 . . . ERROR=404 !OOPS, HIT END WITH MISSING .PASSENDS! 00502 . . . CLASS=0 00503 . . ...FIN 00504 . . (CLASS.EQ.TDIR) 00505 . . . SELECT (DTYPE) 00506 . . . . (DPIF) 00507 . . . . . SCAN-NAME 00508 . . . . . SCAN-GARBAGE 00509 . . . . ...FIN 00510 . . . . (DPUNL) 00511 . . . . . SCAN-NAME 00512 . . . . . SCAN-GARBAGE 00513 . . . . ...FIN 00514 . . . . (DPEND) SCAN-GARBAGE 00515 . . . . (OTHERWISE)CLASS=TOFF 00516 . . . ...FIN!select 00517 . . ...FIN 00518 . . (OTHERWISE) CLASS=TOFF 00519 . ...FIN!conditional 00520 ...FIN!when 00521 ELSE 00522 . SELECT (CLASS) 00523 . . (TEXEC) 00524 . . . SELECT (EXTYPE) 00525 . . . . (TFORT) CONTINUE !PURE FORTRAN, NOTHING MORE TO DO 00526 . . . . (TINVOK) SCAN-GARBAGE !PROCEDURE INVOCATION 00527 . . . . (TCOND) SCAN-GARBAGE !CONDITIONAL 00528 . . . . (TSELCT) !SELECT 00529 . . . . . SCAN-CONTROL 00530 . . . . . IF(NUNITS.GT.1) !CAN HAVE NOTHING TO RIGHT OF () ON A SELECT 00531 . . . . . . NUNITS=1 00532 . . . . . . CURSOR=USTART(2) 00533 . . . . . . RESET-GET-CHARACTER 00534 . . . . . . SCAN-GARBAGE 00535 . . . . . ...FIN 00536 . . . . ...FIN 00537 . . . . (OTHERWISE) SCAN-CONTROL 00538 . . . ...FIN 00539 . . ...FIN 00540 . . (TFIN) SCAN-GARBAGE !FIN 00541 . . (TEND) CONTINUE !END HIT 00542 . . (TELSE) SCAN-PINV-OR-FORT !ELSE HIT 00543 . . (TTO) !PROCEDURE DFN HIT 00544 . . . CSAVE=CURSOR 00545 . . . SCAN-PINV !GET THE PROCEDURE NAME 00546 . . . WHEN(FOUND) SCAN-PINV-OR-FORT 00547 . . . ELSE !NO NAME GIVE WITH TO! 00548 . . . . ERSTOP=ERSTOP+1 00549 . . . . ERRSTK(ERSTOP)=5 00550 . . . . SAVE-ORIGINAL-STATEMENT (FLECS VERSION 22.38) 18-NOV-82 16:05:52 PAGE 00011 A,A/-SP=A 00551 . . . . SFLX(1)=CSAVE 00552 . . . . CALL CATSTR(SFLX,SDUM) 00553 . . . . CURSOR=CSAVE 00554 . . . . RESET-GET-CHARACTER 00555 . . . . SCAN-PINV 00556 . . . ...FIN 00557 . . ...FIN 00558 . . (TCEXP) SCAN-CONTROL !LINE OF FORM (..) 00559 . . (TDIR) !29JUN81 00560 . . . SELECT (DTYPE) 00561 . . . . (DPAGE) SCAN-GARBAGE 00562 . . . . (DINCL) 00563 . . . . . SCAN-NAME 00564 . . . . . SCAN-GARBAGE 00565 . . . . ...FIN 00566 . . . . (DPIF) !30JUN81MAO 00567 . . . . . SCAN-NAME 00568 . . . . . SCAN-GARBAGE 00569 . . . . ...FIN 00570 . . . . (DPUNL) !30JUN81MAO 00571 . . . . . SCAN-NAME 00572 . . . . . SCAN-GARBAGE 00573 . . . . ...FIN 00574 . . . . (DPEND) SCAN-GARBAGE !30JUN81MAO 00575 . . . . (DNAME) !30JUN81MAO 00576 . . . . . SCAN-NAME 00577 . . . . . SCAN-GARBAGE 00578 . . . . ...FIN 00579 . . . ...FIN!select 00580 . . ...FIN 00581 . ...FIN 00582 ...FIN!else 00583 IF(ERSTOP.GT.0) CLASS=0 00584 LSTLEV=LEVEL 00585 C 00586 C IF WANT FULL OUTPUT TO FTN FILE, PUT OUT FLX LINE AS COMMENT 00587 C 14-FEB-80 00588 C 00589 IF(LSTFUL.AND.(CLASS.NE.TEXEC.OR.EXTYPE.NE.TFORT)) 00590 . CALL CPYSTR(SLIST,SFLX) !PUT FLX LINE IN LIST STRING 00591 . CALL PUTCH(SLIST(2),1,CHC) !PUT COMMENT CHAR IN COL 1 00592 . CALL PUT(LINENO,SLIST,FORTCL) !PUT IT OUT 00593 ...FIN 00594 C 00595 RETURN ---------------------------------------- 00596 TO GET-CHARACTER !GET NEXT CHARACTER IN STRING 00597 . CURSOR=CURSOR+1 00598 . CPOS=CPOS+1 00599 . IF (CPOS.GT.NCHPWD) 00600 . . CWD=CWD+1 00601 . . CPOS=1 00602 . ...FIN (FLECS VERSION 22.38) 18-NOV-82 16:05:52 PAGE 00012 A,A/-SP=A 00603 . WHEN(CURSOR.GT.SFLX(1)) CHTYPE=TEOL 00604 . ELSE 00605 . . CALL GETCH(SFLX(CWD),CPOS,CH) 00606 . . CHTYPE=CHTYP(CH) 00607 . ...FIN 00608 ...FIN ---------------------------------------- 00609 TO LIST-BLANK-LINE !PUT OUT BLANK LINE WITH PROPER INDENTAT 00610 . LSTLEV=LEVEL 00611 . WHEN (LSTLEV.EQ.0) CALL PUT(BLN,SB,LISTCL) 00612 . ELSE 00613 . . CALL CPYSTR(SLIST,SB6) 00614 . . DO (I=1,LSTLEV) CALL CATSTR(SLIST,SSPACR) 00615 . . WHEN (SLIST(1).GT.WWIDTH) CALL PUT(BLN,SP,LISTCL) 00616 . . ELSE CALL PUT(BLN,SLIST,LISTCL) 00617 . ...FIN 00618 . BLN=0 00619 ...FIN ---------------------------------------- 00620 TO LIST-COMMENT-LINE 00621 C . 00622 C . WHEN COMMENT LINE IS A C FOLLOWED BY 6 BLANKS LIST AS NORMAL 00623 C . FLECS LINE; OTHERWISE LIST EXACTLY AS IS IN FLX FILE. 00624 C . 00625 . CURSOR=1 00626 . RESET-GET-CHARACTER 00627 . INDENT=.TRUE. 00628 . I=2 00629 . REPEAT WHILE (I.LE.6.AND.INDENT) 00630 . . GET-CHARACTER 00631 . . IF ((CHTYPE.NE.TBLANK).AND.(CHTYPE.NE.TEOL)) INDENT=.FALSE. 00632 . . I=I+1 00633 . ...FIN 00634 . WHEN (INDENT) 00635 . . LSTLEV=LEVEL 00636 . . CLASS=0 00637 . . LIST-FLEX !OUTPUT LINE WITH INDENTATION 00638 . ...FIN 00639 . ELSE CALL PUT(LINENO,SFLX,LISTCL) 00640 C . 00641 C . IF WANT FULL OUTPUT TO FTN FILE, PUT OUT COMMENT--14-FEB-80 00642 C . 00643 . IF(LSTFUL)CALL PUT(LINENO,SFLX,FORTCL) 00644 C . 00645 ...FIN ---------------------------------------- 00646 TO LIST-DASHES 00647 . CALL PUT(0,SB,LISTCL) 00648 . CALL PUT(0,SDASH,LISTCL) (FLECS VERSION 22.38) 18-NOV-82 16:05:52 PAGE 00013 A,A/-SP=A 00649 . CALL PUT(0,SB,LISTCL) 00650 ...FIN ---------------------------------------- 00651 TO LIST-FLEX 00652 . IF (CLASS.EQ.TTO) LIST-DASHES 00653 . IF (SFLX(1).LT.7) CALL CATSTR(SFLX,SB7) 00654 . CALL CPYSUB(SLIST,SFLX,1,6) 00655 . UNLESS(LSTLEV.EQ.0) 00656 . . DO (I=1,LSTLEV) CALL CATSTR(SLIST,SSPACR) 00657 . ...FIN 00658 . IF(CLASS.EQ.TFIN) 00659 . . SLIST(1)=SLIST(1)-SSPACR(1) 00660 . . CALL CATSTR(SLIST,SFSPCR) 00661 . ...FIN 00662 . CALL CATSUB(SLIST,SFLX,7,SFLX(1)-6) 00663 . IF (SLIST(1).GT.WWIDTH) CALL CPYSTR(SLIST,SFLX) 00664 . WHEN (ERLST) 00665 . . CALL PUT(LINENO,SLIST,ERRCL) 00666 . . ERLST=.FALSE. 00667 . ...FIN 00668 . ELSE CALL PUT(LINENO,SLIST,LISTCL) 00669 ...FIN ---------------------------------------- 00670 TO READ-NEXT-STATEMENT 00671 C . 00672 C . READ THROUGH FLX FILE UNTIL FIND A NONBLANK, NONCOMMENT LINE 00673 C . (BLANK AND COMMENT LINES PUT OUT INTO FLL FILE) 00674 C . 00675 . REPEAT UNTIL (FOUND) 00676 . . CALL GET(LINENO,SFLX,ENDFIL) 00677 . . IF (FIRST) !FIRST READ ON THE FILE? 00678 . . . UNTIL (SFLX(1).GT.0.OR.ENDFIL) CALL GET(LINENO,SFLX,ENDFIL) 00679 . . . FIRST=.FALSE. 00680 . . . IF(ENDFIL) NOPGM=.TRUE. 00681 . . ...FIN 00682 . . IF (ENDFIL) !IF HIT EOF, PRETEND READ AN END 00683 C . . . 00684 C ALECS VVVVV 00685 . . . WHEN(ALECS)CALL CPYSTR(SFLX,SAEND) 00686 . . . ELSE 00687 C ALECS ^^^^^ 00688 C . . . . 00689 . . . . CALL CPYSTR(SFLX,SEND) 00690 C . . . . 00691 C ALECS VVVVV 00692 . . . ...FIN 00693 C ALECS ^^^^^ 00694 C . . . 00695 . . . LINENO=0 00696 . . ...FIN 00697 . . CALL GETCH(SFLX(2),1,CH) (FLECS VERSION 22.38) 18-NOV-82 16:05:52 PAGE 00014 A,A/-SP=A 00698 . . CONDITIONAL 00699 . . . (SFLX(1).EQ.0) !BLANK LINE 00700 . . . . BLN=LINENO 00701 . . . . IF(PASFLG) LIST-BLANK-LINE !30JUN81 00702 . . . . FOUND=.FALSE. 00703 . . . ...FIN 00704 . . . (CH.EQ.CHC.OR.CH.EQ.FORMFD) !COMMENT LINE !MAO15-SEP-80 00705 . . . . IF(PASFLG) LIST-COMMENT-LINE !30JUN81 00706 . . . . FOUND=.FALSE. 00707 . . . ...FIN 00708 . . . (OTHERWISE) FOUND=.TRUE. 00709 . . ...FIN 00710 . ...FIN 00711 ...FIN ---------------------------------------- 00712 TO RESET-GET-CHARACTER 00713 C . 00714 C . GET LAST CHARACTER AGAIN 00715 C . 00716 . CURSOR=CURSOR-1 00717 . CWD=(CURSOR-1)/NCHPWD+2 00718 . CPOS=CURSOR-(CWD-2)*NCHPWD 00719 . GET-CHARACTER 00720 ...FIN ---------------------------------------- 00721 TO SAVE-ORIGINAL-STATEMENT 00722 C . 00723 C . SAVE STATEMENT FROM FLX FILE FOR LATER REFERENCE 00724 C . 00725 . UNLESS (SAVED) 00726 . . SAVED=.TRUE. 00727 . . HOLDNO=LINENO 00728 . . CALL CPYSTR(SHOLD,SFLX) 00729 . ...FIN 00730 ...FIN ---------------------------------------- 00731 TO SCAN-CONTINUATION 00732 C . 00733 C . IS THIS A CONTINUATION LINE? IE. IS THERE SOMETHING IN COL 6 00734 C . BESIDES A BLANK OR ZERO? 00735 C . 00736 . GET-CHARACTER 00737 . CONDITIONAL 00738 . . (CHTYPE.EQ.TEOL) CONT=.FALSE. 00739 . . (CH.EQ.CHZERO.OR.CH.EQ.CHSPAC) CONT=.FALSE. 00740 . . (OTHERWISE) CONT=.TRUE. 00741 . ...FIN 00742 ...FIN (FLECS VERSION 22.38) 18-NOV-82 16:05:52 PAGE 00015 A,A/-SP=A ---------------------------------------- 00743 TO SCAN-CONTROL 00744 C . 00745 C . CHECK THE (..) AFTER A KEYWORD, EG. WHEN(..) 00746 C . 00747 . WHILE (CHTYPE.EQ.TBLANK) GET-CHARACTER 00748 . START=CURSOR 00749 . IF (CHTYPE.NE.TLP) !IF NO ( FOUND, INSERT ONE AFTER BLANKS 00750 . . ERSTOP=ERSTOP+1 00751 . . ERRSTK(ERSTOP)=3 00752 . . SAVE-ORIGINAL-STATEMENT 00753 . . CALL CPYSTR(SST,SFLX) 00754 . . SFLX(1)=START-1 00755 . . CALL CATSTR(SFLX,SLP) 00756 . . CALL CATSUB(SFLX,SST,START,SST(1)-START-1) 00757 . ...FIN 00758 . PCNT=1 !COUNT OF # OF ( 00759 . FOUND=.TRUE. 00760 . REPEAT UNTIL (PCNT.EQ.0.OR..NOT.FOUND) !SCAN TO MATCHING ) 00761 . . GET-CHARACTER 00762 . . SELECT (CHTYPE) 00763 . . . (TRP) PCNT=PCNT-1 00764 . . . (TLP) PCNT=PCNT+1 00765 . . . (TEOL) FOUND=.FALSE. 00766 . . ...FIN 00767 . ...FIN 00768 . UNLESS (FOUND) 00769 C . . 00770 C . . DIDNOT FIND MATCHING RIGHT PAREN, APPEND ENOUGH TO BALANCE LINE 00771 C . . 00772 . . ERSTOP=ERSTOP+1 00773 . . ERRSTK(ERSTOP)=4 00774 . . SAVE-ORIGINAL-STATEMENT 00775 . . DO (I=1,PCNT) CALL CATSTR(SFLX,SRP) 00776 . . CURSOR=SFLX(1) 00777 . . RESET-GET-CHARACTER 00778 . ...FIN 00779 . GET-CHARACTER 00780 . NUNITS=NUNITS+1 00781 . UTYPE(NUNITS)=UEXP !ASSUME (LOGICAL) 00782 . USTART(NUNITS)=START 00783 . ULEN(NUNITS)=CURSOR-START 00784 . CALL CPYSUB(SST,SFLX,START,CURSOR-START) 00785 . IF(STREQ(SST,SOWSE)) UTYPE(NUNITS)=UOWSE !OOPS, REALLY (OTHERWISE 00786 . SCAN-PINV-OR-FORT !CHECK FOR TRAILING FORT OR C-O-A 00787 ...FIN ---------------------------------------- 00788 TO SCAN-GARBAGE !MAKE SURE NOTHING BEYOND END OF STMNT 00789 . WHILE (CHTYPE.EQ.TBLANK) GET-CHARACTER 00790 . IF(CHTYPE.NE.TEOL.AND.CH.NE.CINLIN) !25-JAN-80 (MAO) IN-LINE 00791 . . ERSTOP=ERSTOP+1 !BAD STUFF ON THE LINE 00792 . . ERRSTK(ERSTOP)=2 (FLECS VERSION 22.38) 18-NOV-82 16:05:52 PAGE 00016 A,A/-SP=A 00793 . . SAVE-ORIGINAL-STATEMENT 00794 . . SFLX(1)=CURSOR-1 00795 . ...FIN 00796 ...FIN ---------------------------------------- 00797 TO SCAN-KEYWORD 00798 C . 00799 C . DETERMINE IF LINE STARTS WITH A FLECS KEYWORD OR A PROCEDURE 00800 C . INVOKATION. NOTE ON ENTRY HERE WE ARE AT COL 6. 00801 C . 00802 . GET-CHARACTER 00803 . WHILE (CHTYPE.EQ.TBLANK) GET-CHARACTER 00804 . WHEN (CH.NE.DIRCH) DRCTV=.FALSE. !not a directive !22-JUN-81 MAO 00805 . ELSE 00806 . . DRCTV=.TRUE. !is a directive !22-JUN-81 00807 . . GET-CHARACTER !skip over directive character !22-JUN-81 00808 . ...FIN!else 00809 . SELECT (CHTYPE) 00810 . . (TLETTR) !LETTER IN COL 7 00811 . . . START=CURSOR 00812 . . . INVOKE=.FALSE. 00813 . . . BADCH=.FALSE. 00814 . . . REPEAT UNTIL (BADCH) !FIND LENGTH OF ENTRY 00815 . . . . GET-CHARACTER 00816 . . . . CONDITIONAL 00817 . . . . . (CHTYPE.LE.TDIGIT) CONTINUE !0-9 AND A-Z ONLY (BLANKS EXCLUD 00818 . . . . . (CHTYPE.EQ.THYPHN) INVOKE=.TRUE. !A PROCEDURE INVOCATION 00819 . . . . . (OTHERWISE) BADCH=.TRUE. !END OF SCAN 00820 . . . . ...FIN 00821 . . . ...FIN 00822 . . . LEN=CURSOR-START 00823 . . . WHEN (INVOKE) !WAS A PROCEDURE INVOCATION 00824 . . . . CLASS=TEXEC 00825 . . . . EXTYPE=TINVOK 00826 . . . . NUNITS=1 00827 . . . . UTYPE(1)=UPINV 00828 . . . . USTART(1)=START 00829 . . . . ULEN(1)=LEN 00830 . . . ...FIN 00831 . . . ELSE 00832 . . . . CALL CPYSUB(SST,SFLX,START,LEN) !PUT "KEYWORD" IN SST 00833 . . . . CLASS=TEXEC !BUT ASSUME PURE FORTRAN 00834 . . . . EXTYPE=TFORT 00835 . . . . SELECT (SST(1)) !SST(1)=LENGTH OF STRING 00836 . . . . . (2) 00837 . . . . . . CONDITIONAL 00838 . . . . . . . (STREQ(SST,KIF).AND..NOT.DRCTV) EXTYPE=TIF !17AUG81 MAO 00839 . . . . . . . (STREQ(SST,KTO)) CLASS=TTO 00840 . . . . . . . (STREQ(SST,KDO)) 00841 . . . . . . . . WHILE(CHTYPE.EQ.TBLANK) GET-CHARACTER 00842 . . . . . . . . WHEN (CHTYPE.EQ.TDIGIT) EXTYPE=TFORT !OOPS, REALLY FORT DO 00843 . . . . . . . . ELSE EXTYPE=TDO 00844 . . . . . . . ...FIN (FLECS VERSION 22.38) 18-NOV-82 16:05:52 PAGE 00017 A,A/-SP=A 00845 . . . . . . ...FIN 00846 . . . . . ...FIN 00847 . . . . . (3) 00848 . . . . . . CONDITIONAL 00849 . . . . . . . (STREQ(SST,KFIN)) CLASS=TFIN 00850 . . . . . . . (STREQ(SST,KEND)) 00851 . . . . . . . . IF (CHTYPE.EQ.TEOL) CLASS=TEND 00852 C . . . . . . . . 00853 C ALECS VVVVV 00854 . . . . . . . . IF (ALECS .AND. CHTYPE.EQ.TBLANK) !22-JUN-81 00855 C . . . . . . . . . 00856 C . . . . . . . . . .END name IS OK BUT .ENDM IS NOT 00857 C . . . . . . . . . 00858 . . . . . . . . . CLASS=TEND !22-JUN- 00859 . . . . . . . . ...FIN!if 00860 . . . . . . . . DRCTV=.FALSE. !previously set .T. for .END !29JUN81 00861 C ALECS ^^^^^ 00862 C . . . . . . . . 00863 . . . . . . . ...FIN 00864 . . . . . . ...FIN 00865 . . . . . ...FIN 00866 . . . . . (4) 00867 . . . . . . CONDITIONAL 00868 . . . . . . . (STREQ(SST,KWHEN)) EXTYPE=TWHEN 00869 . . . . . . . (STREQ(SST,KELSE)) CLASS=TELSE 00870 . . . . . . . (STREQ(SST,KPAGE) .AND. DRCTV) !22-JUN-81 00871 . . . . . . . . CLASS=TDIR !22-JUN-81 00872 . . . . . . . . DTYPE=DPAGE !22-JUN-81 00873 . . . . . . . ...FIN 00874 . . . . . . . (STREQ(SST,KNAME) .AND. DRCTV) !30JUN81 00875 . . . . . . . . CLASS=TDIR 00876 . . . . . . . . DTYPE=DNAME 00877 . . . . . . . ...FIN 00878 . . . . . . ...FIN 00879 . . . . . ...FIN 00880 . . . . . (5) 00881 . . . . . . CONDITIONAL 00882 . . . . . . . (STREQ(SST,KWHILE)) EXTYPE=TWHILE 00883 . . . . . . . (STREQ(SST,KUNTIL)) EXTYPE=TUNTIL 00884 . . . . . . ...FIN 00885 . . . . . ...FIN 00886 . . . . . (6) 00887 . . . . . . CONDITIONAL 00888 . . . . . . . (STREQ(SST,KREPT)) 00889 . . . . . . . . WHILE(CHTYPE.EQ.TBLANK) GET-CHARACTER 00890 . . . . . . . . START=CURSOR 00891 . . . . . . . . WHILE(CHTYPE.EQ.TLETTR) GET-CHARACTER 00892 . . . . . . . . LEN=CURSOR-START 00893 . . . . . . . . CALL CPYSUB(SST,SFLX,START,LEN) 00894 . . . . . . . . CONDITIONAL 00895 . . . . . . . . . (STREQ(SST,KWHILE)) EXTYPE=TRWHIL 00896 . . . . . . . . . (STREQ(SST,KUNTIL)) EXTYPE=TRUNTL 00897 . . . . . . . . ...FIN 00898 . . . . . . . ...FIN 00899 . . . . . . . (STREQ(SST,KSELCT)) EXTYPE=TSELCT (FLECS VERSION 22.38) 18-NOV-82 16:05:52 PAGE 00018 A,A/-SP=A 00900 . . . . . . . (STREQ(SST,KUNLES)) EXTYPE=TUNLES 00901 . . . . . . . (STREQ(SST,KPIF) .AND. DRCTV) !30JUN81 00902 . . . . . . . . CLASS=TDIR 00903 . . . . . . . . DTYPE=DPIF 00904 . . . . . . . ...FIN 00905 . . . . . . ...FIN 00906 . . . . . ...FIN 00907 . . . . . (7) !29JUN81 00908 . . . . . . IF (STREQ(SST,KINCL) .AND. DRCTV) 00909 . . . . . . . CLASS=TDIR 00910 . . . . . . . DTYPE=DINCL 00911 . . . . . . ...FIN!if 00912 . . . . . . IF (STREQ(SST,KPEND) .AND. DRCTV) !30JUN81MAO 00913 . . . . . . . CLASS=TDIR 00914 . . . . . . . DTYPE=DPEND 00915 . . . . . . ...FIN!if 00916 . . . . . ...FIN 00917 . . . . . (10) !30JUN81 00918 . . . . . . IF (STREQ(SST,KPUNL) .AND. DRCTV) 00919 . . . . . . . CLASS=TDIR 00920 . . . . . . . DTYPE=DPUNL 00921 . . . . . . ...FIN!if 00922 . . . . . ...FIN!(10) 00923 . . . . . (11) 00924 . . . . . . IF (STREQ(SST,KCOND)) EXTYPE=TCOND 00925 . . . . . ...FIN 00926 . . . . ...FIN 00927 . . . ...FIN 00928 . . ...FIN 00929 . . (TLP) CLASS=TCEXP !MUST BE COND OR SELECT SUBCLAUSE 00930 . . (OTHERWISE) 00931 C . . . 00932 C . . . NOT A LETTER OR LEFT PAREN. MUST BE PURE FORTRAN LINE 00933 C . . . 00934 . . . CLASS=TEXEC 00935 . . . EXTYPE=TFORT 00936 . . ...FIN 00937 . ...FIN 00938 ...FIN ---------------------------------------- 00939 TO SCAN-NAME !29JUN81 00940 C . 00941 C . SCAN THE NAME GIVEN WITH A DIRECTIVE 00942 C . 00943 . WHILE (CHTYPE.EQ.TBLANK) GET-CHARACTER 00944 . NUNITS=1 00945 . UTYPE(1)=UDIR 00946 . USTART(1)=CURSOR 00947 C . 00948 . WHILE (CHTYPE.NE.TEOL.AND.CH.NE.CINLIN) GET-CHARACTER 00949 . ULEN(1)=CURSOR-USTART(1) 00950 ...FIN!to scan-name (FLECS VERSION 22.38) 18-NOV-82 16:05:52 PAGE 00019 A,A/-SP=A ---------------------------------------- 00951 TO SCAN-PINV !IS THERE A PROCEDURE INVOCATION? 00952 . WHILE(CHTYPE.EQ.TBLANK) GET-CHARACTER 00953 . FOUND=.FALSE. 00954 . IF(CHTYPE.EQ.TLETTR) 00955 . . START=CURSOR 00956 . . REPEAT UNTIL (CHTYPE.GT.THYPHN) 00957 . . . GET-CHARACTER 00958 . . . IF(CHTYPE.EQ.THYPHN) FOUND=.TRUE. 00959 . . ...FIN 00960 . ...FIN 00961 . IF (FOUND) !IT IS A PROCEDURE INVOCATION! 00962 . . NUNITS=NUNITS+1 00963 . . UTYPE(NUNITS)=UPINV 00964 . . USTART(NUNITS)=START 00965 . . ULEN(NUNITS)=CURSOR-START 00966 . ...FIN 00967 ...FIN ---------------------------------------- 00968 TO SCAN-PINV-OR-FORT 00969 C . 00970 C . CHECK FOR PROCEDURE INVOCATION OR A FORTRAN UNIT 00971 C . EG. WHEN()I=J VS. WHEN()C-O-A VS. WHEN() 00972 C . 00973 . WHILE (CHTYPE.EQ.TBLANK) GET-CHARACTER 00974 . UNLESS (CHTYPE.EQ.TEOL.OR.CH.EQ.CINLIN) !25-JAN-80 (MAO) IN-LINE 00975 . . CSAVE=CURSOR 00976 . . SCAN-PINV 00977 . . WHEN(FOUND) SCAN-GARBAGE !WAS PROC INVOC 00978 . . ELSE 00979 C . . . 00980 C . . . NOT A PROCEDURE INVOCATION, SO MUST BE A FORTRAN LINE 00981 C . . . 00982 . . . NUNITS=NUNITS+1 00983 . . . UTYPE(NUNITS)=UFORT 00984 . . . USTART(NUNITS)=CSAVE 00985 . . . ULEN(NUNITS)=SFLX(1)+1-CSAVE 00986 . . ...FIN 00987 . ...FIN 00988 ...FIN ---------------------------------------- 00989 TO SCAN-STATEMENT-NUMBER 00990 C . 00991 C . CHECK CONTENTS OF COL 1-5 FOR LEGAL (IN FORTRAN SENSE) 00992 C . STATEMENT #, IE ONLY DIGITS OR BLANKS. STORE # (IF THERE) 00993 C . IN FLXNO. SET PASS=.T. IF ILLEGAL CHARACTER, TO INDICATE 00994 C . LINE IS TO BE PASSED DIRECTLY TO FTN FILE. 00995 C . 00996 . FLXNO=0 00997 . PASS=.FALSE. (FLECS VERSION 22.38) 18-NOV-82 16:05:52 PAGE 00020 A,A/-SP=A 00998 . DO (I=1,5) 00999 . . GET-CHARACTER 01000 . . SELECT (CHTYPE) 01001 . . . (TBLANK) CONTINUE 01002 . . . (TDIGIT) FLXNO=FLXNO*10+CH-CHZERO 01003 . . . (TEOL) CONTINUE 01004 . . . (OTHERWISE) PASS=.TRUE. !ILLEGAL CHAR IN COL 1-5 01005 . . ...FIN 01006 . ...FIN 01007 ...FIN 01008 END ---------------------------------------- PROCEDURE CROSS-REFERENCE TABLE 00596 GET-CHARACTER 00630 00719 00736 00747 00761 00779 00789 00802 00803 00807 00815 00841 00889 00891 00943 00948 00952 00957 00973 00999 00609 LIST-BLANK-LINE 00701 00620 LIST-COMMENT-LINE 00705 00646 LIST-DASHES 00652 00651 LIST-FLEX 00637 00670 READ-NEXT-STATEMENT 00469 00712 RESET-GET-CHARACTER 00533 00554 00626 00777 00721 SAVE-ORIGINAL-STATEMENT 00550 00752 00774 00793 00731 SCAN-CONTINUATION 00485 00743 SCAN-CONTROL 00529 00537 00558 00788 SCAN-GARBAGE 00508 00512 00514 00526 00527 00534 00540 00561 00564 00568 00572 00574 00577 00977 00797 SCAN-KEYWORD 00493 00939 SCAN-NAME 00507 00511 00563 00567 00571 00576 (FLECS VERSION 22.38) 18-NOV-82 16:05:52 PAGE 00021 A,A/-SP=A 00951 SCAN-PINV 00545 00555 00976 00968 SCAN-PINV-OR-FORT 00542 00546 00786 00989 SCAN-STATEMENT-NUMBER 00484 (FLECS VERSION 22.38) A,A/-SP=A