.TITLE
/
/
/ FIRST PRINTING, JANUARY 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) 1975, BY DIGITAL EQUIPMENT CORPORATION
/
/
/
.TITLE XVM FORTRAN IV COMPILER, PART 2
/
/ CONTINUATION OF TWO PART SOURCE FILE OF FORTRAN COMPILER
/ THE SAME EDIT NUMBER AND SOURCE FILE EXTENSION IS MAINTAINED
/ FOR BOTH PARTS
/
/
/ EDIT # 46 4 FEB 74 TAM
/
/ EDIT DATE VERSION PROGRAMMER FIX
/ 050 24-NOV-74 V3A001 R.K. HYATT CORRECTED >0E < PROBLEM - IN PART TWO
/
/ 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 CHANGE VERSION NUMBER TO V3B000
/ FOR B UPDATE TO DOS-15
/
/ 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
/ REDUNTENT EQUIVALENCE STATEMENTS - NEW ERROR
/ MESSAGE >17C< - SPR#15-714
/
/ 058 3-FEB-75 V3B003 R.K. HYATT INSERTED CHECK FOR UNBALANCED
/ RIGHT PARENS IN PRE-SCANNER - 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 DEFINITIONS - SPR#15-E737
/
/ 061 20-FEB-75 V3B006 R.K. HYATT CHANGED HELLO IN PDP15 VERSIONS
/ OF COMPILER
/
/ 062 21-MAY-75 R.K. BLACKETT REMOVED ANTIQUE CONDITIONALS
/
/ 063 22-MAY-75 V1X000 R.K. BLACKETT CHANGE CODE GENERATED FOR A
/ LOGICAL .OR. TO DO A BOOLEAN INCLUSIVE OR
/
/ 064 22-MAY-75 V1X001 R.K. BLACKETT FIX FORMAT STATEMENT PROCESSOR
/ 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' IN P1.
/
/ 066 28-AUG-75 V1X003 R.K.BLACKETT ADD LISTING HEADER LINE.
/
/ 067 16-OCT-75 V1A000 R.K. BLACKETT ADD SIZE AND ERR CNT MSGS
/
/068 11-NOV-75 V1A000 R.K. BLACKETT FROM NOW ON, ONLY THE EDIT
/ HISTORY IN PART 1 WILL BE UPDATE
/ WITH EACH EDIT.
/
/
.TITLE COMPILER MESSAGES
/SUBROUTINE TO OUTPUT MESSAGES
/CALLING SEQUENCE...
/ JMS SUB990
/ .DSA HIGHBITS+MESSAGE ADDRESS (-2 FOR DUMMY HEADER)
/ HIGHBITS=400000 FOR BATCH SUPPRESSION, 100000 FOR TTY FORCE
/
SUB990 CAL 0
.IFUND RSX /(RKB-067)
LAC* SUB990
AND* SCOM52
SPA!CLL /IF BATCH AND HIGHBITS=400000,
JMP SUB991 /SCRUB THE MESSAGE
LAC* SUB990
AND T00000
RTR
XOR* SCOM52 /PUT THE 100000 BIT INTO BIT 4 OF .SCOM+52
DAC* SCOM52 /TO FORCE PRINTOUT ON THE TELETYPE IF ON
.ENDC
.IFDEF RSX
LAC S990CL /CHECK TO SEE IF OUTPUT TO LPT
SAD (DAT12)
JMP SUB992 /YES DON'T SUPPRESS
LAC VERPNT /IS TTY I/O PERMITTED?
SNA
JMP SUB991 /NO IGNORE TTY I/O
SUB992=.
.ENDC
LAC* SUB990
AND S77777 /GET RID OF HIGHBITS
.IFUND RSX
DAC CTLPSW
/ .WRITE -3
S990CL CAL 2775
.DSA 000011
CTLPSW .DSA 000000
Z77677 .DSA 777677
DZM .-2
LAC S02775
.ENDC
.IFDEF RSX
DAC DA3MSG /SET UP MESSAGE POINTER
CAL WRIT3 /WRITE MESSAGE
JMS WFEV /WAIT FOR EVENT VARIABLE
LAC S990CL /LUN IN CASE OF I/O ERROR
LAC (DAT3) /RESTORE LUN NUMBER
.ENDC
DAC S990CL
SUB991 ISZ SUB990
JMP* SUB990
.IFUND RSX /(RKB-067)
SCOM52 .DSA 152
.ENDC
.EJECT
/(RKB-067)
/(RKB-067) SUBROUTINE TO CONVERT A POSITIVE BINARY NUMBER
/(RKB-067) INTO 5 PACKED ASCII CHARCTERS.
/(RKB-067)
/(RKB-067) CALLING SEQUENCE:
/(RKB-067) LAC (WHERE) / WHERE TO PUT THE 5/7 ASCII WORD PAIR
/(RKB-067) JMS SUB980
/(RKB-067) LAC NO# / WHERE TO GET THE NUMBER TO CONVERT
/(RKB-067) --- ------ <-- RETURN
/(RKB-067)
SUB980 XX /(RKB-067) CONVERT BINARY TO DECIMAL ASCII
DAC SUB98P /(RKB-067) SAVE 'TO' ADDR
XCT* SUB980 /(RKB-067) GET NUMBER TO CONVERT
IDIV /(RKB-067) PULL OUT LSD
12 /(RKB-067)
AAC 60 /(RKB-067) MAKE IT ASCII
RAL /(RKB-067) RIGHT PLACE FOR LAST CHAR OF PAIR
DAC SUB98T+1 /(RKB-067) PUT IT AWAY
DIV+1000 /(RKB-067) GET FOURTH CHAR
12 /(RKB-067)
AAC 60 /(RKB-067) MAKE IT PRINT
ALSS 10 /(RKB-067) POSITION IT
XOR SUB98T+1 /(RKB-067) COMBINE W/EXISTING CHAR
DAC SUB98T+1 /(RKB-067)
DIV+1000 /(RKB-067)GET THE THIRD
12 /(RKB-067)
ALSS 17 /(RKB-067)
XOR SUB98T+1 /(RKB-067)
DAC SUB98T+1 /(RKB-067)
DIV+1000 /(RKB-067) NEXT
12 /(RKB-067)
AAC 60 /(RKB-067)
ALSS 4 /(RKB-067)
AAC 6 /(RKB-067) THIS IS HIGH PART OF CHAR 3
DAC SUB98T /(RKB-067)
LACQ /(RKB-067) GET LAST CHAR
AAC 60 /(RKB-067)
ALSS 13 /(RKB-067)
XOR SUB98T /(RKB-067)
DAC* SUB98P /(RKB-067) MOVE IT OUT TO USER AREA
ISZ SUB98P /(RKB-067)
LAC SUB98T+1 /(RKB-067) SECONT WORD OF PAIR
DAC* SUB98P /(RKB-067)
JMP* SUB980 /(RKB-067) ALL DONE
SUB98P 0 /(RKB-267)
SUB98T .BLOCK 2 /(RKB-067)
.IFUND %NOHDG /(RKB-069)
MESSY1-./2*1000+2 /(RKB-070)
0 /(RKB-070)
TOF .ASCII <14>'PAGE 000 FILNAM SRC DD-MON-YY HH:MM ' /(RKB-066)
.ENDC /(RKB-069)
.DEFIN HELLO,VER,RLSE,LVL
.IFUND RSX
.IFUND %FPP
MESSY1 .ASCII 'F4M XVM V@VER@RLSE@LVL'<15>
.ENDC
.IFDEF %FPP
MESSY1 .ASCII 'FPF4M XVM V@VER@RLSE@LVL'<15>
.ENDC
.ENDC
.IFDEF RSX
MESSY4-./2*1000+2 /(RKB-070) RSX NEEDS NICE HEADER WORD PAIR
0 /(RKB-070)
.IFUND %FPP
MESSY1 .ASCII 'F4M RSX XVM V@VER@RLSE@LVL'<15>
.ENDC
.IFDEF %FPP
MESSY1 .ASCII 'FPF4M RSX XVM V@VER@RLSE@LVL'<15>
.ENDC
.ENDC
.ENDM
/
/
/
HELLO 1,A,005 /(GAR-075) KICK TO XVM V1A005.
/
/
/
/
/ OTHER MESSAGES USED BY FORTRAN
/
.IFDEF RSX
MESSY5-MESSY4/2*1000+2
0
.ASCII ' FOR-'
.ENDC
MESSY4 .ASCII /END PASS1/<15>
.DSA 420240
.DSA 406472
.DSA 330432
MESSY5 .DSA 373720 /.ASCII />/<175>
.IFUND RSX
MESSY3 .DSA 572417 /.ASCII /^P/<175>
.ENDC
.IFDEF RSX
X77777-MESSY3/2*1000+1002
0
MESSY3 .ASCII /FOR-^P/<175>
.ENDC
X77777 .DSA 577777
3002
0
MESSY6 .ASCII / >00I< /<15>
ERFLG1 .ASCII '< '<15>
.LOC .-1
ERFLG2 .ASCII '<^'<15>
.LOC .-1
.IFUND RSX
CMDERT .ASCII /?/<15>
.LOC .-1
.ENDC
.IFDEF RSX
4002
0
CMDERT .ASCII /FOR-SYNTAX ERR/<15>
.ENDC
.IFDEF RSX
4002
0
.ENDC
MESSY2 .ASCII <12>/ PROG > 4K/<15>
.LOC .-1
.IFDEF RSX
2002
00
MESSY7 .ASCII <15>
.LOC .-1
.ENDC
.IFUND %NOEOC /(RKB-069)
SIZMSG 010002 /(RKB-067)
0 /(RKB-067)
.ASCII 'PROGRAM SIZE = ' /(RKB-067)
PGMSIZ .ASCII 'XXXXX' /(RKB-067)
.ASCII ', NO ERRORS'<15> /(RKB-067)
.LOC .-1 /(RKB-067)
ERRMSG 006002 /(RKB-067)
0 /(RKB-067)
.ASCII 'XXXXX ERRORS DETECTED'<15> /(RKB-067)
.LOC .-1 /(RKB-067)
.ENDC /(RKB-069)
.TITLE ARITHMETIC EXPRESSION ANALYZER
/ SUBROUTINE TO INITIALIZE ARG(I) AND OP(I) LISTS
/ CALLING SEQUENCE...
/ JMS INAOPI
/
INAOPI SYN TFAO04
LAC ARG0
DAC ARGI / 0 TO I
DAC ARG1 / ARG(0) TO ARG1
DAC TYPEA1 / SET NO ARGUMENT 1
LAC OP0
DAC OPI / 0 TO I
DZM* OPI / OP(0) TO POP
JMS EXP640 /0 TO LEVEL(POP)
LAC TSIMNE
DAC TSI / INITIALIZE CREATED TEMPORARY STORAGE
LAC TSRMNE
DAC TSR / FOR INTEGER-LOGICAL, REAL, AND
LAC TSDMNE
DAC TSD / DOUBLE PRECESION.
LAC TSJMNE
DAC TSJ
JMS INFAOP / INITIALIZE FETCH ARG-OP SUBROUTINE
JMP* INAOPI
TSJMNE .DSA 125120
.EJECT
/ SUBROUTINE TO DECODE ARITHMETIC AND LOGICAL EXPRESSIONS
/
EXPRSN SYN PARLHI
JMS INAOPI /INITIALIZE ARG(I), OP(I) LISTS
LAC IFFLAG /THE LAST ITEM PROCESSED IS PRE-SET TO AN
DAC TFAO01 /OPEN PARENTHESIS FOR AN IF STATEMENT.
EXP001 JMS FA2NOP
LAC RWEXPF
SZA /IF THE "I/O LIST" FLAG IS ON
LAC IDXNOP
SAD C00001 /AND THE CURRENT OPERATOR IS AN = SIGN
JMP RWEQLS /GO TO THE IMPLIED DO LIST CLEANUP ROUTINE
EXP003 LAC LEVNOP /INSTRUCTIONS ARE GENERATED IN HEIRARCHAL
JMS TWOCMA /FASHION. EACH OPERATION IS ASSIGNED A
TAD LEVPOP /PRIORITY LEVEL. INDIVIDUAL PRIORITIES MAY
SMA /CHANGE DUE TO THE INFLUENCE OF
JMP EXP004 /PARENTHETICAL GROUPING. INSTRUCTIONS ARE
EXP011 JMS EXP530
JMP EXP11A /IF NOT ARRAY,DON'T TEST
LAC IDXNOP
ERS 08E,<SAD C00028>,EE1 /**050** BETTER BE ')'
EXP11A JMS EXP710 /NOT GENERATED WHEN THE PRIORITY OF THE
/LAST OPERATOR IS LESS THAN THE PRIORITY
/OF THE NEXT OPERATOR.
/WHEN AN ARG1.POP.ARG2 TRIPLE IS BYPASSED
/DUE TO THE RELATIVE PRIORITIES OF THE
LAC* NOP
AND S00077
SAD S00052 /PART WORD OP?
JMP EXPART /YES - GO TO IT
EXP005 LAC ARG2 /OPERATORS, THE ACCUMULATOR IS STORED IF
DAC ARG1 /IT IS AN ARGUMENT.
LAC NOP /THE LIST IS PUSHED DOWN AS THE NEXT
JMS EXP640 /ARGUMENT AND NEXT OPERATOR PAIR (ARG2.NOP)
JMP EXP001 /BECOME THE LAST ARGUMENT AND LAST OPERATOR
EXP004 LAC IDXNOP /AN INDICATION TO GENERATE INSTRUCTIONS
SAD C00030 /MAY NOT ALWAYS RESULT IN THE IMMEDIATE
JMP EXP006 /GENERATION OF INSTRUCTIONS.
SAD C00032 /COMMAS (FUNCTION PARAMETER SEPARATORS)
JMP EXP007 /AND PARAMETER LIST TERMINATION DELIMETERS
SNA!CLA
LAC RWEXPF /DONT CHECK FOR ARRAY NAME ALONE IF NEXT OP IS CR
SNA /AND "I/O FLAG" IS ON
JMS EXP530 /ARE HANDLED INDEPENDANTLY.
JMP EXP008
LAC IDXNOP
ERS 08E,<SAD C00028>,EE /ERROR: FUNCT NAME NOT
JMP EXP011 /FOLLOWED BY ( AND NOT A PARAMETER
EXP006 LAC* BASEJ /A COMMA CAN BE USED ONLY AS A DELIMETER
SNA /TO SEPARATE ITEMS IN A LIST AND CAN OCCUR
JMP UNPCMA /ONLY WITHIN PARENTHESES UNLESS IN AN I/O LIST
EXP007 LAC IDXPOP /FUNCTION PARAMETERS MAY BE SINGLE
SAD C00030 /TERMS OR EXPRESSIONS.
JMP EXP009 /FUNCTION AND ARRAY NAMES MAY BE FUNCTION
SAD C00028 /PARAMETERS AS LONG AS THEY ARE NOT
JMP EXP009 /COMBINED INTO AN EXPRESSION.
JMS EXP530 /AN ERROR IS ANNOUNCED IF A FUNCTION
JMP EXP010 /OR ARRAY NAME IS USED IN AN EXPRESSION
ERX 09E,EE /WITHOUT A FOLLOWING OPEN PARENTHESIS
EXP009 LAC SIGNA2
SPA /ALL FUNCTION APARAMETERS ARE REDUCED TO A
JMS EXP680 /SINGLE TERM, STORED IN A TEMPORARY IF NECESSARY
JMS EXP690 /SO THAT WE HAVE AN ADDRESS TO PASS TO THE FUNCTION
LAC IDXNOP
SAD C00030 /THE SPECIAL ARGUMENT AND OPERATOR
JMP EXP005 /FOLLOWING THE FUNCTION REFERENCE ARE
JMS FA2NOP /FETCHED WHEN THE PARAMETER LIST IS
DZM SSCTR /TERMINATED.
EXP013 LAC ARGI
TAD K00001
DAC ARGI
LAC OPI
TAD K00001
DAC OPI
LAC* OPI /THE LIST INDICES ARE PUSHED UP UNTIL THE
AND S00077
SAD C00030
ISZ SSCTR /COUNT ARGUMENTS (SUBSCRIPTS)
SAD C00028 /START OF THE PARAMETER LIST IS FOUND.
JMP EXP014
JMP EXP013
EXP014 JMS EXP540 /THE FUNCTION CALL IS GENERATED AS EITHER
LAC* TARGI /A JMS* OR A JMS. A JMS IS GENERATED WHEN
JMS SETA2 /THE FUNCTION NAMED IS A STATEMENT FUNCTION
JMS SYMTYP /IS IT A FUNCTION
XOR U00000 /OR A SUBSCRIPTED VARIABLE?
JMP EXSBSC /SUBSCRIPTED VARIABLE - GO PROCESS
LAC* ADDRA2 /A TRANSFER VECTOR IS UN-NECESSARY FOR
AND W17777 /STATEMENT FUNCTIONS AS THEY ARE LOCALLY
SMA /DEFINED RATHER THAN EXTERNALLY DEFINED.
XOR S20000
AND S77777 /THE CALLING SEQUENCE FOR A STANDARD
XOR JMSCMD /LIBRARY ROUTINE IS AS FOLLOWS:
JMS RELBIN / JMS* SUB BRANCH VIA TRANSFER VECTOR
/ JMP PN+1 BRANCH AROUND PARAMETERS
LAC PC / P1 FIRST PARAMETER
TAD SSCTR / P2 SECOND PARAMETER
TAD C00002 /...
XOR JMPCMD
JMS RELBIN
LAC EXPSPC /SET GATE IN EXP560 TO OUTPUT INDIRECT ADDRESS
DAC CALLSW /TO ARRAYS IN THIS PARAMETER LIST
EXP018 ISZ TARGI / ..
ISZ TOPI / PN NTH PARAMETER
LAC* TARGI
JMS EXP720
LAC* TOPI
AND S00077
SAD C00032
SKP
JMP EXP018 /AFTER THE LAST PARAMETER HAS BEEN OUTPUT,
LAC EXPDIR /RESET CALL OF ARRAY GATE
DAC CALLSW /(ALSO RESET AT ERRAC+1, IN CASE OF ERROR)
EXP002 LAC* OPI /THE FUNCTION CALL IS COMPLETE
DAC SIGNA2
AND W00000 /THE LIST IS PUSHED UP AS THE FUNCTION
XOR* NOP
DAC* OPI /REFERENCE (INCLUDING THE PARAMETER LIST)
LAC MODEA2 /IS REPLACED WITH THE ACCUMULATOR AS
DAC* ARGI
JMS SETA2 /ARGUMENT 2. THE NEXT OPERATOR IS THE LAST
LAC OPI /ONE OBTAINED. THE MODE AND THE SIGN OF THE
DAC POP /FUNCTION NAME ARE RETAINED AS THE MODE
LAC ARGI
JMP EXP020 /AND SIGN OF THE ACCUMULATOR.
EXP008 LAC IDXNOP /THE INSTRUCTIONS GENERATED AS THE RESULT
SAD C00001 /OF THE REPLACEMENT (=) OPERATOR BEING
SKP /USED ARE DEFERRED UNTIL ALL THE CODE TO
JMP EXP010 /THE RIGHT OF THE OPERATOR HAS BEEN EXAMINED.
LAC ASSTMT /EQUAL SIGN OPERATORS ARE ALLOWED ONLY IN ASSIGNMENT
ERS 32X,SZA,EX /STMNT; OTHER LEGAL USES NOT TREATED IN THIS SUBR.
LAC IDXPOP /
SAD C00001 /MULTIPLE EQUAL SIGNS ARE ALLOWED AS LONG
JMP EXP08A /AS SUCCESSIVE ASSIGNMENT ARGUMENTS ARE
LAC POP /NOT EXPRESSIONS.
ERS 14X,<SAD OP0>,EX /ERROR: EXPRESSION LEFT OF =
JMP EXP011
EXP08A LAC* ARG1 /MAKE SURE THAT THE ARGUMENT THAT A VALUE
AND Z00000 /IS ASSIGNED TO IN A MULTIPLE ASSIGNMENT
SAD U00000 /IS NOT A CONSTANT
JMP EX14X /IS A CONSTANT - GO ANNOUNCE ERROR
JMP EXP011 /NOT A CONSTANT - CONTINUE
UNPCMA LAC RWEXPF /UNPARENTHESIZED COMMAS ARE ONLY LEGAL
ERN 23X,SNA,EX /IN AN I/O LIST
LAC POP
ERS 30X,<SAD OP0>,EX /BETTER BE NO EXPRESSION LEFT!
EXP010 LAC POP /THE EXPRESSION IS COMPLETLY DECODED WHEN
SAD OP0 /THE PREVIOUS OPERATOR HAS BEEN PUSHED UP
SKP /TO THE BEGINNING OF THE LIST.
JMP EXP022
LAC RWEXPF
SZA /IF WE ARE IN AN I/O LIST,
JMP .+3 /DO NOT LOAD THE RESULT INTO THE AC
JMS EXP680 /THE VALUE OF THE EXPRESSION IS ALWAYS
JMS EXP670 /LEFT IN THE ACCUMULATOR.
LAW -67
TAD OPVALU
TAD IFFLAG
SZA /AN ERROR IS ANNOUNCED IF THE EXPRESSION CONTAINS
LAC* BASE0 /MORE RIGHT PARENS THAN LEFT PARENS AND WE ARE
ERN 15X,SZA,EX /NOT IN AN "IF" STATEMENT.
JMP* EXPRSN
EXP022 LAC IDXPOP /THE REPLACEMENT, EXPONENTIATION, AND
SAD C00001 /UNARY OPERATORS ARE SEPARATED OUT AND
JMP EXP024 /EXAMINED SEPARATELY.
SAD C00026
JMP EXP025
SAD C00004
JMP EXP067
SAD C00024
JMP EXP026
TAD Z77750 /**CATCHES UNBALANCED PARENTHESES IN
ERN 31X,SMA,EX /**SUBROUTINE CALL PARAMETERS
DZM RELOPT
LAC MODEA1 /IN GENERAL THE MODES OF THE TWO ARGUMENTS
SAD MODEA2 /MUST AGREE.
JMP EXP027
LAC MODEA1 /SWITCH ARGUMENTS SO THAT THE
SNA /LOWER PRECISION ARGUMENT
JMP NOCH /IS IN ARG1
SAD S40000
JMP CH
LAC MODEA2
SAD S60000
JMP CH
SNA
CH JMS EXP650 /IF ORDERING OCCURS, THE OPERATION IS REVERSED
NOCH JMS EXP610 /.POP. IS
JMP EXP032 / MULTIPLY OR DIVIDE,
JMP EXP033 / ADD OR SUBTRACT, OR
JMP EXP034 / RELATIONAL
ERX 16V,EV /ERROR: LOG OP WITH NON-INTEGER ARGS
EXP032 LAC SIGNA2 /THE SIGN OF THE ACCUMULATOR AFTER THE
XOR SIGNA1 /MULTIPLICATION OR DIVISION IS PERFORMED
DAC SIGNA2 /IS POSITIVE IF BOTH ARGUMENT SIGNS ARE
JMP EXP035 /ALIKE AND NEGATIVE IF DIFFERENT.
EXP034 LAC IDXPOP /RELATIONAL OPERATIONS ARE EVALUATED BY
TAD RELOPC /SUBTRACTING THE TWO ARGUMENTS AND
DAC RELOPT /EXAMINING THE RESULT. THE ORIGINAL
LAC C00012 /OPERATOR IS SAVED FOR FUTURE USE AND THE
DAC IDXPOP /SUBTRACT OPERATOR SUBSTITUTED. SIGN
EXP033 JMS EXP625 /CONTROL FOR PLUS-MINUS OPERATORS IS USED
EXP035 JMS EXP690 /SAVE AC IF AC IS ARG2
LAC MODEA1
SAD S40000
JMP EXP037 /IF MODEA1 IS REAL, NO CONVERSION NECESSARY
JMS EXP630
LAC MODEA2
DAC TEMP#
LAC MODEA1
DAC MODEA2 /SWITCH MODES
LAC TEMP
JMS EXP740 /GENERATE INSTRUCTION TO CONVERT MODE OF ARG1
LAC TEMP
DAC MODEA2
JMS SETA1 /SET UP NEW ARG1 TO REFLECT MODE CHANGE
EXP037 LAC* POP /GENERATED.
AND U00000 /WHEN THE ARGUMENT MODES ARE DIFFERENT,
SNA /THE REAL ARGUMENT IS ALWAYS LOADED INTO
JMP EXP036 /THE ACCUMULATOR AND THE DOUBLE PRECESION
LAC IDXPOP /OPERATION INVOKED.
SAD C00012 /REVERSE DIVIDE OR SUBTRACT OPERATIONS
LAC C00042 /ARE SET WHEN THE ARGUMENTS WERE
SAD C00018 /INTERCHANGED. MULTIPLICATION AND
LAC C00039 /ADDITION ARE COMMUTATIVE.
DAC IDXPOP /THE REAL ARGUMENT IS THEN LOADED INTO THE
EXP036=.
LAC MODEA1 /INTEGER MODE
SZA!CLL /YES
JMP EXPKF1 /NO
LAC IDXPOP /SUBTRACT
SAD C00012 /NO
SKP!STL /YES SET LINK
SAD C00042 /REVERSE NO
SKP /YES LEAVE LINK 0
JMP EXPKF1 /TREAT AS USUAL
LAC TYPEA1 /IS ARG1 IN AC
SZA!RAR /YES PUT LINK INTO SIGN BIT OF AC
JMP EXPKF5 /NO LOAD IT
XOR SIGNA2 /RESULT NEGATIVE OF ANSWER IF SUBTRACT
DAC SIGNA2
JMP EXPKF6
EXPKF5 SPA /REVERSE SUBTRACT YES
JMS EXP650 /NO- INTERCHANGE ARGUMENTS TO MAKE REVERSE
JMS EXP630 /LOAD ARG1 INTO AC
EXPKF6 JMS EXPKFF /NEGATE ARG1
LAC C00015 /CHANGE OPERATION TO TAD
DAC IDXPOP
SKP /DO NOT LOAD ARG1 AGAIN
EXPKF1 JMS EXP630 /LOAD ARG1 IF NECESSARY
JMS EXP590 /THE INSTRUCTION (.POP.ARG2) IS THEN
TAD IDXPOP /OUTPUT.
LAC RELOPT /WHEN THE ORIGINAL OPERATOR WAS A
SNA /RELATIONAL OPERATOR, THE RESULT OF THE
JMP EXP038 /SUBTRACTION IS CONVERTED TO ONE OF THE
/TWO LOGICAL QUANTITIES (.TRUE. OR .FALSE.)
JMS GTINAC /GET A TESTABLE VALUE INTO THE AC
LAC SIGNA2
SPA!CLA /THE ACCUMULATOR IS NEGATED IF THE
/SUB-EXPRESSION SIGN IS MINUS.
/INTEGER NEGATION IS USED TO MAINTAIN
JMS EXP570 /A TRUE ZERO RESULT.
LAC* RELOPT /ARG1 - ARG2 TO AC
JMS ABSBIN / XXX IS... SPA!SNA!CLA FOR .LE.
LAC CLCCMD / CLA!CMA / SPA!CLA FOR .LT.
JMS ABSBIN / SNA!CLA FOR .EQ.
DZM SIGNA2 / SZA!CLA FOR .NE.
CLA!SKP / SMA!SZA!CLA FOR .GT.
EXP038 LAC MODEA2 / SMA!CLA FOR .GE.
EXP066 DAC* ARG1 /THE SUBEXPRESSION ARG1.POP.ARG2 IS
JMS SETA2 /REMOVED FROM THE LISTS AND REPLACED WITH
LAC* NOP /A NEW ARG1, NOP, AND THE ACCUMULATOR.
AND T77777
DAC* POP /THE LIST INDICES ARE PUSHED UP AND THE
LAC SIGNA2 /NEW VALUES ASSOCIATED WITH THE
AND W00000 / ARG1.POP.ARG2.NOP. SEQUENCE ARE UPDATED.
XOR* POP
DAC* POP
LAC ARG1
EXP020 DAC ARG2
DAC ARGI
TAD K00001
DAC ARG1
LAC POP
DAC NOP
DAC OPI
TAD K00001
JMS EXP640
JMP EXP003
EXP027 JMS EXP610 /WHEN THE ARGUMENT MODES AGREE, POP IS
JMP EXP041 /DETERMINED TO BE...MULTIPLY-DIVIDE
JMP EXP042 / ...ADD OR SUBTRACT
JMP EXP043 / ...RELATIONAL
LAC MODEA2 / ...LOGICAL
ERN 19V,SZA,EV
JMS EXP520 /TAKE CARE OF THE SIGNS AND LOAD ARG1
EXP046 LAC IDXPOP /GET THE OPERATOR
SAD C00002 /IS IT .OR.?
JMP EXP047 /.OR. IS A FUDGE
JMS OPOPA2 /OUTPUT .POP.ARG2
LAC* ARG2
JMP EXP038 /MOVE DOWN LISTS AND KEEP GOING
EXP047 LAC LMQCMD /(RKB-063) OUTPUT LMQ
JMS ABSBIN /(RKB-063)
JMS EXP590 /(RKB-063) LAC ARG2
TAD C00004
LAC OMQCMD /(RKB-063) OMQ
JMS ABSBIN /(RKB-063)
JMP EXP038
EXP041 LAC TYPEA2 /THE ARGUMENTS ARE INTERCHANGED AND THE OPERATOR
SNA /REVERSED IF ARGUMENT 2 IS THE ACCUMULATOR.
JMS EXP650
LAC SIGNA2 /THE SIGNS OF THE ARGUMENTS YIELD THE SIGN
XOR SIGNA1 /OF THE RESULT.
DAC SIGNA2
JMP EXP037
EXP043 LAC IDXPOP
TAD RELOPC /RELATIONAL OPERATIONS ARE EVALUATED BY
DAC RELOPT /FIRST SUBTRACTING THE TWO ARGUMENTS AND
LAC C00012 /THEN EXAMINING THE RESULT FOR NEGATIVE,
DAC IDXPOP /ZERO, OR POSITIVE.
EXP042 LAC TYPEA2
SNA /THE ARGUMENTS OF A SUB-EXPRESSION
JMS EXP650 /CONTAINING A PLUS OR MINUS OPERATOR ARE
JMS EXP625 /PROCESSED BY THE SIGN CONTROL ROUTINE, AND
JMP EXP037 /THE PROPER INSTRUCTION IS GENERATED.
EXP024 JMS EXP680 /ARGUMENT 2 IS LOADED INTO THE ACCUMULATOR
JMS EXP670 /AND NEGATED IF NECESSARY.
LAC* POP
AND U00000 /CHECK FOR THE "REVERSE =" OPERATOR
SZA
JMP PTWEQU /THIS IS THE "PARTWORD STORE" OP
LAC MODEA1
JMS EXP740 /CONVERT MODES ACROSS THE EQUAL SIGN
JMS EXP600
JMS EXP590
TAD C00008
EXP040 LAC SIGNA2
ERN 21V,SPA,EV /ERROR IF ASSIGNMENT VAR SIGNED
JMP EXP038
EXP025 LAC MODEA1
JMS COMBIN /COMBINE MODEA1 AND MODEA2 TO GET
TAD PWRTAB /AN INDEX INTO THE EXPONENTIATION TABLE
DAC GETPWR
GETPWR OPR /GET THE PROPER EXPONENTIATION ROUTINE NAME
SZA /CONVERSION NECESSARY?
JMP EXPOK
JMS EXP520 /YES.THEN MAKE BASE REAL.
JMS EXP600
LAC S20000
JMS EXP740
JMS EXP600
LAC S20000 /REAL AC
JMS SETA1 /BECOMES ARG1
JMP EXP025 /TRY IT AGAIN
EXPOK AND S17777
DAC OPTEMP /SAVE IT IN THE REPLACEABLE OPERATOR
JMS EXP520 /TAKE CARE OF THE SIGNS AND LOAD ARG1
LAW -2 /GENERATE:
JMS OPOPA2 /JMS* OP
LAC* ARG2 /(WHERE OP = -2 = REPLACEABLE OPERATOR)
XCT GETPWR /FETCH THE ROUTINE NAME AGAIN
AND S60000 /GET THE MODE OF THE RESULT
JMP EXP066 /FROM THE TABLE OF EXPONENTIAL OPERATORS
EXP026 LAC SIGNA2 /UNARY MINUS SIMPLY CAUSES THE SIGN
CMA /OF ARG2 TO BE REVERSED
DAC SIGNA2
LAC* ARG2
JMP EXP038+1 /GO PURGE THE ARG-OP LIST
/
EXP067 LAC MODEA2 /THE .NOT. OPERATOR IS NOT LEGAL IF ITS
ERN 25V,SZA,EV /OPERAND IS NOT INTEGER OR LOGICAL
JMS EXP710 /STORE ARG1 IF IT WAS IN THE ACCUMULATOR
JMS EXP680 /FORCE ARG2 INTO THE ACCUMULATOR
JMS EXP670 /NEGATE THE ACCUMULATOR IF NECESSARY
LAC CMACMD
JMS ABSBIN /.NOT. GENERATES A "CMA" COMMAND
JMP EXP038
.EJECT
/ SUBROUTINE TO FETCH ARGUMENT 2 AND NEXT OPERATOR (ARG2 AND NOP)
/
FA2NOP CAL 0
JMS FARGOP /THE NEXT ARGUMENT-OPERATOR PAIR IS
JMS ENTER /FETCHED AND ENTERED INTO THE ARG-OP LISTS.
LAC ARGI
DAC ARG2
LAC* ARG2
JMS SETA2 /ARGUMENT2 CONSISTS OF ARG(I) LIST ADDRESS
LAC OP /SYMBOL/CONSTANT TABLE ADDRESS, TYPE OF
DAC SIGNA2 /ARGUMENT (SYMBOLIC, CONSTANT, SUBSCRIPTED
AND T77700 /VARIABLE, FUNCTION OR UNARY), SIGN OF THE
DAC LEVNOP /ARGUMENT, AND MODE (INTEGER, REAL, DOUBLE
LAC OP /PRECESION, OR LOGICAL) OF THE ARGUMENT.
AND S00077 /NEXT OPERATOR CONSISTS OF OP(I) LIST
DAC IDXNOP /ADDRESS, LEVEL VALUE (HEIRARCHY NUMBER
LAC OPI /PLUS CURRENT PARENTHESIS LEVEL COUNT).
DAC NOP /AND OPERATOR VALUE (INDEX ON OPERATOR
JMP* FA2NOP /TRANSLATION TABLE).
/
/SUBROUTINE TO GET A VALUE INTO THE AC WHICH CAN BE TESTED
/ FOR POSITIVE, ZERO, AND NEGATIVE
/
GTINAC CAL 0
LAC MODEA2
SNA
JMP* GTINAC /IF EXPR IS INTEGER OR LOGICAL, DO NOTHING
SAD S60000
JMP DIINAC /DOUBLE INTEGER - NORMALIZE IT
LAC ACCMNE /GENERATE A "LAC* .AB" INSTRUCTION
JMS EXP580
.IFUND %FPP
XOR LACCMD
.ENDC
.IFDEF %FPP
XOR JMSCMD /(OR A "JMS* .ZA" IF IN FPP MODE)
.ENDC
JMP* GTINAC /RETURN
DIINAC NOP
.IFUND %FPP
LAC NORM18
JMS ABSBIN /OUTPUT NORM-18 INST
.ENDC
.IFDEF %FPP
LAC ZE
JMS EXP580 /OR JMS* .ZE
XOR JMSCMD
.ENDC
JMP* GTINAC
ZE 131425
.EJECT
/ SUBROUTINE TO FETCH UNSIGNED INTEGER ARGUMENT (SIMPLE VARIABLES ONLY)
/
FIARGO CAL 0
LAC K00001 /THE LAST ELEMENT IS INITIALIZED TO
DAC TFAO01 /DISALLOW UNARY OPERATORS.
JMS FARGOP
LAC* ARG /THE ARGUMENT MUST BE A SCALAR,
SMA /THEREFORE ITS TYPE MUST BE EITHER 0,1 OR 3
SAD U00000
SKP /ALL OTHER TYPES ARE ILLEGAL
LAC NAME0 /IN ADDITION, IT MUST BE AN INTEGER - THEREFORE
ERN 06S,SZA,ES /ITS MODE MUST BE 0
JMP* FIARGO
.EJECT
/ PART WORD ROUTINES
/COME HERE WHEN PARTWORD OP IS ABOUT TO BE PUT IN ARG-OP LIST
EXPART JMS PTWDNM /GET FIRST BIT NUMBER
DAC PTM
LAC CHAR
ERS 01P,<SAD S00051>,EP /BETTER TERMINATE WITH :
JMS PTWDNM /GET LAST BIT NUMBER
DAC PTN
LAC CHAR
ERS 02P,<SAD S00053>,EP /BETTER END WITH ]
LAW -44
TAD PTN
ERN 03P,SMA,EP /LART BIT NUM SHOULD BE <=35
CMA
DAC PTWDNM /SAVE 35-N TEMPORARILY
LAC PTM
JMS TWOCMA
TAD PTN
ERN 04P,SPA,EP /FIRST BIT NUM SHOULD BE <= LAST
DAC PTM /ALSO SAVE TEMPORARILY
LAC C00009
JMS SHIFT
LAC PTM /SHIFT N-M LEFT 9
DAC PTM
TAD (757000) /(GAR-074)
SMA!SZA!CLA /(GAR-074) SET HIGH ORDER BIT ON IF N-M>17
LAC V56000 /SET BITS 1-8 TO THE WIDTH OF THE FIELD
TAD PTM /(MINUS 18 IF HIGH ORDER BIT ON)
TAD S01000 /ADD A LITTLE BIAS TO KEEP IT POSITIVE
XOR PTWDNM
DAC PTN /SAVE PARTWORD PARAMETER WORD
LAC C00032
DAC TFAO01 /PRESET TFAO01(LAST OP) TO F)
JMS FARGOP /(FUNCT CLOSE PAREN) AND GET NEXT ARG/OP
LAC OP
DAC* OPI /REPLACE THE [ OPERATOR BY THIS OPERATOR
AND T77700
DAC LEVNOP
LAC OP
AND S00077
DAC IDXNOP
SAD C00001 /IS THE NEXT OP AN EQUAL SIGN?
JMP PTWLFT /YES - PARTWORD STORE NECESSARY
LAC SIGNA2 /GENERATE PARTWORD LOAD - FIRST FORCE THE
SPA /CURRENT EXPRESSION POSITIVE AND INTO
JMS EXP680 /A STORAGE LOCATION
JMS EXP690
LAC PTWDOP
JMS OPOPA2 /THEN GENERATE JMS* .PB
LAC* ARG2 / .DSA ARG
LAC PTN / .DSA PARTWORD PARAM
JMS FPPOUT
DZM SIGNA2
LAC PTN
SPA!CLA
LAC S60000 /(GAR-074) MODE OF RESULT IS INTEGER IF N-M<=17,
DAC MODEA2 /DOUBLE INTEGER OTHERWISE
DZM TYPEA2 /RESULT IN AC
DAC* ARG2
JMP EXP003 /CONTINUE EXPRESSION SCAN
PTWDOP PARTLD-OPTRAN-1
PTWLFT LAC PTN /PARTWORD STORE NECESSARY - SAVE PARAMETER
DAC PTNLFT
LAC* OPI
XOR U00000 /CHANGE "=" TO "REVERSE ="
DAC* OPI
JMP EXP003 /CONTINUE SCAN
/
/ROUTINE TO ACCUMULATE A SMALL INTEGER
/
PTWDNM CAL 0
JMS FNBCHR
ERN 05P,<JMS NUMTST>,EP /ERROR IF NOT DIGIT
DAC TARGI /SAVE IT AWAY
JMS FNBCHR
JMS NUMTST /NEXT CHAR A DIGIT?
JMP PTW001 /NO - EXIT
DAC TOPI
LAC TARGI
RCL
RAL
TAD TARGI /ACCUMULATE DIGIT1*10+DIGIT2
RAL
TAD TOPI
DAC TARGI
JMS FNBCHR /GET NEXT CHAR BLINDLY
PTW001 LAC TARGI
JMP* PTWDNM /EXIT WITH NUMBER IN AC
/GO HERE TO GENERATE PARTWORD STORE CODE
PTWEQU LAC S60000
JMS EXP740 /CONVERT AC TO DOUBLE INTEGER
LAC PTWDST
JMS OPOPA2 /GENERATE JMS* .PC
LAC* ARG1 / .DSA ARG
LAC PTNLFT / .DSA PARAMETER WORD
JMS FPPOUT
JMP EXP040 /RESUME "=" PROCESSING
PTM 0
PTN 0
PTNLFT 0
PTWDST PARTST-OPTRAN-1
V56000 356000
.EJECT
VARSIZ=ADJFLG
EXSBSC LAC SYMTBC
DAC SYMTBX /NAME OF ARRAY = MOST RECENT NAME FOR DDIO
JMS SETADR /THE NUMBER OF STATED SUBSCRIPTS MUST EQUAL
LAC* SYMTW5 /SAVE THIS, CAUSE SYMTW5 IS SAME LOCATION AS
DAC INTDIV /EXP540, A SUBROUTINE CALLED BELOW
ISZ SSCTR /THE NUMBER OF DECLARED SUBSCRIPTS.
JMS SUBCNT
JMS EXP540 /SAVE ARGI AND OPI IN TARGI AND TOPI
LAC* ARGI
JMS SETA2 /SYMTBC IS RESET, BUT NOT YET SYMTW5 OR SYMTW6
DAC EXSBMD /PUT ARRAY INTO ARG2 AND SAVE MODE FOR LATER
JMS SETN /COMPUTE NUMBER OF WORDS PER ELEMENT FOR THIS MODE
DAC VARSIZ /TO BE USED IN TWO PLACES BELOW
DAC VARSZ2
LAC RWEXPF /THIS IS NON-0 IF IN I/O LIST
SNA
JMP SNGTST /IF IS ZERO, THEN CHOOSE OPTIMIZATION NORMALLY
LAC SSCTR /WILL NOT OPTIMIZE FOR I/O OF TWO OR THREE DIMEN-
SAD C00001 /SIONS, TO SAVE SPACE. NEITHER WILL WE OPTIMIZE
SKP /FOR DDIO OUTPUT OF A SINGLE DIMENSION, AS IT
JMP .SSOUT /NEEDS SUBSCRIPT NUMBER, WHICH IT CAN ONLY GET FROM
LAC RWFLAG /.SS PARAMETER LIST. RWFLAG= 2 IF WRITE.
RTR /PUT LINK ON IF WRITE, OFF IF READ
LAC SYMTMP /BITS 0,1,2 OF SYMTMP = 100 IF DDIO
SAD W00000 /DDIO?
SNL /YES, BUT IS IT OUTPUT?
JMP SNGLSS /NOT DDIO, OR NOT OUTPUT - OPTIMIZE
JMP .SSOUT /ELSE OUTPUT .SS CALL
SNGTST LAC SSCTR /OPTIMIZE FOR ALL ONE DIMENSIONAL REFERENCES
SAD C00001
JMP SNGLSS
OPTSWC NOP /FOR 2 OR 3 DIMENSIONS, SET TO SKIP IF ARE NOT
JMP SSOPT /TO OPTIMIZE.
.SSOUT LAC SSCALC
JMS EXP580 /OUTPUT JMS* .SS
XOR JMSCMD
LAC* ARGI
JMS SETA2
LAC* ARGI
JMS EXP560
XOR W00000 /FORM PARAMETER ADDRESS OF ARRAY
AND W77777 /THEN MASK OUT THE MODE BITS
JMS VECBIN /AND OUTPUT THE RESULT
EXSBLP ISZ TOPI
ISZ TARGI
JMS CKSUB
LAC C00004
JMS OPOPA2 /OUTPUT LAC(*) SN FOR EACH SUBSCRIPT
LAC* TARGI
LAC* TOPI
AND S00077
SAD C00030 /ARE WE DONE YET?
JMP EXSBLP /NO
SSDACA JMS EXP550 /OUTPUT A "DAC" WITH A STRING ADDRESS
XOR DACCMD
LAC EXSBMD /FORM A NEW ARGUMENT OF TYPE 4(STRING),
XOR TSTRNG /WITH THE SAME MODE AS THE ARRAY AND THE ADDRESS
XOR W00000 /OF THE GENERATED STRING
DAC MODEA2 /AND REPLACE THE ARRAY NAME WITH IT
JMP EXP002 /CONTINUE AS IF A FUNCTION WERE BEING PROCESSED
EXSBMD .DSA 0
/ ONE DIMENSION SUBSCRIPT OPTIMIZATION
SNGLSS ISZ TARGI
ISZ TOPI
JMS CLCTAD /OUTPUT: CLC; TAD I
JMS SSOPT0 /OUTPUT: N* THIS RESULT
JMP SSTADA /GO COMPLETE THE CALCULATION-SAME FOR ALL ARRAYS
/ TWO AND THREE DIMENSIONAL SUBSCRIPT OPTIMIZATION
SSOPT ISZ TARGI
ISZ TOPI
LAW -1 /USE TO ADDRESS TEMPORARY LOCATIONS T1,T2,T3
TAD AT1
DAC TI /WHERE AT1 CONTAINS ADDRESS OF T1
LAC* SYMTW6 /CHECK FOR VARIABLE DIMENSION OF TWO OR 3 IMEN.
DAC T0 /ARRAY, AS INDICATED BY 777777 IN SYMTW5 OR SYMTW6
SPA
JMP VDOPT /JUMPT TO VARIABLE DIMEN OPTIMIZATION IF NOT POS
LAC INTDIV /(SINGLE DIMENSIONED ARRAYS DON'T WORRY IF VARIABLE
SPA /DIMENSIONED, AS THERE IS NO CHECKING ON SS BOUNDS)
JMP VDOPT
JMS INTDIV /PROCEED WITH CONSTANT SS OPTIMIZATION,
LAC SSCTR /DIVIDING IMAX*N BY N AND LEAVING IT IN T1.
SAD C00003 /IF ONLY TWO DIMENSIONS, ZERO THIRD DIMEN VALUES,
JMP .+4 /AND OUTPUT LAC J. WILL GENERATE CODE TO COMPUTE
DZM T2 / BASE ADDR + N*[I+IMAX*(J+K*JMAX) + C]
JMS LACOUT /WHER C = (-1-IMAX-IMAX*JMAX), A CONSTANT, COMPUTED
JMP FIN2ND /BY THE COMPILER. GO FINISH 2 D CASE.
LAC T0 /FOR 3 DIMES, COMPUTE IMAX * JMAX BY DIVIDING
JMS INTDIV /SAVED IMAX*JMAX*N BY N. ANS INTO T2, TI BUMPED TO T3
LAC T1 /ALSO COMPUTE JMAX
DAC VARSZ2 /SET UP AS IF STILL DIVIDING BY NO. WORDS PER ELEMENT
LAC T2
JMS INTDIV / RESULT IS IN T3, = JMAX
ISZ TARGI /BUMP TO POINT TO K
ISZ TOPI
JMS LACOUT /OUTPUT LAC K
JMS MULOUT /OUTPUT MUL, .DSA JMAX, LACQ, TAD J
JMS TADOUT
FIN2ND LAC AT1 /OUTPUT MUL, .DSA IMAX, LACQ
DAC TI / OUTPUT TAD I
JMS MULOUT
JMS TADOUT
LAC T2 /COMPUTE -1-IMAX-IMAX*JMAX, WHER JMAX IS ZERO IF 2D
TAD T1
CMA
DAC S /OUTPUT TAD TO THIS VALUE, AS ENTERED INTO THE CONSTANT
DZM NAME0 /TABLE
JMS CONSSE
DAC T0
LAC* T0
AND S17777
XOR TADCMD
JMS RELBIN
JMS SSOPT0 /OUTPUT EFFECTIVE N* RESULT OF PRECEDING CALCS
LAC* ARGI
JMS SETA2
SSTADA LAC* ARGI
JMS EXP560 /OUTPUT TAD ARRAY
NOP /TO PACIFY EXP560, WHICH RETURNS ON NEXT INSTR
AND S77777
XOR TADCMD
JMS RELBIN
JMP SSDACA /GO CLEANUP
/ADJUSTABLE ARRAY SS OPTIMIZATION - ALL CALCULATIONS DONE AT EXECUTION TIME
VDOPT JMS CLCTAD /OUTPUT LAW, TAD I
DZM T0
JMS SSOPT0 /OUTPUT EFFECTIVE N* INTERMEDIATE RESULT IN AC
LAC T0 /IF N WASN'T 3, T0 IS STILL ZERO, AND A TEMP LOCATION
SNA /MUST BE CREATED, SUCH THAT IN EITHER CASE T0 HOLDS IT
JMS EXP510 /ADDRESS
DAC T0 /SAVE THE ADDRESS OF THE TEMPORARY
JMS DCRLTD /OUTPUT DAC TEMP, LAC WD3 OF ADB, DAC .+4
TAD K00002 /FOLLOWED BY CLC, TAD J
ISZ TI
DZM* TI /MULOUT PICKS UP ZERO AT TI AS SIGNAL TO OUTPUT ABS 0
JMS MULOUT /ANT TO AVOID CHANGIN ARG POINTERS. OUTPUT
LAC T0 / MUL, XX, LACQ, TAD TEMP
JMS TADOUT
LAC SSCTR /CHECK FOR THIRD DIMENSION
RAR /CAN'T BE 1, SO IF IS 3, LINK GETS SET
SNL
JMP SSTADA /ONLY TWO DIMENS, GO CLEAN UP
JMS DCRLTD /OUTPUT DAC TEMP, LAC ADB WD4, DAC .+4
TAD K00001 /FOLLOWED BY CLC, TAD K
JMS MULOUT /OUTPUT MUL, XX, LACQ
LAC T0
JMS TADOUT /OUTPUT TAD TEMP
JMP SSTADA /GO CLEANUP
/
INTDIV CAL /DIVIDE ROUTINE TO REMOVE N FACTOR, WHEN VARSZ2 IS N,
CLL
ISZ TI
IDIV /OR TO COMPUT JMAX WHEN IMAX IS IN VARSZ2
VARSZ2 XX
LACQ
DAC* TI /ARE SUCCESIVLY STORING RESULT IN T1. T2, T3
JMP* INTDIV
/
LACOUT CAL /OUTPUT LAC TO TARG
ISZ TARGI
ISZ TOPI
JMS CKSUB /CHECK THAT SUBSCRIPTS ARE INTEGER SCALARS
LAC C00004 / GET LAC COMMAND CODE
JMS OPOPA2 /OUTPUT LAC
LAC* TARGI / TO THIS ARGUMENT
JMP* LACOUT
/
CKSUB CAL
LAC* TARGI /CHECK THAT ALL OF THE SUBSCRIPTS ARE INTEGERS
JMS SETA2 /
ERN 04S,SZA,ES
ERS 05S,<JMS EXP530>,ES /AND SCALAR VARIABLES
JMP* CKSUB
/
MULOUT CAL /OUTPUT MUL, .DSA VARIABLE OR ZERO, LACQ
LAC MULCMD /EAE+13122
TAD S20000 / !20000; CAUSES AC0 INTO LINK, THEN MUL
JMS ABSBIN
LAC* TI /IF COMES UP 0, .DSA 0 IS OUTPUT, AS THIS LOCATION
JMS FPPOUT /IS SET WHEN RUNNING. ELSE IS JMAX OR IMAX.
LAC LAQCMD //OUTPUT LAQ (TO REPRESEN LACQ)
JMS ABSBIN
LAC* TI /DON'T REGRESS POINTERS WHEN DOING ADJUSTABLE
SNA!CLC /DIMENSIONS
JMP* MULOUT / ELSE HAVE SET AC = 777777
TAD TOPI
DAC TOPI
LAW -1
TAD TARGI
DAC TARGI
LAC* TARGI
JMP* MULOUT
/
TADOUT CAL /OUTPUT TAD TO ARG ADDRESSED BY AC
DAC MULOUT
JMS SETA2
LAC C00015
JMS OPOPA2
LAC MULOUT
JMP* TADOUT
/
SSOPT0 CAL /OUTPUT EFFECTIVE N* STUFF IN AC
LAC VARSIZ /AS NOTHING IF N= 1, RAL IF N= 2, OR DAC, RAL, TAD
SAD C00001 /IF N = 3
JMP* SSOPT0
SAD C00002 / 2 DIMENS?
JMP RCLOUX /YES, GO OUT@PUT RCL
CLA
JMS STORET /CREATE A TEMPORARY
DAC T0 /SAVE ITS ADDRESS
JMS RCLOUT /OUTPUT RCL
LAC T0
JMS TADOUT /OUTPUT TAD TEMP
JMP* SSOPT0
RCLOUX JMS RCLOUT /OUTPUT JUST RCL FO N = 2
JMP* SSOPT0
/
RCLOUT CAL /OUTPUT RCL
LAC RCLCMD
JMS ABSBIN
JMP* RCLOUT
/
CLCTAD CAL /OUTPUT CLC, TAD
JMS CKSUB /CHECK SUBSCRIPT VALIDITY
LAC CLCCMD
JMS ABSBIN
LAC C00015
JMS OPOPA2
LAC* TARGI
JMP* CLCTAD
/
DCRLTD CAL /OUT PUT DAC TEMP, LAC ADB WORD, DAC .+4
LAC C00008
JMS OPOPA2
LAC T0
LAC* SYMTBX /ADDRESS OF WORD 5 OF ADB
XCT* DCRLTD /BACK TO 3RD OR 4TH WOTD
AND S17777
XOR LACCMD
JMS RELBIN
LAC PC /COMPUT .+4
TAD C00004
XOR DACCMD
JMS RELBIN
ISZ DCRLTD
ISZ TARGI
ISZ TOPI
JMS CLCTAD /OUTPUT CLC, TAD J (OR K)
JMP* DCRLTD
.EJECT
/ SUBROUTINE TO OUTPUT .POP.ARG2 INSTRUCTION
/ CALLING SEQUENCE...
/ LAC OP
/ JMS OPOPA2
/ LAC ARG
/
OPOPA2 SYN FAOMOD
DZM ISUBRR
SAD C00012 /IS THIS SUBTRACT OR REVERSE SUBTRACT
JMP OUTP12 /SUBTRACT
SAD C00042 /REVERSE SUBTRACT NO
JMP OUTP13 /YES
OUTP07 TAD OPTRAN /THE OPCODE INDEX IS CONVERTED TO A REAL
DAC TCTR /INSTRUCTION AND THE ARGUMENT IS DESECTED.
XCT* OPOPA2
JMS SETA2 /TWO FORMS OF INSTRUCTIONS ARE GENERATED
LAC* TCTR /BY THE COMPILER. THE MAJORITY OF THEM
.IFDEF %FPP
AND Z70000 /IS THIS INSTRUCTION FPP INSTRUCTION
SAD Z10000
SKP /YES, OUTPUT IT ACCORDINGLY
JMP NONFPP
LAC* TCTR
JMS FPPOUT
XCT* OPOPA2 /GET THE ARGUMENT
DAC OBJB04 /SET PARAMETER MODE
JMS EXP560
XOR W00000 /MAKE A REGULAR SUBROUTINE PARAMETER OUT OF IT
AND W77777 /THEN AND OFF THE MODE BITS AND OUTPUT IT
JMS VECBIN /(THE FPP BOX IS FINICKY ABOUT SUCH THINGS)
DZM OBJB04 /RESET PARAMETER MODE FLAG
JMP OUTP11 /RETURN TO MAINSTREAM
NONFPP LAC* TCTR
.ENDC
AND S17777 /ARE SUBROUTINE CALLS. THE OTHER FORM IS
SNA /AN ACTUAL MACHINE INSTRUCTION.
JMP OUTP01
TAD DECPNT /SUBROUTINED INSTRUCTIONS REQUIRE THAT
JMS EXP580 /THE SUBROUTINE NAME BE ENTERED INTO THE
XOR JMSCMD /SYMBOL TABLE AS ENTERNAL FUNCTIONS.
LAC* TCTR /THE OPERAND ADDRESS OF THE INSTRUCTION
SMA /IS OUTPUT AS A PARAMETER TO THE SUBROUTINE
JMP OUTP02
LAC C00004 /THE PARAMETER OF INTEGER OPERATIONS IS
JMP OUTP07 /OUTPUT AS A LAC INSTRUCTION.
OUTP02 XCT* OPOPA2 /PARAMETERS FOR OTHER INSTRUCTIONAL
JMS EXP720 /SUBROUTINES ARE OUTPUT AS VECTOR ADDRESSES
OUTP11 LAC TYPEA2
SAD V00000 /ONCE A TEMPORAY STORAGE LOCATION HAS BEEN
SKP /USED (I.E. APPEARS AS THE ARGUMENT), IT
JMP OUTP03 /MAY BE RELEASED FOR RE-USE
ISZ ADDRA2
LAC* ADDRA2 /A TEMPORARY STORAGE LOCATION IS RELEASED
AND V77777
SAD TSD /ONLY IF IT IS THE LAST ONE CREATED (THE
JMP OUTP04 /THEORY BEING THAT TEMP STORAGE IS USED
SAD TSR /IN THE REVERSE ORDER THAT IT IS CREATED).
JMP OUTP05
SAD TSJ
JMP OUTP06
JMP OUTP03
OUTP06 TAD K00001
DAC TSJ
JMP OUTP03
OUTP04 TAD K00001 /AS TEMPORARY STORAGE IS CREATED IN A
DAC TSD /SEQUENTIAL MANNER, IT IS RELEASED
JMP OUTP03 /SEQUENTIALLY ALSO.
OUTP05 TAD K00001
DAC TSR
OUTP03 JMS FAKE /IGNORE THIS INSTRUCTION IF ILLEGAL
LAC* ARG2
JMS SETA2
ISZ ISUBRR
SKP
JMS EXPKFF
JMP* OPOPA2
OUTP01 LAC TYPEA2 /NORMAL INSTRUCTIONS WITH ARGUMENT
SAD W00000 /ADDRESSES THAT ARE THE RESULT OF A
/PREVIOUS CALCULATION (E.G. SUBSCRIPTED
JMP OUTP08 /VARIABLES) MUST REFERENCE THAT ADDRESS
XCT* OPOPA2 /OTHERWISE THE ADDRESS IS SET UP (ALONG
JMS EXP560 /WITH THE INDIRECT BIT IF NECESSARY..
OUTP10 XOR S20000 /COMMON, DUMMY,ETC.).
XOR* TCTR /THE OPERAND ADDRESS IS MERGED WITH THE
JMS RELBIN /INSTRUCTION AND THE RESULT OUTPUT AS A
JMP OUTP11 /RELOCATABLE INSTRUCTION.
OUTP08 LAC MODEA2 /INDIRECTLY.
JMS EXP510 /A TEMPORAY STORAGE LOCATION IS CREATED
JMS SETA2 /AND ITS ADDRESS STRUNG TO THE ADDRESS
XCT* OPOPA2 /OF THE STORE FOLLOWING THE ADDRESS
AND S17777 /CALCULATION.
JMS BINOUT
XOR C00020 /OUTPUT REFERENCE ADDRESS.
LAC* ADDRA2
AND S17777
JMS BINOUT
XOR C00021 /OUTPUT DEFINITION ADDRESS.
LAC* ADDRA2 /THE TEMP STORE ADDRESS BECOMES THE
AND S17777 /ARGUMENT ADDRESS OF THE INSTRUCTION.
JMP OUTP10
OUTP12 CLC /REGULAR SUBTRACT FLAG
DAC ISUBRR
OUTP13 JMS EXPKFF /OUTPUT TCA AND ADD
LAC C00015
JMP OUTP07
.EJECT
/
/ CONSTANT OR FLOATING INSTRUCTION OUTPUT ROUTINE
/ CALLING SEQUENCE
/ LAC CONSTANT
/ JMS FPPOUT
/
FPPOUT 0
JMS ABSBIN
FPPTST JMP* FPPOUT
/
/
/
/ SUBROUTINE TO ENTER ARG, OP IN ARG(I) AND OP(I) LISTS
/
ENTER SYN SYMTW3
ISZ ARGI /LIST ENTRY AD. UPDATE
LAC ARGI /AND CHECKED
ERN 01T,<SAD ARGEND>,ET /ERROR: LISTS FULL
ISZ OPI
LAC ARG /THE CURRENT ARGUMENT AND OPERATOR PAIR
DAC* ARGI /ARE ENTERED INTO THE NEXT AVAILABLE LIST
LAC OP /POSITION.
DAC* OPI
AND S00077
JMP* ENTER
.EJECT
/ SUBROUTINE TO SET UP ARGUMENT 1
/ CALLING SEQUENCE...
/ LAC ARG /ARGUMENT DESCRIPTION WORD
/ JMS SETA1 /ARG1 ALREADY CONTAINS ARG(I) ADDRESS
/
SETA1 SYN SYMTW2 /AN ARGUMENT COSISTS OF...
DAC ADDRA1 / ADDRESS OF ENTRY IN SYMBOL OR CONSTANT
AND Z00000 /TABLE.
DAC TYPEA1 / TYPE OF ARGUMENT
SZA!SMA
JMP .+3 /IF THE ARGUMENT IS NOT A VARIABLE OR
LAC ADDRA1 /CONSTANT, THE MODE IS CARRIED IN THE
SKP /ORIGINAL DESCRIPTION WORD.
LAC* ADDRA1
AND S60000
DAC MODEA1 / MODE OF ARGUMENT
JMP* SETA1 / SIGN(ARG1) IS HANDLED INDEPENDANTLY
/
/
/
/ SUBROUTINE TO SET UP ARGUMENT 2
/ CALLING SEQUENCE...
/ LAC ARG /ARGUMENT DESCRIPTION WORD
/ JMS SETA2 /ARG2 ALREADY CONTAINS ARG(I) ADDRESS
/
SETA2 SYN SYMT2A /AN ARGUMENT CONSISTS OF...
DAC ADDRA2 / ADDRESS OF ENTRY IN SYMBOL OR CONSTANT
DAC SYMTBC /TABLE.
AND Z00000
DAC TYPEA2 / TYPE OF ARGUMENT
SZA!SMA
JMP .+3 /IF THE ARGUMENT TYPE IS NOT A VARIABLE OR
LAC ADDRA2 /CONSTANT, THE MODE IS CARRIED IN THE
JMP .+3
JMS FAKE
LAC* ADDRA2
AND S60000
DAC MODEA2 / MODE OF ARGUMENT
JMP* SETA2 / SIGN(ARG2) IS HANDLED INDEPENDANTLY
.EJECT
/ SUBROUTINE TO TEMPORARILY STORE THE CURRENT ACCUMULATOR
/ CALLING SEQUENCE...
/ LAC MODE
/ JMS STORET
/
STORET CAL 0
JMS EXP510 /A TEMPORARY STORAGE LOCATION IS CREATED
DAC ARG /AND SUBSTITUTED FOR THE ACCUMULATOR AS
JMS GETMOD /GET THE OPERATOR INCREMENT
LAC NAME0 /FROM THE MODE OF NAME0
TAD C00008 /MODE OF THE ARGUMENT) AND A STORE
JMS OPOPA2 /INSTRUCTION INSERTED INTO THE COMMAND
LAC ARG /SEQUENCE.
XOR U00000 /THE ARGUMENT TYPE IS CHANGED FROM SIMPLE
JMP* STORET /VARIABLE TO TEMPORARY STORAGE.
/
/
/
/ SUBROUTINE TO OUTPUT STRING CODES (ADDRESS TO PC)
/ CALLING SEQUENCE...
/ LAC STRING ADDR
/ JMS STRING
/
STRING CAL 0
AND S17777
JMS BINOUT
XOR C00020 /OUTPUT REFERENCE ADDRESS
LAC PC
JMS BINOUT
XOR C00021 /OUTPUT DEFINITION ADDRESS
JMP* STRING
.EJECT
/ SUBROUTINE TO OUTPUT RELOCATABLE INSTRUCTIONS
/ CALLING SEQUENCE...
/ LAC INSTRUCTION
/ JMS RELBIN
/
RELBIN SYN FMS
JMS BINOUT /THE BINARY WORD IS OUTPUT AS A RELOCATABLE
XOR C00003 /INSTRUCTION.
JMP* RELBIN /LOADER CODE 03.
/
/
/ SUBROUTINE TO OUTPUT INSTRUCTION WITH AN ADDRESS TAKEN FROM
/ THE CURRENTLY-POINTED-TO SYMBOL TABLE ENTRY (SYMTBC)
/ CALLING SEQUENCE...
/ JMS SYMBIN
/ XOR INSTRUCTION
/
/
SYMBIN SYN FLS
LAC* SYMTBC
AND S17777 /GET ADDRESS OF SYMBOL
XCT* SYMBIN /MUSH IN THE INSTRUCTION
JMS RELBIN /OUTPUT THE MESS
JMP* SYMBIN /RETURN
/
/
/
/ SUBROUTINE TO OUTPUT ABSOLUTE BINARY CODE
/ CALLING SEQUENCE...
/ LAC BINARY WORD
/ JMS ABSBIN
/
ABSBIN SYN ENTFLG
JMS BINOUT /THE BINARY WORD IS OUTPUT AS AN ABSOLUTE
XOR C00004 /INSTRUCTION, CONSTANT, OR ADDRESS.
JMP* ABSBIN /LOADER CODE 04
.EJECT
/ SUBROUTINE TO CREATE TEMPORARY STORAGE
/ CALLING SEQUENCE...
/ LAC MODE
/ JMS EXP510
/
EXP510 CAL 0
DAC NAME0 /THE MODE OF THE ACCUMULATOR DETERMINES THE
JMS RTLAND /MODE OF THE TEMPORARY STORAGE IN WHICH THE
TAD PTSI /ACCUMULATOR IS TO BE STORED.
DAC NAME1
ISZ* NAME1
LAC* NAME1
DAC NAME1 /A NAME IS GENERATED FOR EACH OF THE THREE
LAC STAF /NAME TEMP STORAGE DIFFERENTLY IF A
DAC NAME2 /STATEMENT FUNCTION IS BEING PROCESSED
JMS SYMBSE /TEMP STORAGE TYPES AND ENTERED INTO THE
LAC SYMTBC /SYMBOL TABLE. (I,L=.AN , R=.BN , D=.CN ..
XOR T00000 /WHERE N IS THE NTH GENERATED NAME). THIS
JMP* EXP510 /NAME REPLACES THE ACC AS THE ARGUMENT.
PTSI .DSA TSI /POINTER TO ARRAY OF TEMPORARY NAMES
TSI .DSA 0 /INTEGER TEMPORARY NAME
TSR .DSA 0 /REAL TEMPORARY NAME
TSD .DSA 0 /DOUBLE PRECISION TEMPORARY NAME
TSJ .DSA 0
/
/
/ SUBROUTINE TO TAKE CARE OF ARGUMENT SIGNS AND LOAD ARG1
/
EXP520 CAL 0
LAC SIGNA2
SMA /ARG2 NEGATIVE?
JMP .+3 /NO
JMS EXP710 /YES - STORE ARG1 IF NECESSARY
JMS EXP680 /LOAD ARG2
JMS EXP690 /SAVE ARG2(FIXING SIGN) IF ARG2 IS IN THE AC
JMS EXP630 /LOAD ARG1
JMS EXP700 /NEGATE ARG1 IF NECESSARY
JMP* EXP520
/
/
RTLAND 0
RTL
RTL
RTL
AND C00003
JMP* RTLAND
.EJECT
/ SUBROUTINE TO CHECK FOR UNSUBSCRIPTED ARRAY REFERENCE OR FUNCTION
/ REFERENCE WITHOUT A PARAMETER LIST
/ CALLING SEQUENCE...
/ JMS EXP530
/ JMP NEITHER
/ XXX FUNCTION
/
EXP530 SYN SYMTW4
LAC TYPEA2 /WHEN FUNCTION PARAMETER LISTS ARE NOT
SAD T00000 /INDICATED, THE ARGUMENT IS EXAMINED TO
SKP /PREVENT FUNCTION AND ARRAY NAMES FROM
JMP* EXP530 /BEING USED AS SIMPLE VARIABLES.
LAC* ADDRA2 /I.E., WITHOUT PARAMETER OR
AND Z00000 /SUBSCRIPT LISTS
SMA /THE ILLEGAL TYPE FIELDS IN THE SYMBOL TABLE
SAD U00000 /ARE: 2,4,5,6 AND 7
ISZ EXP530 /SKIP IF BAD
JMP* EXP530 /RETURN
/
/
/
/ SUBROUTINE TO TEMPORIARLY STORE ARG(I) AND OP(I) INDICES
/
EXP540 SYN SYMTW5
LAC ARGI
DAC TARGI /ARG(I) TO TEMP
LAC OPI
DAC TOPI /OP(I) TO TEMP
JMP* EXP540
/
/
/
/ SUBROUTINE TO OUTPUT AN INSTRUCTION WITH A STRING ADDRESS
/ CALLING SEQUENCE...
/ JMS EXP550
/ XOR INSTRUCTION
/
EXP550 SYN S
LAC PC /THE STRING ADDRESS IS THE CURRENT VALUE
DAC TSTRNG /OF THE PROGRAM COUNTER.
XCT* EXP550 /THIS TOGETHER WITH THE INSTRUCTION IS
JMS RELBIN /OUTPUT AS A RELOCATABLE INSTRUCTION
LAC TSTRNG /(LOADER CODE 03).
ISZ EXP550
JMP* EXP550
.EJECT
/ SUBROUTINE TO SET UP A PARAMETER OR INSTRUCTION
/ CALLING SEQUENCE...
/ LAC ARG
/ JMS EXP560
/ XOR INDIRECT BIT
/
EXP560 SYN MS /PARAMETERS MAY BE VARIABLES, CONSTANTS,
DAC SYMTBC /TEMPORARY STORAGE, OR STRING ARGUMENTS.
SMA!SZA /WE MAY HAVE TO GET THE MODE
LAC* SYMTBC /INDIRECTLY
AND S60000 /EXTRACT MODE
RCL
RAL
DAC MODEXX /SHIFT IT TO BITS 1,2 AND SAVE IT
LAC SYMTBC
AND Z00000
SAD T00000 /CONSTANTS AND TEMPORARY STORAGE ARE
JMP EXP561 /LOCALLY DEFINED AND AS SUCH ARE OUTPUT AS
SAD W00000 /DIRECT ADDRESSES.
JMP EXP562
EXP563 LAC* SYMTBC
AND S17777
EXP565 OPR /**MBOX**TAD MODEXX /ADD IN MODE BITS
EXP564 ISZ EXP560
JMP* EXP560 /SORT OUT VARIOUS SYMBOL TYPES, CHOSING EXP565
EXP561 LAC* SYMTBC /IF NO INDIRECT BITS. ARRAYS ARE SPECIAL -
LRS 17 / IF WE ARE IN A SUBR. OR FUNC. CALL, CALLSW
TAD EQEXP /ADDRESSES 'SPECAL', WHICH FORCES INDIRECT IN
DAC RTLAND /BIT 0. THIS GIVES TRUE CALL BY REFERENCE.
LAC* SYMTBC
AND S17777
JMP* RTLAND
EQEXP .DSA EXPTAB / ADDRESS OF TABLE
EXPSPC JMP SPECAL / SET INTO CALLSW WHEN FUNC. OR SUBR. CALL
CALLSW JMP EXP565 / INITIALLY DIRECT, DEFAULT FOR ARRAYS
EXPDIR JMP EXP565 / USED TO RESET CALL SW TO DEFAULT
EXPTAB JMP EXP565 /0 - LOCAL SCALAR
JMP INDIR /1 - COMMON SCALAR
JMP INDIR /2 - EXTERNAL FUNCTION
JMP INDIR /3 - DUMMY SCALAR (ALSO STMNT NUMBER)
JMP CALLSW /4 - LOCAL ARRAY
JMP CALLSW /5 - COMMON ARRAY
JMP EXP565 /6 - INTERNAL (STATEMENT) FUNCTION
JMP CALLSW /7 - DUMMY ARRAY
SPECAL XOR W00000 /FORCE INDIRECT OF ARRAY WHEN IN A SUBR. OR
JMP EXP565 /FUNCTION CALL.
INDIR XCT* EXP560 /IMPOSE ACTUAL INDIRECT BIT.
JMP EXP565
EXP562 LAC SYMTBC
JMS STRING /STRING CODE ARGUMENTS ARE OUTPUT AS THE
JMP EXP564 /CURRENT PROGRAM COUNTER.
MODEXX .DSA 0
.EJECT
/ SUBROUTINE TO GENERATE COMMANDS TO NEGATE THE ACCUMULATOR
/ CALLING SEQUENCE...
/ LAC MODE
/ JMS EXP570
/
EXP570 SYN LS
SZA
JMP EXP571
JMS EXPKFF /OUTPUT TCA
JMP* EXP570 /COMPLEMENT PLUS ONE.
EXP571 SAD S60000
JMP EXP572
LAC OPTR25 /THE REAL AND DOUBLE PRECESION ACCUMULATOR
SKP
EXP572 LAC DBLNEG
.IFDEF %FPP
JMS FPPOUT
CLA
JMS FPPOUT /FLOATING INSTRUCTIONS ARE ALWAYS TWO WORDS
.ENDC
.IFUND %FPP
JMS EXP580
XOR JMSCMD
.ENDC
JMP* EXP570
/
/
/SUBROUTINE TO OUTPUT A TCA INSTRUCTION
/
EXPKFF 0
LAC TCACMD
JMS ABSBIN
JMP* EXPKFF
.EJECT
/ SUBROUTINE TO OUTPUT COMPILER GENERATED SUBROUTINE CALLS
/ CALLING SEQUENCE...
/ LAC SUBROUTINE NAME
/ JMS EXP580
/ XOR COMMAND
EXP580 SYN TMS
DAC NAME1 /THE SUBROUTINE NAME IS ENTERED INTO THE
DZM NAME2
LAC U00000 /SYMBOL TABLE AS AN EXTERNAL FUNCTION.
DAC NAME0
JMS SYMBSE /THE ADDRESS ASSIGNED TO THE TRANSFER
LAC* SYMTBC /VECTOR IS MERGED WITH A JMS( INSTRUCTION
AND S17777 /AND OUTPUT AS THE CALL TO THE SUBROUTINE.
XCT* EXP580
XOR S20000 /THE NAMES OF COMPILER CALLED SUBROUTINES
JMS RELBIN /ARE THREE CHARACTERS IN LENGTH AND ALWAYS
JMP* EXP580 /BEGIN WITH A PERIOD. E.G. .AA
.EJECT
/ SUBROUTINE TO OUTPUT .OP. ARG2 INSTRUCTION BASED ON MODE
/ CALLING SEQUENCE...
/ JMS EXP590
/ TAD OPERATION
/
EXP590 SYN TLS
JMS GETMOD /GET THE OPERATOR MODE INCREMENT
LAC MODEA2 /FROM THE MODE OF ARGUMENT 2
XCT* EXP590
JMS OPOPA2 /THE .OP. ARG2 INSTRUCTION IS THEN OUTPUT.
LAC* ARG2
JMP* EXP590
/
/ SUBROUTINE TO COMPUTE OPERATOR OFFSET FROM MODE
/
GETMOD CAL 0
XCT* GETMOD /GET THE ARGUMENT
JMS RTLAND
SAD C00003 /IF IT IS DOUBLE INTEGER
LAC DIFDGE /LOAD A SPECIAL DOUBLE INTEGER FUDGE VALUE
ISZ GETMOD
JMP* GETMOD
DIFDGE .DSA DIOPS-OPTRAN-5
/
/
/ SUBROUTINE TO INTERCHANGE ARGUMENT 1 AND ARGUMENT 2
/
EXP600 SYN SYMTW6
LAC* ARG2 /ARGUMENT 1 AND ARGUMENT 2 ARE ORDERED
DAC TARGI /(INTERCHANGED) TO OBTAIN A MORE
LAC* ARG1 /EFFICIENT CODE GENERATION.
DAC* ARG2
JMS SETA2 /THE ORDERING IS PERFORMED BY PHYSICALLY
LAC SIGNA1 /INTERCHANGING THE ARGUMENTS IN THE
DAC SIGNA2 /ARGUMENT LIST AND RE-GENERATING THE
LAC TARGI /ARGUMENT DESCRIPTION WORDS (MODE, TYPE,
DAC* ARG1 /SIGN, AND TABLE ADDRESS).
JMS SETA1
LAC* NOP
DAC SIGNA1
JMP* EXP600
.EJECT
/ SUBROUTINE TO DECODE PREVIOUS OPERATOR (POP)
/CALLING SEQUENCE...
/ JMS EXP610
/ JMP MULT-DIV
/ JMP ADD-SUB
/ JMP RELATIONAL
/ XXX LOGICAL
/
EXP610 SYN TSMTBC
LAC IDXPOP
SAD C00021
JMP* EXP610
SAD C00018 /THE FIRST EXIT IS TAKEN WHEN POP IS
JMP* EXP610 /MULTIPLY (*) OR DIVIDE (/).
ISZ EXP610
SAD C00015
JMP* EXP610
SAD C00012 /THE SECOND EXIT IS TAKEN WHEN POP IS
JMP* EXP610 /ADDITION (+) OR SUBTRACT (-).
ISZ EXP610
TAD K00005
SPA
JMP EXP611 /THE THIRD EXIT IS TAKEN WHEN POP IS
TAD K00006 /RELATIONAL (.LT., .LE., .NE., .EQ.,
SMA /.GE., .GT.)
EXP611 ISZ EXP610 /THE LAST EXIT IS TAKEN WHEN POP IS
JMP* EXP610 /LOGICAL (.AND., .OR.)
.EJECT
/ SUBROUTINE TO PERFORM SIGN CONTROL FOR PLUS-MINUS OPERATORS
/
EXP625 SYN DOI /THE SIGN OF THE SUB-EXPRESSION AND THE
LAC C00015 /AS THE ARGS ARE ALREADY ORDERED,IT IS
SAD IDXPOP /ONLY NECESSARY OF DETERMINE THE MOST
JMP EXP627 /EFFICIENT OPERATOR & SIGN OF THE RESULT.
DAC IDXPOP /+ IS CHOSEN AS A FIRST GUESS AS IT IS
LAC* POP /USUALLY THE MOST EFFICIENT.
AND U00000 /SEE IF REVERSE SUBTRACT.
SNA
JMP EXP621 /PROCESS AS NORMAL SIGN CHANGE.
LAC SIGNA1 /REVERSE SIGN OF ARG1
CMA
DAC SIGNA1
EXP627 LAC* POP /GET RID OF THE REVERSE INDICATOR.
AND X77777
DAC* POP
JMP EXP626
EXP621 LAC SIGNA2
CMA
DAC SIGNA2
EXP626 LAC SIGNA2 /OPERATOR ARE CHOSEN BASED UPON THE
SMA /FOLLOWING ARITHMETIC IDENTITIES....
JMP EXP622
DZM SIGNA2 / (+A)-(+B) = (+A)+(-B) = + (A-B)
LAC SIGNA1 / (+A)-(-B) = (+A)+(+B) = + (A+B)
SPACMD SPA / (-A)-(+B) = (-A)+(-B) = - (A+B)
JMP EXP623 / (-A)-(-B) = (-A)+(+B) = - (A-B)
LAC C00012
DAC IDXPOP
DZM SIGNA2
JMP* EXP625
EXP622 LAC SIGNA1
SMA
JMP* EXP625
LAC C00012
DAC IDXPOP
LAC* POP /MAKE OP REVERSE
XOR U00000
DAC* POP
DZM SIGNA1
JMP* EXP625
EXP623 LAC W00000
DAC SIGNA2
JMP* EXP625
.EJECT
/ SUBROUTINE TO OUTPUT A LOAD ARG1 INSTRUCTION
/
EXP630 CAL 0
LAC TYPEA1 /NO ACTION IS TAKEN IF ARGUMENT 1 IS
SNA /ALREADY THE ACCUMULATOR.
JMP* EXP630
JMS GETMOD /GET THE OPERATOR MODE INCREMENT
LAC MODEA1 /FROM THE MODE OF ARGUMENT 1
TAD C00004
JMS OPOPA2 /THE LOAD ARG1 INSTRUCTION IS THEN OUTPUT.
LAC* ARG1
LAC* ARG2
JMS SETA2
JMP* EXP630
/
/
/
/ SUBROUTINE TO SET UP ARGUMENT 1 AND PREVIOUS OPERATOR
/ CALLING SEQUENCE...
/ LAC POP /NEW ADDRESS OF POP
/ JMS EXP640
/
EXP640 SYN TSMTW4
DAC POP /THE LIST INDICES HAVE BEEN PUSHED EITHER
LAC* ARG1 /DOWN (NO CODE OUTPUT AND A NEW ARG2,NOP
JMS SETA1 /ARE TO BE FETCHED) OR UP (CODE HAS BEEN
LAC* POP /GENERATED AND THE ARG1.POP.ARG2
DAC SIGNA1 /SUB-EXPRESSION IS BEING REMOVED FROM THE
AND T77700 /LISTS).
DAC LEVPOP
LAC* POP
AND S00077
DAC IDXPOP
JMP* EXP640
/
/
/
/ SUBROUTINE TO INTERCHANGE ARGUMENTS 1 AND 2 AND REVERSE THE OPERATOR
/
EXP650 SYN TRELAD
JMS EXP600 /ARGUMENT 1 AND ARGUMENT 2 ARE INTERCHANGED
LAC* POP /AND THE OPERATOR REVERSED.
XOR U00000
DAC* POP
JMP* EXP650
.EJECT
/ SUBROUTINE TO NEGATE ARGUMENT 2 (IF NECESSARY)
/
EXP670 CAL 0
LAC SIGNA2 /THE SIGN OF THE ACCUMULATOR IS EXAMINED
SMA /AND IF MINUS, THE ACCUMULATOR IS NEGATED.
JMP* EXP670
LAC MODEA2
JMS EXP570
DZM SIGNA2
JMP* EXP670
/
/
/
/ SUBROUTINE TO LOAD ARGUMENT 2 INTO THE ACCUMULATOR (IF NECESSARY)
/
EXP680 CAL 0
LAC TYPEA2 /NO ACTION IS TAKEN IF ARGUMENT 2 IS
SZA /ALREADY IN THE ACCUMULATOR.
JMS EXP590 /OTHERWISE, A LOAD ARGUMENT 2 INSTRUCTION
TAD C00004 /IS GENERATED.
LAC MODEA2
DAC* ARG2 /SET ARGUMENT AS ACCUMULATOR
JMS SETA2
JMP* EXP680
/
/
/
/ SUBROUTINE TO TEMPORARILY STORE ACCUMULATOR AND SET ARGUMENT 2
/
EXP690 CAL 0
LAC TYPEA2 /NO ACTION IS TAKEN WHEN ARGUMENT 2 IS NOT
SZA /THE ACCUMULATOR.
JMP* EXP690
JMS EXP670 /NEGATE THE ACCUMULATOR IF NECESSARY.
LAC MODEA2 /WHEN ARGUMENT 2 IS THE ACCUMULATOR, IT IS
JMS STORET /TEMPORARILY STORED.
DAC* ARG2
JMS SETA2 /ARGUMENT 2 IS REPLACED WITH A TEMPORARY
JMP* EXP690 /STORAGE LOCATION OF THE SAME MODE.
.EJECT
/ SUBROUTINE TO NEGATE ARGUMENT 1 (IF NECESSARY)
/
EXP700 SYN ARGCTR
LAC SIGNA1 /THE SIGN OF THE ACCUMULATOR IS EXAMINED
SMA /AND IF MINUS, THE ACCUMULATOR IS NEGATED.
JMP* EXP700
LAC MODEA1
JMS EXP570
DZM SIGNA1
LAC* POP
AND V77777
DAC* POP
JMP* EXP700
/
/
/
/ SUBROUTINE TO TEMPORARILY STORE ACCUMULATOR AND SET ARGUMENT 1
/
EXP710 SYN MODE
LAC TYPEA1 /NO ACTION IS TAKEN WHEN ARGUMENT 1 IS NOT
SZA /THE ACCUMULATOR.
JMP* EXP710
JMS EXP700 /THE ACCUMULATOR IS NEGATED (IF NECESSARY)
LAC MODEA1 /BEFORE IT IS TEMPORARILY STORED.
JMS STORET
DAC* ARG1 /ARGUMENT 1 IS REPLACED WITH A TEMPORARY
JMS SETA1 /STORAGE LOCATION OF THE SAME MODE.
JMP* EXP710
.EJECT
/ SUBROUTINE TO OUTPUT A PARAMETER
/ CALLING SEQUENCE...
/ LAC ARG
/ JMS EXP720
/
EXP720 SYN DOM1
DAC OBJB04 /(VECTOR IS A PARAMETER - FOR OBJ. LIST)
JMS EXP560 /THE PROPER ADDRESS IS DETERMINED AND
XOR W00000 /OUTPUT AS A FULL 15 BIT RELOCATABLE
JMS VECBIN /VALUE.
DZM OBJB04 /(RESET VECTOR-PARAMETER INICATOR)
JMP* EXP720
/
/
/
/ SUBROUTINE TO OUTPUT TAD (1) INSTRUCTION
/
EXP730 CAL 0
LAC IACCMD
JMS ABSBIN /GENERATE IAC FOR PDP15
JMP* EXP730
.EJECT
/ SUBROUTINE TO CONVERT MODE OF ACCUMULATOR
/ CALLING SEQUENCE...
/ LAC CONVERSION MODE
/ JMS EXP740
/
EXP740 SYN DOM3
JMS COMBIN /COMBINE AC AND MODEA2 TO GET AN INDEX INTO
TAD CVTBLA /THE MODE CONVERSION TABLE
DAC .+1
OPR
SNA /ENTRY=0 MEANS NO CONVERSION NECESSARY
JMP* EXP740
SPA /ENTRY NEGATIVE MEANS MACHINE OPCODE
JMP EXP741
JMS EXP580
XOR JMSCMD /OTHERWISE ITS A SUBROUTINE CALL
JMP* EXP740
.IFUND %FPP
EXP741 JMS ABSBIN
.ENDC
.IFDEF %FPP
EXP741 JMS FPPOUT
CLA
JMS FPPOUT
.ENDC
JMP* EXP740
/
/
CVTBLA LAC .+1
0 /INT_INT
127500 /INT_REAL .AX
127500 /INT_D.P. .AX
NORM18 FPPIN 640422,131424 /INT_D.I. NORM-18 OR .ZD
127477 /REAL_INT .AW
0 /REAL_REAL
0 /REAL_D.P.
FPPIN 130247,714210 /REAL_D.I. .JW
127477 /D.P._INT .AW
0 /D.P._REAL
0 /D.P._D.P.
FPPIN 130247,714210
LRSS18 FPPIN 660522,131423 /D.I._INT LRSS 18 OR .ZC
FPPIN 130250,714670 /D.I._REAL .JX
FPPIN 130250,714670 /D.I._D.P. .JX
0 /D.I._D.I.
.EJECT
/ SUBROUTINE TO OUTPUT RELOCATABLE VECTORS
/ CALLING SEQUENCE
/ LAC BINARY WORD
/ JMS VECBIN
/
VECBIN CAL 0
JMS BINOUT /THE BINARY WORD IS OUTPUT AS A 15 BIT
XOR C00005 /RELOCATABLE ADDRESS (VECTOR).
JMP* VECBIN /LOADER CODE 05.
/
/SUBROUTINE TO FORM A TABLE INDEX (0 THRU 15) FROM THE AC AND MODEA2
/
COMBIN CAL 0
RCL
RAL /CLL RTL
TAD MODEA2
RTL
RTL
RTL /ROTATE MESS INTO LOW ORDER BITS
JMP* COMBIN
/
/
/
/ SUBROUTINE TO DETERMINE IF STATED SUBSCRIPTS EQUAL DECLARED SUBSCRIPTS
/
SUBCNT CAL 0
JMS SUBCT2 /COUNT NUMBER OF SUBSCRIPTS
ERS 16S,<SAD SSCTR>,ES /# SUBSCRIPTS STATED .NE. # DECLARED
JMP* SUBCNT
SUBCT2 CAL /COUNT NO OF SUBSCRIPTS; ALSO ENTERED DURING
LAC C00001 /ALLOCATION OF ARRAY DES. BLOCK
DAC TCTR /A MINIMUM OF ONE DIMENSION IS ASSUMED.
LAC* SYMTW5 /WORDS FIVE AND SIX OF THE SYMBOL TABLE
SZA /ENTRY FOR THE ARRAY CONTAIN INFORMATION
ISZ TCTR /PERTAINING TO DIMENSIONS TWO AND THREE.
LAC* SYMTW6
SZA /THESE WORDS ARE ZERO IF DIMENSIONS TWO
ISZ TCTR /AND/OR THREE DO NOT EXIST.
LAC TCTR
JMP* SUBCT2
.TITLE SYNTAX ANALYZER ( ARGUMENT - OPERATOR FETCH)
/ SUBROUTINE TO INITIALIZE FETCH ARGUMENT-OPERATOR SUBROUTINE
/
INFAOP SYN TCTR
LAC BASE0 /THE PARENTHESIS LEVEL INDEX IS SET TO THE
DAC BASEJ /FIRST ENTRY AND THAT ENTRY CLEARED. MORE
DZM* BASEJ /THAN ONE ENTY IS USED IN ORDER TO KEEP
LAC K00001 /TRACK OF NESTED FUNCTION CALLS. THE LAST
DAC TFAO01 /ELEMENT PROCESSED IS NON-EXISTANT.
JMP* INFAOP
/
/
/
/ SUBROUTINE TO FETCH AN ARGUMENT-OPERATOR PAIR
/
FARGOP CAL 0
LAC FAOPIM /THIS ROUTINE IS PRE-INITIALIZED AS IT IS
DZM NAME0 /CALLED MANY TIMES IN SUCCESSION. EACH CALL
DZM SIGN /IS A REQUEST FOR AN ARGUMENT-OPERATOR (OR
DAC TFAO04 /DELIMETER) PAIR. THE FIRST ITEM OBTAINED
FAO081 DAC FAOMOD /IS ALWAYS AN ARGUMENT UNLESS THE LAST ITEM
FAO080 JMS FNBCHR /WAS A SPECIAL DELIMETER.
LAC CHRTYP
SNA
FAO090 ERX 18I,EI /ERROR: BAD CHAR
TAD FAOMOD /CHARACTER DECODING IS BASED ON THE CURRENT
DAC .+3 /PROCESSING MODE AND THE CHARACTER TYPES.
LAC CHAR /EXIT IS TO ONE OF TWENTY-NINE ROUTINES.
DAC OPVALU
JMS*
.EJECT
/ FETCH ARGUMENT-OPERATOR DECODING MATRIX (MODE BY CHARACTER TYPE)
/ INITIAL MODE ROW
/
FAOPIM JMP FAOPIM /TYPE CHARACTER
JMP FAO010 /01 NUMERIC 0123456789
JMP FAO020 /02 ALPHABETIC BCJKMNQSUVWYZ
JMP FAO020 /03 ALPHABETIC ED
JMP FAO020 /04 ALPHABETIC AFGHILPXORT
JMP FAO030 /05 OPERATOR +-
JMP FAO040 /06 OPERATOR */
JMP FAO050 /07 PERIOD .
JMP FAO060 /08 PARENTHESIS (
JMP FAO075 /09 PARENTHESIS )
JMP FAO035 /10 DELIMETER ,=C/R
JMP FAO120 /11 SPACE
JMP FAO700 /12 QUOTES "$
JMP FAO040 /13 PARTWD [
JMP FAO750 /14 MISC :];#@
/ NUMERIC MODE ROW
/
FAOPNM JMP FAOPNM /TYPE CHARACTER
JMP FAO130 /01 NUMERIC 01234567890
JMP FAO280 /02 ALFABETIC BCJKMNQSUVWYZ
JMP FAO140 /03 ALFABETIC ED
JMP FAO150 /04 ALFABETIC AFGHILPXORT
JMP FAO160 /05 OPERATOR +-
JMP FAO170 /06 OPERATOR */
JMP FAO180 /07 PERIOD .
JMP FAO280 /08 PARENTHESIS (
JMP FAO190 /09 PARENTHESIS )
JMP FAO163 /10 DELIMETER ,=C/R
JMP FAO120 /11 SPACE
JMP FAO163 /12 QUOTES "$
JMP FAO170 /13 PARTWD [
JMP FAO164 /14 MISC :];#@
/ (ALL MISC CHARS IN NUMERIC MODE ARE ILLEGAL PARTWORD
/ PROCESSOR DOES NOT USE FARGOP, SO : ] BAD, AND ; @ # ARE
/ STRICTLY OUT OF CONTEXT)
/ SYMBOLIC MODE ROW
/
FAOPSM JMP FAOPSM /TYPE CHARACTER
JMP FAO200 /01 NUMERIC 0123456789
JMP FAO200 /02 ALPHABETIC BCJKMNQSUVWYZ
JMP FAO200 /03 ALPHABETIC ED
JMP FAO200 /04 ALPHABETIC AFGHILPXORT
JMP FAO210 /05 OPERATOR +-
JMP FAO220 /06 OPERATOR */
JMP FAO230 /07 PERIOD .
JMP FAO240 /08 PARENTHESIS (
JMP FAO250 /09 PARENTHESIS )
JMP FAO210 /10 DELIMETER ,=C/R
JMP FAO120 /11 SPACE
JMP FAO210 /12 QUOTES "$
JMP FAO220 /13 PARTWD [
JMP FAO211 /14 MISC :];#@
.EJECT
/ PROCESSOR RETURN TO SET LAST ITEM AND GETCH NEXT CHARACTER
FAO001 LAC OPVALU
FAO003 DAC TFAO01
JMP FAO080
/
/ PROCESSOR RETURN WHEN ARGUMENT-OPERATOR PAIR HAS BEEN FETCHED
FAO002 LAC OPVALU /THE CURRENT OPERATOR IS SET AS THE LAST
DAC TFAO01 /ITEM PROCESSED. THIS IS TO ALLOW LOOKING
XOR LEVEL /BACKWARDS NEXT TIME.
DAC TCTR
LAC SIGN /THE OPERATOR, ITS HEIRARCHY LEVEL AND THE
AND W00000 /ARGUMENT SIGN ARE ALL PUT TOGETHER IN ONE
XOR TCTR /WORD.
RCL /A C/R HAS A TRUE LEVEL OF ZERO.
SZA!RAR /OTHERWISE, THE CURRENT PAREN LEVEL COUNT
TAD* BASEJ /IS ADDED TO THE OPERATOR HEIRARCHY SO
DAC OP /THAT PARENTHESIS GROUPING OF ARGUMENTS
LAC OPVALU /AND OPERATORS GET PREFERENTIAL TREATMENT.
JMP* FARGOP
.EJECT
/ NUMERIC CHARACTER AFTER INITIAL PERIOD
/
FAO100 LAC S20000 /THE NUMBER MODE IS SET TO REAL
DAC NAME0
/
/ NUMERIC CHARACTER IN THE INITIAL MODE
/ /THE MODE OF THE NUMERIC ARGUMENT IS
FAO010 JMS FAO500 /INITIALLY SET AS INTEGER. THE LAST ITEM
K00029 LAW -35 /IS EXAMINED TO DETERMINE IF TWO ARGUMENTS
TAD CHAR /HAVE BEEN WRITTEN BACK-TO-BACK. IF NOT,
DAC LS /THE PROCESSOR IS INITIALIZED FOR NUMERIC
DZM MS /CONVERSION. THE MANTISSA IS SET TO THE
LAC PASS2 /INITIAL DIGIT. SWITCHES ARE SET TO
/INDICATE CONVERSION INCOMPLETE,
DAC FAO131 /MANTISSA VERSUS EXPONENT CONVERSION, AND
DZM TFAO03 /THE FRACTIONAL DIGIT COUNT, AND
DZM TFAO05 /EXPONENT SIGN ARE RESET.
JMP FAO132+1
/
/ ALPHABETIC CHARACTER (TYPES 02,03,04) IN THE INITIAL MODE
/
FAO020 JMS FAO500 /THE LAST ITEM PROCESSED IS EXAMINED TO
LAC C00001
DAC CHRCTR
LAC CHAR /DETERMINE IF TWO ARGUMENTS HAVE BEEN
DAC NAME2 /WRITTEN BACK-TO-BACK. IF NOT, THE
DZM NAME1 /PROCESSOR IS INITIALIZED FOR SYMBOLIC
/CONVERSION. THE SYMBOL (NAME) IS SET WITH
/THE FIRST CHARACTER.
/
TAD LACTAB /THE MODE OF THE SYMBOL IS DETERMINED BY A
DAC .+1 /TABLE LOOKUP. THE TABLE CONTAINS THE STANDARD
XX /MODE CODES IN BITS 4-5 AND THE LOGICAL FLAG
RCL /IN THE SIGN BIT
DAC NAME0
CLA!RAR
DAC LOGFLG
/THE MODE OF A VARIABLE CAN ALWAYS BE CHANGED
K00002 LAW -2 /THROUGH THE USE OF THE SPECIFICATION
FAO023 DAC TCTR /STATEMENTS. NAMES ARE CONCATENATED THREE
LAC FAOPSM /CHARACTERS PER WORD WITH A MAXIMUM OF SIX
JMP FAO081 /CHARACTERS.
.EJECT
/.OPERATOR (+ -) IN THE INITIAL MODE
FAO030 LAC TFAO01 /A PLUS-MINUS OPERATOR AS THE FIRST ITEM
SAD C00024 /IS ALLOWED IN TWO CASES. THE MORE FREQUENT
JMP FAO031
SAD C00028 /BEING WHEN THE LAST ITEM IS THE CLOSING
JMP FAO031 /PARENTHESIS OF A SUBSCRIPT OF FUNCTION
SAD C00034 /ARGUMENT LIST. THE OTHER CASE IS WHEN THE
JMP FAO031 /OPERATOR IS USED AS A UNARY OPERATOR
SAD C00030
JMP FAO031
SPA
JMP FAO035
TAD K00010
SPA!SNA
JMP FAO031
FAO035 ERN 10S,<JMS FAO510>,ES
LAC Z00000 /WHEN THE PREVIOUS DELIMITER WAS SPECIAL,
DAC ARG /THE OPERATOR IS RETURNED
JMP FAO002 /ALONG WITH A SPECIAL ARGUMENT.
FAO031 LAC OPVALU /ONLY A PLUS OR MINUS OPERATOR MAY BE
SAD C00015 /CONSIDERED AS A UNARY OPERATOR. UNARY
JMP FAO001 /PLUS OPERATORS ARE UNCONDITIONALLY IGNORED
LAC C00024 /THE MINUS OPERATOR IS CONVERTED TO A
DAC OPVALU /UNARY NEGATION OPERATOR
LAC S01000
DAC LEVEL
DAC ARG
LAC DATAFL
SNA /IS IT IN DATA STMT?
JMP FAO034 /NO.
LAC W00000 /YES -- NEGATE ARGUMENT.
XOR OPVALU
DAC SIGN
LAC FAOPIM
DAC FAOMOD
JMP FAO001
FAO034 LAC Z00000 /MODE NEGATION OF AN ARG.
DAC ARG /WHEN THE OPERATOR IS DISTRIBUTIVE, A
JMP FAO002 /SPECIAL UNARY ARGUMENT IS RETURNED
/
/
/ OPERATOR (* / [ , = C/R) IN THE INITIAL MODE
FAO040 JMS FAO540 /AN ERROR IS ANNOUNCED WHEN A BINARY
JMP FAO035 /OPERATOR IS USED AS A UNARY OPERATOR.
.EJECT
/
/ PARENTHESIS (OPEN) IN THE INITIAL MMDE
FAO060 ERS 16X,<JMS TSTORD>,EX /ILLEGAL IN DECLARATION STMTS
JMS FAO500 /ILLEGAL AFTER SPECIAL DELIMITER
ERN 17X,<SAD K00001>,EX /ILLEGAL IF TFA001=INITIAL VALUE
LAC S01200
TAD* BASEJ /OPEN PARENS CANNOT FOLLOW LIST TERMINATION
DAC* BASEJ /EITHER. WHERE GROUPING IS ALLOWED, THE
FAO062 LAC CHAR /PAREN LEVEL COUNT IS UPDATED FOR OPERATOR
JMP FAO003 /HEIRARCHY TESTING.
/
/
/ PARENTHESIS (CLOSING) IN THE INITIAL MODE
FAO075 ERN 11S,<JMS FAO510>,ES /ERROR IF NO SPECIAL DELIMITER
DAC CHAR
LAC Z00000 /(OPERATOR OR A GOUPING PAREN FOLLOWING A
DAC ARG /FUNCTION OR A SUBSCRIPTED VARIABLE.
FAO073 LAW 776600 /EACH TIME A CLOSING PARENTHESIS IS
TAD* BASEJ /ENCOUNTERED, THE PAREN LEVEL COUNT IS
DAC* BASEJ /DECREASED. SINCE THE NUMBER OF CLOSING
SMA /PARENTHESIS MUST EQUAL THE NUMBER OF OPEN
JMP FAO074 /PARENTHESIS, THE LEVEL COUNT SHOULD NOT
SAD Z76600 /NORMALLY BE LESS THAN 0. THE EXCEPTION IS
LAC BASEJ /DURING SCANNING OF AN IF, READ, WRITE, OR
ERS 19X,<SAD BASE0>,EX /EQUIVALENCE STATEMENT WHEN ONE
LAC S01200 /EXCESS CLOSE PAREN IS LEGAL.
DAC LEVEL
LAC C00031 /A CLOSING PARENTHESIS IS RETURNED AS THE
JMP FAO072 /OPERATOR TO INDICATE THIS DELIMITER.
FAO074 LAC BASEJ /FUNCTION NESTING (I.E. ONE FUNCTION IS AN
SAD BASE0 /ARGUMENT OF ANOTHER FUNCTION) HAS OCCURED
JMP FAO062 /WHEN THE INITIAL BASE INDEX IS NOT THE
TAD K00001 /CURRENT BASE INDEX (THE INDEX IS INCREASED
DAC TCTR /FOR EACH FUNCTION ENCOUNTERED). AS SUCH,
LAC* BASEJ /THE CURRENT CLOSING PARENTHESIS MAY BE
SAD* TCTR /THE ARGUMENT LIST DELIMETER.(IT IS IF THE
SKP /CURRENT LEVEL IS EQUAL TO THE PREVIOUS
JMP FAO062 /LEVEL). OTHERWISE THE PARENTHESIS IS JUST
/A GROUPING DELIMETER (NO IMMEDIATE EFFECT).
LAC TCTR /THE OPERATOR )F IS RETURNED WHEN LIST
DAC BASEJ /TERMINATING DELIMETERS ARE ENCOUNTERED.
LAC C00032 /FOR EACH FUNCTION TERMINATED, THE NESTING
FAO072 DAC OPVALU /LEVEL IS DECREASED BY ONE.
JMP FAO002
Z76600=FAO073
.EJECT
/ PERIOD (.) IN THE INITIAL MODE
/
FAO050 JMS FNBCHR /GET A CHARACTER
LAC CHRTYP /IF THE CHARACTER IS NUMERIC, THEN THE PERIOD
SAD C00001 /IS THE BEGINNING OF A FLOATING POINT
JMP FAO100 /NUMBER.
SZA /IF THE CHARACTER IS ALPHABETIC (TYPE 2,3 OR 4)
TAD K00005 /THEN THE PERIOD IS THE BEGINNING OF A
SMA /LOGICAL OPERAND OR CONSTANT.
JMP FAO090 /IF CHARACTER IS ANYTHING ELSE, ITS AN ERROR.
/
/ ALPHABETIC CHARACTER IN THE UNDECIDED MODE
FAO110 LAC FAOMOD /AN ALPHABETIC CHARACTER FOLLOWING A PERIOD
DAC TFAO06 /INDICATES THE PRESENCE OF EITHER A LOGICAL
LAC CHAR /OPERATOR OR CONSTANT OR A RELATIONAL
DAC NAME2 /OPERATOR. AN ENTRY FROM X-MODE FLAG IS SET
/TO PREVENT OPERATORS FROM OCCURING
/WITHOUT ARGUMENTS (AND VICE VERSA).
FAO111 JMS FNBCHR /GET NEXT CHARACTER
SAD C00046 /IF IT IS A PERIOD,
JMP FAO270 /PROCESS THE COLLECTED LOGICAL QUANTITY
LAC CHRTYP
SZA /IF IT IS ALPHABETIC OR NUMERIC,
TAD K00005 /CONCATENATE THIS CHARACTER TO THE CHARACTERS
SMA /ALREADY COLLECTED AND CONTINUE.
JMP FAO090 /IF NON-ALPHANUMERIC, ITS AN ERROR
JMS CAT
JMP FAO111
.EJECT
/ NUMERIC CHARACTER IN THE NUMERIC MODE
FAO130 JMS FAO620 /WHEN CONVERSION IS COMPLETE, ACCEPT ONLY
FAO131 NOP /OPERATORS. WHEN CONVERSION IS INCOMPLETE,
JMP FAO132 /THE DECESION TO CONVERT THE MANTISSA OR
LAC TFAO05 /THE EXPONENT MUST BE MADE.
SNA /WHEN THE
LAC C00015 /EXPONENT IS BEING PROCESSED, THE SIGN IS
AND S00077 /(SET EXPONENT OBTAINED FLAG)
DAC TFAO05 /SET TO PLUS IF ONE WAS NOT WRITTEN.
JMS DECBIN /THE MAGNITUDE OF THE DECIMAL EXPONENT
JMS FAO560 /CANNOT EXCEED THE MAXIMUM INTEGER SIZE
JMP FAO080
FAO132 JMS DECBIN /MANTISSA CONVERSION PROCEEDS AS IF ALL
LAC NAME0 /NUMBERS ARE DOUBLE PRECESION IN LENGTH.
SZACMD SZA /IF THE NUMBER MODE IS EITHER REAL OF
ISZ TFAO03 /DOUBLE PRECESION, ONE IS ADDED TO THE
FAO013 LAC FAOPNM
JMP FAO081 /FRACTIONAL DIGIT COUNT FOR EXP ADJUSTMENT.
/
/ ALPHABETIC CHARACTER (E,D) IN THE NUMERIC MODE
/
FAO140 ERS 28V,<XCT FAO131>,EV /ERROR IF EXPONENT FIELD
JMS FAO620 /ALREADY PROCESSED.
LAC CHAR /THE MODE OF THE NUMBER HS DETERMINED BY
TAD K00005 /THE CHARACTER BEGINNING THE EXPONENT
SZA
LAC S20000 /FIELD. AN EXPONENT BEGINNING WITH E
TAD S20000 /INDICATES A REAL NUMBER. THE EXPONENT OF
DAC NAME0 /A DOUBLE PRECESION NUMBER BEGINS WITH A D.
LAC PASS1 /SET...
DAC FAO131 /CONVERT EXPONENT FLAGS.
JMS FAO550 /THE MANTISSA IS MOVED AS THE EXPONENT
DZM MS
DZM LS
JMP FAO080 /CONVERSION UTILIZES THE SAME STORAGE.
.EJECT
/ ALPHABETIC CHARACTER (A,F,H,I,L,P,X) IN THE NUMERIC MODE
/
FAO150 ERS 20X,<SAD C00008>,EX /ONLY H IS LEGAL
LAC NAME0
ERN 05H,SZA,EH
/NUMBER PRECEDING H MUST BE INTEGER
JMS FAO560 /HOLLERITH CONSTANT.
JMS TWOCMA
DAC TCTR
CLL
TAD C00005 /THE NUMBER PRECEDINH "H" MUST BE
ERN 03H,SNL,EH /BETWEEN 1 AND 5
K00005 LAW -5
DAC FMTCNT /THE HOLLERITH CONSTANT OCCUPIES TWO
FAO156 JMS FETCHR /WORDS AND IS PACKED IN 5/7 ASCII FORMAT
ERS 04H,<JMS CTRL60>,EH /CARRIAGE RETURN ILLEGAL HERE
LAC XCHAR
JMS FMTPAK
OPR
ISZ TCTR /WHEN ALL THE CHARAATERS HAVE BEEN FETCHED
JMP FAO156 /AND THE CONSTANT FORMED, THE CONSTANT....
LAC FMTCNT /(HOLCON SET TO 1 BEFORE ENTERING; RESETTING IT
DAC HOLCON /SEZ WE GOT HOLLERITH INFO, AND HOW LONG IT IS)
JMS FMTFIL /...IS LEFT JUSTIFIED WITHIN THE 2 WORDS
OPR
LAC S20000 /AND SPACE CHARACTERS ADDED IF NECESSARY.
FAO712 DAC NAME0 /THE MODE OF THE CONSTANT IS SET TO REAL
LAC FMS /SO THAT BOTH WORDS WILL BE USED.
DAC S
LAC FLS
DAC NAME1
FAO713 LAC PROCAD /DATA INITIALIZATION CONSTANTS ARE NOT
SAD DATAAD /ENTERED INTO THE CONSTANT TABLE
SKP!CLA /CONSTANTS FOUND IN EXECUTABLE
JMS CONSSE /STATEMENTS ARE ENTERED.
/THE CONSTANT OR ITS ADDRESS BECOMES THE
XOR U00000 /ARGUMENT AND THE NEXT NON-BLANK CHARACTER
DAC ARG /BECOMES THE OPERATOR-DELIMETER.
FAO711 DZM TFAO04
JMP FAO013
.EJECT
/ QUOTE (",$,') IN THE INITIAL MODE
/
FAO700 LAC XCHAR
DAC NAME0 /SAVE THE OPENING QUOTE
LAW -5
DAC FMTCNT /INITIALIZE FORMAT PACKER
LAW -7
DAC TCTR /AND CHARACTER COUNTER
FAO701 JMS FETCHR /GET A CHARACTER
ERS 07H,<JMS CTRL60>,EH /END OF STMT IS ERROR
ERS 06H,<ISZ TCTR>,EH /SO IS >5 CHARACTERS
LAC XCHAR
SAD NAME0 /CHECK FOR CLOSING QUOTE
JMP FAO702
FAO703 JMS FMTPAK /PACK THE CHARACTER IN
OPR
JMP FAO701
FAO702 JMS FNBCHR /LOOK ONE CHARACTER AHEAD
SAD NAME0 /IF THE DELIMITER IS REPEATED,
JMP FAO703 /THEN INSERT THE DELIMITER INTO THE TEXT.
DZM UNFNBC /OTHERWISE PUT THE CHARACTER BACK
LAC FMTCNT /(RESET HOLCON FROM 1 TO FMTCNT TO SIGNAL HOLLERITH
DAC HOLCON /CONSTANT, AND HOW LONG IT IS)
JMS FMTFIL /LEFT JUSTIFY THE TEXT WITH SPACES
OPR
LAC S60000 /SET MODE TO DOUBLE INTEGER
JMP FAO712
/
/ SPECIAL CHARACTERS (@,#,;,],:) IN THE INITIAL MODE
/
FAO750 LAC XCHAR /GET THE CHARACTER
SAD S00073 /SEMICOLON?
JMP FAO035 /YES - TREAT LIKE COMMA
SAD C00035 /#?
JMP FAOCTL /YES - OCTAL CONSTANT
ERS 23I,<SAD S00100>,EI /BETTER BE @
JMS FDFSNO /GET THE STATEMENT NUMBER FOLLOWING THE @
LAC SYMTBC
DAC S /FORM A RELOCATABLE INTEGER CONSTANT
LAC Y00000 /(MODE=0 BUT TYPE=6)
DAC NAME0
JMS CONSSE /ENTER IT INTO THE CONSTANT TABLE
XOR T00000 /CALL IT A VARIABLE NAME, BUT HOPEFULLY
DAC ARG /THE FACT THAT ITS "TYPE" IS THAT OF A FUNCTION
DZM UNFNBC
JMP FAO711 /WILL PROPERLY RESTRICT ITS USAGE
.EJECT
FAOCTL DZM MS
DZM LS /INITIALIZE NUMBER
JMS FNBCHR /GET A CHAR
SAD S00104 /D?
SKP /YES
JMP FAOCTS
LAC S60000 /SET MODE TO DOUBLE INTEGER
DAC NAME0
JMS FNBCHR
FAOCTS SAD C00045 /-?
SKP
JMP FAOOLP /NO
ISZ SIGN /YES - COMPLEMENT SIGN
JMS FNBCHR
FAOOLP AND Z77770
XOR C00048
SZA /OCTAL DIGIT?
JMP FAOODN /NO
JMS DLSHFT /YES - SHIFT MS,LS LEFT 3
JMS DLSHFT
JMS DLSHFT
LAC XCHAR
AND C00007 /ADD IN NEW OCTAL DIGIT
TAD LS
DAC LS
JMS FNBCHR /GET A NEW CHARACTER
JMP FAOOLP /LOOP
FAOODN LAC NAME0 /IF NOT DOUBLE PRECISION,
SNA
DZM MS /ZAP HIGH ORDER WORD
SNA /IF MODE IS INTEGER AND LS IS NAGATIVE,
LAC LS
SMA /WE MUST FUDGE BECAUSE OF A TEST IN
JMP FAOO01 /SUBROUTINE "FAO570"
JMS TWOCMA
DAC LS /SET LS POSITIVE
CLC
TAD SIGN
DAC SIGN /AND COMPLEMENT SIGN
FAOO01 JMS FAO570 /COMPLETE THE CONVERSION
DZM UNFNBC
JMP FAO013
.EJECT
/ OPERATOR (+,-) IN THE NUMERIC MODE
/
FAO160 XCT FAO131 /A PLUS OR MINUS SIGN IN A NUMERIC FIELD
JMP FAO163 /IS EITHER A DELIMITING OPERATOR (E.G.
LAC TFAO05 /ONLY A MANTISSA HAS BEEN OBTAINED) OR IT
SZA /IS THE SIGN OF THE EXPONENT (WHEN ONE HAS
JMP FAO163 /NOT YET BEEN OBTAINED).
LAC CHAR
XOR W00000 /THE EXPONENT SIGN IS FLAGGED TO INDICATE
DAC TFAO05 /THE ABSENCE OF AN EXPONENT.
JMP FAO080
FAO163 JMS FAO570 /THE NUMBER CONVERSION IS COMPLETED AND
JMP FAO002 /THE SIGN TAKEN AS THE OPERATOR.
/
/ OPERATOR :];#@ IN NUMERIC MODE
/
FAO164 LAC XCHAR /ONLY # IS LEGAL
SAD C00035
JMP FAO163 /AS USED IN RANDOM ACCESS READ/WRITE
JMP EI13I /GO GENERATE DIAGNOSTIC
/
/ OPERATOR (*,/,[) IN THE NUMERIC MODE
/
FAO170 JMS FAO540 /THE OPERATOR IS TESTED FOR EXPONENTIATION
JMP FAO163 /AND NUMERIC CONVERSION COMPLETED.
.EJECT
/ PERIOD (.) IN THE NUMERIC MODE
/
FAO180 JMS FNBCHR /A PERIOD IN A NUMERIC STRING CAN BE
LAC TFAO04 /INTERPRETED AS EITHER A DECIMAL POINT OR
SNA /AS THE BEGINNING OF A LOGICAL OR
JMP FAO110 /RELATIONAL OPERATOR. IF IT TURNS OUT TO
LAC NAME0 /BE A LOGICAL CONSTANT OR THE UNARY
SNA /OPERATOR .NOT. THE ENTER FROM X-MODE FLAG
JMP FAO182 /SETTING WILL CAUSE AN ERROR ANNOUNCEMENT.
FAO183 JMS FAO570 /THE PERIOD IS NOT A DECIMAL POINT IF THE
JMP FAO110 /NUMBER HAS ALREADY BEEN CONVERTED OR IF
FAO182 LAC CHRTYP /THE MODE OF THE NUMBER IS NOT INTEGER.
SAD C00002 /THE PERIOD IS A DECIMAL POINT IF THE
JMP FAO183 /CHARACTER FOLLOWING IT IS NOT ALPHABETIC.
SAD C00004 /IT MAY BE A DECIMAL POINT IF THE
JMP FAO183 /ALPHABETIC CHARACTER IS AN E OR A D (FOR
SAD C00003 /EXPONENT IDENTIFICATION).
JMP FAO184
DZM UNFNBC /WHEN A DECIMAL POINT IS ENCOUNTERED, THE
LAC S20000 /NUMBER MODE IS TENATIVELY SET TO REAL AND
DAC NAME0 /THE CONVERSION ALGORITHM IS INITIALIZED
JMP FAO080 /TO ACCEPT THE FRACTIONAL DIGITS.
FAO184 LAC CHAR
SAD C00004 /ONE REL. OP. BEGINS WITH
JMP FAO140 /LETTER E (.EQ.).
JMS FNBCHR /WHEN E IS THE NEXT CHARACTER AFTER THE
DZM UNFNBC
LAC C00005 /PERIOD, THE CHARACTER FOLLOWING E IS
DAC CHAR /LOOKED AT TO SEE IF IT IS THE LETTER Q.
LAC XCHAR /IF NOT, THE LETTER E IS ASSUMED TO BE THE
SAD S00121 /START OF THE EXPONENT FIELD.
JMP FAO183 /IF IT IS A Q, THE CONVERSION OF THE
JMP FAO140 /NUMBER IS COMPLETED AND THE LOGIC OP GOT.
/
/ PARENTHESIS (CLOSING) IN THE NUMERIC MODE
/
FAO190 JMS FAO570 /THE CONVERSION IS COMPLETED AND THE
JMP FAO073 /PARENTHESIS LEVEL COUNT UPDATED.
.EJECT
/ NUMERIC, ALPHABETIC (ALL) CHARACTERS IN THE SYMBOLIC MODE
FAO200 JMS FAO620 /ONLY UNCONVERTED ARGUMENTS CONTAIN LETTERS
JMS CAT /SYMBOLIC NAMES ARE CONCATENATED THREE
ISZ TCTR /CHARACTER PER WORD USING A RADIX 50
JMP FAO080 /CONVERSION ALGORITHM.
LAC NAME1 /A SYMBOLIC NAME IS A STRING OF NO MORE
ERN 21X,SZA,EX /THAN 6 ALPHANUMERIC CHARACTERS. THE
LAC NAME2 /CONCATENATED STRINGS OCCUPY ONE OR TWO
DAC NAME1 /WORDS IN THE SYMBOL TABLE. THREE OR LESS
DZM NAME2 /CHARACTERS REQUIRE ONLY ONE WORD.
DZM CHRCTR
K00004 LAW -4 /NAMES CONSISTING OF FOUR TO SIX CHARACTERS
JMP FAO023 /OCCUPY TWO WORDS.
/
/ OPERATOR (*,/,[) IN THE SYMBOLIC MODE
/
FAO220 JMS FAO540 /TEST FOR THE EXPONENTIATION OPERATOR.
/
/ OPERATOR-DELIMETER (+ - , = * / ** C/R) IN THE SYMBOLIC MODE
/
FAO210 JMS FAO590 /SYMBOLIC CONVERSION IS COMPLETED, AND THE
JMP FAO002 /CHARACTER SET AS THE OPERATOR.
/
/ PERIOD (.) IN THE SYMBOLIC MODE
/
FAO230 JMS FAO590 /WITH SYMBOLIC CONVERSION COMPLETED, THE
JMS FNBCHR /PROCESSOR IS INITIALIZED TO FETCH A
JMP FAO110 /LOGICAL OR RELATIONAL OPERATOR.
/
/ @ ] : ; # IN THE SYMBOLIC MODE
/
FAO211 LAC XCHAR /# IS LEGAL, AS USED IN RANDOM
SAD C00035 /ACCESS READ/WRITE
JMP FAO210 /SEMICOLON IS LEGAL..
SAD S00073
SKP
JMP EI23I
LAC TORDER /...AND IT MUST BE IN A COMMON STATEMENT
SAD T40000
JMP FAO210 /IS COMMON, OK
JMP EI23I /ELSE REPORT ERROR
.EJECT
/ PARENTHESIS (OPEN) IN THE SYMBOLIC MODE
FAO240 JMS FAO590 /COMPLETE THE SYMBOL PROCESSING
JMS TSTORD /IS THIS STATEMENT A SPECIFICATION STMT?
JMP FAO241 /NO
LAC* SYMTBC
AND V00000 /NO FUNCTIONS ARE ALLOWED IN
ERN 27V,<SAD U00000>,EV /SPECIFICATION STATEMENTS
FAO248 LAC C00028 /SET OPERATOR TO (F, THE FUNCTION/SUBSCRIPT
DAC OPVALU /OPERATOR
LAC BASEJ
TAD C00001 /BUMP THE FUNCTION/SUBSCRIPT NESTING LEVEL
ERN 03L,<SAD BASEMX>,EL /CHECK FOR OVERFLOW
LAC* BASEJ /START THE NEW LEVEL OFF
ISZ BASEJ /WITH A PRECEDENCE
TAD S01200 /ONE GREATER THAN THAT OF THE PREVIOUS
DAC* BASEJ /NESTING LEVEL
JMP FAO002 /RETURN FROM FARGOP
/
FAO241 LAC* SYMTBC /EXECUTABLE STATEMENT - CHECK
AND Z00000 /IF VARIABLE IS A SCALAR
SNA
JMP FAO242 /YES - REDEFINE IT AS A FUNCTION (MAYBE)
XOR U00000 /IF THE VARIABLE IS AN ARRAY OR FUNCTION,
SPA!SNA
JMP FAO248 /RETURN THE FUNCTION/SUBSCRIPT OPERATOR (F
LAC U00000 /VARIABLE MUST BE A DUMMY SCALAR - REDEFINE
XOR* SYMTW2 /IT AS A FUNCTION BUT SET A FLAG SO THAT
DAC* SYMTW2 /THE TRANSFER VECTOR WILL NOT BE OUTPUT
JMP FAO243
FAO242 LAC NAME1 /BEFORE WE REDEFINE A SCALAR AS A FUNCTION,
ERN 29V,SZA,EV /CHECK IT ISN'T ALREADY DEFINED
LAC TFAO01 /(RKB-073) WAS PREV. OP. ')'
ERN 14S,<SAD C00031>,EX /(RKB-073) ')(' IS ILLEGAL
FAO243 LAC* SYMTBC
AND S77777 /AND OUT THE TYPE BITS
XOR U00000 /REPLACE WITH FUNCTION TYPE
DAC* SYMTBC
JMP FAO248 /GO TO COMMON CODE
/
/
/PARENTHESIS (CLOSING) IN THE SYMBOLIC MODE
FAO250 JMS FAO590 /THE CONVERSION IS COMPLETED AND THE
JMP FAO073 /PARENTHESIS LEVEL COUNT UPDATED.
.EJECT
/ PERIOD (.) IN THE LOGIC OPERATOR MODE
FAO270 LAC LOCTAB /A PERIOD IS THE ONLY LEGAL DELIMETER FOR
DAC TCTR /THE LOGICAL AND RELATIONAL OPERATORS AND
FAO273 LAC* TCTR /THE LOGICAL CONSTANTS .TRUE. AND .FALSE.
SAD NAME2
JMP FAO271 /THE CONCATENATED MNEMONIC IS COMPARED
ISZ TCTR /WITH THE TABLE OF ALLOWABLE OPERATORS AND
LAC TCTR /CONSTANTS.
ERN 19I,<SAD LOCTBM>,EI /ERROR: NAME NOT IN TABLE
JMP FAO273
FAO271 LAC LOCTAB
JMS TWOCMA /THE OPERATOR VALUE OF THE TERM IS A
TAD TCTR /FUNCTION OF ITS POSITION IN THE TABLE.
DAC OPVALU
SZA /THE LOGICAL CONSTANTS .TRUE. AND .FALSE.
SAD C00001 /AND THE UNARY LOGICAL OPERATOR .NOT.
JMP FAO274 /CONNOT BE OBTAINED OTHER THAN AS A FIRST
SAD C00011 /ELEMENT OF THE ARGUMENT-OPERATOR PAIR.
LAC C00001 /IF OPERATOR IS .XOR.,
TAD K00004 /FUDGE TO GET PRECEDENCE=1
SMA!SZA
LAC C00001 /THE PRECEDENCE OF THE LOGICAL OPERATORS IS:
TAD C00004 /.XOR.=1,.OR.=2,.AND.=3,.NOT.=4,.XX.(REL)=5
CLL /THIS IS COMPUTABLE FROM THE OPERATOR VALUE
RTL /EASILY. NOW ROTATE THE PRECEDENCE
RTL /INTO BITS 9-11,
RTL
DAC LEVEL /AND STORE IT
SAD S00400
JMP FAO274
LAC TFAO06
SAD FAOPIM /THE REMAINDER OF THE LOGICAL AND
JMP FAO035 /RELATIONAL OPERATORS MUST OCCUR IN CONTEXT
JMP FAO002 /AS BINARY OPERATORS (I.E. PRECEDED AND
/FOLLOWED BY ARGUMENTS). AN ERROR CONDITION
/EXISTS WHEN THIS IS NOT TRUE.
FAO274 LAC TFAO06 /MAKE SURE THAT .TRUE.,.FALSE. AND .NOT.
ERS 22X,<SAD FAOPIM>,EX /ONLY OCCUR AS UNARY TERMS
JMS FAO500
LAC OPVALU /THE UNARY OPERATOR .NOT. IS HANDLED IN
SAD C00004 /THE SAME MANNER AS THE UNARY MINUS
JMP FAO034 /OPERATOR.
DZM NAME0 /THE LOGIC CONSTANT MNEMONIC IS CONVERTED
LAC OPVALU /TO THE PROPER BINARY REPRESENTATION.
JMS TWOCMA /.TRUE. IS REPRESENTED BY (777777).
DAC S
JMP FAO713 /GO TO COMMON CODE
.EJECT
/
/ ILLEGAL CHARACTER IN THE UNDECIDED MODE
FAO120=FAO090
/ ILLEGAL CHARACTER IN THE NUMERIC MODE
FAO280=FAO090
/
/
/ SUBROUTINE TO TEST FOR EXISTING ARGUMENT
/
FAO500 CAL 0 /TWO ARGUMENTS CANNOT BE WRITTEN BACK-TO-
ERS 14S,<JMS FAO510>,ES /BACK, THEREFORE AN ARG
JMP* FAO500 /IS NOT ALLOWED AFTER A SPECIAL DELIMITER
/
/
/
/ SUBROUTINE TO TEST LAST ELEMENT FOR SPECIAL DELIMETER
/ CALLING SEQUENCE...
/ JMS FAO510
/ JMP NO /LAST ITEM WAS NOT )F
/ NEXT INSTRUCTION /LAST ITEM WAS )F
/
FAO510 CAL 0 /THE FIRST ITEM PROCESSED CANNOT BE AN
LAC TFAO01 /ARGUMENT IF THE LAST ITEM PROCESSED (LAST
SAD C00032 /CALL TO FARGOP) IS ONE OF THE SPECIAL
ISZ FAO510 /DELIMETERS. (ACTUALLY, NOW THERE IS
JMP* FAO510 /ONLY ONE - ")F" )
.EJECT
/ SUBROUTINE TO TEST FOR ** OPERATOR
/
FAO540 CAL 0 /BOTH MULTIPLICATION AND EXPONENTIATION
SAD C00021 /ARE INDICATED BY USING THE ASTERISK (*)
SKP
JMP* FAO540 /CHARACTER. MULTIPLICATION BY ONE (*) AND
JMS FNBCHR /EXPONENTIATION BY TWO (**).
/WHENEVER AN ASTERISK IS ENCOUNTERED, THE
SAD C00042 /CHARACTER FOLLOWING IT IS EXAMINED TO
JMP FAO541 /DETERMINE IF IT IS ALSO AN ASTERISK. IF
DZM UNFNBC /NOT THE CHARACTER IS UNFETCHED AND THE
LAC S00700
DAC LEVEL
JMP* FAO540 /OPERATOR REMAINS AS MULTIPLICATION.
FAO541 LAC S01100 /EXPONENTIATION IS RANKED AS 8.
DAC LEVEL
LAC C00026 /IF IT IS AN ASTERISK, THE EXPONENTIATION
DAC OPVALU /OPERATOR IS SET.
JMP* FAO540
/
/
/
/SUBROUTINE TO MOVE CONVERTED MANTISSA TO BETTER PLACE
/
FAO550 CAL 0 /THE CONVERTED MANTISSA IS MOVED AS THE
LAC LS /SAME STORAGE IS USED FOR THE CONVERSION
DAC NAME2 /OF THE EXPONENT AND THE GENERATION OF
LAC MS /THE POWER NUMBER FOR FRACTIONAL MANTISSAE.
DAC NAME1
JMP* FAO550
/
/
/
/ SUBROUTINE TO CHECK MAGNITUDE OF INTEGER NUMBER
/
FAO560 CAL 0 /ALL NUMBERS ARE CONVERTED AS IF THEY ARE
LAC LS /DOUBLE PRECISION CONSTANTS.
SMA /HOWEVER, CERTAIN NUMBERS
LAC MS /(LIKE EXPONENTS AND HOLLERITH COUNTS)
ERN 06M,SZA,EM /MUST BE POSITIVE INTEGERS
LAC LS /PUT INTEGER VALUE IN AC
JMP* FAO560
.EJECT
/ SUBROUTINE TO COMPLETE CONVERSION OF A NUMERIC ARGUMENT
/
FAO570 CAL 0
LAC TFAO04 /RETURN IS IMMEDIATE WHEN THE NUMBER HAS
SNA /ALREADY BEEN CONVERTED.
JMP* FAO570
LAC NAME0 /NUMBERS ARE INTEGERS, REAL FLOATING POINT.
SNA /OR DOUBLE PRECESION FLATING POINT.
JMP FAO572
SAD S60000
JMP FAO571 /DOUBLE PRECISION OCTAL CONSTANT
XCT FAO131 /FLOATING POINT NUMBERS MAY OR MAY NOT BE
JMP FAO573 /WRITTEN WITH AN EXPONENT FIELD.
LAC TFAO05
ERN 30V,SPA!SNA,EV /ERROR: NO NUMBER AFTER E OR D
LAC PASS2
DAC FAO131 /CLEAR 'STILL IN EXPONENT' FLAG
JMP FAO589
FAO573 JMS FAO550 /REAL NUMBERS WITHOUT EXPONENTS ARE
DZM LS /SUPPLIED WITH AN EXPONENT OF ZERO.
FAO589 LAC LS /FOATING POINT NUMBERS CONSIST OF AN
DAC TFAO04 /EXPONENT (INITIALLY AN EXPONENT OF TEN.(
LAC NAME2 /AND A MANTISSA (INITIALLY AN INTEGER).
DAC LS
LAC NAME1
DAC MS /A REAL OR DOUBLE PRECESION NUMBER IS
TAD NAME2 /REPRESENTED INTERNALLY BY TWO OR THREE
SZA /WORDS RESPECTIVELY. A FLOATING POINT
JMP FAO575 /NUMBER WHOSE MAGNITUDE IS ZERO IS
DZM S /REPRESENTED INTERNALLY BY TWO (OR THREE)
JMP FAO576 /ZERO WORDS.
FAO575 LAC C00035 /THE INITIAL SCALE OF A D.P. INTEGER IS 35.
DAC S /THE MANTISSA IS NORMALIZED TO OBTAIN THE
JMS DNORM /MAXIMUM SIGNIFICANCE FOR THE NUMBER.
LAC TFAO05
SAD C00012
JMP FAO577
LAC TFAO04 /THE CONVERTED EXPONENT IS ADJUSTED TO
JMS TWOCMA /ACCOUNT FOR THE FRACTIONAL DIGITS IN THE
DAC TFAO04 /MANTISSA. (I.E. THE DIGIT COUNT IS
FAO577 LAC TFAO04 /SUBTRACTED FROM THE ALGEBRAIC VALUE OF
TAD TFAO03 /THE INPUTTED TENS EXPONENT.)
DAC TFAO04
SPA /THE MAGNITUDE OF THE ADJUSTED EXPONENT
JMS TWOCMA /IS EXAMINED AND IF IT IS GREATER THAN
TAD K00077 /76 AN ERROR IS ANNOUNCED.
ERN 07M,SMA,EM /ERROR: EXPONENT > 76
LAC TFAO04
DZM TFAO05 /THE CONVERSION OF THE NUMBER IS COMPLETE
SNA /IF THE ADJUSTED EXPONENT IS ZERO. (THE
JMP FAO578 /MANTISSA IS NORMALIZED AND THE TWOS SCALE
SPA /FACTOR IS THE EXPONENT.)
JMP FAO579 /THE ALGEBRAIC SIGN OF THE ADJUSTED
JMS TWOCMA /EXPONENTS DETERMINES WHETHER THE MANTISSA
DAC TFAO05 /IS TO BE MULTIPLIED (+) OR DIVIDED (-) BY
DAC TFAO04 /TEN RAISED TO THE ABSOLUTE VALUE OF THE
LAC S /ADJUSTED EXPONENT.
DAC TFAO03 /WHEN THE EXPONENT IS POSITIVE, THE
LAC C00001 /MANTISSA CAN BE SUCCESSIVELY MULTIPLIED
DAC S /BY TEN WITHOUT ANY ACCURACY LOSS.
JMS FAO550 /HOWEVER, SUCCESSIVE DIVISIONS BY TEN WILL
DZM LS /RESULT IN AN ACCURACY LOSS. TO MINIMIZE
LAC U00000 /THE ACCURACY LOSS WHEN NEGATIVE EXPONENTS
DAC MS /ARE INVOLVED, A NUMBER EQUIVALENT TO THE
FAO579 JMS MOVE /MOVE (MS,LS) TO (TMS,TLS)
JMS DRSHFT /BOTH THE ORIGINAL ACCUMULATOR AND THE
JMS DRSHFT /MULTIPLIER (10) ARE NORMALIZED PRIOR TO
LAC TLS /THE MULTIPLICATION (SHIFT AND ADD)
JMS DADD /THE RIGHT INSTEAD OF LEFT SHIFT KEEPS THE
LAC S /RESULT NORMALIZED WITHIN ONE BINARY PLACE.
TAD C00003 /THE ORIGINAL SCALE IS ADJUSTED TO ACCOUNT
DAC S /FOR THE NORMALIZED 10.
JMS DNORM /THE NUMBER IS MULTIPLIED AS A FRACTION
ISZ TFAO04 /DIVISION PERFORMED. THE POWER NUMBER IS
JMP FAO579 /FORMED BY SUBSTITUTING A NORMALIZED ONE
LAC TFAO05 /FOR THE MANTISSA. THE RESULT OF EACH
SNA /MULTIPLICATION IS NORMALIZED TO MAINTAIN
JMP FAO578 /THE 35 MOST SIGNIFICANT BITS.
LAW -44 /THE NUMBER CONVERSION IS COMPLETE EXCEPT
DAC TCTR /FOR FORMING THE NUMBER IF THE EXPONENT IS
LAC LS /POSITIVE.
JMS TWOCMA /THE DIVISION MUST BE PERFORMED IF THE
DAC TLS /EXPONENT IS NEGATIVE.
LAC MS
CMA!SZL /THE DIVISOR IS NEGATED FOR SUBTRACTION
TAD C00001 /PURPOSES.
DAC TMS
DZM MS /THE QUOTIENT IS INITIALIZED TO ZERO.
DZM LS
LAC S
JMS TWOCMA /THE QUOTIENT EXPONENT IS CALCULATED AND
TAD TFAO03 /STORED. (DIVIDEND EXPONENT MINUS DIVISOR
DAC S /EXPONENT)
FAO583 JMS DLSHFT /DIVISION OCCURS BETWEEN TWO POSITIVE,
SPA /NORMALIZED NUMBERS. THE QUOTIENT WILL
JMP FAO580 /ALSO BE NORMALIZED OR AT MOST GREATER BY
LAC NAME2 /ONE AS THE RESULT OF THE DIVISION MAY BE
TAD TLS /AN OVERSCALED NUMBER.
DAC TFAO06 /THIRTY-SIX QUOTIENT BITS ARE GENERATED TO
GLK /ALLOW FOR THE OVERSCALING. THE QUOTIENT
TAD NAME1 /IS NORMALIZED TO THIRTY-FIVE BITS WHEN
TAD TMS /THIS OCCURS.
SMA /THE DIVISION IS PERFORMED AS SUCCESSIVE
JMP FAO581 /SUBTRACTIONS OF THE DIVISOR ON DECESENDING
LAC NAME2 /POWERS OF TWO OF THE DIVIDEND.
JMP FAO582
FAO581 DAC NAME1
LAC C00001 /A QUOTIENT BIT IS GENERATED EACH TIME THE
XOR LS /DIVIDEND IS EQUAL TO OR LARGER THAN THE
DAC LS /DIVISOR. THE DIVIDEND IS REPLACED WITH ITS
LAC TFAO06 /ADJUSTED VALUE. THE QUOTIENT BITS ARE
FAO582 RCL /GENERATED IN ASCENDING POWERS OF TWO.
DAC NAME2
LAC NAME1 /THE DIVIDEND IS LEFT SHIFTED SO THAT THE
RAL /NEXT SUBTRACTION INVOLVES A LESSER POWER
DAC NAME1 /OF TWO TERM.
ISZ TCTR
JMP FAO583 /THE QUOTIENT IS NOW EITHER NORMALIZED OR
FAO580 JMS DNORM /OVERSHIFTED BY ONE.
FAO578 DZM TMS
LAC S20000 /THE CONVERTED MANTISSA IS ROUNDED AT THE
SAD NAME0 /LEAST SIGNIFICANT BIT. (AT THIS POINT
TAD S00377 /REAL NUMBERS ARE SIGNIFICANT TO 28 BITS
TAD Z60001 /AND DOUBLE PRECISION NUMBERS ARE
JMS DADD /SIGNIFICANT TO 36 BITS.) THE NUMBER IS
JMS DNORM /RE-NORMALIZED IN CASE THE ROUNDING CAUSED
/A CARRY OUT OF THE MOST SIGNIFICANT BIT.
LAC NAME0 /REAL NUMBERS ONLY OCCUPY TWO WORDS IN
SAD S40000 /MEMORY. THE NINE LEAST SIGNIFICANT BITS
JMP FAO585 /OF THE EXPONENT AND THE NINE LEAST
LAC LS /SIGNIFICANT BITS OF THE MANTISSA OCCUPY
AND Z77000 /THE FIRST WORD. THE MOST SIGNIFICANT
DAC LS /SEVENTEEN BITS OF THE NORMALIZED MANTISSA
LAC S /OCCUPY THE SECOND WORD. THE MATISSA IS
AND S00777 /ACCURATE TO 27 BITS (APPROX. 8+ DECIMAL
XOR LS /DIGITS), THE EXP. TO 8 BITS (10**76).
DAC S /DOUBLE PRECISION NUMBERS OCCUPY THREE
FAO585 LAW -2 /WORDS IN MEMORY, WITH THE EXPONENT, THE
AND LS /MOST SIGNIFICANT 17 MANTISSA BITS AND THE
DAC LS /LEAST SIGNIFICANT 17 MANTISSA BITS EACH
LAC SIGN /OCCUPYING ONE WORD. THE MANTISSA IS
SZA!CLA /ACCURATE TO 34 BITS (APPROX. 10+ DEC DIG).
LAC W00000 /THE ARGUMENT SIGN HAVING BEEN DIRECTLY
XOR MS /ASSIMULATED INTO THE ARGUMENT WAS EXAMINED
DAC MS /TO PREVENT THE LOGICAL UNARY OPERATOR
JMS FAO550 /.NOT. FROM BEING APPLIED TO AN ARITH TERM.
JMP FAO576
FAO572 LAC LS
SMA
LAC MS
SZA!CLA /IF THE INTEGER'S MAGNITUDE IS >2**17-1
LAC S60000 /THEN MAKE IT A DOUBLE INTEGER LITERAL
DAC NAME0
FAO571 LAC SIGN
SNA!CLA
JMP FAO598 /SIGN POSITIVE - DON'T NEGATE
LAC LS
JMS TWOCMA
DAC LS
LAC MS /DOUBLE INTEGER 2'S COMPLEMENT NEGATION
CMA
SZL
TAD C00001
DAC MS
FAO598 LAC LS
DAC NAME1 /LOW ORDER INTO LOW ORDER
LAC LS
DAC S /ALSO INTO HIGH ORDER IN CASE ITS AN INTEGER
LAC NAME0
SNA
JMP .+3 /IT IS
LAC MS /ITS NOT - SET HIGH ORDER TO HIGH ORDER
DAC S
FAO576 JMS TSTORD
SNA /CONSTANTS ARE NOT ENTERED INTO THE
JMP FAO588 /CONSTANT TABLE IF THEY APPEAR ON
JMS CONSSE /PRE-EXECUTABLE OR DATA STATEMENTS.
FAO574 XOR U00000 /THE CONSTANTS ADDRESS IN THE CONSTANT
DAC ARG /TABLE PLUS AN INDENTIFICATION CODE ARE
/USED TO FORM THE ARGUMENT.
DZM TFAO04 /THE CONVERSION IS FLAGGED AS COMPLETE AND
DZM SIGN
JMP* FAO570 /RETURN IS MADE TO THE CALLING PROGRAM.
FAO588 LAC NMODE
JMP FAO574 /SET DUMMY ADDRESS
NMODE .DSA NAME0
.EJECT
/ SUBROUTINE TO FORM A SYMBOLIC ARGUMENT
/
FAO590 SYN TFAO05
LAC TFAO04 /RETURN IS IMMEDIATE IF THE SYMBOL HAS
SNA /ALREADY BEEN ENTERED INTO THE SYMBOL
JMP* FAO590 /TABLE. OTHERWISE, THE SYMBOLIC ARGUMENT
JMS FAO600 /IS ENTERED INTO THE SYMBOL TABLE.
JMS SYMBSE /THE JUST ENTERED-PREVIOUSLY ENTERED
LAC SYMTBC /GET SYMTAB POINTER
DAC SYMTBX /SAVE AS LAST REFERENCED SYMBOL FOR DD I/O
LAC T00000 /INDICATOR IS RETAINED FOR FUTURE USE.
XOR SYMTBC /THE ARGUMENT IS FORMED BY COMBINING THE
DAC ARG /ENTRY ADDRESS AND AN INDICATOR IDENTIFYING
DZM TFAO04 /THE ARGUMENT AS SYMBOLIC.
JMP* FAO590
SYMTBX .DSA 0
/
/
/ SUBROUTINE TO SET UP NAME WORDS FOR ENTRY IN THE SYMBOL TABLE
/
FAO600 CAL 0
LAC CHRCTR /SYMBOLS AND STATEMENT NUMBERS ARE ENTERED
SZA /INTO THE SYMBOLTABLE AS 6 CHARACTER NAMES
TAD K00003 /NAMES WHICH ARE LESS THAN
SMA
JMP FAO603
DAC TFAO04 / SIX CHARACTERS IN LENGTH ARE PADDED
DZM CHAR /WITH SPACES TO MAKE UP THE RIGHT NUMBER.
FAO604 JMS CAT
ISZ TFAO04 /THIS BIT OF FUSSING AROUND MAKES LIFE
JMP FAO604 /MORE BEARABLE FOR SYMBOL TABLE SORTS AND
FAO603 LAC NAME1 /WORD ENTRY INTO THE SYMBOL TABLE.
SZA
JMP* FAO600
LAC NAME2
DZM NAME2
DAC NAME1
JMP* FAO600
/
/
/ SUBROUTINE TO ANNOUNCE AN ERROR IF THE ARGUMENT CONVERSION IS FINISHED
/
FAO620 CAL 0
LAC TFAO04 /AN ERROR IS ANNOUNCED IF A DIGIT OR LETTER
ERN 15S,SNA,ES /IS OBTAINED IN THE ARGUMENT MODE
JMP* FAO620 /AFTER THE ARGUMENT HAS BEEN CONVERTED
/BUT AN OPERATOR HAS NOT BEEN FOUND.
.TITLE SYMBOL AND CONSTANT TABLE SEARCH ROUTINES
/ SUBROUTINE TO SEARCH-ENTER NAMES IN THE SYMBOL TABLE
/ CALLING SEQUENCE
/ JMS SYMBSE
/ /NAME JUST ENTERED IF ZERO ACC
/ /NAME PREVIOUSLY ENTERED IF NON-ZERO ACC
SYMBSE CAL 0 /INITIALIZE THE SEARCH ADDRESS TO THE FIRST
ISZ FILFLG
SKP
JMP CMDA1
DZM FILFLG
LAC SYMTB0 /ENTRY IN THE SYMBOL TABLE.
DZM CHRCTR /INITIALIZE RELATIVE POSITION
SBSE01 DAC SYMTBC
ISZ CHRCTR
SAD SYMTBN /THE SEARCH ADDRESS IS COMPARED AGAINST
JMP SBSE02 /THE NEXT ENTRY ADDRESS. IF EQUAL, THE
JMS SETADR /NAME IS NOT IN THE TABLE.
LAC* SYMTW2 /OTHERWISE THE NAME IS COMPARED AGAINST
AND T77777
SAD NAME1 /THE CURRENT SEARCH SYMBOL.
SKP
JMP SBSE04
LAC* SYMT2A
AND T77777 /AND OUT "LOGICAL VAR" FLAG FROM 2D WORD
SAD NAME2
JMP SBSE05
SBSE04 JMS SBSE50 /WHEN THE NAME DOES NOT MATCH THE CURRENT SEARCH SYMBOL
JMP SBSE01 /THE NEXT SYMBOL IS FETCHED
SBSE05 LAC* SYMTBC
AND S60000
DAC NAME0 /THE MODE OF THE FOUND VARIABLE IS
LAC TSMTBN /RETAINED AS THE MODE OF THE CURRENT VAR.
SNA
JMP SBSE06 /THESE DUMMY VARIABLES ARE UNIQUE ONLY
LAC SYMTBC /TO THE CURRENT STATEMENT FUNCTION.
JMS TWOCMA /HOWEVER, THEY DO RETAIN THE SAME MODE
TAD DOTABX /AS THE PERMANENT VARIABLE BY THE SAME
SPA!SNA /NAME.
JMP SBSE03
SBSE06 JMS TSTORD /IF WE ARE IN AN EXECUTABLE STATEMENT
LAC* SYMTBC /AND THIS SYMBOL IS A SIMPLE NON-COMMON
AND Z17777 /VARIABLE OF ANY MODE WHICH HAS NOT YET
SAD S17777 /BEEN REFERENCED IN AN EXECUTABLE
SKP /STATEMENT, THEN MAKE BELIEVE THAT WE
JMP SBSE08 /JUST DEFINED THE SYMBOL. THIS ALLOWS
LAC* SYMTBC /FUNCTIONS TO BE TYPED IN TYPE STATEMENTS.
XOR C00001 /OF COURSE WE MUST NOW INDICATE THAT THE
DAC* SYMTBC /VARIABLE HAS BEEN ACCESSED IN EXECUTABLE
JMP CLACMD /CODE. (THIS CODE ALWAYS FAILS ON PASS 2)
Z17777 .DSA 717777
SBSE08 LAC SYMTBC
JMP SBSE07
SBSE02 LAC TSMTBN /ENTER SYMBOL INTO THE SYMBOL TABLE
SZA
JMP SBSE03
LAC C00007 /WHEN THE NAME IS NOT IN THE TABLE AN
JMS TABOFL /ATTEMPT IS MADE TO ENTER IT.
JMS SETADR /THE NAME IS ORIGINALLY ENTERED AS IF
LAC NAME0 /IT WERE A SIMPLE VARIABLE
XOR S17777 /THE INITIAL DEFINITION OF THE VARIABLE IS
DAC* SYMTBC /SET TO 17777, MEANING UNDEFINED
LAC NAME1 /THE NEXT TWO WORDS OF THE ENTRY
DAC* SYMTW2 /CONTAIN THE RADIX-50 NAME OF THE VARIABLE
LAC NAME2
XOR LOGFLG /THE SECOND NAME WORD ALSO CONTAINS
DAC* SYMT2A /THE "LOGICAL VARIABLE" INDICATOR.
LAC NAME0
JMS SETN /GET THE NUMBER OF WORDS OCCUPIED BY THE
DAC* SYMTW3 /VARIABLE AND PUT IT INTO THE ENTRY
LAC CHRCTR /SET THE VARIABLE TO POINT TO ITSELF AS IT
DAC* SYMTW4 /BELONGS TO NO EQUIVALENCE CLASS YET
DZM* SYMTW5 /ZERO OUT THE SUBSCRIPT ENTRIES FOR THE VARIABLE
DZM* SYMTW6
LAC S17777 /INITIALIZE THE "OFFSET" WORD
DAC* SYMTW7 /TO AN UNDEFINED NUMBER
JMS TSTORD /ARE WE IN THE EXECUTABLE STATEMENTS?
SKP /YES
JMP SBSE12-1 /NO - FINISHED
LAC* SYMTW2 /SET BIT 0 OF THE HIGH-ORDER NAME WORD ON TO
XOR W00000 /INDICATE THAT WORDS AFTER THE NAME WORDS
DAC* SYMTW2 /DO NOT EXIST - SAVES MUCHO TABLE SPACE
LAC* SYMTBC /IF THE FIRST DEFINITION OF THE VARIABLE
XOR C00001 /OCCURS IN AN EXECUTEABLE STATEMENT, DEFINE
DAC* SYMTBC /IT WITH THAT IN MIND
JMS SBSE50 /THE NEXT ENTRY ADDRESS IS UPDATED
SBSE12 DAC SYMTBN /ACCORDINGLY.
CLACMD CLA
SBSE07 DAC NAME1 /THE ACCUMULATOR IS CLEARED AS AN INDICATOR
JMP* SYMBSE /THAT THE NAME WAS JUST ENTERED.
SBSE03 LAC SYMTB0
DAC TCTR
JMS CNSE50 /ERASEABLE DUMMY VARIABLES
LAC NAME2 /(FROM STATEMENT FUNCTIONS)
DAC* TCTR /ARE ENTERED IN FRONT OF THE
JMS CNSE50 /PERMANENT SYMBOL TABLE
LAC NAME1
XOR W00000 /MAKE THIS A SHORT ENTRY
DAC* TCTR
JMS CNSE50
DAC SYMTB0
DAC SYMTBC
LAC NAME0
DAC* TCTR
JMP CLACMD
.EJECT
/ SUBROUTINE TO UPDATE CURRENT SYMBOL ADDRESS TO NEXT ENTRY
/
SBSE50 CAL 0
LAC* SYMTW2 /GET THE HIGH-ORDER NAME WORD
SMA!CLA /IS THE "SHORT ENTRY" BIT ON?
LAC C00005 /NO - ENTRY WAS 8 WORDS LONG
TAD SYMTW3 /YES - ENTRY IS 3 WORDS LONG
JMP* SBSE50
/
/
.EJECT
/ SUBROUTINE TO SEARCH-ENTER CONSTANTS IN THE CONSTANT TABLE
/
CONSSE CAL 0 /INITIALIZE THE SEARCH ADDRESS TO THE FIRST
LAC CONTB0 /ENTRY IN THE CONSTANT TABLE
CNSE05 DAC TCTR /THE CURRENT ENTRY ADDRESS IS RETAINED SO
DAC CONTBC /THAT IT MAY BE RETURNED TO THE CALLING
SAD CONTBN /PROGRAM. WHEN THE CURRENT SEARCH ADDRESS
JMP CNSE02 /IS EQUAL TO THE NEXT ENTRY ADDRESS, THE
LAC* TCTR /CONSTANT IS NOT IN THE TABLE AND MUST BE
AND Z60000 /ENTERED. IF NOT, THE CONSTANT LOCATED AT
XOR NAME0 /THE SEARCH ADDRESS IS COMPARED AGAINST THE INCOMING
SZA /CONSTANT. CONSTANTS MUST AGREE IN MODE AND VALUE
JMP CNSE03 /BEFORE THEY CAN BE CONSIDERED IDENTICAL.
JMS CNSE50 /WITH MODES IDENTICAL, THE SEARCH ADDRESS
LAC* TCTR /IS UPDATED TO THE FIRST CONSTANT WORD.
SAD S /IF THE FIRST WORDS DONT COMPARE, THE
JMP CNSE04 /SEARCH ADDRESS IS UPDATED TO THE NEXT
CNSE03 JMS CNSE51 /ENTRY IN THE CONSTANT TABLE AND THE SEARCH
JMP CNSE05 /CONTINUES.
CNSE04 LAC NAME0 /THE MODE IS EXAMINED FOR INTEGER
AND S60000 /WHEN THE FIRST WORDS COMPARE. THE CONSTANT
SNA /HAS BEEN FOUND IF THE MODE
JMP CNSE08 /IS INTEGER
JMS CNSE50 /WHEN THE MODE IS NOT INTEGER, THE SEARCH ADDRESS
LAC* TCTR /IS BUMPED SO THE 2D WORDS CAN BE COMPARED.
SAD NAME1 /IF THE SECOND CONSTANT WORDS COMPARE
SKP /THE MODE IS EXAMINED TO DETERMINE IF THE
JMP CNSE03 /CONSTANT IS A REAL OR DOUBLE PRECESION
LAC NAME0 /CONSTANT. WHEN THE SECOND WORDS DO NOT
AND S20000 /COMPARE THE NEXT ENTRY IS EXAMINED.
SZA /IF THE CONSTANT IS A REAL CONSTANT, A
JMP CNSE08 /MATCH HAS BEEN FOUND AND EXIT IS IMMEDIATE
JMS CNSE50 /IF THE CONSTANT IS A DOUBLE PRECESION
LAC* TCTR /CONSTANT, THE THIRD CONSTANT WORDS ARE
SAD NAME2 /COMPARED. IF EQUAL, A MATCH IS FOUND. IF
JMP CNSE08 /NOT EQUAL, THE NEXT ENTRY IS EXAMINED.
JMP CNSE03
CNSE02 LAC C00003
JMS TABOFL /BEFORE A NEW CONSTANT IS ENTERED INTO THE
LAC NAME0 /TABLE, IT MUST BE DETERMINED IF THERE IS
DAC* TCTR /ENOUGH ROOM FOR IT. AT THIS POINT (FOR THE
JMS CNSE50 /SAKE OF SIMPLICITY) ALL CONSTANTS ARE
LAC S /ASSUMED TO BE DOUBLE PRECESION. WHEN ROOM
DAC* TCTR /EXISTS, ALL FOUR WORDS OF THE ASSUMED
JMS CNSE50 /DOUBLE PRECESION CONSTANT ARE ENTERED
LAC NAME1 /INTO THE TABLE.
DAC* TCTR
JMS CNSE50
LAC NAME2
DAC* TCTR
JMS CNSE51 /THE NEXT ENTRY ADDRESS IS UPDATED, HOWEVER
DAC CONTBN /ACCORDING TO THE MODE OF THE CONSTANT.
CNSE08 LAC CONTBC /THE ENTRY ADDRESS OF THE CONSTANT IS
JMP* CONSSE /RETURNED TO THE CALLING PROGRAM.
/
/
/
/ SUBROUTINE TO UPDATE THE CONSTANT TABLE SEARCH ADDRESS BY ONE
/
CNSE50 CAL 0 /THE CONSTANT TABLE OCCUPIES THE TOP-HALF
K00001 LAW -1 /OF THE CONSTANT-SYMBOL TABLE.
TAD TCTR /ENTRIES ARE MADE FROM THE TOP DOWN. THERE-
DAC TCTR /FORE THE SEARCH ADDRESS MUST BE NEGATIVELY
ERN 02T,<SAD .FFREE>,ET /ERROR: TOO MANY DUMMY VARS
JMP* CNSE50 /UPDATED.
/
/
/
/ SUBROUTINE TO UPDATE CONSTANT TABLE INTRY ADDRESS
/
CNSE51 CAL 0 /THE CURRENT ENTRY ADDRESS IS UPDATED BY
LAC* CONTBC /THE NUMBER OF WORDS OCCUPIED BY THE ENTRY.
JMS SETN /THAT NUMBER IS A FUNCTION OF THE MODE OF
CMA /THE CURRENT ENTRY.
TAD CONTBC
JMP* CNSE51 /WORDS. THE UPDATED ADDRESS IS RETURNED.
.TITLE MISCELLANEOUS SUBROUTINES
/ SUBROUTINE TO TEST FOR SYMBOL-CONSTANT TABLE OVERFLOW
/ CALLING SEQUENCE...
/ LAC N /N IS THE LENGTH OF THE ENTRY MINUS ONE
/ JMS TABOFL /(THE MINUS ONE IS FOR TWOS COMPLEMENT)
/
TABOFL CAL 0 /THE SYMBOL AND CONSTANT TABLES ARE REALLY
TAD SYMTBN /JUST ONE BIG TABLE. SYMBOLS ARE ENTERED
CMA /FROM THE BOTTOM UP. CONSTANTS ARE ENTERED
TAD CONTBN /FROM THE TOP DOWN.
ERN 03T,SPA,ET /ERROR: SYMBOL AND CONSTANT TABLE MEET
JMP* TABOFL
/
/
/
/
/ SUBROUTINE TO DETERMINE NUMBER OF MACHINE WORDS OCCUPIED BY AN ITEM
/ BASED ON THE MODE OF THE ITEM.
/ CALLING SEQUENCE...
/ LAC MODE /MODE IS CONTAINED IN BITS 3 AND 4
/ JMS SETN
/
SETN CAL 0
JMS RTLAND
SAD C00003 /IS THE MODE DOUBLE INTEGER?
LAC C00001 /DOUBLE INTEGER IS THE SAME AS REAL FOR
TAD C00001 /LENGTH PURPOSES.
JMP* SETN /THE LENGTH IS (CONVENIENTLY) 1+ THE MODE NUMBER
/
/
/
/
/ SUBROUTINE TO CONVERT DECIMAL TO BINARY
/
DECBIN CAL 0
JMS MOVE /(TMS,TLS)=(MS,LS)
JMS DLSHFT
JMS DLSHFT /(MS,LS)=(MS,LS)*4
ERN 10M,SPA!SZL,EM /CHECK FOR OVERFLOW
LAC TLS
JMS DADD /(MS,LS)=(MS,LS)*5
JMS DLSHFT
ERN 09M,SPA!SZL,EM /CHECK FOR OVERFLOW AGAIN
DZM TMS
LAC CHAR /CONVERT INTERNAL REPRESENTATION OF DIGIT
TAD K00029 /TO PURE BINARY CHARACTER (00 TO 11)
JMS DADD /(ACC*10)+DIGIT
ERN 08M,SPA,EM /ERROR: NUMBER > 2**35-1
JMP* DECBIN
.EJECT
/ SUBROUTINE TO CONCATENATE SYMBOLS
/
CAT CAL 0 /SYMBOLS ARE CONCATENATED USING A RADIX 40
LAC C00002 /SCHEME..I.E. NORMAL BASE CONVERSION EXCEPT
JMS SHIFT /THERE ARE 40 ELEMENTS IN THE SYSTEM.
LAC NAME2 /(WORD)*4
TAD NAME2 /(WORD*4)+(WORD*1)
DAC NAME2
LAC C00003
JMS SHIFT
LAC NAME2 /(WORD*5)*8
TAD CHAR
DAC NAME2 /(WORD*40)+CHAR
ISZ CHRCTR /COUNT THE CONCATENATED CHARACTERS.
JMP* CAT
JMP* CAT
/
/
/
/ SUBROUTINE TO DETERMINE IF THE FIRST EXECUTABLE STATEMENT HAS BEEN
/ ENCOUNTERED.
/ CALLING SEQUENCE...
/ JMS TSTORD
/ JMP YES /YES
/
TSTORD CAL 0 /ALL STATEMENTS CONTRIBUTING TO THE
LAC TORDER /SPECIFICATION OF DATA STORAGE HAVE AN
TAD X40000 /ORDER NUMBER LESS THAN 5 . ALL SUCH
SPA /STATEMENTS MUST OCCUR BEFORE THE FIRST
/EXECUTABLE STATEMENT (DATA AND FORMAT
ISZ TSTORD /MUST ALSO OCCUR AFTER SPECIFICATION
JMP* TSTORD /STATEMENTS.
/
/
/
/ SUBROUTINE TO DETERMINE TYPE OF CURRENT SYMBOL TABLE ENTRY
/ CALLING SEQUENCE...
/ JMS SYMTYP /X IS...0 FOR NON-COMMON, 1 FOR COMMON,
/ XOR (X00000) / 2 FOR FUNCTION, 3 FOR DUMMY
/ JMP NO /NOT TYPE TESTED
/ NEXT INSTRUCTION /IS THE TYPE TESTED
/
SYMTYP CAL 0 /THE DESCRIPTION WORD OF THE CURRENT
LAC* SYMTBC /SUMBOL TABLE ENTRY IS FETCHED AND THE
AND V00000 /SYMBOLS TYPE IS ISOLATED.
XCT* SYMTYP /THIS TYPE IS MATCHED AGAINST THAT
ISZ SYMTYP /SPECIFIED BY THE CALLING SEQUENCE.
SNACMD SNA /THE EXIT POINT IS DETERMINED BY THE
ISZ SYMTYP /RESULT OF THE COMPARISON.
JMP* SYMTYP
.EJECT
/ SUBROUTINE TO FETCH STATEMENT NUMBER
/ CALLING SEQUENCE...
/ JMS FETSNO
/ ON RETURN, AC=DEFINITION WORD IF STMT NUMBER FOUND, OTHERWISE -1
/
FETSNO CAL 0 /A STATEMENT NUMBER IS A SYMBOL MADE UP OF
FSNO07 JMS FNBCHR /ALL NUMERIC CHARACTERS. FIVE ARE ALLOWED.
LAC CHRTYP
SAD C00001 /IF THE FIRST CHARACTER IS NOT NUMERIC, NO
JMP FSNO01 /STATEMENT NUMBER HAS BEEN FOUND AND THIS
DZM UNFNBC /FACT IS INDICATED TO THE CALLING PROGRAM
LAW -1 /BY RETURNING WITH A ZERO ACCUMULATOR. THE
JMP* FETSNO /COLUMN COUNT IS RESET TO ALLOW THE CHAR
FSNO01 LAC CHAR /TO BE RE-FETCHED.
SAD C00029 /LEADING ZEROES IN A STATEMENT NUMBER ARE
JMP FSNO07 /IGNORED.
DZM NAME1
LAC C00002
DAC CHRCTR
LAW -2 /INITIALLY THE FIRST NAME WORD IS CLEARED
FSNO06 DAC TCTR /AND THE CHARACTER PUT INTO WORKING STORAGE
LAC CHAR /A MAXIMUM OF TWO MORE CHARACTERS WILL BE
DAC NAME2 /CONCATENATED TO FORM THE FIRST HALF OF THE
/SYMBOL FORM OF A STATEMENT NUMBER.
FSNO05 JMS FNBCHR
LAC CHRTYP
SAD C00001 /THE NEXT NON-DIGIT CHARACTER ENCOUNTERED
JMP FSNO02 /IS INTERPRETED AS THE TERMINAL CHARACTER
JMS FAO600 /OF THE STATEMENT NUMBERS.
LAC NAME1 /ALL STATEMENT NUMBERS ARE ENTERED INTO THE
/SYMBOL TABLE.
TAD DECPNT /A PERIOD IS PLACED IN FRONT OF THE
DAC NAME1 /STATEMENT NUMBER FOR IDENTIFICATION.
LAC V00000
DAC NAME0
JMS SYMBSE /THE SYMBOL IS FLAGGED AS A STATEMENT
LAC* SYMTBC /NUMBER AND EXIT IS MADE WITH THE SYMBOL
JMP* FETSNO /DESCRIPTION IN THE ACCUMULATOR.
FSNO02 ISZ TCTR /A COUNT IS MAINTENED ON THE NUMBER OF
JMP FSNO03 /DIGITS IN THE NUMBER TO PERMIT TWO WORD
LAC NAME1 /CONCATENATION OF THE STATEMENT LABEL.
ERN 07N,SZA,EN /ERROR: STMT NO HAS > 5 DIGITS
LAC NAME2 /WHEN THREE DIGITS HAVE BEEN ENCOUNTERED,
DAC NAME1 /THE FIRST TWO PLUS A PERIOD (ADDED LATER
LAC C00001
DAC CHRCTR
K00003 LAW -3 /IS THE FIRST NAME WORD AND THE LAST THREE
JMP FSNO06 /IS THE SECOND NAME WORD.
FSNO03 JMS CAT /CONCATENATE THE CURRENT CHARACTER AND GO
JMP FSNO05 /FETCH THE NEXT ONE.
.TITLE CHARACTER INPUT SUBROUTINES
/ SUBROUTINE TO FETCH THE NEXT CHARACTER FROM THE CURRENT SOURCE IMAGE
/ CALLING SEQUENCE...
/ JMS FETCHR
/ FETCHR SKIPS IF A C/R IS FETCHED DURING "NO CONTINUATION" MODE
/
FETCHR CAL 0
LAC UNFNBC /A NEW CHARACTER WILL NOT BE FETCHED IF
SZA /THE LAST CHARACTER FETCHED WAS NOT USED.
JMP FTC06
LAC LSTCHR
JMP FTC07 /WHEN THE NEXT CHARACTER TO FETCH IS TO BE
FTC06 LAC ERFLG1 /FOUND IN COLUMN 73, THE CURRENT IMAGE IS
DAC MESSY6+2
LAC COL
SAD S00111 /EXHAUSTED AND A NEW IMAGE MUST BE INPUT.
JMPFT2 JMP FTC02
JMP FTC01
FTC02 LAC CTRLSW /IMAGE CONTINUATION IS NOT ALLOWED DURING
SNA /STATEMENT RECOGNITION.
JMP FTC05 /THEREFORE, A SPECIAL EXIT IS TAKEN WHEN
ISZ FETCHR /THE IMAGE IS EXHAUSTED.
JMP* FETCHR
FTC05 JMS SINPUT /A NEW IMAGE IS INPUT AND EXAMINED TO SEE
JMS FTC500 /IF IT IS A CONTINUATION OF THE LAST ONE.
JMP FTC04 /THE PRESENT STATEMENT IS TERMINATED IF
LAC ERFLG2
XCT PASS
XCT SLIST
DAC MESSY6+2
LAC CHARCR /THE NEW IMAGE IS NOT A CONTINUATION
JMP FTC07
FTC04 JMS SOUTPT /IF THE NEW IMAGE IS A CONTINUATION OF THE
/LAST ONE (COLUMN SIX CONTAINS A CHARACTER
FTC01 JMS SIN500 /OTHER THAN SPACE OR ZERO), THE COLUMN
SAD CHARCR /COUNT IS SET TO THE BEGINING OF THE
FT2CNG JMP FTC02 /STATEMENT FIELD
ISZ COL
FTC07 DAC LSTCHR
DAC UNFNBC /RESET NO FETCH INDICATOR.
AND S00077 /THE INTERNAL REPRESENTATION OF THE
DAC CHAR /CHARACTER IS SENT BACK TO THE CALLER,
LAW -13 /ALONG WITH THE EXTERNAL REPRESENTATION
JMS SHIFT /OF THE CHARACTER (FOR HOLLERITH DATUM
LAC LSTCHR /AND FORMAT STATEMENT PACKING), AND
DAC XCHAR
LAW -6
JMS SHIFT
LAC LSTCHR /ALONG WITH A CODE IDENTIFYING WHAT TYPE
AND C00015 /OF CHARACTER IT IS (NUMERIC,ALPHABETIC,
DAC CHRTYP /OPERATOR, DELIMITER, ETC.)
SAD C00005
LAC S00600 /A PLUS-MINUS OPERATOR IS RANKED AS 6.
SAD C00006
LAC S00700 /A MULTIPLICATION-DIVISION OPERATOR IS
SAD C00013 /RANKED AS 7.
LAC S01200 /THE PARTWORD OPERATOR IS RANKED AS 10.
AND S07700
DAC LEVEL /A NON-OPERATOR/DELIMETER IS RANKED AS 0.
LAC CHRTYP
JMP* FETCHR
.EJECT
/ SUBROUTINE TO FETCH THE NEXT NON-BLANK CHARACTER FROM THE SOURCE IMAGE
/
FNBCHR CAL 0
DZM CTRLSW /(ALLOW IMAGE CONTINUATION)
JMS FETCHR /CHARACTERS ARE FETCHED UNTIL A NON-BLANK
SKP
JMP .+3
SAD C00011 /CHARACTER IS FOUND.
JMP .-4 /BLANK AND SPACE ARE SYNONYMOUS
LAC XCHAR /RETURN CHARACTER TO CALLER
JMP* FNBCHR
/
/
/
/
/ SUBROUTINE TO TEST CURRENT SOURCE IMAGE FOR CONTINUATION
/ CALLING SEQUENCE...
/ JMS FTC500
/ JMP YES
/ XXX NO
/
FTC500 SYN TEMP0
LAC COL06 /A CONTINUATION IMAGE CONTAINS A NON-ZERO
SAD CHARSP /DIGIT IN COLUMN SIX.
JMP FTC501
SAD CHAR0 /SOURCE INPUT HAS ALREADY SET COLUMN SIX
/TO EITHER A NUMBER OR A SPACE
/CONTINUATION IMAGE.
FTC501 ISZ FTC500
JMP* FTC500 /NORMAL IMAGE
.TITLE ARITHMETIC SUBROUTINES (MULTIPLY, SHIFTS, ETC.)
/ SUBROUTINE TO PERFORM SINGLE PRECESION,POSITIVE INTEGER MULTIPLICATION
/ CALLING SEQUENCE...
/ LAC MULTIPLICAND
/ JMS MULT
/ LAC MULTIPLIER
/ RETURN, ANSWER IN AC
MULT CAL 0
DAC MULT01 /MULTIPLICAND
XCT* MULT /LAC OR LAC* MULTIPLIER
CLL
MULCMD MUL
MULT01 XX
DAC MS
LAQCMD LACQ
DAC LS
JMS FAO560 /TEST RESULT .GT.(2**17)-1
ISZ MULT
JMP* MULT
/
/
/
/ SUBROUTINE TO TWOS COMPLEMENT THE ACCUMULATOR
/
TWOCMA SYN SHFCTR
CLL!CMA /A TWOS COMPLEMENT IS A ONES COMPLEMENT
TAD C00001 /PLUS ONE
JMP* TWOCMA
.EJECT
/ SUBROUTINE TO SHIFT ARGUMENT RIGHT OR LEFT N PLACES AND LEAVE IN ACC
/ CALLING SEQUENCE...
/ LAC COUNT /COUNT IS NEG FOR RIGHT, POS FOR LEFT
/ JMS SHIFT / AND ZERO FOR NO SHIFT
/ LAC ARG /MAY BE LAC*
/
SHIFT CAL 0
SNA /IF COUNT IS ZERO, EXIT IS SUCH THAT THE
JMP* SHIFT /ARG IS ACCESSED UPON RETURN
SMA
JMP SHFT01
DAC SHFCTR
LAC SHFT10 /A NEGATIVE COUNT IMPLIES A RIGHT SHIFT
JMP SHFT02
SHFT01 JMS TWOCMA
DAC SHFCTR
LAC SHFT11 /A POSITIVE COUNT IMPLIES A LEFT SHIFT
SHFT02 DAC SHFT03
XCT* SHIFT /FETCH ARGUMENT
SHFT03 NOP /EITHER A RCR OR A RCL
ISZ SHFCTR /COUNT-1
JMP SHFT03
ISZ SHIFT /SKIP PARAMETER UPON EXIT
JMP* SHIFT
/
/
/
/ SUBROUTINE TO NORMALIZE DOUBLE PRECESION ACCUMULATOR
/
DNORM CAL 0 /A NUMBER IS SAID TO BE NORMALIZED WHEN
DNRM02 LAC MS /THE MOST SIGNIFICANT NON-ZERO BIT OF THE
SMA /NUMBER OCCUPIES THE MOST SIGNIFICANT BIT
JMP DNRM01 /OF THE WORD FIELD ASSIGNED TO THE NUMBER.
JMS DRSHFT /THESE HUMBERS ARE NORMALIZED TO BIT 1 OF
ISZ S /THE MOST SIGNIFICANT HALF OF THE DOUBLE
PASS2 OPR /PRECESION NUMBER.
JMP* DNORM /THE ASSOCIATED SCALE FACTOR REPRESENTS THE
DNRM01 AND U00000 /POSITION OF THE LEAST SIGNIFICANT BIT OF
SZA /THE NUMBER (ASSUMING AN INTEGER NUMBER
JMP* DNORM /AND A POSITIVE SCALE FACTOR). A NEGATIVE
JMS DLSHFT /SCALE FACTOR INDICATES A FRACTIONAL
LAW -1 /NUMBER AND ITS MAGNITUDE THE NUMBER OF
TAD S /ZERO BITS BETWEEN THE BINARY POINT AND
DAC S /THE FIRST NON-ZERO BIT OF THE
JMP DNRM02 /FRACTION.
.EJECT
/ SUBROUTINE TO ADD THE TWO DOUBLE PRECISION ACCUMULATORS
/ CALLING SEQUENCE...
/ LAC TLS /OR ANYTHING ELSE (CHAR)
/ JMS DADD
/
DADD CAL 0
CLRLNK CLL /CARRY INDICATOR RESET
TAD LS
DAC LS /ACC + LS TO LS
GLK /IF CARRY FROM LS ADDITION,
TAD TMS /ADD ONE TO MS
TAD MS
DAC MS /A NEGATIVE ACCUMULATOR INDICATES OVERFLOW
JMP* DADD / TO THE CALLING PROGRAM
/
/
/
/ SUBROUTINE TO RIGHT SHIFT THE DOUBLE PRECESION ACCUMULATOR ONE PLACE
/
DRSHFT CAL 0
LAC MS
SHFT10 RCR /MS.RSHFT.(1)
DAC MS /MS17 TO LINK
LAC LS /LINK TO LS0
RAR /LS.RSHFT.(1)
DAC LS
JMP* DRSHFT
/
/
/
/ SUBROUTINE TO LEFT SHIFT THE DOUBLE PRECESION ACCUMULATOR ONE PLACE
/
DLSHFT CAL 0
LAC LS
SHFT11 RCL /LS.LSHFT.(1)
DAC LS /LS0 TO LINK
LAC MS /LINK TO MS17
RAL /MS.LSHFT.(1)
DAC MS /A NON-ZERO LINK OR NEGATIVE ACCUMULATOR
JMP* DLSHFT / INDICATES OVERFLOW TO THE CALLING PROGRAM
.EJECT
/ SUBROUTINE TO MOVE DOUBLE PRECESION ACCUMULATOR TO TEMPORARY STORAGE
/
MOVE CAL 0
LAC MS
DAC TMS /MS TO TMS
LAC LS
DAC TLS /LS TO TLS
JMP* MOVE
/
/
/
/ SUBROUTINE TO SET ADDRESSES OF THE WORDS FORMING THE CURRENT ENTRY IN
/ THE SYMBOL TABLE
/
SETADR CAL 0
LAC SYMTBC /THE ADDRESS OF THE WORDS IN THE CURRENT
TAD C00001 /ENTRY ARE SET UP TO MAKE ACCESSING THEM
DAC SYMTW2 /EASY.
TAD C00001
DAC SYMT2A
TAD C00001
DAC SYMTW3
TAD C00001
DAC SYMTW4 /EQUIVALENCE (COMMON) CLASS LINKAGE
TAD C00001 /ADDRESS (BECOMES ARRAY SIZE)
DAC SYMTW5 /FIRST ARRAY DIMENSION WORD (N*IMAX)
TAD C00001
DAC SYMTW6 /SECOND ARRAY DIMENSION WORD (N*IMAX*JMAX)
TAD C00001
DAC SYMTW7
JMP* SETADR
SYMTW7 .DSA 0
/
/
/
/ SUBROUTINE TO TEMPORARILY SAVE SYMBOL TABLE ENTRY ADDRESSES
/
TSETAD CAL 0
LAC CHRCTR
DAC TRELAD
LAC SYMTBC /THE ADDRESSES OF
DAC TSMTBC / THE FIRST WORD (DESCRIPTION),
LAC SYMTW4
DAC TSMTW4 / THE FOURTH WORD (LINKAGE ADDRESS), AND
LAC SYMTW7
DAC TSMTW7 / THE SEVENTH WORD (RELATIVE POSITION)
JMP* TSETAD /ARE SAVED TEMPORARILY.
.TITLE SOURCE IMAGE INPUT/OUTPUT ROUTINES
/ SUBROUTINE TO INPUT A SOURCE IMAGE
/
SINPUT CAL 0
.IFUND RSX
/ .READ -11,2,SINBFH,32 /READ IN A SOURCE IMAGE
CAL 02767 / DEVICE 3 .. IOPS ALPHA
.DSA 000010 / READ CODE
.DSA SINBFH / INPUT BUFFER ADDRESS (INCLUDES HEADERS)
-44 /BUFFER SIZE IS 36 WORDS
/ .WAIT -11 /WAIT UNTIL THE BUFFER HAS BEEN TRANSFERED
CAL 00767 / DEVICE 3
.DSA 000012 / WAIT CODE
.ENDC
.IFDEF RSX
CAL READ11 /READ FROM INPUT DEVICE
JMS WFEV /WAIT FOR EVENT VARIABLE
LAC (DAT11) /LUN IN CASE OF I/O ERROR
.ENDC
LAC SINBFH
AND C00015
SAD C00005
JMP ENDGEN
SAD C00006
JMP ENDGEN
SINPUX=.
ISZ LINMBR /(RKB-067)
/(RKB-067)
/(RKB-067) DELETED 16 LINES OF %BOSS CONDITIONALIZED CODE. ALSO
/(RKB-067) DELETED THE LABEL 'NOCARY'.
/(RKB-067)
JMS SINP00 /INITIALIZE BUFFER AND FETCH CONTINUATION
LAC TCHAR
SAD CHARCR
JMP SINPUT+1
XOR CHARC
AND Z74000 /COMMENTS ARE INDICATED BY THE CHARACTER C
SZA /IN THE FIRST CHARACTER POSITION.
JMP* SINPUT
JMS SOUTPT /COMMENTS ARE LISTED, BUT NOT PROCESSED.
JMP SINPUT+1
ENDGEN LAC ENDBFR
DAC SINBFH+2
LAC ENDBFR+1
DAC SINBFH+3
.IFDEF RSX
LAC HEADER
DAC SINBFH
.ENDC
JMP SINPUX
HEADER .DSA 2002 /HEADER INFO
ENDBFR .ASCII <11>/END/<15>
.EJECT
/ SUBROUTINE TO FETCH CONTINUATION FIELD AND POSITION COUNTERS TO THE
/ STATEMENT FIELD
/
SINP00 CAL 0
JMS SIN520
LAC C00007
DAC COL
LAW -5
DAC LEVEL /SAVE COLUMN 1 FOR COMMENT TEST
JMS SIN500 /THE STATEMENT NUMBER AND CONTINUATION
DAC TCHAR /FIELDS ARE EXAMINED TO DETERMINE THE
SKP /CONTENTS OF THE CONTINUATION FIELD AND
SINP02 JMS SIN500
SAD CHARSP /ALSO THE WORD AND CHARACTER COUNTER VALUES
JMP SINP03 /FOR THE BEGINNING OF THE STATEMENT FIELD
SAD TABCHR /(NECESSARY BECAUSE OF VARYING INPUT FORMATS)
JMP SINP01 / ANY CHARACTERS THAT ARE NON-BLANK OR NON-
LMQ /TAB AND IN THE FIRST 5 POSITIONS MUST BE
LAC TCHAR /NUMERIC, UNLESS IT IS A COMMENT STATEMENT
SAD CHARC
JMP* SINP00 /(RKB-071) RETURN IF COMMENT LINE
LACQ
AND S01700 /TEST IF IS NUMERIC
SAD S00100
JMP SINP03 /THIS PREVENTS BAD CONTINUATION FROM OCCURING
JMS SOUTPT /OUTPUT THE BAD LINE
ERX 09N,EN
SINP03 ISZ LEVEL
JMP SINP02
JMS SIN500 /COLUMN 6 MUST BE CHECKED HERE FOR A TAB
SAD TABCHR /CHARACTER
JMP SINP01
JMS SIN530
JMP SINP04
SINP01 JMS SIN530 /A TAB CHARACTER INDICATES A SKIP OF THE
JMS SIN500 /REMAINDER OF THE STATEMENT NUMBER FIELD.
DAC LSTCHR
AND S01700
SAD S00100 /THE CONTINUATION FIELD IS ALSO SKIPPED
JMP SINP04 /IF THE CHARACTER FOLLOWING THE TAB IS NOT
DZM UNFNBC /A NUMBER.
ISZ COL
JMP* SINP00
SINP04 LAC* CHAR
DAC COL06 /THE CONTINUATION FIELD (COLUMN SIX) WILL
JMP* SINP00 /POINTERS ARE SET TO THE STATEMENT FIELD.
.EJECT
/ SUBROUTINE TO LIST SOURCE IMAGE
/
SPRINT CAL 0
/(RKB-067) DELETED .IFDEF %BOSS.
LAC SINBFH
TAD S01000 /ADD 1 TO BUFFER WORD COUNT
DAC SINBFH-2
/(RKB-067) 22 LINES DELETED.
LAC (SINBFH) /(RKB-067)
JMS SUB980 /(RKB-067) CONVERT LINE NO. TO DECIMAL.
LAC LINMBR /(RKB-067) ASCII CHARACTERS.
LAC SINBFH+1 /(RKB-067) LOAD RESULTING WORD PAIR.
LMQ /(RKB-067) INTO AC-MQ.
LAC SINBFH /(RKB-067) AND SHIFT MSD OUT,
CLL /(RKB-067) MAKING ROOM FOR ...
LLS 7 /(RKB-067) 4-DIGIT NUMBER,
DAC SINBFH /(RKB-067) PLUS A TAB.
LACQ /(RKB-067)
AAC 22 /(RKB-067)
DAC SINBFH+1 /(RKB-067)
LAW 774000 /(RKB-067) NOW CHECK FOR LEADING LF.
AND SINBFH+2 /(RKB-067) WE NEED TO CHANGE LF ...
SAD (050000) /(RKB-067) TO RUBOUT, SINCE A ...
LAW 774000 /(RKB-067) LF SHUTS OFF LP15, BUT...
LMQ /(RKB-067) A RUBOUT IT HARMLESS TO ALL
LAC SINBFH+2 /(RKB-067) OR IT IN
AND (3777) /(RKB-067)
OMQ /(RKB-067)
DAC SINBFH+2 /(RKB-067) PUT IT BACK
.IFUND RSX
LAC S02766 /USE .DAT -12
XCT LIST
LAC S02775 /USE .DAT -3
DAC SPR.1 /(RKB-067)
.IFUND %NOHDG /(RKB-069)
DAC SPR.3 /(RKB-067)
DAC SPR.4 /(RKB-067)
.ENDC /(RKB-069)
AND S00777
DAC SPR.2 /(RKB-067)
.IFUND %NOHDG /(RKB-069)
JMS SPRHDR /(RKB-067)
.ENDC /(RKB-069)
SPR.1 .WRITE -12,2,SINBFH-2,32 /(RKB-067) PRINT SOURCE IMAGE ON LISTING DEVICE
SPR.2 .WAIT -12 /WAIT UNTIL THE BUFFER HAS BEEN TRANSFERED
.ENDC
.IFDEF RSX
XCT LIST /LISTING WANTED?
SKP /NO
JMP .+4
LAC VERPNT /CHECK TO SEE IF PRINTING WANTED
SNA
JMP SPRXIT /(RKB-070) NO, EXIT
LAC (DAT12) /PICK UP THE LUN FOR THE LISTING DEVICE
XCT LIST /IS IT IN USE?
LAC (DAT3) /NO OUTPUT ON OUTPUT TTY
DAC WR3LUN /SET LUN IN WRITE REQUEST
.IFUND %NOHDG /(RKB-069)
DAC SPR.4 /(RKB-068) AND FOR HEADER LINES...
DAC SPR.6 /(RKB-068) ...
JMS SPRHDR /(RKB-068) PRINT THE HEADING IF NEEDED
.ENDC /(RKB-069)
CAL WRIT12 /DO THE WRITE
JMS WFEV /WAIT FOR THE EVENT VARIABLE
LAC (DAT12) /LUN IN CASE OF I/O ERROR
.ENDC
SPRXIT LAC SINBFH-2 /(RKB-070) RESTORE BUFFER HEADER
TAD Z77000 /BUMP THE BUFFER WORD COUNT BACK DOWN
DAC SINBFH /AND RESTORE THE BUFFER CONTROL WORD
JMP* SPRINT
.IFUND %NOHDG /(RKB-069)
SPRHDR XX /(RKB-066) DETERMINE IF WE SHOULD PRINT HEADER
ISZ LINCNT /(RKB-066) HAS LINE COUNT OVERFLOWED?
JMP* SPRHDR /(RKB-066) NO, EXIT WITHOUT PRINTING
LAW -70 /(RKB-066) YES, NEED TO PRINT, BUT FIRST RESTORE COUNTER
DAC LINCNT /(RKB-066) GOING TO PUT 56 LINES PER PAGE
ISZ PAGCNT /(RKB-066) KICK PAGE NUMBER
LAC PAGCNT /(RKB-066) GET PAGE NUMBER
IDIV /(RKB-066) CONVERT TO DECIMAL
12
AAC 60 /(RKB-066) MAKE IT ASCII
RCL /(RKB-066)
DAC TOF+3 /(RKB-066) BUILD IN HEADER
DIV+1000 /(RKB-066) DIVIDE MQ
12 /(RKB-066)
AAC 60 /(RKB-066)
ALSS 10 /(RKB-066) POSITION IT
XOR TOF+3 /(RKB-066) COMBINE WITH OTHER
DAC TOF+3 /(RKB-066)
LACQ /(RKB-066) GET LAST CHAR
RTR /(RKB-066) THIS ONE IS A LITTLE MESSY
RTR /(RKB-066) AS IT IS THE SPLIT CHAR
XOR TOF+3 /(RKB-066)
DAC TOF+3 /(RKB-066)
GLK /(RKB-066) THIS IS THE SPLIT PART
LMQ /(RKB-066)
LAC TOF+2 /(RKB-066) EVEN THOUGH THE SPLIT PART CAN ONLY BE ONE BIT
OMQ /(RKB-066) IT IS A PAIN
DAC TOF+2 /(RKB-066)
.IFUND RSX /(RKB-067)
SPR.3 .WRITE -12,2,TOF-2,40 /(RKB-067) PRINT THE HEADING
SPR.4 .WRITE -12,2,SPRBLK,4 /(RKB-067) AND ONE BLANK LINE
.ENDC /(RKB-066)
.IFDEF RSX /(RKB-066)
CAL SPR.3 /(RKB-068) PRINT THE HEADER AT TOF
JMS WFEV /(RKB-068) WAIT
LAC (DAT12) /(RKB-068)
CAL SPR.5 /(RKB-068) NOW A BLANK LINE
JMS WFEV /(RKB-068)
LAC (DAT12) /(RKB-068)
.ENDC /(RKB-068)
JMP* SPRHDR /(RKB-066) ALL DONE
SPRBLK 002002 /(RKB-066) A BLANK LINE FOR SPACING AFTER HEADING
0 /(RKB-066)
.ASCII ' '<15> /(RKB-066)
.LOC .-1 /(RKB-066) RECLAIM THAT WASTED WORD
.IFDEF RSX /(RKB-068)
SPR.3 2700 /(RKB-068) WRITE CPB FOR HEADER
EVA /(RKB-068)
SPR.4 XX /(RKB-068)
2 /(RKB-068)
TOF-2 /(RKB-068)
SPR.5 2700 /(RKB-068) WRITE CPB FOR BLANK LINE
EVA /(RKB-068)
SPR.6 XX /(RKB-068)
2 /(RKB-068)
SPRBLK /(RKB-068)
.ENDC /(RKB-068)
.ENDC /(RKB-069)
.EJECT
/ SUBROUTINE TO FETCH AND TRANSLATE A SOURCE CHARACTER
/
SIN500 CAL 0
LAC CHRCNT /TWO WORDS AT A TIME (5 CHARACTERS) ARE
SIN507 SZA /MOVED FROM THE INPUT IMAGE TO A WORKING
JMP SIN501 /CHARACTER BUFFER.
LAC* SINBUF
DAC CHRBUF /THE INDIVIDUAL CHARACTERS ARE EXTRACTED
ISZ SINBUF /FROM THIS CHARACTER BUFFER.
LAC* SINBUF
DAC CHRBF1
SIN506 ISZ SINBUF
LAW -4 /THE FIRST CHARACTER OF THE BUFFER IS
DAC CHRCNT /ALREADY IN POSITION FOR TRANSLATION.
JMP SIN502
SIN501 TAD C00001
DAC CHRCNT /EACH TIME A CHARACTER IS REQUIRED (EXCEPT
JMS SIN510 /THE FIRST OF THE FIVE) THE CHARACTER
SIN502 LAC CHRBUF /BUFFER IS SHIFTED LEFT 7 BITS AND THE CHARACTER
CLL /IN THE HIGH ORDER SEVEN BITS IS LOOKED UP
LRS 13 /IN THE TABLE OF LEGAL ASCII CHARACTERS.
SAD S00175 /THE TABLE IS LINEARIZED BY REPLACING
LAC C00031 /THE CHARACTERS ALTMODE, CARRIAGE RETURN
SAD C00013 /AND TAB BY ARTIFICIAL VALUES.
LAC C00030
SAD C00010
JMP SIN500+1 /LINE FEEDS ARE IGNORED
SAD C00009
LAC C00029
TAD PSTABL
DAC CHAR
LAC* CHAR
XOR CHRBUF /IF THE HIGH ORDER 7 BITS OF THE INDEXED ENTRY
AND Z74000 /MATCH THOSE OF THE INPUT BUFFER,
SZA /THE CHARACTER IS LEGAL
JMP SIN500+1
LAC* CHAR
JMP* SIN500
PSTABL .DSA TABCHR-35
.EJECT
/ SUBROUTINE TO SHIFT CHARACTER BUFFER LEFT SEVEN PLACES
/
SIN510 CAL 0
LAC CHRBF1
LMQ /THE TWO WORD CHARACTER BUFFER IS
LAC CHRBUF /SHIFTED LEFT 7 SPACES
CLL
LLS 7
DAC CHRBUF
LACQ
DAC CHRBF1
LAC CHRBUF /LEFT MOST CHARACTER IS LEFT ADJ IN AC ON RETURN
JMP* SIN510
/
/
/
/ SUBROUTINE TO INITIALIZE SOURCE IMAGE WORD AND CHARACTER COUNTERS
/
SIN520 CAL 0
LAC SINBF0 /INITIALIZE...
DAC SINBUF / WORD COUNT TO FIRST BUFFER WORD.
DZM CHRCNT / CHARACTER COUNT TO BEGIN WITH A NEW
LAC CHARSP / SET OF WORDS.
DAC COL06 / SPACE CHARACTER TO COLUMN SIX.
DZM COL / COLUMN NUMBER
JMP* SIN520
/
/
/
/ SUBROUTINE TO SAVE SOURCE IMAGE WORD AND CHARACTER COUNTERS
/
SIN530 CAL 0
LAC SINBUF /SAVE...
DAC TSINBF / BUFFER WORD ADDRESS
LAC CHRCNT
DAC TCHCNT / CHARACTER COUNTER
LAC CHRBUF
DAC TCHBUF / CHARACTER BUFFER
LAC CHRBF1
DAC TCHBF1 / CHARACTER BUFFER
LAC COL
DAC KOL / COLUMN NUMBER
JMP* SIN530
.EJECT
/ SUBROUTINE TO RESTORE SAVED SOURCE IMAGE WORD AND CHARACTER COUNTERS
/
SIN540 CAL 0
LAC TSINBF /RESTORE...
DAC SINBUF / BUFFER WORD ADDRESS
LAC TCHCNT
DAC CHRCNT / CHARACTER COUNTER
LAC TCHBUF
DAC CHRBUF / CHARACTER BUFFER
LAC TCHBF1
DAC CHRBF1 / CHARACTER BUFFER
LAC KOL
DAC COL / COLUMN NUMBER
JMP* SIN540
/
/
/
/ SUBROUTINE TO OUTPUT SOURCE IMAGE
/
SOUTPT CAL 0
SLIST SKP /THE SOURCE IMAGE IS LISTED UNLESS NO LIST
JMP* SOUTPT /IS SPECIFICALLY REQUESTED BY THE USER.
XCT PASS
JMS SPRINT /THE SOURCE LISTING IS PRODUCED DURING
JMP* SOUTPT /PASS 2 ONLY.
.TITLE ERROR ROUTINES
/ERROR ENTRIES
ERRORN 0 /GIVE ERROR IF TEST DOES NOT SKIP
DAC ERRAC /SAVE AC
LAC ERRORN /SAVE EXIT AND ARG. POINTER
DAC ERRORS
LAC* ERRORN /FETCH TEST INSTRUCTION TO AVOID DOUBLE EXCT.
DAC .+2
LAC ERRAC /RESTORE AC
XX /TEST INSTRUCTION
JMP EROR1
EROR2 ISZ ERRORS /NO ERROR
ISZ ERRORS
JMP* ERRORS
ERRORS 0
DAC ERRAC
LAC* ERRORS
DAC .+2
LAC ERRAC
XX /TEST INSTRUCTION
JMP EROR2
EROR1 ISZ ERRORS /ERROR
LAC* ERRORS
DAC ERRAC
JMS ERROR1
ERRAC XX /ERROR MESSAGE AND AC STORE
LAC EXPDIR /SPECIAL SWITCH FOR GEN OF INDIRECT ADDRESSES TO
DAC CALLSW /ARRAY IN SUB. AND FUNC. CALLS IS SET TO DEFAULT.
LAC PROCAD
SAD K00001 /IF THIS IS THE END STATEMENT, EXIT TO
JMP PASS /TERMINATE THE PASS, OTHERWISE EXIT TO
JMP EREXIT /FETCH THE NEXT SOURCE IMAGE.
/
/
/ SUBROUTINE TO ANNOUNCE AN ERROR
/
ERROR1 SYN CONTBC
LAC* ERROR1
DAC MESSY6+1
ISZ ERROR1
ISZ FILFLG
SKP
.IFUND RSX
JMP RSTRT /CAN NOT OUTPUT ERROR MESSAGE
.ENDC
.IFDEF RSX
JMP CMDERR /COMAND ERROR
.ENDC
LAC PASS2 /BINARY OUTPUT IS TERMINATED
DAC OBINRY
XCT PASS /ALWAYS LIST IN PASS 1
XCT SLIST /LIST IN PASS 2 IF NO SOURCE LIST
JMS SPRINT
.IFUND RSX
LAC S02766 /USE .DAT -12
XCT LIST
LAC S02775 /USE .DAT -3
DAC S990CL
AND S00777
DAC ERWAIT
.ENDC
.IFDEF RSX
LAC (DAT12) /PRINT ERROR MESSAGE ON
XCT LIST /LUN 12 IF LISTING DEVICE IS OPEN
LAC (DAT3) /NOT OPEN USE OUTPUT TTY
DAC S990CL /SET IN LUN
.ENDC
.IFUND %NOEOC /(RKB-069)
ISZ ERRCNT /(RKB-067) UP ERROR COUNT
.ENDC /(RKB-069)
.IFUND %NOHDG /(RKB-069)
JMS SPRHDR /(RKB-067) PRINT HEADING, IF NEEDED.
.ENDC /(RKB-069)
JMS SUB990 /PRINT ERROR MSG
MESSY6-2
.IFUND RSX
ERWAIT CAL
12
.ENDC
.IFDEF RSX
JMS WFEV /WAIT FOR EVENT VARIABLE TO BE SET
LAC S990CL /LUN IN CASE OF I/O ERROR
.ENDC
JMP* ERROR1
.IFUND %NOEOC /(RKB-069)
ERRCNT 0 /(RKB-067)
.ENDC /(RKB-069)
.TITLE BINARY OUTPUT AND LISTING GENERATION ROUTINES
/ SUBROUTINE TO OUTPUT BINARY OBJECT CODE
/ CALLING SEQUENCE...
/ LAC DATA WORD
/ JMS BINOUT
/ XOR LOADER CODE
/
BINOUT CAL 0
BINO05 ISZ BINBUF /THE DATA STORE ADDRESS IS UPDATED AND THE
DAC* BINBUF /DATA WORD IS STORED IN THE OUTPUT BUFFER
LAC C00006 /(3 DATA WORDS FOR EVERY CODE WORD)
JMS SHIFT
LAC* CODEWD /THE LOADER CODE WORD IS MERGED INTO THE
XCT* BINOUT /OUTPUT BUFFER (3 LOADER CODES PER WORD).
DAC* CODEWD
AND S00077 /THE LODER CODE IS EXAMINED TO DETERMINE
TAD LDRTAB /IF THE CORRESPONDING DATA SHOULD BE LISTED
DAC .+3
BINO06 JMS OBJ500 /INITIALIZE LISTING BUFFER
LAC* BINBUF
JMP
.EJECT
/ TABLE OF ADDRESSES OF OBJECT CODE LISTING ROUTINES
/
LDRTAB JMP LDRTAB /CODE TYPE
JMP BINO01 /01 PROGRAM SIZE
JMP OBJ020 /02 LOAD ADDRESS
JMP OBJ030 /03 RELOCATABLE INSTRUCTION
JMP OBJ040 /04 ABSOLUTE INSTRUCTION, CONSTANT
JMP OBJ050 /05 RELOCATABLE VECTOR
JMP OBJ060 /06 DATA STORAGE BLOCK
JMP BINO01 /07 SYMBOL - FIRST WORD
JMP BINO01 /08 SYMBOL - SECOND WORD
JMP BINO01 /09 VIRTUAL GLOBAL SYMBOL DEFINITION
JMP BINO01 /10 INTERNAL GLOBAL SYMBOL DEFINITION
JMP BINO01 /11 BLOCK DATA DECLARATION
JMP BINO01 /12 COMMON BLOCK DEFINITION
JMP BINO01 /13 COMMON SYMBOL DEFINITION
JMP BINO01 /14 COMMON SYMBOL REFERENCE DEFINITION
JMP OBJ150 /15 DATA INITIALIZATION CONSTANT-WORD 1
JMP OBJ171 /16 DATA INITIALIZATION CONSTANT-WORD 2
JMP OBJ171 /17 DATA INITIALIZATION CONSTANT-WORD 3
JMP OBJ180 /18 DATA INITIALIZATION CONSTANT-DEFINIT
JMP BINO01 /19 INTERNAL SYMBOL DEFINITION
JMP OBJ200 /20 STRING CODE - REFERENCE ADDRESS
JMP OBJ210 /21 STRING CODE - DEFINITION
JMP BINO01 /22 INPUT/OUTPUT DEVICE ROUTINE REQUEST
JMP BINO01 /23 END
/
/
/
.IFDEF %FPP
OBJ020 LAC C00042
JMS OBJ510
LAC* BINBUF
JMS OBJ640
JMP OBJ037 /PRINT "*ORIGIN"
.ENDC
.EJECT
/ ROUTINE TO LIST RELOCATABLE INSTRUCTIONS
/
OBJ030 JMS OBJ530 /OUTPUT PROGRAM COUNTER.
JMP OBJ036 /EXIT IF PASS 1 OR NO LISTING
LAC OBJ400
DAC OBJB01
LAC* BINBUF /TRANSLATE OCTAL OPCODE TO ITS
AND Z40000 /MNEMONIC COUNTERPART
OBJ031 SAD* OBJB01
JMP OBJ032
ISZ OBJB01
ISZ OBJB01
JMP OBJ031
OBJ032 ISZ OBJB01
LAC* OBJB01
JMS OBJ580 /PACK MNEMONIC INTO THE OUTPUT BUFFER.
LAC* BINBUF
AND S20000
SZA /AN ASTERISK WILL FOLLOW THE MNEMONIC IF
LAC C00010 /THE MEMORY REFERENCE IS INDIRECT,
TAD S00040 /THERWISE A SPACE WILL FOLLOW.
JMS OBJ510
JMS OBJ630 /FORMAT A SPACE BEFORE THE ADDRESS FIELD.
LAC* BINBUF
JMS FAKE
XOR* SYMTBC
AND S17777 /THE ADDRESS FIELD IS PRINTED AS EITHER
SNA /A SYMBOLIC REFERENCE, A PROGRAM ADDRESS,
JMP OBJ033 /OR AS AN UNDEFINED STRING ADDRESS.
LAC* BINBUF
AND S17777
SAD PC
SKP
JMP OBJ035
OBJ034 LAC C00036 /A STRING ADDRESS IS OUTPUT AS $NNNNN
JMS OBJ510 /WHERE NNNNN IS THE PROGRAM COUNTER
LAC PC
OBJ035 JMS OBJ640 /A PROGRAM ADDRESS IS OUTPUT AS NNNNN
JMP OBJ036
OBJ033 LAC SYMTBC
AND S77777
JMS TWOCMA
TAD SYMTBN
SMA
JMP OBJ036-1
OBJ038 JMS FAKE
LAC* SYMTBC
SPA
JMP OBJ03A /RELOC. LITERAL
JMS SETN
JMS TWOCMA
DAC NAME0
LAC S00050
JMS OBJ510
OBJ039 LAC SYMTBC
TAD K00001
DAC SYMTBC
JMS FAKE
LAC* SYMTBC
JMS OBJ650 /OUTPUT LITERAL
ISZ NAME0
JMP OBJ039
JMP OBJ036
OBJ03A LAC SYMTBC
TAD K00001
DAC SYMTBC
LAC* SYMTBC /GET POINTER TO REAL SYMTAB ENTRY
DAC SYMTBC
LAC S00050
JMS OBJ510 /OUTPUT OPEN PAREN AND SYMBOL NAME
JMS OBJ550 /OUTPUT SYMBOL NAME
OBJ036 JMS INCRPC
TAD C00001 /INCREMENT PROGRAM COUNTER BY ONE.
OBJ037 XCT PASS
OLIST SKP /OBJECT CODE IS PRINTED WHEN REQUESTED AND
JMP BINO01 /DURING PASS 2 ONLY.
JMS OBJ520
.EJECT
/ BINARY BUFFER POINTER UPDATE
/
.IFUND %FPP
OBJ020=.
.ENDC
/
BINO01 JMS SIN540
ISZ WRDCTR
JMP BINO02
XCT PASS /BINARY CODE IS NOT OUTPUT IF AN ERROR HAS
OBINRY SKP /OCCURED OR IF THE USER REQUESTED NONE, OR
JMP BINO03 /IF IT IS PASS 1.
.IFUND RSX
/ .WRITE 0,-13,BINBFH,50 /WRITE THE BINARY CODE TO THE OUTPUT DEVICE
CAL 765 / DEVICE 5 .. IOPS BINARY
.DSA 000011 / WRITE CODE
.DSA BINBFH / BINARY CODE BUFFER ADDRESS
Z77577 .DSA 777577 / 50 WORDS OF OUTPUT
/ .WAIT -13 /WAIT UNTIL BUFFER HAS BEEN TRANSFERRED
CAL 00765 / DEVICE 5
.DSA 000012 / WAIT CODE
.ENDC
.IFDEF RSX
CAL WRIT13 /WRITE BINARY FILE
JMS WFEV /WAIT FOR EVENT VARIABLE TO BE SET
LAC (DAT13) /LUN IN CASE OF I/O ERROR
.ENDC
BINO03 JMS BIN500 /INITIALIZE BINARY BUFFER AND COUNTERS.
JMP* BINOUT
BINO02 ISZ CODCTR
SKP
JMS BIN510 /INITIALIZE FOR NEXT LOADER CODE GROUP.
LAC C00023
XCT* BINOUT
SZA /THE BUFFER IS FILLED AND WRITTEN WHEN
JMP* BINOUT /THE END CODE IS ENCOUNTERED.
JMP BINO05
.EJECT
/ ROUTINE TO LIST ABSOLUTE INSTRUCTIONS AND CONSTANTS
/
OBJ040 JMS OBJ530 /FORMAT PROGRAM COUNTER
JMP OBJ036 /EXIT IF PASS 1 OR NO LISTING
.IFDEF %FPP
LAC* ABSBIN
SAD FPPTST /IS THIS A FLOATING INSTRUCTION
JMS OBJ554 /YES OUTPUT IT IN SYMBOLIC IF TABLE HAS IT
SKP /EITHER NOT FLOATING INSTRUCTION OR
/IT IS NOT IN THE TABLE
JMP OBJ036 /OUTPUT BUFFER AND UPDATE PC
.ENDC
LAC* ABSBIN /IS THIS A CONSTANT
SAD FPPTST
JMP OBJ041 /YES
LAC* BINBUF
JMS OBJ610
SAD* BINBUF
SKP /WHEN THE COMMAND HAS BEEN FORMATTED FOR
JMP OBJ036 /OUTPUT, THE PROGRAM COUNTER IS UPDATED.
AND Z67777
OBJ044 DAC OBJB03 /ABSOLUTE COMMANDS MAY BE MICRO-CODED.
JMS OBJ610
SAD OBJB03 /THE COMPILER GENERATES COMBINATIONS OF...
JMP OBJ043 / SPA OR SMA
LAC S00041 / QNA OR SZA
JMS OBJ510 / CLA
LAC CLAMNE
JMS OBJ580
JMP OBJ036
OBJ043 AND Z77577
DAC OBJ620
JMS OBJ610
SAD OBJ620 /IF WE CAN'T MAKE HEADS OR TAILS OF THE WORD
JMP OBJ041 /SIMPLY OUTPUT IT AS A .DSA
LAC S00041
JMS OBJ510 /OUTPUT ! CHARACTER.
LAC OBJB03
AND Z77677
JMP OBJ044
OBJ041 JMS OBJ620 /OUTPUT .DSA
LAC DSAMNE
LAC* BINBUF
JMS OBJ650 /OUTPUT CONSTANT
JMP OBJ036 /INCREMENT PC AND OUTPUT BUFFER
.EJECT
/ ROUTINE TO LIST RELOCATABLE VECTORS
/
OBJ050 JMS OBJ530 /FORMAT PROGRAM COUNTER
JMP OBJ036 /EXIT IF PASS 1 OR NO LISTING
JMS OBJ620 /FORMAT .DSA
LAC DSAMNE
LAC OBJB04
SNA /VECTORS ARE EITHER FUNCTION PARAMETER
JMP OBJ051 /ADDRESSES OR TRANSFER VECTORS FOR
DAC SYMTBC
AND Z00000 /EXTERNAL VARIABLES
SAD U00000 /THE ADDRESS OF A CONSTANT PARAMETER IS
JMP OBJ038 /OUTPUT.
SAD W00000
JMP OBJ034 /FORMAT STRING ADDRESS
JMS SETADR
OBJ051 LAC* BINBUF /SYMBOLIC VECTORS MAY REPRESENT
AND Z00000 /DIRECT OR INDIRECT PARAMETER ADDRESSES
SNA /WITH OR WITHOUT MODE BITS
JMP OBJ033
JMS OBJ650 /OUTPUT N00000
LAC S00053 / +
JMS OBJ510
JMP OBJ033 / SYMBOL NAME
/
/
/
/ ROUTINE TO LIST BLOCK STORAGE
/
OBJ060 JMS OBJ530 /FORMAT-PROGRAM COUNTER
JMP OBJ061 /EXIT IF PASS 1 OR NO LISTING
JMS OBJ620
LAC BLKMNE /FORMAT .BLK
LAC* BINBUF
JMS OBJ650 /FORMAT DATA WORD
OBJ061 JMS INCRPC
TAD* BINBUF /UPDATE PC BY DATA WORD
JMP OBJ037
.EJECT
/ ROUTINE TO LIST DATA INITIALIZATION CONSTANTS
/
OBJ150 DZM ARG
OBJ171 LAC ARG
TAD K00001
DAC ARG /COUNT CONSTANTS
JMP BINO01
OBJ180 JMS OBJ640 /FORMAT CONSTANT ADDRESS
LAC S
JMS OBJ650 /FORMAT FIRST CONSTANT
ISZ ARG
SKP
JMP OBJ037 /OUPUT OBJECT IMAGE
LAC NAME1
JMS OBJ650 /FORMAT SECOND CONSTANT
ISZ ARG
SKP
JMP OBJ037 /OUTPUT OBJECT IMAGE
LAC NAME2
JMS OBJ650 /FORMAT THIRD CONSTANT, AND
JMP OBJ037 /OUTPUT OBJECT IMAGE
/
/
/
/ ROUTINE TO LIST STRING DEFINITIONS
/
OBJ200 DAC OBJB01 /SAVE REFERENCE ADDRESS
JMP BINO01
OBJ210 LAC C00036
JMS OBJ510 /OUTPUT PERIOD
LAC OBJB01
JMS OBJ640 /OUTPUT REFERENCE ADDRESS
LAC S00075
JMS OBJ510 /OUTPUT =
JMS OBJ630 /OUTPUT SPACE
LAC* BINBUF /OUTPUT DEFINITION ADDRESS
JMS OBJ640 /...I.E...
JMP OBJ037 / .REFAD = DEFAD
.EJECT
/ SUBROUTINE TO INITIALIZE BINARY OUTPUT BUFFER
/
BIN500 CAL 0 /INITIALIZE...
LAW -22
DAC WRDCTR / WORD COUNTER
LAC BINBF0
DAC BINBUF / BUFFER STARTING ADDRESS
JMS BIN510 / BUFFER COUNTERS
JMP* BIN500
/
/ SUBROUTINE TO UPDATE BINARY BUFFER COUNTERS
/
BIN510 CAL 0 /INITIALIZE...
ISZ BINBUF / DATA WORD STORAGE ADDRESS
LAC BINBUF
DAC CODEWD / LOADER CODE WORD STORAGE ADDRESS
LAW -3
DAC CODCTR / LOADER CODE GROUPING COUNTER
JMP* BIN510
/
/ SUBROUTINE TO OUTPUT SYMBOL NAME
/
OSYMBL CAL 0
LAC* SYMT2A /GET THE SECOND NAME WORD
AND T77777
SZA!CLL /IF IT IS NON-ZERO
CML /WE WANT TO SET BIT 0
LAC* SYMTW2 /OF THE FIRST WORD ON
AND T77777
SZL
XOR W00000 /THE FIRST WORD OF THE NAME (CHARACTERS
JMS BINOUT /01 THROUGH 03) ARE OUTPUT AS LOADER CODE
XOR C00007 /07.
LAC* SYMT2A /THE SECOND WORD OF THE NAME (CHARACTERS
AND T77777
SZA
JMS BINOUT /04 THROUGH 06) ARE OUTPUT AS LOADER CODE
XOR C00008 /08.
JMP* OSYMBL
.EJECT
/ SUBROUTINE TO INITIALIZE OBJECT CODE LISTING OUTPUT BUFFER
/
OBJ500 CAL 0 /INITIALIZE...
JMS SIN530 /SAVE CHARACTER BUFFERS AND POINTERS
LAC S01502
DAC OBJBFH / OUTPUT BUFFER SIZE
LAC OBJBF0
DAC SINBUF / OUTPUT BUFFER STARTING ADDRESS
LAW -4
DAC CHRCNT / CHARACTER COUNT
LAC S00040
DAC CHRBF1 / CONTROL CHARACTER AND SPACE CHARACTER
JMP* OBJ500 / TO THE OUTPUT BUFFER.
/
/
/
/ SUBROUTINE TO PACK CHARACTER INTO THE OBJECT LISTING OUTPUT BUFFER
/ CALLING SEQUENCE...
/ LAC CHARACTER /ASCIT CODE
/ JMS OBJ510
/
OBJ510 CAL 0
DAC TCHAR
JMS SIN510 /THE CHARACTER BUFFER IS SHIFTED LEFT
LAC CHRBF1 /SEVEN PLACES AND THE CHARACTER IS MERGED
XOR TCHAR /INTO THE BUFFER.
DAC CHRBF1
ISZ CHRCNT
JMP* OBJ510
LAC CHRBF1 /WHEN THE CHARACTER BUFFER IS FULL
RCLCMD RCL /(FIVE CHARACTERS), IT IS LEFT JUSTIFIED
LAC CHRBUF /AND ENTERED INTO THE OUTPUT BUFFER.
RAL
DAC* SINBUF
ISZ SINBUF
LAC CHRBF1
RCL
DAC* SINBUF
ISZ SINBUF /THE OUTPUF BUFFER ADDRESS AND CHARACTER
LAW -5 /COUNTS ARE UPDATED FOR THE NEXT SET OF
DAC CHRCNT /CHARACTERS.
LAC S01000
TAD OBJBFH /THE OUTPUT BUFFER SIZE IS UPDATED
DAC OBJBFH /ACCORDINGLY.
JMP* OBJ510
.EJECT
/ SUBROUTINE TO OUTPUT OBJECT LISTING OUTPUT BUFFER
/
OBJ520 CAL 0
OBJ522 LAW -1
SAD CHRCNT /SPACES ARE USED TO PAD OUT THE CURRENT
JMP OBJ521 /CHARACTER BUFFER AND FORCE ITS ENTRY
LAC S00040 /INTO THE OUTPUT BUFFER.
JMS OBJ510
JMP OBJ522
OBJ521 LAC C00013 /A CARRIAGE RETURN IS THE LAST CHARACTER
JMS OBJ510 /PACKED INTO THE OUTPUT BUFFER.
.IFUND %NOHDG /(RKB-069)
JMS SPRHDR /(RKB-066) SHOULD WE PRINT HEADING?
.ENDC /(RKB-069)
.IFUND RSX
/ .WRITE 2,-12,OBJBFH,32 /WRITE OUTPUT BUFFER TO LISTING DEVICE
CAL 02766 / DEVICE 4 .. IOPS ALFA (517 ASCIT)
.DSA 000011 / WRITE CODE
.DSA OBJBFH / BUFFER ADDRESS
.ENDC
.IFUND RSX
Z67777 .DSA 767777 / BUFFER LENGTH
.ENDC
.IFUND RSX
/ .WAIT -12 /WAIT UNTIL THE BUFFER HAS BEEN TRANSFERRED
CAL 00766 / DEVICE 4
.DSA 000012 / WAIT CODE
.ENDC
.IFDEF RSX
CAL WRIA12 /WRITE ON LISTING DEVICE
JMS WFEV /WAIT FOR EVENT VARIABLE
LAC (DAT12) /LUN IN CASE OF I/O ERROR
.ENDC
JMS SIN540 /RESTORE CHARACTER BUFFER AND POINTERS
JMP* OBJ520
/
/
/
/ SUBROUTINE TO PACK PROGRAM COUNTER FOR OBJECT CODE LISTING
/ CALLING SEQUENCE...
/ JMS OBJ530
/ JMP PASS 1 OR NO LISTING
/
OBJ530 CAL 0
XCT PASS
XCT OLIST
JMP* OBJ530
ISZ OBJ530 /BUMP RETURN POINTER IF LISTING IN PROGRESS
LAC PC /THE PROGRAM COUNTER IS LISTED FOR ALL
JMS OBJ640 /INTERMEDIATE INSTRUCTIONS AND NON-LABELED
JMS OBJ630 /PACK AN EXTRA SPACE.
JMP* OBJ530
.EJECT
/ SUBROUTINE TO PACK N OCTAL DIGITS FOR OBJECT CODE LISTING
/ CALLING SEQUENCE...
/ LAC OCTAL WORD
/ JMS OBJ540
/ LAC -N
/
OBJ540 CAL 0
DAC OBJB01 /SAVE OCTAL WORD
XCT* OBJ540
TAD OBJ545
OBJ541 DAC OBJB02 /SET ADDRESS OF SHIFT VALUE
LAC* OBJB02
JMS SHIFT
LAC OBJB01 /SHIFT DIGIT TO LEAST SIGNIFICANT POSITION
AND C00007 /AND CONVERT IT TO ASCIT CODE.
TAD C00048
JMS OBJ510 /PACK CHARACTER IN OUTPUT BUFFER.
LAC OBJB02
TAD C00001
SAD OBJ545
JMP* OBJ540
JMP OBJ541
/
/ TABLE OF RIGHT SHIFT VALUES FOR OCTAL SHIFTING
/
K00015 .DSA -000017 /15 6 DIGITS
K00012 .DSA -000014 /12 5 DIGITS
K00009 .DSA -000011 /09 4 DIGITS
K00006 .DSA -000006 /06 3 DIGITS
.DSA -000003 /03 2 DIGITS
C00000 .DSA 0000000 /00 1 DIGIT
OBJ545 .DSA OBJ545
LINCNT -1 /(RKB-066) LINES LEFT ON THIS PAGE
PAGCNT 0 /(RKB-066) CURRENT PAGE NUMBER
.EJECT
/ SUBROUTINE TO PACK SYMBOL FOR OBJECT CODE LISTING
/
OBJ550 CAL 0
JMS SETADR
LAW -2 /CHARACTERS 1,2 AND 3 ARE OUTPUT FIRST.
DAC SETADR
LAC* SYMTW2
OBJ551 DAC OBJB03
JMS OBJ560 /THE MOST SIGNIFICANT CHARACTER IS
TAD K01600 /TRANSLATED FROM RADIX 50 TO ASCIT AND
JMS OBJ570 /OUTPUT.
LAC OBJB02
JMS OBJ560 /THE SECOND MOST SIGNIFICANT CHARACTER IS
TAD K00040 /TRANSLATED FROM RADIX 50 TO ASCIT AND
JMS OBJ570 /OUTPUT
LAC OBJB02
DAC OBJB01 /THE LEAST SIGNIFICANT CHARACTER IS
JMS OBJ570 /TRANSLATED TO ASCIT AND OUTPUT.
LAC* SYMT2A
.IFDEF %FPP
AND Z00000 /IF THE TOP THREE BITS OF THE SECOND NAME WORD
SAD Z00000 /ARE ALL ON IT MEANS WE'RE OUTPUTTING A
JMP* OBJ550 /FLOATING POINT OPCODE - RETURN NOW
LAC* SYMT2A /NORMAL SYMBOL OUTPUT - RELOAD SECOND WORD
.ENDC
ISZ SETADR
JMP OBJ551
JMP* OBJ550
.EJECT
/
/ TABLE OF FPP OPCODES USED BY THE COMPILER AND THEIR MNEMONICS
/
.IFDEF %FPP
OBJ555 0
OBJ552 .+1
713070 /.LOAD. R -- (.AG)
502566 /R50: 'UNF'
045640 /R50: 'LD '
713170 /.LOAD, D -- (.AO)
502564 /R50: 'UND'
045640 /R50: 'LD '
713100 /.LOAD. J -- (.JG)
020444 /R50: 'ELD'
713660 /.STORE. -- (.AH)
502566 /R50: 'UNF'
074740 /R50: 'ST '
713770 /.STORE. D -- (.AP)
502564 /R50: 'UND'
074740 /R50: 'ST '
713700 /.STORE. J -- (.JH)
021114 /R50: 'EST'
710440 /R-R -- (.AJ)
024172 /R50: 'FSB'
710540 /D-D -- (.AR)
015772 /R50: 'DSB'
710500 /J-J -- (.JJ)
021072 /R50: 'ESB'
716040 /R+R -- (.AI)
022654 /R50: 'FAD'
716140 /D+D -- (.AQ)
014454 /R50: 'DAD'
716100 /J+J -- (.JI)
017554 /R50: 'EAD'
712040 /R/R -- (.AL)
023066 /R50: 'FDV'
712140 /D/D -- (.AT)
014666 /R50: -- 'DDV'
712100 /J/J -- (.JL)
017766 /R50: 'EDV'
711440 /R*R -- (.AK)
023630 /R50: 'FMP'
711540 /D*D -- (.AS)
015430 /R50: 'DMP'
711500 /J*J -- (.JK)
020530 /R50: 'EMP'
713273 /-R -- (.BA)
023005 /R50: 'FCM'
713460 /REVERSE REAL DIVIDE -- (.AN)
024124 /R50: 'FRD'
712560 /REVERSE DOUBLE DIVIDE -- (.AV)
015724 /R50: 'DRD'
712500 /REVERSE DBLINT DIVIDE -- (.JN)
021024 /R50: 'ERD'
711040 /REVERSE REAL SUBTRACT -- (.AM)
024143 /R50: 'FRS'
711140 /REVERSE DOUBLE SUBTRACT -- (.AU)
015743 /R50: 'DRS'
711100 /REVERSE DBLINT SUBTRACT -- (.JM)
021043 /R50: 'ERS'
716601 /BRANCH ON 0
010221 /R50: 'BZA'
716602 /BRANCH ON NEGATIVE
007211 /R50: 'BMA'
716603 /BRANCH ON NEGATIVE OR 0
007145 /R50: 'BLE'
714210 /DBLINT TO REAL -- (.JW)
023541 /R50: 'FLA'
714670 /REAL TO DBLINT -- (.JX)
503026 /R50: 'URF'
113050 /R50: 'XA '
OBJ553=.
.EJECT
/
/ SUBROUTINE TO PACK AN FPP INSTRUCTION FOR OBJECT CODE LISTING
/
OBJ554 CAL 0
LAC OBJ552
DAC OBJ560
OBJ556 LAC* OBJ560 /FETCH FIRST INSTRUCTION IN FLOATING TABLE
SAD OBJ553 /IS THIS THE LAST
JMP* OBJ554 /YES; NOT FOUND
SAD* BINBUF /IS THIS ENTRY IDENTICAL TO OUTPUT INST.
JMP OBJ557 /YES WE HAVE FOUND THE RIGHT SYMBOL
ISZ OBJ560 /NO; INCREMENT PASSED THIS ENTRY
LAC* OBJ560 /IS THIS SYMBOL TWO WORD SYMBOL
SPA /NO
ISZ OBJ560 /YES; INCREMENT PASSED 2ND HALF
ISZ OBJ560
JMP OBJ556 /ITERATE ON NEXT ENTRY IF IT EXISTS
OBJ557 LAC OBJ560
DAC SYMTBC
JMS OBJ550
ISZ OBJ554 /TAKE SECOND EXIT
JMP* OBJ554
.ENDC
.EJECT
/ SUBROUTINE TO ISOLATE A CHARACTER IN RADIX 50 MODE
/ CALLING SEQUENCE...
/ LAC RADIX 50 WORD
/ JMS OBJ560
/ TAD -N /CHARACTER POSITION..1)1600, 2)40
/
OBJ560 CAL 0
AND T77777
DZM OBJB01
DZM OBJB02
OBJ561 XCT* OBJ560 /THE CHARACTER IS ISOLATED BY DIVISION
SPA /(REPETITIVE SUBTRACTION).
JMP* OBJ560
DAC OBJB02
ISZ OBJB01
JMP OBJ561
/
/
/
/ SUBROUTINE TO CONVERT A RADIX 50 CHARACTER TO ASCIT AND PACK IT
/
OBJ570 CAL 0
LAC OBJB01 /A SPACE WHICH IS.
SZA /ZERO (RADIX 50) TRANSLATES TO 40 (ASCIT)
JMP OBJ571
LAC S00040
JMP OBJ572
OBJ571 TAD Z77744
SNA!CMA
LAW /.=56
SNA!CMA
LAW 111 /%=45
SMA
TAD K00045 /NUMBERS AND .
TAD S00134
AND S00177
OBJ572 JMS OBJ510 /35-46 (RADIX 50) TRANSLATE TO 60-71 (ASCIT
JMP* OBJ570
K00045 777723
.EJECT
/ SUBROUTINE TO PACK MNEMONIC OPCODE FOR OBJECT CODE LISTING
/ CALLING SEQUENCE...
/ LAC MNEMONIC CODE
/ JMS OBJ580
/
OBJ580 CAL 0
TAD U02020 /THE MNEMONIC IS PARTIALLY CONVERTED TO
DAC OBJB02 /ASCIT BEFORE IT IS PACKED FOR OUTPUT.
JMS OBJ590
JMP* OBJ580
/
/
/
/ SUBROUTINE TO TRANSLATE MODIFIED SIXBT TO ASCII AND PACK IT
/ CALLING SEQUENCE...
/ LAC SIXBT
/ JMS OBJ590
/
OBJ590 CAL 0
LAC K00012
JMS OBJ600 /PACK FIRST CHARACTER
LAC K00006
JMS OBJ600 /PACK SECOND CHARACTER
LAC C00000
JMS OBJ600 /PACK THIRD CHARACTER
JMP* OBJ590
/
/
/
/ SUBROUTINE TO POSITION, TRANSLATE, AND PACK 6-BIT CHARACTER
/ CALLING SEQUENCE...
/ LAC SHIFT VALUE
/ JMS OBJ600
/
OBJ600 CAL 0
JMS SHIFT
LAC OBJB02
AND S00077 /POSITION CHARACTER
TAD C00048 /TRANSLATE TO ASCIT
JMS OBJ510 /PACK IN OUTPUT BUFFER
JMP* OBJ600
.EJECT
/ SUBROUTINE TO TRANSLATE AND OUTPUT AN ABSOUTE COMMAND
/ CALLING SEQUENCE...
/ LAC COMMAND
/ JMS OBJ610
/
OBJ610 CAL 0
SAD SNACMD
LAC SNAMNE
SAD SPACMD
LAC SPAMNE
SAD SZACMD
LAC SZAMNE
SAD CMACMD
LAC CMAMNE
SAD CLACMD
LAC CLAMNE
SAD PASS1 /SKP
LAC SKPMNE
SAD SMACMD
LAC SMAMNE
SAD RCLCMD
LAC RCLMNE
SAD LAQCMD
LAC LAQMNE
SAD TCACMD
LAC TCAMNE
SAD IACCMD
LAC IACMNE
.IFUND %FPP
SAD NORM18
LAC NRMMNE
SAD LRSS18
LAC LRSMNE
.ENDC
SAD LMQCMD /(RKB-063) CHECK FOR LMQ FROM .OR.
LAC LMQMNE /(RKB-063)
SAD OMQCMD /(RKB-063) CHECK FOR OMQ FROM .OR.
LAC OMQMNE /(RKB-063)
SMACMD SMA /IF RECOGNIZABLE, PRINT IT AND EXIT WITH
JMS OBJ580 /SOMETHING OTHER THAN THE INSTRUCTION IN
JMP* OBJ610 /THE ACCUMULATOR.
/
LMQCMD LMQ /(RKB-063) LMQ INSTRUCTION FOR .OR.
OMQCMD OMQ /(RKB-063) OMQ INSTRUCTION FOR .OR.
.EJECT
/ SUBROUTINE TO OUTPUT A PSEUDO OP
/ CALLING SEQUENCE...
/ JMS OBJ620
/ LAC MNEMONIC
/
OBJ620 CAL 0
LAC C00046
JMS OBJ510 /FORMAT PERIOD
XCT* OBJ620
JMS OBJ580 /FORMAT OPCODE
JMS OBJ630 /FORMAT 3 SPACES
JMP* OBJ620
/
/
/
/ SUBROUTINE TO PACK A SPACE INTO THE OUTPUT BUFFER
/
OBJ630 CAL 0
LAC S00040
JMS OBJ510 /PACK A SPACE,
JMP* OBJ630
/
/
/
/ SUBROUTINE TO FORMAT 13-BIT ADDRESS AND A SPACE
/ CALLING SEQUENCE...
/ LAC ADDRESS
/ JMS OBJ640
/
OBJ640 CAL 0
AND S17777
JMS OBJ540 /FORMAT THE ADDRESS
LAC K00005
JMS OBJ630 /FORMAT A SPACE
JMP* OBJ640
/
/
/
/ SUBROUTINE TO FORMAT FULL CONSTANT AND A SPACE
/ CALLING SEQUENCE...
/ LAC CONSTANT
/ JMS OBJ650
/
OBJ650 CAL 0
JMS OBJ540 /FORMAT CONSTANT
LAC K00006
JMS OBJ630 /FORMAT SPACE
JMP* OBJ650
.EJECT
/ TABLE OF MEMORY REFERENCING INSTRUCTIONS GENERATED BY THE COMPILER
/
OBJ400 .DSA DACCMD
S40000 OPCOD DAC
U00000 OPCOD LAC
V40000 OPCOD TAD
X00000 OPCOD AND
Y00000 OPCOD JMP
T00000 OPCOD JMS
U40000 OPCOD XOR
JMPICM JMP*
/
/ TABLE OF OTHER MNEMONICS
/
DSAMNE .SIXBT /DSA/
BLKMNE .SIXBT /BLK/
CMAMNE .SIXBT /CMA/
SKPMNE .SIXBT /SKP/
SNAMNE .SIXBT /SNA/
SMAMNE .SIXBT /SMA/
SPAMNE .SIXBT /SPA/
SZAMNE .SIXBT /SZA/
CLAMNE .SIXBT /CLA/
LAQMNE .SIXBT /LAQ/
RCLMNE .SIXBT /RCL/
CLCMNE .SIXBT /CLC/
TCAMNE .SIXBT 'TCA'
IACMNE .SIXBT 'IAC'
LMQMNE .SIXBT 'LMQ' /(RKB-063)
OMQMNE .SIXBT 'OMQ' /(RKB-063)
.IFUND %FPP
NRMMNE .SIXBT 'NRM'
LRSMNE .SIXBT 'LRS'
.ENDC
.TITLE COMPILER TABLES
/ OPCODE TRANSLATION TABLE
/ INDEXED BY OPERATOR NUMBER
/ INSTRUCTION(S) GENENERATED IS EITHER A MACHINE-LEVEL INSTRUCTION OR
/ A CALL TO AN INSTRUCTIONAL SUBROUTINE.
/ FLOATING HARDWARE INSTRUCTIONS ARE RECOGNIZED BY A 71 IN BITS 0-5
/ THE ARGUMENT OF A FLOATING INSTRUCTION IS A TRANSFER VECTOR IN
/ THE FOLLOWING LOCATION
/ A SUBROUTINE CALL IS GENERATED IF BITS 5-17 .NE. ZERO.
/ B5-17 CONTAIN THE CONCATENATED FORM OF THE SUBROUTINE NAME
/ (LESS THE FIRST CHARACTER WHICH IS A PERIOD)
/ B0 INDICATES WHETHER THE ARGUMENT IS AN ADDRESS OR A LAC ADDRESS
/ (B0 .EQ. ONE CAUSES THE LAC TO BE GENERATED)
/ THE SUBROUTINE CALLING SEQUENCE IS...
/ JMS* NAME
/ .DSA ARGUMENT ADDR (+400000 IF INDIRECT)
/ OR JMS* NAME
/ LAC ARGUMENT ADDR (LAC* IF INDIRECT)
/ A MACHINE-LEVEL INSTRUCTION IS GENERATED IF BITS 5-17 .EQ. ZERO.
/ B0-4 CONTAINS THE OPERATION CODE
/ A MACHINE-LEVEL INSTRUCTION IS....
/ XXX ARGUMENT ADDR (XXX* IF INDIRECT)
/
/
OPTEMP 0 /REPLACEABLE OPERATOR TO SAVE SOME SPACE
OPTRAN .DSA .+1
127477 /.AW FIX TO FLOAT SUBROUTINE
GETARG 127641 /.DA ..FETCH ARGUMENT ADDR EXTERNAL SUBR
C00045 55 /UNUSED SLOT IN TABLE
AND /.AND.
LAC /.LOAD. I
FPPIN 000057,713070 /.LOAD. R -- .AG
FPPIN 000067,713170 /.LOAD. D -- .AO
C00046 56 /UNUSED SLOT IN TABLE
DAC /.STORE. I
FPPIN 000060,713660 /.STORE. R -- .AH
FPPIN 000070,713770 /.STORE. D -- .AP
XOR /.XOR.
.DSA 400101 / I - I -- .AY
FPPIN 000062,710440 / R - R -- .AJ
FPPIN 000072,710540 / D - D -- .AR
TAD / I + I
FPPIN 000061,716040 / R + R -- .AI
FPPIN 000071,716140 / D + D -- .AQ
.DSA 400055 / I / I -- .AE
FPPIN 000064,712040 / R / R -- .AL
FPPIN 000074,712140 / D / D -- .AT
.DSA 400054 / I * I -- .AD
FPPIN 000063,711440 / R * R -- .AK
FPPIN 000073,711540 / D * D -- .AS
CMACMD CMA /- I
OPTR25 FPPIN 127521,713273 /- R -- .BA
/
RELOPC .DSA .-4 /RELATIONAL OP TABLE - BASE VALUE IS 5
SPA!CLA /.LT.
SPA!SNA!CLA /.LE.
SNA!CLA /.EQ.
SMA!CLA /.GE.
SMA!SZA!CLA /.GT.
SZA!CLA /.NE.
/
FNCMNE 127740 /.EX ..FUNCTION RETURN PSEUDO STATE. NO.
130000 /.FP OTS I/O INITIALIZE SUBR
.DSA 000404 /BACKSPACE -- .FT
.DSA 000405 /REWIND -- .FU
.DSA 000406 /END FILE -- .FV
SSCALC .DSA 131013 /SUBSCRIPT CALCULATION ROUTINE -- .SS
/
.DSA 400056 /REVERSE DIVIDE I-I .AF
FPPIN 000066,712440 /REVERSE DIVIDE R/R .AN
FPPIN 000076,712540 /REVERSE DIVIDE D/D .AV
.DSA 400102 /REVERSE SUBTRACT I-I .AZ
FPPIN 000065,711040 /REVERSE SUBTRACT R-R .AM
FPPIN 000075,711140 /REVERSE SUBTRACT D-D .AU
/
PAMNE .DSA 130601 /.PA PAUSE ROUTINE
STMNE .DSA 131014 /.ST STOP ROUTINE
CGOMNE .DSA 130047 /.GO COMPUTED GOTO OBJECT TIME SUBROUTINE
BLANKC .DSA 131330 /.XX BLANK COMMON LABEL
TSIMNE .DSA 125050 /%I INTEGER TEMP STORE MNEMONIC
TSRMNE .DSA 125620 /%R REAL TEMP STORE MNEMONIC
TSDMNE .DSA 124540 /%D DOUBLE TEMP STORE MNEMONIC
ACCMNE FPPIN 127452,131421 /.AB OR .ZA -- LOC OR SUBR
.DSA 127500 /.AX FLOAT TO FIX SUBROUTINE
/
BCDINT 000402 /BCD READ -- .FR
000403 /BIN READ -- .FS
000407 /BCD WRITE -- .FW
000410 /BIN WRITE -- .FX
BCDAIO 000361 /BCD ARRAY I/O -- .FA
000362 /BIN ARRAY I/O -- .FB
000365 /BCD ELEMENT I/O -- .FE
000372 /BIN ELEMENT I/O -- .FJ
BCDCLN 127766 /BCD I/O CLEANUP -- .FF
127767 /BIN I/O CLEANUP -- .FG
001342 /BCD RANDOM READ -- .RR
001343 /BIN RANDOM READ -- .RS
001347 /BCD RANDOM WRITE -- .RW
001350 /BIN RANDOM WRITE -- .RX
001321 /BCD RANDOM ARRAY I/O -- .RA
001322 /BIN RANDOM ARRAY I/O -- .RB
001325 /BCD RANDOM ELEMENT I/O -- .RE
001332 /BIN RANDOM ELEMENT I/O -- .RJ
130726 /BCD RANDON I/O CLEANUP -- .RF
130727 /BIN RANDOM I/O CLEANUP -- .RG
DBLNEG FPPIN 130221,713273 /D.I. NEGATION .JA
DIOPS FPPIN 000627,713100 /D.I. LOAD .JG
S00700 700
S00600 600
S01000 1000
FPPIN 000630,713700 /D.I. STORE .JH
S01100 1100
S00100 100
S00500 500
FPPIN 000632,710500 /D.I. SUBT .JJ
S00104 104
S00105 105
FPPIN 000631,716100 /D.I. ADD .JI
S00106 106
S00107 107
FPPIN 000634,712100 /D.I. DIVIDE .JL
S00110 110
S00300 300
FPPIN 000633,711500 /D.I. MULTIPLY .JK
/
PWRTAB LAC .+1 /EXPONENTIATION TABLE - FILLS GAPING HOLE
00122 /I**I .BB
0 /I**R ILLEGAL
0 /I**D ILLEGAL
60131 /I**J .BI
20123 /R**I .BC
20125 /R**R .BE
40126 /R**D .BF
20134 /R**J .BL
40124 /D**I .BD
40127 /D**R .BG
40130 /D**D .BH
40135 /D**J .BM
60133 /J**I .BK
0 /J**R ILLEGAL
0 /J**D ILLEGAL
60132 /J**J .BJ
/
FPPIN 000636,712500 /D.I. REV DIV. .JN
S00400 400
S00200 200
FPPIN 000635,711100 /D.I. REV SUBT. .JM
PARTLD 1202 /PARTWORD LOAD .PB
PARTST 1203 /PARTWORD STORE .PC
DDRDSC 130034 /DATA-DIRECTED READ ELEMENT .GD
DOTGD 130034 /DATA-DIRECTED READ S.S. VAR .GD
130031 /DATA-DIRECTED WRITE ELEMENT .GA
130033 /DATA-DIRECTED WRITE S.S. VAR .GC
130035 /DATA-DIRECTED READ ARRAY .GE
0 /HOLE IN TABLE STRUCTURE
130032 /DATA-DIRECTED WRITE ARRAY .GB
DOTGF 437 /DECODE .GG
436 /ENCODE .GF
.EJECT
/
/ RECOGNITION TABLE FOR LOCICAL AND RELATIONAL OPERATORS (ARGUMENTS)
/
LOCTAB .DSA .+1 /OP-ARG OPVALU LEVEL
.DSA 723775 /.FALSE. 1 (ARGUMENT)
.DSA 775715 /.TRUE. 0 (ARGUMENT)
.DSA 001152 /.OR. 2 2
.DSA 004164 /.AND. 3 3
.DSA 054754 /.NOT. 4 4
.DSA 000764 /.LT. 5 5
.DSA 000745 /.LE. 6 5
.DSA 000331 /.EQ. 7 5
.DSA 000435 /.GE. 8 5
.DSA 000454 /.GT. 9 5
.DSA 001065 /.NE. 10 5
.DSA 114152 /.XOR. 11 1
LOCTBM .DSA LOCTBM
.EJECT
/ CHARACTER TRANSLATION TABLE
/
/ EACH ENTRY IN THIS TABLE CONTAINS THREE FIELDS OF INFORMATION
/ 1) BITS 00-06 ASCIT CHARACTER CODE
/ 2) BITS 07-11 CHARACTER TYPE CODE
/ 3) BITS 12-17 INTERNAL CHARACTER CODE
/
/CHAR ASCII TYPE INTERNAL
TABCHR .DSA 044000 / TAB 011 00 00
CHARCR .DSA 065200 / C/R 015 12 00
CHARLT .DSA 765200 /ALT 175 12 00
CHARSP .DSA 201300 / SP 040 13 00
.DSA 204000 / ! 041 00 00
.DSA 211450 / " 042 14 50
CHAROC .DSA 215647 / # 043 16 47
.DSA 221450 / $ 044 14 50
.DSA 224033 / % 045 00 33
.DSA 230000 / & 046 00 00
.DSA 235440 / ' 047 14 40
.DSA 241042 / ( 050 10 42
.DSA 245137 / ) 051 11 37
.DSA 250625 / * 052 06 25
.DSA 254517 / + 053 05 17
.DSA 261236 / , 054 12 36
.DSA 264514 / - 055 05 14
.DSA 270734 / . 056 07 34
.DSA 274622 / / 057 06 22
CHAR0 .DSA 300135 / 0 060 01 35
.DSA 304136 / 1 061 01 36
.DSA 310137 / 2 062 01 37
.DSA 314140 / 3 063 01 40
.DSA 320141 / 4 064 01 41
.DSA 324142 / 5 065 01 42
.DSA 330143 / 6 066 01 43
.DSA 334144 / 7 067 01 44
.DSA 340145 / 8 070 01 45
.DSA 344146 / 9 071 01 46
.DSA 351651 / : 072 16 51
.DSA 355655 / ; 073 16 55
.DSA 360000 / < 074 00 00
.DSA 365201 / = 075 12 01
.DSA 370000 / > 076 00 00
.DSA 374000 / ? 077 00 00
.DSA 401654 / @ 100 16 54
.DSA 404201 / A 101 02 01
CHARB .DSA 410202 / B 102 02 02
CHARC .DSA 414203 / C 103 02 03
CHARD .DSA 420304 / D 104 03 04
.DSA 424305 / E 105 03 05
.DSA 430406 / F 106 04 06
.DSA 434407 / G 107 04 07
CHARH .DSA 440410 / H 110 04 10
.DSA 444411 / I 111 04 11
.DSA 450212 / J 112 02 12
.DSA 454213 / K 113 02 13
CHARL .DSA 460414 / L 114 04 14
.DSA 464215 / M 115 02 15
.DSA 470216 / N 116 02 16
CHARO .DSA 474417 / O 117 04 17
.DSA 500420 / P 120 04 20
.DSA 504221 / Q 121 02 21
CHARR .DSA 510422 / R 122 04 22
CHARS .DSA 514223 / S 123 02 23
.DSA 520424 / T 124 04 24
CHARU .DSA 524225 / U 125 02 25
.DSA 530226 / V 126 02 26
.DSA 534227 / W 127 02 27
.DSA 540430 / X 130 04 30
.DSA 544231 / Y 131 02 31
.DSA 550232 / Z 132 02 32
.DSA 555552 / [ 133 15 52
.DSA 560000 / \ 134 00 00
.DSA 565653 / ] 135 16 53
.DSA 570000 / ^ 136 00 00
ARROW .DSA 574000 / _ 137 00 00
/
CHR1 .DSA 065236
CHR2 .DSA 765236
CHR3 .DSA 065200
CHR4 .DSA 765200
.EJECT
/ TABLE OF CONSTANTS
/ POSITIVE DECIMAL INTEGERS WHOSE VALUE IS LESS THAN 100000 ARE
/ IDENTIFIED BY THE LABEL CXXXXX WHERE XXXXX IS THE MAGNITUDE OF THE
/ CONSTANT. NEGATIVE INTEGERS WHOSE VALUE IS LESS THAN 100000 ARE
/ IDENTIFIED BY THE LABEL KXXXXX WHERE XXXXX IS THE MAGNITUDE.
/
.DEC
C00002 .DSA 000002
C00003 .DSA 000003
C00004 .DSA 000004
C00006 .DSA 000006
C00007 .DSA 000007
C00009 .DSA 000009
C00011 .DSA 000011
C00014 .DSA 000014
C00017 .DSA 000017
C00019 .DSA 000019
C00020 .DSA 000020
C00021 .DSA 000021
C00022 .DSA 000022
C00023 .DSA 000023
C00024 .DSA 000024
C00026 .DSA 000026
C00028 .DSA 000028
C00029 .DSA 000029
C00030 .DSA 000030
C00031 .DSA 000031
C00032 .DSA 000032
C00034 .DSA 000034
C00035 .DSA 000035
C00036 .DSA 000036
C00039 .DSA 000039 /REVERSE DIVIDE OPERATOR
C00042 .DSA 000042 /REVERSE SUBTRACT OPERATOR
C00047 .DSA 000047
C00048 .DSA 000048
DECPNT .DSA 044800 /CONCATENATION OF . SP SP
K00010 .DSA -000010
K00040 .DSA -000040
K00077 .DSA -000077
K01600 .DSA -001600
K08177 .DSA -008177
K08192 .DSA -008192
K08191 .DSA -008191
K24576 .DSA -024576
K04081 .DSA -004081
.EJECT
/ LOGICAL CONSTANTS ARE IDENTIFIED BY THE LABEL LXXXXX WHERE L IS S,T,U,
/ V,W,X,Y,Z REPRESENTING 0,1,2,3,4,5,6,7 RESPECTIVELY AND THE MOST
/ SIGNIFICANT OCTAL DIGIT AND XXXXX IS THE REMAINING FIVE DIGITS.
.OCT
W00000 .DSA 400000
Z00000 .DSA 700000
S01200 .DSA 001200
V00000 .DSA 300000
S00777 .DSA 000777
S20000 .DSA 020000
S17777 .DSA 017777
S00077 .DSA 000077
T77700 .DSA 177700
S60000 .DSA 060000
T77777 .DSA 177777
Y77777 .DSA 677777
V60000 .DSA 360000
S00051 .DSA 000051
S00054 .DSA 000054
S00075 .DSA 000075
S00050 .DSA 000050
S00114 .DSA 000114
S00117 .DSA 000117
S00120 .DSA 000120
S00124 .DSA 000124
S00130 .DSA 000130
S00133 .DSA 000133
S00175 .DSA 000175
Z77750 .DSA 777750
S00122 .DSA 000122
S02766 .DSA 002766
S02775 .DSA 002775
S00177 .DSA 000177
S00101 .DSA 000101
S70000 .DSA 070000
.IFDEF %FPP
Z70000 .DSA 770000
Z10000 .DSA 710000
T31422 .DSA 131422
.ENDC
T31442 .DSA 131442
S20564 .DSA 020564
S21042 .DSA 021042
X40000 .DSA 540000
W17777 .DSA 417777
V77777 .DSA 377777
S00111 .DSA 000111
Z77770 .DSA 777770
S00121 .DSA 000121
S07700 .DSA 007700
Z74000 .DSA 774000
Z77706 .DSA 777706
S00041 .DSA 000041
S00053 .DSA 000053
S00134 .DSA 000134
U02020 .DSA 202020
S01700 .DSA 001700
S01502 .DSA 001502
S77777 .DSA 077777
S00377 .DSA 000377
W77777 .DSA 477777
.IFDEF RSX
.TITLE RSX I/O CPB'S
/
/ RSX I/O CPB'S AND I/O SUBROUTINES
/
PARSIZ 27 /PARTITION SIZE REQUEST
ENDPAR /EVENT VARIABLE RETURNS LAST WORD OF PARTITION
/
PREA11 2300 /PREALLOCATE BUFFER'S
EVA /EVENT VARIABLE ADDRESS
DAT11 /LUN
/
PREA12 2300 /PREALLOCATE BUFFER'S
EVA
DAT12
/
PREA13 2300 /PREALLOCATE BUFFER'S
EVA
DAT13
/
/
PARTDV 37 /READ FROM TDV
PAREV /EVENT VARIABLE
SINBFH /BUFFER ADDRESS
45
/
REQTDV 1 /REQUEST CPB
0 /NO EVENT VARIABLE REQUESTED
.SIXBT 'TDV...'
0
/
PAREV 0
PARCNT 0
VERPNT 0
SKPSWC NOP
PARSAV .BLOCK 52
/
/
ENDPAR 0 /LAST WORD IN PARTITION
ATTACH 0
DAC ATTLUN /ATTACH TO A LUN -- SAVE LUN NUMBER
CAL ATACH /ATTACH CAL
JMP* ATTACH /RETURN
/
ATACH 2400 /ATTACH FUNCTION
0 /EVENT VARIABLE ADDRESS
ATTLUN 0 /LOGCAL UNIT NUMBER
/
DETACH 0
DAC DETLUN /DETACH FROM A LUN -- SAVE LUN NUMBER
CAL DETCH /DETACH CAL
JMP* DETACH /RETURN
/
DETCH 2500 /DETACH FUNCTION
0 /EVENT VARIABLE ADDRESS
DETLUN 0 /LOGICAL UNIT NUMBER
/
ENTERR 0
DAC ENTLUN /ENTER A FILE
LAC FILE /MOVE THE FILE NAME
DAC ENTFIL /TO THE ENTER CPB
LAC FILE+1
DAC ENTFIL+1
LAC FILE+2
DAC ENTFIL+2
CAL ENTR /ISSUE ENTER CAL
CAL WFEVA /WAIT FOR EVENT VARIABLE
LAC EVA /PICK UP EVENT VARIABLE
SMA /WAS IT LEGAL?
JMP* ENTERR /YES RETURN
SAD K00006 /NO -- HANDLER FILE STRUCTURED?
JMP ENTER1 /(GAR-075) GO OUTPUT FORM FEED.
JMS IOERR /YES -- MUST BE AN I/O ERROR
LAC ENTLUN /LUN IN CASE OF I/O ERROR
ENTER1 CAL WRFF /(GAR-075)
JMP* ENTERR /(GAR-075) NOW RETURN.
/
ENTR 3300 /ENTER CAL
EVA /EVENT VARIABLE ADDRESS
ENTLUN 0 /ENTER LUN
ENTFIL .BLOCK 3 /FILE NAME
/
CLOSEL 0 /LUN PASSED IN AC, EXCEPT IS CMA'D IF ERROR
SPA!CLL /CLOSE. LINK SET = 0 IF POS AC, BUT SET = 1 IF
CML!CMA /NEG AC, ALONG WITH MAKING NEG AC POS
DAC CLOLUN /PUT LUN INTO CLOSE FUNCTION
LAC TADCMD /GET CLOSE FUNCTION CODE, NOT YET JUSTIFIED,
RTR /AND SHIFT IN LINK - IF WAS ON, A 13400 CLOSE
LRS 4 /FUNCTION, I.E. ERROR CLOSE, IS DEFINED.
DAC CLOSDT /CLOSE FUNCTION IS DEFINED.
CAL CLOSDT /ISSUE CLOSE REQUEST
CAL WFEVA /WAIT FOR EVENT VARIABLE
LAC EVA /PICK UP EVENT VARIABLE
SMA /WAS IT LEGAL?
JMP* CLOSEL /RETURN
SAD K00006 /NO IF NOT -6
JMP* CLOSEL /YES LEGAL RETURN
SAD K00009 /NO IF NOT -11 ALSO
JMP* CLOSEL
JMS IOERR /I/O ERROR
LAC CLOLUN /LUN OF I/O ERROR
/
CLOSDT 0 /CLOSE, ERR CLOSE, SEEK, OR DELETE
EVA /EVENT VARIABLE ADDRESS
CLOLUN 0 /LOGICAL UNIT NUMBER
0 /FILE NAME
0 /FILE NAME NOT USED IF CLOSE OR ERR CLOSE
0 /EXT
/
SEEK 0 /LOOKS FOR EXISTING BINARY FILE WHEN
DAC CLOLUN /(LUN NUMBER IN AC) BINARY IS TO BE OUTPUT.
LAC S03200 /IF NOT FOUND, THEN THE BINARY FILE LEFT BY
DAC CLOSDT /AN ERROR CLOSE MUST BE DELETED
LAC FILE /ESTABLISH FILE NAME
DAC CLOLUN+1
LAC FILE+1
DAC CLOLUN+2
LAC FILE+2 /ESTABLISH 'BIN' EXTENSION; REMAINS THAT WAY
DAC CLOLUN+3 /IF DELETE IS PERFORMED.
CAL CLOSDT /DO SEEK TO FILENAM BIN
CAL WFEVA /WAITFOR
LAC EVA /GET EVENT VARIABLE
AAC 13 / IS -13 IF FILE NOT FOUND
SNA!CLA
LAC S01000 /GET SKP BIT
TAD PASS2 /ADD NOP
DAC DELETE /SAVE; SKP IF NO BIN FOUND, NOP OTHERWISE
LAC EVA
SMA /IF THE EVENT VARIABLE IS POSITIVE, AN EXISTING
JMP CLSEEK /BIN WAS FOUND, AND IT MUST BE CLOSED
XCT DELETE /ONLY NEGATIVE EV ALLOWED IS -13, FOR WHICH
SKP /DELETE IS A NOP
JMP* SEEK /RETURN WITHOUT CLOSE WHEN BIN FILE NOT FOUND
JMS IOERR /REPORT IOERR FOR ANY NEG EV OTHER THAN -13
CLSEEK LAC CLOLUN /THIS LAC MUST FOLLOW IOERR AND PRECEED CLOSEL
JMS CLOSEL /CLOSE SEEK'D BINARY FILE
JMP* SEEK
/
DELETE NOP
/
DELBIN 0 /DELETES BINARY FILE JUST ERR CLOSED
LAC S03500 /SO ONLY NEED TO SET DELETE CODE
DAC CLOSDT /FILENAME AND EXTENSION ARE RETAINED
CAL CLOSDT /FROM WHEN SEEK WAS DONE
JMS WFEV /WAITFOR, EXIT IF I/O ERROR
LAC CLOLUN /PICKED UP BY WFEV IF ERROR, ELSE IS HARMLESS
JMP* DELBIN
/
/
WFEV 0
CAL WFEVA /WAIT FOR EVENT VARIABLE
LAC EVA /PICK UP EVENT VARIABLE
SMA /WAS IT OK?
JMP* WFEV /YES -- RETURN
XCT* WFEV /PICK UP THE LUN
WFEVL DAC . /SAVE IT
LAC EVA /PICK UP EVENT VARIABLE AGAIN
JMS IOERR /GO REPORT ERROR
LAC WFEVL /PICK UP THE LUN
/
/
/ I/O ERROR HAS OCCURRED OUTPUT TO USER
/ FOR-I/O ERROR LUN XX EVENT VARIABLE YYYYYY
/
IOERR 0
TCA /COMPLEMENT ERROR TO MAKE IT POSITIVE
LMQ /SAVE IT IN MQ
LAW -6 /DECODE 6 DIGITS
DAC ENDPAR /SAVE TEMPORARILY
LAC (IOER-1) /SET UP MESSAGE POINTER
DAC* C00008
DECOD ECLA!LLS 3 /DECODE MQ - EVENT VARIABLE
AAC 60 /ADD 60 TO DIGIT
DECODS SAD C00048 /IS IT A ZERO? C00048=60 OCTAL
JMP NDECOD /YES -- SUPPRESS LEADING ZEROES
PAL /SAVE AC
LAC DECRRA /SET UP TO JUMP OVER ZERO SUPPRESS
DAC DECODS /SET JUMP
PLA /RESTORE AC
DECODR DAC* 10 /STORE CHARACTER
ISZ ENDPAR /FINISHED?
JMP DECOD /NO DECODE IT
LAC (IOERL-1) /SET UP TO DECODE THE LUN
DAC* C00008
XCT* IOERR /PICK UP THE LUN SLOT
IDIV /DIVIDE BY 10 TO FIND DECIMAL LUN
12
PAX /SAVE REMAINDER
LACQ /PICK UP QUOTENT
AND C00015 /MASK OFF NUMBER
AAC 60 /ADD 60
DAC* 10 /STORE IT
PXA /PICK UP REMAINDER AGAIN
AND C00015 /MASK IT OFF ALSO
AAC 60 /ADD 60
DAC* 10 /STORE IT IN THE MESSAGE
CAL WRIOER /WRITE ERROR ON OUTPUT TTY
CAL WFEVA /WAIT FOR MESSAGE TO COMPLETE
LAC C00013 /FORCE TDV TO BE CALLED
DAC TITLEA
JMP EXITR /EXIT
/
NDECOD CLA /SUPPRESS PRINTING
DECRRA JMP DECODR /RETURN
/
/
IOERMS ERMSE-IOERMS+1/2*1000+3
0
106 /F
117 /O
122 /R
055 /-
111 /I
057 //
117 /O
040 /SP
105 /E
122 /R
122 /R
117 /O
122 /R
040 /SP
114 /L
125 /U
116 /N
040 /SP
IOERL 0 /LUN XX
0
040 /SP
IOER .BLOCK 6 /EVENT VARIABLE
000 /NULL
015 /CR
ERMSE 012 /LF
/
WRIOER 2700 /WRITE I/O ERROR MESSAGE
EVA /EVENT VARIABLE ADDRESS
DAT3 /OUTPUT DEVICE
3 /IMAGE ASCII
IOERMS /BUFFER ADDRESS
/
WFEVA 20 /WAITFOR REQEUEST
EVA /EVENT VARIABLE ADDRESS
EVA 0 /EVENT VARIABLE
/
/
READ11 2600 /READ REQUEST
EVA /EVENT VARIABLE ADDRESS
DAT11 /LOGICAL UNIT NUMBER
2 /MODE -- IOPS ASCII
SINBFH /BUFFER ADDRESS
45 /MAX WORD COUNT
/
HINF 3600 /HANDLER INFORMATION REQUEST
EVA /EVENT VARIABLE ADDRESS
DAT11 /LOGICAL UNIT NUMBER
/
WRIT3 2700 /WRITE REQUEST
EVA /EVENT VARIABLE ADDRESS
S990CL DAT3 /LOGICAL UNIT NUMBER
2 /MODE -- IOPS ASCII
DA3MSG 0 /BUFFER ADDRESS
/
WRIT12 2700 /WRITE REQUEST
EVA /EVENT VARIABLE ADDRESS
WR3LUN 0 /LOGICAL UNIT NUMBER
2 /MODE -- IOPS ASCII
SINBFH-2 /(RKB-070) BUFFER ADDRESS
/
WRFF 2700 /WRITE A FORM FEED ON THE OUTPUT DEVICE
0 /EVENT VARIABLE NOT NECESSARY
DAT12 /OUTPUT DEVICE
2 /MODE IOPS ASCII
FFMSG /BUFFER
/
FFMSG 2002 /FORM FEED
0
.ASCII ''<14><175> /FORM FEED
/
WRIT13 2700 /WRITE REQUEST
EVA /EVENT VARIABLE ADDRESS
DAT13 /LOGICAL UNIT NUMBER
0 /MODE -- IOPS BINARY
BINBFH /BUFFER
/
SEEK11 3200 /SEEK REQUEST FOR INPUT LUN
EVA /EVENT VARIABLE ADDRESS
DAT11 /LUN
FILE .BLOCK 3 /FILE NAME
/
WRIA12 2700 /WRITE REQUEST
EVA /EVENT VARIABLE ADDRESS
DAT12 /LUN
2 /MODE -- IOPS ASCII
OBJBFH /BUFFER ADDRESS
/
/ CONSTANTS
C00008 .DSA 10
C00010 .DSA 12
C00013 .DSA 15
S03200 .DSA 3200
S03500 .DSA 3500
Z67777 .DSA 767777
Z77000 777000
Z77577 .DSA 777577
Z77677 .DSA 777677
Z77744 .DSA 777744
.ENDC
TFAO03 .DSA 0 /DIGIT COUNT FOR NUMERIC PROCESSING
BNKBTS .DSA 0
IACCMD IAC
TCACMD TCA
/
Z60001=K08191
S00040=C00032
Z60000=K08192
S00052=C00042
Z40000=PASS2
/
ISUBRR 0
SPASNA SPA!SNA
.IFUND RSX
PATCH .BLOCK 40 /PATCH AREA
.ENDC
.IFDEF RSX
.LTORG
SIZECP .SIZE /SIZE OF F4 FOR RSX
.ENDC
.END RSTRT