$(1) LIT $(1) . UNIVAC 1108 FORTRAN 5 COMPILER -- PHASE 2 . . THE MAJOR FUNCTIONS OF PHASE 2 ARE -(1) TO MAKE STORAGE ASSIGNMENTS FOR . VARIABLES, EXTERNAL NAMES, HOLLERITH CONSTANTS, AND FORMAT STATEMENTS AND . (2) TO PERFORM A PRELIMINARY LOOP ANALYSIS BY EXAMINING ALL TRANSFERS TO AND . FROM ALL LOOPS. THE RESULTS OF THE LOOP ANALYSIS ARE A TABLE OF REFERENCED . LABELS, MARKING OF THE 'LOOP' TABLE, AND POSSIBLE ERROR DIAGNOSTICS. PREQ ALC1 L A0,CRELC,*B3 . STORAGE CLASS LOADING TABLE 131K L A0,CROLC,*B4 131K N2MN* L A0,BUGERR ER IALL$ TNZ MCEXPD . IF NON ZERO RELEASE MACRO SPACE J ENDEXP L,H2 A0,MCEXPD ANU,M A0,2 S,H2 A1,SYMBRK+1 L,H2 A0,MCEXPD . LAST NEEDED ADDRESS1 A,M A0,5 ER LCORE$ ENDEXP L A0,CRCRFT SAVE CROSS REF FLAG S A0,SVCRFT SZ CRCRFT TURN OFF DURING PHASE 2 OBF30 . OPEN TO READ F30 L A0,(0777777400000) S A0,EQVTH L,M A0,5 TZ CRD 166310 LMJ B11,DALEC . ASSIGN LOCATION COUNTERS DYNAMICLY 131K L B1,CRISYM TZ,S1 BSTC1+4 SZ CRLBCM TZ,S1 BSTC1+4 . BANKING AND G OPTION ARE INCOMPATIBLE SZ,T3 CR131K TNZ,S6 CR131K . TEST G; LARGE CORE OPTION J $+4 SZ CRLBCM L A0,(010000,000) . PLACE ONLY INSTRUCTIONS IN IBANK ODD CO . ALSO CONSTANTS TO IBANK S A0,CRALC L A0,(010000,0000) . INSTRUCTIONS TO ODD COUNTER . REST TO EVEN COUNTERS TNZ,S2 U1110A . CONSTANTS IN DBANK WITH A OPTION TZ,S1 BSTC1+4 . TEST FOR BANKING S A0,CRALC TNZ CRUAL J ALC9 SZ CRLBCM L A0,(0770000,0770000) AND A0,CRALC . FORCE TEMP TO D BANK S A1,CRALC SN,S6 A0,CR131K . SET G OPTION AND UAL ALC9 L A0,(010710,0) S A0,2,B1 L B3,(1,0) 131K L B4,(1,0) 131K L,S1 A0,CRALC 131K EX ALC1,A0 131K S A0,CRSTC2 . 1ST CHOICE GOES TO INSTRUCTIONS 131K L,S2 A0,CRALC 131K EX ALC1,A0 131K S A0,CRSTC3 . THEN CONSTANTS AND TEMP 131K L,S3 A0,CRALC 131K EX ALC1,A0 131K S A0,CRSTC5 . THEN SINGLE VARIABLES 131K L,S5 A0,CRALC EX ALC1,A0 . ALLOCATE CONSTANTS S A0,CRSTC9 SZ A0 EX ALC1,A0 . NEXT EVEN COUNTER TO DBANK TEMP S A0,CRSTC8 . COUNTER FOR DBANK TEMP L,M A0,1 EX ALC1,A0 . NEXT ODD COUNTER FOR STATIC DIAGNOSTIC S A0,CRSTC7 . COUNTER FOR STATIC DIAGNOSTICS L,S4 A0,CRALC DYNCNT EX ALC1,A0 DYNCNT S A0,CRSTC6 . ARRAYS TO REMAINING EVEN COUNTER 131K L A0,CRELC,B3 131K TLE A0,CROLC,B4 131K L A0,CROLC,B4 131K AN,M A0,1 131K S A0,CRSTC4 . COMMON GETS SAALLEST .GT. ANY PREVIOUS 131K ALC2 TZ,S2 U1110A . REENTRANT LIBRARY J ALC2B J ALC2C ALC2B SZ,T1 N0RGTB+11 . DON'T USE X10, REENTRANT LIB'S USE IT ALC2C . ALC2A L,M A1,2 L A0,CRSTC2 S,S3 A1,BSTC1,A0 INSTRUCTIONS L,M A1,3 L A0,CRSTC3 CONSTANTS AND TEMP S,S3 A1,BSTC1,A0 L,M A1,4 L A0,CRSTC6 ARRAYS S,S3 A1,BSTC1,A0 L,M A1,5 L A0,CRSTC5 VARIABLES S,S3 A1,BSTC1,A0 L,M A1,7 L A0,CRSTC9 . CONSTANTS S,S3 A1,BSTC1,A0 L,M A1,6 L A0,CRSTC8 . DBANK TEMP S,S3 A1,BSTC1,A0 L,M A2,4 L A0,(1,1) ALBNKA L,H2 A1,BSTC1,A0 TLE,M A1,2 J ALBNKB TG,M A1,6 J ALBNKB L A1,CRSTC1,A1 S,H2 A1,BSTC1,A0 ALBNKB JGD A2,ALBNKA L A0,CRSTC6 A A0,(0400000) S,H1 A0,1,B1 SZ,H2 1,B1 L B3,(4,4) A,H2 B3,CRISYM AN,M B3,SYM L B4, (2,0) 166600 L B5, (4,0) 166700 L B6,(1,1) 166800 L B7, (1,0) 166900 L B8, (2,0) 167000 L A15,(0777777400000) END OF FILE 167100 L,M A13,06000 167110 L,M A11,04000 . EQ BIT 131K L R7,(0777777,0) END OF RECORD 167400 SZ R8 R8 CONTAINS SEQUENCE COUNT 167600 L B2,CRC NUMBER OF COMMON BLOCKS 167800 SZ B9 NUMBER OF EXTERNAL NAMES 168100 TNZ,S2 U1110A REENTRANT LIBRARY J ALC2L TZ,H1 CRFLD . TEST IF CHARACTERS PRESENT J $+3 TNZ,S3 CRREFL IO WAS CALLED J ALC2I L A0,('NSCR$ ') TZ,S1 CRNCCB . TEST IF ROUTINE WILL BE USED IN COMMON L A0,('NSCR$$') S A0,PRESYM SZ A0 L,M A1,2 GROUP NUMBER LMJ B10,ALC5 SZ,H2 1,A1 L,M A0,2 SET CLASS EXTERNAL S,H1 A0,2,A1 A,M B9,1 EXTERNAL COUNT S,H2 A1,N0LA ALC2I TNZ,S4 CRREFL . IO WITH UNIT OCCURRED J ALC2K L A0,('NBF0$ ') MINIMUM IO BUFFER LMJ B10,EXREF ALC2K . DO JPL , J ALC2L . NIOCB$ AT JPL CONTAINS NAMELIST TNZ,S5 CRREFL . TEST NAMELIST READ J ALC2M L A0,('NLR$ ') LMJ B10,EXREF ALC2M TNZ,S6 CRREFL NAMELIST WRITE J ALC2L L A0,('NLW$ ') LMJ B10,EXREF ALC2L TNZ,S1 CRCHAR . TEST IF CHARACTER USED WITH IO J ALC2LL L A0,('N$EQCH') TZ,S2 U1110A . TEST REENTRANT LIBRARY L A0,('N$$QCH') LMJ B10,EXREF ALC2LL L A0,CRC A A0,CRSTC4 STORAGE CLASS 4 168300 AN,M A0,1 168400 S,H2 A0,SSYM7 168600 . SCAN SYMBOL TABLE TO ASSIGN EXTERNAL NAMES AND NON-COMMON, 168700 . NON-EQUIVALENT, NON-DUMMY VARIABLES 168800 L,H1 A0,SYMBRK+1 LAST CRSYM IN FIRST BLOCK DYNCNT SZ,S2 SYMBRK COUNT BLOCKS DYNCNT S A0,SYMB DYNCNT SSYM L,M A0,7 168900 L A9,(0300000) 169100 SSYM1 AND,H1 A0,SYM+2,B3 . SELECT CLASS L,M A2,SYM,B3 YNCNT TNE A2,SYMB TEST FOR END OF BLOCK IN SYMBOL TABLE YNCNT J SSEXA YNCNT TE A15,SYM,*B3 J SSYM3,A1 -NO, BRANCH ON CLASS 169400 A B9,CRC -YES 169500 S B9,CRLAB 169510 J SCTB SCAN CTAB 169520 SSYM2 AND,H1 A13,SYM-2,B3 AND A11,A14 . TEST FOR 131K JNZ A12,SSYX1 EQUIVALENCE JNZ A14,SSYM1 VARIABLE COMMON OR EQUIVALENT 169710 TNZ,S3 SYM-2,B3 . IS TYPE UNASSIGNED J SSYM11 -YES, DON'T ASSIGN STORAGE L,M A0,SYM-4,B3 TNE,H2 A0,N0LOGF DO NOT ASSIGN STORAGE J SSYX2 FOR $LGIF$ LMJ B11,LENGTH DETERMINE ARRAY SIZE 170000 SSYX1 L,S2 A2,SYM-2,B3 A1 CONTAINS ARRAY SIZE AND,M A2,7 131K SZ A4 131K JNZ A3,SSYMB . SSYMB IF DEMENSIONED 131K SSYMA L A8,CRSTC5,A3 . VARIABLE(OR ARRAY) STOREGE CLASS 131K JNZ A12,SSYMC . SSYMC IF EQ 131K S,H1 A8,SYM-3,B3 TO SYM S,S1 A4,SYM-3,B3 SET SPECIAL FLAG L A8,LRSTC1+3,A3 S,H2 A8,SYM-3,B3 A A8,A1 170100 S A8,LRSTC1+3,A3 SSYX2 L,M A0,7 TZ,H1 SYM-1,B3 HAS VARIBLE BEEN DEFINED J SSYM1 -YES 170400 AND A9,SYM-2,B3 JNZ A10,SSYM1 170600 L A1,SYM-4,B3 . UNDEFINED VARIABLE S A1,ERRPAR 170800 TNE A1,('I$ ') . DO NOT DIAGNOSE I$ J SSYM1 LMJ B11,ERROR 170900 FORM6 010,3,ERRPAR J SSYM1 171100 SSYMB TZ,H2 CR131K L,M A4,040 . SPECIAL FLAG ONLY IF 131K 131K L,M A3,1 . SET STORAGE CLASS INDEX 131K J SSYMA 131K SSYMC SZ SYM-3,B3 S,S1 A3,SYM-3,B3 J SSYM1 131K SSYM3 J SSYM2 -VARIABLE 171200 J SSYM1 J SSYM4 -EXTERNAL FUNCTION 171400 J SSYM1 -CONSTANT 171500 J SSYM1 -PARAMETER 171600 J SSYMRG DUMMY ARGUMENT J SSYM1 -INTRINSIC FUNCTION 171800 J SSYM10 -OTHER SSYM4 TZ,S4 SYM-2,B3 . EXTERNAL FUNCTION J SSYM1A NAME MAYBE IS REFERENCED SSYM1B L A1,SYM-4,B3 L,H1 A3,CRLNIF JZ A3,SSYM41 LXI A3,(-2) TNE A1,0,*A3 J SSYM1C LXM,XH2 A3,0,A3 TP,XM 0,A3 J SSYM41 J $-5 SSYM1C L,H2 A1,1,A3 S A1,SYM-3,B3 L,M A1,07776 S,H1 A1,SYM-3,B3 L,H1 A1,SYM-2,B3 AN,M A1,1 C=1 173000 OR,M A1,0200 S,H1 A2,SYM-2,B3 J SSYM1 173200 SSYMRG L,S2 A2,SYM-2,B3 TEST FOR SINGLE DEF PT FROM ENTRY SZ,S1 SYM-3,B3 AND,M A2,7 131K TNZ,H2 CR131K JZ A3,SSYM1 . RETURN IF NOT DIMENSIONED 131K L,M A1,040 131K S,S1 A1,SYM-3,B3 SET SPECIAL FLAG TNZ,H2 SYM-1,B3 J SSYMRGA L,M A0,SYM-4,B3 TZ,S1 CRDGSY LMJ B11,LENGTH SSYMRGA . L,M A0,7 J SSYM1 SSYM1A TNZ SYM-1,B3 J SSYM1 IF DEFINITION POINT HAS BEEN PUT OUT J SSYM1B NAME HAS BEEN REFERENCED SSYM41 L,H1 B10,CRLNLB SSMJ41 TNZ B10 J SSMJ42 EXTERNAL NAME NOT FOUND AN,M B10,3 TNE A1,3,B10 J SSMJ43 EXTERNAL NAME FOUND SSMQ41 . L,XH2 B10,0,B10 TN,XM 0,B10 J SSMJ41 SSMJ42 A,M B9,1 BOOST EXTERNAL COUNT S A1,PRESYM SZ PRESYM+1 L,M A0,0,B9 SN,H2 A0,PRESYM+2 EXTERNALS ARE FOUND BY NAME L A0,(-0106,-1) S A0,MLINK L A0,(3,PRESYM) LMJ B11,MTLT SLJ SYMOF L,M A2,0,B9 SSMJ44 TP A2 J SSMQ41 EXTERNAL ALSO COMMON BLOCK NAME A A2,SSYM7 SSC A2,18 S A2,SYM-3,B3 L,M A0,7 J SSYM1 SSMJ43 LN,XH2 A2,1,B10 J SSMJ44 SSYM10 L,M A1,0700 AND,H1 A1,SYM-2,B3 TLE,M A2,0400 IS D GT 4 J SSYM20 . CHECK FOR FORMAT OR HOLL CTABFH TNE,M A2,0400 - YES TEST FOR NAMELIST J SSYM12 D=4 ERROR L,M A1,0770 AND,H1 A1,SYM-2,B3 . GET D AND T TNE,M A2,0570 J SSYM1 NL STATEMENT ONLY TNE,M A2,0670 J SSYM23 . NAMELIST SEEN AND INVOKED CTABFH J SSYM13 ERROR - NL NOT DEFINED SSYM20 L,M A1,0770 . MASK CTABFH AND,H1 A1,SYM-2,B3 . GET D AND T CTABFH TNE,M A2,0200 . FORMAT (207)? CTABFH J SSYM21 . YES CTABFH TNE,M A2,0360 . HOLLERITH (0367)? CTABFH J SSYM22 . YES CTABFH J SSYM1 CTABFH SSYM21 L,H1 A8,SYM-1,B3 . GET LENGTH CTABFH S,T3 A8,SYM-2,B3 LENGTH FOR N6FS TG,M A8,10000 . FORMAT DEFINED? CTABFH J SSYM1 . NO CTABFH L,H2 A8,LRSTC1+7 . NEXT RSA FOR CONSTANTS S,H2 A8,SYM-1,B3 . MAKE STORAGE ASSIGNMENT CTABFH A,H1 A8,SYM-1,B3 . ADD LENGTH CTABFH S,H2 A8,LRSTC1+7 . ADVANCE RSA L,H2 A8,CRSTC9 . LOCATION COUNTER FOR CONSTANTS S,H1 A8,SYM-1,B3 . MAKE STOAGE ASSIGNMENT CTABFH J SSYM1 CTABFH SSYM22 L,H2 A8,LRSTC1+7 . NEXT RSA FOR CONSTANTS S,H2 A8,SYM-3,B3 . MAKE STORAGE ASSIGNMENT CTABFH A,T3 A8,SYM-2,B3 . ADD LENGTH CTABFH S,H2 A8,LRSTC1+7 . ADVANCE RSA L,H2 A8,CRSTC9 . LOCATION COUNTER FOR CONSTANTS S,H1 A8,SYM-3,B3 . MAKE STORAGE ASSIGNMENT CTABFH J SSYM1 CTABFH SSYM23 L,H2 A8,LRSTC1+7 . NEXT RSA FOR CONSTANTS S,H2 A8,SYM-3,B3 . MAKE STORAGE ASSIGNMENT CTABFH A,H1 A8,SYM-1,B3 . ADD LENGTH CTABFH S,H2 A8,LRSTC1+7 . UPDATE L,H2 A8,CRSTC9 . LOCATION COUNTER FOR CONSTANTS S,H1 A8,SYM-3,B3 . MAKE STORAGE ASSIGNMENT CTABFH J SSYM1 CTABFH SSYM11 L,H1 A1,SYM-2,B3 AND,M A1,01000 JZ A2,SSYM19 TYPE OR DIMENSION MESSAGE L,M A1,0407 FUNCTION NOT REFERENCED S,H1 A1,SYM-2,B3 . DO NOT ALLOCATE STORAGE FOR L A1,SYM-4,B3 . THE NAME OF THE FUNCTION S A1,ERRPAR LMJ B11,ERROR WRITE MESSAGE FORM6 011,16,ERRPAR J SSYM1 NOW PROCESS IT SSYM19 L,M A1,0407 S,H1 A1,SYM-2,B3 . MAKE CLASS UNASSIGNED SO EARL . WON'T LIST IN MEMORY MAP. *** SSYM12 L A1,SYM-4,B3 S A1,ERRPAR TZ,H2 CRSD1 . C OPTION J SSYM1 LMJ B11,ERROR FORM6 010,13,ERRPAR J SSYM1 SSYM13 L A1,SYM-4,B3 S A1,ERRPAR LMJ B11,ERROR FORM6 010,15,ERRPAR J SSYM1 SSEXA L,S2 A2,SYMBRK YNCNT A,M A2,1 YNCNT S,S2 A2,SYMBRK YNCNT L,H1 A3,SYMBRK+1,A2 YNCNT S A3,SYMB YNCNT L A3,SYMBRK,A2 YNCNT A,M A3,3 YNCNT SSL A3,2 YNCNT LSSL A3,2 AN,M A3,SYM LXM B3,A3 RESET TO START OF NEXT BLOCK YNCNT J SSYM1 YNCNT ALC5 S A0,PRESYM+1 . LENGTH OF BLOCK S,H2 B2,PRESYM+2 . BLOCK NUMBER S,S4 A1,PRESYM+2 . GROUP NUMBER L A0,(-0106,-1) S A0,MLINK L A0,(3,PRESYM) LMJ B11,MTLT SLJ SYMOF L,M A0,4 . MAKE DUMMY SYM ENTRY LMJ B11,PRQEST SLJ SYMOF DSL A0,54 L A0,PRESYM S A0,0,A1 . NAME OF VARIABLE L A0,B2 BLOCK NUMBER A A0,CRSTC4 S,H1 A0,1,A1 STORAGE CLASS SZ 2,A1 SZ 3,A1 L,M A0,1 S,H2 A0,1,A1 . RELATIVE STORAGE ASSIGNMENT A,M B2,1 . BOOST NUMBER OF COMMON BLOCKS J 0,B10 EXREF S A0,PRESYM EXTERNAL REFERENCE NAME SZ PRESYM+1 LENGTH S,T3 B2,PRESYM+2 LOCATION COUNTER L A0,(-0106,-1) S A0,MLINK L A0,(3,PRESYM) LMJ B11,MTLT SLJ SYMOF A,M B2,1 LOC COUNTER COUNT A,M B9,1 EXTERNAL COUNT J 0,B10 . 175200 . SCAN CTAB TO ASSIGN COMMON VARIABLES, FORMAT STATEMENTS, 175300 . HOLLERITH CONSTANTS AND DUMMY ARGUMENTS 175400 . 175500 SCTB L A6,(0,0777777) 175600 L R6,CRSTC9 L,M A12,07777 L R1,(' ') L,H1 B3,COMVB TNZ B3 J SCTB11 SCTBMA L,XH1 A2,0,B3 TE A2,(0777777777777) J SCTB13 L,H1 B10,CRLNLB SCTB7 TNZ B10 J SCTB72 AN,M B10,3 L,H1 A0,2,B10 TG,H2 A0,2,B10 S,H2 A0,2,B10 . LONGEST LENGTH IN BLOCK SZ,H1 2,B10 . TOTAL FOR INTERNAL ROUTINE L,H2 B10,0,B10 TN,XM 0,B10 J SCTB7 SCTB72 J SCTBM SCTB13 TE A2,(-0105) J SCTB2 L,XH2 A2,0,B3 JN A2,SCTB11 LXM,H2 B3,0,B3 J SCTBMA SCTBM AN,M B3,1 J SCTBMA . COMMON VARIABLE 176300 SCTB2 L,H2 A0,0,B3 L,M A13,7 AND,H1 A13,2,A0 ENTRY ON COMMON LIST IS NO LONGER A VARIABLE TE,M A14,5 . ALLOW A DUMMY ARG IN COMMON JNZ A14,SCTBM AND,H1 A12,0,B3 AU A13,CRSTC4 CB+ST@@@ 176900 L B11,A13 . LABCB1 INDEX 131K SLJ FNLBCK . GET COMMON BLOCK LOC IN ASSIGN. STORAGE S,H1 A14,1,A0 STORAGE CLASS 177200 L,M A14,040 131K L,M A1,04000 . FOR EQUIVALENCE 131K AND,H1 A1,2,A0 . PROCESSING 131K JNZ A2,$+3 . FLAGS MUST BE SET 131K TNZ,H2 CR131K J SCTB3-2 131K TNZ,H1 1,B10 S,H1 A0,1,B10 . POINTER TO FIRST VAR. IN BLOCK S,S1 A14,1,A0 . SET PH6 FLAG 131K SZ,S1 2,A0 . SET COMMON FLAG 131K L,H1 A14,2,B10 S,H2 A14,1,A0 STORAGE ASSIGNMENT 177400 SCTB3 LMJ B11,LENGTH 177500 A,H1 A1,2,B10 S,H1 A1,2,B10 J SCTBM SCTB11 LX B3,(1,0) LX,H1 B6,CRLNAR . HEAD LINK TO DUMMY ARGS TNZ B6 J SCTB6 . NO. DUMMY ARGS SCTB4B L,XH1 A0,0,B6 TNE A0,(0777777777777) J SCTB4C TNE A0,(-0107) J SCTB5 SCTB4A L,S1 A1,0,B6 TNE,M A1,6 J SCTB4C L,H2 A0,0,B6 TNZ A0 J SCTB4C L,S1 A13,1,A0 131K L A14,A13 L,M A1,037 TLE,S2 A1,2,A0 . TREAT AS DEFINED IF IT IS IN EQ. J $+2 TZ,H2 3,A0 . IS ARGUMENT DIMENSIONED OR,M A13,010 L A13,A14 LSSL A13,12 131K A,M A13,STC1 131K LSSL A13,18 131K S A13,1,A0 LM,XH1 A13,3,A0 S,H1 A13,3,A0 SCTB4C . SCTB5A AN,M B6,1 J SCTB4B SCTB5 L,XH2 B6,0,B6 TN,XM 0,B6 J SCTB4B SCTB6 . LXI,M B6,1 SCTB9 L,M A12,07777 RESTORE . PROCESS THE 'EQVT' TABLE TO MAKE EQUIVALENCE ASSIGNMENTS EQS L,M A11,02000 181000 . BUILD UP EQVT REMEQT L,H1 A0,EQVTI . INDEX IN SYM OF EQUIV TABLE (BEGIN) REMEQT L,M A1,EQVT . A1 WILL BE INDEX IN EQVT REMEQT LXI,M A1,2 REMEQT JZ A0,EQVTB3 REMEQT LXI A0,(-1) EQVTB1 L,XH1 A2,0,A0 REMEQT TNE A2,(-0103) . EQVT LINK FLAG MTFSYM J EQVTB2 . GO FIND THE NEXT GROUP (IF ANY) REMEQT AN,M A0,1 REMEQT DL A2,0,*A0 . MOVE OUT OF EQUIV TABLE IN SYM REMEQT DSC A2,36 DS A2,0,*A1 . INTO EQVT REMEQT L,M A2,0,A1 TG,M A2,EQVTH LMJ B11,EQVSX . GENERATE ERROR MESSAGE J EQVTB1 REMEQT EQVTB2 L,XH2 A2,0,A0 REMEQT JN A2,EQVTB3 REMEQT LXM,H2 A0,0,A0 REMEQT J EQVTB1 REMEQT EQVTB3 L A2,(0777777400000) REMEQT S A2,0,A1 REMEQT TZ,S5 CRD SLJ N2EQV L B2,(2,0) LX B3,(04,0777773) L,M A9,7 181300 L R1,(' ') . CONSTRUCT EQVTH TABLE 181400 EQS1 TNE A15,EQVT,B2 END OF FILE 181500 J EQS5 -YES 181600 S,H2 B2,EQVTH+4,*B3 M(J)=I 181700 L,M A0,EQVTH,B3 . GET ABSOLUTE END TO EQVTH TG,M A0,LREF LMJ B11,EQVSX . GENERATE ERROR MESSAGE SZ A7 (N,R)=0 181800 S,H1 B3,EQVTH,B3 L(J)=J 181900 SZ EQVTH+2,B3 182000 SZ EQVTH+3,B3 182100 EQS2 TP EQVTH+2,B3 . ANY COMMON IN CLASS 131K J EQS3 -YES 182300 LXM,H2 B4,EQVT,B2 SYM(V) 182400 L,S1 A12,1,B4 131K JZ A12,EQS3 . IS THIS COMMON OR DIMENSIONED 131K AND,H1 A9,2,B4 -YES 182800 JNZ A10,EQS3 IS THIS VARIABLE DUMMY 182900 L,H1 A0,EQVT,B2 . OFFSET 131K TN 1,B4 131K SZ A0 . CLEAR FOR NON COMMON 131K AH A0,1,B4 -NO 183000 S A0,EQVTH+2,B3 ARRAY ASSIGNMENT+OFFSET 183100 EQS3 L,XH1 A6,EQVT,B2 183200 TG,XH2 A6,EQVTH+3,B3 OFFSET LESS THAN MAX OFFSET 183300 S,H2 A6,EQVTH+3,B3 -NO, REPLACE MAX OFFSET 183400 L,H2 A0,EQVT,B2 183500 S A0,EQTFLG . SHOW LENGTH THAT EQUIVALENCE MADE CALL LMJ B11,LENGTH 183600 L,H1 A2,EQTFLG . NUMBER OF CHARACTER PER WORD TNZ,S4 EQVTH,B3 . TEST IF CHARACTER LENGTH ALREADY SET S,S4 A2,EQVTH,B3 . SAVE FOR FUTURE USE TE,S4 A2,EQVTH,B3 . TEST INCOMPAIBLE USE NOP . TEST MIXED EQUIVALENCE SZ EQTFLG AN,XH1 A1,EQVT,B2 LENGTH-S(I) 183700 TG,XH1 A1,EQVTH+3,B3 IS CLASS BEING LENGTHENED 183800 S,H1 A1,EQVTH+3,B3 -YES,REPLACE MT(J) 183900 S,H2 B3,EQVT+1,B2 W(I)=J 184000 TP EQVT+1,*B2 184100 J EQS4 184200 TNE A15,EQVT,B2 J EQS31 A A7,(1,0) N=N+1 184300 J EQS2 EQS31 L,S1 A0,EQVT-1,B2 OR,M A0,040 S,S1 A1,EQVT-1,B2 EQS4 S A7,EQVTH+1,B3 N AND R 184500 J EQS1 184600 EQS5 L,M A0,0,B2 NUMBER OF WORDS IN EQVT 184700 JGD A0,$+2 184800 J PLOOP 184810 S A15,EQVTH+4,B3 SSA A0,1 NUMBER OF ENTRIES 184900 LXM,M B2,0 184910 L R5,A0 185000 LN,M A0,2 EQS6 L,H2 A4,EQVT,*B2 SYM(V) 185200 JZ A4,EQS14 IF SYM(V)=0, ALREADY PROCESSED 185300 LXM,M B4,0,B2 185400 L R1,R5 185500 EQS7 SE,H2 A4,EQVT,*B4 185600 J EQS14 185700 SZ,H2 EQVT-2,B4 CLEAR SYM(V) 185800 L,H2 A0,EQVT-1,B2 W(K) 185900 L,H2 A1,EQVT-1,B4 W(M) 186000 L,H1 A5,EQVTH,A0 L(W(K)) 186100 AN,H1 A5,EQVTH,A1 L(W(K))-L(W(M)) 186200 JZ A5,EQS12 ARE CLASS NUMBERS EQUAL 186300 L,M A2,0,B2 - NO, K *** AN,M A2,2 L,M A3,0,B4 M *** AN,M A3,2 JN A5,EQS8 186600 DSC A0,36 EXCHANGE INDEXES 186700 DSC A2,36 186800 . A0 IS W(P), A1 IS W(N), A2 IS P, AND A3 IS N 186900 EQS8 L,XH2 A5,EQVTH+1,A0 R(W(P)) 187000 A,XH1 A5,EQVT,A3 187100 AN,XH1 A5,EQVT,A2 R(W(P))+S(N)-S(P) 187200 AN,XH2 A5,EQVTH+1,A1 BIAS B 187300 L,H1 A2,EQVTH,A0 L(W(P)) 187400 L,H1 A3,EQVTH,A1 L(W(N)) 187500 L R4,R1 SAVE PREVIOUS REPEAT COUNT 187600 L,M A6,4,B3 NO. OF EQVTH WORDS 187700 SSA A6,2 REPEAT COUNT 187900 L R1,A6 188000 LXM,M B5,0 INITIAL SCAN INDEX EQS9 SE,H1 A3,EQVTH,*B5 SEARCH FOR L(N) 188200 J EQS11 188300 S,H1 A2,EQVTH-4,B5 L(Q)=P 188400 AU,XH2 A5,EQVTH-3,B5 R(Q)+B 188500 S,H2 A6,EQVTH-3,B5 188600 TP EQVTH+2,A2 . IS EQVTH(P) COMMON 131K J EQS10 -YES 188800 L A6,EQVTH-2,B5 -NO 188900 JP A6,EQS10 . IS EQVTH(Q) COMMON 131K ANH A6,A5 -YES, MAKE EQVTH(P) COMMON S A6,EQVTH+2,A2 189200 EQS10 AU,XH1 A5,EQVTH-1,B5 MT(Q)+B 189300 TG,XH1 A6,EQVTH+3,A2 IS MT(P) LE MT(Q)+B 189400 S,H1 A6,EQVTH+3,A2 -YES,REPLACE MT(P) 189500 L,XH2 A6,EQVTH-1,B5 189600 AN A6,A5 MS(Q)-B 189700 TG,XH2 A6,EQVTH+3,A2 IS MS(P) LE MT(Q)-B 189800 S,H2 A6,EQVTH+3,A2 -YES, REPLACE MS(P) 189900 J EQS9 190000 EQS11 L R1,R4 RESTORE REPEAT COUNT 190100 J EQS7 190200 EQS12 L,XH1 A6,EQVT-2,B2 CLASS NUMBERS ARE EQUAL 190300 A,XH2 A6,EQVTH+1,A1 190400 AN,XH2 A6,EQVTH+1,A0 190500 TNE,XH1 A6,EQVT-2,B4 IS S(R) = S(K)-R(W(K))+R(W(N)) 190600 J EQS7 -YES,REDUNDANT ASSIGNMENT 190700 S A4,ERRPAR -NO, CONFLICTING ASSIGNMENT 190800 LMJ B11,ERROR 190900 FORM6 031,5,ERRPAR J EQS7 191100 EQS14 JGD R5,EQS6 191200 EQS15 LXM,M B5,0 191300 L,M A11,02000 191400 L R2,(0777777,0) 191500 L R5,(0,0777777) 191600 LN,M A0,2 TZ,S5 CRD ONLY FOR PHASE 2 DUMPS LMJ B11,DALEC EQS16 LXM,T3 B2,EQVTH,B5 . M = M(K) LXM,H1 B6,EQVTH,B5 191800 L,H1 R4,EQVTH+1,B5 N=N(K) 191900 TN EQVTH+2,B6 . IS CLASS COMMON 131K J EQS21 -NO 192100 TP EQVTH+3,B6 IS COMMON BLOCK INCREMENTED 192200 J EQS17 -YES 192300 L,H1 A0,EQVTH+2,B5 STC 192400 AN A0,CRSTC4 STC-STC4 192500 LSSL A0,24 SSL A0,24 L A13,A0 L,H2 A1,CRC A,M A1,1 TG A0,A1 J EQS161 SLJ FNLBCK . FIND LABELLED BLOCK POINTER TO B10 L,XH1 A1,EQVTH+3,B5 MT(K) 192700 A,XH2 A1,EQVTH+2,B5 RSA(K) 192800 TG,XH2 A1,2,B10 S,H2 A1,2,B10 EQS161 S,H1 R5,EQVTH+3,B6 G(L(K)) 193100 EQS17 L,H2 A0,EQVT,*B2 SYM(V) 193200 JZ A0,EQS19+1 IGNORE IF ZERO 193300 AND,H1 A9,2,A0 193400 JNZ A10,EQS19+1 ASSIGN ONLY NON-DUMMY VARIABLES 193500 L,XH2 A6,EQVTH+2,B6 RSA(L(K)) 193600 A,XH2 A6,EQVTH+1,B5 RSA(L(K))+R(K) 193700 AN,XH1 A6,EQVT-2,B2 RSA(L(K))+R(5)-S(M) 193800 JN A6,EQS18 IS ADDRESS NEGATIVE 193900 EQS171 MLU A6,EQVTH+2,B6 -NO, ADD STC 194000 AND,H1 A11,2,A0 194100 JZ A12,EQS18K . IS VAR ALREADY IN COMMONI ???? TE A7,1,A0 -YES 194300 J EQS20 194400 J EQS19-1 131K EQS18 S A0,ERRPAR EXTENDING COMMON FORWARD 194900 LMJ B11,ERROR 195000 FORM6 031,6,ERRPAR J EQS171 195200 EQS18K OR,H1 A11,2,A0 . SET COMMON BIT S,H1 A12,2,A0 131K SZ,S1 2,A0 . SET COMMON FLAG 131K AND,M A11,070 .TEST FOR CHARACTER TE,M A12,060 J EQS18L L,H2 A1,3,A0 . GET POINTER TO EXTENSION L,S2 A4,2,A0 . NUMBER OF DIMENSIONS AND,M A4,7 A A1,A5 . ADDRESS OF CHARACTER PACKET L,S3 A4,EQVT-1,B2 . VALUE OF EQUIVALENCE OFFSET A,H2 A4,0,A1 . ASSIGNED CHARACTER OFFSET IF ANY DSL A4,36 DI,S4 A4,EQVTH,B6 S,H2 A5,0,A1 . SET NEW CHARACTER OFFSET A A7,A4 . CORRECTED RSA EQS18L S A7,1,A0 . MAKE STORAGE ASSIGNMENT TNZ,H2 CR131K EQS19 SZ,S1 1,A0 . CLEAR NEG BIT 131K JGD R4,EQS17 195400 TLEM,M B5,0,B3 195500 J EQS16 195600 J PLOOP 195700 EQS20 S A0,ERRPAR CONFLICTING COMMON ASSIGNMENT 195800 LMJ B11,ERROR 195900 FORM6 031,5,ERRPAR J EQS19+1 196100 EQS21 TP EQVTH+3,B6 IS CLASS LENGTH ADDED TO STC3 196200 J EQS22 -YES 196300 L,S1 A2,EQVTH+2,B5 . 131K L A8,LRSTC1+3,A2 GET PROPER ASSIGNMENT L R6,CRSTC1+3,A2 S,T3 R6,EQVTH,B5 . SAVE STC FOR LATER L,H2 A0,EQVT,B2 L,S3 A4,2,A0 SSL A4,3 TNE,M A4,6 . TEST FOR CHARACTER J EQS21J A,XH2 A8,EQVTH+3,B5 196400 S,H2 A8,EQVTH+3,B5 196500 A,XH1 A8,EQVTH+3,B5 196600 S A8,LRSTC1+3,A2 UPDATE RSA EQS21K LSSL A2,5 . SHIFT BIT OR LACK OF SAME S,S2 A2,EQVTH+3,B5 . AND SAVE IT S,S1 R5,EQVTH+3,B5 EQS22 L,H2 A0,EQVT,*B2 SYM(V) 196900 JZ A0,EQS23 IGNORE IF ZERO AND,H1 A9,2,A0 197000 JNZ A10,EQS23 ASSIGN ONLY NON-DUMMY VARIABLES 197100 L,S3 A4,2,A0 AND,M A4,070 TNE,M A5,060 . TEST FOR CHARACTER J EQS22Q L,XH2 A1,EQVTH+3,B6 MS(L(K)) 197300 A,XH2 A1,EQVTH+1,B5 MS(L(K))+R(K) 197400 AN,XH1 A1,EQVT-2,B2 MS(L(K))+R(K)-S(M) 197500 S,H2 A1,1,A0 RSA 197600 J EQS22J . NONE EQS22Q L,H2 A1,3,A0 . POINTER TO EXTENSION STORAGE L,S2 A4,2,A0 . NUMBER OF DIMENSIONS AND,M A4,7 A A1,A5 . ADDRESS OF CHARACTER PACKET L,S3 A4,EQVTH,B6 . EQUIVALENCE OFFSET XOR,M A4,077 . CONVERT TO POSITIVE L A4,A5 . MOVE TO LOWER REGISTER A,XH2 A4,EQVTH+1,B5 . MS(L(K))+R(K) L,XH2 A5,EQVTH+3,B6 . MS(L(K)) MSI,S4 A5,EQVTH,B6 A A4,A5 AN,XH1 A4,EQVT-2,B2 . MS(L(K))+R(K)-S(M) DSL A4,36 DI,S4 A4,EQVTH,B6 S,H2 A5,0,A1 . NEW CHARACTER OFFSET S,H2 A4,1,A0 EQS22J L,T3 R6,EQVTH,B6 S,H1 R6,1,A0 STC 197700 L,S2 A2,EQVTH+3,B6 TZ,H2 CR131K S,S1 A2,1,A0 . SET PH6 FLAG (IF EXISTANT) 131K EQS23 JGD R4,EQS22 197800 TLEM,M B5,0,B3 197900 J EQS16 198000 J PLOOP 198100 EQS21J L,XH2 A5,EQVTH+3,B5 . CHARACTER START DSL A5,36 . PREPARE FOR DIVIDE DI,S4 A5,EQVTH,B6 SN,S3 A6,EQVTH,B6 . SET TRUE CHARACTER START WITHIN WORD A A8,A5 . GET ALLOCATED START WITHIN WORD S,H2 A8,EQVTH+3,B5 . ALLOCATED LENGTH L,XH1 A5,EQVTH+3,B5 . LENGTH OF CHARACTER CLASS DSL A5,36 . PREPARE FOR DIVIDE DI,S4 A5,EQVTH,B6 GET LENGTH IN WORDS TZ A6 . TEST FOR REMAINDER (PART OF WORD) A,M A5,1 . TOTAL SPACE FOR STRING A A8,A5 . ADVANC?VCE RELATIVE STORAGE ADDRESS L,S3 A5,EQVTH,B6 . SEE IF OFFSET SPILLED INTO NEXT WORD TE,M A5,077 A,M A8,1 S A8,LRSTC1+3,A2 . UPDATE RSA J EQS21K EQVSX LMJ B11,ERROR FORM6 +02,18,0 . SPACE OVERFLOW J EXIT . PROCESS THE 'AREFA','LREF',AND 'LOOPT' TABLES PLOOP . AREFLK . BUILD UP AREF TABLE (AREFA) AREFLK L,H1 A0,AREFI . AREFA INDEX IN SYM AREFLK L,M A1,AREFA . A1 = INDEX IN AREFA AREFLK JZ A0,AREFB3 . NONE AREFLK LXI,M A1,1 AREFLK LXI A0,(-1) AREFLK AREFB1 L,XH1 A2,0,A0 AREFLK TNE A2,(-0102) . AREF LINK FLAG MTFSYM J AREFB2 AREFLK L A2,0,*A0 AREFLK S A2,0,*A1 AREFLK J AREFB1 AREFLK AREFB2 L,XH2 A2,0,A0 AREFLK JN A2,AREFB3 AREFLK LXM,H2 A0,0,A0 AREFLK J AREFB1 AREFLK AREFB3 L A2,(0777777400000) . EOF AREFLK S A2,0,A1 AREFLK TZ,S5 CRD SLJ N2AREF LXM,M B7,0 AREFLK . PROCESS NAMELIST TABLE LNKNME L,H1 A0,CRSFL . A0 = BEGINING OF NAMELIST TABLE IN SYM LNKNME JZ A0,NLST3 . NO NAMELIST LNKNME L A11,(010000,0) . G1 MASK LNKNME NLST1 L,XH1 A1,0,A0 LNKNME TNE A1,(-0101) . NAMELIST LINK FLAG MTFSYM J NLST2 . THIS MUST BE A LINK-FLAG LNKNME OR A11,1,A1 LNKNME S A12,1,A1 LNKNME AN,M A0,1 LNKNME J NLST1 LNKNME NLST2 L,XH2 A1,0,A0 . PICK UP POINTER TO NEXT GROUP LNKNME JN A1,NLST3 . NEG IMPLIES END OF TABLE LNKNME LXM,H2 A0,0,A0 . A0 = ADDRESS OF NEXT GROUP LNKNME J NLST1 LNKNME NLST3 . LNKNME LXM,M B7,0 LNKNME L B1,(1,-1) 198400 LXM B8,(-2) 198500 L,M R6,0 SEQUENCE COUNT 198600 SZ PLIN . INTERNAL SUBROUTINE NO. SHORT3 J $+4 SHORT3 PLP1 L A0,PLIN . BUMP INTERNAL SUBR NO. SHORT3 A,M A0,1 SHORT3 S A0,PLIN SHORT3 LXM,M B8,2,B8 SHORT3 LXM,M B2,0 198810 L,M A6,1 198900 LXM,M B6,AREFA+1,B1 BEGINNING SORT ADDRESS 199000 S,H2 B6,PLP2 199100 L,M R1,30000 199200 L A0,(0777777) 199300 SE,H1 A0,0,*B6 FIND EOR 199400 SLJ BUG NONE--ERROR 199500 L,M A0,29999 199600 AN A0,R1 199700 S A0,SRCHCT NUMBER OF ITEMS TO SORT J PLP1J $(2) . PLP1J LMJ B11,SRT1 PLP2 + $-$ +SRCHCT J PLP3J $(1) . PLP3J SZ A12 PLP3 TP AREFA+1,*B1 AREFA(J)=EOR 200400 J PLP7 -YES 200500 TNE,H1 A12,AREFA,B1 SYM(M)(J)=S 200600 J PLP3 -YES 200700 L,H1 A12,AREFA,B1 200800 DSL A10,72 T=T1=0 200900 PLOP3 TG,S4 A6,AREFA,B1 IS AREFA(J) A REFERENCE 201000 J PLOP4 -YES 201100 J PLP3 201900 PLOP4 S A6,A10 T1=1 202000 L,M B3,0,B1 Q=J, 202100 A,M B1,1 202200 PLP4 TE,H1 A12,AREFA,B1 SYM(M)(J)=S 202300 J PLP5 -NO 202400 TG,S4 A6,AREFA,*B1 IS AREFA(J) AN ASSIGN 202500 J PLP4 -NO 202600 S A6,A11 T=1 202700 TZ,S4 AREFA,B3 IS AREFA(Q) A COND REF J PLP4 NO REF WITH LIST IGNORE L,T3 A0,AREFA,B3 PR 203000 A A0,(0400000) F (REFERENCE) 203100 S,H2 A0,LREF1,B2 203200 LXM,H2 B5,AREFA-1,B1 SYM(N) 203300 S,H2 B5,LREF1+1,B2 203400 XH1 EQU 4 TP,XH2 AREFA-1,B1 ANX,M B5,0,*0 SZ,H1 LREF1+1,B2 203410 L A0,0,B5 N 203500 S,H1 A0,LREF1,*B2 203600 J PLP4 203700 PLP5 LXM,M B1,1,B3 J=Q+1 203800 JNZ A11,PLOP3J S R6,R8 204100 S A12,ERRPAR 204100 LMJ B11,ERROR 204200 FORM6 031,7,ERRPAR LXM,M B1,0,B3 204310 SZ A12 S=0 204400 J PLP3 204500 PLOP3J L,H2 A0,AREFA,B1 TE,H2 A0,AREFA,B3 J PLOP3 A,M B1,1 J PLOP3J PLP7 TNZ,T1 LREF,B8 . LREF(K) = EOR J PLP8 -YES 204700 PLP7A . L A0,LREF,B8 SHORT+ AND A0,(0777777407777) . REMOVE DO LEVEL SHORT+ S A1,LREF1,B2 . ITEM. SHORT+ L A0,LREF+1,*B8 SHORT+ S A0,LREF1+1,*B2 SHORT+ TP,XH2 LREF-2,B8 . IF SHORT+ J PLP7 . DEFN ITEM, SHORT+ SZ,H2 LREF1-1,B2 . REMOVE GARBAGE, SHORT+ A A1,(0400000) SHORT+ S A1,LREF1,B2 . SIMULATE REF SHORT+ AND,M A0,07700 . ITEM. SHORT+ TNZ A1 . (IF THERE WERE ANY SHORT+ J PLP7 . REF ITEMS DELETED.) SHORT+ S A0,LREF1+1,B2 SHORT+ L,S4 A4,LREF1+1,B2 SHORT+ LSSC A4,18 SHORT+ A,H1 A4,LREF1,B2 SHORT+ LMJ B11,SLT . FIND SYM (LABEL). SHORT+ +CRLBHL SHORT+ SLJ BUG . SOMEONE LIED. SHORT+ S,H2 A1,LREF1+1,*B2 . FINISH ITM OFF. SHORT+ J PLP7 SHORT+ PLP8 L A2,(1,0) SRV INDEX SHORT3 TZ,XH1 LREF,B8 J PLP7A L A6,PLIN INTERNAL SUBR NO. SHORT3 L,M A5,CRLC MARK FOR END CHAIN SHORT3 TNE,H2 A5,CRLBHL+1 IF LABEL TABLE EMPTY, SHORT3 J PLP8X BYPASS ALL OF THIS NONSENSE. SHORT3 L,H2 B11,CRLBHL+1 WE ARE LOOKING AT TOP OF TREE. SHORT3 PLPTST TE,H1 A6,0,B11 CORRECT ROUTINE? SHORT3 J PLPNXT NO, FIND NEXT. SHORT3 L A0,2,B11 DELETED LREF SHORT3 TOP,M A0,2 FOR THIS LABEL? SHORT3 J PLPNXT NO SHORT3 L,S2 A0,2,B11 TNE,M A0,2 IGNORE FOR FORMAT J PLPNXT L,H2 A0,0,B11 YES. LABEL SHORT3 LSSC A0,18 ALIGNED SHORT3 A,T3 A0,3,B11 PLATEAU OF DEFN SHORT3 L,H1 A1,LOOPT,A0 SEQ OF PLATEAU SHORT3 LSSC A1,18 ALIGNED SHORT3 DS A0,LREF1,*B2 DEFN ENTRY SHORT3 A A0,(0400000) SHORT3 A,M A1,0,B11 SHORT3 DS A0,LREF1,*B2 REF ENTRY SHORT3 PLPNXT L,H1 A0,1,B11 LEFT SEARCHLINK SHORT3 TE A0,A5 STACK IFF EXISTS. SHORT3 S A0,SRV,*A2 SHORT3 TNE,H2 A5,1,B11 RIGHT LINK GOOD? SHORT3 J PLPLFT NO, POP UP. SHORT3 L,H2 B11,1,B11 YES, USE IT. SHORT3 J PLPTST SHORT3 PLPLFT TNE A2,(1,0) DONE? SHORT3 J PLP8X YES SHORT3 AN,M A2,1 NO, PICK UP LEFT LINK SHORT3 L B11,SRV,A2 AND USE IT. SHORT3 J PLPTST SHORT3 PLP8X L,M A0,0,B2 SHORT3 S A0,QZID SHORT3 SSA A0,1 NUMBER OF LREF1 ENTRIES 205400 S A0,SRCHCT S A15,LREF1,B2 EOF TO LREF1 205510 TZ,S5 CRD SLJ N2QZID LMJ B11,SRT2 SORT LREF1 ON FIRST WORD 205600 NOP 0,LREF1 205700 +SRCHCT TZ,S5 CRD SLJ N2QZ2 LXM,M B4,2 M=0 205900 L,M A6,0,B2 206000 JZ A6,PLP28 206100 PLP9 SZ DUPFLG .INITIALIZE FLAG TZ,S4 LREF1-2,B4 IS LREF1(M) A LABEL J PLP34 -NO, ERROR 206300 PLP91 SZ A11 206400 L,H1 A12,LREF1-2,B4 S= N(M) 206500 LXM,M B3,0,B4 Q=M *** ANX,M B3,2 . CORRECT COUNT PLP10 TNE,M A6,0,B4 IS M=I 206700 J PLP28 -YES 206800 TE,H1 A12,LREF1,B4 -NO,IS L(M)=S 206900 JMGI B4,PLP9 --NO, M=M+2 207000 TNZ,S4 LREF1,B4 IS LREF1(M) A LABEL 207100 J PLP35 -YES--DUPLICATE LABEL 207200 PLP101 TZ DUPFLG .REFERENCES A DUPLICATED LABEL J PLP36 YES - FATAL ERROR PLP102 JNZ A11,PLP11 L,M A11,1 T = 1 207400 L,H1 A0,LREF1,B4 207500 PLP11 L,T3 A7,LREF1,B3 PL1=PN(Q) 207900 L A1,A7 P=PN(Q) 208000 L,T3 A8,LREF1,*B4 PR1=PR(M),M=M+2 208100 L A0,A8 R=PR(M) 208200 TNE A8,A7 IS PL1=PR1 208300 J PLP10 -YES 208400 L,T3 B10,LOOPT,A1 PB(P) 208500 L A9,A7 PL2=PL1 208600 TP,T2 LOOPT+1,A1 IS F6(P)=1 208700 L,T1 A9,LOOPT+1,B10 -YES, PL2=POD(PB(P)) 208800 L A1,A9 P=PL2 208900 L,T3 B10,LOOPT,A0 PB(R) 209000 L A10,A8 PR2=PR1 209100 TP,T2 LOOPT+1,A0 IS F6(R)=1 209200 L,T1 A10,LOOPT+1,B10 -YES,PR2=POD(PB(R)) 209300 L A0,A10 R=PR2 209400 JNZ A9,PLP13 IS PL2=0 209500 PLP12 JZ A0,PLP10 -YES, IS R=0 209600 L,T3 B10,LOOPT,A0 --NO, PE(R) 209700 L,M A4,040 209800 OR,S4 A4,LOOPT,B10 209900 S,S4 A5,LOOPT,B10 D6(PE(R))=1 210000 L,T1 A0,LOOPT+1,A0 R=POD(R) 210100 JB A0,PLBDLP J PLP12 210200 PLP13 L,M A4,020 D5 210300 JZ A0,PLP15 IS R=0 210400 TG,T3 A9,LOOPT,A0 -NO, IS PE(R) GREATER THAN PL2 210500 J PLP14 --NO, 210600 TG A9,A0 --YES, IS R GREATER THAN PL2 210700 J PLP15 ---NO 210800 PLP14 L,T3 B10,LOOPT,A0 PE(R) 210900 L,T1 A0,LOOPT+1,A0 R=POD(R) 211000 JB A0,PLBDLP OR,S4 A4,LOOPT,B10 211100 S,S4 A5,LOOPT,B10 D5(PE(R))=1 211200 J PLP13+1 211300 PLP15 JNZ A10,PLP18 IS PR2=0 211400 L,H2 B10,LREF1-1,B4 YES SYM TABL REF OF LABEL TP,XH2 LREF1-1,B4 ANX,M B10,0,*0 STRIP NEGATIVE BIT L,M A4,04000 211600 OR,T3 A4,2,B10 211700 S,T3 A5,2,B10 Q12(SYM(N)(M)) 1 211800 L,T3 A4,LOOPT,A1 PE(P) 211900 TE,M A4,2,A1 IS PE(P)=P+2 212000 J PLP17 -NO, ERROR 212100 PLP151 L,M A4,040 212200 PLP16 JZ A1,PLP10 IS P=0 212300 OR,S4 A4,LOOPT,A1 -NO 212400 S,S4 A5,LOOPT,A1 C6(P)=1 212500 L,T1 A1,LOOPT+1,A1 P=POD(P) 212600 JB A1,PLBDLP J PLP16 212700 PLP17 L B10,A7 PLATEAU OF REFERENCE L,H1 A3,LREF1-2,B4 L,H1 A4,LOOPT,B10 SEQ. NO. 213000 S A4,R8 213200 S A3,ERRPAR 213200 LMJ B11,ERROR TRANSFER FROM LEVEL 0 TO 213300 FORM6 020,11,ERRPAR J PLP151 213500 PLP18 JZ A1,PLP21 IS P=0 213600 TG,T3 A10,LOOPT,A1 -NO,IS PE(P) GREATER THAN PR2 213700 J PLP19 --NO 213800 TG A10,A1 --YES, IS P GREATER THAN PR2 213900 J PLP21 ---NO 214000 PLP19 L,S4 A4,LOOPT,A1 214100 OR,M A4,020 214200 S,S4 A5,LOOPT,A1 C5(P)=1 214300 L,T1 A1,LOOPT+1,A1 P=POD(P) 214400 L,H2 B10,LREF1-1,B4 SYM(N)(M) TP,XH2 LREF1-1,B4 ANX,M B10,0,*0 STRIP NEGATIVE BIT L,M A4,04000 214600 OR,T3 A4,2,B10 214700 S,T3 A5,2,B10 Q12(SYM(N)(M)=1 214800 L,H1 A0,LREF1+1,B3 SEQUENCE COUNT 214900 S A0,R8 215100 L,H2 A0,0,B10 N CLEAN S A0,ERRPAR 215200 LMJ B11,ERROR MARK ERROR--TRANSFER 215300 FORM6 020,10,ERRPAR J PLP18 215500 PLP21 L A1,A9 P=PL2 215600 JZ A10,PLP10 IS PR2=0 215700 PLP22 JZ A1,PLP10 -NO,IS P=0 215800 TG,T3 A10,LOOPT,A1 --NO, IS PE(P) GT PR2 215900 J PLP23 ---NO 216000 TG A10,A1 ---YES, IS P GT PR2 216100 J PLP24 ----NO 216200 PLP23 L,T1 A1,LOOPT+1,A1 P=POD(P) 216300 J PLP22 216400 PLP24 L A0,A1 R=P 216500 PLP25 A,M A0,2 R=R+2 216600 TG,T3 A0,LOOPT,A1 IS R GE PE(P) 216700 J PLP10 -YES 216800 TP,T2 LOOPT+1,A0 -NO,IS F6(R)=1 216900 J PLP25 --YES 217000 TE,T1 A1,LOOPT+1,A0 --NO,IS POD(R)=P 217100 J PLP25 ---NO 217200 TG A7,A0 IS R GT PL1 217300 J PLP27 -NO 217400 TLE A8,A0 IS R LE PR1 217500 J PLP27 -NO 217600 TG,T3 A8,LOOPT,A1 IS PR1 LT PE(P) 217700 J PLP27 -NO 217800 PLP26 L,S4 A4,LOOPT,A0 217900 OR,M A4,02 218000 S,S4 A5,LOOPT,A0 C2(R)=1 218100 J PLP25 218200 PLP27 TLE A8,A1 IS P LE PR1 218300 J PLP25 -NO 218400 TG,T3 A8,LOOPT,A0 IS PR1 LT PE(R) 218500 J PLP25 -NO 218600 TLE,T3 A7,LOOPT,A0 IS PE(R) LE PL1 218700 J PLP25 -NO 218800 TG,T3 A7,LOOPT,A1 IS PL1 LT PE(P) 218900 J PLP25 -NO 219000 J PLP26 -YES, MARK NON-OPTINAL LOOP 219100 PLP28 TE A15,LREF,B8 IS LREF(K) EOF 219200 J PLP1 -NO, PROCESS NEXT RECORD 219300 LXM,M B8,0 -YES, BEGIN LOOPT SCAN 219400 NOP . 219450 PLP29 TNE A15,LOOPT+2,*B8 IS LOOPT = EOF 219500 J PLP33 -YES, 219600 TP,T2 LOOPT+1,B8 219700 J PLP29 -NO, AT END DO, IGNORE 219800 L,H2 B10,LOOPT+1,B8 SYM(I) TP,XH2 LOOPT+1,B8 ANX,M B10,0,*0 STRIP NEGATIVE BIT L,H1 A4,2,B10 MODE OF INDUCTION VARIABLE AND,M A4,01007 IS IT A FUNCTION NAME TE,M A5,01000 J PLP29A NO, IT ISN'T L,S4 A4,LOOPT,B8 IT IS SO FORCE MATERIALIZATION OR,M A4,04 S,S4 A5,LOOPT,B8 PLP29A RES 0 L,T3 B10,LOOPT,B8 219900 L,M A4,060 220000 AND,S4 A4,LOOPT,B10 D5(PE(K)) OR D6(PE(K)) 220100 L,S4 A4,LOOPT,B8 220200 JZ A5,PLP30 220300 OR,M A4,04 220400 S,S4 A5,LOOPT,B8 C3(K)=1 220500 S A5,A4 220510 PLP30 AND,M A4,060 C5(K) OR C6(K) 220600 JZ A5,PLP301 OR,M A4,1 220800 S,S4 A5,LOOPT,B8 C1(K)=1 220900 PLP301 L A0,B8 L,S4 A4,LOOPT,B8 . GET C3,C1 JZ A4,PLP31 PLP302 L,T1 A0,LOOPT+1,A0 . OUTTER LINK JB A0,PLBDLP JZ A0,PLP31 NONE OR,S4 A4,LOOPT,A0 . INCLUDE S,S4 A5,LOOPT,A0 J PLP302 PLP31 L,M A4,2,B8 221000 TE,T3 A4,LOOPT,B8 IS PE(K)=K+2 221100 J PLP29 -NO 221200 TN,XH2 LOOPT,B8 IS C6(K)=1 221300 J PLP29 -NO 221400 TP,XH2 LOOPT,B10 IS D6(PE(K))=0 J PLP29 -NO PLP32 L,H1 A4,LOOPT,B8 LEGAL ENTRY TO LOOP BUT NO EXIT 224000 S A4,R8 SEQUENCE COUNT 224200 LMJ B11,ERROR 224200 FORM6 0,12,0 J PLP29 224400 PLBDLP . AT THIS POINT A PLATEUA WAS DTECTED WHICH IS ODD . SINCE THE TABLE ARE ALREADY MIXED UP A JUMP IS MADE TO END OF . PHASE 2 IF NO PRIOR FATAL ERROR OTHERWISE AN INTERNAL PHASE 2 . ERROR IS GENERATED TNZ CRFL IF ALREADY FATAL ERROR SLJ BUG J EXIT JUST EXIT PLP33 L,H1 A5,SYMBRK+1 SZ,S2 SYMBRK S A5,SYMB L B3,(4,0) LXM B3,CRISYM L,M A0,7 L,M A2,077777 SDP1 L,M A6,4,B3 TNE,H2 A6,CRSYM J SDP10 TNE A6,SYMB J SDP3 AND,H1 A0,6,*B3 EX SDP2,A1 J SDP1 SDP10 S,H2 A2,CRCDP S,H2 A2,CREDP EXIT L A1,DIMPTA AN,M A1,1 SZ N0RGSA S,S3 A1,DIMBUF L,M A1,$+4 S,H2 A1,DIMPTR TZ,S1 CRDGSY . TEST IF DIMENSION POINTERS J DIMA . ARE TO BE CLOSED L A0,(040100,0) . END OF FILE ITEM FOR F60 S A0,DIMBUF L,M A0,$+3 S,H2 A0,DIMPTR J DIMA WF60B . WRITE LAST BLOCK, CLOSE FILE TNZ,S2 CRFLGS . CTS CALL ? J NOCTS TZ CRLIST NON ZERO FOR S OR L OPTIONS J SQFILE TNZ CRSTED NON ZERO FOR START EDIT J NOCTS SQFILE DL A0,('SQUELCH$ ') CTS WANTS DS A0,RPFOR$+1 OUTPUT IN S,S2 A0,RPFLG$ CAUSE PAGE EJECT AT END J FILEID SQUELCH$ FILE NOCTS TNZ CREMOT . NON ZERO IS DEMAND TERMINAL J NOLIST TZ RPFOR$ J NOLIST TNZ,S1 CRDGSY . TEST FOR OUTPUTTING SYMBOL TABLE TZ CRLIST J AFLRT TNZ CRSTED J NOLIST AFLRT DL A0,FACK DS A0,RPFOR$+1 L,M A1,1 L,M A0,FACK ER FACIL$ TZ,S1 FACK+6 EQUIPMENT TYPE, ZERO IS NOT ASSIGNED J JACKB ASSIGNED L,M A0,AFILEA NOT ASSIGNED, TRY @ASG,A ER CSF$ JN A0,JACKE L,M A0,FACK ER FACIL$ L,S1 A0,FACK+7 . TEST IF CATALOGED OR ASIGNED TEP,M A0,020 J JACKA . A TEMPOARARY FILE J JACKC . A CATALOGED FILE JACKE L A0,(0105,JPPM) CAN NOT ASSIGN ATHENA$ ER PRINT$ J NOLIST JACKB L,S1 A0,FACK+7 FILE IS ASSIGNED,CHECK T FLAG TOP,M A0,020 S,S2 A1,RPFLG$ DO NOT BREAKPOINT, IT WAS @ASG,A J JACKA OTHERWISE @ASG,T JACKC S,S3 A1,RPFLG$ . SET TO FREE FILE, WAS CATALOGED BUT UNASSIGN JACKA . DO 1-JPL , PROC L A0,(3,BRKPM) TZ,S2 RPFLG$ J $+3 TZ,H1 BRKPTT . TEST IF STILL IN CHAIN ER CSF$ DO JPL , PROC END FILEID DL A6,PARTBL+1 FILE NAME DL A8,PARTBL+3 ELEMENT NAME DL A10,PARTBL+7 VERSION NAME JNZ A6,$+4 I OPTION CAUSES NAMES DL A6,PARTBL+14 TO BE IN SOURCE DL A8,PARTBL+16 OUTPUT FIELDS DL A10,PARTBL+20 DS A6,FACK L,M A0,FACK ER FACIL$ L A3,(1,1) WORD COUNTER L B11,(1,3) CHARACTER COUNTER DL A1,FACK+4 QUALIFER LMJ B10,RTNID L,M A0,'*' EX STARAY,*B11 . OUTPUT AN ASTERISK DL A1,FACK+2 FILE NAME LMJ B10,RTNID L,M A0,'.' EX STARAY,*B11 . OUTPUT A PERIOD DL A1,A8 ELEMENT NAME LMJ B10,RTNID TNE A10,(' ') J IDF1 L,M A0,'/' EX STARAY,*B11 . OUTPUT A SLASH DL A1,A10 VERSION NAME LMJ B10,RTNID IDF1 L A4,PARTBZ . CHECK FOR U OPTION TOP,M A4,040 J IDF1J . NO CYCLE INFO GIVEN L,M A0,'(' EX STARAY,*B11 L,S6 A4,PARTBL+13 . INPUT CYCLE INFO DSL A4,36 DI,M A4,10 JZ A4,IDF1K L A0,A4 A,M A0,060 . CONVERT TO FIELDATA EX STARAY,*B11 IDF1K L A0,A5 A,M A0,060 . CONVERT TO FIELDATA EX STARAY,*B11 L,M A0,')' EX STARAY,*B11 IDF1J L,M A1,5 L,M A0,' ' . FORCE A BLANK FOR 12 CHARACTER NAMES EX STARAY,*B11 . OUTPUT SIX BLANKS JGD A1,$-1 DL A1,('OPTIONS: ') LMJ B10,RTNID EX STARAY,*B11 . OUTPUT ONE BLANK L,M A4,25 . LOOP COUNTER L,M A0,5 L A1,PARTBZ LSSC A1,10 . LEFT JUSTIFY IDF2 LSSC A1,1 . GET OPTION LETTER A,M A0,1 . FORM LETTER IN FIELDATA JNB A1,$+2 EX STARAY,*B11 . OUTPUT OPTION LETTER JGD A4,IDF2 . CONTINUE LOOP FOR ALL 26 LETTERS A,M A3,0101 . LINE SPACE PLUS NUMBER OF WORDS S,H1 A3,MSGCT L A0,MSGCT S A0,RPFOR$ ER PRINT$ L,M A0,RPFOR$ ER PRNTA$ L A0,PRNTP S A0,RPFOR$ L,M A0,RPFOR$ ER PRNTA$ L A1,PRNTPA S A1,RPFOR$ ER PRNTA$ NOLIST L A0,SVCRFT RESTORE CROSS REF FLAG S A0,CRCRFT TZ,S5 CRD ONLY FOR PHASE 2 DUMPS TEMP-- LMJ B11,DALEC DUMP TABLES 222620 J *PHEXIT LNKNME PLP34 L,XH1 A0,LREF1-2,B4 JN A0,PLP10 . SPECIAL LABEL FROM EXIT LOOP AND CYCLE S A0,ERRPAR 222900 L,H1 A0,LREF1-1,B4 222910 L,H2 A1,LREF1-1,B4 TP,XH2 LREF1-1,B4 ANX,M A1,0,*0 TNZ A0 222920 L,H1 A0,3,A1 S A0,R8 222940 LMJ B11,ERROR 223100 FORM6 021,8,ERRPAR L,M A14,0 223300 J PLP10 223310 PLP35 L,H1 A0,LREF1+1,*B4 DUPLICATE LABEL 223400 S A0,R8 SEQUENCE COUNT 223600 S A12,ERRPAR LABEL 223600 LMJ B11,ERROR 223700 FORM6 022,9,ERRPAR DUPLICATE LABELS L,H1 A0,LREF1+1,B3 S A0,R8 . SEQUENCE COUNT LMJ B11,ERROR FORM6 022,9,ERRPAR DUPLICATE LABELS S R15,DUPFLG . SET DUPE LABEL FLAG J PLP10 223900 PLP36 L,H1 A0,LREF1+1,B4 REFERENCED DUPE LABEL S A0,R8 SEQUENCE COUNT S A12,ERRPAR LABEL LMJ B11,ERROR FORM6 022,9,ERRPAR J PLP102 SDP2 S,H2 A2,3,B3 0 VARIABLE S,H2 A2,3,B3 1 INTERNAL SUBPROGRAM S,H2 A2,3,B3 2 EXTERNAL SUBPROGRAM J SDP1 3 CONSTANT J SDP1 4 PARAMETER S,H2 A2,3,B3 5 ARGUMENT J SDP1 6 INTRINSIC FUNCTION J SDP1 7 LABEL SDP3 L,S2 B11,SYMBRK A,M B11,1 S,S2 B11,SYMBRK L,H1 A5,SYMBRK+1,B11 S A5,SYMB L,H2 A5,SYMBRK,B11 A,M A5,3 SSL A5,2 LSSL A5,2 AN,M A5,4 LXM B3,A5 J SDP1 . LENGTH DETERMINES THE STORAGE REQUIRED FOR 224600 . AN ARRAY. CALLING SEQUENCE 224700 . 224800 . N LMJ B11, LENGTH 224900 . N+1 RETURN 225000 . 225100 . SET A0 TO SYM(V) BEFORE JUMPING 225200 . A1= LENGTH AFTER RETURN 225300 . 225400 . 225500 . IF THE ARRAY HAS A VARIABLE DIMENSION - 225600 . (1) IF THE ARRAY IS A DUMMY VARIABLE THE DIMENSION 225700 . IS ASSUMED ZERO. (I.E., THE ARRAY SIZE IS ZERO) 225800 . (2) IF THE ARRAY IS NOT DUMMY, THE DIMENSION IS 225900 . ASSUMED 1 AND AN ERROR IS INDICATED. 226000 . 226100 . 226200 LENGTH L,H1 A1,2,A0 AND,M A1,01007 TNE,M A2,01005 . TEST DUMMY ARG AS FUNCTION J 0,B11 TEP,M A1,2 . SKIP OUT ON FUNCTIONS J 0,B11 AND,M A1,070 SELECT TYPE 226400 L,M A1,1 226500 TE,M A2,030 IS ARRAY DOUBLE PRECISION 226700 TNE,M A2,040 IS ARRAY COMPLEX 226800 L,M A1,2 -YES 226900 TNE,M A2,060 J LENC . COMPUTE LENGTH OF AN ELEMENT SZ EQTFLG . FLAG IS HARMFUL EXCEPT FOR CHARACTER LENCA L,S2 A2,2,A0 AND,M A2,7 NUMBER OF DIMENSIONS 227100 JZ A3,LEN3Y TZ,S1 CRDGSY TEST FOR MOVING DIMENSION POINTERS SLJ DIMPTR AN,M A3,1 227300 L,M A4,1 227400 L,H2 A2,3,A0 DIMENSION REFERENCE LOCATION 227500 A A2,(1,0) 227600 SZ A5 227700 LEN1 TNE,S1 A4,0,*A2 . IS ID=1? CTABD J LEN2 -YES 227900 L,M A5,1 -NO 228000 J LEN3 228100 LEN2 AN,M A2,1 CTABD TZ,S2 0,A2 . PARAMETER? CTABD J $+3 PARDIM MSI,H2 A1,0,*A2 . NO CTABD J $+4 PARDIM MSI A1,*0,*A2 . YES CTABD JN A1,LEN3X PARDIM JZ A1,LEN3X PARDIM LEN3 JGD A3,LEN1 228300 JNZ A5,LEN4 228400 TLE A1,MAXD 131K J LEN3Y . TEST TO CONVERT LENGTH TO CHARACTERS S A0,ERRPAR -YES 228700 S B11,A3 228800 LMJ B11,ERROR ARRAY TOO LARGE 228900 FORM6 031,1,ERRPAR J 0,A3 EXIT 229100 LEN3Y TNZ,H1 EQTFLG J 0,B11 TZ,H2 EQTFLG J 0,B11 . IN EQUIVALENCE RETURN CHARACTERS . S,H2 A1,EQTFLG . SAVE TOTAL LENGTH IN CHARACTERS DSL A1,36 DI,H1 A1,EQTFLG . GET LENGTH IN WORDS TZ A2 . TEST FOR REMAINDER A,M A1,1 J 0,B11 LEN3X S A0,ERRPAR PARDIM S B11,A3 PARDIM LMJ B11,ERROR PARDIM FORM6 032,17,ERRPAR . NEG OR ZERO DIMENS. FATAL. PARDIM J 0,A3 PARDIM LEN4 L,H1 A2,2,A0 THERE IS A VARIABLE DIMENSION 229200 AND,M A2,7 229300 JZ A3,0,B11 IS ARRAY DUMMY 229400 SZ A1 -YES,SIZE = 0 229500 J 0,B11 229600 LENC L,H1 A1,2,A0 . GET MODE AND CLASS FIELDS AND,M A1,7 TNE,M A2,5 . TEST FOR DUMMY ARGUMENT J LEND . SET LENGTH TO ZER0 L,H2 A1,3,A0 . GET DIMENSION/CHARACTER POINTER L,S2 A2,2,A0 . NUMBER OF DIMENSIONS AND,M A2,7 A A1,A3 . COMPUTE ADDRESS OF CHARACTER PACKET L,S2 A4,0,A1 . TYPE OF CHARACTER L,H2 A1,1,A1 . LENGTH OF AN ELEMENT L,M A5,6 . FIELDATA CHARACTERS PER WORD TNE,M A4,3 . TEST ASCII STRINGS L,M A5,4 . ASCII CHARACTERS PER WORD S,H1 A5,EQTFLG . SAVE CHARACTER PER WORD TZ,H2 EQTFLG . RETURN LENGTH IN CHARACTERS FOR EQUIVA JZ A3,0,B11 . EXIT IF NO DIMENSIONS J LENCA LEND SZ A1 . SET ELEMENT LENGTH TO ZERO J 0,B11 ERROR S B11,ERRSA S A0,ERRSA+1 230400 L A0,0,B11 230500 DS A1,ERRSA+2 TP,XH2 0,B11 AN,M A0,0,*0 L A1,ERCNTZ REENT A,M A1,1 ONLY FILE 100 ERRORS S A1,ERCNTZ REENT TG,M A1,100 AND THEN QUIT J EXIT L A1,0,A0 230800 S A1,ERROR1+1 PARAMETER 230900 L A1,R8 SEQUENCE COUNT 231100 DSC A0,18 231100 A,M A0,02000 231200 S A0,ERROR1 231300 LMJ B11,ERFP FILE ERROR 231400 NOP 0,ERROR1 231500 L B11,ERRSA 231600 L A0,ERRSA+1 231700 DL A1,ERRSA+2 J 1,B11 232000 SYSERR L R15,BUG SLJ N0RGSV ER CEND$ LMJ B11,CONTTT +006200,BUG LMJ B11,ERROR FORM6 042,2,BUG J EXIT . . THIS ROUTINE PUTS THE SYMBOL TABLE POINTER AND POINTER TO ITS DIMENSIONS . FOR ALL DIMENSIONED VARIABLES INTO F60. THIS IS DONE IF THE SYMBOL TABLE . IS GOING TO BE MADE A PART OF THE RELOCATABLE TEXT AS THESE POINTERS . ARE NORMALLY DESTROYED BY DEFINITION POINTS. DIMPTX DS A0,N0RGSA SAVE SOME REGISTERS TZ CRFL . IF FATAL ERR OR DO NOT BUILD TABLE J DIMPTR DS A2,N0RGSA+2 DS A4,N0RGSA+4 S B11,N0RGSA+6 L A1,DIMPTA POINTER INTO 14 WORD BUFFER L A2,DIMPTB COUNT OF AVAILABLE ENTRIES DIMB JGD A2,$+2 J DIMA S,H1 A0,DIMBUF,A1 L,H2 A0,3,A0 S,H2 A0,DIMBUF,*A1 S A1,DIMPTA SAVE POINTERS S A2,DIMPTB DL A0,N0RGSA DL A2,N0RGSA+2 DL A4,N0RGSA+4 L B11,N0RGSA+6 J *DIMPTR DIMA L A5,F60I . NUMBER SLOTS IN BUFFER AN,M A5,16 JP A5,W60FA . ROOM IN BUFFER FOR ITEM DS A0,N0RGSA+8 . SAVE@REGISTERS L,H2 A0,F60+6 . LOCATION OF BUFFER L A1,F60J . NEXT AVAILABLE CONTROL L,M A2,076 . FORCE SKIP TO NEXT BUFFER S,S1 A2,0,A1 . WHEN _076 IS@_READ AS CONTROL WORD S A5,1,A0 . POSSIBLE SECOND TEST FOR END OF BUFFER BWRIT F60 L,M A5,BUFN-1 . NUMBER SLOTS IN BUFFER . NUMBER L,H2 A1,F60+6 . LOCATION OF CURRENT ACTIVE BUFFER AH A1,(1,NBCW) . FORM NEXT LOCATION IN BUFFER S A1,F60J DL A0,N0RGSA+8 . RESTORE REGISTERS W60FA L A1,F60J . CURRENT LOCATION IN BUFFER S A5,F60I L,M A2,16 . TOTAL LENGTH OF __ITEM SZ 0,A1 . SET FIELDATA AND NO TERMINATING CONTRO S,T1 A2,0,*A1 L A0,(1,DIMBUF) L,M R1,15 BT A1,0,*A0 . MOVE ITEM INTO BUFFER S A1,F60J . CURRENT LOCATION IN BUFFER L,M A2,14 L A1,(1,1) L A0,DIMBUF TNZ N0RGSA J DIMPTR TNE A0,(040100,0) . TEST FOR CLOSE OUT WRITE J *DIMPTR L A0,N0RGSA . RESTORE SYM POINTER J DIMB . RTNID SZ A0 LDSL A0,6 ONE CHARACTER TO A0 JZ A0,SNDWD ALL DONE TNE,M A0,05 BLANK IS ALSO ALL DONE J SNDWD EX STARAY,*B11 STORE CHARACTER INTO ARRAY J RTNID GO TO NEXT CHARACTER SNDWD L A1,A2 GET SECOND WORD SZ A2 PREVENT LOOPING JZ A1,0,B10 ALL DONE J RTNID CONTINUE WITH SECOND WORD . FORTRA $(2) PLIN +0 INTERNAL SUBROUTINE NO. SHORT3 EQTFLG +0 . SET WHILE PROCESSING EQUIVALENCE SSYM7 +0 DUPFLG +0 BUGERR +0133700,BUG N1BUG . BUG +0 NOP . J SYSERR DO 1-LMSC , PROC TFILEA '@ASG,T ATHENA$,F . ' AFILEA '@ASG,A ATHENA$ . ' JPPM 'ATHENA$ CAN NOT BE ASSIGNED ' FACK 'ATHENA$ ' DO LMSC , PROC END DO 1-JPL , PROC TFILEA '@ASG,T DP$ . ' AFILEA '@ASG DP$ . ' JPPM 'FILE DP$ CAN NOT BE ASSIGNED ' BRKPM '@BRKPT DP$ . ' FACK 'DP$ ' DO JPL , PROC END RES 7 $(1) . STARAY S,S1 A0,IDENT,A3 S,S2 A0,IDENT,A3 S,S3 A0,IDENT,A3 S,S4 A0,IDENT,A3 S,S5 A0,IDENT,A3 LMJ B9,$+1 PUTR S,S6 A0,IDENT,*A3 . LAST CHARACTER IN WORD L B11,(1,0) J 0,B9 $(2) MSGCT +0,IDENT IDENT 'ELEMENT: ' DO 14 , ' ' DIMBUF +0160016,0 RES 15 DIMPTA +1,1 POINTER INTO DIMBUF DIMPTB +14 DIMPTR J $-$ J DIMPTX SVCRFT +0 . SAVES CRCRFT DURING PHASE 2 PRESYM +0 +0 +0 SRCHCT +0 NUMBER OF ITEMS TO SORT ERRPAR +0 ERROR1 RES 2 ERROR MESSAGE (ERROR) ERRSA RES 4 SAVED REGISTERS (ERROR) SYMB +0 CURRENT CRSYM TO TEST FOR END OF BLOCK REENT QZID* +0 ERCNTZ +0 REENT END