.TITLE XVM FORTRAN IV COMPILER, PART 1 / / / FIRST PRINTING, FEBRUARY, 1975 / / THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO / CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED / AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION. / DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPON- / SIBILITY FOR ANY ERRORS THAT MAY APPEAR IN THIS / DOCUMENT. / / THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FUR- / NISHED TO THE PURCHASER UNDER A LICENSE FOR USE ON / A SINGLE COMPUTER SYSTEM AND CAN BE COPIED (WITH / INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR / USE IN SUCH SYSTEM, EXCEPT AS MAY OTHERWISE BE PRO- / VIDED IN WRITING BY DIGITAL. / / DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY / FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIP- / MENT THAT IS NOT SUPPLIED BY DIGITAL. / / COPYRIGHT (C) 1974, 1975 BY DIGITAL EQUIPMENT CORPORATION / / .EJECT / / PART 1 OF TWO PART SOURCE FILE OF FORTRAN IV COMPILER. THE SAME / EDIT NUMBER AND SOURCE FILE EXTENSION IS MAINTAINED FOR BOTH PARTS. / / /EDIT #46 4 FEB 74 *TAM-43 THROUGH 38*37-REF* / /FORTRAN 4 COMPILER / EDIT DATE VERSION PROGRAMMER FIX / 050 24-NOV-74 V3A001 R.K. HYATT CORRECTED >0E < PROB - IN PART 2 / / 051 24-NOV-74 V3A002 R.K. HYATT CORRECTED NONDETECTION OF / MISSING PAREN IN IMPLIED DO LOOPS / INCLUDED NEW ERROR MESSAGE >33X< / / 052 24-NOV-74 V3A003 R.K. HYATT CORRECTED NONDETECTION OF GARBAGE / AT END OF EXPRESSION IN ASSIGNMENT STATEMENTS / INCLUDED NEW ERROR MESSAGE >34X< / / 053 26-NOV-74 V3A004 R.K. HYATT CORRECTED INFINITE LOOPING / ON ERROR MESSAGE DUE TO COMMAND SYNTAX ERROR / / 054 27-NOV-74 V3B000 R.K. HYATT CHANGED VERSION NUMBER TO V3B000 / FOR B UPDATE OF DOS - IN PART TWO / / 055 16-JAN-75 V3B000 R.K. HYATT CORRECTED DOS INIT PROBLEM / / 056 31-JAN-75 V3B001 R.K. HYATT REMERGED DOS AND RSX COMPILERS / AND DELETED MODE BITS FROM HIGH ORDER VECTORS BITS / / 057 3-FEB-75 V3B002 R.K.HYATT CORRECTED NONDETECTION OF / REDUNDENT EQUIVALENCE STATEMENTS - NEW ERROR / MESSAGE >17C< - SPR#15-714 / / 058 3-FEB-75 V3B003 R.K. HYATT INSERTED CHECK FOR UNBALANCED - SPR#15-822 / / 059 3-FEB-75 V3B004 R.K. HYATT CORRECTIONS FOR IMPROPER / EVALUATION OF 'IF5' - SPR#15-822 / / 060 11-FEB-75 V3B005 R.K. HYATT CORRECTIONS TO DETECT UNDEFINED / FUNCTION DEFENITIONS - SPR#15-E737 / / 061 20-FEB-75 V3B006 R.K. HYATT CHANGED 'HELLO' TO XVM 'VERSION' FOR PDP15 / / 062 21-MAY-75 R.K. BLACKETT REMOVED ANTIQUE CONDITIONAL ASSEMBLY / PARAMETERS IN PREPERATION TO XVM VERSIONS. / / 063 22-MAY-75 V1X000 R.K. BLACKETT CHANGE CODE GENERATED FOR / LOGICAL .OR. TO DO A BOOLEAN INCLUSIVE OR. / / 064 22-MAY-75 V1X001 R.K. BLACKETT FIX FORMAT STATEMENT CHECKER / TO DETECT MISSING OPENING PAREN / / 065 30-JUL-75 V1X002 R.K. BLACKETT FIX ERROR IN EDIT 062. / FOUR LINES WERE ERONEOUSLY DELETED / AFTER LABEL 'DDCHK'. / / 066 29-AUG-75 V1X003 R.K. BLACKETT GIVE FORTRAN A "HEADER LINE' / AT THE TOP OF EACH LISTING PAGE, AND / COUNT LINES/PAGE. ALSO FIXED A BUG / SUCH THAT A COMMA IN THE COMMAND STRING / WILL NOW GIVE AN ERROR, RATHER THAN / SEEK THE WRONG FILE NAME. / / 067 18-SEP-75 V1A000 R.K. BLACKETT ADD 'SIZE =' AND 'XX ERRORS' / MESSAGES. ALSO REMOVED BOSS CONDITIONALS / AND CHANGED THE HELLO TO 'XVM V1A000'. / / 068 11-NOV-75 V1A000 R.K. BLACKETT FIX HEADER LINE FROM GOING / TO -12 WHEN NO LISTING REQUIESTED / ALSO, COMPLETE RSX CODE IN HEADER. / / 069 17-NOV-75 V1A000 R.K. BLACKETT PUT IN CONDITIONAL ASSEMBLY / PARAMETERS TO ELIMINATE EITHER / THE LISTING TOF HEADING LINE, OR / END OF COMPILATION SIZE/ERROR / COUNT MESSAGE. THIS IS A TEMPORARY / SITUATION DUE TO THE RSX VERSION / BEING > 8K WITH THESE FEATURES. / / 070 23-DEC-75 V1A000 R.K. BLACKETT PRECEED RSX'S HELLO MESSAGE / WITH A LEGAL HEADER WORD PAIR, / SINCE SOME RSX HANDLERS (LP FOR / EXAMPLE) ARE PICKIER THAN TT. / .TITLE XVM FORTRAN IV, ASSEMBLY PARAMETERS / IF RSX DEFINED MAKE RSX VERSION / IF %FPP DEFINED MAKE VERSION TO USE FLOATING HARDWARE / IF %ARGOP IS DEFINED IT IS TAKEN AS THE LENGTH OF THE ARG-OP TABLE / .EJECT .IFDEF RSX / %NOHDG=0 /(RKB-069) NO HEADING FOR NOW WITH RSX %NOEOC=0 /(RKB-069) NO END OF COMPILATION MSG, EITHER. ECLA=641000 / RSX PARAMETER DEFINITIONS / .IFUND DAT2 DAT2=14 .ENDC .IFUND DAT3 DAT3=15 .ENDC .IFUND DAT11 DAT11=17 .ENDC .IFUND DAT12 DAT12=20 .ENDC .IFUND DAT13 DAT13=21 .ENDC .ENDC / / / .IFUND %ARGOP %ARGOP=101 .ENDC .IODEV -11,-12,-13 .TITLE XVM FORTRAN IV, MACRO DEFINITIONS .DEFIN SYN,A A .DSA 0 /PUT TWO TAGS ON THIS LOCATION .ENDM .DEFIN BLK,N .LOC .+N .ENDM .DEFIN OPCOD,A A@CMD A .SIXBT +A+ .ENDM / / ERROR MACROS - TWO SETS, BASIC AND EXPANDED / .DEFIN ERN,A,B,C C@A JMS ERRORN .ASCII + @A+ .LOC .-2 B .LOC .+1 .ENDM / .DEFIN ERS,A,B,C C@A JMS ERRORS .ASCII + @A+ .LOC .-2 B .LOC .+1 .ENDM / .DEFIN ERR,A,B,C C@A .ASCII + @A+ .LOC .-2 JMS ERROR1 .LOC .+1 .ENDM / .DEFIN ERX,A,C C@A JMS ERRORS .ASCII + @A+ .LOC .-2 SKP .LOC .+1 .ENDM / / MACROS TO GENERATE FPP INSTRUCTIONS OR SUBROUTINE NAMES .IFDEF %FPP .DEFIN FPPIN,A,B B .ENDM .ENDC .IFUND %FPP .DEFIN FPPIN,A,B A .ENDM .ENDC .TITLE .TITLE ONCE-ONLY INITIALIZATION CODE /BANK-BIT INITIALIZATION-OVERLAYED / BEGIN=. .IFUND %NOHDG /(RKB-069) DON'T DO THIS IF WE DON'T WANT IT .IFUND RSX /(RKB-066) LAC* SC.DATE /(RKB-066) GET THE DATE LRSS 14 /(RKB-066) POSITION TO MONTH .ENDC /(RKB-067) .IFDEF RSX /(RKB-067) CAL GTDATE /(RKB-067) LAC GTDATE+2 /(RKB-067) .ENDC /(RKB-067) RCL /(RKB-066) EACH ENTRY IN MONTAB IS TWO WORDS LONG TAD MONTAB /(RKB-066) FIND THIS MONTH DAC MONTAB /(RKB-066) LAC* MONTAB /(RKB-066) MOVE THREE CHARACTER MONTH INTO PRINT LINE DAC TOF+14 /(RKB-066) // ISZ MONTAB /(RKB-066) // LAC* MONTAB /(RKB-066) // DAC TOF+15 /(RKB-066) // .IFUND RSX /(RKB-067) LAC* SC.DATE /(RKB-066) GET THE DATE BACK LRS 6 /(RKB-066) POSITION TO DAY IN 12-17 AND S00077 /(RKB-066) CLEAN IT UP .ENDC /(RKB-067) .IFDEF RSX /(RKB-067) LAC GTDATE+3 /(RKB-067) .ENDC /(RKB-067) JMS GT2D /(RKB-066) GET TWO DECIMAL CHARACTERS DAC TOF+13 /(RKB-066) PUT DAY IN PRINT LINE .IFUND RSX /(RKB-067) LAC* SC.DATE /(RKB-066) NOW GO FOR YEAR AND S00077 /(RKB-066) STRIP IT AAC 106 /(RKB-066) YEAR IS HELD AS YEARS SINCE 1970 .ENDC /(RKB-067) .IFDEF RSX /(RKB-067) LAC GTDATE+4 /(RKB-067) .ENDC /(RKB-067) JMS GT2D /(RKB-066) GET TWO DECIAMAL CHARACTERS LLSS 3 /(RKB-066) POSITION ANSWER AAC 4 /(RKB-066) PAD WITH BLANK DAC TOF+16 /(RKB-066) AND PUT YEAR IN PRINT LINE .IFUND RSX /(RKB-067) ISZ SC.DATE /(RKB-066) NOW WORD POINTS TO TIME LAC* SC.DATE /(RKB-066) GET TIME OF DAY LRSS 14 /(RKB-066) POSITION HOURS .ENDC /(RKB-067) .IFDEF RSX /(RKB-067) LAC GTDATE+5 /(RKB-067) .ENDC /(RKB-067) JMS GT2D /(RKB-066) GET 2 CHARACTERS ALS 3 /(RKB-066) SLIDE IT AAC 7 /(RKB-066) MAKE SURE ':' PRINTS DAC TOF+20 /(RKB-066) PUT HOURS IN PRINT LINE .IFUND RSX /(RKB-067) LAC* SC.DATE /(RKB-066) GET THE TIME LRS 6 /(RKB-066) POSITION FOR MINUTES AND S00077 /(RKB-066) CLEAN IT UP .ENDC /(RKB-067) .IFDEF RSX /(RKB-067) LAC GTDATE+6 /(RKB-067) .ENDC /(RKB-067) JMS GT2D /(RKB-066) CONVERT TO ASCII XOR U00000 /(RKB-066) BUILD IN BOTTOM PART OF ':' DAC TOF+21 /(RKB-066) AND PUT MINUTES IN PRINT LINE .ENDC /(RKB-069) LAC DLNOP DAC RSTRT .IFUND RSX LAC* S00100 AND S70000 /GET BANK BITS DAC BNKBTS / /ONCE-ONLY INITIALIZATION-OVERLAYED / OVRLAY CAL+775 1 INIT02 0 LAC* S00103 .ENDC .IFDEF RSX CAL PARTDV /READ THE PARAMETERS FROM TDV LAC PAREV /PICK UP THE EVENT VARIABLE SPA /IS IT LEGAL? JMP REQERR /NO -- ILLEGAL TDV REQUEST ERROR CAL PREA11 /PREALLOCATE INPUT BUFFER CAL WFEVA /WAIT FOR EVENT VARIABLE LAC EVA SMA JMP .+4 SAD (-6) /-6 LEGAL SKP JMS IOERR /OTHER ERROR POSSIBLY NOT ENUF CORE LAC (DAT11) JMS SIN520 /READ THE SWITCHES FOR BUFFER ALLOCKATION BUFAL1 JMS SIN500 /READ CHARS THRU THE 1ST SPACE SINCE TDV... SAD CHARSP /WON'T STRIP OFF THE EXTRA CHARS. IS IT A SPACE? JMP BUFAL /YES -- PROCEED TO LOOK FOR SWITCHES SAD CHARLT /NO -- ALTMODE? JMP CMDERR /YES -- ERROR SAD CHARCR /NO -- CARRIAGE RETURN? JMP CMDERR /YES -- ERROR JMP BUFAL1 /NO -- IGNORE THE CHAR AND CONTINUE TO LOOK FOR A SPACE. BUFAL JMS SIN500 SAD CHARLT /ALTMODE? JMP CMDERR /YES COMMAND ERROR SAD CHARCR /CRTN? JMP CMDERR /YES ERRROR SAD CHARB /B? JMP CHBB /ALLOCATE A BUFFER FOR IT SAD CHARL /L? JMP CHLL /ALLOCATE A BUFFER FOR IT SAD CHARO /O? JMP CHLL /SAME AS L SAD CHARS JMP CHLL /SAME AS L SAD ARROW /END OF COMMAND STRING? JMP CMDEND JMP BUFAL /NO TRY AGAIN / CHBB CAL PREA13 LAC (JMP BUFAL) /ONLY DO IT ONCE DAC CHBB CAL WFEVA /WAIT FOR EVENT VARIABLE BUFEVC LAC EVA /CHECK EVENT VARIABLE SMA /IS IT LEGAL? JMP BUFAL /YES GO DECODE AGAIN SAD (-6) /-6 IS ALSO LEGAL JMP BUFAL JMS IOERR /OTHER ERROR POSSIBLY NOT ENUF CORE LAC (DAT13) / CHLL CAL PREA12 /PREALLOCATE LISTING DEVICE CAL WFEVA LAC (JMP BUFAL) /ONLY DO IT ONCE DAC CHLL JMP BUFEVC /CHECK EVENT VARIABLE CMDEND CAL PARSIZ /FIND THE PARTITION SIZE LAC ENDPAR /PICK UP THE END OF AVAILABLE MEMORY .ENDC DAC ENDINT .IFDEF RSX AND S60000 /GET BANK BITS DAC BNKBTS /SET IN BANK BITS FLAG SNA /CHECK FOR ZERO JMP HELPP /BOOBY TRAPED IF BANK BITS ARE 0 !!!!!!! .ENDC .IFUND RSX N00767 CAL 767 /.INIT INPUT (-11) 1 INIT02 0 LAC .-1 AND S00200 .ENDC .IFDEF RSX LAC (DAT11) /ATTACH TO INPUT DEVICE JMS ATTACH CAL HINF /DO A HANDLER INFORMATION TO FIND OUT IF DIRECTORY DEVICE CAL WFEVA /WAIT FOR EVENT VARIABLE LAC EVA /PICK UP THE EVENT VARIABLE AND (040000) /MASK OFF THE DIRECTORY BITS .ENDC SZA LAC DLJMP /BULK STORAGE SNA LAC DLNOP /NOT BULK STORAGE DAC EPS1SW /INTO END PASS 1 SWITCH LAC DLCR DAC SINBFH+44 CLC TAD ENDINT DAC CONTB0 .IFUND RSX LAC* S00102 .ENDC .IFDEF RSX LAC SIZECP /PICK UP THE SIZE OF THE PARTITION INDICATOR .ENDC DAC .FFREE LAC DL155 DAC BINBFH .IFDEF RSX JMP STARTI /START UP INIT FINISHED HELPP CAL HELPM /NOT ENUF CORE JMS WFEV /WAIT FOR EVENT VARIABLE LAC C00013 /LUN INCASE OF I/O ERROR CAL C00008 /EXIT / HELPM 2700 EVA 15 /ON LUN 13 2 /IOPS ASCII HELPMS /BUFFER HELPMS 6002 /HEADER 0 .ASCII /FOR-PARTITION TOO SMALL/<15> REQERR CAL REQMS /TDV ERROR JMS WFEV /WAIT FOR EVENT VARIABLE LAC C00013 /LUN IN CASE OF I/O ERROR DAC TITLEA JMP EXITF / REQMS 2700 EVA 15 /LUN 13 TDV OUTPUT DEVICE 2 /ASCII REQERM /MESSAGE REQERM 6002 /HEADER 0 /CHECKSUM .ASCII /FOR-TDV ERR/<15> .ENDC .IFUND RSX JMP INIT02 .ENDC DL155 15500 DLCR 64000 ENDINT BEGIN .IFUND RSX DLNOP JMS SUB990 .ENDC .IFDEF RSX DLNOP NOP .ENDC DLJMP JMP INIT01 S00102 102 S00103 103 .IFUND %NOHDG /(RKB-069) DOING HEADING STUFF? .IFUND RSX /(RKB-067) SC.DATE 147 /(RKB-066) POINTER TO SCOM DATE/TIME WORDS .ENDC /(RKB-067) .IFDEF RSX /(RKB-067) GTDATE 24 /(RKB-067) 0 /(RKB-067) .BLOCK 6 /(RKB-067) .ENDC /(RKB-067) GT2D XX /(RKB-066) SUBROUTINE TO CONVERT TO 2 DECIMAL CHARS IDIV /(RKB-066) DIVIDE INTO TWO DIGITS 12 /(RKB-066) // RCL /(RKB-066) WE ALWAYS BUILD FOR THE SECOND WORD OF A PAIR PAL /(RKB-066) SAVE THE SECOND DIGIT LLSS 10 /(RKB-066) POSITION FIRST DIGIT PLA /(RKB-066) RETURN SECOND XOR (30140) /(RKB-066) MAKE THEM PRINTING ASCII OMQ /(RKB-066) SMASH THEM ALL TOGETHER JMP* GT2D /(RKB-066) MONTAB .-1 /(RKB-066) THE MONTHS NAMES .ASCII '-JAN-' /(RKB-066) .ASCII '-FEB-' /(RKB-066) .ASCII '-MAR-' /(RKB-066) .ASCII '-APR-' /(RKB-066) .ASCII '-MAY-' /(RKB-066) .ASCII '-JUN-' /(RKB-066) .ASCII '-JUL-' /(RKB-066) .ASCII '-AUG-' /(RKB-066) .ASCII '-SEP-' /(RKB-066) .ASCII '-OCT-' /(RKB-066) .ASCII '-NOV-' /(RKB-066) .ASCII '-DEC-' /(RKB-066) .ENDC /(RKB-069) .TITLE STORAGE ASSIGNMENT - TEMPORARIES AND ARRAYS .IFUND RSX .LOC BEGIN /NOW SET UP PC FOR OVERLAY STORAGE .ENDC .IFDEF RSX /**053** REMOVED OVERLAY BY .LOC RELOCATION LIST OPR /**050** LIST MUST NOT SKIP WHEN EXECUTED ON COMMAND DECODE .ENDC .IFUND RSX LIST BLK 1 /**055** FIX FOR DOS INIT PROBLEMS .ENDC DOTABX BLK 1 /END ADDRESSE OF DO-TABLE DOTABC BLK 1 /SECOND STRING ADDRESS TABLE DOTABB BLK 1 /FIRST STRING ADDRESS TABLE DOTABA BLK 1 /TERMINAL STATEMENT NO. TABLE FILFLG BLK 1 STRNGB BLK 1 /ADDRESS OF BRANCH AROUND PARAMETERS SSCTR BLK 1 /SUBSCRIPT COUNTER FCNRET BLK 1 /SYMTAB ADDRESS OF FUNCTION RETURN FCNFLG BLK 1 /SUBPROGRAM FLAG - MINUS 1 FOR BLOCK DATA NAME0 BLK 1 /ARGUMENT MODE TFAO06 BLK 1 /LOGIC OP MODE ENTRY FLAG (MODE) TFAO01 BLK 1 /LAST DELIMITER PROCESSED DOM2 BLK 1 TI BLK 1 /ADDRESS OF I-TH SUBSCRIPT TRW2 BLK 1 TRW1 BLK 1 EQUCLS BLK 1 /ADDR OF LAST ENTRY IN EQV CLASS LIST RELADR BLK 1 /ADDRESS RELATIVE TO HEAD OF EQV CLASS DIFF BLK 1 /DIFFERENCE IN A VARIABLES ADDR IN TWO EQV CLASSES SUBADJ BLK 1 /ADDRESS LINEUP ADJUSTMENT FACTOR SUBVAL BLK 1 /RELATIVE ADDRESS WITH RESPECT TO ONE OLDCLS BLK 1 /NON-ZERO IF WE ARE MERGING TWO EQV CLASSES COMCLS BLK 1 /NON-ZERO IF THIS EQV CLASS IS IN COMMON HEDCLS BLK 1 /ADDRESS OF HEAD MEMBER OF EQV CLASS LSTVAR BLK 1 /ADDR OF LAST VARIABLES LINKAGE WORD FSTVAR BLK 1 /FLAG INDICATING FIRST CLASS MEMBER DATAFL BLK 1 /DATA STATEMENT FLAG TSTRNG BLK 1 /TEMPORARY HOLD FOR STRING ADDRESS NOP BLK 1 /ADDRESS OF NEXT OPERATOR IN OP TABLE CTRLSW BLK 1 /FLAG GOVERNING WHETHER CONTINUATION IS ALLOWED .IFUND RSX FILE BLK 3 /FILE NAME FROM COMMAND STRING .ENDC STRNGA BLK 1 /ADDR OF INSTRUCTION REQUIRING A STRING PROCAD BLK 1 /ADDRESS OF STATEMENT PROCESSING ROUTINE TORDER BLK 1 /ORDER NUMBER OF CURRENT STMT SORDER BLK 1 /ORDER NUMBER OF LAST STATEMENT LABEL BLK 1 /SYMTAB ADDR OF CURRENT STATEMENT LABEL LOWRAD BLK 1 /BLOCK DATA SIZE, ALSO EQV CLASS LOW ADDR EQUSTR BLK 1 /AMOUNT OF NON-COMMON EQUIVALENCED STORAGE TSMTBN BLK 1 /"STATEMENT FUNCTION" FLAG SYMTBN BLK 1 /NEXT ENTRY ADDRESS IN SYMBOL TABLE SYMTB0 BLK 1 /FIRST ADDRESS IN SYMBOL TABLE SYMTBC BLK 1 /ADDRESS OF CURRENT ENTRY IN SYMTAB TSMTW7 BLK 1 /TEMP ADDRESS OF WORD 7 OF SYMTAB ENTRY CONTBN BLK 1 /NEXT ENTRY ADDRESS IN CONSTANT TABLE OBJBFH BLK 22 /PRINTING BUFFER OBJB04 BLK 1 /TEMP STORAGE OBJB03 BLK 1 /" OBJB02 BLK 1 /" OBJB01 BLK 1 /" CODCTR BLK 1 /LOADER CODE COUNTER WRDCTR BLK 1 /DATA WORD COUNTER CODEWD BLK 1 /LOADER CODE WORD STORAGE ADDRESS BINBUF BLK 1 /DATA WORD STORAGE ADDRESS BINBFH BLK 32 /BINARY OUTPUT BUFFER TCHAR BLK 1 /TEMPORARY CURRENT CHAR KOL BLK 1 /TEMP COLUMN COUNTER TCHCNT BLK 1 /TEMP CHCRACTER COUNTER TSINBF BLK 1 /TEMPORARY ADDRESS OF NEXT 5 CHARACTERS TCHBF1 BLK 1 /TEMPORARY CHARACTER BUFFER TCHBUF BLK 1 /" BITCTR BLK 1 /SHIFT COUNTER FOR POSITIONING CHARACTER COL06 BLK 1 /CONTENTS OF CONTINUATION FIELD(COLUMN 6) UNFNBC BLK 1 /RE--USE LAST CHARACTER FETCHED FLAG LSTCHR BLK 1 /LAST CHARACTER FETCHED LEVEL BLK 1 /CURRENT CHAR, HIERARCHY LEVEL IF OP CHRTYP BLK 1 /TYPE CODE OF CURRENT CHARACTER XCHAR BLK 1 /ASCII OF CURRENT CHAR CHAR BLK 1 /INTERNAL CODE FOR CURRENT CHAR COL BLK 1 /COLUMN COUNTER CHRCNT BLK 1 /CHARACTER COUNTER (WITHIN BUFFER) SINBUF BLK 1 /ADDRESS OF NEXT 5 CHARACTERS CHRBF1 BLK 1 /SECOND WORD OF DOUBLEWORD CHAR BUFFER CHRBUF BLK 1 /FIRST WORD OF CHAR BUFFER LINMBR BLK 1 /(RKB-067) BLK 2 /(RKB-067) STORAGE FOR LINE NUMBER SINBFH BLK 45 /INPUT BUFFER / / / TABLES WHICH PRECEDE THE COMPILER IN MEMORY / DOTAB DO TABLES / SYMTAB SYMBOL TABLE / CONTAB CONSTANT TABLE / .FFREE 0 /START OF DO + SYMTAB CONTB0 0 .IFDEF RSX PC 0 CTLPSW 0 START 0 FORMST 0 .ENDC .EJECT / DESCRIPTION OF VARIABLES DEFINED ELSEWHERE IN THE PROGRAM /ADDRA1 ADDRESS IN SYMTAB OF ARGUMENT 1 /ADDRA2 ADDRESS IN SYMTAB OF ARGUMENT 2 /ARGI ADDRESS OF CURRENT ENTRY IN ARG TABLE /ARG1 ADDRESS OF ARGUMENT 1 IN ARG TABLE /ARG2 ADDRESS OF ARGUMENT 2 IN ARG TABLE /ARG ARGUMENT DESCRIPTOR WORD /CHRCTR POSITION NUMBER OF CURRENT SYMBOL IN SYMTAB /CONTBC ADDRESS OF CURRENT ENTRY IN CONSTANT TABLE /FAOMOD POINTS TO CURRENT JUMP TABLE /FLS LOW HALF OF BUFFER FOR PACKING FORMATS AND HOLLERITH CONSTANTS /FMS HIGH ORDER HALF OF SAME BUFFER /FMTCNT COUNT OF CHARACTERS REMAINING IN ABOVE BUFFER /HFLG "HOLLERITH MODE" FLAG FOR FORMAT SCANNER /IDXNOP VALUE OF NEXT OPERATOR /IDXPOP VALUE OF PREVIOUS OPERATOR /IFFLAG ON IF CURRENT STMT IS AN IF STMT /LEVNOP PRECEDENCE LEVEL OF NEXT OP /LEVPOP PRECEDENCE LEVEL OF PREVIOUS OP /LOGIF ON IF LOGICAL IF STMT SEEN /LS LOW ORDER WORD FOR NUMBER CONVERSION /MODE MODE TYPE FOR SPECIFICATION STMTS /MODEA1 MODE OF ARG 1 /MODEA2 MODE OF ARG 2 /MS HIGH ORDER WORD FOR NUMBER CONVERSION /NAME1 FIRST WORD OF CONCATENATED SYMBOL /NAME2 SECOND WORD OF SYMBOL /NUMFLG "NUMBER COLLECTED" FLAG FOR FORMAT SCANNER /OP OPERATOR DESCRIPTOR WORD /OPI ADDRESS OF LAST ENTRY IN OPERATOR TABLE /OPVALU VALUE OF CURRENT OPERATOR /POP ADDRESS OF PREVIOUS OP IN OP TABLE /RELOPT RELATIONAL OPERATOR TYPE /S HIGH ORDER RESULT OF NUMBER CONVERSION /SHFCTR SHIFT COUNTER /SIGN ARGUMENT SIGN /SIGNA1 SIGN OF ARGUMENT 1 /SIGNA2 SIGN OF ARGUMENT 2 /SYMTW2 ADDRESS OF FIRST NAME WORD IN SYMTAB ENTRY /SYMT2A ADDRESS OF SECOND NAME WORD IN SYMTAB ENTRY /SYMTW3 ADDRESS OF LENGTH WORD OF SYMTAB ENTRY /SYMTW4 ADDRESS OF CHAIN WORD OF SYMTAB ENTRY /SYMTW5 ADDRESS OF DIM1 WORD IN SYMTAB ENTRY /SYMTW6 ADDRESS OF DIM2 WORD IN SYMTAB ENTRY /TARGI TEMPORARY HOLD FOR ARGI /TCTR TEMPORARY COUNTER /TEMP0 TEMPORARY ADDRESS HOLD /TFAO04 NUMERIC CONVERSION COMPLETE FLAG /TFAO05 EXPONENT SIGN /TLS TEMP HOLD FOR LS /TMS TEMP HOLD FOR MS /TOPI TEMP HOLD FOR OPI /TRELAD TEMPORARY FOR RELATIVE ADDRESS /TSI NAME OF NEXT INTEGER/LOGICAL TEMPORARY /TSR NAME OF NEXT REAL/DOUBLE INTEGER TEMPORARY /TSD NAME OF NEXT DOUBLE PRECISION TEMPORARY /TSMTBC TEMP HOLD FOR CURRENT SYMTAB ADDRESS /TSMTW4 TEMP HOLD FOR ADDRESS OF CURRENT CHAIN WORD /TYPEA1 TYPE OF ARGUMENT 1 /TYPEA2 TYPE OF ARGUMENT 2 .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 AND LOGICAL 1 REAL / 2 DOUBLE PRECISION 3 DOUBLE INTEGER / / A SYMBOL TABLE ENTRY IS EITHER 3 OR 8 WORDS LONG AND LOOKS LIKE THIS: / / WORD 1: BITS 0-2=SYMBOL TYPE, BITS 3-4=MODE, BITS 5-17=DEFINITION / THE VALUES FOR THE SYMBOL TYPE ARE: / 0 SCALAR NON-COMMON VARIABLE / 1 SCALAR COMMON VARIABLE / 2 EXTERNAL FUNCTION / 3 DUMMY ARGUMENT (ALSO USED FOR STATEMENT NUMBERS) / 4 NON-COMMON ARRAY / 5 COMMON ARRAY / 6 INTERNAL (STATEMENT) FUNCTION / 7 DUMMY ARRAY / / BITS 5-17 CONTAIN THE ACTUAL EXECUTION TIME ADDRESS DURING PASS 2 / DURING PASS 1 THEY ARE 17777 IF THE SYMBOL HAS NOT BEEN REFERENCED / IN AN EXECUTABLE STATEMENT, 17776 OTHERWISE / / WORD 2: FIRST WORD OF SYMBOL NAME -- BIT 0 ON IF 3 WORD SYMBOL / BIT 1 ON IF SYMBOL IS A DUMMY ARG USED AS A FUNCTION / / WORD 3: SECOND WORD OF SYMBOL NAME - BIT 0 ON IF MODE="LOGICAL" / / WORD 4: (IF ANY): AMOUNT OF STORAGE USED BY THIS SYMBOL / / WORD 5: (IF ANY): CHAIN POINTER TO NEXT VARIABLE IN EQUIVALENCE BLOCK / POINTS TO SELF IF VARIABLE NOT EQUIVALENCED OR IN COMMON / / WORD 6: (IF ANY):FIRST DIMENSION / WORD 7: (IF ANY):SECOND DIMENSION / / WORD 8: (IF ANY): OFFSET OF THIS VARIABLE FROM BEGINNING OF THE / COMMON OR EQUIVALENCE BLOCK TO WHICH IT BELONGS. FOR ARRAYS, WORD 8 / CONTAINS THE ADDRESS OF THE ARRAY WHILE WORD 1 CONTAINS THE ADDRESS / OF THE ARRAY DESCRIPTOR BLOCK / / / 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 02 02 .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. / 11 13 01 01 .XOR. / 12 14 06 06 - / 15 17 06 06 + / 18 22 07 07 / / 21 25 07 07 * / 24 30 09 11 UNARY NEGATION / 26 32 08 10 ** / 28 34 10 12 (F FUNCTION OR SUBSCRIPT OPERATOR / 30 36 00 00 , / 31 37 00 00 ) / 32 40 00 00 )F FUNCTION OR SUBSCRIPT CLOSURE / 34 42 00 00 ( .EJECT ARG0 .DSA ARG0+1 .REPT %ARGOP -1 ARGEND .DSA ARGEND /ARG.-OP. OVFLW. ADD. OP0 .DSA OP0+1 /OP(I) LIST START .REPT %ARGOP -1 EQU0 .DSA EQU0+1 .REPT 20 -1 EQCLSX .DSA EQCLSX /EQUIVALENCE CLASS LIST OVERFLOW ADDRESS / / / ARRAY DECLARATION SUBSCRIPT STORAGE T0 0 /WORDS PER ELEMENT T1 0 /FIRST SUBSCRIPT T2 0 /SECOND SUBSCRIPT T3 0 /THIRD SUBSCRIPT ATX .DSA ATX /LIMIT OF 3 SUBSCRIPTS AT1 .DSA T1 /ADDRESS OF FIRST SUBSCRIPT / /FILE NAME STORAGE FILE1 0 /FIRST HALF OF PROGRAM NAME SYMBOL FILE2 0 /SECOND HALF OF PROGRAM NAME SYMBOL TITLEA 15 /LINE TERMINATING CHAR FOR BATCH / / / 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 10 BASE -1 /TABLE BASEMX .DSA BASEMX /END OF TABLE BASEJ .DSA 0 /ADDRESS OF CURRENT LEVEL COUNTER / / / /BUFFER POINTERS / SINBF0 .DSA SINBFH+2 BINBF0 .DSA BINBFH+1 /ADDRESS (-1) OF BINARY BUFFER OBJBF0 .DSA OBJBFH+2 /ADDRESS OF OUTPUT BUFFER .EJECT / FILE EXTENSIONS / SRCEXT .SIXBT /SRC/ LSTEXT .SIXBT /LST/ BINEXT .SIXBT /BIN/ / / PASS1 INITIALIZATION / / INIT02 LAC CTLPSW SZA JMP INIT01 RSTRT JMP BEGIN .IFUND RSX M1BK .DSA 400000+MESSY1-2 JMS SUB990 M2BK .DSA 400000+MESSY5-2 / .READ -2 / INPUT COMMAND STRING CAL 02776 C00008 .DSA 000010 .DSA SINBFH Z77744 .DSA 777744 / .WAIT -2 CAL 00776 C00010 .DSA 000012 .ENDC .IFDEF RSX LAC (PARSAV-1) /RESTORE SAVE AREA DAC* C00008 LAC (SINBFH-1) DAC* C00009 LAW -45 DAC PARCNT LAC* 10 DAC* 11 ISZ PARCNT JMP .-3 LAC* 10 /RESTORE POINTERS ALSO DAC SINBUF LAC* 10 DAC CHRCNT LAC* 10 DAC CHRBUF LAC* 10 DAC CHRBF1 LAC* 10 DAC COL LAC (SKP) /SET UP TO JUMP OVER SWITCHES DAC SKPSWC STARTI=. .ENDC .TITLE PASS 1 INITIALIZATION / .IFUND RSX CAL 767 /.INIT -11 1 INM11 INIT02 START 0 .ENDC LAC CHR1 /INTERNAL FOR CR AND ESC IS 36 DAC CHARCR LAC CHR2 DAC CHARLT .IFDEF RSX LAC (DAT11) /ATTACH TO THE INPUT SOURCE FILE JMS ATTACH .ENDC LAW -32 /INITIALIZE IMPLICIT MODE TABLE (EDIT# 40) DAC HILET /RESET ALL ENTRIES IN THE IMPLICIT LAC DACTAB /TYPE TABLE TO THE FORTRAN DEFAULT VALUES DAC .+2 LAC S10000 XX /I THRU N ARE INTEGERS ISZ .-1 /ALL OTHER LETTERS ARE REAL ISZ HILET JMP .-3 /FIRST SET THE ENTIRE TABLE TO REAL .REPT 6,1 DZM IMTBL+10 /THEN SET I THRU N TO INTEGER LAC PASS1 /INITIALIZE.... DAC PASS / PASS SWITCH. .IFDEF RSX XCT SKPSWC /SKIP IF NOT FIRST TIME .ENDC DAC SYMMAP / NO SYMBOL MAP .IFDEF RSX LAC RSXBIN /GET PREVIOUS 'B' SWITCH SETTING, BUT XCT SKPSWC /SKIP IF NOT THE FIRST TIME .ENDC LAC OBSPCL /SPECIAL, POSITIVE NO-OP DAC OBINRY /OBINRY=+NOP(NO OUTPUT),-NOP(OUTPUT, PASS1) OR SKP LAC PASS2 DAC F4K .IFDEF RSX XCT SKPSWC .ENDC DAC OPTSWC /SUBSCRIPT CALCULATION IN-LINE : ON .IFDEF RSX XCT SKPSWC /SKIP IF NOT THE FIRST TIME .ENDC DAC SLIST /NO SOURCE LIST .IFDEF RSX XCT SKPSWC /SKIP IF NOT THE FIRST TIME .ENDC DAC LIST /NO LISTING DEVICE DAC FT2CNG .IFDEF RSX XCT SKPSWC /SKIP IF NOT THE FIRST TIME .ENDC DAC OLIST /NO OBJECT LIST LAC EQU0 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 .IFDEF RSX XCT SKPSWC /SKIP IF NOT FIRST TIME SKP JMP CMDA /GO DECODE THE FILE NAME .ENDC .IFUND %NOHDG /(RKB-069) DZM PAGCNT /(RKB-066) ZERO THE PAGE COUNTER .ENDC /(RKB-069) .IFUND %NOEOC /(RKB-069) DZM ERRCNT /(RKB-067) ZERO THE ERROR COUNTER. .ENDC JMS SIN520 .IFDEF RSX INIT13 JMS SIN500 /IGNORE UNTIL THE FIRST SPACE SAD CHARSP /IS IT A SPACE? JMP INIT08 /YES DECODE SWITCHES SAD CHARLT /ALTMODE? JMP CMDERR /YES COMMAND ERROR SAD CHARCR /CRTN? JMP CMDERR /YES COMMAND ERROR JMP INIT13 /NONE OF ABOVE TRY AGAIN .ENDC 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 RSX SAD CHARR /CHECK FOR R SWITCH ISZ VERPNT /SET OUTPUT ON TTY SWITCH .ENDC SAD CHARO JMP CMDO / O...OBJECT LIST SAD CHARS JMP CMDS / S...SYMBOL MAP SAD CHARH / H...NO IN-LINE SUBSCRIPT CALCULATION JMP CMDH SAD ARROW JMP CMDA /_...END OF OPTION LIST JMP INIT08 / ILLEGAL CHAR...IGNORE .IFUND RSX CMDERR JMS SUB990 /ERROR: CR OR ALT MODE BEFORE _ CMDERT-2 LAC* SCOM52 SPA JMP END999 /RETURN TO MONITOR IF IN BATCH JMP INIT02 .ENDC .IFDEF RSX CMDERR ISZ VERPNT /FORCE PRINTING ON TTY JMS SUB990 CMDERT-2 LAC C00013 /FORCE TDV TO BE CALLED DAC TITLEA JMP EXITF /EXIT FORTRAN .ENDC CMDB LAC PASS1 DAC OBINRY / SET BINARY OPTION FLAG .IFDEF RSX DAC RSXBIN /SAVE BINARY OPTION FLAG FOR RSX RE-ENTRIES .ENDC JMP INIT08 .IFDEF RSX RSXBIN XOR C00000 .ENDC CMDH LAC PASS1 /PUT A SKIP AT OPTSWC TO PREVENT IN-LINE DAC OPTSWC /SUBSCRIPT CALCULATION JMP INIT08 CMDL LAC PASS1 DAC SLIST / SET SOURCE LIST OPTION FLAG LSTSET DAC LIST JMP INIT08 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 .IFDEF RSX ENDCMR LAC (SINBFH-1) /SET UP TSAVE BUFFER DAC* C00008 LAC (PARSAV-1) DAC* C00009 LAW -45 /SAVE ALL 45 WORDS DAC PARCNT LAC* 10 DAC* 11 ISZ PARCNT JMP .-3 LAC SINBUF /SAVE THE POINTERS ALSO DAC* 11 LAC CHRCNT DAC* 11 LAC CHRBUF DAC* 11 LAC CHRBF1 DAC* 11 LAC COL DAC* 11 LAC S00054 /SET LAST CHARACTER READ TO 54 JMP CMDRTN / ENDCMA DZM UNFNBC /SET THE SWITCH TO STOP CHARACTER SCAN ISZ TCTR /6 CHARACTERS FOUND? JMP CMDM14 /NO TRY AGAIN JMP ENDCMR /YES -- SAVE POINTERS .ENDC CMDA DAC UNFNBC .IFDEF RSX JMS SUB990 /IDENTIFY IF R SWITCH .DSA 400000+MESSY1-2 .ENDC 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 .IFUND RSX JMP CMDERR /(RKB-066) IF YES, ERROR .ENDC .IFDEF RSX JMP ENDCMA /GO SAVE PARAMETERS .ENDC 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 .IFUND RSX JMP .+10 /FINISHED .ENDC .IFDEF RSX JMP .+12 .ENDC JMS FNBCHR /FIND TERMINATOR. .IFDEF RSX SAD S00054 /CHECK FOR COMMA TERMINATOR JMP ENDCMR /SAVE THE BUFFER .ENDC SAD C00013 SKP SAD S00175 SKP .IFUND RSX JMP .-5 .ENDC .IFDEF RSX JMP .-7 /NOT FOUND TRY AGAIN .ENDC CMDRTN=. DAC TITLEA LAC MS DAC FILE LAC LS DAC FILE+1 / SET UP FILE NAME LAC LSTEXT DAC FILE+2 / SET NAME EXTENSION (LST) LAC CHR3 /INTERNAL FOR CR AND ESC IS 00 DAC CHARCR LAC CHR4 DAC CHARLT LAC JMPFT2 DAC FT2CNG XCT LIST JMP TRYBIN .IFUND RSX CAL+5766 /(RKB-067) SUPPRESS LF ON .CLOSE 1 M3BK INIT02 PC 0 /PROGRAM COUNTER / .ENTER -12 / OPEN LISTING FILE CAL 00766 .DSA 000004 .DSA FILE .ENDC .IFDEF RSX LAC (DAT12) /ATTACH TO OUTPUT LISTING DEVICE JMS ATTACH LAC (DAT12) /ENTER ON 12 JMS ENTERR /ENTER FILE .ENDC TRYBIN LAC BINEXT DAC FILE+2 / SET NAME EXTENSION (BIN) XCT OBINRY JMP INIT01 .IFUND RSX CAL+1765 1 INIT02 FORMST 0 / .ENTER -13 / OPEN BINARY FILE CAL 00765 .DSA 000004 .DSA FILE .ENDC .IFDEF RSX LAC (DAT13) /ATTACH TO THE OUTPUT BINARY DEVICE JMS ATTACH LAC (DAT13) /LOOK FOR AN EXISTING BINARY FILE; IF NONE, JMS SEEK /'DELETE' IS SET TO KILL BAD BINARY LAC (DAT13) /ENTER THE BINARY FILE JMS ENTERR /ENTER FILE .ENDC .TITLE PASS 1 / PASS 2 COMMON INITIALIZATION / INIT01 JMS INDOTB /INITIALIZE DO TABLE POINTERS .IFUND RSX .CLOSE -3 /TYPE CR/LF .ENDC .IFDEF RSX JMS SUB990 /WRITE A CR LF ON THE OUTPUT TTY .DSA 400000+MESSY7-2 .ENDC DZM CTLPSW LAC SRCEXT DAC FILE+2 / SET NAME EXTENSION (SRC) .IFUND RSX / .SEEK -11,FILE CAL 00767 / LOCATE INPUT FILE .DSA 000003 .DSA FILE .ENDC .IFUND %NOHDG /(RKB-069) CLC /(RKB-067) DAC LINCNT /(RKB-067) LAC FILE /(RKB-066) PUT FILE NAME IN HEADER LMQ /(RKB-066) JMS CV6A /(RKB-066) CONVERT NEXT .SIXBT CHAR TO ASCII ALSS 13 /(RKB-066) PACK IT TO 5/7 DAC TOF+6 /(RKB-066) JMS CV6A /(RKB-066) GET CHAR 2 ALSS 4 /(RKB-066) PACK IT XOR TOF+6 /(RKB-066) WITH CHAR 1 DAC TOF+6 /(RKB-066) // JMS CV6A /(RKB-066) DO THE THIRD CLQ!LRSS 3 /(RKB-066) THIS IS THE SPLIT CHAR XOR TOF+6 /(RKB-066) PUT FIRST 4 BITS WITH OTHER 2 CHARS DAC TOF+6 /(RKB-066) // LACQ /(RKB-066) RECAL LOW 3 BITS OF THIRD CHAR DAC TOF+7 /(RKB-066) PUT IT IN HEADER LAC FILE+1 /(RKB-066) GET SECOND HALF OF FILE NAME LMQ /(RKB-066) JMS CV6A /(RKB-066) CONVERT CHAR 4 ALSS 10 /(RKB-066) POSITION IT XOR TOF+7 /(RKB-066) COMBINE IT DAC TOF+7 /(RKB-066) // JMS CV6A /(RKB-066) DO CHAR 5 RCL /(RKB-066) POSITION IT XOR TOF+7 /(RKB-066) // DAC TOF+7 /(RKB-066) // JMS CV6A /(RKB-066) SIXTH AND FINAL CHAR ALSS 13 /(RKB-066) SLIDE IT ALL THE WAY OVER XOR (001012) /(RKB-066) COMBINE WITH A SPACE AND 'S' FOR SRC DAC TOF+10 /(RKB-066) .ENDC /(RKB-069) .IFDEF RSX CAL SEEK11 /SEEK THE FILE CAL WFEVA /WAIT FOR EVENT VARIABLE LAC EVA SMA /LEGAL? JMP SKOKA /YES CONTINUE SAD (-6) JMP SKOKA /YES JMS IOERR /NO I/O ERROR SKOKA LAC (DAT11 /LUN IN CASE OF I/O ERROR .ENDC DZM SORDER / STATEMENT ORDERING COUNTER DZM LINMBR /(RKB-067) JMS BIN500 /BINARY OUTPUT BUFFER DZM XCHAR / SOURCE IMAGE REQUIRED LAC END23+1 DAC BINO06 /OBJECT LISTING BUFFER INITIALIZATION 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 FCNRET /AND POINTER TO SYMBOL DEFINED AS RETURN CODE DZM PROCAD DZM STAF /RESET TEMPORARY STORAGE LETTER FOR STATEMEMTFUNCTIONS DZM START /INITIALIZE STARTING ADDRESS .TITLE STATEMENT INITIALIZATION,RECOGNITION,EXECUTION,TERMINATION / CONTRL LAC K00001 /INITIALIZE.... DAC UNFNBC / FETCH NEXT CHARACTER INDICATOR DZM LOGIF / LOGICAL IF STATEMENT DZM RWEXPF /ZERO "I/O LIST" FLAG DZM LOGFLG /INITIALIZE "LOGICAL VARIABLE" FLAG DZM IMPLFG /ZERO "IMPLICIT STATEMENT" FLAG DZM LABEL / LABEL FIELD ENTRY DZM OBJB04 /VECTOR IS (IS NOT) A PARAMETER (OBJ LIST) 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* /CONSIDERATION. .IFUND %NOHDG /(RKB-069) CV6A XX /(RKB-066) ROUTINE TO CONVERT SIXBIT TO ASCII LLSS!1000 6 /(RKB-066) GET NEXT CHAR SNA /(RKB-066) IS IT NULL? AAC 40 /(RKB-066) YES, MAP IT TO SPACE AAC 40 /(RKB-066) DO THE CONVERTION XOR (140) /(RKB-066) // JMP* CV6A /(RKB-066) THATS IT .ENDC /(RKB-069) .EJECT /SUBROUTINE TO FETCH STATEMENT LABEL / CTRL00 SYN ARGI 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 CONSISTING OF 1-5 DECIMAL DIGITS DAC FETSNO LAC XCHAR /IF THE STATEMENT NUMBER DID NOT SAD C00009 /TERMINATE WITH A TAB, THEN WE MUST JMP CTRL01 /CHECK THE COLUMN COUNTER TO MAKE SURE LAW -7 /THAT THE NON-DIGIT, NON-SPACE CHARACTER TAD COL /OCCURRED IN OR AFTER COLUMN SEVEN ERN 08N,SPA,EN /OTHERWISE ILLEGAL ST. NO. CTRL01 LAC FETSNO /RESTORE AC SMA /AC NEGATIVE MEANS NO DIGITS FOUND JMP CTR01 CLA JMP CTRL03 CTR01 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 DAC PC /IS CHECKED AGAINST THE OLD DEFINITION ERR 01N,16340,EN /AND AN ERROR IS SIGNALLED IF DIFFERENT JMP CTRL05 /USED MORE THAN ONCE AS A STATEMENT LABEL. CTRL04 LAC PC /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 .EJECT / SUBROUTINE TO AVOID ILLEGAL MEM REFS / FAKE CAL 0 DAC BINBFH+1 /SAVE AC LAC* FAKE AND S17777 /(17777 XOR LACCMD /(200000 DAC .+1 XX .IFUND RSX AND S60000 /MAKE SURE JMS TWOCMA /OF LEGAL ADDR. TAD BNKBTS SNL .ENDC .IFDEF RSX AND (77777) TCA /THIS IS THE RIGHT WAY I HOPE !! TAD ENDPAR SPA .ENDC ISZ FAKE /DO NOT EXECUTE INSTRUCTION LAC BINBFH+1 JMP* FAKE .EJECT / STATEMENT RECOGNITION DECODING MATRIX / / INITIAL MODE ROW CTRLIM JMP CTRLIM /TYPE CHARACTER JMP CTRL11 /01 NUMERIC 0123456789 JMP CTRL12 /02 ALPHABETIC BCJKMNQSUVWYZ JMP CTRL12 /03 ALPHABETIC ED JMP CTRL12 /04 ALPHABETIC AEFGHILPXORT JMP CTRL13 /05 OPERATOR +- JMP CTRL13 /06 OPERATOR */ JMP CTRL13 /07 PERIOD . JMP CTRL14 /08 PARENTHESIS ( JMP CTRL15 /09 PARENTHESIS ) JMP CTRL16 /10 DELIMETER ,= JMP CTRL13 /11 SPACE JMP CTRL55 /12 QUOTES "$ JMP CTRL13 /13 PARTWD [ JMP CTRL13 /14 MISC :];#@ / / SYMBOLIC MODE ROW CTRLSM JMP CTRLSM /TYPE CHARACTER JMP CTRL18 /01 NUMERIC 0123456789 JMP CTRL18 /02 ALPHABETIC BCJKMNQSUVWYZ JMP CTRL18 /03 ALPHABETIC ED JMP CTRL18 /04 ALPHABETIC AFGHILPXORT JMP CTRL13 /05 OPERATOR +- JMP CTRL13 /06 OPERATOR */ JMP CTRL13 /07 PERIOD . JMP CTRL14 /08 PARENTHESIS ( JMP CTRL15 /09 PARENTHESIS ) JMP CTRL16 /10 DELIMITER ,= JMP CTRL18 /11 SPACE JMP CTRL55 /12 QUOTES "$ JMP CTRL13 /13 PARTWD [ JMP CTRL13 /14 MISC :];#@ / / NUMERIC MODE ROW CTRLNM JMP CTRLNM /TYPE CHARACTER JMP CTRL18 /01 NUMERIC 0123456789 JMP CTRL13 /02 ALPHABETIC BCJKMNQSUVWYZ JMP CTRL13 /03 ALPHABETIC ED JMP CTRL19 /04 ALPHABETIC AFGHILPXORT JMP CTRL13 /05 OPERATOR +- JMP CTRL13 /06 OPERATOR */ JMP CTRL13 /07 PERIOD . JMP CTRL14 /08 PARENTHSEIS ( JMP CTRL15 /09 PARENTHESIS ) JMP CTRL16 /10 DELIMETER ,= JMP CTRL18 /11 SPACE JMP CTRL55 /12 QUOTES "$ JMP CTRL13 /13 PARTWD [ JMP CTRL13 /14 MISC :];#@ .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). ERS 19X,,EX1 /**058** IF PAREN COUNT GOES NEGITIVE /TELL THE USER HE'S MESSED UP AND HAS /TOO MANY RIGHT PARENS 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. ERS 01D,,ED /ERROR IF OTHERWISE 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 DZM ASSTMT /GETS ISZ'D IF ASSMNT STATEMENT LAC LOGIF SZA JMP CTRL29 CTRL07 LAC Y00000 JMS CTRL50 /BECAUSE A LOGICAL IF STATEMENT MAY SAD IFMNE /CONTAIN AN ASSIGNMENT STATEMENT, THE SKP /**59** CHECK IF REALLY PAREN JMP CTRLXX /**059** THIS IS NECESSARY BECAUSE LAC S00050 /**059** SOMEBODY DEFINED THE INTERNAL SAD XCHAR /**59** CODES FOR '5' AND '(' AS THE SAME JMP CTRL22 /**059** IT'S A '(' - PAREN CTRLXX NOP /**059** 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 CTRL29 LAC OP SNA JMP CTRL07 JMS CTRL80 /FUNCTIONS) OR A NON-ASSIGNMENT STATEMENT. JMS SIN540 /AFTER THE STORAGE ASSIGNMENTS HAVE BEEN JMS CTRL00 /(FETCH STATEMENT LABEL) LAC V40000 DAC TORDER /SET ORDER (TENTATIVELY) TO EXECUTABLE STMT JMS FVARGO /THE ASSIGNMENT DZM CTRLSW /VARIABLE AND ITS DELIMETER ARE FETCHED. DAC UNFNBC /RESET "BACKUP CHARACTER" FLAG DZM PROCAD /INDICATE ASSIGNMENT OR FUNCTION STATEMENT. SAD C00028 /THE STATEMENT IS IDENTIFIED AS A LAC* ARG /STATEMENT FUNCTION WHEN THE DELIMITER AND V00000 /INDICATES A FUNCTION OR SUBSCRIPT AS THE FIRST SAD U00000 /OPERATOR AND THE FIRST VARIABLE TYPE JMP STAFCN /IS THAT OF A FUNCTION JMS SIN540 /EXECUTABLE STATEMENT- DZM STAF /RE-INITIALIZE TEMPORARY SUFFIX ISZ ASSTMT /SET TO 1, TESTED IN EXPRSN FOR VALID = JMS EXPRSN /ASSIGNMENT STATEMENT IS DECODED. LAW -110 /**052** ARE WE INBOUNDS? LIKE WITHIN TAD COL /**052** COL. 73?? SMA!CLA /**052** IF NOT FORGET ABOUT THE TEST JMP STEXIT /**052** WE'RE NOT IN BOUNDS SO GET ON WITH THE WORK LAC XCHAR /**052** IN BOUNDS - CHECK LAST NON BLANK FOR A C/R ERS 34X,,EX /**052** IF NOT A C/R THEN GIVE AN ERROR .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 /(WHEN NECESSARY) TO A STATEMENT ADDRESS. DOCLEN LAC DOTABA SAD .FFREE /IF THERE ARE NO ENTRIES IN THE DO TABLE, JMP CONTRL /DO NOT SEARCH FOR TERMINATION TAD K00001 /IF ONE OR MORE DO LOOPS ARE STILL OPEN, DAC TRW2 /CHECK WHETHER LAC LABEL /THE LABEL ON THE CURRENT STATEMENT SNA JMP CONTRL /(IF THERE IS ONE) SAD* TRW2 /IS THE TERMINATING LABEL OF THE HIGHEST JMP DO23 /LEVEL DO LOOP. DO21 LAC TRW2 /IF NOT, CHECK ALL OTHER DO LOOPS TO SEE SAD .FFREE /IF THIS IS THE TERMINATING LABEL JMP CONTRL /OF ANY LOWER LEVEL DO LOOP TAD K00001 DAC TRW2 LAC* TRW2 /IF IT IS, A DO LOOP NESTING ERROR EXISTS. SAD LABEL JMP DO22 JMP DO21 /LOOP FOR ALL CURRENT DO LOOPS DO23 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 DECDTP LAC* DOTABB /STATEMENT TYPE O.K. -- OUTPUT DO CLEANUP XOR JMPCMD JMS RELBIN /OUTPUT THE JUMP BACK INTO THE LOOP LAC* DOTABC JMS STRING /AND STRING THE EXIT JUMP JMP DOCLEN /TEST NEXT LOWER NESTING LEVEL. DO24 ERN 09D,,ED /ERROR: ILLEGAL TERMINATING STMT DO22 ERN 02L,,EL /ERROR: ILLEGAL DO NESTING .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 ENDMNE /ENDFILE MUST BE RECOGNIZED SEPARATELY AS JMP CTRL37 /THE FIRST 3 CHARACTERS OF EACH PAIR ARE IDENTICAL IMCTRL SAD REAMNE /(ENTRY HERE FROM "IMPLICIT" STATEMENT) JMP CTRL36 JMP CTRL38 CTRL36 JMS FNBCHR /WHEN THE FIRST THREE CHARACTERS ARE REA, SAD S00114 /AN ERROR IS ANNOUNCED IF THE CHARACTER JMP CTRL40 /IS NEITHER D NOR L ERS 13I,,EI 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 /IF ITS A CARRIAGE RETURN, THE STATEMENT IS JMP END /AN END STATEMENT - OTHERWISE WE CHECK FOR ERS 14I,,EI /AN "ENDFILE" STATEMENT. LAC Y00000 JMS CTRL50 /CHECK THE NEXT 3 CHARACTERS FOR "ILE" ERS 15I,,EI /ERROR: MISSPELLED STATEMENT. 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 ERN 01I,,EI /RAN OUT OF NAMES - ERROR 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. JMP CTRL38+1 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 /NEXT TIME IN BITS 0-1 /THE STATEMENT IS IDENTIFIED WHEN ALL CHARACTERS LAC* TCTR /TO DATE HAVE BEEN RECOGNIZED AND THE NUMBER OF AND T77777 /CHARACTERS TO EXAMINE NEXT TIME IS ZERO. ERS 02I,,EI /ERROR: CHARACTERS NOT MATCHED 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 SNA /CHECK FOR "DOUBLE" STATEMENT JMP DBLEXX /WHICH IS A FUDGE LAC IMPLFG SZA!CLL /ARE WE IN AN "IMPLICIT" STATEMENT? JMP IMPL01 /YES - GO CHECK THE KIND OF STATEMENT WE LAC PROCAD /FOUND SAD IMPLAD SKP /KLUDGE - "IMPLICIT" STMT HAS ORDER 1/2 AND Z00000 /THE SPECIFICATION STATEMENTS MUST BE RCR /PROCESSED IN A PRESCRIBED MANNER. DAC TORDER /THEREFORE THE ORDER NUMBER OF THE CURRENT JMS TWOCMA /STATEMENT IS COMPARED AGAINST THE ORDER TAD SORDER /OF THE LAST STATEMENT. ERN 03I,SMA!SZA,EI /ERROR: STATEMENT OUT OF ORDER. JMS TSTORD /STATEMENTS ARE ORDERED AS FOLLOWS... JMP CTRL33 / 00 BLOCK DATA, FUNCTION, SUBROUTINE / 01 INTEGER, REAL, LOGICAL, DBL PREC, DBL INT. LAC TORDER / 02 DIMENSION TAD Z00000 / 03 COMMON SPA / 04 EQUIVALENCE, EXTERNAL (FLOATS) JMP CTRL34 / 05 DATA STATEMENT XCT PASS / 06 STATEMENT FUNCTIONS / 07 ALL OTHERS JMP SEMI00 /CHECK FOR COMMON-DATA ';' OR DIMEN, PASS 2 JMP CTRL34 /STORAGE ASSIGNMENT STATEMENTS ARE NOT CTRL33 SZA /PROCESSED DURING PASS 2. JMS CTRL80 /ONLY DATA STATEMENTS AND STORAGE /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 DBLEXX LAC U00000 /"DOUBLE" STATEMENT CAN EITHER BE "DOUBLE INTEGER" JMS CTRL50 /OR "DOUBLE PRECISION" - GET A CHARACTER AND JMP CTRL38 /KEEP DECODING THE STATEMENT SEMI00 LAC TORDER /WANT TO TRAP DIMENSION STATEMENTS IN PASS 2 SAD T00000 /SUCH THAT ADJUSTABLE DIMENSION MAY BE JMP DIMENS /PROCESSED TO OUTPUT ADJUSTMENT ROUTINES SAD T40000 JMP SEMI01 /LOOK FOR COMMON SEMICOLON FUDGE JMP CONTRL /IF NOT A COMMON STMT, FORGET IT SEMI01 JMS FNBCHR /GET A CHAR SAD S00073 /IF ITS A SEMICOLON, JMP SEMI02 /WE'VE FOUND OUR KLUDGE SAD C00013 JMP CONTRL /AHHH... AN ORDINARY COMMON STATEMENT JMP SEMI01 /KEEP LOOKING SEMI02 LAC U40000 /CHANGE THE STATEMENT ORDER DAC TORDER /TO THAT OF A DATA STATEMENT LAC FCNFLG /THE SEMICOLON CONSTRUCTION ERS 11I,,EI /IS ONLY GOOD IN A BLOCK DATA JMP DATA /SUBPROGRAM T40000 140000 S00073 73 ASSTMT XX .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 620775 /EQU .DSA 400000+EQUIVA /EQUIVALENCE .DSA 600020 /P (FUDGE) DBPRAD .DSA 100000+DBLPRC /DOUBLE PRECISION .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 .DSA 600011 /I (FUDGE) DBINAD .DSA 100000+DBLINT /DOUBLE INTEGER .DSA 621424 /EXT .DSA 400000+EXTERN /EXTERNAL .DSA 612446 /CON .DSA 700000+CONTIN /CONTINUE FUNMNE .DSA 624326 /FUN .DSA 000000+FUNCTI /FUNCTION .DSA 635130 /IMP IMPLAD .DSA 000000+IMPLIC /IMPLICIT .DSA 635204 /INT INTEAD .DSA 100000+INTEGE /INTEGER .DSA 646537 /LOG LOGIAD .DSA 100000+LOGICA /LOGICAL .DSA 612445 /COM .DSA 300000+COMMON /COMMON .DSA 670534 /RET RETADR .DSA 700000+RETURN /RETURN .DSA 620563 /ENC .DSA 700000+ENCODE /ENCODE .DSA 614713 /DEC .DSA 700000+DECODE /DECODE .DSA 615555 /DOU .DSA 0 /DOUBLE SOMETHING .DSA 623752 /FOR .DSA 700000+FORMAT /FORMAT .DSA 604513 /ASS .DSA 700000+ASSIGN /ASSIGN .DSA 670537 /REW .DSA 700000+REWIND /REWIND .DSA 511231 /WRI .DSA 700000+WRITE /WRITE .DSA 462075 /PAU PAUSAD .DSA 700000+PAUSE /PAUSE .DSA 463331 /PRI .DSA 700000+WRITE /PRINT .DSA 420604 /ENT .DSA 700000+ENTRY /ENTRY .DSA 211364 /CAL .DSA 700000+CALL /CALL .DSA 214474 /DAT DATAAD .DSA 500000+DATA /DATA .DSA 274757 /STO STOPAD .DSA 700000+STOP /STOP .DSA 300370 /TYP .DSA 700000+WRITE /TYPE .DSA 227054 /GOT GOTOAD .DSA 700000+GOTO /GOTO IFMNE .DSA 034522 /IF( IFADDR .DSA 700000+IF /IF 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 / / 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 635661 /IVA EQUIVALENCE .DSA 670513 /REC DOUBLE PRECISION .DSA 671355 /ROU SUBROUTINE .DSA 620603 /ENS DIMENSION .DSA 612174 /CKD BLOCK DATA .DSA 643710 /KSP BACKSPACE .DSA 655245 /NTE DOUBLE INTEGER .DSA 421036 /ERN EXTERNAL .DSA 477166 /TIN CONTINUE CTIMNE .DSA 412751 /CTI FUNCTION .DSA 446153 /LIC IMPLICIT .DSA 220135 /EGE INTEGER .DSA 234271 /ICA LOGICAL .DSA 051646 /MON COMMON .DSA 103036 /URN RETURN .DSA 057145 /ODE ENCODE .DSA 057145 /ODE DECODE .DSA 007145 /BLE DOUBLE .DSA 050574 /MAT FORMAT .DSA 034546 /IGN ASSIGN .DSA 035164 /IND REWIND .DSA 001445 /TE WRITE .DSA 001375 /SE PAUSE .DSA 001104 /NT PRINT .DSA 001351 /RY ENTRY C00012 .DSA 000014 /L CALL C00001 .DSA 000001 /A DATA C00016 .DSA 000020 /P STOP .DSA 000005 /E TYPE C00015 .DSA 000017 /O GOTO / SIDTB2=. .DSA 445726 /LEN EQUIVALENCE .DSA 435501 /ISI DOUBLE PRECISION .DSA 277166 /TIN SUBROUTINE .DSA 035246 /ION DIMENSION .DSA 004541 /ATA BLOCK DATA .DSA 003275 /ACE BACKSPACE .DSA 026232 /GER DOUBLE INTEGER .DSA 000064 /AL EXTERNAL .DSA 001515 /UE CONTINUE ONMNE .DSA 001146 /ON FUNCTION .DSA 000574 /IT IMPLICIT C00018 .DSA 000022 /R INTEGER .DSA 000014 /L LOGICAL / SIDTB3=. .DSA 000175 /CE EQUIVALENCE .DSA 001146 /ON DOUBLE PRECISION C00005 .DSA 000005 /E SUBROUTINE / .EJECT / SUBROUTINE TO CONCATENATE N NON-BLANK CHARACTERS / CALLING SEQUENCE... / LAC N /N IS CONTAINED IN BITS 0 AND 1 / JMS CTRL50 / CTRL50 SYN ARG1 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) / / PROCESS " AND ' AND $ DURING STATEMENT SCAN / CTRL55 LAC XCHAR DAC CTRL50 /SAVE OPENING QUOTE CTRL56 JMS FETCHR SKP JMP CTRL19 /LINE DONE LAC XCHAR SAD CTRL50 JMP CTRL13 /CLOSE QUOTE - RETURN TO MAIN SCAN JMP CTRL56 /KEEP LOOKING .EJECT / SUBROUTINE TO TEST FOR STATEMENT TERMINATION CHARACTER / CALLING SEQUENCE... / JMS CTRL60 / JMP NO / XXX YES / CTRL60 SYN RELOPT 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 / / / / SUBROUTINE TO DETERMINE IF STATEMENT IS ERRONEOUSLY LABELED / CTRL70 SYN ARG2 LAC LABEL SNA /NO ACTION IS TAKEN IF THE STATEMENT IS JMP* CTRL70 /NOT LABELED. ERR 02N,16340,EN /A RECOVERABLE ERROR IS ANNOUNCED LAC V77777 /IF THE 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. / / / / SUBROUTINE TO ANNOUNCE AN ERROR WHEN A BLOCK DATA SUBPROGRAM CONTAINS / EXECUTABLE STATEMENTS / CTRL80 SYN OPI /NO ACTION IS TAKEN WHEN THE CURRENT LAC FCNFLG /SOURCE PROGRAM IS NOT A BLOCK DATA ERN 04I,,EI /SUBPROGRAM JMP* CTRL80 .TITLE STORAGE ALLOCATION STATEMENTS IMPLIC LAC S40000 /IMPLICIT IS OF ORDER 3/2 - I.E. DAC TORDER /IT COMES AFTER A "SUBROUTINE" STATEMENT ISZ IMPLFG /BUT BEFORE ANY TYPE STATEMENT XCT PASS /LIKE THE TYPE STATEMENTS, JMP CONTRL /IT IS IGNORED ON PASS 2 IMPGRP LAC Y00000 /BEGINNING OF IMPLICIT GROUP: GET THE JMS CTRL50 /NEXT THREE CHARACTERS JMP IMCTRL /AND DECODE THE RESULTING ATATEMENT IMPL01 LAC PROCAD /STATEMENT DECODER COMES HERE WHEN ITS DONE SAD REALAD LAC S20000 /DETERMINE IF THE STATEMENT IS A TYPE STATEMENT SAD INTEAD /AND SET THE MODE ACCORDINGLY CLA SAD DBPRAD LAC S40000 SAD DBINAD LAC S60000 SAD LOGIAD CLA!CML RAR /THE IMPLICIT MODE TABLE CONSISTS OF THE MODE DAC MODE /SHIFTED RIGHT 1 AND THE LOGICAL FLAG IN THE SIGN AND SI7777 /NOW TEST IF WE GOT SOMETHING ERN 08I,SZA,EI /THE STATEMENT WASN'T A TYPE STATEMENT JMS FNBCHR ERS 12I,,EI /NEXT CHAR BETTER BE ( IMPCMA JMS GETLET /GET A LETTER AND FORM A POINTER DAC LOLET /SET LOWER LIMIT DAC HILET /HIGHER LIMIT = LOWER LIMIT JMS FNBCHR SAD C00045 /IS IT A RANGE OR A SINGLE VALUE? JMP IMDASH /A RANGE IMPCMN LAC HILET /THIS IS WHERE WE SET THE TABLE - CMA /COMPUTE THE NUMBER OF ENTRIES IN THE RANGE TAD LOLET DAC HILET ERN 21I,SMA,EI /HIGHER LIMIT < LOWER LIMIT - ERROR LAC MODE LOLET XX /STORE THE MODE INTO THE TABLE ISZ LOLET ISZ HILET JMP LOLET /AS MANY TIMES AS NECESSARY LAC XCHAR SAD S00054 /WAS TERMINATOR A COMMA? JMP IMPCMA /YES - GET ANOTHER RANGE ERS 22I,,EI /BETTER BE A ) JMS FNBCHR SAD S00054 /IS THERE ANOTHER GROUP? JMP IMPGRP /YES XCT PASS JMP CRTEST /ONLY REDEFINE VARIABLES DURING PASS 1 LAC SYMTB0 /NOW GO THROUGH THE SYMBOL TABLE IMPSLP DAC SYMTBC /AND RE-TYPE ALL VARIABLES SAD SYMTBN /WHICH ARE NOT ALREADY EXPLICITLY TYPED JMP CRTEST JMS SETADR LAC* SYMTW2 /GET THE HIGH ORDER NAME WORD JMS OBJ560 /EXTRACT THE FIRST CHARACTER TAD K01600 LAC OBJB01 /OBJB01 CONTAINS FIRST RADIX 50 CHARACTER SAD C00028 /PERIOD? JMP IMNEXT /YES - SYSTEM SYMBOL - DON'T TYPE IT TAD LACTAB DAC .+1 /INDEX INTO THE TABLE OF IMPLICIT MODES XX RCL /DECOMPOSE THE TABLE ENTRY INTO THE MODE DAC MODE /AND THE "LOGICAL VARIABLE" FLAG CLA!RAR DAC LOGFLG LAC* SYMTW6 RAL /EXPLICIT TYPE BIT IN SIGN OF SYMTW6 LAC* SYMTBC AND Z17777 /AND OUT MODE BITS XOR MODE SNL DAC* SYMTBC /RE-STORE IF NOT EXPLICITLY DEFINED LAC* SYMT2A XOR LOGFLG SNL DAC* SYMT2A /SIMILIARLY RESTORE LOGICAL FLAG IMNEXT JMS SBSE50 /GO TO NEXT ENTRY JMP IMPSLP /AND LOOP IMDASH JMS GETLET /RANGE INDICATED - GET UPPER LIMIT DAC HILET JMS FNBCHR /GET TERMINATOR JMP IMPCMN / GETLET CAL 0 /SUBROUTINE TO GET A LETTER JMS FNBCHR TAD K00133 CLL TAD C00026 /TEST FOR CHARACTER IN THE RANGE 101-132 OCTAL ERN 20I,SNL,EI TAD DACTAB /FORM AN INSTRUCTION JMP* GETLET K00133 .DSA 777645 DACTAB DAC IMTBL LACTAB LAC IMTBL-1 IMTBL .BLOCK 32 /IMPLICIT TABLE - 26 WORDS LONG HILET 0 S10000 .DSA 10000 IMPLFG .DSA 0 SI7777 .DSA 7777 .EJECT / EXTERNAL STATEMENT PROCESSOR / EXTERN JMS CTRL80 /EXTERNAL CANNOT APPEAR IN BLOCK DATA SUBR. EXTE03 JMS FVARGO /THE EXTERNAL STATEMENT IS USED TO DECLARE LAC* SYMTBC /THE NAMES OF EXTERNAL FUNCTIONS WHICH AND Z00000 /WILL APPEAR AS FUNCTION PARAMETERS WITHOUT SAD V00000 /(BY SETTING SPECIAL BIT IN SYMTAB, DUMMY JMP EXTE02 /VARIABLES CAN BE EXTERNAL) ERN 01E,SZA,EE /PARAMETER LISTS SO THAT THEY MAY BE EXTE01 LAC* SYMTBC /DISTINGUISHED FROM SIMPLE VARIABLES. AND S60000 /GET THE SYMTAB ENTRY FOR THE FUNCTION, SAVE ITS XOR U17777 /MODE, AND TYPE IT AS A FUNCTION. DAC* SYMTBC /THE LISTED NAMES CANNOT REPRESENT... LAC OPVALU / (1) ALREADY DECLARED FUNCTION NAMES SAD C00030 / (X) DUMMY VARIABLES ARE ALLOWED JMP EXTE03 / (2) VARIABLES ASSIGNED TO A COMMON BLOCK LAC SORDER / (3) ARRAYS DAC TORDER JMP CRTEST EXTE02 LAC* SYMTW2 /BIT 1 OF SECOND SYMTAB WORD IS AND U00000 /SET IF A DUMMY ARG USED AS A FUNCTION SZA /MUST NOT ALREADY BE SET JMP EE01E LAC* SYMTW2 /SET THE SPECIAL BIT XOR U00000 DAC* SYMTW2 JMP EXTE01 U17777 .DSA 217777 /UNDEFINED EXTERNAL .EJECT / DOUBLE INTEGER STATEMENT PROCESSOR / DBLINT 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 SKP!CLL LOGICA CLA!CLL!CML /LOGICAL=INTEGER BUT SET A FLAG DAC MODE /MODE IS INDICATED BY 0 CLA!RAR DAC LOGFGX /SAVE LOGICAL-INTEGER FLAG 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. .EJECT / DIMENSION STATEMENT PROCESSOR - ALSO USED BY TYPE STATEMENTS /ALLOWS PASS2 PROCESSING OF ARRAYS TO GET ADJUSTABLE DIMENSION DIMENS JMS FVARGO /GET A VARIABLE NAME LAC MODE /IF WE ARE IN A DIMENSION STATEMENT (MODE=-1) SPA /THEN WE SHOULDN'T CHECK FOR MODE REDEFINITION. JMP DIMN01 XCT PASS /NOR SHOULD WE CHECK FOR MODE REDEFINITION IN JMP DIMN05-3 /PASS 2 LAC* SYMTW6 /IF VARIABLE MODE ALREADY EXPLICITLY SET, BIT 0 ERN 01V,SPA,EV /OF SYMTW6 WILL BE ON - REPORT AN ERROR. 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 Z17777 /STATEMENT. THE IMPLICIT MODE OF THE NAME XOR MODE /(BASED ON THE FIRST CHARACTER OF THE NAME) IS DAC* SYMTBC /OVERRIDDEN AND THE EXPLICIT MODE SUBSTITUTED. JMS SETN /RECOMPUTE THE ELEMENT LENGTH DAC* SYMTW3 /AND SAVE IT LAC* SYMT2A AND V77777 XOR LOGFGX /THE "LOGICAL FLAG" IN SYMT2A IS PART OF THE MODE DAC* SYMT2A LAC OPVALU SAD C00028 /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 ERN 01X,,EX /CR TERMINATES, OTHERWISE ERROR JMP STEXIT DIMN01 LAC OPVALU /DIMENSION STATEMENTS MAY CONTAIN ONLY ERS 01C,,EC /ARRAY DECLARATIONS. DIMN03 JMS FEDIMN /THE ARRAY DIMENSIONS ARE OBTAINED AND JMP DIMN05 /ENTERED INTO THE SYMBOL TABLE. LOGFLG .DSA 0 LOGFGX .DSA 0 .EJECT / COMMON STATEMENT PROCESSOR / COMMON JMS FNBCHR /LABELED COMMON IS INDICATED BY ENCLOSING SAD C00047 JMP COMN01 /THE LABELING NAME IN SLASHES. THE ABSENCE DZM UNFNBC COMN03 LAC BLANKC /OF SLASHES INDICATES BLANK COMMON. DAC NAME1 /BLANK COMMON IS TREATED IN THE SAME DZM NAME2 JMS SYMBSE /MANNER AS LABELED COMMON AND SO THE JMP COMN02 /COMPILER ASSIGNS A LABEL TO BLANK COMMON. COMN01 JMS FNBCHR /TWO SLASHES WITH NO NAME BETWEEN THEM SAD C00047 JMP COMN03 /ALSO INDICATE BLANK COMMON. DZM UNFNBC JMS FVARGO /FETCH THE BLOCK NAME ERS 02C,,EC /NAME MUST END WITH SLASH 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 ERS 03C,,EC /AS A COMMON BLOCK NAME LAC* SYMTW7 /CHECK WHETHER THE BLOCK IS EMPTY SNA JMP COMN04 JMS TSETAD 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* SYMTW7 /LABEL AND THE BLOCK SIZE IS RESET TO ZERO JMS TSETAD COMN09 JMS FVARGO JMS SYMTYP /THE NAMES OF THE DATA WORDS (ARRAYS) OBSPCL XOR C00000 /ASSIGNED TO THE COMMON BLOCK MUST ERX 04C,EC /INITIALLY REPRESENT NON-COMMON VARIABLES LAC OPVALU /OR ALREADY DECLARED TO BE IN COMMON. SAD C00028 /ARRAY DECLARATIONS ARE LEGAL ON COMMON JMS FEDIMN /STATEMENTS. LAC* TSMTW7 /VARIABLES IN COMMON ARE ASSIGNED RELATIVE DAC* SYMTW7 /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* SYMTW3 /THE SIZE OF THIS VARIABLE (OR ARRAY) IS TAD* TSMTW7 /ADDED TO THE EXISTING SIZE OF THE COMMON DAC* TSMTW7 /BLOCK TO WHICH IT IS ASSIGNED JMS CHAIN /THE VARIABLE (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 C00045 /SEMICOLON? JMP SEMI02 /YES - ITS THE COMMON-DATA KLUDGE 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 / EQUIVALENCE STATEMENT PROCESSOR / EQUIVA JMS FNBCHR /GET CHARACTER ERS 05C,,EC /BETTER BE ( 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 /THE EQUIVALENCE CLASS IS INITIALIZED UPON LAC OPVALU /ENCOUNTERING THE FIRST VARIABLE ERS 06C,,EC /ERROR: ONLY 1 VAR IN CLASS 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 XOR T00000 /IS THE VARIABLE IN COMMON? JMP EQUI04 /NO - ADD VARIABLE TO EQUIVALENCE CLASS LAC COMCLS /WE WILL MERGE THIS EQUIVALENCE CLASS WITH ERN 07C,SZA,EC /THE VARIABLE'S COMMON (UNLESS THE LAC C00001 /CLASS IS ALREADY IN COMMON, IN WHICH CASE AN DAC COMCLS /ERROR EXISTS.) A COMMON DAC OLDCLS /BLOCK IS A SPECIAL CASE EQUIVALENCE CLASS. EQUI01 LAC RELADR JMS TWOCMA TAD* SYMTW7 /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 EQUI04 LAC* SYMTW4 SAD CHRCTR JMP EQUI05 LAC COMCLS SNA JMP EQUI01 LAC CHRCTR DAC FSTVAR LAC* SYMTW7 JMS TWOCMA TAD RELADR DAC DIFF SKP EQUI16 JMS NTHSYM LAC* SYMTW7 /MERGING ANOTHER CLASS INTO A CLASS TAD DIFF /IN COMMON - ADD IN THE PROPER OFFSET DAC* SYMTW7 SMA /CHECK THAT THE NEW OFFSET IS NOT JMP .+4 /NEGATIVE, AS THIS MEANS WE HAVE ERR 08C,16060,EC /UNDERFLOWED THE COMMON BLOCK DZM* SYMTW7 /SET OFFSET TO ZERO AND CONTINUE LAC* SYMTBC AND Y77777 XOR T00000 /FORCE THE COMMON INDICATOR ON DAC* SYMTBC /FOR THIS VARIABLE. LAC* SYMTW4 SAD FSTVAR JMP EQUI17 JMP EQUI16 EQUI06 JMS TSETAD LAC HEDCLS /THE PREVIOUS AND CURRENT CLASSES ARE EQUI12 JMS NTHSYM /MERGED WHEN THE CURRENT CLASS CONTAINS LAC* SYMTW7 /MORE THAN ONE MEMBER. THE PREVIOUS CLASS TAD DIFF DAC* SYMTW7 LAC COMCLS /THESE 7 LINES CORRECT AN EQUIV BUG SNA JMP .+5 LAC* SYMTBC AND Y77777 XOR T00000 DAC* SYMTBC 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 EQUI11 LAC DIFF /CLASSES HAVE TWO OR MORE MEMBERS IN COMMON /IF SO, THE RELATIVE ADDRESS OF THE CURRENT /VARIABLE HAS ALREADY BEEN ADJUSTED (WHEN ERN 09C,SZA,EC /**057** THE USER HAS SPECIFIES A REDUNDENT EQUIVALENCE /**057** WE CAN'T HANDLE THAT SO GIVE HIM AN ERROR /**057** SINCE WE BREAK THE CHAIN AND THAT RESULTS IN /**057** MISS ALLOCATION OF CORE ERX 17C,EC /**057** NEW ERROR 'REDUNDENT EQUIVALENCE' /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 /SIMPLY ADDED TO THE CURRENT CLASS. /ERROR: RELATIVE ADDRESS OF A VARIABLE ERN 10C,SPA,EC /ASSIGNED TO A COMMON BLOCK THROUGH /AN EQUIVALENCE RELATION UNDERFLOWS. 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* SYMTW7 /ITS ENTRY IN THE SYMBOL TABLE. EQUI17 JMS CHAIN /THE CURRENT EQUIVALENCE CHAIN IS BROKEN LAC OPVALU /AND THE CURRENT VARIABLE INSERTED SAD C00030 /A COMMA HERE INDICATES MORE CLASS MEMBERS TO COME JMP EQUI07 ERS 11C,,EC /OTHERWISE ONLY ) IS LEGAL 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 /CLASS OR COMMON BLOCK. ERN 01M,,EM /ERROR: EQV CLASS LIST FULL 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. .EJECT / SUBROUTINE TO CLEAN-UP DATA STORAGE ASSIGNMENTS / CLENUP SYN TYPEA1 /DATA STORAGE LOCATIONS ARE ASSIGNED AFTER XCT PASS /THE END STATEMENT IS ENCOUNTERED JMP CLEN02 /THE ASSIGNMENTS ARE MADE DURING PASS 1 LAC PC /AND THE BINARY INFORMATION IS OUTPUT DAC START /DURING PASS 2. DAC EQUSTR /THE AMOUNT OF NON-COMMON EQUIVALENCED LAC EQUCLS /MEMORY IS INITIALLY SET TO ZERO. CLEN10 SAD EQU0 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. SMA /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* SYMTW7 /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* SYMTW7 /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* SYMTW7 TAD LOWRAD /THE MEMBER WITH THE LOWEST RELATIVE DAC* SYMTW7 /ADDRESS WILLBE ASSIGNED THE CURRENT JMS DEFNSM XOR* SYMTW7 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 LAC START DAC PC CLEN02 DZM LOWRAD /THE AMOUNT OF STORAGE REQUIRED FOR THE LAC PFILE1 DAC SYMTW2 TAD C00001 DAC SYMT2A /SET UP FAKE NAME POINTERS JMS OSYMBL /OUTPUT THE FILE NAME 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 SYMTB0 CLENLP DAC SYMTBC SAD SYMTBN /DONE? JMP* CLENUP /YUP - EXIT JMS SETADR LAC K00001 SAD* SYMTBC /COMMON BLOCK? JMP CMNBLK /YES - GO OUTPUT IT AND ITS MEMBERS SAD FCNFLG /ARE WE IN A BLOCK DATA SUBPROGRAM? JMP CMNCHK /YES - GO CHECK FOR NON-COMMON VARIABLES LAC* SYMTBC AND Z00000 /EXTRACT TYPE BITS OF SYMBOL TABLE ENTRY SAD W00000 /NON-COMMON ARRAY? JMP CARRAY /YES - OUTPUT STORAGE AND DESCRIPTOR BLOCK SAD Z00000 /DUMMY ARRAY? IF YES, OUTPUT DES. BLOCK JMP CADB /(YES) AND DEFINING SYMTAB ENTRY FOR /IT SUCH THAT ADDRESSING IS TO THE ADB SAD U00000 /EXTERNAL FUNCTION? JMP CFUNCT /YES - OUTPUT TRANSFER VECTOR SNA /NON-COMMON SCALAR? JMP CSCLAR /YES - RESERVE STORAGE FOR IT CLENNX JMS SBSE50 /GO TO NEXT SYMTAB ENTRY JMP CLENLP /AND LOOP / CARRAY LAC* SYMTW4 /CHECK THE SIGN BIT OF SYMTW4 - IT IS ONLY SPA /SET ON BY THE EQUIVALENCE RESOLVER. JMP CADB /STORAGE ALREADY EXISTS IN EQV. AREA LAC PC /NO STORAGE EXISTS - SAVE PC FOR USE DAC* SYMTW7 /IN ARRAY DESCRIPTOR BLOCK LAC* SYMTW3 /GET LENGTH, CHECK THAT IT IS LESS THAN 8K TAD K08192 /THIS CHECK USED TO BE DONE WHEN DIMENSIONED - ERN 03M,SMA,EM /BUT NOW HAVE TO ALLOW COMMON ARRAYS >8K LAC* SYMTW3 /GET LENGTH JMS BINOUT /OUTPUT A "BLOCK" COMMAND XOR C00006 CADB JMS CLEN50 /OUTPUT FIRST 3 WORDS OF ARRAY DESC. BLOCK JMS VECTOR /OUTPUT POINTER AND DEFINE ARRAY HERE JMP CLENNX /BACK TO THE SALT MINES CFUNCT AND* SYMTW2 /AC CONTAINED U00000, REMEMBER? SZA /BIT 1 OF THE LOW-ORDER NAME WORD IS THE JMP CLENNX /"DUMMY EXTERNAL" FLAG - IGNORE ENTRY IF ON JMS DEFNSM XOR PC /DEFINE SYMBOL HERE JMS VECBIN /OUTPUT A ZERO WORD JMS OSYMBL /PUT OUT SYMBOL NAME LAC* SYMTBC AND S17777 JMS BINOUT /AND GLOBAL DEFINITION CODE XOR C00009 JMP CLENNX / CSCLAR LAC* SYMTW2 /IF THIS ENTRY HAS MORE THAN 3 WORDS, CMA AND* SYMTW4 /CHECK WHETHER IT EXISTS IN EQUIVALENCED SPA /STORAGE JMP CLENNX /GUESS IT DOES - IGNORE IT LAC* SYMTBC AND S17777 /IF A SYMBOL WAS DEFINED IN THE DECLARATION SAD S17777 /STATEMENTS, BUT NEVER REFERENCED IN AN EXECUTEABLE JMP CLENNX /STATEMENT, DON'T DEFINE IT NOW (OR EVER) JMS DEFNSM XOR PC /DEFINE THE SYMBOL AS RIGHT HERE LAC* SYMTBC JMS SETN /FIND THE NUMBER OF WORDS NECESSARY JMS BINOUT XOR C00006 /AND PUT THEM OUT JMP CLENNX / CMNCHK JMS SYMTYP /ONLY VARIABLES IN COMMON ARE ALLOWED XOR C00000 /IN A BLOCK DATA SUBPROGRAM JMP CLENNX ERR 12C,16060,EC /NAUGHTY,NAUGHTY JMP CLENNX /THE SHOW MUST GO ON / CMNBLK JMS TSETAD /SAVE AWAY THE IMPORTANT POINTERS JMS OSYMBL /OUTPUT THE NAME OF THE BLOCK LAC* TSMTW7 /IF THE LENGTH IS ALREADY ZERO, SNA /IGNORE THIS BLOCK AS AN ERROR JMP CLENNX /WAS DETECTED PROCESSING IT DZM* TSMTW7 /INITIALIZE THE LENGTH LAC* TSMTW4 /GET THE FIRST CHAIN POINTER BLKLLP JMS NTHSYM /GET THE CHAINED SYMBOL JMS CLEN60 /COMPUTE THE ADDRESS OF THE LAST ELEMENT TAD* TSMTW7 /(COMPLEMENTED) AND COMPARE IT WITH THE SMA /EXISTING LENGTH JMP .+3 /IT FITS WITHIN THE EXISTING LENGTH LAC TEMP0 /IT DOESN'T FIT - CHANGE THE LENGTH DAC* TSMTW7 LAC* SYMTW4 /GET THE NEXT CHAIN SAD* TSMTW4 /HAVE WE COME FULL CIRCLE? SKP /YUH JMP BLKLLP /NAW - KEEP LOOPIN LAC* TSMTW7 /GET THE BLOCK LENGTH JMS BINOUT XOR C00012 /OUTPUT IT AS A COMMON BLOCK DEFINITION LAC* TSMTW4 CMNVLP JMS NTHSYM /NOW GO THROUGH THE ELEMENTS AGAIN LAC FCNFLG SAD K00001 /IF WE ARE IN A BLOCK DATA ROUTINE, JMP BLDCMN /ALL WE ARE INTERESTED IN IS THE DEFINITION LAC* SYMTBC SPA /IS THE ELEMENT AN ARRAY? JMS CLEN50 /YES - OUTPUT THE FIRST 3 WORDS OF THE ADB JMS VECTOR /OUTPUT AN OFFSET POINTER INTO THE COMMON LAC* SYMTW7 /BLOCK AND DEFINE THE SYMBOL HERE. THEN JMS BINOUT /OUTPUT SOME STRANGE LOADER CODES WHICH XOR C00013 /I TAKE ON FAITH LAC* SYMTBC AND S17777 JMS BINOUT /(ANOTHER, EQUALLY STRANGE LOADER CODE) XOR C00014 SKP BLDCMN JMS DEFNSM /IN BLOCK DATA SUBRS, ALL WE CARE ABOUT XOR* SYMTW7 /IS THAT THE DATA STATEMENTS WORK PROPERLY LAC* SYMTW4 SAD* TSMTW4 /CHECK FOR CIRCUMNAVIGATION SKP /YUP - ALL DONE JMP CMNVLP /NOPE - KEEP SAILING LAC* TSMTW7 /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 TSMTBC DAC SYMTBC JMS SETADR /SET UP POINTERS JMP CLENNX /SO WE CAN ADVANCE TO THE NEXT SYMBOL .EJECT /SUBROUTINE TO OUTPUT 5 WORD ARRAY DESCRIPTOR BLOCK (LESS TRANSFER VEC.) CLEN50 SYN POP /THE ADB IS OUTPUT FOR ALL ARRAYS, ALTHOUGH LAC* SYMTBC /SYMTAB ENTRIES FOR A DUMMY ARRAY MAY NOT BE AND S60000 /COMPLETE. WORD 1 CONTAINS THE MODE, RIGHT LRSS 34 /ADJUSTED, AND THE NUMBER OF DIMENSIONS-1 IN JMS SUBCT2 /BITS 0,1,2. SUBCT2 COUNTS THE DIMENSIONS, THEN TAD K00001 /SUBTRACT 1. THE WORD IS OUTPUT AS AN ABSOLUTE LLS 17 JMS FPPOUT /INSTRUCTION. WORD 2 IS THEN USED FOR SIZE, LAC* SYMTW3 /ALLOWING EASILY ENOUGH BITS FOR A 128K ARRAY, JMS FPPOUT /IT PRESENTLY BEING THE LOADERS DECISION AS TO LAC* SYMTW5 /HOW BIG AN ARRAY CAN BE (EITHER AS PART OF THE JMS FPPOUT /PROGRAM SIZE OR A COMMON BLOCK). WORD 3 LAC* SYMTW6 /= N*IMAX, WORD 4 = N*IMAX*JMAX, WHERE N IS JMS FPPOUT /THE NO. WORDS PER ELEMENT FOR THIS MODE JMP* CLEN50 / / SUBROUTINE TO OUTPUT A TRANSFER VECTOR / VECTOR SYN ADDRA1 JMS DEFNSM /DEFINE THE SYMBOL XOR PC /AS THE CURRENT VALUE OF THE PC LAC* SYMTW7 /TRANSFER VECTORS ARE SHEER ADDRESS JMS VECBIN /THE TRANSFER VECTOR IS INITIALLY SET TO JMP* VECTOR /REFERENCE THE ARRAY(VAR) ADDRESS. / / / / SUBROUTINE TO DEFINE A SYMBOL / CALLING SEQUENCE... / JMS DEFNSM / XOR DEFINITION / DEFNSM SYN ADDRA2 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 / CLEN60 SYN MODEA1 LAC* SYMTW3 /THE NUMBER OF WORDS OCCUPIED BY THIS TAD* SYMTW7 /ASSIGNED TO THIS VARIABLE. DAC TEMP0 /THE POSITIVE ADDRESS IS SAVED AND ITS JMS TWOCMA /NEGATIVE RETURNED TO THE CALLING PROGRAM. JMP* CLEN60 / / / / 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. TAD K04081 SPA JMP .+3 LAC PASS1 /PROGRAM EXCEEDS 4K DAC F4K LAC PC TAD K08177 SPA /THE COMPILER.. 8191 IS USED AS A FLAG.) JMP* INCRPC DZM PC ERR 02M,16320,EM /ERROR: PROGRAM SIZE EXCEEDS A CORE BANK JMP* INCRPC .EJECT / SUBROUTINE TO FETCH VARIABLE ARGUMENT-OPERATOR/DELIMITER PAIR / FVARGO SYN NUMFLG 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 / / / /SUBROUTINE TO SET ADDRESS OF NTH SYMBOL /CALLING SEQUENCE / LAC N / JMS NTHSYM / NTHSYM SYN SIGNA1 JMS TWOCMA DAC TCTR LAC SYMTB0 NTHSM1 DAC SYMTBC JMS SETADR ISZ TCTR SKP JMP* NTHSYM JMS SBSE50 JMP NTHSM1 .EJECT / /GET DIMENSION DECLARATION SUBSCRIPTS. ALLOWS INTEGER VARIABLE DIMENS /IF DUMMY ARRAY. IN PASS2, GENERATES CALLS TO ARRAY ADJUSTMENT SUBS. /3D ARRAYS ONLY. FARDIM SYN SIGNA2 DZM T2 /INITIALIZE LATTER 2 DIMENSIONS. DZM T3 /ADJFLG IS INITIALIZED TO ZERO, AND IS DZM ADJFLG /INCREMENTED IF VALID VARIABLE DIMENSION IS LAC SYMTBC /FOUND. SAVE PTR TO PRESENT SYMTAB ENTRY, DAC VARTST /MAY GET CHANGED. BUT IS THIS ISN'T A DUMMY LAC* VARTST AND V00000 /ARRAY, A 0 IS SAVED INSTEAD. IT IS USED TO SAD V00000 /CHECK VALIDITY OF OCCURENCE OF VARIABLE DIMEN SKP /IF SYMTBC IS LOST FOR NON-DUMMY ARRAY (BY FIARGO) DZM VARTST /IT WAS AN ERROR ANYWAY. DZM SSCTR /INITIALIZE COUNT OF SUBSCRIPTS. LAC AT1 /GET ADDRESS OF DIMENSION HOLDING WORDS. FARD05 DAC TI /TI GETS BUMPED TO SUCCESSIVELY STORE DIMENS. JMS FIARGO /GETS ARG, FLAGS ERROR IF NOT INTEGER CONSTANT LAC ARG /OR VARIABLE. A CONSTANT IS ACCEPTED IN ALL AND Z00000 /CASES (THIS TEST MODELED AFTER ROUTINE CONTST) SAD U00000 /OTHERWISE THE ARG MUST BE A DUMMY VARIABLE, JMP FARD01 /AND WE MUST BE PROCESSING A DUMMY ARRAY. LAC VARTST /ERROR "VARIABLE DIMENSION IN NON-DUMMY ARRAY" ERS 12S,,ES LAC* SYMTBC /OCCURENCE OF VARIABLE HAS RESET SYMTAB PTR AND Z00000 /TO THAT VAR'S ENTRY; MUST BE TYPE DUMMMY ERS 13S,,ES /"VAR DIMEN NOT DUMMY INTEGER" LAC SYMTBC /WHEN GOOD VAR. DIMEN IS FOUND, ITS POINTER IS XOR X00000 /IS FLAGGED AND SAVED IN PLACE OF ACTUAL VALUE. ISZ ADJFLG /ALSO PUT BIT 2 ON, TO INDICATE SYMBOLIC TYPE. SKP FARD01 JMS CONTST /TRUE INTEGER CONST. SUBSCRIPT ARRIVES HERE ALSO DAC* TI ISZ SSCTR /ACCOUNT FOR ONE MORE SUBSCRIPT. DIMENSIONS LAC OPVALU /ARE SEPARATED BY COMMAS. THE DIMENSION LIST SAD C00030 /IS TERMINATED BY A RIGHT PAREN. ERROR NOTED JMP FARD02 ERS 01S,,ES /IF OTHERWISE. JMS FARGOP /THE PSEUDO-ARGUMENT SUBSCRIPTED VARIABLE AND LAC VARTST /ITS DELIMITER ARE OBTAINED BEFORE RETURN, SNA /AND PASS SPECIFIC CLEANUP MUST BE DONE. JMP* FARDIM /NO CLEANUP DONE IF NOT DUMMY ARRAY. LAC ADJFLG /ADJFLG IS > 0 IF VARIABLE DIMEN WAS FOUND /CLEAN UP FOR ADJUSTABLE ARRAY ONLY. SNA!CLA /1. ENTER WITH CONTST IN AC. IF ZERO, NO VAR- JMP* FARDIM /IABLE DIMENSIONS LAC DJMNE JMS EXP580 /JMS* TO .DJ. XOR JMSCMD /(PASS1 - ONLY DEFINE .DJ) LAC VARTST /RESTORE SYMBOL TABLE POINTER DAC SYMTBC /MAKES SURE OUTPUT ROUTINES WORK LAC* SYMTBC /2. NOW OUTPUT DIRECT ADDRESS TO ADB WORD 5, AND S17777 /ADDRESS OF WHOSE SYMBOL TABLE ENTRY WAS JMS VECBIN /SAVED IN VARTST (INCR. PC IF PASS 1) /OCCURENCE OF AT LEAST 1 ADJ. DIMEN. REQUIRES PARAMETERS FOR EACH LAC AT1 /DIMEN. BE OUTPUT, EITHER AS A CONSTANT OR A FARD09 DAC CHAIN /POINTER TO A DUMMY ARGUMENT. LAC* CHAIN / CONSTANTS ARE POSITIVE, SNA /AND ARE OUTPUT AS ABSOLUTE BINARY DATA. IF THEY JMP FARD07 /COME UP ZERO, IT MEANS THAT THIS IS THE END OF SPA /THE PARAMETER LIST, MAX = NO. OF DIMENSIONS JMP .+3 /POINTERS ARE FLAGGED (BIT0=1) JMS FPPOUT /(ONLY INCREMENTS PC IF PASS1). JMP .+3 AND V77777 / THE FLAG IS REMOVED, AND A VECTOR IS OUTPUT, JMS EXP720 /USING SYMTAB ENTRY ADDRESS PASSED IN AC LAC CHAIN /INCREMENT FOR T2 AND T3. TAD C00001 SAD ATX /ATX HAS ADDRESS = T3+1 SKP JMP FARD09 FARD07 LAC T1 /REMOVE POINTER ENTRIES SPA DZM T1 LAC T2 SPA DZM T2 LAC T3 SPA DZM T3 LAC VARTST /RESET POINTER TO SYMTAB ENTRY TO THAT OF DAC SYMTBC /THE DUMMY ARRAY. JMS SETADR /DEFINE THE REST OF THE POINTERS TO THIS ENTRY. JMP* FARDIM DJMNE .DSA 127652 /.DJ, RADIX 50 ADJFLG .DSA 0 /0 IF NO ADJ. DIMENS., >0 OTHERWISE FARD02 LAC TI /CHECK FOR EXCEEDING THREE DIMENSIONS. ATX HOLDS TAD C00001 /THE ADDRESS OF THE LOCATION FOLLOWING T3. ERN 02S,,ES /("MORE THAN THREE DIMENSIONS DECLARED") JMP FARD05 .EJECT /FETCH AND ENTER ARRAY DIMENSIONS INTO SYMBOL TABLE. FOR 3 DIMENS, /5 WORD ADB, CALL BY REFERENCE, >8K COMMON ARRAY, EAE MULT ROUTINE. /NO CHECKING OF ARRAY LENGTH MADE CAUSE DONT'T NECESSARILY YET KNOW IF /IT WILL BE IN A COMMON BLOCK. FEDIMN SYN LEVPOP LAC* SYMTW3 / GET NUMBER OF WORDS PER ELEMENT, USE TO CAL- DAC T0 /CULATE TOTAL ARRAY SIZE. JMS FARDIM /GO GET DIMENS AND FILL IN BLOCK T1,T2,&T3 WITH XCT PASS / IF PASS 2, A QUICK EXIT IS TAKEN (ALL FARDIM JMP FPASS2 /DID WAS GENERATE .DJ OR .DK CALL IF DMY ARY) LAW -1 /COMPUTE THE APPROPRIATE SYMTAB ENTRIES THAT TAD AT1 /DESCRIBE THE SIZE OF THIS ARRAY, GOING THROUGH DAC CONTST /T1,T2,T3 LIST SET UP BY FARDIM. PROPER ACCOUNT DAC VARTST /MUST BE TAKEN OF THOSE ENTRIES WHICH ARE FEDNEX LAC* VARTST /ZERO DUE TO DUMMY VARIABLE VS. THOSE ZERO'ED ISZ CONTST /DUE TO BEING BEYOND NO. OF DIMENS DECLARED. JMS MULT /CUMULATIVE PRODUCT UP TO N*IMAX*JMAX*KMAX LAC* CONTST /IS COMPUTED, EACH INTERMEDIATE RESULT BEING SNA!CLL /SAVED. ANY ZERO PRODUCT SIGNALS DUMMY DIMEN- CLA!CMA!CML /SION, SINCE CALCULATION IS BEING DONE ONLY FOR DAC* CONTST /AS MANY DIMENSIONS THAT EXIST. WHEN 0 COMES LAC CONTST /UP, 777777 IS STORED - SUCH THAT LATER CHECKING SNL /FOR NO. OF DIMENSIONS WILL WORK. THE POINTER DAC VARTST /TO PREVIOUS INTERMEDIATE RESULT IS BUMPED SAD TI /ONLY IF NON-ZERO RESULT. E.G., FOR 'A' REAL, SKP /A(N,M,5) YIELDS T1=T2=777777, T3=10; OR JMP FEDNEX /A(N,5,2) YIELDS T1=777777, T2=10, T3=20. LAC* SYMTBC /ERROR: REDEFINING ARRAY ERN 04V,,EV XOR W00000 /(400000) THE SYMBOL IS FLAGGED AS AN ARRAY DAC* SYMTBC LAC* TI /TI WAS LEFT BY FARDIM TO ADDRESS THE LAST DAC* SYMTW3 /DIMENSION OF THE ARRAY, WHICH NOW HOLDS THE DZM* TI /TOTAL SIZE. THE REST OF THE SYMBOL LAC T1 /TABLE ENTRIES FOR THIS ARRAY ARE DEFINED. DAC* SYMTW5 /THE FACT THAT THE TRUE SIZE OF A DUMMY ARRAY MAY LAC T2 /NOT YET BE KNOWN IS OF NO CONCERN, SINCE NO DAC* SYMTW6 /SPACE IS TO BE ALLOCATED LOCALLY FOR FPASS2 LAC OPVALU /SUCH AN ARRAY. THE TERMINAL DELIMITER IS JMP* FEDIMN /RETURNED IN THE AC. .EJECT / SUBROUTINE TO ANNOUNCE AN ERROR IF THE ARGUMENT IS NOT A VARIABLE / VARTST SYN HFLG LAC ARG /THE ARGUMENT TYPE IS ISOLATED AND AND Z00000 /EXAMINED TO DETERMINE IF IT IS A VARIABLE. ERS 02V,,EV JMP* VARTST / / / / SUBROUTINE TO ANNOUNCE AN ERROR IF AN INTEGER ARGUMENT IS NOT A / NON-ZERO POSITIVE CONSTANT. / CONTST SYN FMTCNT LAC S SMA!SZA!CLA LAC ARG AND Z00000 /TEST MODE AND VALUE ERS 03V,,EV /ERROR: NOT INTEGER CONST>0 LAC S JMP* CONTST / / / / SUBROUTINE TO CHAIN CLASS MEMBERS (EQUIVALENCE OR COMMON BLOCK) / CHAIN SYN IDXPOP 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 VARIABLE OR ARRAY WITH CONSTANT SUBSCRIPTS / FVORAR SYN MODEA2 /THIS SUBROUTINE IS USED BY THE DATA AND JMS FVARGO /EQUIVALENCE STATEMENT PROCESSORS. LEGAL LAC* SYMTBC /NAMES ARE SIMPLE VARIABLES OR ARRAY AND U00000 /ELEMENTS WITH CONSTANT SUBSCRIPTS ERN 05V,SZA,EV /ERROR: DUMMY VAR OR FUNCTION DZM SSCTR /USED IN DATA STMT DZM T0 LAC* SYMTBC /THE NUMBER OF WORDS PER ITEM JMS SETN /IS OBTAINED FOR USES BOTH INTERNAL AND DAC MODE /EXTERNAL TO THIS ROUTINE. LAC OPVALU /THE APPEARANCE OF A SUBSCRIPTED VARIABLE /NEED NOT INDICATE AN ARRAY ELEMENT. IF /THE VARIABLE HAS NOT BEEN DECLARED AS AN SAD C00028 /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 LAC 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 /AS A FUNCTION AND AN ERROR WOULD OCCUR). /ERROR: MORE THAN 1 DIMENSION INDICATED FOR ERN 07V,SMA,EV /A NON-ARRAY VARIABLE. LAC T2 TAD K00001 /THE ELEMENT POSITION IS CALCULATED FOR JMS MULT /MULTI-DIMENSION ARRAY ELEMENTS AS... LAC* 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 LAC* 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* SYMTBC /ELEMENT. MUST HAVE CORRECT NUMBER OF SUBSCRIPTS, AND Z00000 /(UNLESS # DCL SS = 1), AND THE ELEMENT XOR X00000 /POSITION CANNOT EXCEED 8191 IF A LOCAL ARRAY, SNA!CLA /OR 32767 IF A COMMON ARRAY. LAC K24576 / -24 K TAD K08192 / -8 K TAD T0 ERN 04M,SMA,EM JMP* FVORAR .TITLE STATEMENT PROCESSORS FOR EXECUTABLE STATEMENTS / READ AND WRITE STATEMENT PROCESSORS / READ ENTRY = READ WRITE ENTRY = WRITE WRITE LAC C00002 /WRITE ENTRY -- TWO TO RWFLAG READ DAC RWFLAG /RWFLG= READ/WRITE INDICATOR DZM ENCFLG /ZERO ENCODE/DECODE FLAG JMS FNBCHR ERS 08V,,EV /FIRST CHARACTER MUST BE ( JMS IODEV /FETCH AND RECORD DEVICE NUMBER LAC ARG /STORE AWAY TEMPORARILY DAC ARTEM DZM RWEOFS /INITIALIZE OFFSET AND FLAGS DZM RWERRS DZM SYMTMP DZM RWBIN LAC XCHAR /GET CHARACTER WHICH TERMINATED DEVICE NUMBER DZM RWRAN SAD C00035 /#? JMP RWRA /YES; RANDOM ACCESS I/O SAD C00039 /'? JMP RWRA /YES - RANDOM ACCESS JMP RWNRAN /NOT RANDOM ACCESS - CHECK FOR COMMA OR RPAR RWRA LAC C00024 /READ IN EXPRESSION FOR FIRST RECORD # DAC IFFLAG LAC PASS1 /ACCEPT , AS 0 LEVEL DELIMITER DAC EX23X+1 JMS EXPRSN LAC SNACMD /PUT THINGS BACK TO NORMAL DAC EX23X+1 LAC MODEA2 /MUST BE INTEGER EXPRESSION ERN 32V,SZA,EV LAC C00010 /(OFFSET FOR RANDOM ACESS DAC RWRAN LAC XCHAR /GET CHARACTER WHICH TERMINATED RECORD NUMBER RWNRAN SAD S00051 /RIGHT PAREN? JMP RWBIN1 /YES - BINARY I/O, NO EXITS ERS 05I,,EI /CHAR BETTER BE COMMA RWNRA JMS SIN530 /SAVE REGISTERS FOR LOOK AHEAD LAC Y00000 /GET NEXT 3 CHARACTERS DZM LOGIF /DO NOT ALLOW CONTINUATION JMS CTRL50 SAD S20564 /(END IN RADIX 50 JMP RWEOF SAD S21042 /(ERR IN RADIX 50 JMP RWERR RWNEIO JMS SIN540 /RESTORE SOURCE IMAGE LAC SYMTMP /MAKE SURE THAT THIS POINT REACHED ONLY ONCE ERN 36V,SZA,EV LAC RWEOFS /HAVE ANY SPECIAL EXITS BEEN INDICATED TAD RWERRS ERN 37V,SZA,EV JMP RWASC1 /BCD I/O RWEOF LAC DCEOF /GET ADDRESS TO GO TO ON END OF FILE SKP RWERR LAC DCERR /GET ADDRESS TO GO TO ON ERROR CONDITION DAC STORC JMS FNBCHR /GET OPERATOR SAD S00075 /=/ SKP JMP RWNEIO /MUST NOT BE RIGHT AFTER ALL JMS FDFSNO /GET THE DEFINED ONLY STATEMENT NUMBER STORC XX /STORE AWAY ADDRESS LAC XCHAR /TEST OPERATOR FOLLOWING ADDRESS JMP RWNRAN /BY RE-ENTERING SCAN LOOP RWBIN1 LAC SYMTMP SNA ISZ RWBIN /BIN I/O OFFSET LAC RWEOFS /DO WE NEED EXPANDED I/O? TAD RWERRS SNA JMP NEXIO /NO LAC T31442 /OUTPUT JMS* .ZR JMS EXP580 XOR JMSCMD LAC RWEOFS /GET EOF EXIT JMS ADROR0 /OUTPUT IT NOP LAC RWERRS JMS ADROR0 /NOW THE ERROR EXIT NEXIO NOP LAC ENCFLG SZA /IF ENCODE/DECODE FLAG IS ON JMP NEXIOX /IGNORE ALL THE OTHER FLAGS LAC RWINIT /OUTPUT I/O INITIALIZER TAD RWFLAG /BUMP FOR READ OR WRITE TAD RWBIN /BUMP FOR BINARY I/O TAD RWRAN /BUMP FOR RANDOM ACCESS NEXIOX JMS OPOPA2 LAC ARTEM LAC ENCFLG SNA /ENCODE/DECODE? JMP .+3 /NO LAC ENCVAR /YES - OUTPUT VARIABLE NAME JMS EXP720 LAC RWBIN SZA JMP RW13 /SKIP READING OF FORMAT LABEL IF BIN LAC SYMTMP /UNSAVE SYMBOL TABLE POINTER AND V77777 JMS ADROR0 /OUTPUT THE FORMAT POINTER TAD C00001 RW13 JMS FNBCHR /FETCH FIRST CHARACTER OF THE I/O LIST. DZM RWDLVL /ZERO IMPLIED DO LEVEL ISZ RWEXPF /SET FLAG FOR EXPRESSION ANALYZER JMS CTRL60 JMP RW14 /IF CHAR NOT A CARRIAGE RETURN, THERE IS LAC RWBIN /IF I/O OPERATION IS A WRITE TAD RWFLAG /IN BCD MODE GO OUTPUT CLEANUP CODE ERN 02X,,EX /ELSE ERROR JMP RWENDL / ADROR0 SYN LEVNOP /SUBROUTINE TO PUT OUT A RELOCATABLE ADDR OR 0 SNA /IS IT 0? JMP OUTPT0 /YES - USE FPPOUT DAC SYMTBC LAC* SYMTBC /GET SYMTAB ENTRY SMA /IS IT AN ARRAY? XCT* ADROR0 /THIS IS EITHER A "NOP" OR A "TAD (1" AND W17777 /MASK OUT ADDRESS AND ARRAY INDICATOR JMS VECBIN /OUT WE GO JMP* ADROR0 /RETURN TO DATA WORD WITH NO ILL EFFECT OUTPT0 JMS FPPOUT /ZERO IN AC - OUTPUT IT JMP* ADROR0 /RETURN / RWASC1 JMS FNBCHR /GET A CHAR SAD S00054 /COMMA? JMP DATDIR /YES - DATA DIRECTED I/O SAD S00051 /CLOSE PAREN? JMP DATDIR /YES - D.D I/O DZM UNFNBC /PUT THE CHARACTER BACK JMS FETSNO /GET THE FORMAT STATEMENT NUMBER SMA /POSITIVE RESULT MEANS STATEMENT NUMBER - JMS CKDFSN /CHECK TO SEE THAT ITS DEFINED (LEAVES AC POS.) SPA /NEGATIVE RESULT MEANS NON-NUMBER - JMS FVARGO /FETCH ARRAY NAME LAC SYMTBC /SAVE THE SYMBOL TABLE ADDRESS RW44A DAC SYMTMP LAC XCHAR /TEST OPERATOR SAD S00054 /IF OPERATOR IS , THEN EXPANDED I/O INDICATED JMP RWNRA ERS 01F,,EF /BETTER BE CLOSE PAREN JMP NEXIO /GO TO OUPUT INITIALIZATION CODE DATDIR LAC W00000 JMP RW44A /SET SYMTMP TO 400000 AS A FAKE VALUE .EJECT / INPUT-OUTPUT LIST PROCESSOR RW14 DZM UNFNBC /UNFETCH CHAR AND GO TO LIST PROCESSOR / RW19 JMS FNBCHR /PEEK AT THE NEXT CHARACTER SAD S00050 /OPEN PAREN? JMP RWIMDO /YES - ASSUME BEGINNING OF AN IMPLIED DO DZM UNFNBC /NO - PUT CHAR BACK JMS EXPRSN /GET AN EXPRESSION LAC TYPEA2 /GET TYPE OF RESULT SAD T00000 /IS IT A VARIABLE? JMP RW20 /YES - GOOD,GOOD ERS 03X,,EX /ELSE MUST BE A STRING, IE, S.S. VARIABLE LAC SYMTBX /LAW -MODE WILL NOT BE NEEDED FOR DDIO OUTPUT TAD C00005 /OF A SUBSCRIPTED ELEMENT OF ANY DIMENSION. DAC DDSS2 /IN PARTICULAR, FOR OUTPUT OF A SINGLE DIMENSION LAC* DDSS2 /SUBSCRIPTED VARIABLE. FOR THIS CASE ONLY, DDSS2 DAC DDSS2 /GETS SET TO ZERO, AS SYMTAB ENTYR FOR 2ND DIM JMP DDCHK /IS ZERO. GO CHECK IF WILL ACTUALLY BE DDIO RW20 DAC DDSS2 /STASH ARBITRARY NON 0 VALUE, INDICATING IS NOT LAC* ADDRA2 /A 1 DIM. ARRAY SS ELEMENT REFERENCE. NOW, SMA /WAS RW20 ENTERED DUE TO SCALAR OR WHOLE ARRAY JMS MODLAW /REFERENCE? IF SCALAR, MUST OUTPUT LAW -MODE DDCHK=. /WHOLE ARRAY I/O ROUTINES GET MODE FROM ADB /AND .SS PASSES IT TO 1 DIM DDIO OUTPUT AND ALL LAC SYMTMP /(RKB-065) OTHER 2 AND 3 DIM I/O XOR W00000 /(RKB-065) SNA /(RKB-065) DATA DIRECTED I/O? JMP DDLIST /(RKB-065) YES - GENERATE DATA-DIRECTED CALLS .IFDEF %DDIO /AND .SS PASSES IT TO 1 DIM DDIO OUTPUT AND ALL LAC SYMTMP /OTHER 2 AND 3 DIM I/O XOR W00000 SNA /DATA DIRECTED I/O? JMP DDLIST /YES - GENERATE DATA-DIRECTED CALLS .ENDC LAC DDSS2 /WAS THIS A 1 DIM. ARRAY SS ELEMENT REFERENCE? SNA JMS MODLAW /YES, OUTPUT LAW -MODE LAC TYPEA2 SMA!CLA /CHECK FOR ARRAY I/O LAC* ADDRA2 SMA!CLA LAC C00002 /NO - SET SCALAR OFFSET TAD RWBIN /ADD BCD/BINARY OFFSET TAD RWRAN /ADD RANDOM ACCESS OFFSET TAD RWABAS /ADD BASE OF I/O TABLE JMS OPOPA2 /GENERATE PROPER CALL LAC* ARG2 /WITH PROPER ARG RWCOMN LAC SIGNA2 /CHECK FOR NO UNARY MINUS STUFF ERN 24X,SPA,EX RWCOMA LAC IDXNOP /GET OP WHICH TERMINATED EXPRESSION SAD C00030 /COMMA? JMP RW19 /YES - CONTINUE SCANNING ERN 26X,SZA,EX /BETTER BE A CARRIAGE RETURN JMP RWENDL /IT WAS - TERMINATE I/O SCAN DDLIST LAC RWFLAG /IF IS INPUT (RWFLAG=0), AND WAS A 1 DIM SZA /S.S. ELEMENT REFERENCE, MUST OUTPUT LAW -MODE JMP .+3 /ELSE THE MODE IS PASSED BY A .SS CALL SAD DDSS2 /DDSS2 IS ZERO IF I DIM SS ELEMENT REFERENCE JMS MODLAW LAC TYPEA2 RCL SZA!CLA /FORM A RANDOM CONSTANT: LAC* ADDRA2 /0 IF SCALAR, 1 IF S.S. VARIABLE, SPA!CLA /4 IF ARRAY LAC C00002 RAL TAD RWFLAG /ADD IN READ/WRITE FLAG (0 OR 2) TAD DDRWSC /ADD IN BASE OF DATA - DIR I/O TABLE DAC ARG LAC* ARG /LOAD SUBROUTINE TO CALL JMS EXP580 /AND CALL IT XOR JMSCMD LAC RWFLAG SNA /DON'T OUTPUT NAME IF INPUT OPERATION JMP RWOPTR LAC SYMTBX DAC SYMTBC /GET POINTER TO VARIABLE NAME JMS SETADR /SET UP POINTERS TO SYMTAB ENTRY LAC* SYMTW2 AND V77777 JMS FPPOUT /PRINT FIRST 3 CHARACTERS LAC* SYMT2A JMS FPPOUT /AND SECOND 3 CHARACTERS RWOPTR LAC* ARG2 JMS EXP720 /OUTPUT THE VARIABLE JMP RWCOMN /CONTINUE WITH LIST / RWENDL LAC RWBIN /COMPUTE THE PROPER CLEANUP ROUTINE TAD RWRAN TAD RWCNUP DAC ARG LAC* ARG /GET NAME OF SUBR TO CALL JMS EXP580 /GENERATE CALL XOR JMSCMD LAC RWDLVL /GET THE DO-LEVEL ERN 27X,SZA,EX /ERROR IF NON-ZERO JMP STEXIT /WE'RE THROUGH / RWIMDO JMS EXP550 /GENERATE A "JMS STRING" XOR JMSCMD DAC* DOTABA /SAVE THE STRING ADDRESS IN THE DO TABLE JMS INCDTP /BUMP DEPTH TO NEXT LEVEL ISZ RWDLVL /BUMP LEVEL COUNTER JMP RW19 /CONTINUE / / THE EXPRESSION ANALYZER GOES HERE IF AN EQUAL SIGN IS ENCOUNTERED / WHILE "RWEXPF" IS ON / RWEQLS LAC POP /**051** CHECK THE STACK. IF NOT CLEARED THEN INCOMPLETE ERS 33X,,EX /**051** EXPRESSION INCOMPLETE AND ERROR LAC RWDLVL /**051** GET THE DO-LEVEL ERN 28X,SNA,EX /BETTER NOT BE ZERO TAD K00001 DAC RWDLVL /DECREASE IT BY 1 JMS DECDTP /BUMP UP THE DO LEVEL POINTERS LAC PC TAD C00004 /GENERATE A "JMP .+4" XOR JMPCMD JMS RELBIN LAC* DOTABA JMS STRING /DEFINE THE SUBROUTINE WHICH WE CALLED LAC PC /AT THE BEGINNING OF THE LOOP DAC* DOTABA CLA JMS FPPOUT JMS DOCODE /GENERATE THE DO LOOP CODE LAC* DOTABA /IN THE SUBROUTINE, THEN GENERATE XOR JMPCMD /A RETURN FROM THE SUBRROUTINE XOR S20000 JMS RELBIN LAC* DOTABC JMS STRING /DEFINE THE TERMINATION EXIT FROM THE SUBROUTINE LAC C00032 DAC TFAO01 /SET LAST DELIMITER SPECIAL JMS FA2NOP /GET THE NEXT OPERATOR JMP RWCOMA / RWABAS BCDAIO-OPTRAN-1 RWCNUP BCDCLN RWINIT BCDINT-OPTRAN-1 DDRWSC DDRDSC RWDLVL .DSA 0 /IMPLIED DO LOOP DEPTH COUNTER RWEXPF .DSA 0 /"I/O LIST" FLAG FOR EXPRESSION ANALYZER ARTEM 0 /.DAT SLOT ARGUMENT STORE RWEOFS 0 /ADDRESS TO GO TO ON EOF RWERRS 0 /ADDRESS TO GO TO ON ERROR IN I/O DCEOF DAC RWEOFS DCERR DAC RWERRS RWRAN 0 /OFFSET FOR RANDOM ACCESS SYMTMP 0 RWBIN=FORMST / MODLAW CAL /OUTPUT THE ONES COMPLEMENT OF THE MODE, AS A LAC* SYMTBX /LAW INSTRUCTION. THIS IS DONE FOR SCALAR I/O AND S60000 /CALLS, AND 1 DIM SS ELEMENT I/O CALLS OTHER LRSS 15 /THAN DDIO OUTPUT. ALL OTHER SS ELEMENT I/O CMA /RELIES ON .SS TO PASS THE MODE. WHOLE ARRAY JMS FPPOUT /I/O GET THE MODE FROM THE ADB. JMP* MODLAW DDSS2 CAL /SET TO 0 IS 1 DIM SS ELEMENT I/O, NON-0 OTHERWISE .EJECT /BACKSPACE, REWIND, AND ENDFILE STATEMENT PROCESSORS. / BACKSPACE ENTRY = BACKSP / REWIND ENTRY = REWIND / ENDFILE ENTRY = ENDFIL ENDFIL LAC C00001 REWIND TAD C00001 BACKSP TAD C00035 DAC TRW1 /SAVE OUTPUT OP-VALUE JMS IODEV /FETCH AND RECORD UNIT NUMBER LAC TRW1 /OUTPUT SUBROUTINE CALL. ENDF01 JMS OPOPA2 LAC ARG JMP CRTEST /EXIT .EJECT /ENCODE-DECODE STATEMENT PROCESSOR ENCODE TAD C00002 DECODE DAC RWFLAG RCR TAD DOTGFP /GET A POINTER TO THE CORRECT ROUTINE DZM RWBIN DZM RWRAN /ZERO VARIOUS FLAGS FOR THE READ/WRITE PROC DAC ENCFLG JMS FNBCHR ERS 39V,,EV /NEXT CHAR BETTER BE ( JMS FIARGO /GET CHARACTER COUNT LAC ARG DAC ARTEM /STORE IN READ/WRITE TEMPORARY LAC OPVALU ERS 40V,,EV /DELIM BETTER BE COMMA JMS FVARGO /GET ARRAY NAME LAC ARG DAC ENCVAR /SAVE IT AWAY LAC* SYMTBC ERN 41V,SMA,EV /ARRAY BETTER BE ARRAY LAC OPVALU ERS 42V,,EV /DELIM BETTER BE COMMA JMP RWASC1 /NOW GO GET FORMAT AND ERR. CONDITIONS ENCFLG .DSA 0 ENCVAR .DSA 0 DOTGFP .DSA DOTGF-OPTRAN-1 / / /SUBROUTINE TO FETCH DEVICE NUMBER AND OUTPUT IODEV LOADER INFORMATION IODEV SYN TYPEA2 JMS FIARGO /FETCH DEVICE NUMBER 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 PASS1 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 FDFSNO /FETCH DEFINED STATEMENT NO. DAC* DOTABA /STORE SYMTAB ADDRESS IN DO TABLE, WORD A DZM UNFNBC /UNFETCH CHARACTER. JMS INAOPI /INITIALIZE ELEMENT LIST. JMS FA2NOP LAC IDXNOP /CHECK DELIMITER FOR "=" ERS 04D,,ED JMS DOCODE /GENERATE DO CODE JMS INCDTP /BUMP DO LEVEL POINTERS JMP STEXIT /EXIT .EJECT /SUBROUTINE TO INITIALIZE DO-TABLE / INDOTB SYN IFFLAG /SET DOTABA, DOTABB, AND DOTABC POINTERS LAC .FFREE /TO THE FIRST ADDRESS OF EACH OF THREE JMS RSVDTP /CONSECUTIVE TABLES. JMP* INDOTB / / /SUBROUTINE TO INCREMENT DO-TABLE POINTERS. / INCDTP SYN NAME2 LAC DOTABA TAD C00001 JMS RSVDTP ERN 01L,,EL /CHECK FOR OVERFLOW JMP* INCDTP /EXIT / / / /SUBROUTINE TO DECREMENT DO-TABLE POINTERS. / DECDTP SYN IDXNOP CLCCMD CLC TAD DOTABA JMS RSVDTP JMP* DECDTP /EXIT / / / /SUBROUTINE TO RESOLVE DO-TABLE POINTERS. /CALLING SEQUENCE -- JMS RSVDTP (DOTABA IN AC) / RSVDTP SYN NAME1 DAC DOTABA TAD C00010 DAC DOTABB TAD C00010 DAC DOTABC JMP* RSVDTP .EJECT /SUBROUTINE TO OUTPUT DO-CODING / DOCODE CAL 0 DZM DOM1 DZM DOM3 JMS INFAOP /RE-INITIALIZE ARG/OP FETCH LAC MODEA2 SNA /CHECK THAT THE DO VARIABLE (ALREADY SCANNED) LAC TYPEA2 /IS A SIMPLE INTEGER VARIABLE ERS 05D,,ED LAC* ARG2 DAC DOI /SAVE DO VARIABLE JMS FIARGO /GET INTEGER VAR/CONST AND OPERATOR LAC OPVALU ERS 06D,,ED /OP BETTER BE COMMA LAC C00004 /GENERATE A LOAD INSTRUCTION JMS OPOPA2 LAC ARG JMS FIARGO LAC ARG DAC DOM2 /SAVE UPPER LIMIT LAC OPVALU SAD C00030 JMP .+3 /STEP EXISTS ISZ DOM1 /NO STEP - SET STEP POSITIVE JMP DOGEN /GO GENERATE CODE JMS FNBCHR /PEEK AT NEXT CHAR SAD C00045 /IS IT "-" JMP .+3 ISZ DOM1 /NO - SET " POSITIVE DO" FLAG DZM UNFNBC /AND UNPEEK THE CHARACTER JMS FIARGO LAC ARG /GET THE STEP DAC DOM3 /SAVE IT AWAY / DOGEN LAC RWEXPF SZA!CLA /THE DO PARAMETERS MUST BE TERMINATED BY A LAW -37 /CARRIAGE RETURN IF IN A REGULAR DO LOOP TAD OPVALU /AND BY A RIGHT PAREN IF IN AN IMPLIED ERN 07D,SZA,ED /DO LOOP LAC DOM1 /DOM1=0 IF NEG DO, =1 IF POS DO .IFDEF %PDP9 /NOW CALCULATE THE INITIAL JMP SZA /"JMP .+3" FOR POS STEP,"JMP .+4" FOR NEG STEP .ENDC /AND PDP-15, "JMP .+5" FOR NEG STEP CMA /AND PDP-9 (CAUSE NEED TWO INSTRUCTIONS TO TCA) TAD C00005 TAD PC XOR JMPCMD /GENERATE JMP .+N JMS RELBIN LAC PC DAC* DOTABB /SAVE POINTER TO LOOP REENTRY FOR DO CLEANUP LAC DOM3 SZA /WAS THERE A STEP? JMP DOWINC /YES - COMPILE DO WITH STEP LAC C00004 JMS OPOPA2 /LAC I LAC DOI JMS EXP730 /IAC ( TAD 1 ON PDP9) JMP DOSTOR / DOWINC LAC C00004 JMS OPOPA2 LAC DOM3 /LAC M3 LAC DOM1 SNA JMS EXP570 /TCA IF NEGATIVE STEP LAC C00015 JMS OPOPA2 /TAD I LAC DOI DOSTOR LAC C00008 JMS OPOPA2 /DAC I LAC DOI JMS EXPKFF /TCA LAC C00015 JMS OPOPA2 /TAD M2 LAC DOM2 LAC DOM1 SMA!SZA!CLA LAC S00600 /GENERATE "SPA" IF POSITIVE STEP, TAD .-2 /"SMA SZA" IF NEGATIVE STEP JMS ABSBIN JMS EXP550 /JMP OUT XOR JMPCMD DAC* DOTABC /SAVE ADDRESS OF JUMPOUT JMP* DOCODE .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. ERN 04N,SNA,EN /ERROR: NO STATEMENT NUMBER 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. SAD S00051 JMP RW71 /IF RIGHT PAREN. RW62 SAD C00047 JMP RW60 /IF SLASH SAD C00034 JMP RW85 /IF " SAD C00036 JMP RW85 /IF $ SAD C00039 JMP RW85 /IF ' SAD S00124 JMP RW81 /IF T RW63 SAD C00045 JMP RW72 /IF MINUS SIGN. RW635 SAD S00050 JMP RW75 /IF LEFT PAREN. JMS NUMCHK JMP RW636 /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 SAD S00122 JMP RW81 /IF R SAD S00117 JMP RW81 /IF O 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 ERS 02F,,EF /GET WIDTH - ERROR IF NOT THERE LAC LS ERN 03F,SNA,EF /ERROR: FIELD WIDTH IS 0 DZM NUMFLG /RESET NUMERIC FLAG AND CHECK XCHAR FOR LAC XCHAR / A PERIOD. SAD C00046 JMP RW68 /IF PERIOD, CONVERSION MUST BE FLOATING. LAC FLOATF /IS CONVERSION D, E, F, OR G. ERN 04F,SZA,EF /ERROR: ILLEGAL W IN NSW.D LAC XCHAR / NO, GET NEXT CONVERSION. JMP RW61 RW68 LAC FLOATF /IS CONVERSION D, E, F, OR G. ERN 05F,SNA,EF /ERROR: ILLEGAL W IN NSW.D JMS FMTFCH / YES, GET D-VALUE. ERS 06F,,EF /GET D-VALUE - ERROR IF MISSING DZM NUMFLG JMP RW61 /GET NEXT CONVERSION. /NUMBER WAS FOUND; PAREN COUNT MUST BE AT LEAST ONE RW636 LAC FPCNT /MUST SNA /MAKE EXPLICIT CHECK TO PREVENT CONDITION OF A JMP EF07F /NUMBER PRECEEDING THE FIRST LEFT PAREN OF LAC XCHAR /THE FORMAT STATEMENT. RECOVER NEXT CHARACTER, JMP RW635 /AND GET NEXT CONVERSION /COMMA PROCESSOR. RW70 LAC FPCNT /CHECK PAREN COUNT. ERN 07F,SPA!SNA,EF /ERROR: MISSING LEFT PAREN JMS FMTFCH JMP RW62 /RIGHT PAREN PROCESSOR. RW71 CLC /DECREMENT PAREN COUNT. TAD FPCNT DAC FPCNT SPA /(RKB-064) CHECK PAREN COUNT -- JMP EF07F /(RKB-064) ERROR IF MINUS (MISSING LEFT PAREN) SZA /(RKB-064) JMP RW60 /(RKB-064) GET NEXT CONVERSION IF PLUS JMP RW83 /(RKB-064) TRY TO EXIT IF ZERO. /MINUS SIGN PROCESSOR. RW72 JMS FMTFCH /FETCH NEGATIVE SCALE FACTOR ERS 08F,,EF /GET NUMBER - ERROR IF MISSING RW73 DZM NUMFLG ERS 09F,,EF /ERROR: P MISSING JMS FMTFCH /FETCH NEXT CHARACTER. JMP RW64 /REENTER SKIP CHAIN. /LEFT PAREN PROCESSOR. RW75 ISZ FPCNT /BUMP PAREN COUNT. JMS FMTFCH /FETCH NEXT CHARACTER. JMP RW62 /REENTER SKIP CHAIN. /P PROCESSOR RW77 LAC NUMFLG /IS P PRECEDED BY A NUMBER. ERN 10F,SNA,EF /ERROR: NO NUMBER BEFORE P JMS FMTFCH /FETCH NEXT CHAR JMP RW64 /RE-ENTER SKIP CHAIN /H PROCESSOR RW78 LAC NUMFLG /IS H PRECEDED BY A NUMBER. SZA LAC LS /IF SO, TEST FOR NUMBER >0 DZM NUMFLG ERN 12F,SNA,EF /ERROR: ZERO PRECEDING H 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. SZA /IF SO, LAC LS /MAKE SURE ITS NON-ZERO DZM NUMFLG ERN 13F,SNA,EF /ERROR: BAD NUMBER BEFORE X JMP RW60 / NO, REENTER SKIP CHAIN AT TOP. /" AND $ PROCESSORS / RW85 DAC LS DAC HFLG /PASS BLANKS RW86 JMS FMTFCH SAD LS SKP JMP RW86 /LOOP UNTIL CLOSE QUOTE DZM HFLG JMP RW60 /T,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 / /SUBROUTINE TO FETCH, TEST, PACK, AND OUTPUT A FORMAT CHARACTER. FMTFCH SYN TARGI LAC HFLG /TEST HOLLERITH FLAG. IF SET, FETCH CHAR- SNA /ACTER. IF NOT SET, FETCH NON-BLANK JMP FMTFC0 /CHARACTER. JMS FETCHR LAC XCHAR SKP FMTFC0 JMS FNBCHR JMS FMTPAK /PACK XCHAR IN MS/LS. JMS FMTOUT /IF MS/LS FULL, OUTPUT 2 OBJECT WORDS. JMS CTRL60 /TEST IF CHARACTER WAS CARRIAGE RETURN JMP* FMTFCH /NO - EXIT WITH CHARACTER IN AC ERX 15F,EF /ERROR: TOO MANY LEFT PARENTHESES .EJECT /SUBROUTINE TO SHIFT MS/LS LEFT 7 AND MERGE CHARACTER. / CALLING SEQUENCE -- LAC CHARACTER (ASCII-7) / JMS FMTPAK / JMP MS/LS FULL (5 CHARACTERS PACKED) / XXX MS/LS NOT FULL (1-4 CHARACTERS PACKED) / INITIALIZATION -- SET FMTCNT TO -5. FMTPAK SYN OP AND S00177 DAC TRW1 /SAVE CHARACTER TO BE PACKED. LAW -7 /INITIALIZE SHIFT-CONNT. DAC TRW2 FMTPK1 JMS DSHL /SHIFT MS/LS 7 LEFT OPEN. ISZ TRW2 JMP FMTPK1 LAC FLS /MERGE IN SAVED CHARACTER. XOR TRW1 DAC FLS ISZ FMTCNT /CHECK IF 5 CHARACTERS HAVE BEEN PACKED. JMP FMTPK2 /NO, BUMP RETURN ADDRESS AND EXIT. JMS DSHL /YES, LEFT JUSTIFY MS/LS AND REINITIAL- LAW -5 /IZE CHARACTER COUNTER. DAC FMTCNT JMP* FMTPAK /EXIT FOR MS/LS FULL. FMTPK2 ISZ FMTPAK /EXIT FOR MS/LS NOT FULL. JMP* FMTPAK / / /SUBROUTINE TO FILL MS/LS WITH BLANK CHARACTERS / CALLING SEQUENCE / JMS FMTFIL / JMP (FILL REQUIRED AND WAS EXECUTED) / XXX (FILL NOT REQUIRED -- NO CHANGE) FMTFIL SYN OPVALU LAW -5 /IF MS/LS ALREADY CONTAINS 5 CHARACTERS, SAD FMTCNT /BUMP RETURN ADDRESS AND EXIT WITH JMP FMTFL2 /MS/LS UNCHANGED. FMTFL1 LAC S00040 /IF MS/LS IS PARTIALLY FULL, PACK BLANKS JMS FMTPAK /UNTIL IT IS FULL, THEN EXIT. JMP* FMTFIL JMP FMTFL1 FMTFL2 ISZ FMTFIL JMP* FMTFIL / / /SUBROUTINE TO OUTPUT M/S / FMTOUT SYN TOPI LAC FMS /OUTPUT MS JMS FPPOUT LAC FLS /OUTPUT LS JMS FPPOUT JMP* FMTOUT /EXIT .EJECT /SUBROUTINE TO CHECK FOR A NUMBER AND COMPLETE ITS CONVERSION. / CALLING SEQUENCE -- LAC CHARACTER (ASCII-7) / JMS NUMCHK / JMP YES NUMCHK SYN ARG JMS NUMTST /IS CHARACTER A NUMBER. JMP NUMCH3 /NO, BUMP RETURN ADDRESS AND EXIT. ISZ NUMFLG /YES - SET FLAG NUMCH1 DAC LS /SAVE VALUE OF NUMBER NUMCH2 JMS FMTFCH /FETCH NEXT CHARACTER. JMS NUMTST /IS IT A NUMBER. JMP* NUMCHK /NO, EXIT WITH NEXT (XCHAR) IN AC. DAC TRW1 /YES - SAVE VALUE LAC LS RTL TAD LS /MULTIPLY LS BY 10. RAL TAD TRW1 /ADD IN NEW DIGIT JMP NUMCH1 /UPDATE VALUE AND LOOP NUMCH3 ISZ NUMCHK /EXIT HERE IF 1ST CHARACTER NON-NUMERIC. JMP* NUMCHK /EXIT WITH CURRENT XCHAR IN AC. / / /SUBROUTINE TO TEST FOR A NUMBER / CALLING SEQUENCE -- LAC CHARACTER / JMS NUMTST / JMP NO NUMTST SYN SIGN TAD Z77706 /IS CHARACTER LESS THEN OR EQUAL TO NINE CLL!CML /BUT GREATER THAN OR EQUAL TO ZERO? TAD C00010 SZL /LINK ON IF VALID NUMBER LAC XCHAR /RELOAD CHAR IF INVALID SNL ISZ NUMTST /SKIP RETURN IF VALID JMP* NUMTST / /SUBROUTINE TO SHIFT FMS/FLS LEFT ONE OPEN. / DSHL SYN CHRCTR LAC FLS RCL DAC FLS LAC FMS RAL DAC FMS JMP* DSHL .EJECT / ASSIGNMENT STATEMENT PROCESSOR / ASSIGN K TO I / ASSIGN JMS FDFSNO /GET A STATEMENT NUMBER LAC SYMTBC DAC S /FORM A PSEUDO - CONSTANT WITH THE LAC Y00000 /SYMBOL TABLE ADDRESS OF THE STATEMENT NUMBER DAC NAME0 /AS THE VALUE AND "RELOCATABLE" AS THE TYPE JMS CONSSE /ENTER IT IN THE CONSTANT TABLE DAC SYMTBC LAC XCHAR / WAS TERMINATING CHAR A -T- ERS 06I,,EI /ERROR: NO T JMS FNBCHR / CHECK FOR -O- ERS 07I,,EI /ERROR: NO O JMS SYMBIN /OUTPUT "LAC (STNO" XOR LACCMD JMS FIARGO /FETCH INTEGER ARGUMENT, OP JMS VARTST /ARGUMENT MUST BE A VARIABLE LAC C00008 /SET STORE INSTRUCTION JMP ENDF01 /OUTPUT INSTRUCTION AND EXIT .EJECT / GOTO STATEMENT PROCESSOR / GOTO CLC DAC RWFLAG /INITIALIZE FLAG FOR LIST PROCESSING JMS FNBCHR SAD S00050 /IS CHAR AN OPEN PARENS (? JMP GOTO01 / YES, IS ((), THIS IS COMPUTED GOTO DZM UNFNBC / NO, UNFETCH AND TEST LAST CHAR FOR A-Z JMS AIF500 /GET STATEMENT NUMBER OR VARIABLE AND OUTPUT JUMP SAD S00054 /WAS TERMINATOR COMMA? SKP /YES - ASSIGNED GOTO JMP CRTEST /NO - BETTER BE CR LAC SYMTBC ERN 24I,SMA,EI /COMMA ILLEGAL AFTER STATEMENT NUMBER JMS FNBCHR ERS 07X,,EX /NEXT CHAR BETTER BE ( DZM RWFLAG /ZERO FLAG AND FALL THROUGH COMPUTED GOTO CODE / / COMPUTED GOTO / GOTO (S1,S2,S3,..SN), V GOTO01 JMS INAOPI /INITIALIZE INTEGER ARG, OP GOTO02 JMS FDFSNO /FETCH DEFINED STATEMENT NO. DAC OP JMS ENTER /ENTER ARG IN LIST LAC XCHAR /TEST LAST CHAR FOR COMMA (,) SAD S00054 / (EXT 54) JMP GOTO02 / YES, IS COMMA, CYCLE BACK FOR NEXT STMNT ERS 04X,,EX /NOT COMMA, BETTER BE ) JMS FNBCHR /FETCH NEXT NON-BLANK CHARACTER ISZ RWFLAG /IF RWFLAG IS NOT -1, THIS IS AN ASSIGNED GOTO STMT JMP CRTEST /AND ALL WE WANTED WAS TO ERROR-CHECK, SO GOODBYE ERS 05X,,EX /BETTER BE COMMA JMS FIARGO /FETCH INTEGER ARG, OP JMS VARTST /ARGUMENT MUST BE A VARIABLE LAC C00004 /SET INDEX VALVE FOR INTEGER LOAD (LAC) JMS OPOPA2 /OUTPUT PREVIOUS OP, ARG2 (LAC V) LAC ARG LAC CGOMNE /SET CAT .GO JMS EXP580 /OUTPUT INSTRUCTION (JMS+ .GO) XOR JMSCMD LAC ARGI /DETERMINE NO OF STATEMENT NOS. IN LIST (N) JMS TWOCMA TAD ARG0 / MOW HAVE (-N) DAC TARGI /SAVE FOR JUMP COUNTER JMS FPPOUT /OUTPUT (-N) JMS INAOPI GOTO06 ISZ OPI LAC* OPI JMS JMPBIN /OUTPUT JUMP TO STATEMENT NUMBER ISZ TARGI /DO THIS THE CORRECT NUMBER OF TIMES JMP GOTO06 JMP CRTEST /SO LONG .EJECT / SUBROUTINE TO OUTPUT A JUMP / CALLING SEQUENCE - LOAD AC WITH POINTER INTO SYMBOL TABLE / (SIGN 0 IF ST. NO., 1 IF ASSIGNED VARIABLE) / JMS JMPBIN / JMPBIN CAL 0 DAC SYMTBC SPA /STATEMENT NUMBER? JMP JMPSYM /NO JMS SYMBIN /YES - OUTPUT "JMP STNO" XOR JMPCMD JMP* JMPBIN /RETURN JMPSYM LAC* SYMTBC /VARIABLE -- AND T00000 /CHECK FOR DUMMY OR COMMON VARIABLE SNA JMP JMPVAR /NEITHER - A SIMPLE JMP* WILL DO LAC PASS1 /OUTPUT THE FOLLOWING SEQUENCE JMS ABSBIN / SKP (MIGHT BE IN IF STMT) LAC PC TAD C00004 / JMP .+4 XOR JMPCMD JMS RELBIN / LAC* VAR JMS SYMBIN XOR LACICM / DAC TEMP CLA JMS STORET / JMP* TEMP DAC SYMTBC JMPVAR JMS SYMBIN XOR JMPICM /OUTPUT A JUMP INDIRECT THROUGH CURRENT SYMTBC JMP* JMPBIN /RETURN LACICM LAC* 0 .EJECT / CONTINUE STATEMENT PROCESSOR / CONTIN JMS FNBCHR /GET LAST CHARACTER JMP CRTEST /EXIT AND TEST FOR C/R IN XCHAR / PAUSE STATEMENT PROCESSOR / PAUSE LAC JMSCMD /SET UP FOR JMS* .PA INSTRUCTION DAC POP / HOLD -JMS- LAC PAMNE / GET .PA JMP STOP01 / STOP STATEMENT PROCESSOR / STOP LAC JMPCMD /SET UP FOR JMP* .ST INSTRUCTION DAC POP / HOLD -JMP- LAC STMNE / GET .ST STOP01 DAC ARG2 / HOLD .PA OR .ST DZM UNFNBC /WE ARE GOING TO FALSELY INSERT A "#" JMS INFAOP /INTO THE INPUT CHARACTER STREAM SO THAT THE LAC CHAROC /NEXT NUMBER (IF ANY) WILL BE TAKEN AS OCTAL DAC LSTCHR JMS FIARGO /FETCH AN INTEGER LAC C00004 JMS OPOPA2 LAC ARG /GENERATE "LAC (CONSTANT" LAC ARG2 /GET .PA OR .ST JMS EXP580 /BUILD AND OUTPUT JMS* .PA OR JMP* .ST XOR POP / (JMS OR JMP) JMP CRTEST /STATEMENT EXIT .EJECT / DATA STATEMENT PROCESSOR / DATA LAW -1 DAC DATAFL JMS CTRL70 /CATCH STMT LABEL FOR CONTINUE ERROR. DATA25 JMS INAOPI /INITIALIZE ARG(I) AND OP(I) LISTS DATA01 JMS FVORAR /FETCH SIMPLE OR SUBSCRIPTED VARIABLE, OP CLL JMS SYMTYP /IS VARIABLE COMMON XOR T00000 CML /LINK IS COMPLEMENTED IF VAR NOT IN COMMON LAW -1 SAD FCNFLG /LINK COMPLEMENTED AGAIN IF IN BLOCK DATA CML ERN 16C,SNL,EC /WRONG COMBINATION YIELDS ERROR LAC* ARG SMA /ARRAY? JMP DATA1B /NO LAC SSCTR SZA /SUBSCRIPTS? JMP DATA1A /YES - TREAT NORMALLY LAC W00000 DAC T0 /SET T0 TO STRANGE NEGATIVE NUMBER SKP DATA1A JMS SUBCNT /CHECK NUMBER OF SUBSCRIPTS DATA1B JMS ENTER /ENTER ARG, OP IN ARG(I), OP(I) LISTS LAC T0 /PLACE SUBSRIPT VALUE DAC* OPI / IN OP(I) LAC OPVALU /IS OPERATOR A COMMA (,) SAD C00030 JMP DATA01 / YES, CYCLE BACK FOR NEXT VARIABLE ERS 10X,,EX /BETTER BE A SLASH JMS EXP540 /MOVE ARG(I) TO TARG(I) JMS INAOPI /RE-INITIALIZE THE LIST DZM TFAO01 LAW -1 DAC ARGCTR /INITIALIZE REPEAT FLAG LAC C00030 DAC OPVALU /INITIALIZE LAST OP TO A COMMA DATA02 ISZ ARGI ISZ OPI /GET NEXT VARIABLE FROM VARIABLE LIST DATA03 ISZ ARGCTR /ARE WE REPEATING? JMP DATA05 /YES - KEEP OLD VARIABLE LAW -1 DAC ARGCTR /RE-INITIALIZE COUNTER LAC OPVALU ERS 11V,,EV /MAKE SURE LAST CHAR SCANNED IS , DATA04 LAC C00001 /IF HOLLERITH CONSTANT IS GOTTEN, THIS IS RESET TO DAC HOLCON /-5 TO 0, CORRESPONDING TO 0 TO 5 CHARACTERS PACKED JMS FARGOP /GET ARG AND OP LAC ARG AND Z00000 ERS 09V,,EV /MAKE SURE ARG IS A CONSTANT LAC OPVALU /IF OP IS *, GO STORE REPEAT FACTOR SAD C00021 /ALSO SET -1 INTO DATA22. IT IS ISZ'D JMP DATA16 /EACH TIME HAVE TO CONVERT INTEGER CONSTANT LAW -1 /TO D.I. VARIABLE; ALLOWING THIS CONVERSION DAC DATA22 /ONLY ONCE IN A REPEAT CYCLE. DATA05 LAC* ARGI /GET ARGUMENT DESCRIPTION WORD (I) JMS SETA2 /BUST ARGUMENT JMS SETADR / TO GENERATE VARIABLE ADDRESSES LAC HOLCON /IF HOLCON IS STILL 1, THEN NO HOLLERITH INFORMATION SAD C00001 /WAS ENCOUNTERED. ELSE CHECK IF ONLY 1 OR TWO JMP DATA26 /CHARACTERS WERE PACKED. ADDING 2 TO HOLCON TAD C00002 /LEAVES IT NEGATIVE IF ONLY 1 OR 2 CHARS WERE SPA!CLL /PACKED, FOR WHICH CASE THE LINK IS SET. STL LAC MODEA2 /GET THE MODE OF THE VARIABLE DAC NAME0 /MAKE THE MODE OF THE CONSTANT MATCH IT AND S60000 /NOW, IF IT IS AN INTEGER, WONT ALLOW MORE THAN SZA /2 CHARS. SKIPS IF IS INTEGER. JMP DATA26 /NOT INTEGER, WE ARE SAFE (ULTIMATE 5 CHAR LIMIT) ERS 02H,SZL,EH /IF LINK IS OFF, TOO MANY CHARS DATA26 LAC NAME0 /CHECK IF MODE OF VARIABLE IS MODE OF CONSTANT RTL /(THIS IS FORCED FOR HOLLERITH CODE) AND V00000 DAC MODEA1 /SHIFT BITS 3,4 INTO BITS 1,2 FOR OUTPUT LAC MODEA2 SAD NAME0 /VARIABLE AND CONSTANT MODES SHOULD AGREE JMP DATA06 TAD MODEA1 /ONLY EXCEPTION BEING WHEN VAR IS DBL INTEGER ERS 38V,,EV /AND CONSTANT IS INTEGER ISZ DATA22 /INITIALLY = -1, ALLOWING CONVERSION OF JMP DATA06+2 /INTEGER TO DOUBLE INTEGER ONLY FIRST LAC S /TIME THROUGH. THIS PREVENTS REPEAT COUNT DAC NAME1 /SEQUENCE FROM CONVERTING MORE THAN ONCE SPA!CLA /IN A SEQUENCE CMA DAC S JMP .+3 DATA06 LAC MODEA1 /IF THE MODE OF THE VARIABLE IS SAD V00000 /DOUBLE INTEGER, MAKE IT REAL TO PACIFY THE LAC T00000 /LOADER (WHICH THINKS MODE 3 IS LOGICAL) DAC MODEA1 LAC S /OUTPUT FIRST DATA WORD JMS BINOUT /WITH XOR C00015 /LOADER CODE 15 LAC MODEA1 /IF MODE OF CONSTANT IS INTEGER OR LOGICAL, SNA / SKIP OUTPUT OF SECOND DATA WORD JMP DATA08 LAC NAME1 /OUTPUT SECOND DATA WORD JMS BINOUT / WITH XOR C00016 / LOADER CODE 16 LAC MODEA1 /IF MODE OF CONSTANT IS REAL, SAD T00000 JMP DATA08 / SKIP OUTPUT OF THIRD DATA WORD LAC NAME2 /OUTPUT THIRD DATA WORD JMS BINOUT / WITH XOR C00017 / LOADER CODE 17 DATA08 LAC* SYMTBC /GET SYMBOL DESCRIPTION AND Z00000 SAD W00000 /CHECK FOR A NON-COMMON ARRAY JMP DATA09 /YES - USE POINTER FROM ARRAY DESCRIPTOR BLOCK LAC* SYMTBC / NO, GET ARG DESCRIPTION WORD (WORD 1) AND S17777 / KEEP ADDRESS OF VARIABLE JMP DATA12 DATA09 LAC* SYMTW7 /GET ADDRESS OF ARRAY DATA12 TAD* OPI / ADD SUBSCRIPT VALUE (0 IF NOT ARRAY) TAD MODEA1 /ADD MODE BITS IN BITS 1,2 AND V77777 /AND OUT SIGN BIT, IF ARRAY KLUDGE JMS BINOUT /OUTPUT DEFINITION WORD XOR C00018 /WITH LOADER CODE 18 LAC MODEA2 JMS SETN TAD* OPI DAC* OPI /BUMP SUBSCRIPT BY ARGUMENT LENGTH XOR W00000 /CHANGE SIGN BIT SMA /IF THIS IS ARRAY KLUDGE, CHECK WHETHER SAD* SYMTW3 /WE HAVE EXHAUSTED THE ARRAY SKP /NO ARRAY OR ARRAY EXHAUSTED - GET NEXT ARG JMP DATA03 /NOT EXHAUSTED YET - GET NEXT CONSTANT LAC ARGI SAD TARGI /IF CURRENT ARG PTR IS AT END OF LIST JMP DATA21 /THEN WE ARE FINISHED JMP DATA02 /OTHERWISE BUMP POINTERS AND CONTINUE DATA16 LAC NAME0 SNA ISZ ARGCTR ERX 15C,EC /CURRENT REPEAT CTR MUST BE 0 AND REPEAT FACTOR JMS CONTST /MUST BE A POSITIVE NON-ZERO INTEGER. JMS TWOCMA DAC ARGCTR /STORE INTEGER (NEGATED) AS NEW REPEAT COUNT JMP DATA04 /AND GO GET SOME DATA TO REPEAT DATA21 LAC C00018 /END OF LIST HAS BEEN REACHED - SAD OPVALU /CHECK THAT NEXT INPUT CHARACTER IS A SLASH ISZ ARGCTR /AND THAT THE REPEAT SWITCH IS OFF ERX 12V,EV /OTHERWISE ERROR JMS FNBCHR /GET NEXT NON-BLANK CHAR SAD S00054 / IS IT A COMMA JMP DATA25 /YES, REINITIALIZE FOR NEW SET OF VARIABLES JMP CRTEST /NO, TEST FOR C/R AND EXIT HOLCON XX DATA22 XX .EJECT / IF STATEMENT PROCESSOR / IF LAC C00024 /THE IF INDICATOR IS SET AS AN OPEN DAC IFFLAG /PARENTHESIS FOR EXPRESSION DECODING. JMS EXPRSN /THE IF EXPRESSION IS DECODED AND THE LAC OPVALU /NECESSARY CODE IS GENERATED SO THAT THE /RESULT WILL BE LEFT IN THE ACCUMULATOR ERS 11X,,EX /ERROR: NO CLOSE PAREN JMS SIN530 /SAVE COLUMN POINTERS ISZ CTRLSW /INHIBIT READING CONTINUATION CARDS IFLP JMS FETCHR /GET A CHARACTAR SKP /NORMAL CHARACTER JMP LGCLIF /END OF LINE REACHED - ASSUME LOGICAL IF TAD K00005 SMA /CHECK IF CHAR IS ALPHANUMERIC SAD C00006 /OR BLANK JMP IFLP /IT IS - KEEP LOOKING LAC XCHAR /IF FIRST NON-ALPHANUMERIC, NON-BLANK CHARACTER SAD S00054 /IS NOT A COMMA, SKP JMP LGCLIF /ITS A LOGICAL IF STMT JMS FNBCHR /IF COMMA, WE MUST STILL CHECK THAT THE NEXT CHAR SAD S00050 /IS A RIGHT PAREN JMP LGCLIF /IF IT IS, THIS IS A LOGICAL IF STMT JMS SIN540 /ARITHMETIC IF - RESTORE POINTERS DZM CTRLSW /RE-ENABLE CONTINUATIONS / /ARITHMETIC IF STATEMENT WRAP-UP / DZM LOGIF .IFUND %FPP JMS GTINAC /GET A TESTABLE RESULT INTO THE AC .ENDC .IFDEF %FPP .ENDC LAC OSSTM1 /SET UP TRANSFER VECTOR FOR STORING ADRESSES DAC OSSTMP JMS AIKF50 /GET ADRESS 1 ERS 12X,,EX JMS AIKF50 /GET ADDRESS 2 ERS 13X,,EX JMS AIKF50 /GET ADDRESS 3 .IFDEF %FPP LAC MODEA2 /IS EXPRESSION INTEGER? SNA JMP AIF14 /YES; USE HARDWARE AC LAC JMP.1 /NO; USE FAC OF FPP SAD JMP.2 /ARE FIRST TWO ADDRESSES IDENTICAL JMP AIFR10 /YES USE SHORTCUT METHOD SAD JMP.3 /ARE FIRST AND THIRD ADDRESS SAME? JMP AIFR12 /YES; USE ANOTHER SHORTCUT METHOD LAC FPPSPA /OUTPUT SKIP ON FAC POSITIVE JMS FPPOUT LAC JMP.1 /MAKE SURE OBJECT CODE LISTING IS RIGHT DAC SYMTBC LAC* SYMTBC AND S17777 JMS VECBIN LAC JMP.2 /ARE SECOND AND THIRD ADDRESSES SAME SAD JMP.3 JMP AIF13 /YES; OUTPUT SIMPLE JMP AIFR12 LAC FPPSNA /OUTPUT SKIP ON NONZERO FAC JMS FPPOUT LAC JMP.2 /MAKE SURE OBJECT LISTING RIGHT DAC SYMTBC LAC* SYMTBC AND S17777 JMS VECBIN JMP AIF13 AIFR10 LAC FSPANA JMP AIFR12+1 FPPSPA 716602 /BMA FPPSNA 716601 /BZA FSPANA 716603 /BLE AIF14=. .ENDC LAC JMP.1 /IS ADDRESS 1 THE SAME AS 2 SAD JMP.2 /NO JMP AIF10 /YES SAD JMP.3 /ADDRESS 3? NO JMP AIF12 LAC SPACMD /OUTPUT A SPA INSTRUCTION JMS ABSBIN LAC JMP.1 /SET UP TO LOOK LIKE ADDRESS JUST READ JMS JMPBIN /OUTPUT FIRST JMP(1) LAC JMP.2 /IS ADDRESS 2 THE SAME AS 3 SAD JMP.3 /NO JMP AIF13 /YES AIF12 LAC SNACMD /OUTPUT A SNA INSTRUCTION JMS ABSBIN LAC JMP.2 /SET UP TO OUTPUT JMP (2) JMS JMPBIN AIF13 LAC JMP.3 /SET UP TO OUTPUT JMP (3) JMS JMPBIN JMP CRTEST /TEST FOR CARRIAGE RETURN TERMINATOR AIF10 LAC SPASNA /OUTPUT SPA!SNA COMMAND JMP AIF12+1 .EJECT / LOGICAL IF STATEMENT WRAP-UP / LGCLIF JMS SIN540 /RESTORE CHAR POINTERS DZM CTRLSW /RE-ENABLE CONTINUATION CARDS LAC LOGIF /ARE WE ALREADY IN A LOGICAL IF? ERN 09I,SZA,EI /YES - ERROR JMS GTINAC /GET A TESTABLE RESULT INTO THE AC ISZ LOGIF /GENERATE: (EXPRESSION RESULT IN AC) LAC SNACMD JMS ABSBIN / SNA JMS EXP550 / JMP AA FALSE EXIT XOR JMPCMD / . TRUE EXIT (STATEMENT) DAC STRNGA / . CLC / AA NEXT STATEMENT DAC IFFLAG /SET IFFLAG OFF SO PAREN CHECKS WILL BE VALID JMP CTRL41 /(SEE EX15X ERROR CHECK) .EJECT / SUBROUTINE TO OUTPUT A BRANCH INSTRUCTION TO A STATEMENT LABEL / AIF500 SYN LOGIF JMS FSNOAV /THE DEFINED-ONLY STATEMENT NUMBER IS JMS JMPBIN /FETCHED AND OUTPUT AS A BRANCH LAC XCHAR /INSTRUCTION. JMP* AIF500 / / / SUBROUTINE TO GET A STATEMENT LABEL /STORES IN JMP.1 TO JMP.3 THE THREE LABELS FOR A ARITHMETIC IF /THE QUANTITIES STORED ARE NOT THE TAGS BUT THE ADDRESSES OF THE /TAGS IN THE SYMBOL TABLE. / OSSTM1 DAC JMP.1 /INSTRUCTION TO STORE IN JUMP TABLE JMP.1 0 JMP.2 0 JMP.3 0 / AIKF50 CAL 0 JMS FSNOAV /FETCH DEFINED ONLY STATEMENT LABEL OSSTMP XX /STORE IT IN THE JUMP TABLE ISZ OSSTMP LAC XCHAR /LEAVE WITH OPERATOR IN AC JMP* AIKF50 / / / SUBROUTINE TO FETCH DEFINED-ONLY STATEMENT NUMBER / FDFSNO SYN FPCNT JMS FETSNO /THE CALLING PROGRAM REQUIRES THAT A ERN 05N,SPA,EN /DEFINED STATEMENT NUMBER BE PRESENT JMS CKDFSN /CHECK THAT STMT NO IS DEFINED LAC SYMTBC /THE SYMTAB ADDRESS IS RETURNED TO THE JMP* FDFSNO /CALLING PROGRAM .EJECT / SUBROUTINE TO CHECK HAT STMT NUMBER IS DEFINED / CKDFSN CAL 0 /SUBROUTINE TO CHECK THAT ST. NO. IS DEFINED AND S60000 /ENTER WITH SYMBOL TABLE WORD 1 IN AC XCT PASS /RETURN IF THIS IS PASS 1 OR IF THE MODE SAD S60000 /BITS OF THE SYMBOL ARE NOT 60000 (UNDEF. ST. NO.) JMP* CKDFSN ERX 03N,EN /ERROR: UNDEFINED STMT NO. ON PASS 2 / / SUBROUTINE TO FETCH DEFINED STMT NUMBER OR ASSIGNED GOTO VARIABLE / FSNOAV CAL 0 /SUBROUTINE TO FETCH DEFINED STMT NO. OR ASS. VAR. JMS FETSNO SPA /STATEMENT NUMBER? JMP FSOOPS /NO JMS CKDFSN /CHECK DEFINITION LAC SYMTBC JMP* FSNOAV /RETURN WITH SYMTAB POINTER IN AC FSOOPS JMS FIARGO /FETCH SIMPLE INTEGER JMS VARTST /VARIABLE LAC SYMTBC XOR W00000 /RETURN WITH SYMTAB POINTER IN AC JMP* FSNOAV /AND SIGN BIT ON .TITLE FUNCTION AND SUBROUTINE STATEMENT PROCESSORS / STATEMENT FUNCTION STATEMENT PROCESSOR / STAFCN LAC SORDER /STATEMENT FUNCTIONS MUST PRECEDE EXECUTABLE CODE ERN 16I,,EI /WHICH HAS A STMT ORDER OF SEVEN. LAC V00000 /STATEMENT FUNCTIONS HAVE AN IMPLIED DAC TORDER /STATEMENT ORDER OF SIX. JMS EXP550 /STRING A JUMP XOR JMPCMD /AROUND THE FUNCTION BODY DAC STRNGA /AND SAVE THE STRING ADDRESS FOR STMT CLEANUP XCT PASS JMP SFCN01 /STATEMENT FUNCTION NAMES CANNOT BE /EXPLICITLY TYPED AS EXTERNAL FUNCTIONS LAC* SYMTBC AND S60000 XOR PC XOR Y00000 /STATEMENT FUNCTIONS ARE DIFFERENTIATED DAC* SYMTBC /FROM EXTERNAL FUNCTIONS. SFCN01 JMS CTRL70 /STATEMENT FUNCTIONS CANNOT BE LABELED. /THE DUMMY ARGUMENTS LISTED ARE VALID ONLY JMS SUBR60 /FOR THIS STATEMENT AND MAY DUPLICATE ISZ TSMTBN /PREVIOUSLY DECLARED NAMES. THE AREA IN JMS SUBR50 /FRONT OF THE SYMBOL TABLE IS USED TO LAC XCHAR /TEMPORARILY CONTAIN THESE ERASABLE VARIABLES ERS 04E,,EE /CHECK FOR = SIGN LAC C00001 /THE PROPER NEXT ENTRY ADDRESS IS RESET DAC IFFLAG /SO THAT NON-DUMMY VARIABLES IN THE DZM TSMTBN /EXPRESSION MAY BE ENTERED PERMANENTLY. LAC STAF TAD S03100 DAC STAF LAC TSMTBC DAC SUBR40 /SAVE POINTER TO FUNCTION DEFINITION JMS EXPRSN /THE BODY OF THE FUNCTION IS DECODED AND LAC* SUBR40 /GET THE MODE OF THE FUNCTION AND S60000 /FROM ITS SYMBOL TABLE ENTRY JMS EXP740 LAC SUBR40 /AFTER CONVERTING THE RESULT, GET THE ENTRY DAC SYMTBC /POINT ADDRESS FROM THE SYMBOL TABLE JMS SYMBIN /AND GENERATE A RETURN JUMP XOR JMPICM /THE SUBROUTINE IS CLOSED WHEN THE EXIT JMP STEXIT /INSTRUCTION IS OUTPUT. STAF 0 /STATEMENT FUNCTION TEMPORARY STORAGE SUFFIX S03100 3100 /A-- .EJECT / T FUNCTION STATEMENT PROCESSOR / TFUNCT LAC SORDER /WE CAME HERE FROM THE TYPE STMT PROCESSOR ERN 17I,SZA,EI /ERROR: FUNCTION STMT NOT FIRST IN PROGRAM / / / SUBROUTINE/FUNCTION STATEMENT PROCESSOR / FUNCTI LAC S20000 /A FUNCTION IS DIFFERENTIATED FROM A SUBROU XOR JMPICM /SUBROUTINE IN THAT A FUNCTION MUST RETURN DAC FCNFLG /A VALUE IN THE ACCUMULATOR TO THE CALLING DZM TORDER LAC PASS2 /PUT A NOP INTO ENTFLG SO SUBR50 DAC ENTFLG /WILL KNOW THIS IS SUBROU OR FUNCTI JMS FVARGO /PROGRAM. THE SUBPROGRAM NAME IS FETCHED XCT PASS JMP FUN002 /MODE SET IF PASS 2 LAC MODE SPA /THE MODE-TYPE IS EXPLICITLY SET WHEN FUN002 LAC* SYMTBC /THIS IS A T FUNCTION STATEMENT AND S77777 /THE NAME IS ENTERED AS A SIMPLE VARIABLE DAC* SYMTBC /WITH THE USE FLAG RESET. XCT PASS /**060** CHECK FOR UNDEFINED FUNCTION ON PASS 2 SKP /**060** IT'S PASS 2 JMP FUN003 /**060** NO CHECK AND S17777 /**060** ONLY NEED ADDRESS BITS SAD S17777 /**060**IF ADDRESS EQUALS 17777, FUNCTION IS SKP /**060**NOT DEFINED JMP FUN003 /**060** LAC FCNFLG /**060** TEST IF SUBROUTINE OR FUNCTION, IF FUNCTION ERS 10E,,EE /**060** THEN ERROR FUN003=. /**060** NO ERROR CONTINUE LAC MODE CMA AND W00000 /IF THE FUNCTION WAS EXPLICITLY TYPED DAC* SYMTW6 /SET THE "EXPLICITLY TYPED" BIT ON JMS SUBR40 /COMPILE THE CODE FOR THE STATEMENT LAC FNCMNE /DEFINE THE QUANTITY ".EX" AS THE JMS EXP580 /ADDRESS OF THE RETURN CODE FOR THE SUBROUTINE JMP .+1 /FANCY, FANCY! LAC SYMTBC /SAVE THE SYMBOL TABLE POINTER SO THAT THE DAC FCNRET /"END" STATEMENT PROCESSOR CAN DEFINE .EX ISZ TORDER /ONLY ONE SUBR,FUNCT OR BLOCKDATA IS ALLOWED JMP CRTEST .EJECT ENTRY LAC FCNFLG /AN ENTRY STATEMENT IS ONLY LEGAL AND Z40000 /INSIDE A SUBROUTINE OR FUNCTION ERS 03E,,EE JMS EXP550 /GENERATE A JUMP AROUND XOR JMPCMD /THIS STATEMENT DAC STRNGA /SAVE STRING ADDRESS FOR STATEMENT CLEANUP RTN JMS FVARGO /GET ENTRY NAME LAC NAME1 ERN 02E,SZA,EE /ENTRY NAME MUST BE UNIQUE LAC PASS1 /PUT A SKP INTO ENTFLG, SO SUBR50 WILL DAC ENTFLG /KNOW ITS AN ENTRY STATEMENT. LAC PC DAC* SYMTBC /STORE ENTRY ADDRESS AWAY TEMPORARILY JMS SUBR40 /COMPILE THE CODE FOR THE ENTRY LAC TSMTBC DAC SYMTBC /RESTORE SYMTBC FOR LISTING JMS SYMBIN /GENERATE LAC ENTRYNAME XOR LACCMD / DAC SUBROUTINENAME LAC S17777 DAC* SYMTBC /SET ENTRY POINT UNDEFINED FOR UNIQUENESS TEST LAC DACCMD /OUTPUT A "DAC 0" SINCE SUBROUTINE ENTRY IS JMS RELBIN /AT 0 (RELOCATABLE) JMP CRTEST .EJECT / SUBROUTINE TO OUTPUT CODE FOR "FUNCTION","SUBROUTINE", AND "ENTRY" STMTS / SUBR40 CAL 0 JMS OSYMBL /PUT OUT THE NAME LAC PC /AS A GLOBAL AND DEFINE IT JMS BINOUT /WITH THE CURRENT LOCATION COUNTER XOR C00010 JMS SUBR60 /GENERATE THE SUBROUTINE ENTRY CODE LAC OPVALU /ANY ARGUMENTS? SAD C00028 JMS SUBR50 /YES - COLLECT THEM JMP* SUBR40 / / / / SUBROUTINE TO GENERATE A SUBROUTINE ENTRY / SUBR60 SYN FLOATF DZM STRNGB JMS TSETAD /THE SYMBOL TABLE POINTERS ARE PRESERVED LAC PC /THE SUBROUTINE ENTRY POINT IS OUTPUT AS JMS VECBIN /A SELF-REFERENCING TRANSFER VECTOR. LAC OPVALU SAD C00028 /A SUBROUTINE SUBPROGRAM MAY BE WRITTEN JMP SUBR51 /WITHOUT AN ARGUMENT LIST. LAC FCNFLG ERS 05E,,EE /ARG LIST NOT INDICATED JMP* SUBR60 SUBR51 LAC GETARG JMS EXP580 / THE SUBROUTINE ENTRY CODE IS... XOR JMSCMD JMS EXP550 / ENTRY .DSA ENTRY XOR JMPCMD / JMS* .G GET ARGUMENTS DAC STRNGB / JMP A(N)+1 JMP* SUBR60 .EJECT / SUBROUTINE TO FETCH DUMMY ARGUMENTS / SUBR50 SYN RWFLAG SUBR55 JMS FVARGO / . . . LAC NAME1 SNA /IS ARGUMENT NAME UNIQUE? JMP SUBR52 /YES - GO OUTPUT POINTER LAC* SYMTBC /THERE ARE FOUR POSSIBILITIES HERE - AND S17777 /1) THE VARIABLE HAS BEEN TYPED BUT NOT USED SAD S17777 /2) THE VARIABLE IS DEFINED AS THE CURRENT LOCATION JMP SUBR52 / (I.E. WE ARE IN PASS2) SAD PC /TSMTBC ADDRESS THE ENTRY, FUNC, OR SUBR NAME JMP SUBR52 /SYMTAB ENTRY. IN PASS 1 MUST GET NEG RESULT CMA /AT THIS STAGE AS (3) THE VAR. WAS PREVIOUSLY TAD* TSMTBC /DEFINED AS DUMMY. AT END OF PASS1, DUMMY ARRAYS SMA /ARE REDEFINED AT END OF PROGRAM. CHECK 3 STILL JMP SUBRYY XCT PASS XCT ENTFLG /POSITIVE RESULT OF CMA; TAD* TSMTBC IS OK. JMP SUBRYY / JMPS IF PASS1 OR IF NOT ENTRY LAC* SYMTBC SPA!CLA /POSITIVE IF NOT ARRAY; IF IS ARRAY SUBRYY LAC* SYMTBC /CHECK IF IS DUMMY AND V00000 ERS 14V,,EV LAC* SYMTBC /IF THE ARGUMENT WAS VALIDLY PREVIOUSLY DEFINED AND S17777 /THEN OUTPUT A POINTER TO THE PREVIOUS XOR W00000 /DEFINITION WITH THE SIGN BIT ON JMS VECBIN JMP SUBR53 /REJOIN OTHER CODE SUBR52 LAC TSMTBN SZA JMP .+3 /STATEMENT FUNCTION. XCT PASS JMP SUBR56 LAC* SYMTBC /ALL ARGS IN THE LIST ARE TYPED AS AND W77777 XOR V00000 /DUMMY VARIABLES AND ASSIGNED THE VALUE OF DAC* SYMTBC /THE CURRENT LOCATION COUNTER. SUBR56 JMS DEFNSM XOR PC JMS VECBIN /THE ARGUMENT LIST IS OUTPUT AS A LIST OF SUBR53 LAC OPVALU /SELF-REFERENCING TRANSFER VECTORS. SAD C00031 /ARGUMENT LIST TERMINATED BY JMP SUBR54 /CLOSE PARENTHESIS ERS 03S,,ES /ONLY OTHER LEGAL CHAR IS , JMP SUBR55 SUBR54 LAC STRNGB /STRING JUMP ROUND JMS STRING /ARGUMENT LIST JMS FNBCHR JMP* SUBR50 .EJECT / BLOCK DATA STATEMENT PROCESSOR / BLOCKD LAC K00001 /THE SUBPROGRAM FLAG IS SET TO INDICATE DAC FCNFLG /A BLOCK DATA SUBPROGRAM. LAC LOWRAD /THE BLOCK DATA DECLARATION IS OUTPUT AS JMS BINOUT /THE CUMULATIVE SIZE OF THE DECLARED XOR C00011 /COMMON BLOCKS ISZ TORDER /ONLY ONE SUBR,FUNCT, OR BLOCKDATA ALLOWED IN A PGM XCT PASS /IF WE ARE IN PASS 2, JMS CLENUP /OUTPUT COMMON DEFINITIONS NOW. JMP CONTIN /FROM BEING ACCEPTED. .EJECT / RETURN STATEMENT PROCESSOR / RETURN LAC FCNRET /A "RETURN" STATEMENT IS ONLY LEGAL ERN 10I,SNA,EI /IF WE ARE IN A SUBROUTINE OR FUNCTION JMS FNBCHR /LOOK A CHARACTER AHEAD DZM UNFNBC SAD C00013 /IS THE CHARACTER A CARRIAGE RETURN? JMP RETRNX /YES - NORMAL SUBROUTINE RETURN MRETRN JMS FVARGO /MULTIPLE RETURN - GET THE RETURN TARGET DZM UNFNBC LAC* SYMTBC AND Z60000 /MAKE SURE THAT IT IS A SIMPLE INTEGER ARGUMENT ERS 26I,,EI /ERROR: ILLEGAL RETURN ADDRESS JMS SYMBIN /GENERATE LAC* ARGUMENT XOR LACICM / DAC SUBROUTINENAME LAC DACCMD / FOLLOWED BY A NORMAL RETURN SEQUENCE JMS RELBIN RETRNX LAC FCNRET /GENERATE A JUMP JMS JMPBIN /TO THE COMMON RETURN CODE AT THE END OF THE PGM JMP CONTIN .EJECT / CALL STATEMENT PROCESSOR / CALL JMS FA2NOP /THE NAME OF THE SUBROUTINE BEING CALLED JMS VARTST /IS FETCHED AND ENTERED INTO THE ARG(I); LAC* SYMTBC /OP(I) LISTS AND Z00000 SAD U00000 /IS THE NAME A FUNCTION? JMP CALL03 SAD V00000 /IS THE NAME A DUMMY ARG? JMP CALL01 LAC NAME1 /CHECK FOR REDEFINITION OF AN ERN 06E,SZA,EE /EXISTING VARIABLE CALL02 LAC* SYMTBC AND S77777 XOR U00000 /THE NAME IS TYPED AS A FUNCTION NAME IF DAC* SYMTBC /THIS IS ITS FIRST APPEARANCE. CALL03 LAC OPVALU SAD C00028 /A SUBROUTINE MAY BE CALLED WITH OR JMP CALL06 /WITHOUT SPECIFYING A PARAMETER LIST. JMS SYMBIN /A SIMPLE "JMS* SUBR" IS GENERATED WHEN XOR JMSICM /NO PARAMETER LIST IS SPECIFIED JMP CRTEST /THE EXPRESSION DECODING ROUTINE IS USED CALL06 LAC CALL05 /TO GENERATE THE SUBROUTINE CALL WITH DAC EXPRSN /FORMAL PARAMETERS. JMP EXP011 CALL05 .DSA CRTEST CALL01 LAC U00000 XOR* SYMTW2 DAC* SYMTW2 JMP CALL02 JMSICM JMS* 0 .TITLE END STATEMENT PROCESSOR / END LAC K00001 DAC PROCAD /SET UP PROCAD FOR ERROR ROUTINE JMS CTRL70 /END STATEMENTS CANNOT BE LABELED LAC FCNFLG SAD K00001 JMP ENDBLK /BLOCK DATA SUBPROGRAM SNA /MAIN PROGRAM? JMP END04 /YES LAC PC /NO - DEFINE ".EX" HERE XOR V00000 DAC* FCNRET LAC FCNFLG SAD JMPICM /IF THIS IS A SUBROUTINE, JMP END02 /OUTPUT A "RETURN" LAC ARG0 DAC ARG2 LAC SYMTB0 XOR T00000 DAC* ARG2 /THE FUNCTION SUBPROGRAM EXIT CONSISTS JMS SETA2 /OF A LOAD COMMAND WITH THE FUNCTION NAME JMS EXP590 /AS THE ARGUMENT. TAD C00004 /THIS IS FOLLOWED BY A BRANCH RETURN TO END02 LAC JMPICM /THE CALLING PROGRAM (INDIRECT VIA ENTRY). JMS RELBIN JMP ENDSP1 END04 LAC CLACMD /GENERATE A "STOP 0" AT THE END JMS ABSBIN /OF A MAIN PROGRAM LAC STMNE /TO PREVENT USERS FROM KILLING THEMSELVES JMS EXP580 /BY STUPIDITY XOR JMPCMD LAC PC DAC START /SET THE STARTING ADDRESS HERE FOR A MAIN PROGRAM .IFDEF %FPP LAC T31422 /OUTPUT A CALL TO .ZB JMS EXP580 XOR JMSCMD .ENDC LAC FNCMNE+1 /IS OUTPUT IF THIS JMS EXP580 /IS A MAIN-BODY XOR JMSCMD /PROGRAM CONTAINING I-O STATEMENTS LAC JMPCMD /A JUMP IS NOW OUTPUT TO THE BEGINNING JMS RELBIN /OF THE PROGRAM (RELOCATABLE LOCATION 0) ENDSP1 JMS CLENUP /ASSIGN VARIABLE STORAGE NOW LAC CONTB0 DAC TCTR END09 SAD CONTBN JMP END13 LAC* TCTR /DECLARED AND CREATED CONSTANTS ARE AND Z60000 /ASSIGNED MEMORY LOCATIONS IMMEDIATELY XOR PC /FOLLOWING THE PROGRAM BODY. DAC* TCTR RAL /CHECK FOR THE SPECIAL CONSTANT SPA!RAR /GENERATED BY THE @N CONSTRUCTION JMP RELCON /AND OUTPUT THEM AS RELOCATABLE CONSTANTS JMS SETN /THE CONSTANTS ARE OUTPUT AS THEY ARE JMS TWOCMA /ASSIGNED. DAC TEMP0 END10 JMS CNSE50 LAC* TCTR JMS FPPOUT ISZ TEMP0 JMP END10 END11 JMS CNSE50 JMP END09 RELCON JMS CNSE50 LAC* TCTR /LOW ORDER WORD IS ADDRESS DAC SYMTBC /OF SYMBOL TABLE ENTRY FOR STATEMENT NUMBER LAC* SYMTBC /FROM THAT ENTRY WE GET THE ADDRESS AND S17777 JMS VECBIN JMP END11 END13 LAC DOTABA ERS 04L,,EL /ERROR: BACKWARD DO LOOP JMP PASS ENDBLK XCT PASS SKP JMS CLENUP /CLEAN UP ON PASS 1 ONLY PASS SKP JMP END12 / END OF COMPILATION / / PASS 2 INITIALIZATION / LAC PASS2 /INITIALIZE... DAC PASS / PASS FLAG .IFUND RSX CAL+767 6 .ENDC .IFDEF RSX LAC (DAT11) /CLOSE THE INPUT FILE AT END OF PASS1 JMS CLOSEL .ENDC JMS SUB990 .DSA 400000+MESSY4-2 EPS1SW XX /DON'T WAIT FOR ^P. .IFUND RSX .DSA 100000+MESSY3-2 Z77000 777000 DAC CTLPSW JMP . /WAIT FOR ^P .ENDC .IFDEF RSX CNTPLP CAL WRCP /WRITE ^P ON TTY CAL WFEVA /WAIT FOR EVENT VARIABLE CAL REACP /READ A LINE CAL WFEVA /WAIT FOR EVENT VARIABLE LAC EVA /PICK UP THE EVENT VARIABLE SPA JMP EXITF /BAD EVENT VARIABLE EXIT LAC SINBFH+2 /PICK UP THE FIRST WORD AND (774000) /MASK OFF THE FIRST CHARACTER SAD (100000) /IS IT ^P? JMP INIT01 /YES RESTART SAD (104000) /IS IT ^Q? JMP EXITF /YES EXIT JMP CNTPLP /NEITHER TRY AGAIN / WRCP 2700 /WRITE ^P EVA /EVENT VARIABLE ADDRESS DAT3 /LUN 2 /DATA MODE MESSY3-2 /LINE BUFFER ADDRESS / REACP 2600 /READ FROM TTY EVA /EVENT VARIABLE ADDRESS DAT2 /LUN 2 /MODE SINBFH /BUFFER ADDRESS 5 /MAX WORD COUNT / .ENDC .EJECT / END OF COMPILATION / END12=. LAC PASS2 DAC BINO06 LAC SYMTB0 END23 DAC SYMTBC JMS OBJ500 /INITIALIZE SYMBOL TABLE OUTPUT LINE LAC SYMTBC /*** END23+1 IS REFERENCED IN INIT01 *** SAD SYMTBN JMP END22 JMS SETADR JMS SIN530 JMS OSYMBL /EACH SYMBOL IS OUTPUT AS AN INTERNAL LAC* SYMTBC /SYMBOL FOR DDT. THE USER MUST MAINTAIN AND S17777 /SOME DISCRETION WHEN IT COMES TO THE USE SAD S17777 /OF SYMBOLS WHICH THE COMPILER DOES NOT SKP /DEFINE (BECAUSE THEY ARE NOT REFERENCED) JMS BINOUT XOR C00019 LAW -1 SAD* SYMTBC JMP .+5 JMS SYMTYP /THE SYMBOL TABLE IS PRINTED WITH FOUR XOR U00000 /SYMBOLS AND THEIR DEFINITIONS PER LINE. LAC K00010 TAD K00006 /COMMON SECTIONS ARE INDICATED BY A SLASH, TAD C00048 /EXTERNAL NAMES AND STATEMENT FUNCTIONS JMS OBJ510 /BY AN ASTERISK BEFORE JMS OBJ630 /THE SYMBOL AND ITS DEFINITION. JMS OBJ550 JMS OBJ630 LAC* SYMTBC AND Z00000 SAD Y00000 JMP END50 LAC* SYMTBC SPA LAC* SYMTW7 SKP END50 LAC* SYMTBC JMS OBJ640 /FORMAT SYMBOL DEFINITION. JMS OBJ630 /FORMAT A SPACE SYMMAP SKP JMS OBJ520 /OUTPUT SYMBOL BUFFER JMS SBSE50 JMP END23 END22 LAC START JMS BINOUT /OUTPUT END CODE WITH STARTING ADDRESS OF XOR C00023 /PROGRAM UNIT AS THE DATA WORD .IFUND %NOEOC /(RKB-069) DO WE WANT END OF COMP. MSGS? LAC ERRCNT /(RKB-067) READY FOR SIZE AND ERRS MSG SZA /(RKB-067) HAVE ANY ERRORS OCCURRED? JMP END24 /(RKB-067) YES LAC (PGMSIZ) /(RKB-067) NO, JUST TO 'SIZE =' PART DAC SINBUF /(RKB-067) LAW -5 /(RKB-067) CONVERT 5 CHARS DAC CHRCNT /(RKB-067) LAC PC /(RKB-067) CONVERT PC TO ASCII JMS OBJ540 /(RKB-067) CONVERT ROUTINE LAW -5 /(RKB-067)**ARG TO OBJ540 JMS SUB990 /(RKB-067) TYPE IT .DSA SIZMSG+400000 /(RKB-067) SUPRESS IF IN BOSS LAC .-1 /(RKB-067) AND FORWARD MSG TO PRINTER JMP END25 /(RKB-067) GO END24 LAC (ERRMSG+2) /(RKB-067) DO ERROR COUNT MSG JMS SUB980 /(RKB-067) CONVERT ERROR COUNT TO DECIMAL LAC ERRCNT /(RKB-067) **ARG TO SUB980 JMS SUB990 /(RKB-067) OK, TYPE IT .DSA ERRMSG+400000 /(RKB-067) SUPRESS IF BOSS LAC .-1 /(RKB-067) GET MSG ADDR FOR PRINTING END25 AND S77777 /(RKB-067) STUFF RIGHT MSG ADDR IN PRINT CALL DAC END26 /(RKB-067) WITHOUT SUPPRESS BIT .IFUND RSX /(RKB-067) LAC S02766 /(RKB-267) SET OUTPUT TO .DAT -12 .ENDC /(RKB-067) .IFDEF RSX /(RKB-067) LAC (DAT12) /(RKB-067) SET OUTPUT TO LUN16 .ENDC /(RKB-067) XCT LIST /(RKB-067) SKIP IF LISTING DEVICE IS NOT TTY. JMP F4K /(RKB-067) DAC S990CL /(RKB-067) STUFF UNIT IN I/O. JMS SUB990 /(RKB-067) PRINT IT END26 .DSA .-. /(RKB-067) .ENDC /(RKB-069) F4K XX JMP .+3 JMS SUB990 .DSA MESSY2-2 .IFUND RSX .WAIT -3 / .CLOSE -11 /NOW IS THE TIME TO CLOSE ALL FILES CAL 00767 .DSA 000006 / .CLOSE -12 XCT LIST JMP .+3 CAL 00766 .DSA 000006 / .CL0SE -13 LAC OBINRY /WAS BINARY SMA /OPENED? JMP NJOPND /NO XCT OBINRY /DID WE GET AN ERROR? JMP COMPER /YES CAL 00765 /NO-CLOSE FILE 6 JMP NJOPND COMPER CAL 765 /ERROR-KILL FILE 1 INIT02 0 .ENDC .IFDEF RSX EXITF LAC (DAT11) /CLOSE INPUT LUN JMS CLOSEL XCT LIST /DON'T CLOSE THE LISTING LUN IF NO LISTING WAS PRINTED JMP .+3 LAC (DAT12) JMS CLOSEL /CLOSE LISTING OUTPUT DEVICE LAC OBINRY /CHECK IF A BINARY FILE WAS OPEN SMA JMP EXITR /NO - DON'T CLOSE AT ALL LAC (DAT13) /YES - GET BINARY FILE LUN XCT OBINRY /WERE THERE COMPILATION ERRORS? CMA /YES JMS CLOSEL /NO XCT DELETE /SKIP TO DELETE BAD BINARY WHEN NO ORIGINAL JMP .+3 /BINARY XCT OBINRY /SKP IF NO ERRORS, AVOID DELETE JMS DELBIN / EXITR LAC (DAT11) /DETACH FROM INPUT LUN JMS DETACH LAC (DAT12) /DETACH FROM LISTING LUN JMS DETACH LAC (DAT13) /DETACH FROM BINARY FILE JMS DETACH LAC TITLEA /CHECK THE LAST CHARACTER SAD S00054 /IS IT A ,? JMP INIT02 /YES RESTART SAD C00013 /IS IT A CARRTN? CAL REQTDV /YES REQUEST TDV .ENDC .IFUND RSX NJOPND LAC TITLEA SAD C00013 JMP INIT02 /ALLOW BATCH PROCESSING OF SOURCE PROGRAMS. .ENDC .IFUND RSX / .EXIT END999 CAL 0 C00013 .DSA 000015 .ENDC .IFDEF RSX CAL C00008 /EXIT TASK .ENDC PFILE1 .DSA FILE1 / .EOT