. THE GET SECTION CONTAINS THE FOLLOWING SUBROUTINES: . GETL -GET LABEL SYMBOL TABLE REFERENCE AND ENTER LREF . GEYE -GET I (SENSE SWITCH-LIGHT TESTS AND SETS) . GINTV -GET INTEGER VARIABLE . GLD -GET LIMITS OF DIMENSION . GLG -GET LOCAL OR GLOBAL SYMBOL TABLE REFERENCE . GLG1 -GET LOCAL OR GLOBAL SYMBOL TABLE REF (NO ENTRY MADE) . GLS -GET LOCAL SYMBOL TABLE REFERENCE PLUS MODE . GNS -GET NEXT STATEMENT . GOL -GET STATEMENT LABEL . GOTO -GO TO STATEMENT . GO60 -ASSIGNED GO TO M,( ) . GSLR -GET STATEMENT LABEL REF (CONDITIONAL REF ONLY) . GSWV -GET SYM (SIMPLE SWITCH VARIABLE) . GX -GET NEXT NON-BLANK CHARACTER . GXB -GET NEXT CHARACTER INCLUDING BLANKS PREQ . DEFINE THE REGISTERS P$IRCB . PROCESSOR INTERFACE DEFINITIONS $(1) . THE FOLLOWING ROUTINE DEINTRINSIFIES AN INTRINSIC FUNCTIN . IF THE NAME IS EFERENCED FROM AN INTERNAL ROUTINE IT IS FORCED TO BE A LOCAL . VARIABLE BEFORE IT IS DEINTRINSIFIED9 DEITY TNZ FLG GLOBAL J DENTXA NO TNZ FMP INTERNAL J DENTXA NO LMJ B11,GLS J $+2 SLJ BUG DENTXA L,H1 A2,2,A1 SZ,S3 2,A1 AND,M A2,01000 JNZ A3,*DEINTX SZ,S2 2,A1 SZ,H2 2,A1 SZ 3,A1 L A2,2,A1,2 J *DEINTX . GET LABEL SYMBOL TABLE REFERENCE AND ENTER LREF 184900 . 185000 GETL2* S,H2 B11,GE30 . SAME AS GETL J GE31 . EXCEPT MAX LABEL NOT CHECKED GETL* S,H2 B11,GE30 A LMJ B11, GETL 185100 L A3,GITV A+1 RETURN 185200 TLE A3,(100000) J GE31 TEST FOR MAX SIZE LABEL LMJ B11,PERR 185500 FORM6 021,39,GITV AND A3,(0377777) S A4,GITV . 8/29/63 FOR PH1-3C GE31 L A4,GITV VALUE OF LABEL TZ MACNO SLJ MCLABL TEST IF LABEL SHOULD BE RENAMED A A4,INTNU NUMBER OF INTERNAL ROUTINE LMJ B11,SLT +CRLBHL LABEL HEAD LINK LMJ B11,SLTI L,H1 A3,2,A1 GET MADE 186000 AND,M A3,07777 186100 JZ A4,GE32 TE,M A4,0107 186200 TNE,M A4,0207 DOES D=1,2,T=0,(=7 186300 J GE33 YES 186400 LMJ B11,PERR NO 186500 FORM6 031,2,SYMV 186600 SZ,H2 2,A1 SZ 3,A1 SZ,S2 2,A1 186700 SZ,S3 2,A1 186800 GE32 L,H1 A3,2,A1 7 IN C, 1 IN D, 0 IN REST OF MADE 186900 OR,M A3,0107 187000 S,H1 A4,2,A1 187100 GE33. SHORT L A2,ST . UNLESS WE ARE WORKING SHORT TE,M A2,5 . ON AN ASSIGN STATEMENT, SHORT LMJ B11,LREFR MAKE LREF ENTRY. SHORT J *GE30 . 187400 . GET I (SENSE SWITCH-LITE TESTS AND SETS) 187600 . 187700 GEYE* S,H2 B11,GY30 187800 LMJ B11,GIT 187900 J GY301 188000 GY302 TNE,M A2,4 188100 J GY303 188200 LMJ B11,ERR1 J GY400 188600 J GY302 188700 . 188800 GY303 L A4,GITV GY313 JP A4,GY305 GY306 LMJ B11,PERR 189100 FORM6 021,33,GITV SZ A4 GY305 TG,M A4,16 J GY306 189500 LMJ B11,SLT + CRIHL LMJ B11,SLTI L,M A0,013 S,S3 A0,2,A1 SET INTEGER MODE A A1,(030000,0) S A1,STRING,*B5 GY307 L,H2 B11,GY30 189800 J 1,B11 RETURN TO A+2 190000 . 190100 GY301 LMJ B11,PERR ERROR (E.O.S.) 191010 FORM6 01,4,0 191020 GY400 J *GY30 . 191600 . GET INTEGER VARIABLE A LMJ B11,GINTV 191800 . 191900 GINTVD* S B11,ALLFLG FLOATING OK IN DO LOOPS J $+2 GINTV* SZ ALLFLG S,H2 B11,GI30 LMJ B11,GLG GET SYM(Y) A+2 NORMAL RETURN 192100 J GI41 NOT IN 192200 L,H1 A2,2,A1 SYM IN A1 - PUT MODE IN A2 192300 AND,M A2,7 192400 TE,M A2,010 EQ,CM,F,D,C=0,T=1 192500 J *GI21,A3 NO - BRANCH ON CLASS 192600 J GI32 YES - RETURN 192700 . 192800 GI50 AND,M A2,0700 (C=0) 192900 TNZ ALLFLG JNZ A3,GI60 D NOT=0 193000 GI503 AND,M A2,070 D=0 193100 TNE,M A3,010 193200 J GI32 T=1 193300 JNZ A3,GI502 193400 GI506 LMJ B11,DTYPE T=0 193500 TNE,M A0,010 IS IT UNTEGER 193600 J GI507 YES 193700 GI502 TG,M A3,050 J GI502X TZ ALLFLG J GI61 FLOATING POINT OK GI502X LMJ B11,PERR FORM6 031,35,SYMV GI508 AND A2,(0777707) 194000 L A2,A3 1 T 194100 L,M A0,010 194110 GI507 OR A2,A0 194200 S,H1 A3,2,A1 194300 J GI32 194400 . C=5 194800 GI70 AND,M A2,01000 F=0 194900 JZ A3,GI50 YES 195000 J GI60 NO 195100 . C=6 195200 GI80 SLJ DEINTX MAKE SURE NAME IS LOCAL AND,M A2,01000 DOES F=0 195320 JZ A3,GI40 YES 195400 J GI60 NO 195500 . C=7 195600 GI90 AND,M A2,0700 195700 TE,M A3,0400 D=4 195800 J GI90X AND A2,(0777070) YES 196000 L A2,A3 196100 S,H1 A2,2,A1 196200 J GI503 196300 GI90X LMJ B11,PERR NAMELIST NAME FORM6 031,174,SYMV J GI503 . C=OTHER-ERROR 196400 GI60 TNZ ALLFLG J $+3 GI61 L B11,GI30 J 2,B11 FLOATING POINT RETURN LMJ B11,PERR FORM6 031,227,SYMV J GI503 . 196800 GI40 SZ,S2 2,A1 0 IN MODE 196900 SZ,S3 2,A1 197000 GI41 L,H1 A2,2,A1 197100 J GI506 197200 . 197300 GI32 L,H2 B11,GI30 197400 J 1,B11 197600 GI42 L,S2 A2,2,A1 SHOW PARAMETER REFERENCE OR,M A2,020 S,S2 A3,2,A1 J GI30 . 197700 . 198000 GI21 J GI50 C=0 198100 J GI60 C=1 198200 J GI60 C=2 198300 J GI60 C=3 198400 J GI42 PARAMETER J GI70 C=5 198600 J GI80 C=6 198700 J GI90 C=7 198800 . 199000 . GET LIMITS OF DIMENSION 199200 . 199300 GLD* S,H2 B11,GD30 SYM IS IN A1 ON ENTRY 199400 S A6,GD11 199500 L B4,(1,0) . INITALIZE DIMTMP INDEX CTABD L,M A6,1 1 IN K 199800 S A6,MXDMN 131K SZ GD12 199850 GD40 LMJ B11,GIT 199900 J GD401 EOS 200000 TNE,M A2,4 200100 J GD500 ITEM = INT CONST 200200 TNE,M A2,3 200300 J GD402 ITEM = VAR NAME 200400 LMJ B11,PERR ITEM = OTHER 200500 FORM6 011,6,GITV 200600 J GD60 200700 GD401 LMJ B11,PERR 200800 FORM6 0,4,0 FOLLOWING STMT INCOMPLETE J GD60 201000 GD402 LMJ B11,GLG NOP . NOT IN GD422 S A1,SYMV SAVE SYM 201500 L,H1 A2,2,A1 GET MODE 201600 AND,M A2,7 201700 TNE,M A3,4 201800 J GD404 C=4 201900 TNE,M A3,5 202000 J GD405 C=5 202100 JNZ A3,GD402A . ERROR, CLASS NOT ZERO TZ FMPX SKIP IM MAIN PROGRAM J GD420 GD402A LMJ B11,PERR C=OTHER 202200 FORM6 031,6,SYMV 202300 L,H1 A2,2,A1 J GD406 202400 GD404 L A4,3,A1 C=4 (PARAMTER IN L) -(A4) 202800 L,S2 A2,2,A1 OR,M A2,020 S,S2 A3,2,A1 L,M A5,0101 . ID & MODIFIER. PARDIM J GD501 202900 GD405 S R15,GD12 FOUND SUBPROGRAM ARGUMENT 203000 GD406 L,M A5,0200 PARDIM L A4,A1 203200 AND,M A2,070 203200 JZ A3,GD409 T=0 203300 TNE,M A3,010 203400 J GD410 T=1 203500 LMJ B11,PERR T=OTHER 203600 FORM6 031,2,SYMV 203700 J GD502 203800 GD409 OR,M A2,010 SET TYPE =1 203900 S,H1 A3,2,A1 204000 GD410 SZ,H1 PRESYM,B4 MTFSYM S,S2 A5,PRESYM,B4 . ID AND MODIFIER SSL A5,6 S,S1 A5,PRESYM,B4 . SIMULATE S,T1 S,H2 A4,PRESYM,*B4 . LIMIT IN A4 MTFSYM L FNXT,R8 RESET NEXT L A0,GXX GET X 204400 TNE,M A0,',' 204500 J GD412 X=COMMA 204600 TNE,M A0,')' 204700 J GD415 X=RT. PAREN 204800 LMJ B11,ERR2 ERROR 204900 L,S2 A2,FLD2,A0 205000 TE,M A2,1 205100 J GD415 X=NON NUMERIC 205200 GD412 TG,M A6,7 K.LT.7 (K IN A6) 205300 J GD413 NO 205400 A,M A6,1 YES 205500 J GD40 GET NEXT LIMIT 205600 GD413 LMJ B11,PERR 205700 FORM6 031,8,SYMV 205800 GD415 L A1,SYMVG RT. PAREN - RETURN 205900 SSC A6,30 206000 L,H1 A3,2,A1 K TO SYM OR A3,A6 206200 S,H1 A4,2,A1 TNZ GD12 ANY DIM. VAR. = ARGUMENTS 206410 J GD70 . NO CTABD AND,M A3,7 206430 TNE,M A4,5 ARRAY NAME = ARGUMENT 206440 J GD70 . NO CTABD LMJ B11,PERR FORM6 031,119,SYMVG = J GD70 . EXIT CTABD GD420 L A3,SYMVG SYM LOC OF VAR BEING DIMENSIONED L,H1 A4,2,A3 AND,M A4,7 MUST BE A SUBROUTINE ARG TE,M A5,5 . CLASS MUST BE 5 (ARG OF SUB) J GD402A IMPROPER DIMENSION AND,M A2,02000 . GET COMMON INDICATOR BIT JZ A3,GD402A . IMPROPER DIMENSION J GD406 . OK . 206800 GD500 L A4,GITV (ITEM IN L) (A4) 206900 L,M A5,0100 . ID FOR CONST PARDIM GD501 JN A4,GD503 207000 L A0,MXDMN 131K MSI A0,A4 131K TLE A0,MAXD 131K J GD504 L.LT.MAXD 207200 GD503 S A4,GITV 207300 LMJ B11,PERR 207400 FORM6 021,7,GITV 207500 GD502 L,M A4,1 SET L=1 207600 L,M A5,0100 . ID = CONST. PARDIM L A0,MXDMN 1315 GD504 S A0,MXDMN PARDIM JNB A5,GD410 . IF THIS IS A PARAMETER, PARDIM L,M A4,3,A1 . PUT ADDR OF ITS SYM W4 PARDIM J GD410 . IN CTAB. PARDIM GD60 L A2,SYMVG . START OF ERROR RETURN CTABD S A2,SYMV CTABD L,H2 B11,GD30 CTABD J GD72 GD70 S A1,SYMV . START OF NORMAL RETURN CTABD GD71 L,M A0,PRESYM . LOC OF TABLE MTFSYM L,M A2,0,B4 . LENGTH OF TABLE A,H1 A2,N1CHQQ . IF NON ZERO WORDS TO SET ASIDE LN A2,A2 . FOR CHARACTER INFO LXI A0,A2 . H1 GETS NEG LNG MTFSYM LMJ B11,MTCT . MOVE TO CONTIG TABLE MTFSYM SLJ SYMOF . ERROR SYM OVERFLOW MTFSYM SSL A0,18 . MOVE TOP TO H2 MTFSYM S,H2 A0,3,A1 . PTR TO DIM INFO IN H2 W4 SYM MTFSYM L B11,GD30 MTFSYM A,M B11,1 MTFSYM GD72 . L A6,GD11 . RESTORE CTABD TZ,H2 CRMON CTABD SLJ N1MNSD . ALL DIM VARABLES MONITORED CTABD J 0,B11 . RETURN (A+1 FOR ERR,A+2 FOR NORMAL) CTABD . GET LOCAL OR GLOBAL SYMBOL TABLE REFERENCE 209100 . (ENTRY MADE IF NOT IN) 209200 . 209300 GLG* S,H2 B11,GL30 209400 L A4,GITV PICK UP ITEM 209500 TZ FMP IS THIS MAIN PROGRAM 209600 J GL32 NO 209700 LMJ B11,SLT YES - SEARCH GLOBAL ONLY 209800 + CRGHL 209900 J GL31 NOT IN 210000 GL33 SZ FLG IN GLOBAL - SET LOCAL FLAG 210100 GL36 L B11,GL30 210200 L,M A1,0,A1 CLEAR A1(H1) 210310 S A1,SYMV 210300 J 1,B11 RETURN TO A+2 210400 GL31 LMJ B11,SLTI NOT IN - SO INSERT 210500 L,M A1,0,A1 CLEAR A1(H1) 210610 S A1,SYMV 210600 J *GL30 RETURN TO A+1 210700 GL32 LMJ B11,SLT --NOT MAIN PROGRAM - SEARCH LOCAL 210800 + CRLHL 210900 J GL34 NOT IN LOCAL 211000 J GL33 IN LOCAL - SET FLAG - RETURN 211100 GL34 LMJ B11,SLT SEARCH GLOBAL - NOT IN LOCAL 211200 + CRGHL 211300 J GL35 NOT IN GLOBAL EITHER - ENTER LOC 211400 S R15,FLG IN GLOBAL - SET GLOBAL FLAG 211500 J GL36 RETURN 211600 GL35 LMJ B11,SLT SEARCH LOCAL FOR PROPER LINK 211700 + CRLHL 211800 J GL31 NOT IN LOCAL 211900 SLJ BUG ERROR 212000 . 212100 . GET LOCAL OR GLOBAL SYMBOL TABLE REF (NO ENTRY MADE) 212800 . 212900 GLG1* L A4,GITV . PICK UP ITEM S,H2 B11,GL40 TZ FMP IS THIS MAIN PROGRAM 213200 J GL42 NO 213300 LMJ B11,SLT YES - SEARCH GLOBAL ONLY 213400 + CRGHL 213500 J *GL40 NOT IN - RETURN TO A+1 213600 GL43 SZ FLG IN GLOBAL - SET LOCAL FLAG 213700 GL46 L B11,GL40 213800 L,M A1,0,A1 CLEAR A1(H1) 213910 S A1,SYMV PUT SYM IN SYMV 213900 J 1,B11 RETURN TO A+2 214000 . 214100 GL42 LMJ B11,SLT --NOT MAIN PROGRAM - SEARCH LOCAL 214200 + CRLHL 214300 J GL44 NOT IN LOCAL 214400 J GL43 IN LOCAL - SET FLAG AND RETURN 214500 . 214600 GL44 LMJ B11,SLT NOT IN LOCAL - SEARCH GLOBAL 214700 + CRGHL 214800 J *GL40 S R15,FLG IN GLOBAL - SET FLAG 215000 J GL46 215100 . 215200 . GET LOCAL SYMBOL TABLE REFERENCE + MODE 215900 . 216000 GLS* S,H2 B11,GL50 L A4,GITV PICK UP ITEM ( A LMJ B11,GLS 216200 TZ FMP IS THIS MAIN PROGRAM ( A+1 NOT IN 216300 J GL52 NO ( A+2 IN 216400 LMJ B11,SLT YES - SEARCH GLOBAL 216500 + CRGHL 216600 J GL51 NOT IN GLOBAL 216700 GL53 L B11,GL50 216800 S A1,SYMV 216900 J 1,B11 RETURN TO A+2 217000 GL51 LMJ B11,SLTI INSERT IN SYMBOL TABLE 217100 L,M A1,0,A1 CLEAR A1(H1) 217210 S A1,SYMV 217200 J *GL50 217300 GL52 LMJ B11,SLT -NOT MA+N PROGRAM 217400 + CRLHL SEARCH LOCAL TABLE 217500 J GL51 NOT IN LOCAL 217600 J GL53 IN LOCAL 217700 . GET NEXT STATEMENT 218500 . 218600 . LMJ B11,GNS 218700 . ERROR 218800 . E.O.F. 218900 . NORMAL 219000 . 219100 GNS* S,H2 B11,GN30 219200 SZ LIST SZ FSCLNG GLOBAL SEMI-COLON FLAG SZ,H1 FLF . FLAG FOR IF'S CONTINUED OVER STMTS GN310. EXEC 8 TN INCLVL . IF READING INCLUDE/MACRO J GN310X . IGNORE EOF TZ EOF EXEC 8 J 1,B11 YES-(RETURN 2) 219400 GN310X. EXEC 8 TZ DELFLG J GN306 GN311 L A0,NLABL NO 219500 S A0,PLABL GET PRESENT LABEL 219600 L A5,B1 S IN B1 219610 S A5,SEQL LABEL OF SEQUENCE CT 219611 OR A5,(01000000) C=1 219620 S A5,NLINE F60 ID,(ID=00,C=0,S) 219630 L B2,(1,SBUF) LOC OF 1ST LINE IN B2 219700 TZ FDASC . TEST FOR ASCII LINE J GN301A L,S6 A0,NLINE+1 . IF FIRSTLINE OF STMT GENER TNE,M A0,'0' . HAS 0 CONTINUE CHARACTER, GENER S,S6 A0,MAFLST . FORCE LIST OF GENERATED. GENER . 219800 GN301 L A0,(1,NLINE+2) FWA OF LINE IN A0 219900 TZ FDASC . TEST FOR ASCII LINE J GN301B L,M R1,11 11 IN K (R1) 220000 BT B2,0,*A0 PUT LINE IN BUFFER (SBUF) 220100 . GET NEXT NON-COMMENT LINE 220200 GN302 L A0,(1,NLINE) 220300 TN INCLVL J GN302J DL A4,F60ID DS A4,XF60ID L A4,F60ID+2 S A4,XF60ID+2 GN302J L,H1 A1,SIRLNG . LENGTH OF IMAGE A,M A1,1 . COUNT F60 ID IN TOTAL L A2,(3,F60ID) . SPECIAL INFO FOR END OF IMAGE L,H2 A3,FDASC . SET ACCORDING TO TYPE OF IMAGE TNZ FCPLST . DONT SEND IMAGES TO F60 IF SET LMJ B11,W60F . PLACE ITEM IN F60 S A6,NLINE F60 ID,(ID=00,C=1,S) 220600 L,M A2,250 PERMISSABLE NO. OF MACRO CALLS TNZ MACNO S A2,MCENT RESET AT EACH ZERO LEVEL CARD TN INCLVL IS INCLUDE OR MACRO ACTIVE J GNCPY GN302QQ L A0,(14,NLINE+1) TZ FDASCZ . TEST FOR ASCII READ L A0,(20,NLINE+1) L,M B10,SIRXX LXI,M B11,JPL$PIRCB$ . BANK CONTAINING SIR$ S A0,SIRLNG . SAVE POTENTIAL LENGTH OF IMAGE LXM,H2 B11,FDASEX LIJ B11,0,B11 . TO BGETSR$ OR BGETAS$ LMJ B11,CCE CONTROL CARD ERROR J GN303 END OF FILE SLJ CNWTST CHECK FOR NEG. CONTROL WORD J GN302QQ . SKIP NEGATIVE CONTROL WORDS L A3,CTSLNB CTS LINE NUMBER SZ CTSLNB TZ,S2 CRFLGS S,H2 A3,F60ID+1 . CTS LINE NUMBER DL A4,F60ID DS A4,XF60ID L A4,F60ID+2 S A4,XF60ID+2 GN302A . TZ FDASC . TEST FOR ASCII IMAGE J GN302R L,S1 A0,NLINE+1 . NORMAL RETURN LOOK AT COLUMN 1 TNE,M A0,'C' IS THIS A COMMENT CARD 221000 J GN302 YES-GO GET NEXT CARD 221100 TNE,M A0,'G' J GN302G TNE,M A0,'H' J GN302H GN302Q TZ FDASC . TEST FOR ASCII IMAGE J GN302S L,S6 A0,NLINE+1 GET COL 6 221200 TNE,M A0,' ' IS THIS CARD A CONTINUATION 221300 J GN304 NO- 221400 TNE,M A0,'0' 221410 J GN304 NO- 221420 GN302B L A0,NLINE+1 AND A0,(0777777777700) TE A1,(' @') J GN302C GN302D L A0,(1,SBUF+335) . MAX SIZE OF SBUF IN A0 TG A0,B2 IS STAT TOO LONG 221600 J GN301 NO-PUT LINE SBUF 221700 LMJ B11,PERR YES-ERROR 221800 FORM6 1,82,0 221900 J GN302 GO GET NEXT CARD 222000 GNCPY TNZ FCPEND . UNLESS END ALREADY READ, MACRO LMJ B11,GETIN . GET NEXT MACRO/INCLUDE LINE. MACRO J GN302A GN302C LMJ B11,PERR FORM6 0,204,0 . UNRECOGNIZED CHAR IN LABEL J GN302D GN301A L,Q2 A0,NLINE+2 . COLUMN 6 TNE,M A0,060 . TEST ASCII ZERO S,S6 A0,MAFLST . FORCE LIST OF GENERATED SZ,H1 FDASCZ . COUNTS CHARACTERS FOR MOVING J GN301 GN301B L,M R1,32 . MOVE 33 HALF WORDS 66 CHARACTERS L,M A2,GN301D TZ,H1 FDASCZ . TEST IF PACKING STARTS ON WORD BOUNDAR L,M A2,GN301E TZ,H1 FDASCZ AN,M B2,1 GN301C L,H2 A4,0,*A0 LMJ A1,0,A2 L,H1 A4,0,A0 L,M A1,GN301C J 0,A2 GN301D S,H1 A4,0,B2 JGD R1,$+5 S,H1 R15,FDASCZ L,M A4,040040 . TWO ASCII BLANKS S,H2 A4,0,*B2 . FILL OUT A WORD J GN302 LMJ A2,0,A1 GN301E S,H2 A4,0,*B2 JGD R1,$+3 SZ,H1 FDASCZ J GN302 L,M A2,GN301D J 0,A1 GN302R L,Q1 A0,NLINE+1 . LOOK AT COLUMN 1 ASCII TNE,M A0,'C' . TEST COMMENT CARD J GN302 . YES TNE,M A0,'G' J GN302G TNE,M A0,'H' J GN302H J GN302Q GN302S L,Q2 A0,NLINE+2 . CHECK COLUMN 6 TNE,M A0,' ' . TEST CONTINUATION J GN304 . NO TNE,M A0,'0' J GN304 L A0,NLINE+1 . TEST COLUMNS 1 TO 4 TE A0,(' ') J GN302C L,Q1 A0,NLINE+2 . TEST COLUMN 5 TE,M A0,' ' J GN302C J GN302D FIELDATA . END OF FILE 222100 GN303 S R15,EOF SET EOF 222200 L A0,(' ') PUT BLANKS IN NEXT LABEL 222300 S A0,NLINE+1 222400 TNZ FDASCZ . TEST FOR ASCII LINES J GN304 NO FIELDATA LINES L A0,(040040040040) . 4 ASCII BLANKS S A0,NLINE+1 S A0,NLINE+2 . END OF THIS STATEMENT -- INITIALIZE GX 222600 GN304 AN B2,(1,SBUF) S B2,N1STLG LENGTH OF STATEMENT MACRO AN,M B2,1 MACRO S B2,R5 LENGTH MINUS ONE FOR JGD MACRO GN304A . L A0,GXTRCZ . SET UP NORMAL BI-LINK S A0,GXSKIP L B2,GXSB2 S B2,GXB2 L B3,(1,SBUF) SZ MCNT SZ MCLVOU S,H2 B3,GNSFL . SHOW STATEMENT READ BY GNS GENER TZ,H1 FCPEND SZ,H2 GNSFL L,H2 A0,FCPEND S,H1 A0,FCPEND GXABSB,ALL . SET NORMAL GX MODE L FNXT,R8 RESET NEXT SZ FEOS RESET 'E.O.S.' FLAG 223700 LMJ B11,GX POSITION GX AT 1ST CHAR 223710 J GN305 L,H2 B11,GN30 RELOAD B11 223730 SZ FNXT SET NEXT J 2,B11 (RETURN 3) 223800 GN305 TNZ MACNO GENER LMJ B11,PSTL GENER L,M A0,GN311J S,1 A0,PS40 CTABD J PS401 CTABD GN311J L B11,GN30 TZ EOF J 1,B11 J GN311 GN3058. EXEC 8 L,H2 B11,GN30 J GN310 . 224200 GN302G . TREAT AS COMMENT IF NO G OPTION L A1,PARTBZ . TOP A1,(1*/('Z'-'G')) J GN302 TREAT AS COMMENT GN302K L,M A1,' ' S,S1 A1,NLINE+1 J GN302Q GN302H . TREAT AS COMMENT IF THERE IS A G OPTION L A1,PARTBZ TEP A1,(1*/('Z'-'G')) J GN302 TREATAS COMMENT J GN302K . 224400 GN306 L A0,NLINE+1 GET LABEL FIELD TP DELAB IF PROCESSING MACRO DEFINE J GNMACD MACRO DEFINE TNZ MACNO J GNJ36 TZ FDASCZ . TEST FOR ASCII IMAGES J AGN306 L A0,('END ') TNE A0,NLINE+2 J GN311 L A0,NLINE+1 GNJ36 . TZ FDASCZ . TEST FOR ASCII IMAGES J AGNJ36 AND A0,(0777777777700) TNE A1,(050505050500) IS LABEL PRESENT J GN308 NO L,M A5,0 . ACCUMULATE SUM L,M A0,5 . COUNTS CHARACTERS L A4,NLINE+1 . LABEL FIELD GNJ37 SZ A3 JGD A0,$+2 . COUNTS 5 CHARACTERS J GNJ38 LDSL A3,6 TNE,M A3,5 . TEST FOR BLANK J GNJ37 AN,M A3,060 . CONVT DIGIT TO BINARY MSI,M A5,10 A A5,A3 . ADD TO SUM J GNJ37 AGN306 DL A0,NLINE+2 . EXTRACT COLUMNS 7 TO 10 LDSL A0,18 ASCII TNE A0,('END ') J GN311 AGNJ36 L A0,NLINE+1 . TEST COLUMNS 1 TO 4 TE A0,(' ') J $+4 L,Q1 A1,NLINE+2 . COLUMN 5 TNE,M A1,040 . TEST FOR BLANK J GN308 L,M A5,0 . ACCUMULATES SUM L,M A0,4 . COUNTS CHARACTERS L A4,NLINE+1 . LABEL FIELD AGNJ37 SZ A3 JGD A0,$+2 J AGNJ38 LDSL A3,9 . EXTRACT ONE CHARACTER TNE,M A3,040 . TEST FOR BLANK J AGNJ37 AN,M A3,060 . CONVERT TO BINARY MSI,M A5,10 A A5,A3 J AGNJ37 AGNJ38 L,Q1 A3,NLINE+2 . COLUMN 5 TNE,M A3,040 . TEST FOR BLANK J GNJ38 AN,M A3,060 MSI,M A5,10 A A5,A3 FIELDATA GNJ38 TNE A5,DELAB . IS CURRENT LAB EQ TO TARGET LABEL J GN307 GN308 . GN308B . L A0,(1,NLINE) EXEC 8 TNZ FCPLST EXEC 8 TN INCLVL . IF INCLUDE/MACRO, MACRO J GN308A . READ VIA N1INC. MACRO TN INCLVL J GN308J DL A4,XF60ID DS A4,F60ID L A4,XF60ID+2 S A4,XF60ID GN308J L,M A5,12 S,S1 A5,NLINE L,H1 A1,SIRLNG . LENGTH OF IMAGE A,M A1,1 . INCLUDE F60 ID IN COUNT L A2,(3,F60ID) . SPECIAL INFO FOR END OF IMAGE L,H2 A3,FDASC . SET ACCORDING TO TYPE OF IMAGE LMJ B11,W60F . PLACE IMAGE IN F60 L,M A5,060 S,S1 A5,NLINE L,M A5,'D' TN DELAB S,S1 A5,NLINE+1 TNZ FDASCZ . TEST FOR ASCII IMAGES J AGN308 L,M A5,0104 . AN ASCII D TN DELAB S,Q1 A5,NLINE+1 . SET A D INTO COLUMN 1 AGN308 L A0,(1,NLINE) L,H1 A1,SIRLNG . LENGTH OF IMAGE A,M A1,1 . ADD F60 ID INTO TOTAL L A2,(3,F60ID) . SPECIAL INFO FOR END OF STATEMENT L,H2 A3,FDASC . SET ACCORDING TO TYPE OF IMAGE LMJ B11,W60F . PLACE IMAGE IN F60 GN308Q L A0,(14,NLINE+1) TZ FDASCZ L A0,(20,NLINE+1) . LENGTH FOR AN ASCII READ L,M B10,SIRXX LXI,M B11,JPL$PIRCB$ . BANK CONTAINING SIR$ S A0,SIRLNG . SAVE POTENTIAL LENGTH OF IMAGE LXM,H2 B11,FDASEX LIJ B11,0,B11 . TO BGETSR$ OR BGETAS$ LMJ B11,CCE CONTROLCARD SEQUENCE ERROR J GN3077 SLJ CNWTST CHECK FOR NEG. CONTROL WORD J GN308Q . SKIP NEGATIVE CONTROL WORDS DL A4,F60ID DS A4,XF60ID L A4,F60ID+2 S A4,XF60ID+2 L A3,CTSLNB CTS LINE NUMBER SZ CTSLNB TZ,S2 CRFLGS S,H2 A3,XF60ID+1 . CTS LINE NUMBER J GN306 GN308A TZ FCPEND . IF THIS IMAGE IS AN END, MACRO J $+3 . GO TERMINATE DELETE. MACRO LMJ B11,GETIN MACRO J GN306 MACRO L A0,(' ') . REMOVE ANY STRAY D'S MACRO S A0,NLINE+1 MACRO GN307 SZ DELFLG TARGET LABEL FOUND L,14 A0,GN311 S,1 A0,PS40 J PS401 SET UP LABEL FOR THIS STATEMENT GN3077 LMJ B11,PERR FORM6 01,198,0 L A0,(' ') S A0,SBUF S A0,SBUF+1 S A0,NLINE+1 S R15,EOF LR,M R5,1 J GN304A GNMACD L,S1 A0,NLINE+1 SKIP ALL COMMENT CARDS TNE,M A0,'C' J GN308B LN,M A1,1 TNE,XH2 A1,DELAB THE LAST TIME AROUND J GNMACN THRU HERE L A0,NLINE+2 TNE A0,('MACEND') J GNMACM L,M A0,15 LMJ B11,PRQEST SLJ SYMOF OUT OF CORE SSL A0,18 L A1,DELAB LINK UP S,H2 A0,0,A1 S,H2 A0,DELAB SZ 0,A0 L,M A1,14 S,H1 A1,0,A0 A A0,(1,1) L A1,(1,NLINE+1) L,M R1,14 BT A0,0,*A1 J GN308B GNMACN SZ DELAB WER'RE DONE J GN307 GNMACM S,H2 A1,DELAB SAY TO STOP NEXT TIME J GN308B . CNWTSR S,H2 A0,FDASC . SET WHETHER IS FD OR ASC S A1,SIRCNT . SAVE CONTROL WORD DS A2,F60ID . SAVE SIR$ EDITING INFORMATION S A4,F60ID+2 S,H1 A1,F60ID+2 L,H2 B11,CNWTST FIX UP RETURN ADDRESS JP A1,1,B11 . CONTROL WORD IS POSITIVE S A1,NLINE . GET CONTROL WORD INTO F60 L,M A0,NLINE . LOCATION OF IMAGE L,S2 A1,SIRCNT . LENGTH OF IMAGE A,M A1,1 . INCLUDE CONTROL WORD IN COUNT L A2,(1,F60ID) . PASS CYCLE INFO L,H2 A3,FDASC S,H1 A3,F60ID+2 . FORCE ASCII INDICATOR OVER CYCLE INFO LMJ B11,W60F . PLACE ITEM IN FILE F60 L,H2 B11,CNWTST . RESTORE B11 L A1,SIRCNT RESTORE A1 SZ NLINE SSL A1,24 TE,M A1,05001 TYPE 50 CONTROL WORD J 0,B11 NO L,H1 A1,NLINE+1 MAY BE LITERAL 'CTS' L,H2 A2,NLINE+1 MAY BE CTS LINE NUMBER TNE,M A1,'CTS' S A2,CTSLNB SAVE CTS LINE NUMBER J 0,B11 RETURN . GET STATEMENT LABEL A LMJ B11,GOL 225200 . 225300 GOL* S,H2 B11,GOL30 A+1 E. O. S. LMJ B11,GIT A+2 NORMAL 225500 J *GOL30 RETURN TO A+1 225600 TNE,M A2,4 ITEM = INTEGE CONSTANT 225700 J GOL31 YES 225800 LMJ B11,PERR NO - ERROR 225900 FORM6 011,39,GITV 226000 L A2,SEQL SEQL=SEQ CT OF ST LABEL 226100 S A2,GITV 226200 GOL31 LMJ B11,GETL GET LABEL REFERENCE + PROCESS IT 226300 L B11,GOL30 226400 L A0,GXX 226500 J 1,B11 RETURN TO A+2 226600 . 226700 . GO TO STATEMENT 227300 . 227400 GOTO* S,H2 B11,GO30 227500 SZ FC4 DO FLAG 227600 SZ FD4 DO FLAG 227700 TNZ FRD IS THIS IN THE RANGE OF A DO 227800 J GO31 NO 227900 TZ LSLF .LAST STATEMENT A LOGICAL IF CSC17 J GO31 .YES-NO ERROR CSC17 LMJ B11,PERR YES 228000 FORM6 1,37,0 ERROR 37 228100 GO31 LMJ B11,GX 228200 J GO310 EOS 228300 L,S2 A2,FLD2,A0 228400 J *GO21,A2 228600 . 228700 GO311 LMJ B11,PERR 228800 FORM6 010,9,GXX 228900 J GO40 229000 . 229100 GO310 LMJ B11,PERR 229200 FORM6 01,4,0 229300 J GO300 229400 . 229500 . 229600 . 229700 . UNCONDITIONAL GOTO 229800 . 229900 GO50 SZ FNXT SET NEXT LMJ B11,GIT GET LABEL 230100 SLJ BUG EOS 230200 TNE,M A2,4 230300 J GO505 230400 L,M A0,3 IF GIT RETURNS A CONSTANT L,M A1,8 DO NOT EDIT INTO ERROR MESSAGE TW A0,A2 J GO502 LMJ B11,PERR FORM6 011,186,0 J GO300 GO502 LMJ B11,PERR FORM6 011,26,GITV 230600 J GO300 GO505 LMJ B11,GETL MAKE SYM AND LREF ENTRIES OR A1,GO18 231200 S A2,STRING,*B5 F30 ITEM 231300 GO503 L A0,SEQL S OF LABEL 231400 OR A0,GO19 231500 S A1,STRING,*B5 F30 ITEM 231600 TZ FEOS 231700 J GO300 231800 J GO310 231900 . ASSIGNED GO TO M, ( ) 232600 . 232700 GO60 SZ FNXT SET NEXT S B4,GO11 SAVE B4 232900 L B4,(1,0) . INITALIZE PRESYM INDEX MTFSYM L A0,(-0102,-1) . AREF LINK FLAG MTFSYM S A0,MLINK MTFSYM LMJ B11,GIT GET M 233100 SLJ BUG 233200 LMJ B11,GSWV GET SIMPLE SWITCH VARIABLE 233500 OR A1,(13,1,0,0,0,0) S A2,STRING,*B5 L A0,PL PLATEAU 233700 S A0,PRESYM,B4 . PUT IN PRESYM TABLE MTFSYM S,H1 A1,PRESYM,*B4 . PUT IN PRESYM TABLE MTFSYM TZ FEOS 234000 J GO651 EOS 234100 L A0,GXX 234200 TNE,M A0,',' 234300 L FNXT,R8 RESET NEXT LMJ B11,GX 234500 J GO652 EOS 234600 TE,M A0,'(' X=LEFT PAREN 234700 LMJ B11,ERR2 NO 234800 L,M A1,PRESYM-1,B4 MTFSYM SR,S4 R15,0,A1 GO610 LMJ B11,GOL GET LABEL AND ENTER LREF 235100 J GO652 EOS 235200 L FNXT,R8 RESET NEXT TZ FEOS 235400 J GO652 EOS 235500 TNE,M A0,')' 235600 J GO653 235700 TE,M A0,',' 235800 LMJ B11,ERR2 235900 J GO610 236000 GO653 LMJ B11,GX GET EOS 236100 J GO651 236200 GO652 LMJ B11,PERR 236300 FORM6 0,4,0 236400 GO651 L,M A0,PRESYM . LOC OF TABLE MTFSYM LXI,M A0,0,B4 . LNG OF TABLE MTFSYM LMJ B11,MTLT . MOVE TO LINKED TABLE MTFSYM SLJ SYMOF . ERROR SYM OVERFLOW MTFSYM L B4,GO11 RESTORE B4 236600 L A0,SEQL LABEL SEQ NO. 236700 OR A0,GO12 ID= ST TYP, ST= ASS GOTO, N=1,S 236800 S A1,STRING,*B5 236900 J GO300 237000 . 237100 . 237200 . 237300 . COMPUTED GOT0 237400 . 237500 GO40 LMJ B11,PSDP S B5,GO17 SAVE B5 S B4,GO11 SAVE B4 237800 L B4,(1,0) MTFSYM L A0,(-0102,-1) . AREF LINK FLAG MTFSYM S A0,MLINK MTFSYM GO401 LMJ B11,GIT 238000 J GO310 EOS 238100 GO404 TNE,M A2,4 238200 J GO402 ITEM=INTEGER CONST. 238300 TNE,M A2,3 238400 J GO403 238500 LMJ B11,ERR3 ITEM=VAR NAME 238600 J GO300 ERROR 238700 J GO404 238800 . 238900 GO402 LMJ B11,GETL GET LABEL REF AND PROCESS 239000 L,M A2,2 T=2 239100 J GO405 239200 . 239300 GO403 LMJ B11,GSWV GET SIMPLE SWITCH 239400 L A2,PL 239500 S A2,PRESYM,B4 . PUT IN PRESYM TABLE MTFSYM S,H1 A1,PRESYM,*B4 . PUT IN PRESYM TABLE MTFSYM L,M A2,3 T=3 239800 . 239900 GO405 S A1,STRING,B5 SYMY 240000 S,S2 A2,STRING,B5 T 240100 L,M A2,ID4 ID=ST REF 240200 S,S1 A2,STRING,*B5 240300 TZ FEOS 240400 J GO310 EOS 240500 L FNXT,R8 RESET NEXT LA A0,GXX 240650 TNE,M A0,')' 240700 J GO406 X=RT PAREN 240800 TE,M A0,',' 240900 LMJ B11,ERR2 241000 J GO401 X=COMMA 241100 . 241200 GO406 LMJ B11,GX 241300 J GO310 EOS 241400 TE,M A0,',' X=COMMA 241500 LMJ B11,ERR2 241600 LMJ B11,SGX3 SAVE FOR POTENTIAL RESCAN S B5,GO171 SAVE PRESENT STRING ADDRESS LMJ B11,GIT YES - GET I 241700 J GO310 EOS 241800 TNZ FEOS J GORSC GO RESCAN EXPRESSION TNE,M A2,3 241900 J GO407 ITEM=VAR NAME 242000 GORSC LMJ B11,RGX3 RESCAN SET BACK POINTERS L A0,(070000,071) FLAG FOR CMPUTED GO TO S B11,SBSCRP LMJ B11,SCIOX SCAN AND CONVERT TO INTEGER SZ SBSCRP L A0,(070000,0) DUMMY TO REFER TO PSUEDO ARGUMENT J GORSCA GO407 L,M A0,PRESYM . LOC OF TABLE MTFSYM LXI,M A0,0,B4 . LNG OF TABLE MTFSYM LMJ B11,MTLT . MOVE TO LINKED TABLE MTFSYM SLJ SYMOF . SYM OVERFLOW MTFSYM LMJ B11,GINTVD J GORSC . RESCAN IT WAS A PARAMETER J $+2 . OK AN INTEGER J GORSC . NON INTEGER OR DEFINE LMJ B11,VTF30 OUTPUT I TO F30 GORSCA . L A0,GO171 COMPUTE R 242800 AN A0,GO17 242900 OR A0,GO15 F30 ITEM 243100 S A1,STRING,*B5 R ITEM TO F30 243200 L,M A0,0,B1 . GET CURRENT SEQUENCE NUMBER OR A0,GO16 243500 S A1,STRING,*B5 F30 ITEM(ST TYPE) 243600 L B4,GO11 RESTORE B4 243700 LMJ B11,GX 243800 J GO300 EOS 243900 J GO310 244000 . 244100 GO300 RES 0 244200 J *GO30 CTABD GO21 J GO60 X=ALPHA 245600 J GO50 X=NUMERIC 245700 J GO40 X=LEFT PAREN 245800 J GO311 X=OTHER 245900 . 246000 . GET STATEMENT LABEL REFERENCE (CONDITIONAL REFERENCE ONLY)246200 . 246300 GSLR* S,H2 B11,GR30 246400 S B4,GR11 SAVE B4 246500 L B4,A0 N-1 IS IN A0,(N-1=K) 246600 GR301 LMJ B11,GX GET 1ST. CHAR. 246700 J GR304 EOS 246800 TNZ,S1 FLD1,A0 246900 J GR303 X=ALPHA NUMERIC 247000 TNE,M A0,',' 247100 J GR302 247200 LMJ B11,PERR 247300 FORM6 011,9,GXX 247400 GR302 L A0,GR12 247500 S A0,STRING,*B5 DROP OUT ITEM 247510 GR312 JGD B4,GR301 K=0 247730 J GR305 YES 247800 . 247900 GR303 SZ FNXT SET NEXT LMJ B11,GIT GET LABEL 248100 SLJ BUG EOS 248200 TNE,M A2,4 248300 J GR306 ITEM=INTEGER COUNT 248400 TNE,M A2,3 248500 J GR307 ITEM=VAR NAME 248600 L,M A0,2 L,M A1,8 TW A0,A2 J GR320 LMJ B11,PERR INAPPROPRIATE CONSTANT FORM6 011,187,0 DO NOT EDIT J GR304 GR320 LMJ B11,PERR FORM6 011,26,GITV 248800 J GR304 248900 . 249000 GR306 L A0,GITV DOES ITEM=NEXT ST LABEL 249100 TE A0,NLABL 249200 J GR308 NO 249300 GR304 L A0,GR12 249400 S A0,STRING,*B5 DROP OUT F30 ITEM 249500 J GR309 249600 . 249700 GR308 LMJ B11,GETL GET LABL SYM TAB REF AND ENTER L--- 249800 OR A1,GR13 ST REF F30 ITEM 249900 S A2,STRING,*B5 250000 GR309 JGD B4,GR310 250100 GR305 L B4,GR11 RESTORE B4 250200 LMJ B11,GIT TEST FOR ND OF STATEMENT J *GR30 MTFSYM LMJ B11,PERR 250500 FORM6 0,4,0 250600 J *GR30 250700 . 250800 GR310 LMJ B11,GX 250900 J GR304 EOS 251000 TNE,M A0,',' X=COMMA 251100 J GR301 YES 251200 LMJ B11,PERR NO 251300 FORM6 010,9,GXX 251400 J GR301 251500 . 251600 . 251700 GR307 LMJ B11,GSWV (ITEM=VAR NAME) GET S SWITCH VAR 251800 OR A1,(13,1,0,0,0,0) S A2,STRING,*B5 L A0,(-0102,-1) . AREF LINK FLAG MTFSYM S A0,MLINK MTFSYM L A3,PL . PLATEAU MTFSYM S A3,PRESYM . PUT IN PRESYM TABLE MTFSYM S,H1 A1,PRESYM . PUT IN PRESYM TABLE MTFSYM L A0,(1,PRESYM) . (LNG,LOC) OF TABLE MTFSYM LMJ B11,MTLT . MOVE TO LINKED TABLE MTFSYM SLJ SYMOF MTFSYM J GR309 252500 . 252600 . GET SYM (SIMPLE SWITCH VARIABLE) 253500 . 253600 GSWV* S,H2 B11,GS30 253700 TNE,M A2,3 253800 J GS301 ITEM=VAR NAME 253900 LMJ B11,ERR4 254000 J GS300 254100 GS301 LMJ B11,GLG GET SYM 254200 J GS303 NOT IN 254300 L,H1 A2,2,A1 GET MODE 254400 AND,M A2,7 254500 J *GS21,A3 BRANCH ON CLASS 254700 . 254800 GS401 AND,M A2,070 C=0 254900 JNZ A3,GS402 255000 GS403 LMJ B11,DTYPE T=0,DETERMINE TYPE 255100 OR A2,A0 255200 S,H1 A3,2,A1 255300 GS402 TP,XH2 2,A1 255400 J GS502 IND VAR 255500 GS300 RES 0 NOT IND VAR 255600 J *GS30 . 255800 GS601 AND,M A2,01000 C=5 255900 JZ A3,GS401 F=0 256000 J GS501 256100 . 256200 GS701 AND,M A2,0700 C=7 TE,M A3,0400 J GS501 AND A2,(0777070) S,H1 A3,2,A1 J GS300 . 256700 GS500 SLJ DEINTX MAKE SURE NAME IS INTRINSIC AND,M A2,01000 JZ A3,GS304 GS501 LMJ B11,PERR C=OTHER 256800 FORM6 031,2,SYMV 256900 GS304 GS303 L,H1 A2,2,A1 257400 J GS403 257500 . 257600 GS502 LMJ B11,PERR 257700 FORM6 031,40,SYMV 257800 J GS300 257900 . 258000 . 258300 GS21 J GS401 C=0 258400 J GS501 1 258500 J GS501 2 258600 J GS501 3 258700 J GS501 4 258800 J GS601 5 258900 J GS500 C=6 J GS701 7 259100 ASCII . . GET NEXT NON-BLANK CHARACTER (GX) ASCII . . THIS ROUTINE EXTRACTS THE NEXT NON-BLANK CHARACTER FROM THE SOURCE STRING . IF FNXT=0, THE CHARACTER IS ASSUMED TO BE IN GXX. . CALLING SEQUENCE -- A LMJ B11,GX (OR LMJ B11,0,B2) . A+1 END OF STATEMENT RETURN . A+2 NORMAL RETURN . UPON EXIT A0 AND GXX CONTAIN THE FIELD-DATA CODE FOR THE CHARACTER. . XARCTM* PROC . ASCII CHARACTER EXTRACTION FOR MACRO JGD FNXT,$+2 . GET NEXT? J AGX3 . OR LAST? JGD R5,$+2 . TERMINATE SUBSTITUTION J MACCED . AFTER LAST CHARACTER L A0,0,B3,XARCTM(1,1) . GET NEXT CHAR L A1,A0 . ALWAYS CONVERT AT LEAST ONCE EX GXASCV . CONVERT TO FIELDDATA EXCEPT IN HOLERIT S A0,GXX . SAVE IT L,H1 A1,ASCFDASC$,A1 . CONVERT FOR CONTROL EX GXVEC,A1 END AGETMX* XARCTM Q1 AGETMXA* XARCTM Q2 XARCTM Q3 XARCTM Q4 JGD FNXT,AGX2 . GET NEXT J AGX3 . OR LAST XARCT* PROC . EXTRACT ASCII CHARACTER REGULAR JGD FNXT,$+2 . GET NEXT J AGX3 . OR LAST L A0,0,B3,XARCT(1,1) . GET NEXT CHARACTER L A1,A0 EX GXASCV . CONVERT TO FIELDATA EXCEPT IN HOLERITH S A0,GXX L,H1 A1,ASCFDASC$,A1 . FORCE TO FIELDATA FOR CONTROL EX GXVEC,A1 END AGETX* XARCT Q1 AGETXA* XARCT Q2 XARCT Q3 XARCT Q4 JGD FNXT,AGX1 . GET NEXT J AGX3 . OR LAST J $-2 AGX1 . TEST FOR EOS JGD R5,AGX2 L,XM A0,*-1,*0 . IMPOSSIBLE CHARACTER S A0,GXX . AND GXVEC INDEX S R15,FEOS SZ R5 J 0,B11 AGX2 . GET NEXT WORD L B2,GXB2 . RESET BI-LINK L A0,1,*B3 . NEXT WORD TE A0,(' ') J 2,B2 . NOT SKIP WORD L A0,GXHOL TE A0,GXSKIP J 2,B2 . NOT SKIP MODE TNZ MCNT J AGX1 . NOT WITHIN SUBSTITUTION L A0,R5 AN,M A0,4 . ADVANCE 4 CHARACTERS JZ A0,2,B2 JN A0,2,B2 S A0,R5 . MORE THAN 6 CHAR ARE LEFT J AGX2 AGX3 . GET LAST CHARACTER TNZ FDASQT . TEST IF ASCII CHARACTERS ALLOWED J GX3 . GXX WOULD CONTAIN A FIELDATA CHARACT TN GXASCV . A NOP IF ASCII CHARACTERS ARE J GX3 . NOT CONVERTED L A0,GXX . LAST L FNXT,R8 . RESET NEXT TE,M A0,' ' TNE,M A0,'@' J GX4 . SPECIAL HANDLING TE,M A0,';' TNE,M A0,0136 . AN ASCII DELTA J GX4 . SPECIAL HANDLING L,H1 A1,ASCFDASC$,A0 . CONVERT TO FIELDATA FOR CONTROL TN A0 . DO NOT CONVERT SPECIAL EOS CHARACTER J *GXVEC,A1 . PASS THRU SPECIAL VECTOR J 0,B11 . TAKE EOS REUTRN FIELDATA . 259200 . GET NEXT NON-BLANK CHARACTER (GX) . . THIS ROUTINE EXTRACTS THE NEXT NON-BLANK CHARACTER FROM THE SOURCE STRING. . IF FNXT=0, THE CHARACTER IS ASSUMED TO BE IN GXX. . CALLING SEQUENCE -- A LMJ B11,GX (OR LMJ B11,0,B2) . A+1 END OF STATEMENT RETURN . A+2 NORMAL RETURN . UPON EXIT A0 AND GXX CONTAIN THE FIELD-DATA CODE FOR THE CHARACTER. . XTRCTM* PROC JGD FNXT,$+2 . GET NEXT? J GX3 . OR LAST? JGD R5,$+2 . TERMINATE SUBSTITUTION J MACCED . AFTER LAST CHAR L A0,0,B3,XTRCTM(1,1) . GET NEXT CHAR S A0,GXX . SAVE IT EX GXEXIT . SPECIAL ACTION RETURN END GETMX XTRCTM S1 GETMXA XTRCTM S2 XTRCTM S3 XTRCTM S4 XTRCTM S5 XTRCTM S6 JGD FNXT,GX2 . GET NEXT? J GX3 . OR LAST? J $-2 XTRCT* PROC JGD FNXT,$+2 . GET NEXT? J GX3 . OR LAST? L A0,0,B3,XTRCT(1,1) . GET NEXT CHAR S A0,GXX . SAVE IT EX GXEXIT . SPECIAL ACTION RETURN END GETX XTRCT S1 GETXA XTRCT S2 XTRCT S3 XTRCT S4 XTRCT S5 XTRCT S6 JGD FNXT,GX1 . GET NEXT? J GX3 . OR LAST? J $-2 GX1 . TEST FOR EOS JGD R5,GX2 L,XM A0,*-1,*0 . IMPOSIBLE CHARACTER S A0,GXX . AND GXVEC INDEX S R15,FEOS SZ R5 J 0,B11 GX2 . GET NEXT WORD L B2,GXB2 . RESET BI-LINK L A0,1,*B3 . NEXT WORD TE A0,(' ') J 2,B2 . NOT SKIP WORD L A0,GXHOL TE A0,GXSKIP J 2,B2 . NOT SKIP MODE TNZ MCNT J GX1 . NOT WITHIN SUBSTITUTION L A0,R5 AN,M A0,6 . ADVANCE 6 CHARS JZ A0,2,B2 JN A0,2,B2 S A0,R5 . MORE THAN 6 CHAR ARE LEFT J GX2 GX3 . GET LAST CHARACTER L A0,GXX . LAST L FNXT,R8 . RESET NEXT TE,M A0,' ' TNE,M A0,'@' J GX4 . SPECIAL HANDLING TE,M A0,';' TNE,M A0,'^' J GX4 . SPECIAL HANDLING J *GXVEC,A0 . PASS THROUGH SPECIAL VECTOR GX4 . LAST REQUIRES RE-EXECUTION L A0,R5 A A0,MCNT . BACK UP CHAR COUNT S A0,R5 AN,H2 B2,GXSKIP . BACK UP CHAR INDEX SZ,S2 GXDMPS . CLEAR DUMP NEXT J 2,B2 . RE-EXECUTE BI-LINK GX5 . LAST WAS SEMICOLON IN GXABSB MODE L A0,GXSCLN . CURRENT MODE TNE A0,GXSSCN J 0,B11 . ABSB, EOS RETURN SZ FSCLN SZ FEOS J 2,B2 . RTRN, RE-EXECUTE BI-LINK GXCMSP . FOUND COMMENT CHAR L A0,MCNT A A0,R5 JZ A0,GX1 . ONLY ONE WORD TO SKIP L,M A0,GX6 S A0,ARFL1 . SET RETURN FROM MACCED GX6 TZ MCNT J MACCED . TERMINATE ALL SUBSTITUTIONS SZ ARFL1 SZ A0 L A1,R5 . GET SBUF COUNT TZ FDASCZ J AGX6 DI A0,11,0,M . COUNT MOD 12 AGX6B ANA A1,R5 . -(COUNT-COUNT(MOD 12)) = -COUNT(NEW) LA A0,B3 . GET SBUF INDEX AA A0,R5 . INDEX + COUNT(OLD) = SBUF LENGTH AA A0,A1 . INDEX+COUNT(OLD)-COUNT(NEW) SNA A1,R5 . NEW COUNT SA A0,B3 . NEW INDEX J GX1 AGX6 LSSL A1,2 . COMPUTE NUMBER OF CHARACTERS DI,M A0,66 . REMAINDER IS OF NUMBER OF CHARACTERS T L A0,A1 DSC A0,2 . LEAVE WORDS IN A0; CHARACTERS IN A1 SSL A1,35 JZ A1,AGX6C A,H2 B2,GXSKIP . ADVANCE ONE CHARACTER AN,M A1,1 . SKIP CHARACTERS NOT PART OF WORD J $-3 AGX6C DSL A0,36 MOVE A0 TO A1 J AGX6B GXCSCN . FOUND SEMICOLON EOS S R15,FEOS S R15,FSCLN L A0,R5 A A0,MCNT . BACK UP CHAR COUNT S A0,R5 L,XM A0,*-2,*0 . IMPOSIBLE CHARACTER S A0,GXX . AND GXVEC INDEX J 0,B11 . EOS RETURN . $(2) . CTABD . THE FOLLOWING IS A CELL WHICH CONTROL TRANSLATION OF ASCII . TO FIELDATA. ALL ASCII CHARACTERS ARE CONVERTED EXCEPT WHEN . A HOLERITH STRING IS BEING PARSED . THE CELL GXASCV NORMALLY CONTAINS L,H1 A0,ASCFDASC$,A0 . BUT IF BLANKS ARE RETURNED THEN IT CONTAINS A NOP GXASCV* L,H1 A0,ASCFDASC$,A0 GXASCVB* L,H1 A0,ASCFDASC$,A0 . BACKUP FOR ABOVE . . THE FOLLOWING ARE THE BACKUP CELLS OF THE GX SPECIAL-ACTION . EXIT-VECTOR. CELLS MARKED WITH AN '*' ARE THEMSELVES BACKED UP . BY THOSE HAVING A '^' IN THE SAME COLUMN. . . B2 BACKUP . GXB2* + GETX . * CURRENT BI-LINK GXSB2* + GETX . ^ NORMAL BI-LINK GXSMB2* + GETMX . ^ DELTA CONTROLLED BI-LINK . . CELLS REFERENCED BY 'GXABSB' AND 'GXRTRN' PROC'S . GXSMSP* LMJ B2,GXCMSP . '@'=END-OF-CARD GXSDEL* LMJ B2,1,B11 . * '^' NOT= SUBSTITUTION GXSKIP* LMJ B2,GETXA-GETX,B2 . * SKIP-THIS-CHAR ENTRY GXSSCN* J GXCSCN . SEMICOLON=END-OF-STMT . . BACKUPS TO THE ABOVE . GXABDL* LMJ B2,GXCDEL . ^ FOR MACRO SOURCE LEVEL>0 GXRTN* LMJ B2,1,B11 GXTRCZ* LMJ B2,GETXA-GETX,B2 . ^ SKIP, NORMAL BI-LINK GXTRMZ* LMJ B2,GETMXA-GETMX,B2 . ^ SKIP, DELTA BI-LINK . . THE GX EXIT EXECUTE CELL, WHICH MAY OR MAY NOT TRAP THE CHAR . GXEXIT EX GXVEC,A0 OR LMJ B2,GXDMP FOR DIAGNOSTICS . . THE GX SPECIAL-ACTION EXIT-VECTOR . VARIABLE CELLS ARE MARKED WITH POTENTIAL CONTENTS . J GX5 . SEMI-: J 0,B11 . EOS GXVEC . GXMSPC* LMJ B2,GXCMSP . @ GXSMSP,GXRTN DO 3 , LMJ B2,1,B11 . GXDEL* LMJ B2,1,B11 . DELTA GXSDEL,GXRTN GXHOL* LMJ B2,GETXA-GETX,B2 . BLANK GXSKIP,GXRTN DO 53 , LMJ B2,1,B11 . GXSCLN* J GXCSCN . SEMI-: GXSSCN,GXRTN DO 4 , LMJ B2,1,B11 . ALLFLG +0 . NON ZERO IF NON INTEGER GIVE SPECIAL RETURN DEINTX* J $-$ CTABD J DEITY CTABD GE30 J $-$ CTABD GS30 J $-$ GY30 J $-$ CTABD GI30 J $-$ CTABD GR30 J $-$ CTABD GO30 J $-$ CTABD GN30 J $-$ CTABD GXB3 J $-$ CTABD . GLD CONSTANTS 208500 GD11 +0 SAVE A6 GD12 + 0 =0,NO SUBPRGM ARGS,NOT=0,YES 208650 . 208700 GD30 J $ 208800 . 208900 . GLG CONSTANTS 212300 . 212400 GL30 J $ 212500 . 212600 . GLG1 CONSTANTS 215400 . 215500 GL40 J $ 215600 . 215700 . 217800 . GLS CONSTANTS 218000 . 218100 GL50 J $ 218200 . 218300 . GOL CONSTANTS 226900 GOL30 J $ 227000 . 227100 . 244400 . GOTO CONSTANTS 244600 . 244700 GO11 +0 SAVE B4 GO12 FORM2 ID1,6,1,0 ID= ST TYP, ST= ASS GOTO, N=1,S 244850 GO15 FORM2 ID7,1,0,0 ID=CONST ITEM,F=1,K 244900 GO16 FORM2 ID1,8,2,0 ID=ST TYPE,ST=COM GOTO,N=2,S 245000 GO17 +0 INDEX FOR STRING GO171 +0 SAVE B5 FOR I AND R GO18 FORM2 ID4,0,0,0 ID=ST REF,T=0 245300 GO19 FORM2 ID1,7,1,0 ID=ST TYPE,ST=UNCOND GO TO,N=1,S 245400 GO20 FORM2 ID3,0,0,0 ID=DROP THROUGH,DOT=0 245500 . GSLR CONSTANTS 252800 . 252900 GR11 +0 SAVE B4 GR12 FORM2 ID3,0,0,0 ID=DROP OUT,DOT=0 253100 GR13 FORM2 ID4,0,2,0 ID=ST REF,T=2,SYM 253200 GR14 FORM2 ID3,0,0,0 ID=DROP OUT,DOT=0 253210 MXDMN + 1 131K CNWTST* J $-$ J CNWTSR END