.TITLE F4 / /FORTRAN 4 COMPILER / /COPYRIGHT 1969, DIGITAL EQUIPMENT /CORP., MAYNARD, MASS. / /TAPE 1 OF 2 / /VERSION V8A / /11-17-69 / /PARAMETER ASSIGNMENTS / PTP=0 MAKE PAPER TAPE SYSTEM (7 OR 9) / BANK=0,1,2,3 PROPER BANK FOR PAPER TAPE / %F2=0 MAKE ABBREVIATED VERSION / PDP7=0 ASSEMBLE FOR 7 DECTAPE / PDP15=0 ASSEMBLE FOR PDP15 / / IF PTP,PDP7, AND PDP15 ARE UNDEFINED, ASSEMBLE / FOR A PDP-9 DECTAPE SYSTEM / IF IMBED DEFINED USE IMBEDDED I/O / IF K16 DEFINED MAKE EXPANDED FORTRAN / .ABS .IFUND BANK BANK=0 .ENDC BASE1=3465 APTP=0 A%F2=0 B%F2=0 C%F2=0 D%F2=0 APDP7=0 APDP15=0 BPDP15=0 ABF=0 AIMBED=0 %F4I=0 AX4K=0 ADUMY=0 BDUMY=0 AEQUIV=0 AERMSG=0 AASCI=0 AK16=0 .IFDEF K16 DUMY=0 .IFUND %F2 EQUIV=0 .ENDC ERMSG=0 ASCI=0 AK16=-21 .ENDC .IFDEF PTP APTP=61 .ENDC .IFUND PTP .IFDEF BF ABF=141 .ENDC .ENDC .IFDEF %F2 A%F2=1322 B%F2=6 C%F2=27 D%F2=-42 .ENDC .IFDEF PDP7 APDP7=-154 .ENDC .IFDEF PDP15 APDP15=-22 BPDP15=1 .ENDC .IFDEF IMBED AIMBED=411+D%F2+BPDP15 .IFDEF X4K .END .ENDC .IFDEF PTP .END .ENDC .ENDC .IFDEF X4K AX4K=-344+C%F2 .ENDC .IFDEF DUMY ADUMY=-15 BDUMY=-1 .ENDC .IFDEF EQUIV AEQUIV=-22 .ENDC .IFDEF ERMSG AERMSG=-174+B%F2+BDUMY .ENDC .IFDEF ASCI AASCI=-16 .ENDC AOPS=AX4K+ADUMY+AEQUIV+AERMSG+AASCI+AK16 .LOC BANK*20000+BASE1+APTP+AIMBED+A%F2+APDP7+APDP15+ABF+AOPS .EJECT /ERROR MACROS .IFUND ERMSG .DEFIN ERN,A,B,C B JMP C .ENDM .DEFIN ERS,A,B,C B SKP JMP C .ENDM .DEFIN ERR,A,B LAW B JMS ERROR1 .ENDM .ENDC .IFDEF ERMSG .DEFIN ERN,A,B,C JMS ERRORN .ASCII A .LOC .-2 B .LOC .+1 .ENDM .DEFIN ERS,A,B,C JMS ERRORS .ASCII A .LOC .-2 B .LOC .+1 .ENDM .DEFIN ERR,A,B .ASCII A .LOC .-2 JMS ERROR1 .LOC .+1 .ENDM .ENDC .EJECT /BANK-BIT INITIALIZATION-OVERLAYED / OPR=740000 .IFDEF IMBED BEGIN LAC DL155 DAC BINBFH JMP INIT02 DL155 15500 SINBFH=. .ENDC .IFUND IMBED BEGIN LAC N00767 DAC RSTRT LAC* S00100 .IFUND PTP AND S60000 /GET BANK BITS .ENDC .IFDEF PTP CLA .ENDC DAC BNKBTS LAC BNKTAB XOR BNKBTS /PUT INTO TABLE ADDR DAC BNKTAB LAC MODCT DAC BNKCTR BNKLOP LAC* BNKTAB XOR BNKBTS DAC BNKTMP LAC* BNKTMP XOR BNKBTS DAC* BNKTMP ISZ BNKTAB ISZ BNKCTR JMP BNKLOP / /ONCE-ONLY INITIALIZATION-OVERLAYED / OVRLAY CAL+775 1 INIT02 0 .IFDEF X4K LAC* S00120 SMA JMP N00767 AND S77777 DAC CONTB1 /EXTRA 4K USED FOR STORAGE OF CONSTANTS AND S70000 DAC BNKBTS XOR S07777 DAC ENDINT /LAST LEGAL ADDRESS LAC S70000 DAC MASK LAC ENDIN1 DAC SYMTB1 /FIRST REGISTER BELOW F4 LAC DL1 DAC SBSE51+1 LAC DL2 DAC CNSE52 .ENDC N00767 CAL 767 /.INIT INPUT (-11) 1 INIT02 0 LAC .-1 SAD S00377 JMP .+3 /BULK STORAGE LAC DLNOP /NOT BULK STORAGE SKP LAC DLJMP DAC EPS1SW /INTO END PASS 1 SWITCH LAC DL155 DAC BINBFH LAC DLCR DAC SINBFH+44 LAC ENDINT DAC CONTB0 JMP INIT02 DLNOP JMS SUB990 DLJMP JMP INIT01 .IFDEF X4K DL1 JMS SYMSAF DL2 JMS CONSAF /CHECK FOR BOUNDARY .ENDC DL155 15500 DLCR 64000 BNKTAB MODF BNKCTR 0 BNKTMP 0 ENDINT BEGF4 .IFDEF X4K ENDIN1 SYMSAF-1 S07777 7777 S70000 70000 .ENDC /ADDRESS TABLE-OVERLAYED MODF=. OVRLAY+2 N00767+2 INIT02+5 M1BK M2BK M3BK ARG0 ARGEND OP0 EQCLSX AT1 BASE0 BASEMX BASEJ SINBF0 BINBF0 .IFUND %F2 OBJBF0 .ENDC ENDINT .IFDEF X4K ENDIN1 .ENDC Z77744-1 FORMST-1 TRYBIN-1 CMDERR+1 CALL05 ER1MSY X17777-1 INIT01-1 .IFDEF PDP15 END02 .ENDC INIT01+7 CTRLIM+1 CTRLIM+2 CTRLIM+3 CTRLIM+4 CTRLIM+5 CTRLIM+6 CTRLIM+7 CTRLIM+10 CTRLIM+11 CTRLIM+12 CTRLIM+13 CTRLSM+1 CTRLSM+2 CTRLSM+3 CTRLSM+4 CTRLSM+5 CTRLSM+6 CTRLSM+7 CTRLSM+10 CTRLSM+11 CTRLSM+12 CTRLSM+13 CTRLNM+1 CTRLNM+2 CTRLNM+3 CTRLNM+4 CTRLNM+5 CTRLNM+6 CTRLNM+7 CTRLNM+10 CTRLNM+11 CTRLNM+12 CTRLNM+13 PIDTB0 PIDTB0+2 PIDTB0+4 PIDTB0+6 PIDTB0+10 PIDTB0+12 PIDTB0+14 .IFUND %F2 PIDTB0+16 PIDTB0+20 .ENDC FUNMNE+1 FUNMNE+3 FUNMNE+5 FUNMNE+7 RETADR FMTADR FMTADR+2 FMTADR+4 .IFUND %F2 FMTADR+6 .ENDC PAUSAD CALLAD DATAAD STOPAD GOTOAD IFADDR PIDTBX ENDFAD REALAD READAD DOADDR CTRL90 CTRL90+1 CTRL90+2 CTRL90+3 CTRL90+4 SIDTBX PASS+7 PASS+11 FAOPIM+1 FAOPIM+2 FAOPIM+3 FAOPIM+4 FAOPIM+5 FAOPIM+6 FAOPIM+7 FAOPIM+10 FAOPIM+11 FAOPIM+12 FAOPUM+1 FAOPUM+2 FAOPUM+3 FAOPUM+4 FAOPUM+5 FAOPUM+6 FAOPUM+7 FAOPUM+10 FAOPUM+11 FAOPUM+12 FAOPNM+1 FAOPNM+2 FAOPNM+3 FAOPNM+4 FAOPNM+5 FAOPNM+6 FAOPNM+7 FAOPNM+10 FAOPNM+11 FAOPNM+12 FAOPSM+1 FAOPSM+2 FAOPSM+3 FAOPSM+4 FAOPSM+5 FAOPSM+6 FAOPSM+7 FAOPSM+10 FAOPSM+11 FAOPSM+12 FAOPLM+1 FAOPLM+2 FAOPLM+3 FAOPLM+4 FAOPLM+5 FAOPLM+6 FAOPLM+7 FAOPLM+10 FAOPLM+11 FAOPLM+12 NMODE .IFUND %F2 LDRTAB+1 LDRTAB+2 LDRTAB+3 LDRTAB+4 LDRTAB+5 LDRTAB+6 LDRTAB+7 LDRTAB+10 LDRTAB+11 LDRTAB+12 LDRTAB+13 LDRTAB+14 LDRTAB+15 LDRTAB+16 LDRTAB+17 LDRTAB+20 LDRTAB+21 LDRTAB+22 LDRTAB+23 LDRTAB+24 LDRTAB+25 LDRTAB+26 LDRTAB+27 .ENDC SINPUT+3 OBINRY+4 .IFUND %F2 OBJ521+4 OBJ545 OBJ400 .ENDC OPTRAN RELOPC LOCTAB LOCTBM CHRTAB CHRTBX MODL=. MODCT MODL-MODF\777777+1 .IFDEF X4K /ROUTINES TO HANDLE EXTRA 4K CORE / /ROUTINE TO JUMP GAP IN SYMBOL STORAGE / SYMSAF 0 /AC CONTAINS PROP. ADDR. DAC TEMSAF TAD C00006 /COMPUTE LAST POSSIBLE ENTRY ADDRESS JMS FORARA /IS ADDR. IN FORBIDDEN AREA? LAC CONTB1 /YES JMP* SYMSAF /NO /COMPUTE WHETHER AC ADDRESS IN FORBIDDEN AREA FORARA 0 JMS TWOCMA DAC TESAF1 TAD CONTB1 /ADDR. < CONTB1 SPA!SNA JMP FORAR1 /NO, OK LAC SYMTB1 /YES,TEST ADDR. > SYMTB1 TAD TESAF1 SMA FORAR1 ISZ FORARA /NO,OK LAC TEMSAF JMP* FORARA / /ROUTINE TO JUMP GAP IN CONSTANT STORAGE / CONSAF 0 /PROPOSED NEXT ENTRY ADDR. IN AC DAC TEMSAF TAD K00003 /COMPUTE LAST POSSIBLE ENTRY ADDRESS JMS FORARA /IS THIS ADDRESS IN FORBIDDEN AREA LAC SYMTB1 /YES JMP* CONSAF /NO TESAF1 0 SYMTB1 0 CONTB1 0 .BLOCK 240-C%F2 .ENDC / /BUFFER ALLOCATION IN OVERLAY AREA / /2ND MINUS FOR WORKING STORAGE / SINBFH=.-45 .ENDC BINBFH=SINBFH-32-24 .IFUND %F2 OBJBFH=BINBFH-26-5 TBEG=OBJBFH .ENDC .IFDEF %F2 TBEG=BINBFH-4 .ENDC .EJECT / TABLES WHICH PRECEDE THE COMPILER IN MEMORY / DOTAB / DO TABLES / SYMTAB /SYMBOL TABLE / CONTAB / CONSTANT TABLE .IFUND IMBED .FFREE .DSA 102 /START OF DO + SYMTAB CONTB0 0 .ENDC .IFDEF IMBED .FFREE ENDIMB CONTB0 BEGF4 .ENDC /FIRST ADDRESS OF CONSTANT TABLE CONTBC=ERROR1 / ADDRESS OF CURRENT ENTRY IN CONTAB CONTBN=TBEG-1 / NEXT ENTRY ADDRESS IN CONTAB SYMTB0=TBEG-2 / FIRST ADDRESS OF SYMBOL TABLE SYMTBC 0 / ADDRESS OF CURRENT ENTRY IN SYMTAB SYMTBN=TBEG-3 / NEXT ENTRY ADDRESS IN SYMTAB SYMTW2=SETA1 / ADDRESS OF WORD 2 CURRENT ENTRY IN SYMTAB SYMT2A=SETA2 /ADDRESS OF WORD2A CURRENT ENTRY IN SYMTAB SYMTW3=EXP520 / ADDRESS OF WORD 3 CURRENT ENTRY IN SYMTAB SYMTW4=EXP530 / ADDRESS OF WORD 4 CURRENT ENTRY IN SYMTAB SYMTW5=EXP540 / ADDRESS OF WORD 5 CURRENT ENTRY IN SYMTAB SYMTW6=EXP600 / ADDRESS OF WORD 6 CURRENT ENTRY IN SYMTAB TSMTBC=EXP610 / TEMP ADDR OF CURRENT ENTRY (W1) IN SYMTAB TSMTBN=TBEG-4 / TEMP ADDR OF NEXT ENTRY IN SYMTAB TSMTW3=EXP620 / TEMP ADDR OF CURRENT ENTRY (W3) IN SYMTAB TSMTW4=EXP640 / TEMP ADDR OF CURRENT ENTRY (W4) IN SYMTAB TRELAD=EXP650 / TEMP RELATIVE ADDRESS CTLPSW=SUB990+5 /0 IF RESTART, OTHERWISE EOM / EQUSTR=TBEG-5 /AMOUNT OF NON COMMON EQUIVALENCE STORAGE .IFUND IMBED START=INIT02+6 /ADDRESS OF FIRST EXECUTABLE INSTRUCTION .ENDC .IFDEF IMBED START 0 .ENDC LOWRAD=TBEG-6 /BLOCK DATA SIZE (EQU CLASS LOW REL. ADDR) IFFLAG=INDOTB /CURRENT STATEMENT IS AN IF STATEMENT LABEL=TBEG-7 /SYMTAB ADDR OF CURRENT STATEMENT LABEL LOGIF=AIF500 /CURRENT STATEMENT IS A LOGICAL IF MODE=EXP710 /MODE-TYPE FOR SPECIFICATION STATEMENTS SORDER=TBEG-10 /ORDER NUMBER OF LAST STATEMENT TORDER=TBEG-11 /ORDER NUMBER OF CURRENT STATEMENT PASS1 SKP /PASS 1 INDICATOR PASS2 .DSA 740000 /PASS 2 INDICATOR PROCAD=TBEG-12 /ADDRESS OF STATEMENT PROCESSING ROUTINE STRNGA=TBEG-13 /ADDRESS OF INSTRUCTION REQUIRING A STRING LSTCMD=TBEG-14 /LAST COMMAND GENERATED TITLEA.DSA 15 / ADDRESS OF CURRENT TITLE IN SYMTAB CTRLSW=TBEG-21 /IMAGE RECOGNITION ALLOWS NO CONTINUATION /CTRLSW=5 REGISTERS /OTS I/O INITIALIZER INDICATOR FILE=CTRLSW+2 /INPUT FILE NAME /(SEEK DIRECTORY) .EJECT / EXPRESSION DECODE WORKING STORAGE ARGI=CTRL00 /ADDRESS OF LAST ENTRY IN ARGUMENT TABLE ARG1=CTRL50 /ADDRESS OF ARGUMENT 2 IN ARGUMENT TABLE ARG2=CTRL70 /ADDRESS OF ARGUMENT 2 IN ARGUMENT TABLE OPI=CTRL80 /ADDRESS OF LAST ENTRY IN OPERATOR TABLE POP=CLEN50 /ADDRESS OF PREVIOUS OPERATOR IN OP TABLE NOP=TBEG-22 /ADDRESS OF NEXT OPERATOR IN OP TABLE ADDRA1=VECTOR /ADDRESS OF SYMBOLIC OR CONSTANT ARGUMENTS ADDRA2=DEFNSM /(1 OR 2) IN SYMBOL OR CONSTANT TABLE. TYPEA1=SCNLO /TYPE OF ARGUMENT 1 TYPEA2=IODEV /TYPE OF ARGUMENT 2 MODEA1=CLEN60 /MODE OF ARGUMENT 1 MODEA2=DEFNP1 /MODE OF ARGUMENT 2 SIGNA1=NTHSYM /SIGN OF ARGUMENT 1 SIGNA2=FARDIM /SIGN OF ARGUMENT 2 LEVPOP=FEDIMN /LEVEL OF PREVIOUS OPERATOR LEVNOP=COMN50 /LEVEL OF NEXT OPERATOR IDXPOP=CHAIN /INDEX ON OP TRANSLATION FOR PREVIOUS OP IDXNOP=DOCLEN /INDEX ON OP TRANSLATION FOR NEXT OPERATOR TSI=FVARGO /CURRENT INTEGER/LOGICAL TEMP STORE NAME TSR=PNZCV /CURRENT REAL TEMPORARY STORAGE NAME TSD=FVORAR /CURRENT DOUBLE PRECISION TEMP STORE NAME TARGI=FMTFCH /TEMPORARY ARG(1) INDEX TOPI=FMTOUT /TEMPORARY OP(1) INDEX TSTRNG=TBEG-23 /TEMPORARY HOLD FOR STRING ADDRESS RELOPT=CTRL60 /RELATIVE OPERATOR TYPE DATAFL=TBEG-24 /DATA STMT FLAG .IFDEF IMBED /IMBED VARIABLES PC 0 FORMST 0 .ENDC .EJECT / ARGUMENT/OPERATOR/LEVEL LISTS ... ARG(I), OP(I) / / THE FORMAT OF THE ARG(I) LIST IS.... / BITS 0-2 IS ARGUMENT TYPE AND BITS 3-17 VARY WITH THE TYPE.... / 0 ACCUMULATOR B03-04 ACCUMULAYOR MODE B05-17 UNUSED / 1 SYMBOLIC B03-17 ADDRESS OF SYMBOL IN SYMBOL TABLE / 2 CONSTANT B03-17 ADDRESS OF CONSTANT IN CONSTANT TABL / 3 TEMPORARY STORAGE B03-17 ADDRESS OF CREATED SYMBOL IN SYMTAB / 4 STRING B03-04 ORIGINAL ARGUMENT MODE / B05-17 STRING ADDRESS / 5 FUNCTION REFERENCE B03-17 UNUSED / 6 SUBSCRIPTED VARIABLE B03-17 UNUSED / 7 UNARY OPERATION B03-17 UNUSED / / MODE IS INDICATED AS... / 0 INTEGER / 1 REAL / 2 DOUBLE PRECESION / 3 LOGICAL / / THE FORMAT OF THE OP(I) LIST IS.... / BIT 0 INDICATES THE SIGN OF THE CORRESPONDING ARGUMENT (ARG(I)) / 0 POSITIVE ARGUMENT / 1 NEGATED ARGUMENT / / BIT 1 INDICATES THE RELATIVE ORDER OF THE ARGUMENTS WITH RESPECT TO / THE OPERATOR....(USED ONLY FOR NON-COMMUTATIBE OPERATIONS).... / 0 NORMAL ACCUMULATOR .OP. ARGUMENT / 1 REVERSE ARGUMENT .OP. ACCUMULATOR / / BITS 02-11 IS THE HEIRARCHY LEVEL OF THE OPERATOR PLUS THE CURRENT / PARENTHESIS NESTING LEVEL / / BITS 12-17 IS THE OPERATOR (ENCODED AS A TRANSLATION TABLE INDEX) / OPERATOR HEIRARCHY LEVEL / 00 (OCTAL) 00 (OCTAL) TERMINATION / 01 01 00 00 = / 02 02 03 03 .OR. / 03 03 03 03 .AND. / 04 04 04 04 .NOT. / 05 05 05 05 .LT. / 06 06 05 05 .LE. / 07 07 05 05 .EQ. / 08 10 05 05 .GE. / 09 11 05 05 .GT. / 10 12 05 05 .NE. / 12 14 06 06 - / 15 17 06 06 + / 18 22 07 07 / / 21 25 07 07 * / 26 32 08 10 ** / 24 30 09 11 UNARY NEGATION / 28 34 10 12 (F / 29 35 00 00 (S / 30 36 00 00 , / 32 40 00 00 )F / 33 41 00 00 )S / ARG0 .DSA ARG0+1 .IFUND DUMY .REPT 17 -1 .ENDC .IFDEF DUMY .REPT 31 -1 .ENDC ARGEND .DSA ARGEND /ARG.-OP. OVFLW. ADD. / EQUIVALENCE CLASS STORAGE (ARG(I) LIST NOT USED DURING EQUIVALENCE / PROCESSING). FSTVAR=TBEG-25 /INDICATES FIRST CLASS MEMBER LSTVAR=TBEG-26 /ADDRESS OF THE LAST VARIABLES LINKAGE WORD HEDCLS=TBEG-27 /ADDRESS OF HEAD MEMBER OF CLASS COMCLS=TBEG-30 /INDICATES A COMMON BLOCK IS THE CLASS OLDCLS=TBEG-31 /INDICATES THE MERGE OF TWO CLASSES SUBVAL=TBEG-32 /RELATIVE ADDRESS WITH RESPECT TO ONE SUBADJ=TBEG-33 /ADDRESS LINE-UP ADJUSTMENT FACTOR DIFF=TBEG-34 /DIFFERENCE BETWEEN ONE VARIABLES ASSIGNED / / RELATIVE ADDRESSES (TWO CLASSES) RELADR=TBEG-35 /RELATIVE ADDRESS WITH RESPECT TO THE HEAD / / OF THE CLASSES ADDRESS. EQUCLS=TBEG-36 /ADDRESS OF LAST ENTRY IN EQUIVALENCE / / CLASS LIST OP0 .DSA OP0+1 /OP(I) AND EQUIVALENCE CLASS LIST START .REPT 31 -1 EQCLSX .DSA EQCLSX /EQUIVALENCE CLASS LIST OVERFLOW ADDRESS .EJECT / READ, WRITE , FORMAT, AND DO WORKING STORAGE / RWFND=FDFSNO RWTST=SUBR60 RWEND=SUBR50 RWFLAG=RWFND PARLHI=EXPRSN TRW1=TBEG-37 TRW2=TBEG-40 TRW3=TBEG-41 DOI=EXP625 DOM1=EXP720 DOM2=TBEG-42 DOM3=EXP740 FPCNT=RWFND FLOATF=RWTST NUMFLG=PARLHI HFLG=DOI FMTCNT=DOM1 FMS=DOM2 FLS=DOM3 .EJECT / ARRAY DECLARATION SUBSCRIPT STORAGE TI=TRW1 /ADDRESS OF I-TH SUBSCRIPT T0=BASE+1 /NUMBER OF MACHINE WORDS PER ELEMENT T1=BASE+2 /FIRST SUBSCRIPT T2=BASE+3 /SECOND SUBSCRIPT T3=BASE+4 /THIRD SUBSCRIPT ATX=BASEMX /SUBSCRIPT OVER-RUN CATCHER SSCTR=OSYMBL /SPECIFIED SUBSCRIPT COUNTER AT1 .DSA T1 /ADDRESS OF FIRST SUBSCRIPT .EJECT / FETCH ARGUMENT/OPERATOR-DELIMETER PAIR WORKING STORAGE ARG=NUMCHK /ARGUMENT DESCRIPTION WORD OP=FMTPAK /OPERATOR DESCRIPTION WORD OPVALU=FMTFIL /OPERATOR VALUE SIGN=NUMTST /ARGUMENT SIGN CHRCTR=DSHL /CONCATENATION CHARACTER COUNTER TFAO01=TBEG-43 /LAST DELIMETER PROCESSED TFAO03=OUTSSC /DIGIT COUNT FOR NUMERIC PROCESSING TFAO04=INAOPI /ARGUMENT CONVERSION COMPLETE (ADJ.10 EXP) TFAO05=FAO590 /EXPONENT SIGN TFAO06=TBEG-44 /LOGIC OP MODE ENTRY FLAG (MODE) FAOMOD=OPOPA2 /CURRENT PROCESSING MODE NAME0=TBEG-45 /ARGUMENT MODE NAME1=RSVDTP /FIRST HALF CONCATENATED SYMBOL NAME2=TSTDTP /SECOND HALF CONCATENATED SYMBOL S=EXP550 /NUMBER CONVERSION MS=EXP560 /NUMBER CONVERSION LS=EXP570 /NUMBER CONVERSION TMS=EXP580 /NUMERIC CONVERSION TLS=EXP590 /NUMERIC CONVERSION TCTR=INFAOP /TEMPORARY COUNTER TEMP0=FTC500 /TEMPORARY ADDRESS HOLD SHFCTR=TWOCMA /SHIFT COUNTER / / SUBPROGRAM WORKING STORAGE / FCNFLG=TBEG-46 /SUBPROGRAM FLAG FCNRET=TBEG-47 /SYMBOL TABLE ADDRESS OF FUNCTION RETURN XITCMD=TBEG-50 /SUBPROGRAM EXIT COMMAND TXITCM=TBEG-51 ARGCTR=EXP700 /DUMMY ARGUMENT COUNTER SUBRN0=TBEG-52 /SUBPROGRAM NAME REFERENCED INDICATOR STRNGB=TBEG-53 /ADDRESS OF BRANCH AROUND PARAMETERS STRNGC=TBEG-54 /ADDRESS OF SUBPROGRAM BRANCH / /FILE NAME STORAGE / FILFLG=TBEG-55 FILE1 0 /FIRST HALF OF PROGRAM NAME SYMBOL FILE2 0 /SECOND HALF OF PROGRAM NAME SYMBOL .EJECT / PARENTHESIS LEVEL COUNTING TABLE / THE PARENTHESIS COUNTING ENTRY IS PUSHED DOWN EACH TIME A FUNCTION / REFERENCE IS ENCOUNTERED. THE ENTRY IS PUSHED UP AT THE TERMINATION / OF EACH FUNCTION REFERENCE. / THE LEVEL NUMBER IS CONTAINED IN BITS 0-11 / BASE0 .DSA BASE /INITIAL ENTRY ADDRESS .REPT 5 BASE -1 /TABLE BASEMX .DSA BASEMX /END OF TABLE BASEJ .DSA BASE0 /ADDRESS OF CURRENT LEVEL COUNTER / /DO TABLE POINTERS DOTABA=TBEG-56 /TERMINAL STATEMENT NUMBER DOTABB=TBEG-57 /FIRST STRING ADDRESS DOTABC=TBEG-60 /SECOND STRING ADDRESS DOTABX=TBEG-61 /END ADDRESSES .EJECT / SOURCE IMAGE INPUT (OUTPUT) BUFFER AND ASSOCIATED WORKING STORAGE / /BUFFER IN OVERLAY AREA / CHRBUF=SINBFH-1 /CHARACTER BUFFER CHRBF1=SINBFH-2 / (CONTAINS FIVE CHARACTERS) SINBUF=SINBFH-3 /ADDRESS OF NEXT 5 CHARACTERS CHRCNT=SINBFH-4 /CHARACTER COUNTER (WITHIN CHARACTER BUFF) COL=SINBFH-5 /COLUMN COUNTER CHAR=SINBFH-6 /CURRENT CHARACTER (INTERNAL CODE) XCHAR=SINBFH-7 /CURRENT CHARACTER (ASCII CODE) CHRTYP=SINBFH-10 /CURRENT CHARACTER (TYPE CODE) LEVEL=SINBFH-11 /CURRENT CHARACTER (HEIRARCHY LEVEL IF OP) LSTCHR=SINBFH-12 /LAST CHARACTER FETCHED UNFNBC=SINBFH-13 /USE LAST CHARACTER FETCHED INDICATOR COL06=SINBFH-14 /CONTENTS OF COLUMN 6 - CONTINUATION FIELD BITCTR=SINBFH-15 /SHIFT COUNTER FOR POSITIONING CHARACTER TCHBUF=SINBFH-16 /TEMPORARY CHARACTER BUFFER TCHBF1=SINBFH-17 /TEMPORARY CHARACTER BUFFER TSINBF=SINBFH-20 /TEMPORARY ADDRESS OF NEXT 5 CHARACTERS TCHCNT=SINBFH-21 /TEMPORARY CHARACTER COUNTER KOL=SINBFH-22 /TEMPORARY COLUMN COUNTER TCHAR=SINBFH-23 /TEMPORARY CURRENT CHARACTER .IFDEF IMBED SINBFH=DTIBUF .ENDC SINBF0 .DSA SINBFH+2 / BINARY OBJECT CODE OUTPUT BUFFER AND ASSOCIATED WORKING STORAGE / /BUFFER IN OVERLAY AREA / BINBF0 .DSA BINBFH+1 /ADDRESS (-1) OF BINARY BUFFER BINBUF=BINBFH-1 /DATA WORD STORAGE ADDRESS CODEWD=BINBFH-2 /LOADER CODE WORD STORAGE ADDRESS WRDCTR=BINBFH-3 /DATA WORD COUNTER CODCTR=BINBFH-4 /LOADER CODE COUNTER .IFUND %F2 / OBJECT CODE LISTING BUFFER / /BUFFER IN OVERLAY AREA / OBJB04=OBJBFH+22 /PRINTING BUFFER (ALSO TEMP STORAGE) OBJB03=OBJBFH+23 /PRINTING BUFFER (ALSO TEMP STORAGE) OBJB02=OBJBFH+24 /PRINTING BUFFER (ALSO TEMP STORAGE) OBJB01=OBJBFH+25 /PRINTING BUFFER (ALSO TEMP STORAGE) OBJBF0 .DSA OBJBFH+2 /ADDRESS OF OUTPUT BUFFER .ENDC .EJECT / BATCH PROCESSOR LIST=TBEG-62 BEGF4=TBEG-63 .DSA 232203 /.SIXBT /SRC/ /FILE NAME EXTENSIONS .DSA 142324 /.SIXBT /LST/ .DSA 021116 /.SIXBT /BIN/ / PASS1 INITIALIZATION / / .IFUND IMBED INIT02 LAC CTLPSW SZA JMP INIT01 / .INIT -11,IOERR,0,0,0 /INITIALIZE SOURCE INPUT DEVICE RSTRT JMP BEGIN /RESTART ADDRESS INIT. TO CAL 767 .DSA 000001 / INITIALIZE CODE .DSA INIT02 / ERROR RETURN .DSA 000000 / STANDARD BUFFER SIZE (72+ CHARACTERS) .ENDC .IFDEF IMBED INIT02=. RSTRT JMS INITIO .ENDC JMS SUB990 M1BK .DSA MESSY1-2 JMS SUB990 M2BK .DSA MESSY5-2 .IFUND IMBED / .READ -2 / INPUT COMMAND STRING CAL 02776 C00008 .DSA 000010 .DSA SINBFH Z77744 .DSA 777744 / .WAIT -2 CAL 00776 C00010 .DSA 000012 .ENDC .IFDEF IMBED JMS TTYIN .ENDC .EJECT / PASS 1 INITIALIZATION / LAC CHR1 /INTERNAL FOR CR AND ESC IS 36 DAC CHARCR LAC CHR2 DAC CHARLT .IFDEF IMBED LAC SIN512 DAC SIN507 DZM DTSAMS .ENDC LAC PASS1 /INITIALIZE... DAC CLEN01 /PRE-DATA ASSIGNMENT SWITCH DAC PASS / PASS SWITCH DZM SUBRN0 .IFUND %F2 DAC SYMMAP / NO SYMBOL MAP .ENDC LAC PASS2 .IFDEF PDP15 DAC F4K .ENDC .IFUND %F2 DAC OLIST / NO OBJECT LIST .ENDC DAC SLIST /NO SOURCE LIST DAC LIST /NO LISTING DEVICE DAC OBINRY /NO BINARY .IFDEF IMBED DAC DLIST .ENDC DAC FT2CNG LAC OP0 DAC EQUCLS / EQUIVALENCE CLASS LIST JMS INDOTB / DO TABLE POINTERS TAD C00010 DAC DOTABX / DO TABLE END DAC SYMTB0 / START SYMBOL TABLE DZM TSMTBN / (PERMANENT SYMTAB) DAC SYMTBN / SYMBOL TABLE NEXT ENTRY ADDRESS LAC CONTB0 DAC CONTBN / CONSTANT TABLE NEXT ENTRY ADDRESS JMS SIN520 INIT08 JMS SIN500 SAD CHARCR /CR JMP CMDERR SAD CHARLT /ALT MODE JMP CMDERR SAD CHARB JMP CMDB /B...BINARY SAD CHARL JMP CMDL / L...LIST SOURCE .IFDEF IMBED SAD CHARU ISZ DTSAMS SAD CHARD JMP CMDD .ENDC .IFUND %F2 SAD CHARO JMP CMDO / O...OBJECT LIST SAD CHARS JMP CMDS / S...SYMBOL MAP .ENDC SAD ARROW JMP CMDA /_...END OF OPTION LIST JMP INIT08 / ILLEGAL CHAR...IGNORE CMDERR JMS SUB990 /ERROR: CR OR ALT MODE BEFORE _ CMDERT-2 JMP INIT02 CMDB LAC PASS1 DAC OBINRY / SET BINARY OPTION FLAG JMP INIT08 CMDL LAC PASS1 DAC SLIST / SET SOURCE LIST OPTION FLAG LSTSET DAC LIST JMP INIT08 .IFUND %F2 CMDO LAC PASS1 DAC OLIST / SET OBJECT LIST OPTION FLAG JMP LSTSET CMDS LAC PASS2 DAC SYMMAP / SET SYMBOL MAP OPTION FLAG LAC PASS1 JMP LSTSET .ENDC .IFDEF IMBED CMDD LAC PASS1 DAC DLIST JMP LSTSET .ENDC CMDA DAC UNFNBC DZM TITLEA JMS SIN530 / SAVE POINTERS FOR OTHER CONVERSION CLC /FETCH FILE NAME FOR DDT DAC FILFLG JMS FVARGO CMDA1 LAC NAME1 DAC FILE1 LAC NAME2 DAC FILE2 JMS SIN540 / RE-POSITION POINTERS FOR FILE NAME LAW -6 DAC TCTR / CONVERT NAME TO SIXBIT DZM MS / FOR FILE SEARCH DZM LS CMDM14 LAW -6 DAC TEMP0 JMS DLSHFT ISZ TEMP0 JMP .-2 JMS FNBCHR SAD S00054 /CHECK FOR COMMA JMP .-2 SAD C00013 /CR JMP ENDCML SAD S00175 /ALT MODE JMP ENDCML AND S00077 XOR LS DAC LS CMDCNT ISZ TCTR JMP CMDM14 JMP CMDONE ENDCML DAC TITLEA /FOR COMMAND BATCHING DZM UNFNBC JMP CMDCNT CMDONE LAC TITLEA /TEST FOR END COMMAND STRING. SZA JMP .+10 /FINISHED JMS FNBCHR /FIND TERMINATOR. SAD C00013 SKP SAD S00175 SKP JMP .-5 DAC TITLEA LAC MS DAC CTRLSW+2 LAC LS DAC CTRLSW+3 / SET UP FILE NAME LAC INIT02-2 DAC CTRLSW+4 / SET NAME EXTENSION (LST) LAC CHR3 /INTERNAL FOR CR AND ESC IS 00 DAC CHARCR LAC CHR4 DAC CHARLT LAC JMPFT2 DAC FT2CNG .IFUND IMBED XCT LIST JMP TRYBIN CAL+1766 1 M3BK INIT02 PC 0 /PROGRAM COUNTER / .ENTER -12 / OPEN LISTING FILE CAL 00766 .DSA 000004 .DSA CTRLSW+2 TRYBIN LAC INIT02-1 DAC CTRLSW+4 / SET NAME EXTENSION (BIN) XCT OBINRY JMP INIT01 CAL+1765 1 INIT02 FORMST 0 / .ENTER -13 / OPEN BINARY FILE CAL 00765 .DSA 000004 .DSA CTRLSW+2 .ENDC .IFDEF IMBED LAC CMDONE+1 DAC SIN507 XCT LIST JMP TRYBIN DLIST XX JMP LISTTL LAC LISTD DAC LISTI JMS DENTER LAC PASS2 DAC OBINRY JMP INIT01 LISTTL LAC LISTT DAC LISTI TRYBIN XCT OBINRY JMP INIT01 LAC RSTRT-1 DAC FILE+2 JMS DENTER .ENDC .EJECT / PASS 1 / PASS 2 COMMON INITIALIZATION / INIT01=. .IFUND IMBED .CLOSE -3 /TYPE CR/LF DZM CTLPSW LAC INIT02-3 DAC CTRLSW+4 / SET NAME EXTENSION (SRC) / .SEEK -11,CTRLSW+2 CAL 00767 / LOCATE INPUT FILE .DSA 000003 .DSA CTRLSW+2 .ENDC .IFDEF IMBED JMS TTCLOS LAC RSTRT-3 DAC FILE+2 JMS DSEEK .ENDC JMS INDOTB / DO TABLE POINTERS LAC PASS1 DAC CLEN01 / DATA ASSIGNMENTS FINISHED/UNFINISHED DAC CTRLSW+1 /OTS I/O INITIALIZE IND. DZM SORDER / STATEMENT ORDERING COUNTER JMS BIN500 / BINARY OUTPUT BUFFER DZM XCHAR / SOURCE IMAGE REQUIRED .IFUND %F2 LAC END23 DAC BINO06 /OBJECT LISTING BUFFER INITIALIZATION .ENDC LAC FCNFLG SAD K00001 JMP .+4 LAC PC JMS BINOUT /OUTPUT PROGRAM SIZE FOR EVERYTHING XOR C00001 /BUT BLOCK DATA SUBPROGRAMS. DZM PC /RESET PROGRAM COUNTER DZM FCNFLG /RESET SUBPROGRAM FLAG DZM PROCAD DZM STAF /RESET TEMPORARY STORAGE LETTER FOR STATEMEMTFUNCTIONS .EJECT / STATEMENT INITIALIZATION, READ IN, RECOGNITION, EXECUTION AND CLEAN UP / CONTRL LAC K00001 /INITIALIZE.... DAC UNFNBC / FETCH NEXT CHARACTER INDICATOR DZM LOGIF / LOGICAL IF STATEMENT DZM LABEL / LABEL FIELD ENTRY .IFUND %F2 DZM OBJB04 /VECTOR IS (IS NOT) A PARAMETER (OBJ LIST) .ENDC DZM DATAFL DAC IFFLAG / IF STATEMENT DAC STRNGA /STRING CLEAN-UP REQUIRED DAC MODE /EXPLICIT MODE TYPING FLAG. LAC DOTABX /THE ORIGIN OF THE NON-ERASEABLE PORTION DAC SYMTB0 /OF THE SYMBOL TABLE IS RE-INSTATED. DZM TSMTBN /TEMPORARY NEXT SYMBOL TABLE ENTRY ADDRESS / /A NEW IMAGE IS INPUT IF THE LAST IMAGE / /WAS NOT FULLY PROCESSED (LAST CHARACTER JMS CTRL60 /EXAMINED IS NOT THE STATEMENT TERMINATION JMS SINPUT /CHARACTER). JMS SOUTPT /THE CURRENT SOURCE IMAGE IS LISTED BEFORE JMS FTC500 /PROCESSING OCCURS. JMP .-3 /CONTINUATION IMAGES FOUND HERE CAN ONLY JMS SINP00 /EXIST DUE TO AN ERRONEOUS LAST STATEMENT SKP CTRL41 JMS SIN530 /THE STARTING COLUMN COUNT IS SAVED TO DZM TCTR /ALLOW ITS PROPER RETURN (THIS LOGIC IS DZM OP /USED TO DECODE THE STATEMENT FOLLOWING CTRL13 LAC CTRLIM /A LOGICAL DO). THE SCAN MODE IS SET TO CTRL06 DAC FAOMOD /INITIAL AND PROCESSING BEGINS. DAC CTRLSW /(IMAGE RECOGNITION ALLOWS NO CONTINUATION) CTRL18 JMS FETCHR SKP /THE SCAN IS TERMINATED WHEN THE LAST JMP CTRL19 /CHARACTER HAS BEEN EXAMINED. SNA /(BLANK CHARACTERS ARE IGNORED.) JMP CTRL18 TAD FAOMOD /PROCESSING IS DETERMINED BY THE CURRENT DAC .+1 /SCAN MODE AND THE CURRENT CHARACTER UNDER JMP* 0 /CONSIDERATION. .EJECT /SUBROUTINE TO FETCH STATEMENT LABEL /CALLING SEQUENCE / JMS CTRL00 / CTRL00 CAL 0 LAC LOGIF /DO NOT PROCESS THE STATEMENT SZA /FIELD A SECOND TIME JMP* CTRL00 JMS SIN520 JMS FETSNO /COLUMNS 1 THRU 5 MAY CONTAIN A STATEMENT ISZ UNFNBC /LABEL. STATEMENT LABELS CONSIST OF A SPA /DIGIT STRING OF 1 TO 5 DECIMAL DIGITS. JMP CTRL04-2 AND S60000 /WHEN A STATEMENT LABEL IS PRESENT, ITS SNA /ASSIGNMENT WORD IS EXAMINED TO DETERMINE JMP CTRL04 /IF THE LABEL HAS PREVIOUSLY BEEN LAC* SYMTBC /ASSIGNED. AND S17777 /A PREVIOUS ASSIGNMENT MAY HAVE OCCURED SAD PC /DURING THIS PASS OR IT MAY HAVE OCCURED JMP CTRL05 /LAST PASS. THE DEFINITION OF THE LABEL / LAW 16340 /IS EQUAL TO THE CURRENT PROGRAM COUNTER / JMS ERROR1 /IF THE ASSIGNMENT IS CORRECT. ER01N ERR <' 01N'>,16340 CLA /AN ERROR IS ANNOUNCED IF THE NUMBER WAS JMP CTRL03 /USED MORE THAN ONCE AS A STATEMENT LABEL. CTRL04 JMS DEFNP1 /THE LABEL IS DEFINED EQUAL TO THE CURRENT XOR V60000 /PROGRAM COUNTER IF THIS IS ITS FIRST DAC* SYMTBC /OCCURANCE IN A LABEL FIELD. CTRL05 LAC SYMTBC /THE LABEL-NO LABEL FLAG IS SET WITH THE CTRL03 DAC LABEL /ADDRESS OF THE LABELS ENTRY IN THE SYMTAB JMS SIN540 /(OR ZERO) TO INDICATE A LABEL (NO LABEL). JMP* CTRL00 FAKE 0 DAC BINBFH+1 /SAVE AC LAC* FAKE AND S17777 /(17777 XOR LACCMD /(200000 DAC .+1 XX .IFUND X4K AND S60000 /MAKE SURE .ENDC .IFDEF X4K AND MASK .ENDC JMS TWOCMA /OF LEGAL ADDR. TAD BNKBTS SNL ISZ FAKE /DO NOT EXECUTE INSTRUCTION LAC BINBFH+1 JMP* FAKE .EJECT / STATEMENT RECOGNITION DECODING MATRIX / / INITIAL MODE ROW CTRLIM JMP* CTRLIM /TYPE CHARACTER .DSA CTRL11 /01 NUMERIC 0123456789 .DSA CTRL12 /02 ALPHABETIC BCJKMNOQRSTUVWYZ .DSA CTRL12 /03 ALPHABETIC ED .DSA CTRL12 /04 ALPHABETIC AEFGHILPX .DSA CTRL13 /05 OPERATOR +- .DSA CTRL13 /06 OPERATOR */ .DSA CTRL13 /07 PERIOD . .DSA CTRL14 /08 PARENTHESIS ( .DSA CTRL15 /09 PARENTHESIS ) .DSA CTRL16 /10 DELIMETER ,= .DSA CTRL13 /11 SPACE / / SYMBOLIC MODE ROW CTRLSM JMP* CTRLSM /TYPE CHARACTER .DSA CTRL18 /01 NUMERIC 0123456789 .DSA CTRL18 /02 ALPHABETIC BCJKMNOQRSTUVWYZ .DSA CTRL18 /03 ALPHABETIC ED .DSA CTRL18 /04 ALPHABETIC AFGHILPX .DSA CTRL13 /05 OPERATOR +- .DSA CTRL13 /06 OPERATOR */ .DSA CTRL13 /07 PERIOD . .DSA CTRL14 /08 PARENTHESIS ( .DSA CTRL15 /09 PARENTHESIS ) .DSA CTRL16 /10 DELIMITER ,= .DSA CTRL18 /11 SPACE / /NUMERIC MODE ROW CTRLNM JMP* CTRLNM /TYPE CHARACTER .DSA CTRL18 /01 NUMERIC 0123456789 .DSA CTRL13 /02 ALPHABETIC BCJKMNOQRSTUVWYZ .DSA CTRL13 /03 ALPHABETIC ED .DSA CTRL19 /04 ALPHABETIC AFGHILPX .DSA CTRL13 /05 OPERATOR +- .DSA CTRL13 /06 OPERATOR */ .DSA CTRL13 /07 PERIOD . .DSA CTRL14 /08 PARENTHSEIS ( .DSA CTRL15 /09 PARENTHESIS ) .DSA CTRL16 /10 DELIMETER ,= .DSA CTRL18 /11 SPACE .EJECT / NUMERIC CHARACTER IN INITIAL MODE CTRL11 LAC CTRLNM /THE SCAN CONTINUES IN THE NUMERIC MODE. JMP CTRL06 / ALPHABETIC CHARACTER IN INITIAL MODE CTRL12 LAC CTRLSM /THE SCAN CONTINUES IN THE SYMBOLIC MODE JMP CTRL06 / LEFT PARENTHESIS IN ALL MODES CTRL14 ISZ TCTR /THE PARENTHESIS COUNTER IS UPDATED (+1). JMP CTRL13 /THE SCAN CONTINUES IN THE INITIAL MODE. JMP CTRL13 / RIGHT PARENTHESIS IN ALL MODES CTRL15 JMS CNSE50 /THE PARENTHESIS COUNTER IS UPDATED (-1). JMP CTRL13 /THE SCAN CONTINUES IN THE INITIAL MODE. / DELIMETER IN ALL MODES CTRL16 LAC CHAR /THE DELIMETER IS EITHER A COMMA OR AN SAD C00001 /EQUAL SIGN. JMP CTRL17 / COMMA IN ALL MODES LAC TCTR /COMMAS INSIDE PARENTHESIS SEPARATE EITHER SZA /SUBSCRIPTS OR FUNCTION PARAMETERS. JMP CTRL13 LAC OP /COMMAS OUTSIDE OF PARENTHESIS SEPARATE SNA /LIST ITEMS WHEN NO EQUAL SIGN HAS BEEN JMP CTRL13 /FOUND. JMS SIN540 /A STATEMENT WITH A COMMA OUTSIDE OF LAC W00000 /PARENTHESIS AND FOLLOWING AN EQUAL SIGN JMS CTRL50 /CAN ONLY BE A DO STATEMENT. / SAD DOMNE / JMP CTRL20 / JMP ED /ERROR: STATEMENT NOT A DO STATEMENT ER01D ERS <' 01D'>,,ED CTRL20 LAC DOADDR /THE STATEMENT HAS BEEN IDENTIFIED AS A JMP CTRL21 /DO STATEMENT. / EQUAL SIGN IN ALL MODES CTRL17 LAC TCTR /AN EQUAL SIGN INSIDE PARENTHESIS CAN ONLY SZA /BE PART OF AN IMPLIED DO WHICH JMP CTRL19 /CANNOT BE PART OF AN ASSIGNMENT STATEMENT. ISZ OP /AN EQUAL SIGN OUTSIDE OF PARENTHESIS JMP CTRL13 /INDICATED A DO OR AN ASSIGNMENT STATEMENT. .EJECT / STATEMENT RECOGNITION WRAP-UP CTRL19 JMS SIN540 /THE USE OF THE NAME .IF. IS RESERVED FOR .IFDEF K16 LAC LOGIF SZA JMP CTRL29 .ENDC CTRL07 LAC Y00000 JMS CTRL50 /BECAUSE A LOGICAL IF STATEMENT MAY SAD IFMNE /CONTAIN AN ASSIGNMENT STATEMENT, THE JMP CTRL22 /STATEMENT IS FIRST EXAMINED TO DETERMINE LAC OP /IF IT IS AN IF STATEMENT. OTHERWISE THE SNA /STATEMENT IS DETERMINED TO BE EITHER AN JMP CTRL23 /ASSIGNMENT STATEMENT (INCLUDING STATEMENT .IFDEF K16 CTRL29 LAC OP SNA JMP CTRL07 .ENDC JMS CTRL80 /FUNCTIONS) OR A NON-ASSIGNMENT STATEMENT. JMS SIN540 /AFTER THE STORAGE ASSIGNMENTS HAVE BEEN JMS CLENUP /PROCESSED (NECESSARY BEFORE ANY EXECUTABLE JMS CTRL00 /(FETCH STATEMENT LABEL) JMS FVARGO /CODE IS GENERATED) THE ASSIGNMENT DZM CTRLSW /VARIABLE AND ITS DELIMETER ARE FETCHED. DZM PROCAD /INDICATE ASSIGNMENT OR FUNCTION STATEMENT. SAD C00028 /THE STATEMENT IS IDENTIFIED AS A JMP STAFCN /STATEMENT FUNCTION WHEN THE DELIMETER JMS SIN540 /INDICATES A FUNCTION AS THE ARGUMENT. LAC V40000 / THE STATEMENT ORDER IS SET TO INDICATE DAC TORDER /EXECUTABLE CODE BEING GENERATED AND THE JMS EXPRSN /ASSIGNMENT STATEMENT IS DECODED. .EJECT / STATEMENT PROCESSING COMPLETED (TERMINATED) RETURN STEXIT LAC TORDER /THE NEW STATEMENT ORDER IS SET BASED ON DAC SORDER /THE ORDER OF THE LAST STATEMENT. EREXIT LAC STRNGA /ALL STATEMENT PROCESSORS AND THE ERROR SMA /ROUTINE EXIT THIS POINT. JMS STRING /THE CURRENT PROGRAM COUNTER IS STRUNG LAC LABEL /(WHEN NECESSARY) TO A STATEMENT ADDRESS. SZA /IF A LABEL WAS PRESENT, IT IS CHECKED JMS DOCLEN /AGAINST THE LIST OF DO RANGE TERMINATION JMP CONTRL /LABELS AND DO CLEAN UP IS OUTPUT (MAYBE). .EJECT / NON-ASSIGNMENT STATEMENT RECOGNITION CTRL22 LAC IFADDR /THIS STATEMENT HAS BEEN IDENTIFIED AS AN JMP CTRL21 /IF STATEMENT. CTRL23 LAC NAME2 /THE STATEMENTS REAL AND READ AND END AND SAD REAMNE /ENDFILE MUST BE RECOGNIZED SEPARATELY AS JMP CTRL36 /THE FIRST THREE CHARACTERS OF EACH PAIR SAD ENDMNE /ARE IDENTICAL. JMP CTRL37 JMP CTRL38 CTRL36 JMS FNBCHR /WHEN THE FIRST THREE CHARACTERS ARE REA, SAD S00104 /THE NEXT NON-BLANK CHARACTER IS OBTAINED JMP CTRL39 /AND EXAMINED FOR D OR L. (READ OR REAL). .IFUND ERMSG SAD S00114 JMP CTRL40 /AN ERROR IS ANNOUNCED IF THE CHARACTER IS ER13I JMP EI /NEITHER D NOR L. .ENDC .IFDEF ERMSG ER13I ERS <' 13I'>,,EI JMP CTRL40 .ENDC CTRL39 LAC READAD JMP CTRL21 /THE ADDRESS OF THE READ OR REAL PROCESSING CTRL40 LAC REALAD /ROUTINE IS SET ACCORDINGLY. JMP CTRL21 CTRL37 LAC U00000 /WHEN THE FIRST THREE CHARACTERS ARE END, JMS CTRL50 /THE NEXT NON-BLANK CHARACTER IS FETCHED SNA /AND EXAMINED FOR EITHER THE STATEMENT JMP END /TERMINATION CHARACTER OF F. A TERMINATION / SAD C00006 /CHARACTER IDENTIFIES AN END STATEMENT. / SKP /AN ERROR IS ANNOUNCED IF THE CHARACTER IS / JMP CTRL28 /NEITHER F OR THE TERMINATION CHARACTER. ER14I ERS <' 14I'>,,EI LAC Y00000 JMS CTRL50 /THE NEXT THREE CHARACTERS ARE FETCHED AND / SAD ILEMNE /MATCHED AGAINST ILE TO COMPLETE THE NAME / SKP /ENDFILE. AN ERROR IS ANNOUNCED IF THE / JMP CTRL28 /NAME IS MISPELED. ER15I ERS <' 15I'>,,EI LAC ENDFAD /OTHERWISE THE STATEMENT IS IDENTIFIED AS JMP CTRL21 /ENDFILE. CTRL38 LAC PIDTB0 /ALL OTHER DAC TCTR /NON-ASSIGNMENT STATEMENTS ARE IDENTIFIED LAC* TCTR /BY THEIR RESPECTIVE NAMES (I.E. COMMON, AND T77777 /STOP, CALL, ETC.). SAD NAME2 JMP CTRL24 /THE FIRST THREE CHARACTERS OF THE NAME LAC TCTR /ARE USED TO OBTAIN A PRELIMINARY TAD C00002 /IDENTIFICATION OF THE STATEMENT. / SAD PIDTBX / JMP EI /ERROR: PRELIMINARY IDENTIFICATION NOT ER01I ERN <' 01I'>,,EI JMP CTRL38+1 /POSSIBLE CTRL24 LAC* TCTR DAC NAME2 /THE RECOGNITION OF THE FIRST THREE ISZ TCTR /CHARACTERS IS ENOUGH TO IDENTIFY THE LAC* TCTR /STATEMENT (ALMOST ALWAYS TRUE). THE DAC PROCAD /PROCESSOR ADDRESS AND OTHER PERTANENT LAC PIDTB0 /INFORMATION IS OBTAINED FROM THE PRIMARY JMS TWOCMA /IDENTIFICATION TABLE. TAD TCTR /THE RELATIVE POSITION OF THIS ENTRY IS RCR /CALCULATED SO THAT IT MAY BE USED TO DAC OP /COMPUTE THE ADDRESS OF THE LAC CTRL90 /CORRESPONDING ENTRY IN THE SECONDARY DAC TEMP0 /TABLES. CTRL31 LAC* TEMP0 TAD OP /THE SECONDARY INDENTIFICATION TABLES ARE DAC TCTR /SEARCHED WHEN THE STATEMENT NAME CONSISTS LAC NAME2 /OF MORE THAN THREE CHARACTERS. AND Y00000 /A SECONDARY TABLE ENTRY CONTAINS THE SNA /CONCATENATION OF THE NEXT N CHARACTERS JMP CTRL27 /(N = 1,2,OR 3) OF THE NAME IN BITS 2-17 JMS CTRL50 /AND THE NUMBER OF CHARACTERS TO EXAMINE LAC TEMP0 /NEXT TIME IN BITS 0-1 / SAD SIDTBX / JMP CTRL28 /THE STATEMENT IS IDENTIFIED WHEN ALL ER12I ERN <' 12I'>,,EI CTRL30 LAC* TCTR /CHARACTERS TO DATE HAVE BEEN RECOGNIZED AND T77777 /AND THE NUMBER OF CHARACTERS TO EXAMINE / SAD NAME2 /NEXT TIME IS ZERO. / SKP /CTRL28 JMP EI /ERROR: CHARS NOT CORRESPONDINGLY MACTHED. ER02I ERS <' 02I'>,,EI LAC* TCTR DAC NAME2 /WHEN THE CHARACTERS MATCH, THE NUMBER OF ISZ TEMP0 /REMAINING CHARACTERS IS FETCHED AND THE JMP CTRL31 /NEXT SECONDARY TABLE REFERENCED. CTRL21 DAC PROCAD /STORE DO OR IF PROCESSOR ADDRESSES. CTRL27 LAC PROCAD AND Z00000 /THE SPECIFICATION STATEMENTS MUST BE RCR /PROCESSED IN A PRESCRIBED MANNER. DAC TORDER JMS TWOCMA /THEREFORE THE ORDER NUMBER OF THE CURRENT TAD SORDER /STATEMENT IS COMPARED AGAINST THE ORDER / SMA!SZA /NUMBER OF THE LAST STATEMENT. /CTRL44 JMP EI /ERROR: CURRENT STMT OUT-OF-ORDER. ER03I ERN <' 03I'>,SMA!SZA,EI JMS TSTORD /STATEMENTS ARE ORDERED AS FOLLOWS... JMP CTRL33 / 00 BLOCK DATA, FUNCTION, SUBROUTINE / /01 INTEGER, REAL, LOGICAL, DOUBLE PREC. LAC TORDER / 02 DIMENSION TAD Z00000 / 03 COMMON SPA / 04 EQUIVALENCE, EXTERNAL (FLOATS) JMP CTRL34 / 05 DATA STATEMENT XCT PASS / 06 STATEMENT FUNCTIONS JMP CONTRL / 07 ALL OTHERS JMP CTRL34 /STORAGE ASSIGNMENT STATEMENTS ARE NOT CTRL33 SZA /PROCESSED DURING PASS 2. JMS CTRL80 /ONLY DATA STATEMENTS AND STORAGE JMS CLENUP /ASSIGNMENT STATEMENTS MAY APPEAR IN A CTRL34 JMS SIN530 JMS CTRL00 JMS TSTORD SNA JMS CTRL70 JMS INAOPI /BLOCK DATA SUBPROGRAM. CLA /APPEAR IN BLOCK DATA SUBPROGRAMS. JMP* PROCAD .EJECT / PRIMARY STATEMENT IDENTIFICATION TABLE / EACH ENTRY IN THIS TABLE CONSISTS OF TWO WORDS. THE FIRST WORD / CONTAINS IN BITS 2-17 THE CONCATENATED FORM OF THE FIRST THREE / CHARACTERS OF THE NAME. BITS 0-1 CONTAIN THE NUMBER OF CHARACTERS TO / BE EXAMINED AGAINST THE FIRST SECONDARY IDENTIFICATION TABLE. / THE SECOND WORD CONTAINS IN BITS 3-17 THE ADDRESS OF THE CORRESPONDING / STATEMENT PROCESSING ROUTINE. BITS 0-2 CONTAIN A NUMBER INDICATING / THE PRESCRIBED ORDER OF APPEARANCE FOR THE STATEMENT. / PIDTB0 .DSA .+1 .DSA 615555 /DOU .DSA 100000+DBLPRC /DOUBLE PRECESION .IFUND %F2 .DSA 620775 /EQU .DSA 400000+EQUIVA /EQUIVALENCE .ENDC .DSA 675012 /SUB .DSA 000000+SUBROU /SUBROUTINE .DSA 615165 /DIM .DSA 200000+DIMENS /DIMENSION .DSA 607157 /BLO .DSA 000000+BLOCKD /BLOCK DATA .DSA 606253 /BAC .DSA 700000+BACKSP /BACKSPACE .IFUND %F2 .DSA 621424 /EXT .DSA 400000+EXTERN /EXTERNAL .ENDC .DSA 612446 /CON .DSA 700000+CONTIN /CONTINUE FUNMNE .DSA 624326 /FUN .DSA 000000+FUNCTI /FUNCTION .DSA 635204 /INT .DSA 100000+INTEGE /INTEGER .DSA 646537 /LOG .DSA 100000+LOGICA /LOGICAL .DSA 612445 /COM .DSA 300000+COMMON /COMMON .DSA 670534 /RET RETADR .DSA 700000+RETURN /RETURN .DSA 623752 /FOR FMTADR .DSA 700000+FORMAT /FORMAT .IFUND %F2 .DSA 604513 /ASS .DSA 700000+ASSIGN /ASSIGN .ENDC .DSA 670537 /REW .DSA 700000+REWIND /REWIND .DSA 511231 /WRI .DSA 700000+WRITE /WRITE .DSA 462075 /PAU PAUSAD .DSA 700000+PAUSE /PAUSE .DSA 211364 /CAL CALLAD .DSA 700000+CALL /CALL .DSA 214474 /DAT DATAAD .DSA 500000+DATA /DATA .DSA 274757 /STO STOPAD .DSA 700000+STOP /STOP .DSA 227054 /GOT GOTOAD .DSA 700000+GOTO /GOTO IFMNE .DSA 034522 /IF( IFADDR .DSA 700000+IF /IF PIDTBX .DSA PIDTBX ENDMNE .DSA 020564 /END ILEMNE .DSA 035045 /ILE ENDFAD .DSA 700000+ENDFIL /ENDFILE REAMNE .DSA 070511 /REA REALAD .DSA 100000+REAL /REAL READAD .DSA 700000+READ /READ DOMNE .DSA 000257 /DO DOADDR .DSA 700000+DO /DO .EJECT / SECONDARY STATEMENT IDENTIFICATION TABLES / CTRL90 .DSA .+1 .DSA SIDTB1 /FIRST SECONDARY TABLE..CHARACTERS 04-06 .DSA SIDTB2 /SECOND SECONDARY TABLE.CHARACTERS 07-09 .DSA SIDTB3 /THIRD SECONDARY TABLE..CHARACTERS 10-12 .DSA SIDTB4 /FOURTH SECONDARY TABLE.CHARACTERS 13-15 SIDTBX .DSA SIDTBX /TERMINAL ADDR SECONDARY REFERENCE TABLE / / A SECONDARY TABLE ENTRY CONTAINS IN BITS 2-17 THE CONCATENATED FORM / OF CHARACTERS N THRU N+2 OF THE NAME AND IN BITS 0-1 THE NUMBER OF / CHARACTERS TO BE EXAMINED IN THE FOLLOWING TABLE. / SIDTB1 .DSA 607145 /BLE DOUBLE PRECISION .IFUND %F2 .DSA 635661 /IVA EQUIVALENCE .ENDC .DSA 671355 /ROU SUBROUTINE .DSA 620603 /ENS DIMENSION .DSA 612174 /CKD BLOCK DATA .DSA 643710 /KSP BACKSPACE .IFUND %F2 .DSA 421036 /ERN EXTERNAL .ENDC .DSA 477166 /TIN CONTINUE CTIMNE .DSA 412751 /CTI FUNCTION .DSA 220135 /EGE INTEGER .DSA 234271 /ICA LOGICAL .DSA 051646 /MON COMMON .DSA 103036 /URN RETURN .DSA 050574 /MAT FORMAT .IFUND %F2 .DSA 034546 /IGN ASSIGN .ENDC .DSA 035164 /IND REWIND .DSA 001445 /TE WRITE .DSA 001375 /SE PAUSE C00012 .DSA 000014 /L CALL C00001 .DSA 000001 /A DATA C00016 .DSA 000020 /P STOP C00015 .DSA 000017 /O GOTO / SIDTB2 .DSA 663325 /PRE DOUBLE PRECISION .IFUND %F2 .DSA 445726 /LEN EQUIVALENCE .ENDC .DSA 277166 /TIN SUBROUTINE .DSA 035246 /ION DIMENSION .DSA 004541 /ATA BLOCK DATA .DSA 003275 /ACE BACKSPACE .IFUND %F2 .DSA 000064 /AL EXTERNAL .ENDC .DSA 001515 /UE CONTINUE ONMNE .DSA 001146 /ON FUNCTION C00018 .DSA 000022 /R INTEGER .DSA 000014 /L LOGICAL / SIDTB3 .DSA 612073 /CIS DOUBLE PRECESION .IFUND %F2 .DSA 000175 /CE EQUIVALENCE .ENDC C00005 .DSA 000005 /E SUBROUTINE / SIDTB4 .DSA 035246 /ION DOUBLE PRECESION .EJECT / SUBROUTINE TO CONCATENATE N NON-BLANK CHARACTERS / CALLING SEQUENCE... / LAC N /N IS CONTAINED IN BITS 0 AND 1 / JMS CTRL50 / CTRL50 CAL 0 DZM NAME2 RCR CTRL52 DAC NAME1 DAC CTRLSW SNA JMP CTRL51 LAC LOGIF SZA DZM CTRLSW CTRL54 JMS FETCHR JMP CTRL53 CTRL51 LAC NAME2 /WHEN FINISHED, THE CONCATENATED JMP* CTRL50 /CHARACTERS ARE RETURNED TO THE CALLING PROGRAM CTRL53 SAD C00011 JMP CTRL54 /ONLY NON-BLANK CHARACTERS FROM THIS IMAGE JMS CAT /ARE CONCATENATED. LAC NAME1 TAD Z00000 / N-1 TO N (ALSO TO SWITCH WHICH ALLOWS JMP CTRL52 / IMAGE CONTINUATION) .EJECT / SUBROUTINE TO TEST FOR STATEMENT TERMINATION CHARACTER / CALLING SEQUENCE... / JMS CTRL60 / JMP NO / XXX YES / CTRL60 CAL 0 LAC XCHAR /THE LAST CHARACTER FETCHED IS EXAMINED SAD C00013 /TO DETERMINE IF IT IS A CARRIAGE RETURN ISZ CTRL60 /CHARACTER (LINE TERMINATION CHARACTER). JMP* CTRL60 .EJECT / SUBROUTINE TO DETERMINE IF STATEMENT IS ERRONEOUSLY LABELED / CALLING SEQUENCE... / JMS CTRL70 / CTRL70 CAL 0 LAC LABEL SNA /NO ACTION IS TAKEN IF THE STATEMENT IS JMP* CTRL70 /NOT LABELED. / LAW 16340 / JMS ERROR1 /A RECOVERABLE ERROR IS ANNOUNCED IF THE ER02N ERR <' 02N'>,16340 LAC V77777 /STATEMENT IS LABELED. DAC* LABEL /THE STATEMENT NUMBER IS FLAGGED AS BEING DZM LABEL /PERMANENTLY UNDEFINEABLE AND THE NO-LABEL JMP* CTRL70 /FLAG IS INDICATED FOR THE STATEMENT. .EJECT / SUBROUTINE TO ANNOUNCE AN ERROR WHEN A BLOCK DATA SUBPROGRAM CONTAINS / EXECUTABLE STATEMENTS / CALLING SEQUENCE... / JMS CTRL80 / CTRL80 CAL 0 /NO ACTION IS TAKEN WHEN THE CURRENT LAC FCNFLG /SOURCE PROGRAM IS NOT A BLOCK DATA / SAD K00001 /SUBPROGRAM. / JMP EI /ERROR: BLOCK DATA SUBPROGRAM CONTAINS ER04I ERN <' 04I'>,,EI JMP* CTRL80 /EXECUTABLE STATEMENTS. .EJECT .IFUND %F2 / EXTERNAL STATEMENT PROCESSOR / EXTERN JMS CTRL80 /EXTERNAL CANNOT APPEAR IN BLOCK DATA SUBR. EXTE03 JMS FVARGO /THE EXTERNAL STATEMENT IS USED TO DECLARE JMS SYMTYP /THE NAMES OF EXTERNAL FUNCTIONS WHICH XOR C00000 /WILL APPEAR AS FUNCTION PARAMETERS WITHOUT .IFUND ERMSG ER01E JMP EE /PARAMETER LISTS SO THAT THEY MAY BE .ENDC .IFDEF ERMSG ER01E ERS <' 01E'>,SKP,EE .ENDC LAC* SYMTBC /DISTINGUISHED FROM SIMPLE VARIABLES. / SPA / JMP EE /THE VARIABLE NAMES LISTED CANNOT ER02E ERN <' 02E'>,SPA,EE XOR U00000 /REPRESENT... DAC* SYMTBC / (1) ALREADY DECLARED FUNCTION NAMES LAC OPVALU / (2) DUMMY VARIABLES SAD C00030 / (3) VARIABLES ASSIGNED TO A COMMON BLOCK JMP EXTE03 / (4) ARRAYS LAC SORDER DAC TORDER JMP CRTEST .ENDC .EJECT / LOGICAL STATEMENT PROCESSOR / LOGICA TAD S20000 /MODE IS INDICATED BY 3 / / DOUBLE PRECESION STATEMENT PROCESSOR / DBLPRC TAD S20000 /MODE IS INDICATED BY 2 / / REAL STATEMENT PROCESSOR / REAL TAD S20000 /MODE IS INDICATED BY 1 / / INTEGER STATEMENT PROCESSOR (AND THE OTHER MODE SETTING STATEMENTS) / INTEGE DAC MODE /MODE IS INDICATED BY 0 JMS SIN530 /SAVE POSITION IN SOURCE IMAGE. LAC Y00000 /THE WORDS LOGICAL, DOUBLE PRECESION, JMS CTRL50 /REAL OR INTEGER MAY OR MAY NOT IDENTIFY XOR Y00000 SAD FUNMNE /THE STATEMENTS BY THE SAME NAMES. SKP /IF THE FIRST WORD FOLLOWING ANY ONE OF JMP INTG02 /THESE WORDS IS THE WORD FUNCTION, THE LAC Y00000 /STATEMENT IS ASSUMED TO BE AN EXPLICITLY JMS CTRL50 /MODE TYPED FUNCTION STATEMENT. XOR W00000 SAD CTIMNE /THE GENERAL FORM OF THE STATEMENT IS.... SKP / T FUNCTION NAME(ARG1,ARG2,..,ARGN) JMP INTG02 /WHERE T IS LOGICAL, DOUBLE PRECESION, LAC W00000 /REAL OR INTEGER. JMS CTRL50 SAD ONMNE JMP TFUNCT /THE MODE-TYPING STATEMENTS ARE INTG02 JMS SIN540 /PROCESSED BY THE DIMENSION STATEMENT. XCT PASS /SPECIFICATION STATEMENTS ARE NOT JMP CONTRL /PROCESSED DURING PASS 2. LAC MODE JMS SETN XOR MODE DAC MODE /SET NEW NUMBER OF WORDS PER ELEMENT .EJECT / DIMENSION STATEMENT PROCESSOR / DIMENS JMS FVARGO /ONLY VARIABLES MAY BE SPECIFIED AS NAMES LAC TORDER /OF DATA STORAGE, ARRAYS, OR FUNCTIONS. SAD T00000 JMP DIMN01 /THE CURRENT STATEMENT ORDER NUMBER IS LAC* SYMTW6 /EXAMINED TO DETERMINE IF THE STATEMENT /IS A DIMENSION OR ONE OF THE SPECIFICATION / SPA /STATEMENTS. THE NAMES ON SPECIFICATION / JMP EV /ERROR: NAME EXPLICITY MODE-TYPED ALREADY. ER01V ERN <' 01V'>,SPA,EV LAC W00000 /THE EXPLICITLY MODE-TYPED FLAG IS SET SO DAC* SYMTW6 /THAT AN ERROR CAN BE ANNOUNCED IF THE LAC* SYMTBC /NAME SHOWS UP ON ANOTHER SPECIFICATION AND Z00000 /STATEMENT. THE IMPLICIT MODE OF THE NAME XOR MODE /(BASED ON THE FIRST CHARACTER OF THE DAC* SYMTBC /NAME) IS OVER-RIDDEN AND THE EXPLICIT LAC OPVALU /MODE SET (BASED ON THE NAME OF THE SAD C00027 /STATEMENT). EITHER SIMPLE VARIABLES OR JMP DIMN03 /ARRAY DECLARATIONS MAY APPEAR ON A DIMN05 SAD C00030 /SPECIFICATION STATEMENT. COMMAS ARE USED JMP DIMENS /TO SEPARATE THE DECLARATIONS. /CRTEST JMS CTRL60 /THE ONLY OTHER DELIMITER ALLOWED IS THE / /STATEMENT TERMINATION CHARACTER (C/R). / JMP EX /ERROR:IMPROPER DELIMITER USED. ER01X=. CRTEST ERN <' 01X'>,,EX JMP STEXIT DIMN01 LAC OPVALU /DIMENSION STATEMENTS MAY CONTAIN ONLY / SAD C00027 /ARRAY DECLARATIONS. / JMP DIMN03 / JMP EC /ERROR: DIMENSION STMT CONTAINS ILLEGAL ARRAY. ER01C ERS <' 01C'>,,EC DIMN03 JMS FEDIMN /THE ARRAY DIMENSIONS ARE OBTAINED AND JMP DIMN05 /ENTERED INTO THE SYMBOL TABLE. .EJECT / COMMON STATEMENT PROCESSOR / COMMON JMS COMN50 /LABELED COMMON IS INDICATED BY ENCLOSING JMP COMN01 /THE LABELING NAME IN SLASHES. THE ABSENCE COMN03 LAC BLANKC /OF SLASHES INDICATES BLANK COMMON. DAC NAME1 /BLANK COMMON IS TREATED IN THE SAME JMS SYMBSE /MANNER AS LABELED COMMON AND SO THE JMP COMN02 /COMPILER ASSIGNS A LABEL TO BLANK COMMON. COMN01 JMS COMN50 /TWO SLASHES WITH NO NAME BETWEEN THEM JMP COMN03 /ALSO INDICATE BLANK COMMON. JMS FVARGO / SAD C00018 / JMP COMN02 / JMP EC /ERROR: SLASH DOES NOT DELIMIT BLOCK NAME. ER02C ERS <' 02C'>,,EC COMN02 LAC NAME1 SNA /IF THE DECLARED NAME OF THIS BLOCK HAS JMP COMN04 /BEEN ENTERED INTO THE SYMBOL TABLE LAC* SYMTBC /PREVIOUSLY, IT MUST HAVE BEEN USED ONLY / SAD K00001 /AS A COMMON BLOCK NAME. / SKP / JMP EC /ERROR: DECLARED BLOCK NAME PREVIOUSLY ER03C ERS <' 03C'>,,EC LAC* SYMTW3 /DECLARED AS SOMETHING ELSE. SNA JMP COMN04 JMS TSETAD /SOMETHING ELSE. LAC* TSMTW4 JMS NTHSYM /CHAIN THE CURRENT BLOCK TO LAC SYMTW4 /THE EXISTING BLOCK. DAC LSTVAR JMP COMN09 COMN04 LAW -1 /WHEN THE NAME IS FIRST DAC* SYMTBC /ENTERED IT IS FLAGGED AS A COMMON BLOCK DZM* SYMTW3 /LABEL AND THE BLOCK SIZE IS RESET TO ZERO JMS TSETAD COMN09 JMS FVARGO JMS SYMTYP /THE NAMES OF THE DATA WORDS (ARRAYS) XOR C00000 /ASSIGNED TO THE COMMON BLOCK MUST .IFUND ERMSG /INITIALLY REPRESENT NON-COMMON VARIABLES. ER04C JMP EC /ERROR: DECLARED VARIABLE IS A DUMMY,FUNCTION, .ENDC .IFDEF ERMSG ER04C ERS <' 04C'>,SKP,EC .ENDC LAC OPVALU /OR ALREADY DECLARED TO BE IN COMMON. SAD C00027 /ARRAY DECLARATIONS ARE LEGAL ON COMMON JMS FEDIMN /STATEMENTS. LAC* TSMTW3 /VARIABLES IN COMMON ARE ASSIGNED RELATIVE DAC* SYMTW3 /POSITIONS IN COMMON IN THE ORDER OF THEIR SZA /APPEARANCE. THE FIRST MEMBER OF THE BLOCK JMP COMN07 /IS INDICATED BY A ZERO BLOCK. IT IS SET LAC CHRCTR /AS BOTH THE FIRST AND LAST MEMBERS OF THE DAC* TSMTW4 /BLOCK LAC SYMTW4 DAC LSTVAR COMN07 LAC* SYMTBC /THE SIZE OF THIS VARIABLE (OR ARRAY) IS AND S17777 /ADDED TO THE EXISTING SIZE OF THE COMMON TAD* TSMTW3 /BLOCK TO WHICH IT IS ASSIGNED DAC* TSMTW3 JMS CHAIN /THE NARIABLE (ARRAY) IS ADDED TO THE LIST LAC* SYMTBC /OF VARIABLES ASSIGNED TO THIS COMMON XOR T00000 /BLOCK. DAC* SYMTBC /THE VARIABLE (ARRAY) IS FLAGGED AS A LAC OPVALU /COMMON VARIABLE (ARRAY). SAD C00030 /NAMES BELONGING TO THE SAME COMMON BLOCK JMP COMN09 /ARE SEPARATED BY COMMAS. A NEW COMMON SAD C00018 /BLOCK IS DECLARED WHEN THE LIST OF NAMES JMP COMN01 /IS DELIMITED BY A SLASH. IF NEITHER OF JMP CRTEST /THESE DELIMITERS APPEAR, FINI. .EJECT .IFUND %F2 / EQUIVALENCE STATEMENT PROCESSOR / EQUIVA JMS FNBCHR /EQUIVALENCE CLASSES ARE WRITTEN AS LISTS / SAD S00050 /OF SIMPLE VARIABLES OR SUBSCRIPTED / SKP /VARIABLES ENCLOSED IN PARENTHESIS. / JMP EC /ERROR: NEW CLASS NOT STARTED WITH LEFT PAREN. ER05C ERS <' 05C'>,,EC DZM FSTVAR /THE FIRST CLASS MEMBER FLAG IS INITIALIZED EQUI07 JMS FVORAR /AND A CLASS MEMBER IS OBTAINED. LAC T0 /THE SUBSCRIPT VALUE OF THE VARIABLE IS THE / /VARIABLES POSITION IN THE ARRAY (SIMPLE DAC SUBVAL /VARIABLES ARE TREATED AS 1-DIMENSIONAL LAC FSTVAR /ARRAYS) PLUS THE NUMBER OF MACHINE WORDS SZA /OCCUPIED BY A SINGLE ELEMENT OF THE ARRAY. JMP EQUI02 LAC OPVALU /THE EQUIVALENCE CLASS IS INITIALIZED UPON / SAD C00030 /ENCOUNTERING THE FIRST VARIABLE. / SKP /EQUI20 JMP EC /ERROR: ONLY 1 CLASS MEMBER INDICATED. ER06C ERS <' 06C'>,,EC DZM OLDCLS DZM COMCLS /INITIALLY, THE CLASS IS SET UP AS A NEW LAC CHRCTR /CLASS WITH NO MEMBERS IN ANY COMMON BLOCK. DAC HEDCLS /THE CURRENT VARIABLE IS NAMED BOTH THE LAC SYMTW4 /HEAD OF THE EQUIVALENCE CLASS AND THE DAC LSTVAR /LAST MEMBER ADDED TO THE CLASS. AS THE LAC SUBVAL /HEAD OF THE CLASS, IT IS ASSIGNED THE DAC SUBADJ /RELATIVE ADDRESS ZERO AND ITS SUBSCRIPT EQUI02 LAC SUBVAL /VALUE IS USED AS THE ADJUSTMENT FACTOR TO JMS TWOCMA /LINE-UP THE RELATIVE ADDRESSES OF THE TAD SUBADJ /OTHER MEMBERS WITH RESPECT TO ZERO. DAC RELADR JMS SYMTYP /A VARIABLE WHICH HAS NOT BEEN ASSIGNED TO XOR T00000 /AN EQUIVALENCE CLASS MAY BE ASSIGNED TO JMP EQUI04 /A COMMON BLOCK. WHEN AN EQUIVALENCE CLASS LAC COMCLS /MEMBER BELONGS TO A COMMON BLOCK, THE / SZA /ENTIRE CLASS IS ASSIGNED TO THE COMMON / JMP EQUI20 /BLOCK. BECAUSE ENTITIES IN COMMON ARE ER07C ERN <' 07C'>,SZA,EC /ASSIGNED UNIQUE STORAGE, ERROR:CURRENT CLASS ALREADY LAC C00001 /BEEN MERGED INTO A COMMON BLOCK. A COMMON DAC COMCLS /BLOCK IS A SPECIAL CASE EQUIVALENCE CLASS. DAC OLDCLS .IFUND EQUIV JMP EQUI04+3 EQUI04 LAC* SYMTW4 /A VARIABLE WHICH HAS NOT BEEN ASSIGNED TO SAD CHRCTR /AN EQUIVALENCE CLASS OR IS THE ONLY JMP EQUI05 /MEMBER IN THE CLASS WILL HAVE ITS OWN LAC RELADR /ADDRESS AS ITS CLASS MEMBER LINKAGE ADDR. .ENDC .IFDEF EQUIV EQUI01 LAC RELADR .ENDC JMS TWOCMA TAD* SYMTW3 /WHEN THE CURRENT VARIABLE IS A MEMBER OF DAC DIFF /TWO UNIQUE CLASSES (THE CURRENT CLASS AND TAD SUBADJ /A PREVIOUS CLASS), THE TWO CLASSES ARE DAC SUBADJ /MERGED TOGETHER INTO ONE CLASS. LAC FSTVAR /WHEN THE CURRENT VARIABLE IS THE ONLY SZA /MEMBER OF THE CURRENT CLASS, THE PREVIOUS JMP EQUI06 /CLASS IS NAMED THE CURRENT CLASS WITH THE LAC* SYMTW4 /VARIABLE NAMED BY THE CURRENT VARIABLES DAC HEDCLS /LINKAGE ADDRESS NAME THE HEAD OF THE DAC OLDCLS /CURRENT CLASS. FLAGS ARE SET TO INDICATE DAC FSTVAR /THAT A NEW CLASS HAS NOT BEEN CREATED AND JMP EQUI07 /THAT THE CLASS CONTAINS MORE THAN ONE .IFDEF EQUIV EQUI04 LAC* SYMTW4 SAD CHRCTR JMP EQUI05 LAC COMCLS SNA JMP EQUI01 LAC CHRCTR DAC FSTVAR LAC* SYMTW3 JMS TWOCMA TAD RELADR DAC DIFF SKP EQUI16 JMS NTHSYM JMS EQUI15 LAC* SYMTW4 SAD FSTVAR JMP EQUI17 JMP EQUI16 .ENDC EQUI06 JMS TSETAD /MEMBER. LAC HEDCLS /THE PREVIOUS AND CURRENT CLASSES ARE EQUI12 JMS NTHSYM /MERGED WHEN THE CURRENT CLASS CONTAINS / /MORE THAN ONE MEMBER. THE PREVIOUS CLASS .IFUND EQUIV LAC* SYMTW3 /IS LEGT ALONE AND THE RELATIVE ADDRESSES TAD DIFF /OF THE CURRENT CLASS MEMBERS ARE ADJUSTED DAC* SYMTW3 /TO LINE-UP WITH THE PREVIOUS CLASS MAMBERS LAC COMCLS /THE ADJUSTMENT FACTOR IS THE DIFFERENCE SNA /BETWEEN THE RELATIVE ADDRESSES ASSIGNED JMP EQUI08 /TO THE CURRENT VARIABLE IN BOTH CLASSES. LAC* SYMTW3 /THIS DIFFERENCE IS ALSO ADDED TO THE / SPA /SUBSCRIPT ADJUSTMENT FACTOR SO THAT FUTURE / JMP EC /MEMBERS MAY BE PROPERLY LINED-UP. SMA JMP .+4 ER08C ERR <' 08C'>,16060 DZM* SYMTW3 / /AN ERROR IS ANNOUNCED IF THE RELATIVE / /ADDRESS OF A VARIABLE ASSIGNED TO A COMMON LAC* SYMTBC /BLOCK UNDERFLOWS THE BLOCK BASE ADDRESS AND Y77777 XOR T00000 /OF ZERO. WHEN THE PREVIOUS CLASS IS A DAC* SYMTBC /COMMON BLOCK, THE MEMBERS OF THE CURRENT .ENDC .IFDEF EQUIV JMS EQUI15 .ENDC EQUI08 LAC* SYMTW4 /CALSS ARE FLAGGED AS VARIABLES IN COMMON SAD TRELAD /ALL RELATIVE ADDRESSES HAVE BEEN ADJUSTED JMP EQUI11 /WHEN THE LINKAGE ADDRESS POINTS TO THE SAD HEDCLS /HEAD OF THE CLASS. JMP EQUI10 /THE CURRENT VARIABLE WILL ALREADY BE A JMP EQUI12 /MEMBER OF THE CURRENT CLASS IF THE TWO .IFDEF EQUIV EQUI15 0 LAC* SYMTW3 TAD DIFF DAC* SYMTW3 LAC COMCLS SNA JMP EQUI08 LAC* SYMTW3 SMA JMP .+4 / LAW 16060 /C ERROR - RELATIVE ADDRESS UNDERFLOWS BLOCK BASE ADDRESS / JMS ERROR1 ER08C ERR <' 08C'>,16060 DZM* SYMTW3 LAC* SYMTBC AND Y77777 XOR T00000 DAC* SYMTBC JMP* EQUI15 .ENDC EQUI11 LAC DIFF /CLASSES HAVE TWO OR MORE MEMBERS IN COMMON / SZA /IF SO, THE RELATIVE ADDRESS OF THE CURRENT / JMP EQUI20 /VARIABLE HAS ALREADY BEEN ADJUSTED (WHEN ER09C ERN <' 09C'>,SZA,EC / /THE OTHER VARIABLE COMMON TO BOTH CAUSED / /A MERGE). THEREFORE, AN ERROR IS ANNOUNCED EQUI10 LAC TRELAD /IF THE CURRENT ADDRESS DIFFERENCE IS NOT / /ZERO (THE RELATIONSHIP BETWEEN THE TWO DAC OLDCLS /VARIABLES IN BOTH CLASSES IS NOT THE SAME) JMS NTHSYM /A FLAG IS SET TO INDICATE THE DISOLVMENT JMP EQUI17 /OF THE CURRENT CLASS. EQUI05 LAC COMCLS SNA /A VARIABLE WHICH IS NOT PRESENTLY JMP EQUI18 /ASSOCIATED WITH ANY OTHER VARIABLES IN AN LAC RELADR /EQUIVALENCE CLASS OR COMMON BLOCK IS / SPA /SIMPLY ADDED TO THE CURRENT CLASS. / JMP EC /ERROR: RELATIVE ADDRESS OF A VARIABLE ER10C ERN <' 10C'>,SPA,EC /ASSIGNED TO A COMMON BLOCK THROUGH AN /EQUIVALENCE RELATIONSHIP UNDERFLOWS EQUI19 LAC* SYMTBC AND Y77777 XOR T00000 /THE VARIABLE ASSIGNED TO A COMMON BLICK IS DAC* SYMTBC /TYPED AS A VARIABLE IN COMMON. EQUI18 LAC RELADR /THE VARIABLE'S RELATIVE ADDRESS IS ADDED TO DAC* SYMTW3 /ITS ENTRY IN THE SYMBOL TABLE. EQUI17 JMS CHAIN /THE CURRENT EQUIVALENCE CHAIN IS BROKEN LAC OPVALU /AND THE CURRENT VARIABLE INSERTED SAD C00030 JMP EQUI07 / SAD C00031 /EQUIVALENCE CLASS MEMBERS ARE SEPARATED / JMP EQUI13 /BY COMMAS. EQUIVALENCE CLASSES ARE / JMP EC /TERMINATED BY RIGHT PARENS. ERROR: NO COMMA OR ). ER11C ERS <' 11C'>,,EC EQUI13 LAC OLDCLS SZA JMP EQUI14 /A NEW ENTRY IS MADE INTO THE LIST OF LAC EQUCLS /UNIQUE EQUIVALENCE CLASSED IS THE CURRENT TAD C00001 /CLASS WAS NOT MERGED INTO A PREVIOUS / SAD EQCLSX /CLASS OR COMMON BLOCK. / JMP EM /ERROR: EQUIVALENCE CLASS LIST FULL. ER01M ERN <' 01M'>,,EM DAC EQUCLS /THE ADDRESS OF THE SYMBOL TABLE ENTRY OF LAC HEDCLS /THE HEAD OF THE CLASS IS ENTERED INTO THE DAC* EQUCLS /LIST OF EQUIVALENCE CLASSES. EQUI14 JMS FNBCHR SAD S00054 /ANOTHER EQUIVALENCE CLASS IS INDICATED IF JMP EQUIVA /THE LAST CLASS IS DELIMITED BY A COMMA. JMP CRTEST /OTHERWISE PROCESSING IS FINISHED. .ENDC .EJECT / SUBROUTINE TO CLEAN-UP DATA STORAGE ASSIGNMENTS / CALLING SEQUENCE... / JMS CLENUP / CLENUP CAL 0 /DATA STORAGE LOCATIONS ARE ASSIGNED AFTER CLEN01 SKP /ALL TYPE-SPECIFICATION, ARRAY DECLARATION, JMP* CLENUP /COMMON DECLARATION AND EQUIVALENCE LAC U40000 DAC SORDER XCT PASS /RELATION STATEMENTS HAVE BEEN PROCESSED. JMP CLEN02 /THE ASSIGNMENTS ARE MAKE DURING PASS 1 LAC PC /AND THE BINARY INFORMATION IS OUTPUT DAC START /DURING PASS 2. .IFDEF %F2 DZM EQUSTR .ENDC .IFUND %F2 DAC EQUSTR /THE AMOUNT OF NON-COMMON EQUIVALENCED LAC EQUCLS /MEMORY IS INITIALLY SET TO ZERO. CLEN10 SAD OP0 JMP CLEN03 /MEMORY ALSO ASSIGNED AT THIS TIME IS USED LAC* EQUCLS /FOR ARRAY DESCRIPTION WORDS, NON-COMMON JMS NTHSYM /ARRAY STORAGE, AND TRANSFER VECTORS FOR LAC* SYMTW4 /SIMPLE VARIABLES IN COMMON. SPA JMP CLEN04 /EACH EQUIVALENCE CLASS IS EXAMINED BEFORE JMS SYMTYP /IT IS ADDED TO THE NON-COMMON STORAGE XOR C00000 /AREA. IF A CLASS HAS ALREADY BEEN ASSIGNED JMP CLEN04 /TO THE STORAGE AREA (BY VIRTUE OF THE DZM LOWRAD /CLASS BEING REDUNDANTLY IN THE LIST TWICE CLEN07 LAC* SYMTW3 /DUE TO A DOUBLE MERGE) OR IF THE CLASS IS JMS TWOCMA /REALLY A COMMON BLOCK, IT IS BY-PASSED. TAD LOWRAD SPA /WHEN A CLASS HAS NOT BEEN ASSIGNED, THE JMP CLEN05 /MEMBER WITH THE LOWEST RELATIVE ADDRESS LAC* SYMTW3 /IS FOUND AND IS ASSIGNED THE PROGRAM DAC LOWRAD /COUNTER AS ITS TRUE ADDRESS. CLEN05 LAC* SYMTW4 SAD* EQUCLS /RELATIVE ADDRESSES MAY BE NEGATIVE AS JMP CLEN06 /THEY REFLECT THE VARIABLES RELATIVE JMS NTHSYM /POSITION IN THE CLASS WITH RESPECT TO THE JMP CLEN07 /HEAD OF THE CLASS (RELATIVE ADDRESS=ZERO). CLEN06 JMS NTHSYM LAC LOWRAD /THE PROGRAM COUNTER IS ADJUSTED BY THE JMS TWOCMA /LOWEST RELATIVE ADDRESS OF THE CLASS. TAD PC /THIS RESULTANT VALUE IS USED TO ASSIGN DAC LOWRAD /LOCATIONS TO THE CLASS MEMBERS. CLEN09 LAC* SYMTW3 TAD LOWRAD /THE MEMBER WITH THE LOWEST RELATIVE DAC* SYMTW3 /ADDRESS WILLBE ASSIGNED THE CURRENT JMS CLEN60 /PROGRAM COUNTER. THE OTHER MEMBERS OF THE TAD PC /CLASS ARE ASSIGNED STORAGE LOCATIONS SMA /THAT ARE CONSISTANT WITH THEIR RELATIVE JMP CLEN08 /POSITIONS IN THE CLASS. DZM PC /THE PROGRAM COUNTER IS UPDATED IF ITS JMS INCRPC /COURRENT VALUE IS LESS THAN WHAT IT WOULD TAD TEMP0 /BE IF IT WAS UPDATED BY THE AMOUNT OF CLEN08 LAC* SYMTW4 /STORAGE OCCUPIED BY THIS MEMBER XOR W00000 /THE CURRENT MEMBER IS FLAGGED AS BEING DAC* SYMTW4 /ASSIGNED AND V77777 SAD* EQUCLS /ALL MEMBERS OF THIS CLASS HAVE BEEN JMP CLEN04 /ASSIGNED WHEN THE CURRENT MEMBERS LINKAGE JMS NTHSYM /ADDRESS POINTS TO THE HEAD OF THE CLASS JMP CLEN09 /(THE FIRST MEMBER ASSIGNED). CLEN04 LAC EQUCLS /THE EQUIVALENCE CLASS LIST ADDRESS IS TAD K00001 /UPDATED AND THE NEXT ENTRY IS EXAMINED DAC EQUCLS /TO DETERMINE IF ALL THE CLASSES HAVE BEEN JMP CLEN10 /ASSIGNED MEMORY LOCATIONS. CLEN03 LAC EQUSTR JMS TWOCMA /THE AMOUNT OF NON-COMMON DATA STORAGE TAD PC /REQUIRED BY THE EQUIVALENCE CLASSES IS DAC EQUSTR /DETERMINED BY SUBTRACTING THE STARTING .ENDC .IFDEF X4K LAC PASS2 /USE ROUTINE TO SEARCH COMPACTED SYMTAB DAC CLEN01 LAC SYMTB0 DAC SYMTBC /POINTER TO UNCOMPACTED SYMBOL TABLE CURRENT ENTRY SAD SYMTBN JMP CLEN02-2 DAC TCTR /POINTER TO NEXT AVAILABLE COMPACTED SYMBOL TABLE ENTRY CLEN14 JMS SETADR /THE SYMBOL TABLE IS COMPACTED AFTER ALL /NON-COMMON EQUIVALENCED STORAGE HAS BEEN ASSIGNED LAC K00001 SAD* SYMTBC JMP CLEN17 SAD FCNFLG SKP JMP CLEN16 JMS SYMTYP XOR C00000 JMP CLEN16 / LAW 16060 / JMS ERROR1 ER12C ERR <' 12C'>,16060 CLEN16 LAC* SYMTBC SPA JMP CLEN17 JMS SYMTYP XOR T00000 JMP CLEN18 CLEN17 LAC TCTR DAC SYMTW5 ISZ SYMTW6 CLEN20 LAC SYMTBC /TRANSFER OLD ENTRY TO ITS NEW POSITION SAD SYMTW6 JMP CLEN19 LAC* SYMTBC DAC* SYMTW5 ISZ SYMTBC ISZ SYMTW5 JMP CLEN20 CLEN18 JMS DEFNSM XOR* SYMTW3 JMP CLEN17 CLEN19 XCT SBSE51+1 /JMS SYMSAF WITH EXTRA 4K SAD SYMTBN JMP CLEN11 DAC EXPTMP LAC TCTR DAC SYMTBC JMS SETADR JMS SBSE50 DAC TCTR /MOVE OVER LAST ENTRY PROCESSED LAC EXPTMP DAC SYMTBC JMP CLEN14 CLEN11 LAC TCTR /FIND THE NEW END OF SYMTAB POINTER DAC SYMTBC JMS SETADR JMS SBSE50 DAC SYMTBN .ENDC .IFUND X4K LAC SYMTB0 /PROGRAM COUNTER FROM THE ENDING PROGRAM CLEN14 DAC SYMTBC /COUNTER (BEFORE AND AFTER ASSIGNMENT). SAD SYMTBN JMP CLEN02-2 /THE SYMBOL TABLE IS COMPACTED AFTER ALL JMS SETADR /NON-COMMON EQUIVALENCED STORAGE HAS BEEN LAC K00001 /ASSIGNED. SAD* SYMTBC JMP CLEN12 /ENTRIES FOR COMMON BLOCK NAMES ARE SAD FCNFLG /REDUCED TO FOUR (OR FIVE) WORDS. SKP JMP CLEN16 JMS SYMTYP /ALL SYMBOL TABLE ENTRIES ARE EXAMINED IN XOR C00000 /A BLOCK DATA SUBPROGRAM. JMP CLEN16 / LAW 16060 /AN ERROR IS ANNOUNCED IF NON-COMMON DATA / JMS ERROR1 /STORAGE IS DECLARED IN A BLOCK DATA ER12C ERR <' 12C'>,16060 CLEN16 LAC* SYMTBC /SUBPROGRAM. SPA JMP CLEN17 /ENTRIES FOR SIMPLE VARIABLES IN COMMON JMS SYMTYP /ARE REDUCED TO FOUR (OR FIVE) WORDS. XOR T00000 JMP CLEN18 /ENTRIES FOR NON-COMMON SIMPLE VARIABLES, CLEN12 LAC SYMTW5 /FUNCTION NAMES, SIMPLE DUMMY VARIABLES, JMP CLEN19 /AND STATEMENT NUMBERS ARE REDUCED TO CLEN18 JMS DEFNSM /TWO (OR THREE) WORDS. XOR* SYMTW3 /THE SYMBOL IS DEFINED OR SET UNDEFINED LAC SYMTW3 /ACCORDINGLY. CLEN19 DAC SYMTBC DAC TCTR CLEN11 LAC SYMTW6 /THE TABLE IS COMPACTED BY REMOVING THE TAD C00001 /UNUSED WORDS OF THE CURRENT ENTRY AND DAC SYMTW6 /PUSHING THE SUBSEQUENT ENTRIES UP INTO SAD SYMTBN /THE UNUSED WORDS (THE TABLE IS LAID OUT JMP CLEN20 /BEGINING IN LOW MEMORY AND ENDING IN HIGH LAC* SYMTW6 /MEMORY). DAC* TCTR ISZ TCTR JMP CLEN11 CLEN20 LAC TCTR /THE NEXT AVAILABLE ENTRY ADDRESS IS DAC SYMTBN /UPDATED BY THE NUMBER OF WORDS REMOVED LAC SYMTBC /FROM THIS ENTRY. JMP CLEN14 CLEN17 LAC SYMTW6 /ALL SIX (OR SEVEN) WORDS ARE RETAINED FOR TAD C00001 /ARRAY NAME AND STATEMENT FUNCTION NAME JMP CLEN14 /ENTRIES. .ENDC LAC START DAC PC CLEN02 DZM LOWRAD /THE AMOUNT OF STORAGE REQUIRED FOR THE LAC PASS2 DAC CLEN01 LAC FILE1 /OUTPUT FILE NAME JMS BINOUT XOR C00007 LAC FILE2 JMS BINOUT XOR C00008 LAC W00000 JMS BINOUT XOR C00019 LAC EQUSTR /MEMBERS OF THE NON-COMMON EQUIVALENCE SZA /IGNORE ZERO BLOCK JMS BINOUT /CLASSES IS OUTPUT AS ONE BLOCK OF XOR C00006 /UNINITIALIZED MEMORY. LAC PROCAD DAC START LAW -1 DAC PROCAD LAC SYMTB0 CLEN25 DAC SYMTBC /ARRAY DESCRIPTION BLOCKS AND TRANSFER SAD SYMTBN /VECTORS FOR SIMPLE VARIABLES ASSIGNED TO JMP CLEN22 /COMMON ARE OUTPUT NEXT. JMS SETADR /THE ORDER OF OUTPUT WILL FOLLOW THE ORDER LAC* SYMTBC /OF THE SYMBOL TABLE EXCEPT FOR VARIABLES SAD K00001 /ASSIGNED TO COMMON. VARIABLES ASSIGNED JMP CLEN23 /TO A COMMON BLOCK ARE OUTPUT AS A UNIT. RCL SNL JMP CLEN13 SPA JMP CLEN24 /DESCRIPTION WORDS ARE NOT OUTPUT FOR A LAC FCNFLG /BLOCK DATA SUBPROGRAM. SAD K00001 JMP CLEN26 /SIMPLE VARIABLES NOT ASSIGNED TO COMMON JMS SYMTYP /AND TRANSFER VECTORS FOR DECLARED XOR C00000 /EXTERNAL REFERENCES ARE NOT ASSIGNED AT JMP CLEN26 /THIS TIME. LAC* SYMTW3 SAD S17777 /NON-COMMON ARRAYS WHICH WERE NOT INCLUDED JMP CLEN27 /IN ANY EQUIVALENCE CLASS ARE ASSIGNED JMP CLEN28 /MEMORY LOCATIONS AT THIS TIME. CLEN27 LAC PC XCT PASS /THE CURRENT SETTING OF THE PROGRAM DAC* SYMTW3 /COUNTER BECOMES THE RELATIVE ADDRESS OF LAC* SYMTBC /THE ARRAY. AND S17777 JMS BINOUT /THE ARRAY IS OUTPUT AS A BLOCK OF NON- XOR C00006 /COMMON STORAGE. CLEN28 JMS CLEN50 JMS VECTOR /DESCRIPTION WORDS FOR NON-COMMON ARRAYS CLEN26 LAC SYMTW6 /ARE OUTPUT AS THEY ARE ENCOUNTERED IN THE CLEN34 TAD C00001 /SYMBOL TABLE. .IFDEF X4K XCT SBSE51+1 .ENDC JMP CLEN25 CLEN24 RCL SPA JMP CLEN26 CLEN13 LAC SYMTW3 JMP CLEN34+1 CLEN23 JMS TSETAD LAC* SYMTW3 /A BLOCK SIZE OF ZERO INDICATES SNA / AN EMPTY COMMON BLOCK (NO MEMBERS). JMP CLEN22-2 / USUALLY THE RESULT OF ERRS IN COMN STMNTS. JMS OSYMBL XCT PASS /DO NOT EXECUTE BLOCK JMP CLEN32 /SIZE CALCULATION PASS2 DZM* TSMTW3 LAC* TSMTW4 CLEN33 JMS NTHSYM JMS CLEN60 /THE COMMON BLOCK SIZE IS RE-CALCULATED TAD* TSMTW3 /BECAUSE IT MAY HAVE BEEN LENGTHENED DUE SMA /TO EQUIVALENCE RELATIONSHIPS. JMP CLEN29 LAC TEMP0 DAC* TSMTW3 CLEN29 LAC* SYMTW4 SAD* TSMTW4 SKP JMP CLEN33 CLEN32 LAC* TSMTW3 JMS BINOUT XOR C00012 LAC* TSMTW4 CLEN40 JMS NTHSYM LAC FCNFLG /ARRAY DESCRIPTION BLOCK AND TRANSFER SAD K00001 /VECTORS ARE NOT GENERATED IF THIS IS A JMP CLEN30 /BLOCK DATA SUBPROGRAM. LAC* SYMTBC SPA JMS CLEN50 JMS VECTOR /THE VARIABLE IN COMMON IN LAC* SYMTW3 /OUTPUT ALONG WITH ITS RELATIVE ADDRESS JMS BINOUT /IN THE CURRENT COMMON BLOCK (CODE 13), XOR C00013 /AND THE ADDRESS OF ITS TRANSFER VECTOR LAC* SYMTBC /(CODE 14). AND S17777 JMS BINOUT XOR C00014 JMP CLEN31 CLEN30 JMS DEFNSM /VARIABLES IN A BLOCK DATA SUBPROGRAM ARE XOR* SYMTW3 /DEFINED AS THEIR RELATIVE ADDRESSES. CLEN31 LAC* SYMTW4 SAD* TSMTW4 SKP JMP CLEN40 LAC* TSMTW3 /A CUMULATIVE SUM OF ALL COMMON BLOCK TAD LOWRAD /SIZES IS OBTAINED FOR USE AS THE PROGRAM DAC LOWRAD /SIZE OF A BLOCK DATA SUBPROGRAM. LAC TSMTW4 JMP CLEN34 CLEN22 LAC START DAC PROCAD LAC PC /THE PROGRAM COUNTER IS SAVED AS THE DAC START /ADDRESS OF THE FIRST EXECUTABLE JMP* CLENUP /INSTRUCTION. .EJECT / SUBROUTINE TO OUTPUT ARRAY DESCRIPTION WORDS / CALLING SEQUENCE... / JMS CLEN50 / CLEN50 CAL 0 /ARRAY DESCRIPTION WORDS ARE OUTPUT FOR LAC* SYMTBC /ALL COMMON ARRAYS AND NON-COMMON ARRAYS AND S77777 /WHICH ARE NOT DUMMY VARIABLES. JMS ABSBIN /(DESCRIPTION WORDS FOR DUMMY ARRAYS ARE LAC* SYMTW5 /LOCATED IN THE CALLING PROGRAM.) JMS ABSBIN / WORD 1 .. MODE + SIZE LAC* SYMTW6 / WORD 2 .. IMAX JMS ABSBIN / WORD 3 .. IMAX*JMAX JMP* CLEN50 / WORD 4 .. ADDRESS .EJECT / SUBROUTINE TO OUTPUT A TRANSFER VECTOR / CALLING SEQUENCE... / JMS VECTOR / VECTOR CAL 0 XCT PASS /THE SYMBOL IS LEFT UNDEFINED UNTIL PASS 2 JMS DEFNSM /AS THE DEFINITION WORD CONTAIN THE NUMBER XOR PC /OF WORDS OCCUPIED BY THIS VARIABLE. LAC* SYMTW3 JMS VECBIN /THE TRANSFER VECTOR IS INITIALLY SET TO JMP* VECTOR /REFERENCE THE ARRAY(VAR) ADDRESS. .EJECT / SUBROUTINE TO DEFINE A SYMBOL / CALLING SEQUENCE... / JMS DEFNSM / XOR DEFINITION / DEFNSM CAL 0 LAC* SYMTBC /THE DEFINITION OF THE SYMBOL IS MERGED AND Z60000 /INTO THE FIRST WORD OF THE SYMBOL TABLE XCT* DEFNSM /ENTRY. DAC* SYMTBC CLA JMP* DEFNSM .EJECT / SUBROUTINE TO OBTAIN THE NEGATIVE ADDRESS OF THE FIRST WORD FOLLOWING / THE WORDS OCCUPIED BY THIS VARIABLE / CALLING SEQUENCE... / JMS CLEN60 / CLEN60 CAL 0 LAC* SYMTBC /THE NUMBER OF WORDS OCCUPIED BY THIS AND S17777 /VARIABLE IS ADDED TO THE RELATIVE ADDRESS TAD* SYMTW3 /ASSIGNED TO THIS VARIABLE. DAC TEMP0 /THE POSITIVE ADDRESS IS SAVED AND ITS JMS TWOCMA /NEGATIVE RETURNED TO THE CALLING PROGRAM. JMP* CLEN60 .EJECT / SUBROUTINE TO INCREMENT PROGRAM COUNTER BY N / CALLING SEQUENCE... / JMS INCRPC / TAD N / INCRPC CAL 0 LAC PC XCT* INCRPC /THE PROGRAM COUNTER IS INCREMENTED BY THE DAC PC /SPECIFIED AMOUNT AND COMPARED WITH 8191. .IFDEF PDP15 TAD K04081 SPA JMP .+3 LAC PASS1 /PROGRAM EXCEEDS 4K DAC F4K LAC PC .ENDC TAD K08177 SPA /THE COMPILER.. 8191 IS USED AS A FLAG.) JMP* INCRPC / LAW 16320 /ERROR: PROGRAM SIZE / JMS ERROR1 /EXCEEDS A SINGLE MEMORY BANK. ER02M ERR <' 02M'>,16320 JMP* INCRPC .EJECT / SUBROUTINE TO FETCH VARIABLE ARGUMENT-OPERATOR/DELIMITER PAIR / CALLING SEQUENCE... / JMS FVARGO / FVARGO CAL 0 JMS INFAOP JMS FARGOP /THE NEXT ARGUMENT-OPERATOR PAIR IS JMS VARTST /OBTAINED. THE ARGUMENT TYPE IS EXAMINED LAC OPVALU /TO MAKE SURE IT IS A VARIABLE. JMP* FVARGO .EJECT /SUBROUTINE TO MAKE PASS1 DEFINITIONS /CALLING SEQUENCE / JMS DEFNP1 / DEFNP1 CAL 0 LAC PC XCT PASS JMP* DEFNP1 XCT CLEN01 JMP* DEFNP1 DAC* SYMTW3 JMP* DEFNP1 .EJECT /SUBROUTINE TO SET ADDRESS OF NTH SYMBOL /CALLING SEQUENCE / LAC N / JMS NTHSYM / NTHSYM CAL 0 JMS TWOCMA DAC TCTR LAC SYMTB0 NTHSM1 DAC SYMTBC JMS SETADR ISZ TCTR SKP JMP* NTHSYM JMS SBSE50 JMP NTHSM1 .EJECT / SUBROUTINE TO FETCH INTEGER CONSTANT ARRAY DIMENSIONS (SUBSCRIPTS) / CALLING SEQUENCE... / JMS FARDIM / FARDIM CAL 0 DZM T2 /AN ARRAY DECLARATION MUST CONTAIN AT DZM T3 /LEAST ONE DIMENSION BUT NOT MORE THAN LAC AT1 /THREE. DZM SSCTR FARD05 DAC TI JMS FIARGO JMS CONTST /THE DIMENSIONS MUST BE WRITTEN AS DAC* TI /UNSIGNED, NON-ZERO INTEGER CONSTANTS. ISZ SSCTR LAC OPVALU /DIMENSIONS ARE SEPARATED BY COMMAS AND SAD C00030 /THE DIMENSION LIST IS TERMINATED BY A JMP FARD02 /RIGHT PARENTHESIS. / SAD C00033 / SKP / JMP ES /ERROR: SOME OTHER DELIMITER USED. ER01S ERS <' 01S'>,,ES JMS FARGOP /THE PSEUDO ARGUMENT SUBSCRIPTED VARIABLE JMP* FARDIM /AND ITS DELIMITER ARE OBTAINED BEFORE FARD02 LAC TI /RETURNING TO THE CALLING PROGRAM. TAD C00001 / SAD ATX /A MAXIMUM OF THREE DIMENSIONS ARE ALLOWED. / JMP ES /ERROR: MORE THAN 3 DIMENSIONS. ER02S ERN <' 02S'>,,ES JMP FARD05 .EJECT / SUBROUTINE TO FETCH AND ENTER (IN THE SYMBOL TABLE) ARRAY DIMENSIONS / CALLING SEQUENCE... / JMS FEDIMN / FEDIMN CAL 0 LAC* SYMTBC /THE NUMBER OF MACHINE WORDS PER ELEMENT AND S17777 /IS OBTAINED AND SET UP AS A MULTIPLIER DAC T0 /FOR DETERMINING THE TOTAL SIZE OF THE JMS FARDIM /ARRAY LAC T0 /THE ARRAY DIMENSIONS ARE OBTAINED AND THE JMS MULT /ROW-COLUMN LENGTHS CALCULATED (ALONG WITH TAD T1 /THE TOTAL SIZE). DAC T1 / N * IMAX JMS MULT TAD T2 DAC T2 / N * IMAX * JMAX JMS MULT TAD T3 DAC T3 / N * IMAX * JMAX * KMAX LAC* TI /THE TOTAL LENGTH IS ONE OF THESE THREE TAD K08192 /NUMBERS DEPENDING ON THE ACTUAL NUMBER OF / SMA /DIMENSIONS. / JMP EM /ERROR: ARRAY LENGTH GREATER THAN 8192. ER03M ERN <' 03M'>,SMA,EM LAC* SYMTBC AND Z60000 /THE LENGTH OF THE ARRAY IS TEMPORARILY XOR* TI /SET AS THE ADDRESS OF THE ARRAY (FOR XOR W00000 /EQUIVALENCE AND COMMON PROCESSING). THE DAC* SYMTBC /SYMBOL IS FLAGGED AS AN ARRAY. DZM* TI LAC T1 /THE INFORMATION REQUIRED TO CALCULATE THE DAC* SYMTW5 /POSITION OF AN ARRAY ELEMENT IS ENTERED / /INTO THE SYMBOL TABLE. I.E. LAC T2 / N*IMAX FOR 2-DIMENSION ARRAYS DAC* SYMTW6 /N*IMAX, N*IMAX*JMAX FOR 3-DIMENSION. LAC OPVALU /THE TERMINAL DELIMITER IS RETURNED TO THE JMP* FEDIMN /CALLING PROGRAM. .EJECT / SUBROUTINE TO ANNOUNCE AN ERROR IF THE ARGUMENT IS NOT A VARIABLE / CALLING SEQUENCE... / JMS VARTST / VARTST CAL 0 LAC ARG /THE ARGUMENT TYPE IS ISOLATED AND AND Z00000 /EXAMINED TO DETERMINE IF IT IS A VARIABLE. .IFUND ERMSG SAD T00000 JMP* VARTST ER02V JMP EV /ERROR: ARG NOT SYMBOLIC. .ENDC .IFDEF ERMSG ER02V ERS <' 02V'>,,EV JMP* VARTST .ENDC .EJECT / SUBROUTINE TO ANNOUNCE AN ERROR IF AN INTEGER ARGUMENT IS NOT A / NON-ZERO POSITIVE CONSTANT. / CALLING SEQUENCE... / JMS CONTST / CONTST CAL 0 LAC ARG /THE ARGUMENT TYPE IS ISOLATED AND AND Z00000 /EXAMINED TO DETERMINE IF IT IS A CONSTANT. / SAD U00000 / SKP /(INTERGER TYPE HAS ALREADY BEEN DETERMINED).145500 / JMP EV /ERROR: ARG NOT NON-ZERO POSITIVE CONSTANT. ER03V ERS <' 03V'>,,EV LAC S /THE CONSTANT MUST BE NON-ZERO AND / SMA!SZA /POSITIVE. / JMP* CONTST / JMP EV /ERROR: ARG NOT NON-ZERO POSITIVE CONSTANT. ER04V ERN <' 04V'>,SPA!SNA,EV JMP* CONTST .EJECT /SUBROUTINE TO TEST FOR A VARIABLE OR A +CONSTANT.NE.0. /CALLING SEQUENCE---JMS PNZCV PNZCV CAL 0 LAC ARG /IF ARG=VARIABLE, EXIT AND Z00000 SAD T00000 SKP JMS CONTST /IF ARG.NE.VARIABLE, IT MUST BE A JMP* PNZCV / POSITIVE, NON-ZERO CONSTANT .EJECT / SUBROUTINE TO FETCH CHARACTER AND CHECK FOR A SLASH (/) AS A DELIMITER / CALLING SEQUENCE / JMS COMN50 / JMP YES / XXX NO / COMN50 CAL 0 JMS FNBCHR /THE NEXT NON-BLANK CHARACTER IS FETCHED SAD C00047 /RETURN IS IMMEDIATE IF THE CHARACTER IS JMP* COMN50 /A SLASH (/). DZM UNFNBC /IF NOT, THE CHARACTER IS UNFETCHED AND ISZ COMN50 /RETURN IS MADE TO MARK PLUS ONE. JMP* COMN50 .EJECT / SUBROUTINE TO CHAIN CLASS MEMBERS (EQUIVALENCE OR COMMON BLOCK) / CALLING SEQUENCE... / JMS CHAIN / CHAIN CAL 0 LAC* LSTVAR /ALL MEMBERS OF THE SAME CLASS ARE CHAINED DAC FSTVAR /TOGETHER IN A CIRCULAR FASHION. I.E. EACH LAC* SYMTW4 /MEMBER POINTS TO ANOTHER MEMBER IN TH DAC* LSTVAR /CLASS AND NO TWO MEMBERS POINT TO THE SAME LAC FSTVAR /OTHER MEMBER. A ONE MEMBER CLASS POINTS DAC* SYMTW4 /TO ITSELF. A NEW MEMBER IS ADDED BY LAC SYMTW4 /BREADING THE CHAIN AT THE LAST MAMBER DAC LSTVAR /AND INSERTING THE NEW MEMBER BY EXCHANGING JMP* CHAIN /POINTERS. (NEW NAMES POINT TO SELF.) .EJECT / SUBROUTINE TO FETCH SIMPLE VARIABLE OR ARRAY ELEMENT WHOSE SUBSCRIPTS / ARE CONSTANTS AND OPERATOR-DELIMITER / CALLINGING SEQUENCE... / JMS FVORAR / FVORAR CAL 0 /THIS SUBROUTINE IS USED BY THE DATA AND JMS FVARGO /EQUIVALENCE STATEMENT PROCESSORS. LEGAL / JMS SYMTYP /NAMES ARE SIMPLE VARIABLES OR ARRAY / XOR V00000 /ELEMENTS WITH CONSTANT SUBSCRIPTS. / SKP / JMP EV /ERROR: NAME IS THAT OF DUMMY VARIABLE. / JMS SYMTYP / XOR U00000 / SKP / JMP EV /ERROR: NAME IS THAT OF EXTERNAL FUNCTION. LAC* SYMTBC AND V00000 ER05V ERN <' 05V'>,,EV ER06V ERN <' 06V'>,,EV DZM T0 LAC* SYMTBC /THE NUMBER OF WORDS PER ITEM (VARIABLE IS / /ONLY ONE ITEM, ARRAY MAY CONTAIN MORE) JMS SETN /IS OBTAINED FOR USES BOTH INTERNAL AND DAC MODE /EXTERNAL TO THIS ROUTINE. LAC OPVALU /THE APPEARANCE OF A SUBSCRIPTED VARIABLE SAD C00027 /NEED NOT INDICATE AN ARRAY ELEMENT. IF JMP FVAR03 /THE VARIABLE HAS NOT BEEN DECLARED AS AN SAD C00029 /ARRAY IT IS TREATED AS A ONE-ONLY JMP FVAR03 /DIMENSION ARRAY. JMP* FVORAR /EXIT IS QUICK IF THE VARIABLE IS NOT FVAR03 JMS FARDIM /SUBSCRIPTED AT ALL. LAC SYMTBC XOR T00000 DAC ARG LAC T1 /THE CONSTANTSUBSCRIPTS ARE OBTAINED AND TAD K00001 /THE ELEMENTS RELATIVE POSITION IN THE JMS MULT /ARRAY (PSEUDO-ARRAY) IS CALCULATED AS IF TAD MODE /THE ARRAY WAS ONE-DIMENSIONAL. DAC T0 LAC SSCTR /A NON-ARRAY VARIABLE MAY BE SINGLY SAD C00001 /SUBSCRIPTED APPEARING ON AN EQUIVALENCE JMP FVAR05 /STATEMENT. (A SIMILARILY WRITTEN VARIABLE LAC* SYMTBC /ON A DATA STATEMENT WOULD BE INTERPRETED / SMA /AS A FUNCTION AND AN ERROR WOULD OCCUR). / JMP EV /ERROR: MORE THAN 1 DIMENSION INDICATED FOR ER07V ERN <' 07V'>,SMA,EV /A NON-ARRAY VARIABLE. FVAR04 LAC T2 TAD K00001 /THE ELEMENT POSITION IS CALCULATED FOR JMS MULT /MULTI-DIMENSION ARRAY ELEMENTS AS... TAD* SYMTW5 TAD T0 / FOR A(I,J,K) DECLARED, AND DAC T0 / A(M,N,O) STATED LAC T3 SZA TAD K00001 / (M-1) + (N-1)*I + (O-1)*I*J JMS MULT TAD* SYMTW6 /EACH TERM OF THE POSITION FORMULAE IS TAD T0 /MULTIPLIED BY THE NUMBER OF WORDS PER DAC T0 /ELEMENT (TO ACCOUNT FOR DIFFERENT DATA JMS SUBCNT /MODES). A POSITION OF ZERO IS THE FIRST FVAR05 LAC T0 /ELEMENT. TAD K08192 /THE NUMBER OF STATED SUBSCRIPTS (OTHER / SPA /THAN ONE) MUST AGREE WITH THE NUMBER OF / JMP* FVORAR /DECLARED SUBSCRIPTS (DATA STATEMENT CHECKS / JMP EM /ONE-SUBSCRIPTED ELEMENTS TOO). THE ELEMENT ER04M ERN <' 04M'>,SMA,EM JMP* FVORAR /POSITION CANNOT BE GREATER THAN 8191. .EJECT / READ AND WRITE STATEMENT PROCESSORS / READ ENTRY = READ / WRITE ENTRY = WRITE WRITE LAC C00001 /WRITE ENTRY -- ONE TO RWFLAG READ DAC RWFLAG /RWFLG= READ/WRITE INDICATOR JMS FNBCHR /FETCH FIRST NON-BLANK CHARACTER AFTER THE / SAD S00050 / READ OR WRITE MNEMONIC. IF ITS NOT A / SKP / JMP EV /ERROR:1ST CHAR AFTER READ OR WRITE NOT (. ER08V ERS <' 08V'>,,EV JMS FIARGO / ARGUMENT MUST BE INTEGER TYPE, / / AS IT IS THE I/O UNIT NO. JMS IODEV /OUTPUT I/O DEVICE INFORMATION. LAW -37 /TEST OP FOR RIGHT-PAREN. IF SO, SET TAD OPVALU / FORMST TO ZERO INDICATING BINARY I/O. DAC FORMST SNA!CLA LAC C00033 TAD RWFLAG /OUTPUT APPROPRIATE OTS CALL --READ OR JMS OPOPA2 / WRITE, BCD OR BINARY. LAC ARG LAC FORMST /CHECK (OPVALU-31). IF ZERO (OP=RIGHT- SNA / PAREN), EXIT TO LIST PROCESSOR SETUP. JMP RW13 / IF -1 (OP = COMMA), FETCH FORMAT / SAD K00001 / STATEMENT OR ARRAY NAME. IF NEITHER, / SKP /ANNOUNCE ERROR. / JMP EI ER05I ERS <' 05I'>,,EI JMS FETSNO /FETCH FORMAT STATEMENT NUMBER. IF AC IS SMA /NEG. AFTER FETCH, THERE WAS NO JMP RW45 / STATEMENT (MUST BE JMS FVARGO / AN ARRAY. OUTPUT JMP RW44 /ADDRESS OF FORMAT+1 RW45 AND S60000 / OR ARRAY XCT PASS SAD S60000 SKP .IFUND ERMSG ER03N JMP EN /ADDRESS UNDEFINED .ENDC .IFDEF ERMSG ER03N ERS <' 03N'>,SKP,EN .ENDC RW44 LAC* SYMTBC SMA / MENT (PLUS 1) OR THE ARRAY. TAD C00001 AND W17777 JMS VECBIN LAC XCHAR /IF THE FIRST CHARACTER AFTER THE FORMAT / SAD S00051 / STATEMENT NUMBER OR THE ARRAY NAME IS / SKP /NOT A RIGHT-PAREN, ANNOUNCE AN ERROR. / JMP EF ER01F ERS <' 01F'>,,EF RW13 JMS FNBCHR /FETCH FIRST CHARACTER OF THE I/O LIST. JMS CTRL60 JMP RW14 /IF CHAR NOT A CARRIAGE RETURN, THERE IS LAC FORMST / AN I/O LIST. SZA JMP RW42 /IF I/O CALL IS BCD, OUTPUT JMS* TO BCD LAC RWFLAG / CLEANUP ROUTINE. / SNA / JMP RW43 /IF I/O CALL IS A READ, OUTPUT JMS* TO / JMP EX / BINARY CLEANUP ROUTINE. IF I/O CALL ER02X ERN <' 02X'>,SZA,EX JMP RW43 /IS BINARY WRITE, ANNOUNCE ERROR. RW14 DZM UNFNBC /UNFETCH CHAR AND GO TO LIST PROCESSOR .EJECT / INPUT AND OUTPUT LIST PROCESSOR -- SCAN1 RW19 JMS INAOPI DZM TFAO01 LAC DOTABA /SAVE DO TABLE POINTER FOR EXIT CHECKS. DAC TRW1 RW20 JMS FA2NOP /FETCH ARG2 AND NOP. LAC ARG0 /SAVE RELATIVE POSITION OF THE ELEMENT JMS TWOCMA / LIST POINTER. TAD ARGI DAC TRW2 LAC IDXNOP /CHECK OP. SNA JMP RW22 /IF C/R. SAD C00030 JMP RW21 /IF COMMA. / SAD C00001 / SKP / JMP RW39 ER03X ERS <' 03X'>,,EX JMS TSTDTP /IF EQUAL SIGN, STORE LEVEL, INDEX IN DO LAC LEVNOP / TABLE. XOR TRW2 DAC* DOTABA JMS INCDTP JMP RW20 RW21 LAC LEVNOP /CHECK LEVEL (DP). TAD Z76600 /IF .LT. 10, END OF SCAN 1. SMA JMP RW20 RW22 JMS INAOPI /END OF SCAN 1 -- SETUP FOR SCAN 2. LAC V77777 /MAKE PAREN BASE LEVEL A LARGE POSITIVE DAC PARLHI / NUMBER IN CASE NO IMPLIED DO'S. LAC DOTABA /TEST DO-TABLE POINTER. IF IT DID NOT SAD TRW1 / CHANGE IN SCAN 1, THERE ARE NO IMPLIED JMP RW23 / DO'S. GO TO SCAN 2 WITH PARLHI LARGE. TAD K00001 /SET RWEND POINTER TO LAST ENTRY IN THE DAC RWEND / IMPLIED-DO-TABLE. (TRW1 POINTS TO 1ST) DAC RWFND /INITIALIZE DO-TABLE SCANNING PARAMETERS. DZM RWTST LAC* RWEND /THE PAREN BASE LEVEL IS SET TO THE LOWEST AND Z77700 / OP-LEVEL IN THE TABLE (ALWAYS THE LAST DAC PARLHI / ENTRY) TO ALLOW FOR GROUPING PARENS. LAC TRW1 /RESET ALL DO-TABLE POINTERS TO FIRST JMS RSVDTP / ENTRY IN THE IMPLIED-DO-TABLE. /I/O LIST PROCESSOR -- SCAN 2. RW23 JMS GETA2N /GET AN ARG/OP PAIR FROM ELEMENT LIST RW231 LAC LEVNOP /IF THE OP-LEVEL IS GREATER THAN OR EQUAL JMS TWOCMA / TO THE BASE LEVEL AT LEAST ONE SET OF TAD PARLHI / DO-CODING MUST BE OUTPUT AT THIS TIME. SMA!SZA / IF NOT, OP IS CHECKED FOR DO-CLEANUP JMP RW29 / REQUIREMENTS OR OTS ROUTINE CALLS. LAC DOTABA /SAVE DOTABLE POINTERS TO PRESERVE CLEANUP DAC TRW3 / HIERARCHY. LAC RWFND /IF LAST FOUND ENTRY IS AT THE END OF THE SAD RWEND / DO-TABLE DON'T BOTHER CHECKING THE JMP RW24 / NEXT SUCCESSIVE ENTRY. ISZ RWFND /CHECK NEXT SUCCESSIVE ENTRY IN THE DO- LAC* RWFND / TABLE. IF ITS NESTING LEVEL IS THE AND Z77700 / SAME AS THE LAST ONE, ITS DO-CODING SAD RWTST / MUST BE THE NEXT OUTPUT. JMP RW25 RW24 LAC S01200 /SCAN THE DO-TABLE FOR THE NEXT HIGHER TAD RWTST / (DEEPER) LEVEL OF NESTING. JMS SCNLO JMP RW25 /FOUND--OUTPUT DO CODING. LAC S01200 /NOT FOUND--THERE ARE NO HIGHER LEVELS OF JMS SCNLO / NESTING. RESCAN TABLE FOR LOWEST NEST JMP RW25 / LEVEL AND OUTPUT DO-CODING. JMP RW405 /NOT FOUND AGAIN--IMPROPER NESTING, E082 RW25 LAC RWFND /SET DO-TABLEPOINTERS TO THE FOUND ENTRY. JMS RSVDTP LAC* RWFND /ZERO OUT THE NESTING LEVEL OF THIS ENTRY AND S00077 / TO ENSURE THAT IT WILL NEVER BE FOUND DAC* RWFND / IN/ IN A SCAN AGAIN. JMS DOCODE /OUTPUT DO-CODING LAC TRW3 /RESTORE DO-TABLE POINTERS TO THEIR SAVED JMS RSVDTP / VALUES. LAC PARLHI /BUMP PAREN BASE LEVEL BY 10 AND GO BACK TAD S01200 / AND CHECK IF ANY MORE SETS OF DO-CODE DAC PARLHI / MUST BE OUTPUT AT THIS TIME. JMP RW231 / CHECK NOP FOR DO-CLEANUP (OPI=EQUAL SIGN) RW29 LAC OPVALU SAD C00001 /CHECK (NOP) FOR EQUAL SIGN SKP / YES, OUTPUT DO-CLEANUP JMP RW31 / NO, OUTPUT I/O BUFFER CALL JMS DCLOUT JMS INCDTP LAC LEVNOP /SKIP OVER DO PARAMETERS IN ELEMENT LIST. DAC TRW2 RW30 JMS GETA2N /FETCH ARGI/OPI UNTIL LEVEL(OP) DROPS 10. LAC LEVNOP SAD TRW2 JMP RW30 LAC PARLHI /DECREMENT PAREN BASE LEVEL BY 10. TAD Z76600 DAC PARLHI JMP RW38 /CONTINUE WITH SCAN 2. /ROUTINE TO OUTPUT CODING FOR OBJECT-TIME I/O BUFFER CALL RW31 LAC OPVALU /CHECK NOP FOR (S OPERATOR. IF SO, OUTPUT SAD C00029 / SUBSCRIPT CODING. JMP RW32 LAC FORMST /NOT SUBSCRIPTED, BRANCH PER BCD OR BINARY. SZA JMP RW33 /BCD JMP RW35 /BINARY RW32 JMS OUTSSC /OUTPUT SUBSCRIPT CODING, AND RESET ARGI JMS TREST /AND OPI TO BOTTOM OF LIST (SUBSCRIPT / /PORTION) LAC FORMST /BRANCH PER BCD OR BINARY. SZA JMP RW34 /BCD JMP RW36 /BINARY RW33 LAC* ARG /CHECK BCD ARG FOR ARRAY SMA JMP RW34 LAC C00045 /BCD ARRAY I/O -- .FA JMP RW37 RW34 LAC C00046 /BCD ELEMENT I/O -- .FE JMP RW37 RW35 LAC* ARG /CHECK BINARY ARG FOR ARRAY SMA JMP RW36 LAC C00048 /BINARY ARRAY I/O -- .FB JMP RW37 RW36 LAW -15 /BINARY ELEMENT I/O -- INTEGER -- .FI JMS SHIFT / REAL -- .FJ LAC MODEA2 / DOUBLE -- .FK TAD C00049 / LOGICAL -- .FL RW37 JMS OPOPA2 /OUTPUT OP/ARG WHERE OP IS IN AC. LAC ARG RW38 LAC LEVNOP /EXIT CHECKING. / /IF LEVEL(OPI).NE.ZERO, CONTINUE WITH SZA / SCAN 2. JMP RW40 LAC TRW1 JMS RSVDTP LAC OPVALU /IF LEVEL(OPI).EQ.ZERO, (OPI) MUST BE / / EITHER A C/R OR A COMMA. IF NOT, / / AN ERROR IS ANNOUNCED. SNA JMP RW41 /IF C/R, EXIT .IFUND ERMSG SAD C00030 JMP RW19 /IF COMMA, GO TO SCAN 1 ER24X JMP EX .ENDC .IFDEF ERMSG ER24X ERS <' 24X'>,,EX JMP RW19 .ENDC RW40 LAC OPVALU /IF OP=C/R, ANNOUNCE ERROR. SZA JMP RW23 RW405 LAC TRW1 / JMS RSVDTP / JMP ED ER02D ERN <' 02D'>,,ED RW41 LAC FORMST /IF (OPI) IS A C/R, A CALL TO THE APPRO- SNA / PRIATE CLEANUP ROUTINE IS OUTPUT JMP RW43 / ACCORDING TO WHETHER THIS I/O CALL IS RW42 LAC OPTR47 / BCD OR BINARY. SKP RW43 LAC OPTR53 JMS EXP580 XOR JMSCMD JMP STEXIT /END OF STATEMENT -- EXIT .EJECT /SUBROUTINE TO GET ARG2/NOP FROM ELEMENT LIST / CALLING SEQUENCE -- JMS GETA2N GETA2N CAL 0 ISZ ARGI /BUMP ARGUMENT LIST POINTER AND UPDATE LAC ARGI / ARG AND ARG2. DAC ARG2 LAC* ARGI DAC ARG JMS SETA2 /UPDATE ADDRA2,MODEA2, AND TYPEA2. LAC ADDRA2 TAD K00001 DAC NOP JMS FAKE LAC* NOP DAC S ISZ OPI /BUMP OPERATOR LIST POINTER AND UPDATE LAC OPI / OP AND NOP. DAC NOP LAC* OPI DAC OP AND S00077 DAC OPVALU /UPDATE OPVALU. TAD K00029 SNA!CLA LAC Z76600 TAD OP AND T77700 DAC LEVNOP /UPDATE LEVNOP. (-10 IF OP=(S.) JMP* GETA2N .EJECT /SUBROUTINE TO SCAN IMPLIED-DO-TABLE NESTING LEVELS. /CALLING SEQUENCE: LAC LOWEST NEST LEVEL / JMS SCNLO / JMP FOUND / JMP NOTFOUND /EXIT WITH RWTST IN ACCUMULATOR. SCNLO CAL 0 DAC RWTST LAW -12 /SET MAX. LOOP COUNT DAC TRW2 SCN1 LAC TRW1 /SET POINTER TO TOP OF TABLE DAC RWFND SCN2 LAC* RWFND AND Z77700 SAD RWTST /EXIT WHEN LEVELS MATCH JMP* SCNLO LAC RWFND /TEST FOR END OF TABLE SAD RWEND JMP .+3 ISZ RWFND /NO, BUMP POINTER. JMP SCN2 LAC RWTST /YES, BUMP LEVEL TAD S01200 DAC RWTST ISZ TRW2 JMP SCN1 ISZ SCNLO JMP* SCNLO .EJECT /BACKSPACE, REWIND, AND ENDFILE STATEMENT PROCESSORS. / BACKSPACE ENTRY = BACKSP / REWIND L ENTRY = REWIND / ENDFILE ENTRY = ENDFIL ENDFIL LAC C00001 REWIND TAD C00001 BACKSP TAD C00035 DAC TRW1 /SAVE OUTPUT OP-VALUE JMS FIARGO /FETCH UNIT NO. = .DAT SLOT JMS IODEV /OUTPUT I/O DEVICE INFORMATION FOR LOADER. LAC TRW1 /OUTPUT SUBROUTINE CALL. ENDF01 JMS OPOPA2 LAC ARG JMP CRTEST /EXIT .EJECT /SUBROUTINE TO OUTPUT IODEV LOADER INFORMATION / CALLING SEQUENCE -- JMS IODEV IODEV CAL 0 DZM CTRLSW+1 /SET OTS I/O INITIALIZER CALL REQUIRED. LAC ARG /TEST ARGUMENT. IF A SYMBOL, DEFINE ALL AND Z00000 / .DAT SLOTS. IF A CONSTANT, DEFINE SAD T00000 / ONE .DAT SLOT (=ARG). IF NEITHER, JMP IODEV2 / ANNOUNCE ERROR. JMS CONTST SKP IODEV2 LAC W00000 /ALL SLOTS JMS BINOUT /OUTPUT IODEV INFO -- LOADER CODE 22. XOR C00022 JMP* IODEV /EXIT .EJECT /DO STATEMENT PROCESSOR DO JMS TSTDTP /TEST DO-TABLE NESTING LEVEL. JMS FDFSNO /FETCH DEFINED STATEMENT NO. LAC SYMTBC /SUCCESSFUL FETCH - STORE SYMBOL TABLE DAC* DOTABA / ADDRESS IN DO-TABLE (WORD A). DZM UNFNBC /UNFETCH CHARACTER. JMS INAOPI /INITIALIZE ELEMENT LIST. DO02 JMS ENTERI /FETCH INTEGER ARG/OP AND ENTER IN LIST. JMS CTRL60 /CONTINUE ENTERING ARG/OP PAIRS IN LIST JMP DO02 / UNTIL (OP) = CARRIAGE RETURN. JMS INAOPI /RE-INITIALIZE ELEMENT LIST. LAC C00001 /SET DO PARAMETER INDEX TO START OF LIST. JMS DOCODE /OUTPUT DO-CODING. JMS INCDTP /BUMP DOTAB POINTERS. JMP STEXIT /EXIT .EJECT /SUBROUTINE TO INITIALIZE DO-TABLE / CALLING SEQUENCE -- JMS INDOTB INDOTB CAL 0 /SET DOTABA, DOTABB, AND DOTABC POINTERS .IFUND IMBED LAC* .FFREE / TO THE FIRST ADDRESS OF EACH OF THREE .ENDC .IFDEF IMBED LAC .FFREE .ENDC JMS RSVDTP /CONSECUTIVE TABLES. JMP* INDOTB .EJECT /SUBROUTINE TO TEST DO-TABLE POINTERS. / CALLING SEQUENCE -- JMS TSTDTP TSTDTP CAL 0 LAC DOTABC /IF POINTER FOR WORD C IS POINTING / SAD SYMTB0 / AT THE FIRST WORD OF THE SYMBOL / JMP EL / TABLE, DO-TABLE SIZE HAS BEEN ER01L ERN <' 01L'>,,EL JMP* TSTDTP / EXCEEDED. .EJECT /SUBROUTINE TO INCREMENT DO-TABLE POINTERS. / CALLING SEQUENCE -- JMS INCDTP INCDTP CAL 0 LAC DOTABA TAD C00001 JMS RSVDTP JMP* INCDTP /EXIT .EJECT /SUBROUTINE TO DECREMENT DO-TABLE POINTERS. / CALLING SEQUENCE -- JMS DECDTP DECDTP CAL 0 /ARE POINTERS LESS THAN OR EQUAL TO THEIR / LAC DOTABA / MINIMUMS. / SAD* .FFREE / JMP ED /ERROR: MISSING DO PARAMETER. /ER03D ERN <' 03D'>,,ED CLC /NO -- DECREMENT POINTERS. TAD DOTABA JMS RSVDTP JMP* DECDTP /EXIT .EJECT /SUBROUTINE TO RESOLVE DO-TABLE POINTERS. /CALLING SEQUENCE -- JMS RSVDTP (DOTABA IN AC) RSVDTP CAL 0 DAC DOTABA TAD C00010 DAC DOTABB TAD C00010 DAC DOTABC JMP* RSVDTP .EJECT /SUBROUTINE TO OUTPUT DO-CODING / CALLING SEQUENCE -- LAC DO-PARAMETER ELEMENT LIST INDEX / JMS DOCODE DOCODE CAL 0 TAD K00001 DAC TRW2 /TEMP STORE LIST INDEX. JMS EXP540 /TEMP STORE ARGI, OPI LAC ARG0 /CONSTRUCT NEW ARGI AND OPI FROM LIST TAD TRW2 / INDEX. DAC ARGI LAC OP0 TAD TRW2 DAC OPI JMS GETA2N /FIRST OP MUST BE EQUAL SIGN -- IF NOT, LAC OPVALU / AN ERROR IS ANNOUNCED. / SAD C00001 / SKP /DO14 JMP ED /ERROR: ILLEGAL CONSTRUCTION OF DO-PARAMETERS. ER04D ERS <' 04D'>,,ED LAC LEVNOP /TEMP STORE LEVEL OF FIRST OP. DAC TRW2 LAC ARG /FIRST ARG = CONTROL VARIABLE. (I) DAC DOI JMS VARTST JMS GETA2N /BUMP ELEMENT LIST POINTERS. JMS PNZCV LAC OPVALU /SECOND OP MUST BE COMMA. / SAD C00030 / SKP / JMP DO14 /ERROR: NO COMMA. ER05D ERS <' 05D'>,,ED LAC ARG /SECOND ARG = INITIAL PARAMETER. (M1) DAC DOM1 JMS GETA2N /BUMP ELEMENT LIST POINTERS. JMS PNZCV LAC ARG /THIRD ARG = TERMINAL PARAMETER. (M2) DAC DOM2 LAC OPVALU /IF THIRD OP IS A C/R, SET (M3)=0 AND SNA /OUTPUT CODE. JMP DO10 / SAD C00030 /IF THIRD OP IS NOT A COMMA, / SKP / JMP DO14 /ERROR: NO COMMA. ER06D ERS <' 06D'>,,ED LAC LEVNOP /IF OP-LEVEL HAS CHANGED, SET (M3)=0 AND / / OUTPUT CODE. IF NOT, GET NEXT ARG/OP SAD TRW2 / PAIR. SKP JMP DO10 JMS GETA2N /BUMP ELEMENT LIST POINTERS. JMS PNZCV LAC ARG /FOURTH ARG = INCREMENTATION PARAMETER.(M3) DAC DOM3 LAC OPVALU /IF FOURTH OP IS A C/R, OUTPUT CODE. SNA JMP DO11 / SAD C00030 /IF FOURTH OP IS NOT A COMMA, / SKP / JMP DO14 /ERROR: OP-LEVEL NOT CHANGED. ER07D ERS <' 07D'>,,ED LAC LEVNOP /IF OP-LEVEL HAS NOT CHANGED, / SAD TRW2 / JMP DO14 /ERROR: OP-LEVEL NOT CHANGED. ER08D ERN <' 08D'>,,ED JMP DO11 DO10 DZM DOM3 DO11 JMS TREST /RESTORE ARGI AND OPI. /DO-CODE OUTPUT SECTION LAC C00004 / (LAC M1) JMS OPOPA2 LAC DOM1 LAC PC / (JMP PC+3) XOR JMPCMD TAD C00003 JMS RELBIN LAC PC /PC TO DO-TABLE, WORD B DAC* DOTABB LAC C00004 / (LAC I) JMS OPOPA2 LAC DOI LAC DOM3 /TEST FOR INCREMENTATION PARAMETER -- IF SZA / NONE SPECIFIED (DOM3=0) ASSUME M3=1. JMP DO12 JMS EXP730 / (TAD 000001) JMP DO13 DO12 LAC C00015 / (TAD M3) JMS OPOPA2 LAC DOM3 DO13 LAC C00008 / (DAC I) JMS OPOPA2 LAC DOI CLA / (CMA ) AND (TAD 000001) JMS EXP570 LAC C00015 / (TAD M2) JMS OPOPA2 LAC DOM2 LAC DOM2 LAC SPACMD / (SPA ) JMS ABSBIN LAC PC /PC TO DO-TABLE, WORD C. DAC* DOTABC XOR JMPCMD / (JMP PC) JMS RELBIN JMP* DOCODE /EXIT .EJECT /SUBROUTINE TO CHECK FOR AND PERFORM DO-CLEANUP OPERATIONS. / CALLING SEQUENCE -- JMS DOCLEN DOCLEN CAL 0 DO20=. .IFUND IMBED LAC* .FFREE .ENDC .IFDEF IMBED LAC .FFREE .ENDC /DO20 LAC* .FFREE /IF THERE ARE NO ENTRIES IN DO-TABLE, AN SAD DOTABA / IMMEDIATE EXIT IS TAKEN JMP* DOCLEN JMS DECDTP LAC* DOTABA /GET DO-TABLE ENTRY (WORD A). SAD LABEL /IF TABLE ENTRY = CURRENT STATEMENT, CHECK SKP / FOR LEGAL RANGE TERMINATION. IF NOT, JMP DO21 / CHECK FOR IMPROPER NESTING. LAC PROCAD /COMPARE STATEMENT TYPES. SAD GOTOAD /GO TO JMP DO24 SAD RETADR /RETURN JMP DO24 SAD STOPAD /STOP JMP DO24 SAD PAUSAD /PAUSE JMP DO24 SAD IFADDR /IF JMP DO24 JMS DCLOUT /STATEMENT TYPE O.K. -- OUTPUT DO-CLEANUP JMP DO20 /TEST NEXT LOWER NESTING LEVEL. DO21 LAC DOTABA /TEMP STORE DOTABLE POINTER JMP DO27 DO22 TAD K00001 /DECREMENT NEST LEVEL DAC TRW2 LAC* TRW2 / NO, TEST STATEMENT. SAD LABEL /AN ERROR IS ANNOUNCED IF CURRENT STATE- JMP DO25 / MENT = ANY TABLE ENTRY OF LOWER NEST LAC TRW2 /LEVEL. /DO27 SAD* .FFREE /IS NEST LEVEL = 0 DO27=. .IFUND IMBED SAD* .FFREE .ENDC .IFDEF IMBED SAD .FFREE .ENDC JMP DO26 /YES,TABLE SEARCH COMPLETE. JMP DO22 /SEARCH MORE /DO24 DZM LABEL / JMP ED /ERROR: ILLEGAL STMT TERMINATES DO-LOOP. DO24=. ER09D ERN <' 09D'>,,ED /DO25 DZM LABEL / JMP EL /ERROR: IMPROPER DO NESTING. DO25=. ER02L ERN <' 02L'>,,EL DO26 JMS INCDTP JMP* DOCLEN .EJECT /SUBROUTINE TO OUTPUT DO-CLEANUP CODING / CALLING SEQUENCE -- JMS DCLOUT DCLOUT CAL 0 LAC* DOTABB /OUTPUT COMMAND TO REENTER DO-CODING. XOR JMPCMD JMS RELBIN LAC* DOTABC /STRING ADDRESS FOR EXIT FROM DO-LOOP. JMS STRING JMP* DCLOUT /EXIT TREST CAL 0 LAC TARGI TAD K00001 DAC ARGI LAC TOPI TAD K00001 DAC OPI JMS GETA2N JMP* TREST .EJECT /FORMAT STATEMENT PROCESSOR FORMAT DZM SYMTBC JMS EXP550 /OUTPUT BRANCH AROUND FORMAT STORAGE AND XOR JMPCMD / SET FLAG FOR COMPLETING STRING. DAC STRNGA LAC LABEL /IF NO LABEL, ANNOUNCE ERROR. / SNA /RW85 JMP EN /ERROR: FORMAT STMT HAS NO STMT NUMBER. ER04N ERN <' 04N'>,SNA,EN DZM HFLG /INITIALIZE HOLLERITH FLAG. DZM NUMFLG /INITIALIZE NUMERIC FLAG. LAW -5 /INITIALIZE FORMAT OUTPUT PACKER. DAC FMTCNT DZM FPCNT /INITIALIZE PAREN COUNT. RW60 JMS FMTFCH /FETCH CHARACTER. RW61 SAD S00054 JMP RW70 /IF COMMA. RW62 SAD S00057 / JMP RW76 /IF SLASH JMP RW60 SAD S00051 JMP RW71 /IF RIGHT PAREN. RW63 SAD S00055 JMP RW72 /IF MINUS SIGN. RW635 SAD S00050 JMP RW75 /IF LEFT PAREN. JMS NUMCHK JMP RW635 /IF NUMBER. SAD S00120 JMP RW77 /IF P SAD S00110 JMP RW78 /IF H SAD S00130 JMP RW80 /IF X SAD S00111 JMP RW81 /IF I SAD S00114 JMP RW81 /IF L SAD S00101 JMP RW81 /IF A RW64 JMS NUMCHK JMP RW65 /IF NUMBER RW65 SAD S00104 JMP RW82 /IF D SAD S00105 JMP RW82 /IF E SAD S00106 JMP RW82 /IF F SAD S00107 JMP RW82 /IF G RW66 JMS NUMCHK JMP RW67 /IF NUMBER, ITS W-VALUE. .IFUND ERMSG ER02F JMP EF /ERROR: MISSING FIELD WIDTH. .ENDC .IFDEF ERMSG ER02F ERS <' 02F'>,SKP,EF .ENDC RW67 LAC LS / SNA / JMP RW86 /ERROR: FIELD WIDTH IS ZERO. ER03F ERN <' 03F'>,SNA,EF DZM NUMFLG /RESET NUMERIC FLAG AND CHECK XCHAR FOR LAC XCHAR / A PERIOD. SAD S00056 JMP RW68 /IF PERIOD, CONVERSION MUST BE FLOATING. LAC FLOATF /IS CONVERSION D, E, F, OR G. / SZA / JMP RW86 /ERROR: ILLEGAL W IN NSW.D. ER04F ERN <' 04F'>,SZA,EF LAC XCHAR / NO, GET NEXT CONVERSION. JMP RW61 RW68 LAC FLOATF /IS CONVERSION D, E, F, OR G. / SNA / JMP RW86 /ERROR: ILLEGAL W IN NSW.D. ER05F ERN <' 05F'>,SNA,EF JMS FMTFCH / YES, GET D-VALUE. JMS NUMCHK JMP RW69 .IFUND ERMSG ER06F JMP EF /ERROR: MISSING D-VALUE. .ENDC .IFDEF ERMSG ER06F ERS <' 06F'>,SKP,EF .ENDC RW69 DZM NUMFLG JMP RW61 /GET NEXT CONVERSION. /COMMA PROCESSOR. RW70 LAC FPCNT /CHECK PAREN COUNT. / SPA!SNA / JMP RW86 /ERROR: MISSING LEFT PAREN. ER07F ERN <' 07F'>,SPA!SNA,EF JMS FMTFCH SAD S00057 JMP .-2 JMP RW63 /REENTER SKIP CHAIN /RIGHT PAREN PROCESSOR. RW71 CLC /DECREMENT PAREN COUNT. TAD FPCNT DAC FPCNT SMA!SZA /IF PAREN COUNT ZERO, EXIT -- IF NOT ZERO, JMP RW60 / GET NEXT CONVERSION. JMP RW83 /MINUS SIGN PROCESSOR. RW72 JMS FMTFCH /FETCH NEGATIVE SCALE FACTOR JMS NUMCHK JMP RW73 .IFUND ERMSG ER08F JMP EF /ERROR: MINUS NOT FOLLOWED BY A NUMBER. .ENDC .IFDEF ERMSG ER08F ERS <' 08F'>,SKP,EF .ENDC RW73 DZM NUMFLG / SAD S00120 /CHECK CHARACTER FOLLOWING SCALE FACTOR / JMP RW74 / FOR P. / JMP RW86 /ERROR: P MISSING. ER09F ERS <' 09F'>,,EF RW74 JMS FMTFCH /FETCH NEXT CHARACTER. JMP RW64 /REENTER SKIP CHAIN. /LEFT PAREN PROCESSOR. RW75 ISZ FPCNT /BUMP PAREN COUNT. /SLASH PROCESSOR RW76 JMS FMTFCH /FETCH NEXT CHARACTER. JMP RW62 /REENTER SKIP CHAIN. /P PROCESSOR RW77 LAC NUMFLG /IS P PRECEDED BY A NUMBER. / SNA / JMP RW86 /ERROR: NO NUMBER PRECEDING P. ER10F ERN <' 10F'>,SNA,EF JMS FMTFCH / YES, FETCH NEXT CHAR. JMP RW64 /REENTER SKIP CHAIN /H PROCESSOR RW78 LAC NUMFLG /IS H PRECEDED BY A NUMBER. / SNA / JMP RW86 /ERROR: NO NUMBER PRECEDING H. ER11F ERN <' 11F'>,SNA,EF DZM NUMFLG LAC LS / YES, IS THE NUMBER = ZERO. / SNA / JMP RW86 /ERROR: ZERO PRECEDING H. ER12F ERN <' 12F'>,SNA,EF JMS TWOCMA / NO, FETCH AND SKIP (LS) CHARACTERS. DAC LS DAC HFLG /SET HOLLERITH FLAG. RW79 JMS FMTFCH ISZ LS JMP RW79 DZM HFLG /RESET HOLLERITH FLAG. JMP RW60 /REENTER SKIP CHAIN AT TOP. /X PROCESSOR RW80 LAC NUMFLG /IS X PRECEDED BY A NUMBER. / SNA / JMP RW86 /ERROR: NO NUMBER PRECEDING X. ER13F ERN <' 13F'>,SNA,EF DZM NUMFLG LAC LS / YES, IS THE NUMBER = ZERO. / SNA /RW86 JMP EF /ERROR: ILLEGAL W IN NSW.D. ER14F ERN <' 14F'>,SNA,EF JMP RW60 / NO, REENTER SKIP CHAIN AT TOP. /I,L,A PROCESSORS. RW81 DZM FLOATF /SET FLAG TO NON-FLOATING. JMP RW825 /REENTER SKIP CHAIN. /D,E,F,G PROCESSORS. RW82 CLC /SET FLAG TO FLOATING. DAC FLOATF RW825 JMS FMTFCH JMP RW66 /REENTER SKIPCHAIN /EXIT CHECKS. RW83 JMS FMTFIL /FILL MS/LS WITH BLANKS IF NECESSARY. JMS FMTOUT / NECESSARY -- OUTPUT LAST WORD PAIR. JMS FNBCHR /FETCH NEXT CHARACTER (SHOULD BE A C/R). JMP CRTEST /EXIT .EOT