perm filename MACN11.MAC[11,SYS] blob
sn#147040 filedate 1975-02-24 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00150 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00013 00002 CHANGES FOR VERSION 3
C00022 00003 CHANGES FOR VERSION 2
C00025 00004 CHANGES FOR VERSION 1
C00032 00005 CHANGES FOR VERSION 0 & PREHISTORY
C00036 00006 ASSEMBLY PARAMETERS
C00038 00007 SUBTTL VARIABLE PARAMETERS
C00040 00008 SUBTTL ACCUMULATOR ASSIGNMENTS
C00042 00009 SUBTTL FLAG REGISTERS
C00049 00010 SUBTTL MISCELLANEOUS PARAMETERS
C00053 00011 SUBTTL EXEC
C00060 00012 SUBTTL FILE INITIALIZATION
C00063 00013 INITIALIZE A LISTING FILE
C00065 00014 INITIALIZE A SOURCE FILE
C00068 00015 SUBTTL COMMAND STRING DECODER
C00071 00016 EXEC COMMAND STRING DISPATCHING
C00074 00017 BYTE TABLE FOR DISPATCHING
C00076 00018 LEFT ARROW PROCESSOR
C00078 00019 HERE WE STORE THE CHARACTER IN R14, BUT FIRST CONVERTING
C00080 00020 SUBTTL SWITCH PROCESSING ROUTINES
C00082 00021 /LI AND /NL PROCESSOR
C00085 00022 /EN AND /DS
C00087 00023 FORMAT CONTROL
C00088 00024 IFN STANSW,<
C00090 00025 TABLE SEARCH
C00091 00026 IFE STANSW,<
C00093 00027 THE FOLLOWING CODE IS USED FOR PROCESSING THE COMMAND
C00097 00028 GETCM1:
C00099 00029 INDFIL: TRNN R16,EXTBIT SET UP THE FILENAME IF NECESSARY
C00101 00030 HEADER: CALL ACEXCH YES, SAVE THE ACCUMULATORS
C00103 00031 THE FOLLOWING SECTION OF CODE PRINTS THE TIME, WHICH IS
C00106 00032 DNC: IDIVI R11,↑D10 RECURSIVE SUBROUTINE
C00108 00033 SUBTTL EXEC ERROR ROUTINES
C00110 00034 ERROR: NON-RECOVERABLE ERROR MESSAGE
C00112 00035 EXIT: CLOSE SRC, CLOSE THE SOURCE DEVICE
C00115 00036 ROUTINE TO OUTPUT RELOCATABLE BINARY
C00117 00037 SUBTTL EXEC ROUTINES USING ASSEMBLER AC'S
C00119 00038 RECURSIVE SUBROUTINE TO PRINT A DECIMAL NUMBER
C00120 00039 LST3SP: LIST SPACES
C00121 00040 LPTOUT: OUTPUT TO LISTING DEVICE
C00124 00041 CODE BETWEEN CHARB AND CHAR SAVES A SEQUENCE NUMBER
C00128 00042 SUBTTL ASSEMBLER PROPER
C00132 00043 GETLIN: GET THE NEXT SOURCE LINE
C00135 00044 ENDLR: END OF LINE PROCESSOR
C00138 00045 AOS ERRCNT YES, TALLY ERROR COUNT
C00142 00046 ENDL8: TRNE RERR,-1 DID LINE HAVE ERRORS?
C00145 00047 STMNT: STATEMENT PROCESSOR
C00148 00048 LABEL: LABEL PROCESSOR
C00150 00049 ASGMT: ASSIGNMENT PROCESSOR
C00153 00050 PROPC: PROCESS OP CODES
C00155 00051 POPCL1: CALL AEXP PROCESS ADDRESS EXPRESSION
C00157 00052 POPCL9: OLD ASH/ASHC MODES
C00158 00053 POPC10: CALL ABSEXP
C00160 00054 SUBTTL EXPRESSION HANDLERS
C00163 00055 AEXP07: -(
C00166 00056 AEXP1A: MOVEI R3,RLDT3 OK FOR QUICKIE?
C00168 00057 TSTAR: TEST ADDITIVE RELOCATION (0,1,5,15)
C00169 00058 EXPR: EXPRESSION PROCESSOR, REGISTER ALLOWED
C00173 00059 EXPRPL: +
C00176 00060 REGEXP: REGISTER EXPRESSION
C00177 00061 TERM: TERM PROCESSOR
C00180 00062 TERMNM: NUMERIC TERM
C00184 00063 TERMDQ: """
C00189 00064 SUBTTL SYMBOL/CHARACTER HANDLERS
C00192 00065 ******* GET A LOCAL SYMBOL *******
C00195 00066 GETNB: GET NON-BLANK CHARACTER
C00198 00067 --- MACARG ---
C00203 00068 SUBTTL PSEUDO-OPS
C00205 00069 ABS0: TLO R15,ABSFLG SET ABSOLUTE FLAG
C00207 00070 .IDENT: IDENTIFY PROGRAM
C00209 00071 .RAD50: RADIX 50
C00214 00072 .RADIX: ".RADIX n" PSEUDO-OP
C00216 00073 .OPDEF: .OPDEF HANDLER
C00218 00074 .GLOBL: .GLOBL PSEUDO-OP
C00219 00075 .TITLE: TITLE PSEUDO-OP
C00221 00076 .ASCIZ: TDZA R2,R2 ".ASCIZ" DIRECTIVE
C00225 00077 .PAGE: FORCE A PAGE EJECT
C00229 00078 ============ .LIST & .NLIST ============
C00232 00079 LISTBL: XWD -17,.+1 15 ARGS IN LISTBL
C00233 00080 =========== .ENABL & .DSABL ============
C00236 00081 ************ .ERROR AND .PRINT *************
C00237 00082 .BYTE: "BYT" PSEUDO-OP
C00240 00083 .ROUND: TLZA R15,FPTFLG CLEAR TRUNCATION FLAG
C00243 00084 FLTG:
C00244 00085 FLTG4: CAIN R3,
C00246 00086 FLTG9: CAML R0,[↑D10B4]
C00248 00087 SUBTTL ASSEMBLER DIRECTIVE ARGUMENT INTERPRETER
C00252 00088 SUBTTL REPEAT HANDLER
C00255 00089 REPEND: REPEAT END
C00257 00090 SUBTTL REPEAT/CONDITIONAL ROUTINES
C00260 00091 .IFB: IF BLANK CONDITIONAL
C00261 00092 .IFT: GENERATING CODE UNDER .IFTF OR .IFF
C00262 00093 FALSE: GET HERE WHEN OUTER LEVEL
C00265 00094 IFZ0: JSP R3,IF0
C00266 00095 .IFDIF: .IF DIF -- ARE ARGS DIFFERENT?
C00268 00096 UNSCON: SETZM UNSLVL CREAR LEVEL COUNT
C00271 00097 SUBROUTINE MDLTST CHECKS THE MACRO DEFINITION LISTING
C00273 00098 SUBTTL MACRO-RELATED ASSEMBLER DIRECTIVES
C00276 00099 SUBTTL MACRO HANDLERS
C00278 00100 <<<<<<< .IRP & .IRPC >>>>>>>
C00285 00101 .MCALL: JRST GETEOL !!! TEMPORARY?!! !!
C00288 00102 CODE FROM DEF03 TO DEF04 IS CONCERNED WITH
C00294 00103 DEF07: TLZ R16,FOLBIT TURN FOLDING ON AGAIN . . .
C00298 00104 CALLM:
C00301 00105 MAC40: END-OF-ARGUMENT PROCESSING
C00304 00106 MAC70: "\"
C00306 00107 SUBROUTINE GENSYM GENERATES A LOCAL SYMBOL IN THE
C00309 00108 ########## .MEXIT ###########
C00312 00109 SUBTTL MACRO STORAGE HANDLERS
C00317 00110 INCMAC: INCREMENT MACRO STORAGE
C00318 00111 SUBTTL LISTING ROUTINES
C00322 00112 =========== SUBROUTINE FORSEQ -==============
C00327 00113 SUBTTL OCTAL OUTPUT ROUTINES
C00329 00114 PROWRD: PROCESS WORD
C00333 00115 RLDTBL:
C00334 00116 ENDP: END OF PASS ROUTINES
C00340 00117 HDROUD: OUTPUT DOUBLE WORD
C00341 00118 BYTOUT: OUTPUT A BYTE OF CODE
C00343 00119 BLKDMP: DUMP THE CURRENT BLOCK
C00345 00120 SUBTTL MEMORY MANAGEMENT
C00346 00121 SUBTTL SYMBOL TABLE HANDLERS
C00348 00122 INSRT: INSERT ITEM IN SYMBOL TABLE
C00350 00123 CRFDEF: TDZA R3,R3 CREF DEFINITION
C00352 00124 CRFLIN: OUTPUT CREF LINE INFO
C00355 00125 SRCHI: INITIALIZE FOR SEARCH
C00356 00126 SYMTB: LIST THE SYMBOL TABLE
C00358 00127 GETSTE: GET SYMBOL TABLE ENTRY
C00362 00128 RADTBL:
C00364 00129 OSRCH: OP TABLE SEARCH
C00366 00130 TYPOFF== ↑D17 PACKING PARAMETERS
C00367 00131 SUBTTL PREDEFINED SYMBOLS (PROTOTYPE SYMBOL TABLE)
C00369 00132 SUBTTL OP CODE TABLE
C00370 00133 OPTBOT: OP TABLE BOTTOM
C00372 00134 OPCDEF B,H,I, , , , MOD20!MOD40, OPCL4, 101000
C00374 00135 OPCDEF B,V,S, , , , MOD20!MOD40, OPCL4, 102400
C00376 00136 OPCDEF D,E,C, , , , MOD20!MOD40, OPCL1, 005300
C00379 00137 OPCDEF M,O,V,B, , , MOD20!MOD40, OPCL2, 110000
C00381 00138 OPCDEF R,T,S, , , , MOD20!MOD40, OPCL3, 000200
C00384 00139 OPCDEF T,S,T, , , , MOD20!MOD40, OPCL1, 005700
C00386 00140 DIRDEF .,F,L,T,2, , .FLT2
C00389 00141 SUBTTL CHARACTER DISPATCH ROUTINES
C00390 00142 CHJTBL: CHARACTER JUMP TABLE (STANFORD MOD BY BO 14-JAN-75)
C00397 00143 SPACE: BYTE (4) , , , , ,SCSE,QJSP,.TAB, SPACE
C00401 00144 BYTE (4) , , , , , ,QJPC, , @
C00405 00145 IFE STANSW,<
C00412 00146 SUBTTL IMPURE AREA
C00414 00147 SEQNUM: BLOCK 1 SEQUENCE NUMBER
C00416 00148 PF0: BLOCK 1
C00417 00149 JOBFFS: BLOCK 204*NUMBUF SOURCE BUFFER
C00420 00150 IFNDEF NONREN, <RELOC>
C00421 ENDMK
C⊗;
; CHANGES FOR VERSION 3
; ---------------------
;MACN11.MAC[11,BO] 14-JAN-75 EDIT BY BO
; Added Stanford character set and COMMENT pseudo-op.
;<VOICE>MACN11.MAC;54 22-OCT-74 17:53:23 EDIT BY RAVELING
; Incorporated changes to fix CCL bugs, fixed by
; Rick Gumpertz at CMU.
;<VOICE>MACN11.MAC;53 19-OCT-74 16:40:04 EDIT BY KODA
; 1. CHECKING FOR A SWITCH FIRST INSTEAD OF A PPN CAUSED
; SOME WEIRD ERRORS. ALSO EXCHANGED MODBIT AND BRKBIT.
;<VOICE>MACN11.MAC;52 19-OCT-74 15:55:18 EDIT BY KODA
; 1. FIXED TYPOS IN STANFORD PPN PROCESSING AND CHANGE "CALL CHFOLD"
; IN CHARTB TO "JRST CHFOLD" SO THAT CHFOLD MAY DO THE RETURN FROM
; CHAR.
;<VOICE>MACN11.MAC;51 18-OCT-74 23:35:57 EDIT BY KODA
; 1. NEW SWITCH CALL STANSW WHICH IF NON-ZERO WILL ASSEMBLE
; WITH CODE THAT WILL ACCEPT STANFORD PPN'S. WHILE DOING
; THIS CODE, CHANGED PPN PROCESSING SO IT WILL NOT ACCEPT
; A PPN IN THE MIDDLE OF A FILE NAME.
;<VOICE>MACN11.MAC;50 18-OCT-74 21:27:58 EDIT BY RAVELING
; 1. FIXED POTENTIAL BUG: SOME OF THE DEFAULT .ENABL
; MODES WERE TAMPERED WITH IN PASS INITIALIZAION.
; 2. FIXED ACTUAL BUG: MACRO CALLS GOT EXTRANEOUS Q FLAGS
; IF THEY HAD A COMMENT AND THEIR LAST ARGUMENT WAS OF
; THE FORM "<...>" OR "↑\...\".
;<VOICE>MACN11.MAC;49 17-OCT-74 19:44:28 EDIT BY RAVELING
; FIXED BUGS IN OUTPUT OF INTERNAL SYMBOL DEFINITIONS.
;<VOICE>MACN11.MAC;48 17-OCT-74 01:41:00 EDIT BY RAVELING
; FIXED (HOPEFULLY) BUGS CAUSED BY CONFLICTING USE OF R4.
;<VOICE>MACN11.MAC;47 17-OCT-74 00:50:19 EDIT BY RAVELING
; 1. ADDED INTERNAL SYMBOL OUTPUT IN OBJECT MODULES, UNDER
; CONTROL OF .ENABL ISD.
; 2. REWROTE SETCHR, GETNT, TSTNSP, & ALL THOSE GOODIES TO
; RUN FASTER AT THE EXPENSE OF USING R4. THEY NOW MAP
; CHARACTER TYPES FROM COLUMN 6 OF CHJTBL.
; 3. FIXED A FEW MINOR BUGS IN NEW FEATURES & CLEANED UP
; ASSORTED SMALL PIECES OF CODE.
;<VOICE>MACN11.MAC;46 15-OCT-74 20:42:55 EDIT BY KODA
; 1. COMMAND PARSER ABLE TO HANDLE MUTIPLE ARGUMENTS TO SWITCHES.
; (E.G. /NL:CND:ME , ETC. )
;<VOICE>MACN11.MAC;45 14-OCT-74 01:18:34 EDIT BY RAVELING
; 1. Revised .ENABL/.DSABL to accept overrides
; from command string.
; 2. Implemented .ENABL/.DSABL GBL.
; 3. Fixed a minor but catastrophic editing error &
; cleaned up assorted flag definitions.
;<VOICE>MACN11.MAC;44 13-OCT-74 20:07:36 EDIT BY RAVELING
; BUG FIXES FOR LOCAL SYMBOL GENERATION.
;<VOICE>MACN11.MAC;43 13-OCT-74 18:50:21 EDIT BY RAVELING
; BUG FIXES FOR .RAD50, LISTING OVERRIDES, AND AUTOMATIC
; LOCAL SYMBOL GENERATION.
;<VOICE>MACN11.MAC;42 13-OCT-74 01:32:13 EDIT BY RAVELING
; 1. REWROTE .RAD50 PROCESSING TO ACCEPT BRACKETED
; EXPRESSIONS.
; 2. ADDED THE REST (?) OF THE CODE FOR AUTOMATIC GENERATION
; OF LOCAL SYMBOLS IN MACRO CALLS.
; 3. MODIFIED LISTING DIRECTIVE PROCESSING TO ACCOUNT FOR
; OVERRIDES FROM THE COMMAND STRING.
; 4. CHANGED TREATMENT OF MACRO-GENNED LINES ON LISTING:
; INSTEAD OF KLUDGY LOOKING "M" MARKER, THE MACRO
; CALL NESTING LEVEL IS PRINTED TO THE LEFT OF THE
; LINE NUMBER.
;<VOICE>MACN11.MAC;41 12-OCT-74 21:21:44 EDIT BY KODA
; 1. BUG IN CRF SWITCH PROCESSING ROUTINE - WAS SETTING BIT IN
; WRONG HALF OF R16.
;<VOICE>MACN11.MAC;40 11-OCT-74 00:16:40 EDIT BY RAVELING
; 1. MODIFIED LOCAL SYMBOL PROCESSING TO HANDLE NUMERIC
; VALUES UP TO 65535.
; 2. FIXED 2 GLITCHES IN "\" PROCESSING.
; 3. ADDED IDENTIFICATION FOR MACRO-GENERATED LINES IN
; THE SEQUENCE NUMBER FIELD.
; 4. ADDED THE FIRST INSTALLMENT OF CODE TO GENERATE
; LOCAL SYMBOLS AUTOMATICALLY IN MACRO CALLS.
;<VOICE>MACN11.MAC;39 7-OCT-74 21:17:22 EDIT BY KODA
; 1. FIXED ANOTHER BUG: COULDN'T TYPE JUST A DEVICE LIKE TTY:
; AS THE SOURCE FILE WITH SWITCHES.
;<VOICE>MACN11.MAC;38 7-OCT-74 20:12:12 EDIT BY KODA
; 1. ADDED /FO SWITCH FOR BINARY FORMATS:
; WHICH ARE "I" FOR IMAGE AND "P" FOR PACKED.
;<VOICE>MACN11.MAC;37 6-OCT-74 15:25:38 EDIT BY KODA
; 1. WAS LOSING REGISTER R1 WHICH HAD DEVICE NAME IN SWITCH
; PROCESSING ROUTINE.
; 2. PUT SOME PATCH SPACE IN IMPURE AREA.
;<VOICE>MACN11.MAC;36 6-OCT-74 14:22:16 EDIT BY KODA
; 1. FIXED A FEW BUGS IN COMMAND PARSER.
;<VOICE>MACN11.MAC;35 5-OCT-74 19:36:23 EDIT BY KODA
; 1. IMPLEMENTED NEW COMMAND PARSING SCHEME.
;<VOICE>MACN11.MAC;34 30-SEP-74 22:28:11 EDIT BY KODA
; 1. CHANGED BYTE AND DISPATCH TABLES ON COMMAND PARSER.
; (GETTING READY FOR REAL SWICTHES.)
;<VOICE>MACN11.MAC;33 30-SEP-74 20:39:18 EDIT BY RAVELING
; -- FIXED ALL 3 BUGS IN THE CHANGES FOR ;32.
;<VOICE>MACN11.MAC;32 29-SEP-74 19:46:02 EDIT BY RAVELING
; 1. JIM KODA CLEANED UP WHOLE GOBS OF ASSORTED INEFFICIENCIES
; (& DIDN'T LEAVE COMMENTS HERE!!!)
; 2. "::" AND "==" ARE HANDLED AS PRESCRIBED FOR THE DOS V09
; LANGUAGE SET.
; 3. .ASCII/.ASCIZ PARSER NOW ACCEPTS BLANKS AND TABS BETWEEN
; FIELDS.
; 4. BUGS IN "\" PROCESSING HAVE BEEN FIXED. . .
; -- RESULT IS A NUMBER IN THE CURRENT RADIX,
; RATHER THAN ONLY IN OCTAL.
; -- LOWER CASE IN THE EXPRESSION FOLLOWING "\" IS
; HANDLED PROPERLY IN ALL CASES.
; CHANGES FOR VERSION 2
;<RAVELING>MACN11.MAC;31 13-JUL-74 20:13:12 EDIT BY RAVELING
; 1. CORRECTED SIDE EFFECT OF .DSABLE PNC -- PROGRAM
; COUNTER DIDN'T INCREMENT!
; 2. FINISHED .ENABL LC - RELATED CODE; MACRO PROTOTYPES
; AND ARGUMENT VALUES ARE NO LONGER FOLDED.
;<RAVELING>MACN11.MAC;30 13-JUL-74 15:38:00 EDIT BY RAVELING
; 1. IMPLEMENTED PNC OPTION OF .ENABL/.DSABL.
; 2. NEARLY FINISHED .ENABL LC: LOWER CASE ASCII IS
; NOW ASSEMBLED AS SUCH BY .ASCII, .ASCIZ,
; 'X, AND "XX; TITLES AND SUBTITLES AREN'T
; FOLDED INTO UPPER CASE EITHER.
;<RAVELING>MACN11.MAC;29 2-JUL-74 23:23:30 EDIT BY RAVELING
; 1. MODIFIED SYMBOL TABLE INITIALIZATION TO SET PREDEFINED
; SYMBOL VALUES, DEFINED IN TABLE PERMST. CURRENT
; ENTRIES DEFINE R0-R7, SP, PC, AND .MACN. -- .MACN.
; IS EVALUATED TO THE ASSEMBLER'S VERSION NUMBER.
; 2. ADDED ASSEMBLY PARAMETER 'TENEX' & FIRST INSTALLMENT OF
; CONDITIONAL ASSEMBLIES, TO TAILOR THE ASSEMBLER TO
; EITHER 1050 OR GENUINE TENEX EVIRONMENTS.
;<RAVELING>MACN11.MAC;28 28-JUN-74 22:33:40 EDIT BY RAVELING
; 1. INCORPORATED STEVE CASNER'S CHANGES TO IMPLEMENT THE
; LOGICAL SHIFT OPERATOR (←) AND TO PREVENT ↑R
; FROM GENERATING Q FLAGS.
; 2. BUG FIXED: .IRP IGNORED ITS LAST ARGUMENT IF IT WAS
; EXPLICITLY OMITTED. PROPER EXPANSION IS TO GEN
; THE IRP BLOCK WITH A NULL VALUE SUBSTITUTED FOR
; THE ARGUMENT.
; CHANGES FOR VERSION 1
;<RAVELING>MACN11.MAC;27 12-JUN-74 21:51:00 EDIT BY RAVELING
; JIM KODA'S CHANGES:
; 1. FIXED GLITCHES IN COMMAND STRING LISTING.
; 2. ADDED FILE NAME IN SUBTITLE LINES.
; MY CHANGES:
; 1. FIXED TABLE ENTRY THAT CAUSED .IF GT TO BE
; TREATED AS .IF GE.
; 2. FIXED LISTING BUG: BLANK LINES GENERATED FROM
; MACROS WERE LISTED EVEN WITH .NLIST ME IN EFFECT.
;<RAVELING>MACN11.MAC;26 3-JUN-74 18:40:34 EDIT BY RAVELING
; ANOTHER .ENABL AMA BUG SQUASHED: MODE 7 ADDRESSES WERE
; BEING PERVERTED TO MODE 3.
;<RAVELING>MACN11.MAC;25 2-JUN-74 14:28:46 EDIT BY RAVELING
; 1. JIM KODA IMPLEMENTED .IDENT.
; 2. FIXED A BUG IN .IF B & .IF NB: IT DID ITS OWN PARSING,
; INSTEAD OF CALLING MACARG, SO IT THOUGHT '<>' WAS NONBLANK.
;<RAVELING>MACN11.MAC;24 31-MAY-74 17:52:22 EDIT BY RAVELING
; FIXED BUG IN .IRP ARGUMENT HANDLING -- IT STRIPPED OFF
; ONE LEVEL TOOO MANY OF NESTED BRACKETS.
;<RAVELING>MACN11.MAC;23 31-MAY-74 15:46:57 EDIT BY RAVELING
; CHANGED .IRP & .IRPC'S ALGORITHM FOR EXPANDING ARGUMENTS
; IN THE PROPER ORDER TO BE LESS CPU-CONSUMING AND
; LESS BUG-PRONE.
;<RAVELING>MACN11.MAC;22 30-MAY-74 23:02:03 EDIT BY RAVELING
; 1. FIXED BUG CAUSING PHASE ERRORS WHEN ABS MODE
; ADDRESSING IS ENABLED.
; 2. FINISHED .IRP & .IRPC.
;<RAVELING>MACN11.MAC;21 30-MAY-74 16:25:06 EDIT BY RAVELING
; FIXED TYPOS & FIRST ROUND OF .IRP/.IRPC PROBLEMS.
;<RAVELING>MACN11.MAC;20 29-MAY-74 21:58:55 EDIT BY RAVELING
; ADDED .IRP & .IRPC PROCESSING, BUT THEY'RE NOT QUITE
; COMPLETE YET.
;<RAVELING>MACN11.MAC;19 29-MAY-74 15:47:01 EDIT BY RAVELING
; 1. MERGED IN JIM KODA'S CHANGES FOR PROPER TITLES,
; LISTING THE COMMAND STRING, AND ANNOUNCING THE VERSION.
; 2. FIXED A BUG IN .IF -- IT WASN'T SKIPPING A COMMA
; BETWEEN THE CONDITION FIELD AND ARGUMENT FIELD
; IN SOME CASES.
;<RAVELING>MACN11.MAC;18 22-MAY-74 12:09:34 EDIT BY CASNER
; TOOK UNUSED LOCAL SYMBOL CODE OUT OF NUMERIC TERM PROCESSOR.
; ADDED ↑R CODE TO TERM PROCESSOR.
;<RAVELING>MACN11.MAC;17 17-MAY-74 20:11:51 EDIT BY RAVELING
; 1. CLEANED UP .NCHR AND .NTYPE.
; 2. SET MACRO BLOCK SIZE TO 30 WORDS INSTEAD OF 10.
; 3. IMPLEMENTED .IIF.
;<RAVELING>MACN11.MAC;16 16-MAY-74 21:13:42 EDIT BY RAVELING
; 1. ADDED STEVE CASNER'S .NTYPE CODE.
; 2. FIXED BUG IN .NCHR (IMPROPER TREATMENT OF BLANK & TAB
; AS SEPARATORS).
; 3. MODIFIED MACRO CALL PROCESSOR TO HANDLE NESTED ARGUMENTS
; PROPERLY.
;<RAVELING>MACN11.MAC;15 15-MAY-74 19:03:49 EDIT BY RAVELING
; 1. FIXED BUG IN MACARG (COULD HAVE ARBITRARILY BEEN CALLED
; BUG IN .IF DIF/.IF IDN).
; 2. FIXED BUG IN .IF B & .IF NB.
;<RAVELING>MACN11.MAC;14 15-MAY-74 00:09:34 EDIT BY RAVELING
; 1. FIXED BUG IN .IF DUE TO OVERZEALOUS CLEANUP.
; 2. RE-IMPLEMENTED .IF DIF & .IF IDN TO TAKE MACRO-TYPE
; ARGUMENTS.
; 3. IMPLEMENTED .NCHR.
; 4. SUPPLIED PROPER PAGE NUMBERING.
;<RAVELING>MACN11.MAC;13 14-MAY-74 14:02:14 EDIT BY RAVELING
; DELETED SOURCE REPRODUCTION, WHICH IS NEITHER
; USED, NEEDED, NOR POSSIBLE TO DO CORRECTLY ANY MORE.
;<RAVELING>MACN11.MAC;12 11-MAY-74 15:34:14 EDIT BY RAVELING
; 1. FIXED UNBALANCED CONDITIONAL & DELETED CCL
; CODE AGAIN.
; 2. MODIFIED .NARG TO BE CONSISTENT WITH DEC ASSEMBLERS
; WHEN AN ARGUMENT IS EXPLICITLY NULL.
;<RAVELING>MACN11.MAC;11 9-MAY-74 21:17:39 EDIT BY RAVELING
; FIXED BUGS IN .NARG & ASSEMBLY TERMINATION.
;<RAVELING>MACN11.MAC;10 9-MAY-74 20:09:49 EDIT BY RAVELING
; CCL'S BACK IN -- THE "%$#(#"! WON'T ASSEMBLE WITHOUT IT!
;<RAVELING>MACN11.MAC;9 9-MAY-74 19:48:00 EDIT BY RAVELING
; 1. SET ASSEMBLY PARAMETER FOR NO CCL FEATURES.
; 2. DELETED PAGE EXTENSIONS, ANTICIPATING GENUINE PAGE
; NUMBERING.
; 3. FIXED .SBTTL BUG THAT CAUSED OCCASIONAL GARBLING.
; 4. IMPLEMENTED .NARG.
; 5. MODIFIED .PRINT & .ERROR TO PRINT THE WHOLE LINE,
; TO MATCH MACRO-11.
;<RAVELING>MACN11.MAC;8 27-MAR-74 21:43:22 EDIT BY RAVELING
; 1. DELETED ALL REFERENCES TO .PDP10 FEATURE USE COUNT.
; 2. CHANGED .RAD50 AND .OPDEF TO CHECK NSFFLG INSTEAD OF
; .PDP10 FOR NONSTANDARD FEATURES.
; 3. .ASCII & .ASCIZ ACCEPT ANY EXPRESSION (NOT JUST A NUMBER)
; WITHIN ANGLE BRACKETS.
; CHANGES FOR VERSION 0 & PREHISTORY
;<RAVELING>MACN11.MAC;7 8-MAR-74 17:14:23 EDIT BY RAVELING
; 1. FIXED BUG IN NUMBER CONVERSION DUE TO LOCAL
; SYMBOL CHECKING.
; 2. FIXED BUG IN LOCAL SYMBOL PROCESSING (LOCAL SYMBOL
; BLOCK NUMBER WASN'T RESET BEFORE PASS 2).
;<RAVELING>MACN11.MAC;6 8-MAR-74 14:55:20 EDIT BY RAVELING
;<RAVELING>MACN11.MAC;5 15-FEB-74 22:18:31 EDIT BY RAVELING
;<RAVELING>MACN11.MAC;4 14-FEB-74 20:59:45 EDIT BY RAVELING
;<RAVELING>MACN11.MAC;3 1-FEB-74 20:53:04 EDIT BY RAVELING
;<RAVELING>MACN11.MAC;2 16-JAN-74 21:13:36 EDIT BY RAVELING
;<RAVELING>MACX11.MAC;58 14-JAN-74 10:11:56 EDIT BY RAVELING
;<RAVELING>MACX11.MAC;57 14-JAN-74 07:11:10 EDIT BY RAVELING
;<RAVELING>MACX11.MAC;56 9-JAN-74 08:47:11 EDIT BY RAVELING
;<RAVELING>MACX11.MAC;55 4-JAN-74 17:02:31 EDIT BY RAVELING
;<RAVELING>MACX11.MAC;54 28-DEC-73 20:34:17 EDIT BY RAVELING
;<RAVELING>MACX11.MAC;53 28-DEC-73 13:51:54 EDIT BY RAVELING
;<RAVELING>MACX11.MAC;52 14-DEC-73 19:08:02 EDIT BY RAVELING
;<RAVELING>MACX11.MAC;51 28-NOV-73 15:50:49 EDIT BY RAVELING
;<RAVELING>MACX11.MAC;50 26-NOV-73 21:33:46 EDIT BY CASNER
;<RAVELING>MACX11.MAC;49 26-NOV-73 18:24:30 EDIT BY CASNER
;<RAVELING>MACX11.MAC;44 31-OCT-73 17:46:51 EDIT BY RAVELING
;<RAVELING>MACX11.MAC;43 25-OCT-73 18:30:31 EDIT BY RAVELING
;<RAVELING>MACX11.MAC;41 24-OCT-73 21:12:50 EDIT BY RAVELING
;<RAVELING>MACX11.MAC;40 23-OCT-73 19:45:43 EDIT BY RAVELING
;<RAVELING>MACX11.MAC;39 19-OCT-73 18:08:33 EDIT BY RAVELING
;<RAVELING>MACX11.MAC;38 19-OCT-73 16:36:11 EDIT BY RAVELING
;<RAVELING>MACX11.MAC;37 18-OCT-73 19:17:42 EDIT BY RAVELING
;<RAVELING>MACX11.MAC;36 18-OCT-73 18:35:03 EDIT BY RAVELING
TITLE MACN11 V003 19-OCT-74
; COPYRIGHT 1969,1970,1971, DIGITAL EQUIPMENT CORPORATION.
; MODIFICATIONS BY . . .
; -- CMU
; -- USC-ISI (PAUL RAVELING, STEVE CASNER, & JIM KODA)
; -- SCRL (DAVE RETZ & SHARI PRICE)
;ASSEMBLY PARAMETERS
STANSW==1
NONREN==1
IFNDEF NONREN, <TWOSEG>
LOC 137
010
IFNDEF NONREN, <RELOC 400000>
IFDEF NONREN, <RELOC>
TITLE: SIXBIT /MACN11/
ASMVER: SIXBIT /V003 / ; ---- VERSIONS SHOULD CHANGE ON 1ST EDIT
VERSION== 3 ; ---- AFTER INSTALLATION IN SUBSYS
ENTRY START
IFNDEF TENEX,<TENEX=0> ; DEFAULT TO 1050 ENVIRONMENT
; -- TENEX=1 ASSEMBLES JSYS'S INSTEAD OF UUO'S,
; PROVIDING COMMAND RECOGNITION AND IMPROVED EFFICIENCY.
; [WHEN WE FINISH IMPLEMENTING IT].
; CCLSW=1 GIVES NEW COMMAND LANGUAGE FEATURES
IFNDEF CCLSW,<CCLSW==1> ;NORMALLY ASSEMBLE WITH CCL FEATURES
IFN TENEX,<CCLSW==0> ; CAN'T USE CCL WITH TENEX!!!
IFE CCLSW,<TEMPC==0> ;TMPCOR UUO FLAG
IFNDEF TEMPC,<TEMPC==1> ;NORMALLY USE CCL WITH TMPCOR UUO
IFNDEF CMUSW,<CMUSW==0> ;FOR CMU MODS
IFNDEF STANSW,<STANSW==0> ;FOR STANFORD PPN'S
IFE TENEX,<
EXTERNAL JOBREL,JOBFF
>
IFN TENEX,<
SEARCH STENEX
>
SUBTTL VARIABLE PARAMETERS
PAGSIZ== ↑D54 ; NUMBER OF LINES ON A PAGE
NUMBUF== 2 ; NUMBER OF BUFFERS PER DEVICE
CORINC== 2000 ; CORE INCREMENT
SPL== 4 ; SYMBOLS PER LINE (SYMBOL TABLE LISTING)
SPLTTY== 3 ; SYMBOLS PER LINE (TTY)
DATLEN== ↑D350 ; DATA BLOCK LENGTH
RLDLEN== ↑D40
WPB== ↑D30 ; MACRO BLOCK SIZE
MACNES== ↑D32 ; MACRO NESTING LIMIT
; -- THIS APPLIES TO BOTH NESTED MACRO
; DEFINITIONS AND NESTED CALLS.
CPL1== ↑D72 ; CHARACTERS PER LOGICAL LINE
CPL2== ↑D83 ; CHARACTERS PER PHYSICAL LINE
CPL3== ↑D144 ; CHARACTERS PER .PDP10 LINE
PDPLEN== 100 ; PUSH-DOWN POINTER LENGTH
CRFLEN== ↑D36 ; CREF SYMBOLS/LINE MAX
COLLPT== ↑D128 ;CPL LPT
COLTTY== ↑D72 ;CPL TTY
TRUE== 1
BKT1== 1
BKT2== 2
BKT3== 3
BKT4== 4
BKT6== 6
SUBTTL ACCUMULATOR ASSIGNMENTS
R0= 0 ; ACCUMULATION OF SIXBIT SYMBOL, SCRATCH
R1= 1 ; SYMBOL VALUE AND FLAGS SET BY SRCH. SCRATCH
R2= 2 ; SCRATCH
R3= 3 ; UNIVERSAL SCRATCH
R4= 4 ; UNIVERSAL SCRATCH +1
R5= 5 ; LOCATION COUNTER
R6= 6 ; SCRATCH
R7= 7 ; SYMBOL TABLE SEARCH INDEX
R10= 10 ; EXPRESSION OR TERM VALUE, SCRATCH
R11= 11 ; SCRATCH
R12= 12 ; MACRO STORAGE BYTE POINTER
R13= 13 ; LINE BUFFER BYTE POINTER
R14= 14 ; CURRENT CHARACTER (ASCII)
R15= 15 ; LH - ASSEMBLER FLAGS, RH - ERROR FLAGS
R16= 16 ; EXEC FLAGS
R17= 17 ; PUSH-DOWN POINTER
; ALTERNATE SYMBOLIC AC ASSIGNMENTS ----
RLOC== 5 ; LOCATION COUNTER
RBPTR== 13 ; INPUT BYTE POINTER
RBYTE== 14 ; INPUT BYTE
RMODE== 15 ; MODE FLAG REGISTER (LEFT HALF)
RERR== 15 ; ERROR FLAG REGISTER (RIGHT HALF)
RLINK== 17 ; STACK PTR FOR SUBROUTINE LINKAGE
SUBTTL FLAG REGISTERS
; R16 - LH
LSTBIT== 000001 ; 1- SUPRESS LISTING OUTPUT
BINBIT== 000002 ; 1- SUPRESS BINARY OUTPUT
CSWBIT== 000004 ; 1- SUPRESS CROSS REFERENCE
IRPBIT== 000010 ; 1- GENERATING .IRP CALL BLOCK
; * THAT MEANS PARSE ONLY 1 ARG.
FOLBIT== 000020 ; 1- OVERRIDE INPUT FOLDING
MODBIT== 000040 ; 1- USER MODE AC'S SET
GEQBIT== 000100 ; 1- GLOBAL EQUATE (==) BEING PROCESSED
TTYBIT== 000200 ; 1- LISTING IS ON TTY
ERRBIT== 000400 ; 1- ERROR MESSAGES ENABLED
SBTBIT== 001000 ; 1- SUBTITLE AVAILABLE
NLISLN== 002000 ; 1- SUPPRESS LIST OF CURRENT LINE
LBLBIT== 004000 ; 1- STATEMENT IS LABELED (MAY BE
; USED TO FORCE PRINTING LOC)
PF1BIT== 010000 ; 1- PRINT PF1 AS IS, INSTEAD OF
; A WORD FROM CODBUF
MEXBIT== 020000 ; 1- MACRO EXPANSION IN PROGRESS
BEXBIT== 040000 ; 1- BINARY EXTENSION LINE BEING LISTED
LOHBIT== 100000 ; 1- LAST OUTPUT WAS PAGE HEADER
IIFBIT== 200000 ; 1- .IIF (NOT .IF!) IN PROGRESS
; R16 - RH
ARWBIT== 000001 ; 1- LEFT ARROW SEEN
EXTBIT== 000002 ; 1- EXPLICIT EXTENSION SEEN
SWTBIT== 000004 ; 1- ENTER SWITCH MODE
INFBIT== 000010 ; 1- VALID INFORMATION SEEN
FFBIT== 000020 ; 1- FORM-FEED SEEN
DEVBIT== 000040 ; 1- NEW DEVICE HAS BEEN NAMED
NLTBIT== 000100 ; 1- PROCESSING .NL
DSABIT== 000200 ; 1- PROCESSING .DS
ENDBIT== 000400 ; 1- END OF ALL INPUT FILES
CKBBIT== 001000 ; 1- CHECKING FOR BINARY FILE
CKLBIT== 002000 ; 1- CHECKING FOR LISTING FILE
NULBIT== 004000 ; 1- NON-NULL COMMAND STRING
DOTBIT== 010000 ; 1- PERIOD WAS LAST CHARACTER
COMBIT== 020000 ; 1- COMMA WAS LAST CHARACTER
COLBIT== 040000 ; 1- COLON WAS LAST CHARACTER
HDRBIT== 100000 ; 1- TIME FOR NEW LISTING PAGE
SEQBIT== 200000 ; 1- SEQUENCE NUMBER SEEN
BRKBIT== 400000 ; 1- LAST CHARACTER WAS EITHER "[" OR "]"
; R15 - LH
CDRFLG== 000001 ; 1- CARD READER INPUT (73-80 IGNORED)
LCFLG== 000002 ; 1- LOWER CASE INPUT
LSBFLG== 000004 ; 1- LOCAL SYMBOL BLOCK ENABLED
PNCFLG== 000010 ; 1- BINARY OUTPUT ENABLED
ENDFLG== 000020 ; 1- END OF SOURCE ENCOUNTERED
REGFLG== 000040 ; 1- REGISTERS DEFINED BY ASSEMBLER
AMAFLG== 000100 ; 1- ABS MODE ADDRESSING
CONFLG== 000200 ; 1- CONCATENATION CHARACTER SEEN
EXTFLG== 000400 ; 1- EXTENSION LINE
FPTFLG== 001000 ; 1- FLOATING POINT TRUNCATION MODE
GBLFLG== 002000 ; 1- TREAT UNDEFINED SYMBOLS AS GLOBAL
HOVFLG== 004000 ; 1- CAUSES SYMBOL BEGINNING WITH A-F
; TO BE INTERPRETED AS A HEX
; CONSTANT, IF RADIX=16
ABSFLG== 010000 ; 1- ABSOLUTE OBJECT
ISDFLG== 020000 ; 1- INTERNAL SYMBOL DICTIONARY REQ'D
FLTFLG== 040000 ; 1- ERROR ENCOUNTERED IN FLOATING ROUTINE
PSWFLG== 100000 ; 1- IMAGE (UNPACKED) MODE
NSFFLG== 200000 ; 1- NONSTANDARD FEATURES ENABLED
P1F== 400000 ; 1- PASS 1 IN PROGRESS
; ** ALL BITS CORRESPONDING TO .ENABL/.DSABL OPTIONS:
ENAMA1== ABSFLG+AMAFLG+CDRFLG+FPTFLG+GBLFLG+HOVFLG
ENAMA2== LCFLG+LSBFLG+NSFFLG+PNCFLG+REGFLG+ISDFLG
ENMASK== ENAMA1+ENAMA2
ENDEF== LCFLG+PNCFLG+REGFLG ; ***** DEFAULT ENABL MODES *****
; R15 - RH
ERRA== 400000 ; 1- ADDRESSING ERROR.
ERRB== 200000 ; 1- BOUNDARY ERROR.
ERRD== 100000 ; 1- DOUBLY-DEFINED SYSMBOL REFERENCED.
ERRE== 040000 ; 1- END DIRECTIVE NOT FOUND.
ERRI== 020000 ; 1- ILLEGAL CHARACTER DETECTED.
ERRL== 010000 ; 1- LINE BUFFER OVERFLOW (EXTRA CHARCTERS IGNORED).
ERRM== 004000 ; 1- MULTIPLE DEFINITION OF A LABEL.
ERRO== 002000 ; 1- OPCODE ERROR.
ERRP== 001000 ; 1- PHASE ERROR.
ERRQ== 000400 ; 1- QUESTIONABLE SYNTAX
ERRR== 000200 ; 1- REGISTER TYPE ERROR.
ERRT== 000100 ; 1- TRUNCATION ERROR.
ERRU== 000040 ; 1- UNDEFINED SYMBOL.
ERRN== 000020 ; 1- 8 OR 9 WITHOUT DECIMAL POINT.
ERRZ== 000010 ; 1- MARGINAL INSTRUCTION
ERRP1== 000001
SUBTTL MISCELLANEOUS PARAMETERS
TTYDEV== 000010 ; 1- DEVICE IS A TTY
PTRDEV== 000200 ; 1- DEVICE IS A PTR
LPTDEV== 040000 ; 1- DEVICE IS A LPT
CDRDEV== 100000 ; 1- DEVICE IS A CDR
IODATA== 200000 ; 1- IO DATA ERROR
IODEV== 100000 ; 1- IO PARITY ERROR
IOWRLK== 400000 ; 1- IO WRITE LOCK ERROR
IOBKTL== 040000 ; 1- IO BLOCK TOO LARGE
IOEOF== 020000 ; 1- END OF FILE ON IO DEVICE
; DEVICE PARAMETERS
BIN== 1
LST== 2
SRC== 3
CMD== 4
ILLCHR== 1 ;ILLEGAL CHARACTER SUBSTITUTE
ELLCHR== 2 ;END OF LOGICAL LINE CHARACTER
INBIT== 2 ;DEVICE CAN DO INPUT
ALMODE== 1 ;ASCII LINE MODE
IFN TENEX,<
EOL== 37 ; TENEX END OF LINE
>
; -------- LISTING CONTROL FLAGS -----------
; THESE FLAGS ARE USED IN THE FOLLOWING WORDS:
; LIWORD LH - VALUE OF OVERRIDES FROM COMMAND STRING
; RH - MASK SHOWING WHICH MODE BITS ARE OVERRIDDEN
; LSTCTL LH - VALUE OF LISTING MODES SET BY SOURCE DIRECTIVES
; RH - EFFECTIVE MODES, DETERMINED BY ALL 3 1/2 WORDS ABOVE
LBEX== 000001 ; BINARY EXTENSIONS
LBIN== 000002 ; BINARY CODE
LCOM== 000004 ; COMMENTS
LCND== 000010 ; UNSATISFIED CONDITIONS
LLD== 000020 ; LISTING DIRECTIVES WITHOUT ARGUMENTS
LLOC== 000040 ; LOCATION COUNTER
LMC== 000100 ; MACRO CALLS
LMD== 000200 ; MACRO DEFINITIONS
LME== 000400 ; MACRO EXPANSIONS
LMEB== 001000 ; MACRO EXPANSION BINARY CODE
LSEQ== 002000 ; SOURCE SEQUENCE NUMBERS
LSRC== 004000 ; SOURCE CODE
LSYM== 010000 ; SYMBOL TABLE
LTOC== 020000 ; TABLE OF CONTENTS
LTTM== 040000 ; TELETYPE MODE
LDEF= 777777-LLD-LME-LMEB-LTTM ; ***** DEFAULT LIST MODES *****
BINRDX== 1 ;BIT DEFINITIONS FOR GLBRDX CONTROL WORD
QUARDX== 2
OCTRDX== 4
DECRDX== 10
HEXRDX== 20
HEXENB== 40 ;ENABLES HEX CONSTANTS TO START WITH A-F,
; SO CONSEQUENTLY SYMBOLS CAN'T
IFE TENEX,< ; 1050 OPDEFS
OPDEF RESET [CALLI 0]
OPDEF DEVCHR [CALLI 4]
OPDEF CORE [CALLI 11]
OPDEF EXIT [CALLI 12]
OPDEF DATE [CALLI 14]
OPDEF APRENB [CALLI 16]
OPDEF MSTIME [CALLI 23]
OPDEF RUNTIM [CALLI 27]
OPDEF ZBINK [CLOSE BIN,]
OPDEF OUTCHR [TTCALL 1,]
OPDEF OUTSTR [TTCALL 3,]
OPDEF INCHWL [TTCALL 4,]
>
OPDEF CALL [PUSHJ R17,]
OPDEF RETURN [POPJ R17,]
DEFINE GENM40 (A,B,C,D,E,F) ;GEN MOD 40
<
XWD $'A*50*50+$'B*50+$'C , $'D*50*50+$'E*50+$'F
>
DEFINE ARG (A,B,C,VALUE) ; ARG TABLE GENERATOR
<
XWD VALUE,$'A*50*50+$'B*50+$'C
>
SUBTTL EXEC
IFN TENEX,<
START: RESET
MOVE RLINK,[IOWD PDPLEN,PDPSTK] ; INIT STACK POINTER.
MOVE R0,TITLE ; DISPLAY "MACN11"
CALL LSTVER ; AND VERSION # ON
MOVEI 1,"-" ; USER'S TERMINAL.
PBOUT
MOVE R0,ASMVER ; GET VERSION #.
CALL LSTVER
MOVEI 1,EOL ; FOLLOW WITH TENEX EOL.
PBOUT
MOVEI 1,"*" ; PROMPT "*" TO REQUEST
PBOUT ; COMMAND STRING INPUT.
MOVE R0,[XWD BZCOR,BZCOR+1] ; CLEAR A BUNCH OF WORKING
SETZB R1,BZCOR ; STORAGE TO 0.
BLT R0,EZCOR-1
MOVEI R1,400000 ; GET TIME AT START OF ASSEMBLY.
RUNTM
MOVEM R1,RUNTM ; SAVE FOR STATISTICS OUTPUT.
HRROI R1,DATSTR ; GET DATE AND TIME,
SETOB R2,R3 ; SAVE FOR PAGE HEADINGS.
ODTIM
SETZ R0, ; DEPOSIT 0-BYTE AT END
IDPB R0,R1 ; TO MAKE IT ASCIZ FORMAT.
CALL CORSET ; INITIALIZE SYMBOL TABLE.
MOVSI R16,BINBIT!LSTBIT!CSWBIT ; INIT FLAGS IN R16 LH.
SETZ R15, ; CLEAR FLAGS IN R15.
>
IFE TENEX,<
START: ;MAIN ENTRY POINT
IFN CCLSW,<
TDZA 0,0 ;NORMAL ENTRY, CLEAR CCL FLAG
SETOM 0 ;CCL ENTRY, SET FLAG
MOVEM 0,CCLFLA ;SAVE FLAG
>
NULFIL: RESET ;RESET ALL I/O
HRRZ R0,JOBFF
ADDI R0,204*NUMBUF*2+200+200 ;ACCOUNT FOR POSSIBLE CCL FILES
CORE R0,
HALT .
MOVE R17,[IOWD PDPLEN,PDPSTK]
IFN CCLSW,<
SKIPE CCLFLA
CALL DSKNIT ;INIT DSK: FOR COMMAND FILE
CAIA
JRST NXTCCL ;SKIP RETURN FROM DSKNIT
>
MOVE R0,TITLE ; GET NAME
CALL LSTVER ; TYPE IT OUT TO USER
OUTCHR ["-"]
MOVE R0,ASMVER ; GET VERSION NUMBER
CALL LSTVER
CALL LSTOU1 ; TYPE CR-LF
OUTCHR ["*"]
NXTCCL:
MOVE R0,[XWD BZCOR,BZCOR+1]
SETZB R1,BZCOR
BLT R0,EZCOR-1
RUNTIM R1,
MOVEM R1,RUNTIM
DATE R0,
MOVEM R0,DATE ;SAVE DATE
MSTIME R0,
MOVEM R0,MSTIME ; AND TIME
CALL CORSET ;SET UPPER CORE
MOVSI R16,BINBIT!LSTBIT!CSWBIT
SETZ R15, ;CLEAR ASSEMBLER FLAG REGISTER
>
MOVE R1,JOBFF
HRLI R1,(POINT 7,)
MOVEM R1,CMDSTR ; SAVE COMMAND STRING POINTER
MOVEM R1,TTIPNT
START1:
IFN CCLSW,<
SKIPE CCLFLA
CALL GETCMD ;READ A CHARACTER FROM COMMAND FILE
SKIPN CCLFLA
>
INCHWL R2
IDPB R2,R1
CAIE R2,LF
CAIN R2,ALTMOD
TDZA R2,R2
JRST START1
IDPB R2,R1
MOVEI R1,1(R1)
MOVEM R1,JOBFF
MOVSI R1,(SIXBIT /DSK/)
CALL GETBIN ;INITIALIZE THE BINARY FILE
MOVSI R1,(SIXBIT /DSK/)
TRNN R16,ARWBIT ;GO ON TO SOURCE IF ← HAS BEEN SEEN
CALL GETLST ;INITIALIZE THE LISTING FILE
MOVE R5,TTIPNT
MOVEM R5,TTISAV ;SAVE TTI POINTER
MOVSI R1,(SIXBIT /DSK/)
CALL GETSRC ;INITIALIZE THE SOURCE FILE
IFN CCLSW,<
SKIPE CCLFLA
OUTSTR [ASCIZ /MACN11: /] ;ANNOUNCE YOURSELF
SKIPN CCLFLA
>
OUTSTR [BYTE (7) CRR, LF, 0] ;CONFIRM ALL'S WELL
CALL ACEXCH ;SAVE EXEC AC'S
CALL ASSEMB ; CALL THE ASSEMBLER
IFN CCLSW,<
SKIPN CCLFLA
>
CALL LSTCR ;SKIP ONE LINE
CALL ACEXCH ;SWAP AC'S
IFN CCLSW,<
EXTERNAL JOBERR
HRRZ R11,ERRCNT
ADDM R11,JOBERR ;UPDATE ERROR COUNT
JUMPN R11,START2 ;DON'T PRINT 0 ERRORS
SKIPE CCLFLA ;IF CCL MODE
JRST EXIT
>
START2: PUSH R17,R16
TRO R16,HDRBIT ; PRINT STATISTICS ON NEW PAGE.
CALL LSTCR ; (THIS ALSO KEEPS TTY CLEAN).
TLO R16,ERRBIT ; SHOW STATS ON GRUBBY TTY TOO.
SETZM LSTCNT
CALL LSTCR ;SKIP A LINE
MOVEI R2,"?" ;ASSUME ERROR
SKIPE R11,ERRCNT ;TEST ERRORS, LOAD R11
CALL LSTOUT
MOVEI R10,[ASCIZ / ERRORS DETECTED: 5/]
CALL LSTMCR
CALL LSTCR
MOVE R10,[POINT 7,[ASCIZ / */],]
CALL LSTASC
MOVE R10,CMDSTR
CALL LSTASC ;PRINT OUT COMMAND STRING
POP R17,R0
IFN CCLSW,<
SKIPE CCLFLA ;SKIP REST IF CCL MODE
JRST EXIT
>
MOVE R11,OPCCNT+1 ;PRINT NUMBER OF INSTRUCTIONS
CAMN R11,OPCCNT
JRST START7 ;DON'T PRINT SUMMARY IF NOTHING SPECIAL
MOVEI R10,[ASCIZ \ TOTAL # OF PST ACCESSES = 5\]
CALL LSTMCR
SKIPA R10,[POINT 7,[ASCIZ \ TOTAL # OF 11/45\]]
CALL LSTOUT
ILDB R2,R10
JUMPN R2,.-2
MOVE R11,OPCCNT+1
SUB R11,OPCCNT
MOVEI R10,[ASCIZ \ INSTRUCTIONS = 5\]
CALL LSTMCR
START7: SETZ R11,
RUNTIM R11, ;GET RUNTIM
SUB R11,RUNTIM ;DEDUCT STARTING TIME
IDIVI R11,↑D1000 ;CONVERT TO SECONDS
MOVEI R10,[ASCIZ / RUN-TIME: 5 SECONDS/]
CALL LSTMCR
HRRZ R11,JOBREL ;GET TOP OF COR
ASH R11,-↑D10 ;CONVERT TO "K"
ADDI R11,1 ;BE HONEST ABOUT IT
MOVEI R10,[ASCIZ / CORE USED: 5K/]
CALL LSTMCR ;LIST MESSAGE
CALL LSTCR
JRST EXIT ; CLOSE OUT
LSTVER: MOVSI R6,(POINT 6,R0,)
ILDB R2,R6
JUMPE R2,CPOPJ ; RETURN ON NULL BYTE
ADDI R2,40 ; CONVERT TO 7-BIT ASCII
OUTCHR R2
TLNE R6,770000
JRST LSTVER+1
RETURN
SUBTTL FILE INITIALIZATION
;INITIALIZE A BINARY FILE
;COLLECTS A DEVICE NAME IN AC R1, A FILE NAME IN XE, AND
;AN OPTIONAL FILE NAME EXTENSION, THE DEVICE IS INITIALIZED IN
;BINARY MODE ON CHANNEL ONE, WITH EITHER ONE OR TWO BUFFERS.
GETBIN:
TRZ R16,CKLBIT ;MAKE SURE NOT CHECKING FOR LISTING FILE
TRO R16,CKBBIT ;TRYING FOR BINARY FILE
CALL GETFIL ;GET A DEVICE NAME AND FILE NAME
RETURN ;NULL FILE EXIT
MOVE R0,R1 ;GET AN EXTRA COPY OF THE DEVICE
DEVCHR R0, ;TEST ITS CHARACTERISTICS
TLNE R0,TTYDEV!PTRDEV!LPTDEV!CDRDEV
JRST ERRTB ;ILLEGAL FOR BINARY
MOVE R0,[INIT BIN,10] ;INIT IMAGE MODE
MOVSI R2,BINBUF ;GET BUFFER HEADER ADDRESS
CALL INISET ;INITIALIZE THE BINARY DEVICE
OUTBUF BIN,NUMBUF
MOVE R3,XE
MOVEM R3,BINNAM ;SAVE BINARY NAME
TRZE R16,EXTBIT ;WAS THERE AN EXTENSION
HLLOM R14,BINNAM+1 ; YES, SAVE IT
TLZ R16,BINBIT ;INDICATE GOOD BINARY FILE
RETURN ;EXIT
SETBIN: ;SET BIN (END OF PASS 1)
TLNE R16,BINBIT ;ANY BINARY?
RETURN ; NO, EXIT
CALL ACEXCH ;YES, GET EXEC AC'S
MOVE R3,BINNAM
MOVEM R3,XE ;SET UP BINARY NAME
MOVSI R3,(SIXBIT /OBJ/)
TLNE R15,ABSFLG ;ABS MODE?
MOVSI R3,(SIXBIT /BIN/) ; YES
SKIPE BINNAM+1 ;WAS THERE AN EXPLICIT EXTENSION?
MOVE R3,BINNAM+1 ; YES, FORGET THE ABOVE
HLLZM R3,XE1 ;SET IN LOOKUP BLOCK
SETZM XE2 ;ZERO REMAINDER
SETZM XE3
ENTER BIN,XE ;ENTER FILE NAME IN DIRECTORY
JRST ERRNR ;DIRECTORY FULL
JRST ACEXCH ;TOGGLE AC'S AND EXIT
;INITIALIZE A LISTING FILE
;COLLECTS A DEVICE NAME IN AC R1, A FILE NAME IN XE AND
;AN OPTIONAL FILENAME EXTENSION, THE DEVICE IS INITIALIZED IN
;ASCII LINE MODE ON CHANNEL 2, IF THE DEVICE IS A TTY, THE
;TTYLST FLAG IS SET TO 1, AND THE INBUF/OUTBUF INDEX IS INCREMENTED.
GETLST:
TRZ R16,CKBBIT ;CLEAR CHECK FOR BINARY FILE
TRO R16,CKLBIT ;LOOK FOR LISTING FILE
SETZM XE
CALL GETFIL ;GET A DEVICE AND FILE NAME
TLNN R16,CSWBIT
CAIA
RETURN
TLNE R16,CSWBIT
JRST GETLS2 ;NORMAL
MOVE R3,[SIXBIT /CREF/]
SKIPN XE ;EXPLICIT CREF NAME?
MOVEM R3,XE ; NO, GIVE IT DEFAULT
TRON R16,EXTBIT ;EXPLICIT EXTENSION?
MOVSI R14,(SIXBIT /CRF/) ; NO, SUPPLY ONE
GETLS2: MOVE R0,[INIT LST,1]
MOVSI R2,LSTBUF ;GET BUFFER HEADER ADDRESS
CALL INISET ;INITIALIZE LISTING FILE
MOVE R0,R1
DEVCHR R0, ;GET DEVICE CHARACTERISTICS
TLNE R0,TTYDEV ;IS IT A TTY?
TLO R16,TTYBIT ;SET FLAG
OUTBUF LST,NUMBUF
TRZN R16,EXTBIT ;WAS THERE AN EXTENSION?
MOVSI R14,(SIXBIT /LST/) ;NO
HLLZM R14,XE1 ;SAVE EXTENSION IN LOOKUP BLOCK
ENTER LST,XE ;ENTER FILE NAME IN DIR.
JRST ERRNR ;DIRECTORY FULL
TLZ R16,LSTBIT ;INDICATE A GOOD LISTING FILE
JRST LPTINI ;INIT LINE OUTPUT AND EXIT
;INITIALIZE A SOURCE FILE
;COLLECTS A DEVICE NAME IN AC R1, A FILE NAME IN XE AND
;AN OPTIONAL FILE NAME EXTENSION. THE DEVICE IS INITIALIZED
;IN ASCII LINE MODE ON CHANNEL 3, AND THE FILE NAME ASSOCIATED
;WITH THE SOURCE FILE IS USED AS THE TITLE ON THE LISTING.
GETSRC:
TRZ R16,CKBBIT!CKLBIT ;CLEAR BITS => LOOKING FOR SOURCE
SETZM XE
IFN STANSW,<
SETZM XE+3 ;Stanford needs its PPN's wiped
>;IFN STANSW
CALL GETFIL ;GET A DEVICE NAME AND FILE NAME
JRST ERRSE ;COMMAND ERROR IF A NULL
MOVE R0,[INIT SRC,1]
MOVEI R2,SRCBUF ;GET BUFFER HEADER ADDRESS
CALL INISET ;INITIALIZE THE SOURCE DEVICE
MOVEI R5,JOBFFS
EXCH R5,JOBFF ;SET TO TOP OF INPUT BUFFER
INBUF SRC,NUMBUF
MOVEM R5,JOBFF ;RESTORE JOBFF
TRZE R16,EXTBIT ;WAS AN EXPLICIT EXTENSION SEEN?
JRST SRC3A+1 ;YES, LOOK FOR IT
MOVSI R14,(SIXBIT /M11/)
HLLZM R14,XE1 ;NO, TRY .M11 FIRST
LOOKUP SRC,XE
CAIA
RETURN
MOVSI R14,(SIXBIT /P11/) ; TRY P11 SECOND
HLLZM R14,XE1
LOOKUP SRC,XE
CAIA
RETURN
MOVSI R14,(SIXBIT /MAC/) ; TRY MAC 3RD
HLLZM R14,XE1
LOOKUP SRC,XE
TDZA R14,R14 ;NOT FOUND, TRY BLANK
RETURN ;FOUND
SRC3A: HLLZM R14,XE1 ;SAVE EXTENSION IN LOOKUP BLOCK
LOOKUP SRC,XE ;LOOKUP FILE NAME
JRST ERRCF ;FILE NOT FOUND
RETURN ;EXIT
SETP2: ;SET FOR PASS 2
CALL ACEXCH ;GET EXEC AC'S
TRZ R16,ENDBIT!FFBIT
MOVE R5,TTISAV
MOVEM R5,TTIPNT ;RESTORE INPUT COMMANDS
MOVSI R1,(SIXBIT /DSK/)
CALL GETSRC ;GET A SOURCE FILE
JRST ACEXCH ;SWAP AC'S AND EXIT
SUBTTL COMMAND STRING DECODER
; This routine will process a file specification field.
; It will store the device name in R0 and the file name in XE.
; Also, it will process the switches that are associated with
; the file.
; It returns +1 if no file was given. Otherwise +2.
GETFIL:
TRZ R16,DEVBIT ;No device yet
CALL GETWRD ;Get a word
JRST CHKNUL ;Check for switches and device name
GTFIL1: TRNE R16,COLBIT ;New device?
JRST [ TRCE R16,DEVBIT ;Set flag so it won't go here twice
JRST ERRSE ;Too many devices
MOVE R1,R14 ;Set new device
JRST GETFIL+1 ]
MOVEM R14,XE ;Save filename
TRNN R16,DOTBIT ;Any extensions?
JRST GTFIL2 ;Nope- continue
CALL GETWRD ;Yes, get it
JFCL ;Null is ok
MOVEM R14,XE1 ;Save it
TRO R16,EXTBIT ;Set extension flag
GTFIL2: TRNE R16,BRKBIT ;Process a PPN?
CALL PPNPRC ;Yes - do it
CAIA ;Null is expected here
JRST ERRSE ; No more words here
TRNE R16,SWTBIT ;Any switches?
CALL SWTPRC ;Yes - process them
TRNN R16,COMBIT!ARWBIT ;No - better be comma or arrow
JRST ERRSE ;None, syntax error
JRST CPOPJ1 ;Yup thats all
CHKNUL:
TRNE R16,COLBIT!DOTBIT ;Ended with colon or period?
JRST ERRSE ; Yes, error
TRNE R16,BRKBIT ;A PPN to do?
JRST [ CALL PPNPRC ;First process PPN
JRST CHKNUL ; If next word is null then check it out
JRST GTFIL1 ] ; If not then it must be a filename
TRNN R16,SWTBIT ;Any switches to process?
JRST [ TRNE R16,DEVBIT ;No, was device given?
JRST CPOPJ1 ;Yes, return +2 then
RETURN ] ;Else return +1
TRNN R16,CKBBIT!CKLBIT!DEVBIT ;Can't be source or can be new device
JRST ERRSE ; Error if it is
CALL SWTPRC ;Process the switch(es)
TRNN R16,DEVBIT ;New device given
RETURN ;No, just return
JRST CPOPJ1 ;Else, return +2
;EXEC COMMAND STRING DISPATCHING
; THIS ROUTINE WILL PICK UP THE NEXT WORD IN THE EXEC TTY BUFFER
; AND PUT ITS SIXBIT VALUE IN R14. A WORD IS TERMINATED BY DELIMITERS
; AS SPECIFIED IN THE BYTE TABLE.
; IF THE NEXT WORD IS NULL THEN IT WILL RETURN +1, WITH THE APPROPRIATE
; DELIMITER FLAG SET. OTHERWISE IT WILL RETURN +2. IF IT DETECTS A
; LINE TERMINATOR SUCH AS A CARRIAGE RETURN THEN IT WILL JUMP TO THE
; STARTING ADDRESS. WORDS THAT ARE MORE THAN SIX CHARACTERS LONG WILL
; BE TRUNCATED TO SIX.
GETWRD:
TRZ R16,SWTBIT!COLBIT!DOTBIT!COMBIT!BRKBIT
SETZ R14, ;CLEAR SYMBOL WORD
MOVE R6,[POINT 6,R14]
GETCMN: CALL GETTTI ;GET NEXT CHARACTER
JRST @DSPTCH(R10) ;GO TO CORRECT ROUTINE
GETTTI: ILDB R5,TTIPNT ;GET A CHARACTER FROM TTY BUFFER
; IF THE CHARACTER IS LOWER CASE, FOLD TO UPPER CASE.
CAIGE R5,141 ; IS CHAR < LOWER CASE A?
JRST GETNLC ; YES - NOT LC
CAIG R5,172 ; NO - CK FOR > LOWER CASE Z
SUBI R5,40 ; ** FOLD **
GETNLC: MOVE R10,R5 ; COPY THE BYTE TO AC R10
IDIVI R10,8 ; TRANSLATE TO 4-BIT CODE
ADD R10,[POINT 4,BITE,] ;SET BYTE POINTER
IBP R10 ;MOVE TO PROPER BYTE
SOJGE R11,.-1 ;TEST FOR END
LDB R10,R10 ;OK, FETCH BYTE
CAIN R10,4 ;IS IT A NULL?
JRST GETTTI ;YES, TRY AGAIN
RETURN ;NO, EXIT
;COMMAND DISPATCH TABLE AND BYTE POINTERS
DSPTCH:
XWD 0,ERRIC ;ILLEGAL CHARACTER
XWD 0,STORE ;ALPHA-NUMERIC
XWD 0,COLON ;<:>
XWD 0,PERIOD ;<.>
XWD 0,ERRIC ;SHOULD NEVER GET THIS
XWD 0,LFTARW ;<←>, "<", OR <=>
XWD 0,COMMA ;<,>
XWD 0,CARRTN ;<CR>
XWD 0,SLASH ;</>
XWD 0,BRACKT ;"[" OR "]"
IFN CCLSW,<
XWD 0,RUNUUO ;<!>
XWD 0,INDFIL ;<@>
>
IFE CCLSW,<
XWD 0,ERRIC
XWD 0,ERRIC
>
;BYTE TABLE FOR DISPATCHING
;CLASSIFICATION BYTE CODES
; BYTE CLASSIFICATION
; ---- --------------
; 00 ILLEGAL CHARACTER
; 01 ALPHA-NUMERIC CHARACTER
; 02 DEVICE DELIMITER, ":"
; 03 FILE EXTENSION DELIMITER, "."
; 04 IGNORED CHARACTER
; 05 OUTPUT SPEC. DELIMITER, "←", "<", OR "<"
; 06 FILE DELIMITER, ","
; 07 COMMAND TERMINATOR, <CR>
; 10 ENTER SWITCH MODE, "/"
; 11 PPN DELIMITER "[" OR "]"
;
; 12 CCL FILE DELIMITER, "!"
; 13 INDIRECT FILE DELIMITER, "@"
;BYTE TABLE:
BITE:
BYTE (4) 4, , , , , , ,
BYTE (4) , 4, 7, 4, 4, 7, ,
BYTE (4) , , , , , , ,
BYTE (4) , , 7, 7, , , ,
BYTE (4) 4,12, 4, , , , ,
BYTE (4) 1, 1, , , 6, , 3,10
BYTE (4) 1, 1, 1, 1, 1, 1, 1, 1
BYTE (4) 1, 1, 2, , 5, 5, ,
BYTE (4) 13, 1, 1, 1, 1, 1, 1, 1
BYTE (4) 1, 1, 1, 1, 1, 1, 1, 1
BYTE (4) 1, 1, 1, 1, 1, 1, 1, 1
BYTE (4) 1, 1, 1,11, ,11, , 5
BYTE (4) , , , , , , ,
BYTE (4) , , , , , , ,
BYTE (4) , , , , , , ,
BYTE (4) , , , , , 7, , 4
;LEFT ARROW PROCESSOR
LFTARW: TRO R16,ARWBIT ;SET APPROPIATE FLAGS
INFTST: TRZE R16,INFBIT ;IS THIS A NULL FILE?
CPOPJ1: AOS (R17) ;GOOD EXIT
CPOPJ: RETURN ;...
;PERIOD PROCESSOR
PERIOD: TRO R16,DOTBIT ;SET FLAG FOR PERIOD SEEN
JRST INFTST ;TEST FOR NULL WORD AND EXIT
;COLON PROCESSOR
COLON:
TRO R16,COLBIT ;SET COLON FLAG
JRST INFTST ;CHECK FOR NULL WORD AND EXIT
;CARRIAGE RETURN PROCESSOR
CARRTN: TRNN R16,NULBIT ;IS THIS JUST A RANDOM CR?
JRST NULFIL ;YES, RESTART COMPLETELY
TRO R16,ENDBIT ;IS THIS A NORMAL MODE COMMAND?
TRNN R16,ARWBIT ;YES, HAS A LEFT ARROW BEEN SEEN?
JRST ERRSE ;NO, SYNTAX ERROR
; YES FLOW INTO COMMA PROCESSOR
;COMMA PROCESSOR
COMMA:
TRO R16,COMBIT ;SET COMMA FLAG
JRST INFTST ;EXIT
; SLASH (/) PROCESSOR
SLASH:
TRO R16,SWTBIT ;TURN ON SWITCH FLAG
JRST INFTST ;EXIT
; BEGIN OR END A PPN
BRACKT:
TRO R16,BRKBIT ;SET BRACKET BIT
JRST INFTST ; EXIT
; HERE WE STORE THE CHARACTER IN R14, BUT FIRST CONVERTING
; TO SIXBIT. ANY CHARACTER AFTER THE SIXTH IS LOST.
STORE: TRO R16,INFBIT!NULBIT ;TURN ON BIT FOR CR ROUTINE
SUBI R5,40 ;CONVERT SIXBIT TO ASCII
TLNE R6,770000 ;DON'T STORE IF NO ROOM FOR CHAR
IDPB R5,R6 ;PLOP THE CHARACTER INTO AC R14
JRST GETCMN ;RETURN
; SWITCH PROCESSOR
SWTPRC:
CALL GETWRD ;GET THE SWITCH
JRST ERRSE ; NULL SWITCH IS AN ERROR
TRNE R14,-1 ;ONLY 3 CHARS FOR SWITCH
JRST ERRSE ; TOO MANY CHARS
HLRZ R0,R14 ;SET-UP FOR TABLE SEARCH
PUSH R17,R1 ;SAVE A COPY OF DEVICE FOR LATER
MOVE R1,SWTTBL ;GET SWITCH TABLE ADDRESS
CALL TABSRC ;SEARCH IT
JRST ERRBS ;CAN'T FIND SWITCH
JRST (R2) ;GO TO CORRECT PROCESSOR
SWTTBL:
XWD -<TABEND-SWTTBL>, .+1
XWD .CREF,(SIXBIT /CRF/)
XWD .LI,(SIXBIT /LI/)
XWD .NL,(SIXBIT /NL/)
XWD .EN,(SIXBIT /EN/)
XWD .DS,(SIXBIT /DS/)
XWD .FORMT,(SIXBIT /FO/)
XWD .PASS,(SIXBIT /PA/)
TABEND=. ;END OF SWITCH TABLE
SUBTTL SWITCH PROCESSING ROUTINES
.CREF:
TRNN R16,CKBBIT!CKLBIT ;NOT ON SOURCE FILES
JRST ERRWF ; ERROR IF SOURCE
TRNN R16,COLBIT ;ANY ARGUMENTS?
JRST [ TLO R16,CSWBIT ;NOPE
JRST SWTCHK ] ;SET FLAG AND EXIT
CALL GETWRD ;YUP - GET THE ARGUMENT
JRST ERRSE ;OOPS, FORGOT IT?
TRNE R14,-1 ;IS IT TOO LONG?
JRST ERRSE ;TOO BAD
HLRZ R14,R14 ;SWAP HALVES
CAIE R14,(SIXBIT /NG/) ;ONLY ONE ARGUMENT ALLOWED
JRST ERRSE ;WRONG ONE
; NOTE: THERE IS NO CODE TO CREATE A FILE THAT CAN BE RUN THROUGH CREF,
; BUT INSTEAD OF FLAGGING ERROR, JUST ASSUME CRF WITHOUT ARGUMENTS.
TLO R16,CSWBIT ;SET FLAG
JRST SWTCHK ; AND EXIT
; /LI AND /NL PROCESSOR
.NL: TRO R16,NLTBIT ;THIS IS /NL NOT /LI
.LI: TRNE R16,CKBBIT ;MAKE SURE NOT BINARY FILE
JRST ERRSE ; ERROR IF IT IS
TRNN R16,COLBIT ;ARGUMENTS TO COME?
JRST NOLARG ; NOPE
GTARG0: CALL GETWRD ;YES- GET IT THEN
JRST ERRSE ;MUST HAVE ARG
TRNE R14,-1 ;CAN'T HAVE MORE THAN 3 CHARS
JRST ERRSE ; ERROR IF SO
HLRZ R0,R14 ;SET-UP FOR CONVERSION TO M40
CALL SIXM40 ;CONVERT IT SO WE CAN DO TABLE SEARCH
MOVE R1,LISTBL ;TABLE IN WHICH TO SEARCH
CALL TABSRC ;LOOK FOR IT
JRST ERRSE ; ILLEGAL ARGUMENT
MOVE R3,LIWORD ;GET LIST CONTROL WORD
TRNE R16,NLTBIT ; /NL OR /LI?
TRZA R3,(R2) ;CLEAR FLAG (/NL)
TRO R3,(R2) ;SET FLAG (/LI)
TLO R3,(R2) ;SET MASK BIT TO FORCE OVERRIDE.
MOVEM R3,LIWORD ;SAVE IT
TRNE R16,COLBIT ;ANY MORE WITH THIS ATTRIBUTE?
JRST GTARG0 ; YES, GET THEM
CALL SETLF ;NO - SET GENUINE LISTING FLAGS.
SWTCHK:
TRZ R16,DSABIT!NLTBIT ;CLEAN OFF MODE BITS
POP R17,R1 ;RESTORE DEVICE NAME
TRNE R16,SWTBIT ;SWITCH TO PROCESS?
JRST SWTPRC ;YES
RETURN ;NO, RETURN
; /LI OR /NL SWITCH WITHOUT QUALIFIER . . .
; OVERRIDE LSTCNT'S VALUE AS FOLLOWS:
; /NL: FORCE LSTCNT NEGATIVE BY ORING ITS LEFT HALF TO BITS.
; /LI: SET LSTCNT'S LEFT HALF TO MATCH IT'S RIGHT HALF.
NOLARG: MOVE R0,LSTCNT ; GET CURRENT LIST LEVEL.
TRZE R16,NLTBIT ; IS THIS /LI OR /NL?
JRST NOLNL ; /NL -- SET LEFT HALF (NEGATIVE).
TLZ R0,-1 ; /LI -- CLEAR LEFT HALF.
TRNE R0,400000 ; IS RIGHT HALF NEGATIVE?
NOLNL: TLO R0,-1 ; YES - FORCE LEFT HALF NEGATIVE.
MOVEM R0,LSTCNT ; STUFF RESULT BACK IN CONSECRATED CORE.
JRST SWTCHK
; /EN AND /DS
.DS: TRO R16,DSABIT ; /DS WAS TYPED
.EN: TRNE R16,CKBBIT!CKLBIT ;LOOKING FOR SOURCE?
JRST ERRSE ;NOPE- ERROR
TRNN R16,COLBIT ;COLON FOR ARGUMENTS?
JRST ERRSE ;MUST HAVE IT FOR /EN OR /DS
GTARG: CALL GETWRD ;GET ARGUMENT
JRST ERRSE ;NULL ARGUMENT NOT ALLOWED
TRNE R14,-1 ;ARGUMENT CAN'T BE GREATER THAN 3 CHARS
JRST ERRSE ;ERROR IF IT IS
HLRZ R0,R14 ;ARGUMENT IN R0 FOR SIXM40
CALL SIXM40 ;CONVERT TO M40
MOVE R1,ENATBL ;FIRST WORD OF TABLE
CALL TABSRC ;SEARCH IT
JRST ERRSE ;CAN'T FIND IT - ERROR
MOVE R3,ENACTL ;GET /EN AND /DS CONTROL WORD
TRNE R16,DSABIT ; /DS?
TRZA R3,(R2) ;NO, SET BIT
TRO R3,(R2) ;YES, CLEAR FLAG
TLO R3,(R2) ;SET MASK BIT TO SHOW OVERRIDE
MOVEM R3,ENWORD ;SAVE FLAG WORD
TRNE R16,COLBIT ;ANY MORE ARGUMENTS TO PROCESS?
JRST GTARG ; YES - DO THEM FIRST
CALL SETEN ;NO - MERGE ENABLE OPTIONS
JRST SWTCHK ;CHECK FOR MORE SWITCHES
; FORMAT CONTROL
.FORMT:
TRNN R16,CKBBIT ;FORMAT IS ONLY FOR BINARY FILES
JRST ERRTB ;ERROR IF OTHERWISE
TRNN R16,COLBIT ; AND MUST HAVE ARGS
JRST ERRSE ;ERROR IF NONE
CALL GETWRD ;GET THE ARGUMENT
JRST ERRSE ;ERROR IF NONE
TRNE R14,-1 ;MORE THAN 3 CHARS?
JRST ERRSE ; YES, ERROR
HLRZ R1,R14 ;GET IT IN RH
CAIN R1,(SIXBIT /I/) ;I FOR IMAGE MODE
JRST [ TLO R15,PSWFLG ;YES- SET FLAG
JRST SWTCHK ] ;AND CHECK FOR NEXT SWITCH
CAIE R1,(SIXBIT /P/) ;P FOR PACKED BINARY
JRST ERRSE ;ERROR IF NOT
JRST SWTCHK ;DEFAULT IS PACKED SO EXIT
.PASS:
JRST ERRBS ;TEMP!!!
IFN STANSW,<
; PROCESS A STANFORD PPN.
; WHERE SIXBIT VALUE IS STORED RIGHT JUSTIFIED IN EACH HALF
; WORD IN THE LOOKUP OR ENTER BLOCK.
PPNPRC:
CAIE R5,"[" ;MUST BEGIN WITH A "["
JRST ERRSE ; ELSE ERROR
SETZM XE3 ;CLEAR PPN WORD
CALL GETWRD ;GET THE FIRST PART OF THE PPN
JRST ERRSE ; ERROR IF NONE
TRNN R14,-1 ;MORE THAN 3 CHARS
TRNN R16,COMBIT ; OR NOT ENDING WITH A COMMA IS AN ERROR
JRST ERRSE ;SYNTAX ERROR
STPPN1: TLNN R14,77 ;IS IT RIGHT JUSTIFIED YET?
JRST [ LSH R14,-6 ; NO, SHIFT OVER 6 BITS
JRST STPPN1 ] ; AND CHECK AGAIN
HLLM R14,XE3 ;SAVE FIRST PART IN BLOCK
CALL GETWRD ;GET NEXT WORD
JRST ERRSE ;ERROR IF NONE
TRNN R14,-1 ;AGAIN IS IT MORE THAN 3 CHARS?
TRNN R16,BRKBIT ; OR NOT ENDING WITH A BRACKET?
JRST ERRSE ; YES, ERROR
CAIE R5,"]" ;MAKE SURE IT ENDED WITH A "]"
JRST ERRSE ; ERROR IF IMPROPER ENDING
STPPN2: TLNN R14,77 ;SEE IF IT IS RIGHT JUSTIFIED
JRST [ LSH R14,-6 ; IF NOT THEN SHIFT RIGHT 6 BITS
JRST STPPN2 ] ; AND CHECK AGAIN
HLRM R14,XE3 ; OK, SAVE IT
RETURN ; AND RETURN
>
; TABLE SEARCH
; TABSRC WILL SEARCH A TABLE FOR A SPECIFIED ENTRY.
; ARGUMENTS: R0 - DATA TO SEARCH FOR IN RH
; R1 - FIRST WORD IN TABLE
;
; RETURNS: +1 IF ARGUMENT WAS NOT FOUND IN TABLE SPECIFIED.
; +2 IF FOUND, WITH LH OF TABLE ENTRY IN RH OF R2
TABSRC:
MOVE R2,(R1) ;GET ADDRESS OF NEXT ENTRY
CAIN R0,(R2) ;MATCH?
JRST FND ;YES!!
AOBJN R1,TABSRC ;NO, INCREMENT AND LOOP BACK
RETURN ;COULDN'T FIND IT
FND: HLRZ R2,R2 ;MOVE IT TO R2
JRST CPOPJ1 ;RETURN +2
IFE STANSW,<
PPNPRC:
SETZM XE3 ;CLEAR NUMBER
LFTBR1: HRLZS XE3 ;COMMA, MOVE TO LEFT HALF
LFTBR2: CALL GETTTI ;GET NEXT CHAR
CAIN R5,"]" ;TERMINAL?
JRST GETWRD ;GET THE NEXT WORD FOR GETFIL
CAIN R5,"," ;SEPARATOR?
JRST LFTBR1 ;YES
CAIL R5,"0" ;TEST FOR OCTAL NUMBER
CAILE R5,"7"
IFE CMUSW,<JRST ERRIC ;IMPROPER CHARACTER>
IFN CMUSW,<JRST CMUID ;CHECK FOR CMU USERID>
HRRZ R10,XE3 ;OK, GET PREVIOUS VALUE
IMULI R10,8
ADDI R10,-"0"(R5) ;ACCUMULATE NEW NUMBER
HRRM R10,XE3
JRST LFTBR2
>
IFN CMUSW,<
CMUID: MOVE R10,[POINT 7,CMUSTR] ;POINTER TO ASCII STRING
SETZM CMUSTR ;CLEAR STRING LOCATION
SETZM CMUSTR+1
IDPB R5,R10 ;FIRST CHAR OF USERID
MOVEM R10,CMUPTR ;STORE POINTER
MOVEI R10,7 ;COUNT FOR LOOP
MOVEM R10,CMUCTR ;STORE COUNT
CMULOP: CALL GETTTI ;GET CHAR
CAIN R5,"]" ;END CHAR
JRST CMUCVT ;CONVERT USERID TO PPN
IDPB R5,CMUPTR ;DEPOSIT CHAR IN STRING
SOSL CMUCTR ;DECR COUNTER
JRST CMULOP ;REPEAT LOOP
JRST ERRUID ;TOO MANY CHARS
CMUCVT: HRRZI R10,CMUSTR ;ADDRESS OF STRING
HRLI R10,XE3 ;DESTINATION OF CONVERTED NUMBER
CALLI R10,-2 ;CMUDEC UUO
JRST ERRUID ;ILLEGAL USERID
JRST GETCMN ;DONE
>
;THE FOLLOWING CODE IS USED FOR PROCESSING THE COMMAND
;STRINGS FOR THE CCL COMMAND FEATURES
IFN CCLSW,<
DSKNIT: ;INIT DSK FOR CCL
HRRZ R0,JOBFF ;USE JOBFF AS START OF CCL BUFFER
HRRM R0,CMDPNT ;DUMMY UP BUFFER HEADER
HRRM R0,TMPFIL+1 ;SET UP TMPCOR READ BLOCK
SOS TMPFIL+1 ;MAKE IT PROPER IOWD FORMAT
HRRI R1,(SIXBIT /P11/)
HRLM R1,TMPFIL ;SETUP NAME OF FILE TO BE READ
MOVNI R1,200 ;AND WORD COUNT
HRLM R1,TMPFIL+1 ;IN READ BLOCK
MOVE R1,[XWD 2,TMPFIL] ;SET UP AC FOR A READ
TMPCOR R1, ;READ AND DELETE "FOR" FILE
JRST TMPEND ;NO FILE IN CORE TRY DISK
ADD R0,R1 ;GET END OF FILE
MOVEM R0,JOBFF ;UPDATE JOBFF SO FILE ISN'T WIPED OUT
HRLM R0,JOBFFI ;SAVE FOR LATER
IMULI R1,5 ;CALCULATE CHARACTER COUNT
MOVEM R1,CMDCNT ;STORE IN BUFFER HEADER
MOVSI R1,(POINT 7,,) ;BYTE POINTER
HLLM R1,CMDPNT ;BUFFER HEADER NOW SETUP
SETOM TMPFLA ;MARK THAT TMPCOR UUO IN PROGRESS
JRST CPOPJ1
TMPEND:
IFE STANSW,<
MOVEI R0,3 ;INIT 3 DIGIT COUNTER
PJOB R2, ;GET JOB NUMBER
DSKNI1: IDIVI R2,↑D10 ;GET LAST DIGIT
ADDI R3,"0"-40 ;CONVERT TO SIXBIT
LSHC R3,-6 ;SLIDE CHAR INTO AC4
SOJG R0,DSKNI1 ;3 CHARS YET?
HRRI R4,(SIXBIT /P11/) ;YES, GET FILENAME ###P11.TMP
MOVEM R4,XE ;SAVE FILE NAME IN LOOKUP DIRECTORY
MOVSI R4,(SIXBIT /TMP/) ;SET UP EXTENSION
MOVEM R4,XE1 ;SAVE EXTENSION IN LOOKUP DIRECTORY
>;IFE STANSW
IFN STANSW,<
MOVE R4,[SIXBIT/QQMACN/]
MOVEM R4,XE
MOVSI R4,(SIXBIT/RPG/)
MOVEM R4,XE1
>;IFN STANSW
SETZM XE3 ;ZERO PROJ,PROG #'S
MOVEI R0,ALMODE ;ASCII LINE DATA MODE
MOVSI R1,(SIXBIT /DSK/)
MOVEI R2,CMDBUF ;GET BUFFER HEADER ADDRESS
OPEN CMD,R0 ;INIT DSK OK?
JRST DSKNI2 ;NO, TYPE MESSAGE
LOOKUP CMD,XE ;LOOKUP ###FOR, TMP ON DISK
JRST DSKNI2 ;FILE NOT FOUND
INBUF CMD,1 ;ONE INPUT BUFFER
MOVE R0,JOBFF
HRLM R0,JOBFFI
JRST CPOPJ1 ;FILE FOUND, SKIP RETURN
DSKNI2: MOVE R0,JOBFF
HRLM R0,JOBFFI
JRST ERRCF1
GETCM3: MOVNI R0,5 ;SKIP OVER SEQUENCE NUMBER
ADDM R0,CMDCNT ;REDUCE COUNT BY 5 BYTES
AOS CMDPNT ;ADVANCE POINTER, FALL THROUGH
GETCMD: SOSG CMDCNT ;ANY CHARACTERS LEFT?
CALL GETCM1 ;NO GET ANOTHER BUFFER FULL
ILDB R5,CMDPNT ;GET CHARACTER
MOVE R0,@CMDPNT ;CHECK FOR SEQUENCE NUMBER
TRNE R0,1
JRST GETCM3 ;BY-PASS THE SEQUENCE NUMBER
CAIN R5,175 ;OLD ALTMODE?
MOVEI R5,33 ;YES, MAKE IT NEW ALTMODE
CAIL R5,140 ;IS CHARACTER LOWER CASE?
TRZ R5,40 ;YES, CHANGE TO UPPER CASE
MOVE R2,R5
RETURN ;EXIT WITH CHARACTER
GETCM1:
IFN TEMPC,<
SKIPE TMPFLA ;IS A TMPCOR UUO GOING?
JRST GETCM2 ;YES, THEN WE ARE DONE?
>
IN CMD,
RETURN ;NO ERRORS OR END OF FILE
STATZ CMD,IODATA!IODEV!IOBKTL
JRST ERRCMD ;DATA ERRORS
GETCM2:
JSP R10,DELFIL ;DELETE FILE
EXIT
DELFIL: SKIPE INDFLA ;DON'T DELETE IF INDIRECT FILE
JRST (R10)
CLOSE CMD,0 ;CLOSE COMMAND FILE
SETZB R4,R5
SETZB R6,R7
IFN TEMPC,<
SKIPE TMPFLA ;TMPCOR BEING USED?
JRST (R10) ;YES, DON'T RENAME FILE?
>
RENAME CMD,R4
JFCL
JRST (R10) ;RETURN
RUNUUO: ;PASS PROGRAM CONTROL TO NEXT PROGRAM (LNKX11)
SKIPN R1
MOVSI R1,(SIXBIT /SYS/) ;IF NO DEVICE, ASSUME SYS:
TRNN R16,EXTBIT ;PERIOD TYPED?
MOVEM R14,XE ;NO, THEN FILE NAME IS IN R14
TRNN R16,EXTBIT ;PERIOD TYPED?
MOVEI R14,0 ;NO, ASSUME 0 EXTENSION
HLLZM R14,XE1 ;SAVE IN DIRECTORY
JSP R10,DELFIL ;DELETE COMMAND FILE
MOVE R0,[XWD 1,R1] ;START INCREMENT,,6 WORD RUN BLOCK ADR
;R1 = DEVICE
MOVE R2,XE ;GET FILENAME
MOVE R3,XE1 ;GET EXTENSION
SETZB R4,R6
MOVE R5,XE3 ;GET PROJ,PROG
RUN R0, ;START NEXT PROGRAM
JSP R10,ERROR ;RUN FAILED
ASCIZ /LINKAGE ERROR FOR 23/
INDFIL: TRNN R16,EXTBIT ;SET UP THE FILENAME IF NECESSARY
MOVEM R14,XE
TRNN R16,ARWBIT ;NORMAL MODE
TLNN R16,BINBIT ;OR BINARY SPECIFIED?
JRST ERRIC ;YES, ILLEGAL CHARACTER
MOVE R0,[INIT CMD,ALMODE]
SKIPN R1 ;INIT CMD FOR @ FILE
MOVSI R1,(SIXBIT /DSK/)
MOVEI R2,CMDBUF
CALL CMDSET
XWD INBIT,1←ALMODE ;LEGAL BITS FROM DEVCHR
TRZE R16,EXTBIT ;EXTENSION?
JRST INDFI1 ;YES, DON'T TRY ASSUMPTIONS
MOVSI R14,(SIXBIT /CMD/)
HLLZM R14,XE1
LOOKUP CMD,XE
TDZA R14,R14 ;TRY NULL EXTENSION
JRST INDFI2
INDFI1: HLLZM R14,XE1
LOOKUP CMD,XE
JRST ERRCF ;CANNOT FIND COMMAND FILE
INDFI2: SETOM CCLFLA ;NON-STANDARD COMMAND STRING
SETOM INDFLA ;SET INDIRECT FLAG
INBUF CMD,1 ;SINGLE BUFFER
MOVE R14,JOBFF
HRLM R14,JOBFFI ;SAVE DATA RESTORE ADDRESS
JRST NXTCCL
>
HEADER: CALL ACEXCH ;YES, SAVE THE ACCUMULATORS
PUSH R17,R16 ;SAVE CURRENT FLAGS
TLO R16,LOHBIT ; NO TTY OUTPUT, FLAG HDR OUT
MOVEI R2,FF ;GET A FORM FEED
CALL LSTDMP ;OUTPUT IT
MOVEI R10,PAGSIZ+3 ;RESET LINE COUNTER REGISTER
MOVEM R10,LINCNT ;...
SKIPN TTLFLA ;DO WE HAVE TITLE?
JRST [
MOVE R0,PRGTTL
CALL LSTSYM ;PRINT JUST NAME
JRST .+3
]
MOVE R10,[POINT 7,TTLMSG] ;YES - PRINT OUT WHOLE TITLE
CALL LSTASC
CALL LSTTAB
MOVE R0,TITLE
CALL LSTSIX
CALL LST3SP
MOVE R0,ASMVER ;PRINT VERSION NO.
CALL LSTSIX
CALL LST3SP
IFE TENEX,<
;THE FOLLOWING SECTION PRINTS THE DATE, WHICH IS FOUND IN
;REGISTER XDATE IN THE FORM
; ((Y-1964)*12 + (M-1))*31 + (D-1)
MOVE R10,DATE ;GET THE DATE IN R10
IDIVI R10,↑D31 ;DIVIDE BY 31 DECIMIAL
ADDI R11,1
CALL DNC ;OUTPUT DAY
IDIVI R10,↑D12 ;DIVIDE BY 12 DECIMAL
MOVE R0,MONTH(R11)
CALL LSTSIX ;OUTPUT THE MONTH, (M-1) IS IN R12
MOVEI R11,↑D64(R10) ;GET THE YEAR
CALL DNC ;TYPE IT
CALL LST3SP ;OUTPUT TAB
;THE FOLLOWING SECTION OF CODE PRINTS THE TIME, WHICH IS
;PICKED UP FROM THE MONITOR AS THE NUMBER OF MILLISECONDS
;SINCE MIDNIGHT. THE FORMAT OF THE TIME PRINTOUT IS HH:MM
MOVE R11,MSTIME ;GET THE CURRENT TIME
IDIVI R11,↑D60*↑D1000 ;NUMBER OF MIN. SINCE MIDNITE
IDIVI R11,↑D60 ;NUMBER OF HOURS
PUSH R17,R12 ;SAVE MINUTES
CALL DNC ;OUTPUT THE HOURS
MOVEI R2,":" ;OUTPUT A COLON AFTER THE HOURS
CALL LSTDMP ;OUTPUT IT
POP R17,R11 ;PUT MINUTES IN OUTPUT AC
MOVEI R2,"0" ;GET AN ASCII ZERO
CAIG R11,↑D9 ;IS IT A ONE-DIGIT NUMBER?
CALL LSTDMP ;YES, OUTPUT A ZERO
CALL DNC ;OUTPUT THE MINUTES
>
IFN TENEX,<
MOVE R10,[POINT 7,DATSTR] ; LIST TIME AND DATE.
CALL LSTASC
>
;THIS SECTION OF CODING PICKS UP THE WORD "PAGE " AND
;STORES IT IN THE PROPER PLACE IN THE TITLE BUFFER.
CALL LST3SP
MOVE R0,[SIXBIT /PAGE/]
CALL LSTSIX ;PRINT "PAGE"
MOVEI R2," "
CALL LSTDMP ;SPACE
MOVE R11,PAGNUM ;GET PAGE NUMBER
CALL DNC ;CONVERT TO DECIMAL AND PRINT
CALL LSTCR
AOS PAGNUM ; INCREMENT FOR NEXT PAGE
;THE FINAL SECTION OF CODE PICKS UP A SUBTITLE (IF AVAILABLE)
;AND PUTS IT ON THE SECOND LINE OF THE PAGE
CALL LSTFIL ;PRINT FILE NAME FIRST
TLNN R16,SBTBIT ;DO WE HAVE A SUBTITLE?
JRST NOSBTL ;NONE SEEN
MOVE R10,[POINT 7,SUBMSG] ; POINT TO SUBTITLE BUFFER
CALL LSTASC ; LIST IT.
NOSBTL: CALL LSTCR ; END THE LINE.
CALL LSTCR ;SECOND LINE CRLF
POP R17,R2 ;RESTORE FLAGS
JRST ACEXCH ;RESTORE F4 REGS AND EXIT
LSTFIL: PUSH R17,R0
MOVE R0,XE ;GET FILE NAME
CALL LSTSIX
CALL LST2SP
MOVE R0,XE1 ;GET EXTENSION
CALL LSTSIX ;LIST IT OUT
CALL LSTTAB ; SEPARATE WITH A TAB
POP R17,R0
RETURN
DNC: IDIVI R11,↑D10 ;RECURSIVE SUBROUTINE
HRLM R12,0(R17) ;SAVE REMAINDER ON PUSHDOWN LIST
CAIE R11, ;ALL DONE?
CALL DNC ;NO, CALL DNC AGAIN
HLRZ R2,0(R17) ;RETRIEVE NUMBER FROM PD LIST
JRST LSTNUM ;LIST NUMERIC AND EXIT
LSTSIX: MOVSI R6,(POINT 6,R0,)
LSTSI1: ILDB R2,R6
JUMPE R2,CPOPJ
ADDI R2," "
CALL LSTOUT
TLNE R6,770000
JRST LSTSI1
RETURN
MONTH: SIXBIT /-JAN-/
SIXBIT /-FEB-/
SIXBIT /-MAR-/
SIXBIT /-APR-/
SIXBIT /-MAY-/
SIXBIT /-JUN-/
SIXBIT /-JUL-/
SIXBIT /-AUG-/
SIXBIT /-SEP-/
SIXBIT /-OCT-/
SIXBIT /-NOV-/
SIXBIT /-DEC-/
IFN CCLSW,<
;CALL: CALL CMDSET
; XWD BITS1,BITS2 ;LEGAL BITS ON DEVCHR
; RETURN
CMDSET: MOVE R3,R1 ;GET DEVICE NAME
DEVCHR R3,
SETCMM R3 ;COMPLEMENT BITS
TDNE R3,@(R17) ;WERE ALL BITS ONE?
JRST ERRNIT ;NO
AOS (R17) ;YES, SKIP RETURN
;FULL THROUGH
>
INISET: MOVE R3,[JRST ERRNA];ERROR EXIT FOR INIT
MOVSI R4,(POPJ R17,)
JRST R0
SUBTTL EXEC ERROR ROUTINES
ERRCMD: MOVEI R10,[ASCIZ /DEVICE INPUT ERROR FOR COMMAND STRING/]
JRST ERROR
ERRNIT: MOVEI R10,[ASCIZ /IMPROPER IO FOR DEVICE 2/]
JRST ERROR
IFN CCLSW,<
ERRCF1: SETZM CCLFLA ;LOOKUP FOR DSK:###P11.TMP FAILED
>
ERRCF: MOVEI R10,[ASCIZ /CANNOT FIND 234/]
JRST ERROR
ERRID: MOVEI R10,[ASCIZ /INPUT DATA ERROR 234/]
JRST ERROR
ERRBS: MOVEI R10,[ASCIZ /1 IS A BAD SWITCH/]
JRST ERROR
ERRIC: MOVEI R10,[ASCIZ /1 IS AN ILLEGAL CHARACTER/]
JRST ERROR
ERRNA: MOVEI R10,[ASCIZ /2 IS NOT AVAILABLE/]
JRST ERROR
ERRNR: MOVEI R10,[ASCIZ /NO ROOM FOR 234/]
JRST ERROR
ERRSE: MOVEI R10,[ASCIZ /SYNTAX ERROR IN COMMAND STRING/]
JRST ERROR
ERRNC: MOVEI R10,[ASCIZ /INSUFFICIENT CORE/]
JRST ERROR
ERRWF: MOVEI R10,[ASCIZ /1 ILLEGAL SWITCH FOR INPUT/]
JRST ERROR
ERRTF: MOVEI R10,[ASCIZ /TOO MANY INPUT FILES/]
JRST ERROR
ERRTB: MOVEI R10,[ASCIZ /2 ILLEGAL FOR BINARY OUTPUT/]
JRST ERROR
IFN CMUSW,<
ERRUID: MOVEI R10,[ASCIZ /ILLEGAL USERID/]
JRST ERROR
>
ERROR: ;NON-RECOVERABLE ERROR MESSAGE
PUSH R17,R10 ;STACK MESSAGE ADDRESS
TLNE R16,MODBIT ;HAVE WE EXEC AC'S?
CALL ACEXCH ; NO, GET THEM
POP R17,R10 ;RESTORE MESSAGE POINTER
MOVSI R16,ERRBIT!LSTBIT!BINBIT ;FUDGE FLAGS
CALL LSTCR
MOVEI R2,"?"
CALL LSTOUT
CALL LSTSP ;TYPE SPACE
CALL LSTMCR
CALL LSTCR
JRST START
LSTMCR: CALL LSTMSG
JRST LSTCR ;LIST MESSAGE AND CRR
LSTMSG: TLOA R10,(POINT 7,,) ;SET BYTE POINTER AND SKIP
LSTMS4: CALL LSTOUT ;TYPE CHARACTER
LSTMS5: ILDB R2,R10 ;GET CHARACTER
JUMPE R2,CPOPJ ;TEST FOR END
CAIL R2,"1" ;TEST FOR SWITCH
CAILE R2,"5"
JRST LSTMS4 ;NO, TYPE THE CHARACTER
CALL @[EXP ERR1,ERR2,ERR3,ERR4,DNC]-"1"(R2)
JRST LSTMS5 ;GET NEXT CHARACTER
ERR1: MOVE R2,R5 ;GET IMPROPER CHARACTER
JRST LSTOUT ;DUMP IT
ERR2: MOVE R0,R1 ;GET DEVICE NAME
CALL LSTSIX ;TYPE IT
MOVEI R2,":"
JRST LSTOUT ;TYPE ":"
ERR3: MOVE R0,XE ;GET FILE NAME
JRST LSTSIX ;TYPE IT
ERR4: HLLZ R0,XE1 ;GET EXTENSION
JUMPE R0,CPOPJ ;EXIT IF NULL
MOVEI R2,"."
CALL LSTOUT ;TYPE "."
JRST LSTSIX
; ********** LIST AN ASCII STRING **********
LSTASC: ILDB R2,R10 ; LOAD NEXT BYTE.
JUMPE R2,CPOPJ ; QUIT WHEN FINDING A 0 BYTE.
CALL LSTOUT ; OUTPUT THE BYTE.
JRST LSTASC
EXIT: CLOSE SRC, ;CLOSE THE SOURCE DEVICE
CLOSE LST, ;CLOSE THE LISTING FILE
CLOSE BIN, ;CLOSE THE BINARY FILE
TLON R16,LSTBIT ;WAS THERE A LISTING FILE?
CALL LSTTST ;YES, TEST FOR FINAL ERROR
TLON R16,BINBIT ;IS THERE A BINARY FILE?
CALL BINTST ;YES, TEST FOR FINAL ERROR
TRNN R16,ENDBIT ;END OF COMMAND STRING?
JRST ERRTF ; NO, MARK ERROR
IFN CCLSW,<
SKIPN CCLFLA ;RESTART IF NOT CCL MODE
JRST START
HLRZ R0,JOBFFI
MOVEM R0,JOBFF ;RESTORE DATA AREA
RELEAS LST,0
RELEAS BIN,0
RELEAS SRC,0
EXIT6: CALL GETCMD ;GET NEXT COMMAND CHAR
CAIL R5,12 ;THROW AWAY REST
CAILE R5,15 ;OF LAST LINE
CAIA
JRST EXIT6
MOVSI R5,070000 ;BACK UP BYTE
ADDM R5,CMDPNT ;POINTER ONE BYTE
AOS CMDCNT
JRST NXTCCL ;GO DO NEXT COMMAND
>
IFE CCLSW,<
JRST START ;BACK TO BEGINNING
>
CORSET: ;INIT DYNAMIC MEMORY
; ; I.E. **** INITIALIZE SYMBOL TABLE ****
HRRZ R0,JOBREL ;GET TOP OF CORE
MOVEM R0,SYMTOP ; SET SAME AS SYMBOL TABLE TOP.
MOVE R1,R0 ; .. SAVE FOR BLOCK TRANSFER.
SUBI R0,PSLEN ; SET INITIAL BOTTOM POINTER.
MOVEM R0,SYMBOT ;STORE IT
HRLI R0,PERMST ; COPY GENUINE PERMANENT SYMBOLS
BLT R0,0(R1) ; (NOT OP CODES!) INTO SYMBOL TABLE.
JRST SRCHI ;INITIALIZE THE SYMBOL TABLE AND RETURN
ACEXCH: ;SWAP AC'S
TLC R16,MODBIT ;TOGGLE MODE BIT
EXCH R0,AC00
EXCH R1,AC01
EXCH R2,AC02
EXCH R3,AC03
EXCH R4,AC04
EXCH R5,AC05
EXCH R6,AC06
EXCH R7,AC07
EXCH R10,AC10
EXCH R11,AC11
EXCH R12,AC12
EXCH R13,AC13
EXCH R14,AC14
RETURN
;ROUTINE TO OUTPUT RELOCATABLE BINARY
BINWRD: ;OUTPUT BINARY WORD
PUSH R17,R2 ;STACK WORD
CALL BINOUT ;OUTPUT LOW BYTE
POP R17,R2
LSH R2,-8 ;MOVE HIGH INTO LOW
;FALL THROUGH
BINOUT: ;BINARY OUTPUT
ANDI R2,377 ;MASK TO 8 BITS
ADDM R2,CHKSUM ;UPDATE CHECKSUM
BINOU2: TLNE R16,BINBIT ;BINARY REQUESTED?
RETURN ; NO, EXIT
TLNN R15,PSWFLG ;PACKED MODE?
JRST BINOU3 ; YES
SOSG BINCNT
CALL BINDMP
IDPB R2,BINPNT
RETURN
BINOU3: PUSH R17,R3
SOSLE BINPCT
JRST BINOU4
CALL BINDMP
MOVE R3,BINCNT
IMULI R3,4
MOVEM R3,BINPCT
BINOU4: MOVN R3,BINPCT
ANDI R3,3
JUMPN R3,BINOU5
SOS BINCNT
IBP BINPNT
BINOU5: DPB R2,BINTBL(R3)
POP R17,R3
RETURN
BINDMP: OUTPUT BIN,
BINTST: STATO BIN,IODATA!IODEV!IOWRLK
RETURN
MOVEI R10,[ASCIZ /BINARY OUTPUT ERROR/]
JRST ERROR ;TYPE ERROR MESSAGE
BINTBL:
POINT 8,@BINPNT,17
POINT 8,@BINPNT, 9
POINT 8,@BINPNT,35
POINT 8,@BINPNT,27
SUBTTL EXEC ROUTINES USING ASSEMBLER AC'S
LSTSYM: ;LIST SYMBOL
PUSH R17,R0
TLNE R0,200000 ; IS THIS A LOCAL SYMBOL?
JRST LSTLOC ; -- YES -- DECODE ITS NAME
; -- NO -- SYMBOL IS IN MOD40
CALL M40SIX ;CONVERT TO SIXBIT
PUSH R17,R1 ;STACK A WORKING REGISTER
MOVSI R1,(POINT 6,R0)
LSTSY1: ILDB R2,R1
ADDI R2,40 ;CONVERT TO ASCII
CALL LSTOUT
TLNE R1,770000 ;TEST FOR END
JRST LSTSY1
LSTRET: POP R17,R1
POP R17,R0 ;RESTORE ORIGINAL
RETURN
; ***** LIST A LOCAL SYMBOL *****
; SYMBOL'S NUMERIC PART IS A 16-BIT NON-ZERO BINARY
; INTEGER IN THE LEFT HALF OF R0.
LSTLOC: TLZ R0,600000 ; RESET LOCAL SYMBOL FLAG BIT.
HLRZ R0,R0 ; ALIGN NUMERIC PART IN RIGHT HALF
PUSH RLINK,R1 ; SAVE WORKING REGS
PUSH RLINK,R3
MOVEI R3,6 ; INIT BYTE COUNT TO 6
; FOR COUNT DOWN TO 0.
; CONVERT NUMERIC PART OF SYMBOL TO DECIMAL.
CALL LSTLNU
MOVEI R2,"$" ; SUPPLY "$" SUFFIX
CALL LSTOUT
SOJE R3,LSTL5 ; QUIT IF FIELD IS FULL
LSTL4: CALL LSTSP ; PAD TO 6 BYTES WITH SPACES
SOJG R3,LSTL4
LSTL5: POP RLINK,R3 ; RESTORE WORK REGS & RETURN
JRST LSTRET
; RECURSIVE SUBROUTINE TO PRINT A DECIMAL NUMBER
; DECREMENTING A BYTE COUNT IN R3 ....
LSTLNU: IDIVI R0,↑D10 ; GENERATE NEXT DIGIT.
HRLM R1,0(RLINK) ; SAVE FOR PRINTING IN REVERSE ORDER.
CAIE R0,0 ; WAS QUOTIENT 0?
CALL LSTLNU ; NO -- REPEAT FOR NEXT DIGIT.
SOJ R3, ; YES - DECREMENT BYTE COUNT.
HLRZ R2,0(RLINK) ; PICK UP NEXT DIGIT,
JRST LSTNUM ; PRINT IT, & POP BACK TO CALLER.
LST3SP: ;LIST SPACES
CALL LSTSP
LST2SP: CALL LSTSP
LSTSP: MOVEI R2,SPACE
JRST LSTOUT
LSTNUM: TROA R2,"0" ;LIST NUMERIC
ADDI R2,40 ;CONVERT SIXBIT TO ASCII
JRST LSTOUT
LSTCR: TDZA R2,R2 ;LIST CR-LF
LSTTAB: MOVEI R2,TAB ;LIST A TAB
LSTOUT: ;LISTING ROUTINE
TLNN R16,LSTBIT ;LISTING REQUESTED?
CALL LPTOUT ; YES
TLNE R16,ERRBIT ;ERROR LISTING?
TLNE R16,TTYBIT ; YES, TO TTY?
RETURN ; NO
JUMPE R2,LSTOU1 ;BRANCH IF CR-LF
OUTCHR R2 ;LIST CHARACTER
RETURN ;EXIT
LSTOU1: OUTSTR [BYTE (7) CRR, LF, 0]
RETURN ;CR-LF TO TTY
LPTOUT: ;OUTPUT TO LISTING DEVICE
SKIPGE LSTCNT ;IF LIST LEVEL IS NEGATIVE
POPJ 17, ;THEN DON'T LIST
LPTOUA: TRZE R16,HDRBIT ;TIME FOR A HEADING?
CALL HEADER ; YES
JUMPE R2,LPTOU4 ;BRANCH IF CR-LF
CAIN R2,TAB
JRST LPTOU3 ;DON'T LIST TABS IMMEDIATELY
SKIPG TABCNT ;ANY TABS TO BE OUTPUT?
JRST LPTOU2 ; NO
PUSH R17,R2 ;YES, STACK CURRENT CHARACTER
LPTOU1: MOVEI R2,7
IORM R2,COLCNT ;FUDGE COLUMN COUNT
MOVEI R2,TAB
CALL LPTOU2 ;OUTPUT THE TAB
SOSE TABCNT ;DECREMENT, ANY MORE?
JRST LPTOU1 ;YES
POP R17,R2 ;NO, RESTORE CHARACTER
LPTOU2: AOSG COLCNT ;ANY COLUMNS AVAILABLE?
JRST LSTDMP ; YES
RETURN ; NO, EXIT
LPTOU3: AOS TABCNT ;TAB, BUMP COUNT
RETURN
LPTOU4: MOVEI R2,CRR ;CR-LF
CALL LSTDMP
MOVEI R2,LF
CALL LSTDMP
SOSG LINCNT ;END OF PAGE?
LPTINI: TRO R16,HDRBIT ; YES, SET FLAG
MOVNI R2,COLLPT ;SET FOR COLUMN COUNT
HRRZ R0,LSTCTL ; LOAD LIST CONTROL FLAGS
TRNE R0,LTTM ; IS IT TTY MODE?
MOVNI R2,COLTTY
MOVEM R2,COLCNT
SETZB R2,TABCNT ;ZERO TAB COUNT AND REGISTER
RETURN
LSTDMP: SOSG LSTBCT ;DECREMENT ITEM COUNT
CALL LIST1 ;EMPTY ENTIRE BUFFER
IDPB R2,LSTPNT ;STORE THE CHARACTER
CAIN R2,LF ;IF LINE FEED
TLNN R16,TTYBIT ;AND LISTING IS ON TTY,
RETURN
;DUMP THE BUFFER
LIST1: TLNE R16,LSTBIT ; IS LISTING BEING SUPPRESSED?
RETURN ; .. YES - JUST RETURN.
OUTPUT LST, ;EMPTY A BUFFER
LSTTST: STATO LST,IODATA!IODEV!IOWRLK ;CHECK FOR ERRORS
RETURN ;NO, EXIT
MOVEI R10,[ASCIZ /LISTING OUTPUT ERROR/]
JRST ERROR ;TYPE MESSAGE
; CODE BETWEEN CHARB AND CHAR SAVES A SEQUENCE NUMBER
; OF THE SORT SUPPLIED BY SOS AND SOME OTHER EDITORS.
; THE SEQUENCE NUMBER IS IDENTIFIED BY FINDING THE LOW ORDER
; BIT OF A DATA WORD SET TO 1; THE WORD ORDINARILY CONTAINS
; FIVE 7-BIT BYTES, LEFT ADJUSTED.
CHARB: MOVEM R2,SEQNUM ;SAVE SEQUENCE NUMBER
AOS SRCPNT ;INCREMENT POINTER PAST WORD
MOVNI R14,5 ;GET -5
ADDM R14,SRCCNT ;SUBTRACT 5 FROM WORD COUNT
TRO R16,SEQBIT
CHAR: JUMPN R12,CHAR2 ;BRANCH IF IN MACRO
SOSGE SRCCNT ;DECREMENT ITEM COUNT
JRST CHAR4 ;GET ANOTHER BUFFER IF NECESSARY
ILDB RBYTE,SRCPNT ; LOAD NEXT BYTE.
MOVE R2,@SRCPNT ; PICK UP THE WORD CONTAINING IT.
TRZE R2,1 ; IS SEQUENCE # BIT ON?
JRST CHARB ; YES - JUST SAVE LINE #.
CHAR1: LDB R2,C7PNTR ;MAP CHARACTER TYPE.
XCT CHARTB(R2) ;DECIDE WHAT TO DO
RETURN ;ACCEPT IT
CHAR2: CALL READMC ;GET A CHARACTER FROM MACRO TREE
JRST CHAR ; NULL, TRY AGAIN
TLO R16,MEXBIT ; SHOW MACRO EXPANSION IN PROGRESS
JRST CHAR1 ; CHECK THE CHARACTER
CHAR4: INPUT SRC, ;CALL MONITIOR FOR A BUFFER
STATZ SRC, IODATA+IODEV+IOBKTL+IOWRLK
JRST ERRID ;INPUT TRANSMISSION ERROR
STATO SRC, IOEOF ;WAS AN END OF FILE REACHED?
JRST CHAR ;GET NEXT CHAR
CLOSE SRC,
TRNN R16,ENDBIT ;CRR SEEN BY COMMAND SCANNER?
JRST CHAR6 ; NO, GET NEXT SOURCE
TLO R15,ENDFLG ;YES, FLAG END
MOVEI R14,LF ;MAKE IT A LINE
RETURN
CHAR6: CALL ACEXCH ;GET EXEC AC'S
MOVSI R1,'DSK' ; LOAD DEFAULT DEVICE NAME
CALL GETSRC ;GET THE NEXT SOURCE FILE
TRO R16,HDRBIT ;START NEW FILE
CALL ACEXCH ;SAVE EXEC AC'S AND RETURN
JRST CHAR
CHARTB: ;CHARACTER JUMP TABLE
PHASE 0
MOVEI R14,ILLCHR ;ILLEGAL CHARACTER
QJNU: JRST CHAR ;NULL, TRY AGAIN
QJCR: JFCL ;END OF STATEMENT
QJVT: MOVEI R14,LF ;VERTICAL TAB
QJSP: JFCL ;BLANK
QJPC: JFCL ;PRINTING CHARACTER
QJLC: JRST CHFOLD ; LOWER CASE, MAYBE FOLD
DEPHASE
; LOWER CASE CHARACTER -- FOLD INTO UPPER CASE
; UNLESS .ENABL LC IS IN EFFECT.
CHFOLD: TLNN RMODE,LCFLG ; IS LOWER CASE ENABLED?
SUBI R14,40 ; NO - FOLD INTO UPPER CASE.
RETURN
SUBTTL ASSEMBLER PROPER
ASSEMB: ;ASSEMBLER PROPER
TLO R15,P1F ;SET FOR PASS 1
MOVE R3,.MAIN.
MOVEM R3,PRGTTL ;INIT TITLE
MOVE R3,.ABS.
MOVEM R3,SECNAM ;INIT ABSOLUTE SECTOR
CALL INIPAS ;INITIALIZE PASS ONE
CALL BLKINI ;INITIALIZE BINARY OUTPUT
CALL LINE ;GO DO PASS ONE.
IFN CCLSW,<
CALL PRNAM ;PRINT THIS PROGRAM'S NAME IF CCL
>
TLZ R15,P1F ;RESET TO PASS 2
TRO R16,HDRBIT ; FORCE PAGE SKIP AFTER TOC.
CALL SETP2 ;RESET INPUT COMMAND STRING
CALL INIPAS
CALL LINE ;CALL THE ASSEMBLER (PASS TWO)
TLNE R16,LSTBIT ;LISTING?
MOVE R0,LSTCTL ; LOAD LISTING CONTROL FLAGS
TRNE R0,LSYM ; SYM TAB BIT SET?
CALL SYMTB ; YES - LIST SYMBOL TABLE.
RETURN
INIPAS:
MOVEI R0,OCTRDX ;SET DEFAULT GLOBAL RADIX TO OCTAL
MOVEM R0,GLBRDX
MOVEI R0,↑D8
MOVEM R0,RADVAL
HRLZI R0,LDEF ; SET DEFAULT LISTING MODES.
MOVEM R0,LSTCTL
CALL SETLF
HRLZI R0,ENDEF ; SET DEFAULT .ENABL MODES.
TLNE RMODE,P1F ; IS THIS START OF PASS 2?
JRST INEN ; NO -- JUST SET DEFAULTS.
TLNE RMODE,ABSFLG ; YES - COPY ABS/REL MODE FLAG
TLO R0,ABSFLG ; AS PASS 1 LEFT IT.
INEN: MOVEM R0,ENACTL ; STORE ENABL FLAGS.
CALL SETEN ; MERGE WITH SWITCH OVERRIDES.
TLNE R15,ABSFLG ;ABSOLUTE?
TDZA R5,R5 ; YES, SET PC TO ZERO
MOVSI R5,(1B<SUBOFF>) ; NO, SET TO RELOCATABLE
MOVSI R3,-↑D256
SETZM SECBAS(R3) ;INIT SECTOR BASES
AOBJN R3,.-1
MOVEI R0,1
MOVEM R0,PAGNUM ;INITIALIZE PAGE NUMBER
MOVEI R0,↑D64 ; INITIAL VALUE FOR NEXT
MOVEM R0,NEXGS ; MACRO-GENERATED LOCAL = 64.
SETZM SEQ ; SET LINE SEQ # = 0.
SETZM LSBLOC ; LOCAL SYMBOL BLOCK # = 0.
SETZM REPLVL
SETZB R12,CONLVL ; CLEAR MACRO BLOCK PTR & COND LVL.
HRRM R12,LSTCNT ; CLEAR RH OF LIST LEVEL.
JRST ENDLI ;EXIT THROUGH END OF LINE ROUTINE
LINE: ;PROCESS ONE LINE
CALL GETLIN ;GET A SOURCE LINE
CALL STMNT ;PROCESS ONE STATEMENT
CALL ENDLR ;PROCESS END OF LINE
TLZN R15,ENDFLG ;TEST FOR END STATEMENT
JRST LINE ;GET THE NEXT LINE
JRST ENDP ;END OF PASS
.MAIN.: GENM40 .,M,A,I,N,.
.ABS.: GENM40 ., ,A,B,S,.
GETLIN: ;GET THE NEXT SOURCE LINE
TLZ R16,NLISLN!MEXBIT!FOLBIT ; RESET LIST-RELATED FLAGS
; AND INPUT FOLDING OVERRIDE.
SKIPE FLTBUF ;SPREAD FLOATING TO LIST?
JRST GETLI7 ; YES
AOS SEQ ; INCREMENT LINE SEQUENCE #
MOVEI R6,1 ;SET COUNT TO FIRST CHAR
MOVE R13,LINPNT ;SET POINTER
GETLI1: CALL CHAR ;GET AN INPUT CHARACTER
CAIN R14,FF ;FORM FEED?
TROA R16,FFBIT ; YES, FLAG AND SKIP
CAIN R14,LF ;OR LINE FEED?
JRST GETLI5 ; YES, END OF LIE
CAIG R6,CPL1 ;PAST NORMAL END?
JRST GETLI4 ; NO, STORE IT
CAIE R6,CPL1+1 ; YES - IS THIS THE MAGIC
JRST GETLI3 ; COLUMN FOR CDR MODE?
; NEXT BYTE IS IN COLUMN 73 OF INPUT LINE. IF
; .ENABL CDR WAS ISSUED, INPUT IS CARD IMAGES; IN
; THIS CASE SUPPLY AN END-LOGICAL-LINE CHARACTER
; IN ORDER TO TREAT SEQUENCE NUMBERS IN 73-80
; AS COMMENTARY INFORMATION.
TLNN RMODE,CDRFLG ; READING CARD IMAGES?
JRST GETLI3 ; NO - CHECK FOR OVERFLOW.
MOVEI R11,ELLCHR ; YES - SET END LINE CHARACTER
IDPB R11,R13 ; AND STORE IN BUFFER
JRST GETLI4 ;ALSO STORE NORMAL CHAR
GETLI3: CAIGE R6,CPL3 ;NORMAL MODE, SKIP IF OVERFLOW
JRST GETLI4 ; OK, STORE IT
TRO R15,ERRL ; NO, FLAG ERROR
JRST GETLI1 ;DON'T STORE IN EITHER CASE
GETLI4: IDPB R14,R13 ;OK, STORE CHARACTER IN BUFFER
AOJA R6,GETLI1 ;BUMP COUNT AND LOOP
GETLI5: IDPB R14,R13 ;END OF LINE, STORE
SETZ R14,
IDPB R14,R13 ;STORE NULL FOR EASY REFERENCE
GETLI6: SETZM FLTBUF ;BE SURE FLTBUF IS CLEAR
TLNE R15,ENDFLG ;PERCHANCE END OF FILE?
TRO R15,ERRE ; YES, FLAG "NO END STATEMENTT"
MOVE R13,LINPNT ;SET FOR READ
JRST GETNB ;RETURN WITH FIRST NON-BLANK
GETLI7: MOVE R6,[XWD FLTBUF,LINBUF] ;FLOATING TO LIST
BLT R6,LINBUF+↑D10 ; MOVE IT
JRST GETLI6 ;EXIT NORMAL
LINPNT: POINT 7,LINBUF, ;POINTER TO START OF LINE
ENDLR: ;END OF LINE PROCESSOR
TLZ R16,LOHBIT ; RESET HEADER PRINTED FLAG
TLNE R15,P1F
JRST ENDLFA ;BYPASS IF PASS 1
MOVE R11,RBPTR ; SAVE POINTER TO CURRENT BYTE.
CALL SETNB ;SET FIRST NON-BLANK
CAIE R14,0 ;IF NULL
CAIN R14,";" ;OR SEMI-COLON
JRST ENDLF ; BRANCH O.K.
SETZ R11, ; NOT AT A COMMENT - CLEAR R11
; TO SHOW NO COMMENT
CAIN R14,CRR ;CARRIAGE RETURN?
CALL GETCHR ; YES, BYPASS IT
CAIE R14,LF ;IF LINE FEED
CAIN R14,FF ; OR FORM FEED,
CAIA ; O.K.
TRO R15,ERRQ ;OTHERWISE FLAG Q ERROR
ENDLF: ;ENDL FIN
; THE NEXT FEW LINES HANDLE .NLIST COM. THE CODE
; FOLLOWING LOCATION ENDL HAS LEFT R11 AS . . .
; 0 IF FIRST UNPARSED TEXT ISN'T COMMENT, OR
; BYTE POINTER TO BEGINNING OF COMMENT.
JUMPE R11,ENDLFA ; SKIP COM CHECK IF NOT AT COMMENT.
SETZ R2, ; PREPARE NULL BYTE IN R2
MOVE R0,LSTCTL ; LOAD LISTING CONTROL FLAGS.
TRNN R0,LCOM ; ARE COMMENTS BEING LISTED?
DPB R2,R11 ; NO - STORE NULL AT COM START.
; WHEN THE LINE IS LISTED LATER THE NULL BYTE IS TAKEN AS
; A SIGNAL TO STOP LISTING THE LINE. THE CODE IMMEDIATELY
; PRECEDING LOCATION ENDL10 HANDLES THIS.
ENDLFA: SETZM CODPNT ;INITIALIZE FOR CODE OUTPUT
CALL PROCOD ;PROCESS CODE
JFCL ; NO CODE, IGNORE THIS TIME
ENDLC: TRZN R15,ERRP1 ; LIST ON PASS 1?
TLNN R15,P1F ; NO, ARE WE IN PASS2?
CAIA ; YES, LIST THIS LINE
JRST ENDL11 ;PASS 1, NO ERRORS, DON'T LIST
CALL CRFLIN ;OUTPUT CREF
TRNN R15,-1 ;ANY ERRORS?
JRST ENDL6 ; NO
AOS ERRCNT ; YES, TALLY ERROR COUNT
TLZ R16,NLISLN ; OVERRIDE LINE LIST SUPPRESSION
TLO R16,ERRBIT ;MESSAGE TO TTY
MOVE R0,XE ;GET FILE NAME
TLNN R16,TTYBIT
CAMN R0,XESAVE
JRST ENDL4
JUMPE R0,ENDL4
MOVEM R0,XESAVE
MOVSI R1,(POINT 6,R0,)
ENDL2: ILDB R2,R1
JUMPE R2,ENDL3
ADDI R2,40
OUTCHR R2
TLNE R1,770000
JRST ENDL2
ENDL3: OUTSTR [BYTE (7) ":", CRR, LF, 0]
ENDL4: HRLZ R0,R15 ;PUT FLAGS IN AC0 LEFT
MOVE R1,[POINT 7,[ASCII /ABDEILMOPQRTUNZ/],]
ENDL5: ILDB R2,R1 ;FETCH CHARACTER
SKIPGE R0 ;THIS CHARACTER?
CALL LSTOUT ; YES
LSH R0,1
JUMPN R0,ENDL5 ;TEST FOR END
ENDL6: TLNE R16,NLISLN ; SUPPRESS LIST OF THIS LINE?
JRST ENDL11 ; YES - JUST CLEAN UP
; *** CHECK FOR MACRO EXPANSION LIST MODES ***
; .LIST ME ** LIST ALL GENERATED LINES
; .NLIST ME, .LIST MEB ** LIST LINES WHICH GEN CODE
; .NLIST ME, .NLIST MEB ** LIST NO EXPANDED LINES
TLNN R16,MEXBIT ; IS MACRO EXPANSION IN PROGRESS?
JRST ENDL6A ?`** NO - LIST THE LINE
TRNE RERR,-1 ; ** YES - IF LINE HAD ERRORS
JRST ENDL6A ; LIST IT REGARDLESS OF OPTIONS.
MOVE R0,LSTCTL ; // CHECK LISTING MODE //
TRNE R0,LME ; IS .LIST ME IN EFFECT?
JRST ENDL6A ; ** YES - LIST THE LINE
TRNE R0,LMEB ; ** NO - .LIST MEB IN EFFECT?
SKIPN PF0 ; %% YES - LIST IFF CODE WAS GEN'D
JRST ENDL11
; *** CHECK FOR COMPLETELY BLANK LINE TO BE LISTED ***
; SUCH A LINE SHOULD BE LISTED AS ONLY CR/LF
; FOR THE SAKE OF LISTING READABILITY & EFFICIENCY.
ENDL6A: MOVE R0,LINPNT ;TEST FOR NO MORE LISTING
ILDB R2,R0 ;GET THE FIRST CHARACTER
CAIN R2,CRR ;CARRIAGE RETURN?
ILDB R2,R0 ; YES, TEST NEXT
CAIE R2,LF ;IF LINE FEED
CAIN R2,FF ; OR FORM FEED,
SETZ R2, ;DON'T LIST IF NOTHING ELSE
TDO R2,PF0
TDO R2,PF1
TDO R2,SEQNUM
JUMPE R2,ENDL10 ;BRANCH IF NOTHING TO LIST
CALL PRNTA ;LIST THE OCTAL
TRNN R16,SEQBIT ;ANY SEQUENCE NUMBERS ENCOUNTERED?
JRST ENDL8 ; NO
; FORMAT A SEQUENCE NUMBER, SUPPLIED BY SOS OR
; ONE OF THE OTHER UNFRIENDLY EDITORS.
CALL LSTTAB ;OUTPUT A TAB
MOVE R0,[POINT 7,SEQNUM,]
ENDL7: ILDB R2,R0 ;GET A CHARACTER
JUMPE R2,ENDL8 ;BYPASS IF NULL
CALL LSTOUT ;OUTPUT THE NUMBER
TLNE R0,760000 ;END OF WORD?
JRST ENDL7 ; NO, TRY FOR MORE
ENDL8: TRNE RERR,-1 ; DID LINE HAVE ERRORS?
JRST ENDL8A ; YES - ALWAYS LIST SOURCE.
MOVE R0,LSTCTL ; NO - CHECK FOR .NLIST SRC.
TRNN R0,LSRC ; IS SOURCE LIST WANTED?
JRST ENDL10 ; NO - SKIP IT.
ENDL8A: CALL LSTTAB
SKIPA R6,LINPNT ;GET SET TO PRINT LINE
ENDL9: CALL LSTOUT ;LIST A CHARACTER
ENDL9A: ILDB R2,R6 ;GET ANOTHER CHARACTER
CAIN R2,ELLCHR ;END OF LOGICAL LINE CHAR?
JRST ENDL9A ; YES, DON'T LIST
CAIN R2,ILLCHR ;ILLEGAL?
MOVEI R2,"?" ; YES, REPLACE WITH QM
CAIL R2,12 ;DON'T LIST IF BETWEEN LF
CAILE R2,15 ; AND CARRIAGE RETURN
JUMPN R2,ENDL9 ;TEST FOR END
JUMPN R2,ENDL9A ;BRANCH IF CR-LF
ENDL10: CALL LSTCR ;END,LIST CR/LF
ENDL11: CALL ENDLIF ;SEMI-INIT LINE
TLO R15,EXTFLG ;FLAG EXTENSION
CALL PROCOD ;PROCESS ADDITIONAL CODE, IF ANY
JRST ENDL12 ; NONE
; ****** BINARY EXTENSION PROCESSING *******
TLO R16,BEXBIT ; FLAG STATE OF LISTING EXTENSION.
MOVE R0,LSTCTL ; CHECK LIST OPTIONS --
TRNN R0,LBEX ; ARE BINARY EXTENSIONS TO LIST?
TLO R16,NLISLN ; NO - DON'T LIST EXTENSION LINES.
JRST ENDLC ; IN ANY CASE, GENERATE CODE.
ENDL12: TRZN R16,FFBIT ;FORM FEED ENCOUNTERED?
JRST ENDLI ; NO
TLNN RMODE,P1F ; IF THIS IS PASS 2 . . .
TRO R16,HDRBIT ;SET HEADER BIT
ENDLI: SETZM CODPNT
ENDLIF: AND R5,[PCMASK] ;CLEAN UP PC
SETZM GLBPNT ;CLEAR GLOBAL POINTER
SETZM PF0 ;CLEAR PRINT WORDS
SETZM PF1
SETZM PF2
SETZM PF3
SETZB R2,SEQNUM
DPB R2,[POINT 7,LINBUF,6] ;FLAG LINE
TRZ R15,-1
TLZ R15,EXTFLG
TLZ R16,ERRBIT!LBLBIT!PF1BIT!BEXBIT
RETURN
STMNT: ;STATEMENT PROCESSOR
CALL GETSYM ;TRY FOR SYMBOL
JRST STMNT3 ; NO
CAMN R0,CMTOP ;LONG COMMENT? -- BO 14-JAN-75
JRST CMENT ; YES.
CAIN R14,":" ;LABEL?
JRST LABEL ; YES
CAIN R14,"=" ;ASSIGNMENT?
JRST ASGMT ; YES
CALL MSRCH ;TEST FOR MACRO
CAIA
JRST STMNT1 ;YES
CALL OSRCH ;NO, TRY OP TABLE
JRST STMNT2 ;TREAT AS EXPRESSION
STMNT1: PUSH R17,R1
TLNE R0,MACBIT ;SPECIAL TEST FOR OPDEFS
MOVSI R1,MAOP ; SET TO MACRO
CALL CRFREF ;CREF IT
POP R17,R1 ;RETRIEVE VALUE/TYPE
LDB R2,TYPPNT ;RESTORE TYPE
XCT STMNJT(R2) ;EXECUTE TABLE
STMNJT: ;STATEMENT JUMP TABLE
PHASE 0
JRST STMNT2 ;BASIC SYMBOL
MAOP: JRST CALLM ;MACRO
OCOP: JRST PROPC ;OP CODE
DIOP: JRST 0(R1) ;PSEUDO-OP
DEPHASE
STMNT2: MOVE R13,SYMBEG ;NON-OP SYMBOL, RESET CHAR POINTER
STMNT3: CALL SETNB ;SET CURRENT CHAR
CAIE R14,";" ;IF SEMI-COLON
CALL TSTNT ; OR LINE TERMINATOR,
RETURN ; NULL LINE
JRST .WORD ;NEITHER, TREAT AS ".WORD"
;FAIL-STYLE COMMENT PSEUDO-OP ADDED BY BO 14-JAN-75
CMENT2: CALL ENDLR ;This is in case there was no delimiter
CALL GETLIN ;on the COMMENT line. Keep looking.
CMENT: CALL SETNB ;Find the first nonblank after COMMENT,
CAIN R4,SCLE
JRST CMENT2
MOVEM RBYTE,CMSEP ;save as the delimiter.
CMENT1: CALL GETCHR ;Scan until...
CMENT3: CAMN RBYTE,CMSEP
JRST CMENT4 ;you find another copy of the delimiter.
CAIE R4,SCLE
JRST CMENT1
CALL ENDLR ;End of line... output to listing,
CALL GETLIN ;get the next line,
CALL SETNB
JRST CMENT3 ;and keep scanning.
CMENT4: CALL GETCHR ;Found it. Get the next character
JRST STMNT ;and start looking for a statement.
LABEL: ;LABEL PROCESSOR
TLO R16,LBLBIT ; FORCE PC TO LIST IN
TLNN R0,200000 ; IS THIS A LOCAL SYMBOL?
CALL LOCRES ; NO - RESET LOCAL SYMBOL BLOCK
MOVEM RLOC,PF0 ; PRINT FIELD 0
CALL SSRCH ;SEARCH THE SYMBOL TABLE
JRST LABEL1 ; NOT THERE
TLNE R1,REGSYM ;REGISTER?
JRST LABEL2 ; YES, ERROR
LABEL1: TLNN R1,DEFSYM ;PREVIOUSLY DEFINED?
TDO R1,R5 ; NO, SET TO CURRENT PC
MOVE R3,R1
TDC R3,R5 ;COMPARE WITH PC
TDNN R3,[PCMASK] ;EQUAL ON MEANINGFUL BITS?
JRST LABEL3 ; YES
LABEL2: TLNN R15,P1F ;NO, PASS 1?
TLNE R1,MDFSYM ;NO, MULTIPLY DEFINED ALREADY?
TLOA R1,MDFSYM ; YES, FLAG SYMBOL
TRO R15,ERRP ;NO, PHASE ERROR
CAIA
LABEL3: TLO R1,LBLSYM!DEFSYM ;OK, FLAG AS LABEL
CALL GETNB ; SKIP ":".
CAIE RBYTE,":" ; IS NEXT BYTE ANOTHER ":"?
JRST LABEL4 ; NO -- DONE WITH LABEL.
TLO R1,GLBSYM ; YES - FLAG LABEL AS GLOBAL,
CALL GETNB ; SKIP THE SECOND ":".
LABEL4: CAMN R0,M40DOT ;PERCHANCE PC?
TROA R15,ERRM ; YES, FLAG ERROR AND SKIP
CALL INSRT ;INSERT/UPDATE
TLNE R1,MDFSYM ;MULTIPLY DEFINED?
TRO R15,ERRM ; YES
CALL CRFDEF ;CREF IT
JRST STMNT ;RETURN TO STATEMENT EVALUATOR
ASGMT: ;ASSIGNMENT PROCESSOR
PUSH RLINK,R0 ; SAVE SYMBOL ON STACK.
CALL GETNB ; GET CHARACTER AFTER "=".
CAIE RBYTE,"=" ; IS NEXT CHAR ANOTHER "="?
JRST ASGMT3 ; NO -- SYMBOL'S LOCAL.
TLO R16,GEQBIT ; YES - SYMBOL WILL BE GLOBAL.
CALL GETNB ; SKIP 2ND "=".
ASGMT3: CALL RELEXP
SYMDEF: MOVE R3,R10
TLO R3,DEFSYM ;BE SURE ZERO PRINTS
MOVEM R3,PF1 ;SET PRINT FIELD
POP R17,R0 ;RETRIEVE SYMBOL
CALL SSRCH ;SEARCH TABLE
JFCL ; NOT THERE YET
TLZE R16,GEQBIT ; IS SYMBOL TO BE GLOBAL?
TLO R1,GLBSYM ; YES. FLAG IT.
TLNE R1,LBLSYM ;LABEL?
JRST ASGMT1 ; YES, ERROR
AND R1,[XWD GLBSYM!MDFSYM,0] ;MASK
TRNN R15,ERRU ;ANY UNDEFINED SYMBOLS?
TLO R1,DEFSYM ; NO, FLAG AS DEFINED
TDOA R1,R10 ;MERGE NEW VALUE
ASGMT1: TLO R1,MDFSYM ; ERROR, FLAG AS MULTIPLY DEFINED
TLNE R1,MDFSYM ;EVER MULTIPLY DEFINED?
TRO R15,ERRM ; YES
CALL CRFDEF ;CREF IT
CAME R0,M40DOT ;SKIP IF LOCATION COUNTER
JRST INSRT ;INSERT AND EXIT
BLKB1: CALL TSTMAX ;TEST FOR NEW HIGH
LDB R2,SUBPNT ; GET CSECT OF EXPR
LDB R3,CCSPNT ; GET CSECT OF PC
CAME R2,R3 ;CURRENT SECTOR?
JRST ASGMT2 ; NO, ERROR
CALL INSRT ; INSERT SYMBOL IN TABLE
HRLI R1,(<RLDT10>B<MODOFF>) ; SET CLASS 10
JRST STCODE ; STOW CODE & EXIT
ASGMT2: TRO R15,ERRA!ERRP1 ; ERROR, DON'T STORE
RETURN
PROPC: ;PROCESS OP CODES
CALL TSTEVN ;MAKE SURE WE'RE EVEN
LDB R2,SUBPNT ;GET CLASS
HRLI R1,BC2
MOVEM R1,OPCODE ;STORE OP
SETZM OFFSET ;CLEAN UP FOR AEXP
SETZM ADREXT
SETZM ADREXT+1
XCT PROPCT(R2) ;EXECUTE TABLE BY SUB-CLASS
SKIPE R1,OPCODE ;FETCH OP-CODE
CALL STCODE ;STOW CODE
SKIPE R1,ADREXT ;EXTENSION?
CALL STCODE ; YES, STORE IT
SKIPE R1,ADREXT+1
CALL STCODE ;DITTO
LDB R1,[POINT 3,OPCODE,35-12]
JUMPN R1,PROPC1
LDB R1,[POINT 13,OPCODE,35-3]
CAIN R1,00012
JRST PROPC2
TRZ R1,00070
CAIN R1,00402
JRST PROPC2
RETURN
PROPC1: CAILE R1,6
RETURN
LDB R1,[POINT 6,OPCODE,35-6]
TRNE R1,70
RETURN
LDB R2,[POINT 6,OPCODE,35]
XOR R2,R1
CAIE R2,20
CAIN R2,40
PROPC2: TRO R15,ERRZ
RETURN
PROPCT:
PHASE 0
HALT
OPCL0: JFCL
OPCL1: CALL POPCL1
OPCL2: CALL POPCL2
OPCL3: CALL POPCL3
OPCL4: CALL POPCL4
OPCL5: CALL POPCL5
OPCL6: CALL POPCL6
OPCL7: CALL POPCL7
OPCL8: CALL POPCL8
OPCL9: CALL POPCL9
OPCL10: CALL POPC10
OPCL11: CALL POPC11
OPCL12: CALL POPC12
OPCL13: CALL POPC13
OPCL14: CALL POPC14
DEPHASE
POPCL1: CALL AEXP ;PROCESS ADDRESS EXPRESSION
DPB R0,[POINT 6,OPCODE,35]
RETURN
POPCL2: CALL AEXP
DPB R0,[POINT 6,OPCODE,35-6]
POP2ND: CALL TSTCOM
CALL AEXP
DPB R0,[POINT 6,OPCODE,35]
RETURN
POPCL3: CALL REGEXP
DPB R10,[POINT 3,OPCODE,35]
RETURN
POPCL4: ;PROCESS BRANCH ON CONDITION
CALL EXPRF ;EVALUATE EXPRESSION
JRST PBCOP2 ; NULL, ERROR
SUBI R10,2(R5) ;COMPUTE E-.-2
ROT R10,-1 ;/2, ODD BIT TO SIGN
TRNE R10,040000 ;WAS IT NEG?
TRO R10,100000 ; YES-PROPOGATE SIGN.
TRNE R10,000200 ;NEGATIVE?
TRC R10,177400 ; YES, TOGGLE HIGH BITS
TRNN R10,177400 ;ANY OVERFLOW?
JUMPGE R10,PBCOP1 ; NO, BRANCH IF EVEN
PBCOP2: MOVNI R10,1 ; YES, SET TO JMP .
TRO R15,ERRA ;FLAG ERROR
PBCOP1: DPB R10,[POINT 8,OPCODE,35]
RETURN
POPCL5: CALL REGEXP
DPB R10,[POINT 3,OPCODE,35-6]
JRST POP2ND
POPCL6: CALL EXPR ;EVALUATE THE EXPRESSION
JFCL ; NULL, TREAT AS ZERO
CALL TSTAR ;TEST ARITHMETIC
TRZE R1,177400 ;OVERFLOW?
TRO R15,ERRA ; YES
LDB R3,MODPNT ;FETCH CLASS
CAIE R3,RLDT1 ;IF ONE
CAIN R3,RLDT15 ; OF FIFTEEN,
TRO R15,ERRA ;RELOCATION ERROR
CAIE R3, ;ABSOLUTE?
TRO R3,200 ; NO, MAKE BIT MODIFICATION
DPB R3,MODPNT
IORM R1,OPCODE ;MERGE WITH BASIC
RETURN
POPCL9: ;OLD ASH/ASHC MODES
POPCL7: CALL AEXP
DPB R0,[POINT 6,OPCODE,35]
CALL TSTCOM
CALL REGEXP
DPB R10,[POINT 3,OPCODE,35-6]
RETURN
POPCL8: CALL REGEXP
DPB R10,[POINT 3,OPCODE,35-6]
CALL TSTCOM
CALL EXPR
TRO R15,ERRA
MOVE R1,R5
ADDI R1,2
MOVEI R0,1 ; AVOID FLAG FROM EXPRMI BY
MOVEM R0,RELLVL ; SET RELOC LEVEL TO 1.
CALL EXPRMI
TRO R15,ERRA
CALL ABSTST
TRNE R10,177601 ;EVEN AND IN BOUNDS?
TRO R15,ERRA ; NO, ERROR
LSH R10,-1
DPB R10,[POINT 6,OPCODE,35]
RETURN
POPC10: CALL ABSEXP
TRNE R10,177700
TRO R15,ERRT
DPB R10,[POINT 6,OPCODE,35]
RETURN
POPC11: CAIE R14,"#"
JRST POPC1B
PUSH R17,R13
CALL GETNB
MOVEI R3,1
MOVEM R3,FLTLEN ;SET LENGTH FOR ROUNDING
CALL FLTG
POP R17,R0
TLNE R15,FLTFLG
JRST POPC1A
HRRZ R10,FLTNUM
TLO R10,BC2
AOS R2,OFFSET
MOVEM R10,ADREXT-1(R2)
MOVEI R0,27
JRST POPC1C
POPC1A: MOVE R13,R0
CALL SETCHR
POPC14: ;NEW CLASS 14
POPC1B: CALL AEXP
POPC1C: DPB R0,[POINT 6,OPCODE,35]
CALL TSTCOM
CALL REGEXP
TRNE R10,177774
TRO R15,ERRA
DPB R10,[POINT 2,OPCODE,35-6]
RETURN
POPC12: CALL REGEXP
TRNE R10,177774
TRO R15,ERRA
DPB R10,[POINT 2,OPCODE,35-6]
JRST POP2ND
POPC13: CALL ABSEXP
TRNE R10,177770
TRO R15,ERRA
DPB R10,[POINT 3,OPCODE,35]
RETURN
TSTCOM:
CAIN R14,","
JRST GETNB
TRO R15,ERRA
POP R17,0(R17)
RETURN
SUBTTL EXPRESSION HANDLERS
AEXP: ;"A" EXPRESSION EVALUATOR
PUSH R17,[0] ;STACK INITIAL VALUE
AEXP01: CALL SETNB ;GET A NON-BLANK
CAIN R14,"#"
JRST AEXP02
CAIN R14,"%"
JRST AEXP04
CAIN R14,"("
JRST AEXP06
CAIN R14,"-"
JRST AEXP07
CAIN R14,"@"
JRST AEXP08
JRST AEXP10 ;NO UNARIES, PROCESS BASIC EXPRESSION
; AEXP2A FORCES MODE 3 ADDRESS GENERATION INSTEAD OF
; MODE 6. CONTROL REACHES AEXP2A FROM THE AEXP10 BLOCK
; IF A .ENABL AMA DIRECTIVE IS IN EFFECT.
AEXP2A: TRO R0,37 ; SET MODE 3 WITH PC
PUSH RLINK,R0 ; STACK IT.
JRST AEXP2B ; CONTINUE AS IF "@#" EXPR
AEXP02: ; #
CALL GETNB ;BYPASS UNARY OP
CALL EXPRF ;EVALUATE EXPRESSION
TRO R15,ERRQ ; NULL, ERROR
AEXP2B: CALL TSTAR ;TEST ARITHMETIC
POP R17,R0 ;RETRIEVE PRESET VALUE
TRO R0,27 ;SET BITS
AOS R2,OFFSET ;GET OFFSET
MOVEM R1,ADREXT-1(R2) ;STORE ADDRESS
RETURN ;EXIT
AEXP04: ; %
CALL REGEXP ;EVALUATE REG EXPRESSION
POP R17,R0 ;RETRIEVE CODE
AEXP05: TRZE R10,-10 ;ANY OVERFLOW?
TROA R15,ERRR ; YES, FLAG ERROR AND SKIP
TRO R0,00(R10) ;SET BITS
RETURN ;EXIT
AEXP06: ; (
CALL AEXP20 ;EVALUATE PARENTHESES
SETZ R1, ;ZERO IN CASE OF INDEX
CAIE R14,"+" ;FINAL "+" SEEN?
JRST AEXP13 ; NO, GO SEE IF (R) OR @(R)?
POP R17,R0 ;YES, RETRIEVE CODE
TRO R0,20(R10) ;SET BITS
JRST GETNB ;BYPASS DELIMITER AND EXIT
AEXP13: POP R17,R0 ;GET CODE
TRON R0,10 ;IS "@" SET?
JRST AEXP05 ;NO-REGISTER MODE
PUSH R17,R0 ;YES-INDEX MODE
JRST AEXP12
AEXP07: ; -(
MOVEM R13,SYMBEG ;SAVE POINTER IN CASE OF FAILURE
CALL GETNB ;GET THE NEXT NON-BLANK
CAIE R14,"(" ;PARENTHESIS?
JRST AEXP09 ; NO, TREAT AS EXPRESSION
CALL AEXP20 ;YES, EVALUATE
POP R17,R0 ;RETRIEVE CODE
TRO R0,40(R10) ;SET BITS
RETURN ;EXIT
AEXP08: ; @
POP R17,R0 ;RETRIEVE BASIC CODE
TROE R0,10 ;SET INDIRECT BIT, WAS IT BEFORE?
TRO R15,ERRQ ; YES, FLAG ERROR
PUSH R17,R0 ;RE-STACK CODE
CALL GETNB ;BYPASS CHARACTER
JRST AEXP01 ;GO BACK TO BEGINNING
AEXP09: ; -( FAILURE
MOVE R13,SYMBEG ;GET POINTER TO "-"
CALL SETNB ;RESTORE CHARACTER
AEXP10: ; NO UNARIES
CALL EXPR ;EVALUATE EXPRESSION
TRO R15,ERRQ ; NULL, ERROR
CAIN R14,"(" ;ANOTHER EXPRESSION?
JRST AEXP11 ; YES, BRANCH
POP R17,R0 ;RETRIEVE CODE
TLNE R10,REGSYM ;REGISTER EXPRESSION?
JRST AEXP05 ; YES, TREAT AS %
TRNE R0,10 ; IS MODE ALREADY DEFERRED?
JRST AEXP1E ; YES -- HAS TO BE MODE 7.
TLNE RMODE,AMAFLG ; .ENABL AMA IN EFFECT?
JRST AEXP2A ; YES - FORCE ABS MODE ADDRESS
AEXP1E: TRO R0,67 ;SET BITS FOR INDEXED BY PC.
MOVE R1,R10
LDB R2,SUBPNT ;GET RELOCATION
HRLI R1,BC2 ;TWO DATA BYTES
MOVEI R3,RLDT6 ;ASSUME EXTERNAL
TLNE R10,GLBSYM
JRST AEXP1B ; TRUE, OK AS IS
LDB R6,CCSPNT ;FETCH CURRENT SEG
CAME R2,R6 ;SAME SEG?
JRST AEXP1A ; NO, FURTHER TESTING REQUIRED
SUBI R10,4(R5) ;YES, COMPUTE OFFSET
SKIPE OFFSET ;THIRD WORD?
SUBI R10,2 ; YES, TWO MORE FOR GOOD MEASURE
DPB R10,[POINT 16,R1,35] ;STORE RESULT
JRST AEXP1D ;BRANCH TO EXIT
AEXP1A: MOVEI R3,RLDT3 ;OK FOR QUICKIE?
JUMPE R2,AEXP1C ; YES, IF TO ABS SEG
MOVE R4,SECNAM(R2)
AOS R2,GLBPNT
MOVEM R6,GLBBUF(R2) ;STORE IN GLOBAL TEMP
MOVEI R3,RLDT16 ;TYPE #16
AEXP1B: DPB R2,SUBPNT ;STORE GLOBAL BUFFER POINTER
AEXP1C: DPB R3,MODPNT ;STORE MODE
AEXP1D: AOS R2,OFFSET
MOVEM R1,ADREXT-1(R2)
RETURN
AEXP11: ; E1(E2)
TLNE R10,REGSYM ;REGISTER EXPRESSION?
TRO R15,ERRR ; YES, ERROR
PUSH R17,R10 ;STACK E1
CALL AEXP20 ;PROCESS EXPRESSION
POP R17,R1 ;RETRIEVE E1
AEXP12: DPB R10,[POINT 3,0(R17),35] ;STORE REG
MOVE R10,R1
CALL TSTAR ;TEST MODE
AOS R2,OFFSET
MOVEM R1,ADREXT-1(R2) ;STORE ADDRESS
POP R17,R0 ;RETRIEVE CODE BITS
TRO R0,60 ;COMPLETE CODE
RETURN ;EXIT
AEXP20: ;()
CALL GETNB ;BYPASS PAREN
CALL REGEXP ;EVALUATE REGISTER EXPRESSION
CAIE R14,")" ;PROPER DELIMITER
TROA R15,ERRQ ; NO, FLAG ERROR AND SKIP
CALL GETNB ; YES, BYPASS CHARACTER
JRST SETNB ;RETURN WITH NON-BLANK DELIMITER
TSTAR: ;TEST ADDITIVE RELOCATION (0,1,5,15)
MOVE R1,R10 ;COPY TO FINAL AC
LDB R2,SUBPNT ;GET RELOCATION
HRLI R1,BC2 ;SET FOR TWO BYTES
JUMPE R2,CPOPJ ;EXIT IF ABS
MOVEI R3,RLDT5 ;ASSUME EXTERNAL
TLNE R10,GLBSYM ;GLOBAL?
JRST TSTAR1 ; YES
MOVEI R3,RLDT1
LDB R6,CCSPNT
CAMN R2,R6 ;CURRENT SECTOR?
JRST TSTAR2 ; YES
MOVE R6,SECNAM(R2)
AOS R2,GLBPNT
MOVEM R6,GLBBUF(R2) ;STORE SECTOR NAME
MOVEI R3,RLDT15 ;TYPE 15
TSTAR1: DPB R2,SUBPNT
TSTAR2: DPB R3,MODPNT
RETURN
EXPR: ;EXPRESSION PROCESSOR, REGISTER ALLOWED
EXPRF: ;EXPRESSION FIN, NO REGISTERS ALLOWED
MOVE R2,GLBRDX ;GET GLOBAL RADIX
TLNE R15,HOVFLG ;CHECK IF HEX OVERRIDE ENABLED
TRO R2,HEXENB ; YES, SET HEXENB IN LOCRDX
RADEXP: MOVEM R2,LOCRDX ;MOVE TO LOCAL RADIX
SETZB R6,RELLVL ;CLEAR RELOCATION LEVEL COUNT
SETZM RECLVL ;CLEAR RECURSION LEVEL COUNT
CALL EXPR0 ;GO EVALUATE EXPRESSION
RETURN ; NULL, EXIT
SOSL RECLVL ;RECURSION LEVEL .GT. 0?
TRO RERR,ERRQ ; YES, FLAG ERROR
SOSLE RELLVL ;RELOCATION LEVEL .GT. 1?
TRO RERR,ERRA ; YES, FLAG ERROR
JRST CPOPJ1 ;EXIT GOOD
EXPR0: ;EXPRESSION PROCESSOR
PUSH RLINK,LOCRDX ;SAVE CURRENT RADIX
CALL TERM ;GET THE FIRST TERM
JRST EXPEX ; NULL, GO EXIT
POP RLINK,LOCRDX ;RESTORE RADIX
CALL EXPRPX ;SET RELOCATION LEVEL
EXPR1: LDB R2,C4PNTR ;MAP NEXT CHAR USING COLUMN 4
XCT EXPRJT(R2) ;EXECUTE TABLE TO SAVE OP ADDR
CALL GETNB ;GET THE NEXT NON-BLANK CHAR
EXPR2: HRLM R2,0(RLINK) ;AND SAVE OP ADDRESS
PUSH RLINK,R10 ;STACK CURRENT VALUE
PUSH RLINK,LOCRDX ;SAVE CURRENT RADIX
CALL TERM ;GET NEXT TERM
TRO RERR,ERRQ ; NULL, FLAG ERROR
POP RLINK,LOCRDX ;RESTORE RADIX
POP RLINK,R1 ;GET PREVIOUS VALUE
HLRZ R2,0(RLINK) ; AND OPERATOR
CALL 0(R2) ;PERFORM OPERATOR
TRO RERR,ERRA ; IF ERROR, FLAG IT
TRZ R10,600000 ;CLEAR ANY OVERFLOW
JRST EXPR1 ;TEST FOR MORE
EXPR3: ;OPERATOR POSSIBLY OMITTED
TRO RERR,ERRQ ;FLAG ERROR: MISSING OP
MOVEI R2,EXPRPL ;SIMULATE "+"
JRST EXPR2 ;CONTINUE
EXPEX: POP RLINK,LOCRDX ;RESTORE RADIX
RETURN ;EXIT
EXPRJT: ;EXPRESSION JUMP TABLE
PHASE 0
JRST CPOPJ1 ;NOT AN OP NOR TERM; EXIT
EXTE: JRST EXPR3 ;POSSIBLE TERM; SIMULATE "+"
EXPL: MOVEI R2,EXPRPL ; +
EXMI: MOVEI R2,EXPRMI ; -
EXOR: MOVEI R2,EXPROR ; !
EXAN: MOVEI R2,EXPRAN ; &
EXMU: MOVEI R2,EXPRMU ; *
EXDV: MOVEI R2,EXPRDV ; /
EXSH: MOVEI R2,EXPRSH ; ← (LOGICAL SHIFT)
DEPHASE
EXPRPL: ; +
TDZA R6,R6 ;ZERO FOR ADD
EXPRMI: ; -
HRROI R6,1 ;ONE FOR SUBTRACT
CALL EXPRPX ;UPDATE RELOCATION COUNT
EXPRP1: LDB R2,SUBPNT ;GET RELOCATION
EXCH R10,R1
LDB R3,SUBPNT
TLNE R1,REGSYM
TLO R10,REGSYM ;TRANSFER REGISTER FLAG
JUMPE R3,EXPRM1 ;BRANCH IF SUBTRACTING ABS
TLON R6,-1 ;NOT ABS, FIRST-TIME ADDITION?
JRST EXPRP1 ; YES, REVERSE
TLNN R1,GLBSYM ;IF EITHER IS GLOBAL,
TLNE R10,GLBSYM
JRST EXPRM2 ; ERROR
CAME R2,R3 ;LAST CHANCE, BOTH SAME RELOCATION
JRST EXPRM2 ; FORGET IT
SKIPN RELLVL ;IF BACK TO ZERO,
TLZ R10,(PFMASK) ;MAKE ABSOLUTE
EXPRM1: AOS 0(R17) ;INDICATE GOOD RESULT
EXPRM2: XCT [EXP <ADDM R10,R1>,<SUBM R10,R1>](R6) ;PERFORM OP
DPB R1,[POINT 16,R10,35] ;STORE TRIMMED RESULT
RETURN ;EXIT
EXPRPX: ;UPDATE RELOCATION LEVEL
TLNE R10,(PFMASK) ;IF ABS,
TLNE R10,GLBSYM ; OR GLOBAL,
RETURN ; NO ACTION
XCT [EXP <AOSA RELLVL>,<SOSGE RELLVL>](R6)
TRO R15,ERRA ; NEGATIVE COUNT, ERROR
RETURN
EXPROR: JSP R3,EXPXCT ; !
IOR R10,R1
EXPRAN: JSP R3,EXPXCT ; &
AND R10,R1
EXPRMU: JSP R3,EXPXCT ; *
IMUL R10,R1
EXPRDV: JSP R3,EXPXCT ; /
IDIV R10,R1
EXPRSH: JSP R3,EXPXCT ; ←
LSH R10,0(R1)
EXPXCT: PUSH R17,0(R3) ;STACK INSTRUCTION
CALL EXPXC1 ;TEST FOR ABSOLUTE
EXCH R10,R1
CALL EXPXC1 ;DITTO FOR OTHER
POP R17,R3 ;FETCH INSTRUCTION
XCT R3 ;EXECUTE IT
ANDI R10,177777 ;MAKE ABSOLUTE
JRST CPOPJ1 ;GOOD EXIT
EXPXC1: CALL ABSTST ;TEST FOR ABSOLUTE
LSH R10,↑D<36-16>
ASH R10,-↑D<36-16> ;EXTEND SIGN
RETURN
REGEXP: ;REGISTER EXPRESSION
CALL EXPR
TRO R15,ERRA ; NULL, ERROR
REGTST: TDZE R10,[<GLBSYM>B17!377B<SUBOFF>!177770]
TRO R15,ERRR ; ERROR
RETURN
ABSEXP: ;ABSOLUTE EXPRESSION
CALL EXPR
TRO R15,ERRA
ABSTST: TLZE R10,(<GLBSYM>B17!377B<SUBOFF>)
TRO R15,ERRA ;ERROR IF GLOBAL OR RELOCATABLE
ANDI R10,177777
RETURN
RELEXP: ;RELOCATABLE EXPRESSION
CALL EXPR
TRO R15,ERRA
TLNE R10,GLBSYM ;NO GLOBALS ALLOWED
JRST ABSTST ;LET ABS FLAG IT
RETURN
TERPL: CALL GETNB ; (SKIP + SIGN)
TERM: ;TERM PROCESSOR
SETZB R10,R1 ;RETURN VALUE IN R10
CALL GETSYM ;TRY FOR SYMBOL
JRST TERM4 ; NOT A SYMBOL
CALL SSRCH ;SEARCH TABLE
JRST TERM2 ; NOT THERE
TLNE R1,MDFSYM ;MULTIPLY DEFINED?
TRO R15,ERRD ; YES
TLNN R1,DEFSYM!GLBSYM ;UNDEFINED?
TRO R15,ERRU ; YES
MOVE R3,R1 ;GET AN EXTRA COPY
TLZ R1,776000-REGSYM ;CLEAR ALL BUT REGISTER BIT
TLNN R3,DEFSYM ;DEFINED?
TLNN R3,GLBSYM ; NO, GLOBAL?
JRST TERM1 ; LOCAL
TLO R1,GLBSYM ;JUST GLOBAL
AOS R6,GLBPNT ;GLOBAL
MOVEM R0,GLBBUF(R6) ;SAVE NAME
DPB R6,SUBPNT ;SAVE NUMBER IN RELOCATION
TERM1: CALL CRFREF ;CREF IT
MOVE R10,R1 ;RESULT TO R10
JRST CPOPJ1 ;GOOD EXIT
TERM2: CALL OSRCH ;TRY OP CODES
JRST TERM3 ; NO
CAIE R2,OCOP ;PSEUDO-OP?
JRST TERM3 ; YES
CALL CRFREF
HRRZ R10,R1 ;YES, TREAT AS NUMERIC
JRST CPOPJ1 ;GOOD EXIT
TERM3: CALL SSRCH ;NOT YET DEFINED
CALL INSRT ;INSERT
TRO R15,ERRU ;FLAG ERROR
JRST CPOPJ1 ;RETURN WITH ZERO
TERM4: LDB R2,C5PNTR ;NON-SYMBOLIC
XCT TERMJT(R2) ;EXECUTE TABLE
CALL SETNB ;RETURN NON-BLANK
JRST CPOPJ1 ;GOOD EXIT
TERMJT: ;TERM JUMP TABLE
PHASE 0
RETURN ;NULL RETURN
TEIG: JRST TERPL ; IGNORE (+)
TE2C: CALL TERM2C ; - (2'S COMPLEMENT)
TEUP: CALL TERMUP ; ↑
TEEX: CALL TERMEX ; < (EXPRESSION FOLLOWS)
TESQ: CALL TERMSQ ; '
TEDQ: CALL TERMDQ ; "
TEPC: CALL TERMPC ; %
TENM: CALL TERMNM ; 0-9
TEHX: CALL TERMNM ; A-F (IF HEX ENABLED)
DEPHASE
TERMNM: ;NUMERIC TERM
PUSH RLINK,R6 ;SAVE R6.
MOVE R6,LOCRDX ;GET RADIX
SETZB R0,R1 ;CLEAR ACCUMULATORS
SETZB R2,R3
SETZB R10,R11
TERMN1: CAILE R14,"9" ;CHECK IF NUMERIC
JRST TERMN6 ; NO, GO CHECK IF HEX
ASH R10,1 ;SHIFT BINARY AC ONE PLACE
ADDI R10,-"0"(R14) ;ADD NUMERIC VALUE OF DIGIT
ASH R1,2 ;SHIFT QUATERNARY AC ONE PLACE
ADDI R1,-"0"(R14) ;ADD
ASH R2,3 ;SHIFT OCTAL
ADDI R2,-"0"(R14)
IMULI R3,↑D10 ;DECIMAL
ADDI R3,-"0"(R14)
ASH R0,4 ;HEXADECIMAL
ADDI R0,-"0"(R14)
TERMN2: CAMGE R11,R14 ;LARGEST DIGIT SO FAR?
MOVE R11,R14 ; YES, SAVE IT
CALL GETCHR ;GET THE NEXT CHARACTER
CAIL R14,"0" ;CHECK IF NUMERIC
JRST TERMN1 ; POSSIBLY, GO CHECK FURTHER
TERMN3: CAIE R14,"." ; NO, CHECK DECIMAL POINT
JRST TERMN7
HRRI R6,DECRDX ; YES, CHANGE RADIX TO DECIMAL
CALL GETNB ; GOBBLE UP "."
TERMN7: TRNE R6,OCTRDX ;CHECK IF RADIX OCTAL
JRST TERMNO ; YES, PROCESS ACCORDINGLY
TRNE R6,DECRDX ;DECIMAL
JRST TERMND
TRNE R6,HEXRDX ;HEXADECIMAL
JRST TERMNH
TRNE R6,QUARDX ;QUATERNARY
JRST TERMNQ
CAIG R11,"1" ;BINARY: CHECK IF ALL DIGITS < 2
JRST TERMN8 ; YES, JUMP OUT
TRO RERR,ERRN ; NO, FLAG ERROR
TERMNQ: MOVE R10,R1 ;MOVE QUATERNARY IN
CAIG R11,"3" ;CHECK IF ALL DIGITS < 4
JRST TERMN8 ; YES, JUMP OUT
TRO RERR,ERRN ; NO, FLAG ERROR
TERMNO: MOVE R10,R2 ;MOVE OCTAL IN
CAIG R11,"7" ;CHECK IF ALL DIGITS < 8
JRST TERMN8 ; YES, JUMP OUT
TRO RERR,ERRN ; NO, FLAG ERROR
TERMND: MOVE R10,R3 ;MOVE DECIMAL IN
CAIG R11,"9" ;CHECK IF ALL DIGITS <= 9
JRST TERMN8 ; YES, JUMP OUT
TRO RERR,ERRN ; NO, FLAG ERROR
TERMNH: MOVE R10,R0 ;MOVE HEXADECIMAL IN
TERMN8: TDZE R10,[-1B19] ;OVERFLOW?
TRO RERR,ERRT ; YES, FLAG TRUNCATION ERROR
POP RLINK,R6 ;RESTORE R6.
RETURN ;EXIT
TERMN6: CAIL R14,"A" ;TEST IF LEGAL HEX DIGIT
CAILE R14,"F"
JRST TERMN3 ; NO, GO FINISH UP
ASH R0,4 ; YES, SHIFT HEXADECIMAL AC ONE PLACE
ADDI R0,-"A"+↑D10(R14) ;ADD NUMERIC VALUE OF DIGIT
JRST TERMN2 ;REJOIN NUMERIC LOOP
TERMPC: ; %
CALL GETNB ;BYPASS PERCENT
CALL TERM ;GET A TERM
TRO R15,ERRR ; ERROR IF NULL
CALL REGTST ;TEST VALID REGISTER TERM
TLO R10,REGSYM ;FLAG IT
RETURN ;EXIT
TERMDQ: ; """
TLO R16,FOLBIT ; OVERRIDE INPUT FOLDING.
CALL GETNT ;GET THE NEXT NON-TERMINATOR
JRST TERMQE ; END OF LINE, ERROR
MOVE R10,R14 ;GET THE CHARACTER
CALL GETNT ;TRY ONE MORE
JRST TERMQE ; ERROR
DPB R14,[POINT 8,R10,35-8] ;STORE IN UPPER
TLZ R16,FOLBIT ; RESET FOLDING OVERRIDE.
JRST GETNB ;RETURN WITH NEXT NON-BLANK
TERMSQ: ; "'"
TLO R16,FOLBIT ; OVERRIDE INPUT FOLDING.
CALL GETNT ;GET NON-TERMINATOR
JRST TERMQE ; TERMINATOR, ERROR
MOVE R10,R14 ;FETCH CHARACTER
TLZ R16,FOLBIT ; RESET FOLDING OVERRIDE.
JRST GETNB ;RETURN NON-BLANK
TERMQE: TRO R15,ERRQ ;RAN OUT OF CHARACTERS
RETURN
TERM2C: ;"-"
CALL GETNB ;GOBBLE "-"
CALL TERM ;GET A TERM
TRO RERR,ERRQ ; ERROR IF NULL
MOVN R0,R10 ;TAKE 2'S COMPLEMENT
TRZ R0,600000
HRR R10,R0 ;PUT 16 BITS OF IT IN R10
RETURN ;EXIT
TERMEX: ;"<"
CALL GETNB ;GOBBLE "<"
CALL EXPR0 ;GET AN EXPRESSION
TRO RERR,ERRQ ; ERROR IF NULL
CAIE R14,">" ;CHECK FOR CLOSING ">"
TROA RERR,ERRQ ; NO, FLAG ERROR
JRST GETNB ; YES, GOBBLE ">" & EXIT
TERMUP: ;"↑" UNARY OPERATOR PROCESSOR
SETZ R0, ;CLEAR AC
CALL GETCHR ;GET THE NEXT CHARACTER
LDB R2,C9PNTR ;MAP CHARACTER USING COLUMN 9
CALL GETCHR ;GOBBLE THE CHARACTER
XCT UPARJT(R2) ;EXECUTE TABLE
CAIE R0, ;RADIX MODIFICATION?
HRRM R0,LOCRDX ; YES, CHANGE IT
CALL TERM ;GET A TERM
TRO RERR,ERRQ ; ERROR IF NULL
RETURN ;EXIT
UPARJT: PHASE 0 ;UP-ARROW JUMP TABLE
TRO RERR,ERRQ ;UNDEFINED OPERATOR: FLAG ERROR
UPARC: JRST TERM1C ;↑C - ONE'S COMPLEMENT
UPARF: JRST TERMFL ;↑F - FLOATING POINT
UPARR: JRST TERM50 ;↑R - RADIX 50
UPARB: HRRZI R0,BINRDX ;↑B - BINARY RADIX
UPARO: HRRZI R0,OCTRDX ;↑O - OCTAL RADIX
UPARD: HRRZI R0,DECRDX ;↑D - DECIMAL RADIX
UPARH: HRRZI R0,HEXRDX!HEXENB;↑H - HEXADECIMAL RADIX
DEPHASE
TERM1C: ;↑C
CALL TERM ;GET A TERM
TRO RERR,ERRQ ; ERROR IF NULL
TRC R10,177777 ;TAKE ONE'S COMPLEMENT
RETURN ;EXIT
TERMFL: ;↑F - FLOATING POINT CONSTANT
CALL SETNB ;IGNORE LEADING BLANKS
HRRZI R0,1
MOVEM R0,FLTLEN ;SET FLOATING LENGTH TO ONE
CALL FLTG ;EVALUATE F.P. CONSTANT
TLNE RERR,FLTFLG ;ANY ERRORS?
TRO RERR,ERRA ; YES, FLAG ERROR
MOVE R10,FLTNUM ;PUT RESULT IN R10
RETURN ;EXIT
TERM50: SETZ R0, ;CLEAR ACCUMULATOR
MOVSI R1,(POINT 6,R0,17) ;SET POINTER
TERM51: CALL TSTNT ;CHECK NON-TERMINATOR
JRST TERM53 ; END IF EOL
MOVEI R3,-40(R14) ;GET A SIXBIT COPY
LDB R2,ANPNTR ;MAP CHARACTER FOR TYPE
CAIN R2,.HEX ;O.K. IF A-F
JRST TERM52
CAIE R2,.ALP ; OR G-Z OR . OR $
CAIN R2,.NUM ; OR 0-9
CAIA
JUMPN R3,TERM53 ; OR SPACE, ELSE END
TERM52: IDPB R3,R1 ;ACCUMULATE THE CHARACTER
CALL GETCHR ;GET THE NEXT CHARACTER
TLNE R1,770000 ;FINISHED WITH 3 CHARACTERS?
JRST TERM51 ; NO, PROCESS NEXT CHARACTER
TERM53: CALL SIXM40 ;CONVERT SIXBIT TO RAD50
HRRZ R10,R0 ;PUT VALUE IN R10
JRST SETNB ;EXIT WITH NEXT NON-BLANK
SUBTTL SYMBOL/CHARACTER HANDLERS
; ORDINARY SYMBOLS ARE A SEQUENCE OF ALPHAMERIC CHARACTERS
; BEGINNING WITH AN ALPHABETIC CHARACTER; "." AND "$"
; ARE CONSIDERED ALPHABETIC.
; LOCAL SYMBOLS ARE A DECIMAL INTEGER FOLLOWED BY
; A "$". THE INTEGER'S VALUE MUST BE IN THE RANGE
; [1,65535].
; IF GETSYM FAILS TO FIND A SYMBOL, IT RETURNS TO 0(RLINK)
; WITH R0 = 0.
; IF THE NEXT NONBLANK TEXT IS A SYMBOL, GETSYM RETURNS TO
; 1(RLINK) WITH THE SYMBOL'S MOD40 EQUIVALENT IN R0.
; ANY CHARACTERS AFTER THE SIXTH IN THE SYMBOL ARE SKIPPED.
; FOR LOCAL SYMBOLS, THE VALUE RETURNED (IN R0) IS . . .
; LEFT HALF: INTEGER PART OF SYMBOL (16 BITS);
; HIGH ORDER BITS ARE 0 & 1 (200000)
; RIGHT HALF: BLOCK NUMBER OF CURRENT LOCAL SYMBOL BLOCK
GETSYM: ;GET A SYMBOL
CALL SETNB ;BYPASS LEADING BLANKS
MOVEM R13,SYMBEG ;SAVE START FOR RESCAN
MOVSI R1,(POINT 6,R0,) ;SET POINTER
TDZA R0,R0 ;CLEAR AC AND SKIP
GETSY1: CALL GETCHR ;GET NEXT CHARACTER
LDB R2,ANPNTR ;MAP CHARACTER TYPE
XCT GETSYT(R2) ;EXECUTE TABLE
GETSY0: SUBI R14,40 ;VALID, CONVERT TO SIXBIT
TLNE R1,770000 ;ARE WE FULL?
IDPB R14,R1 ; NO, STORE CHARACTER
JRST GETSY1
GETSY2: JUMPE R0,CPOPJ ;EXIT IF EMPTY
MOVEM RBYTE,SYMDEL ; SAVE SYMBOL DELIMITER FOR PARSERS.
CALL SETNB ;SYMBOL, RETURN NON-BLANK
CALL SIXM40 ;CONVERT TO MOD40
JRST CPOPJ1 ;EXIT +1
GETSY3: SETCM R3,LOCRDX ;GET LOCAL RADIX COMPLEMENTED
TRNE R3,HEXRDX!HEXENB ;CHECK HEX RADIX AND HEX ENABLED
JRST GETSY0 ; NO, CONTINUE WITH SYMBOL
RETURN ; YES, EXIT EMPTY
GETSYT: ;GETSYM TABLE
PHASE 0
JRST GETSY2 ;NON-ALPHA/NUMERIC
.TAB: JRST GETSY2 ;BLANK
.ALP: JFCL ;ALPHA, O.K.
.NUM: JUMPE R0,GETLSY ; NUMERIC => LOCAL SYM IF 1ST BYTE
.HEX: JUMPE R0,GETSY3 ;A-F O.K. IF NOT FIRST
DEPHASE
; ******* GET A LOCAL SYMBOL *******
; IF THE NUMERIC PART DOESN'T END WITH A "$", THIS
; CAN'T BE A LOCAL SYMBOL. IN THAT CASE RESTORE
; THE ORIGINAL SOURCE INPUT POINTER & RETURN SAYING
; NO SYMBOL WAS FOUND.
; INITIAL ENTRY TO THIS BLOCK OF CODE IS AT GETLSY.
GETL1: CALL GETCHR ; GET NEXT BYTE
LDB R2,ANPNTR ; LOAD ITS TYPE
XCT GETLTS(R2) ; -- CHECK TYPE
IMULI R0,↑D10 ; TYPE IS NUMERIC -- ACCUMULATE
GETLSY: SUBI R14,60 ; BINARY INTEGER.
ADD R0,R14
JRST GETL1
GETLDO: CAIE R14,"$" ; TYPE IS ALPHA -- IS THIS "$"?
JRST GETLNS ; NO -- CAN'T BE LOCAL SYM
CALL GETCHR ; YES -- SKIP THIS BYTE
CAIE R0, ; INSURE THAT INTEGER IS
CAIL R0,↑D65536 ; IN [1,65535]
TRO RERR,ERRT ; GIVE A T FLAG IF IT ISN'T
TRZ R0,400000 ; FORCE HIGH ORDER BIT OFF,
TRO R0,200000 ; LOW ORDER BIT ON.
HRL R0,R0 ; COPY INTEGER TO LEFT HALF,
HRR R0,LSBLOC ; LS BLOCK # TO RIGHT HALF.
JRST CPOPJ1 ; RETURN.
; --- FOUND A DISTINCTLY UNKOSHER CHARACTER BEFORE
; COMING ACROSS A "$". UNDECIDE THAT THIS IS A SYMBOL.
GETLNS: MOVE R13,SYMBEG ; RESTORE INPUT POINTER
LDB R14,R13 ; RELOAD FIRST BYTE.
SETZ R0 ; RETURN 0
RETURN
GETLTS:
JRST GETLNS ; NON ALPHA-NUMERIC
JRST GETLNS ; BLANK OR TAB
JRST GETLDO ; ALPHABETIC (HOPEFULLY $)
JFCL ; NUMERIC
JRST GETLNS ; A-F
GETNB: ;GET NON-BLANK CHARACTER
IBP RBPTR ;INDEX BYTE POINTER
SETNB: ;SET TO NON-BLANK CHARACTER
CALL SETCHR ;SET CHARACTER IN RBYTE
CAIE RBYTE,SPACE ;IF SPACE
CAIN RBYTE,TAB ; OR TAB;
JRST GETNB ; BYPASS
RETURN ;OTHERWISE EXIT
SETCHI: TRO RERR,ERRI ; SET I FLAG FOR ILLEGAL CHAR.
; DROP THRU TO GETCHR TO SKIP IT.
GETCHR: ;GET THE NEXT CHARACTER
IBP RBPTR ;INDEX BYTE POINTER
SETCHR: ;SET THE CURRENT CHAR IN RBYTE
LDB RBYTE,RBPTR ;PICK IT UP
LDB R4,C6PNTR ; LOAD CHARACTER'S TYPE.
XCT SCHTAB(R4) ; CHECK FOR LOWER CASE & THINGS.
RETURN
SCHTAB:
PHASE 0
JFCL ; IGNORE RANDOM CHARACTERS.
SCIL: JRST SETCHI ; ILLCHR - ISSUE I FLAG & SKIP BYTE.
SCEL: JRST GETEOL ; ELLCHR - SKIP TO END OF LINE.
SCLC: JRST FOLTST ; LOWER CASE - FOLD UNLESS OVERRIDDEN
SCLE: JFCL ; LINE END (CR, LF, FF, NUL) - IGNORE
SCSE: JFCL ; SEPARATOR (, ;, BLANK, TAB) - IGNORE
DEPHASE
GETEOL: CALL GETNT ; SKIP TO END OF LINE.
RETURN ; .... FOUND IT: RETURN.
JRST GETEOL ; .... NOT THERE YET: KEEP GOING.
FOLTST: TLNN R16,FOLBIT ; IS FOLDING OVERRIDEN AT PRESENT?
SUBI RBYTE,40 ; NO -- FOLD INTO UPPER CASE.
RETURN ; RETURN WITH BYTE, FOLDED OR NOT.
GETNT: ; GET NON-TERMINATOR.
CALL GETCHR ; GET NEXT BYTE.
TSTNT: ; TEST FOR NON-TERMINATOR.
LDB R4,C6PNTR ; LOAD CURRENT BYTE'S TYPE.
CAIE R4,SCLE ; IS IT END-OF-LINE OF ANY SORT?
AOS (RLINK) ; NO -- RETURN + 2.
RETURN ; YES - RETURN + 1.
TSTNSP: ; TEST FOR NON-SEPARATOR
LDB R4,C6PNTR ; GET CHARACTER TYPE.
CAIE R4,SCSE ; IS IT SEPARATOR?
AOS (RLINK) ; NO -- RETURN + 2.
RETURN ; YES - RETURN + 1.
; --- MACARG ---
; .. SUBROUTINE TO GET A MACRO-TYPE ARGUMENT. THE ARGUMENT
; IS A CHARACTER STRING WHICH MAY BE DELIMITED IN ANY OF
; THREE WAYS:
; STRING@ WHERE "@" REPRESENTS ",", ";", BLANK, TAB,
; OR ANY END-OF-LINE DELIMITER.
; ↑\STRING\ WHERE "\" IS ANY CHARACTER EXCEPT AN END-OF-LINE.
; <STRING> [STRING MAY INCLUDE NESTED "<...>" CONSTRUCTIONS]
; MACARG STORES "STRING" BEGINNING AT LOCATION ARGSTR
; IN ASCIZ FORMAT, AND STORES THE NUMBER OF BYTES IN THE STRING
; IN ARGLEN.
MACART: TDZA R10,R10 ; FLAG MACRO CALL ENTRY;
; WHEN ENTERED VIA MACART, THE ARGUMENT BEING PARSED IS
; WRITTEN INTO A MACRO CALL BLOCK.
MACARG: TRO R10,1 ; FLAG NON-MACRO CALL ENTRY.
PUSH RLINK,R3 ; SAVE WORK REGISTERS.
PUSH RLINK,R4
SETZM ARGLEN ; INIT STRING LENGTH TO 0.
MOVE R3,[POINT 7,ARGSTR] ; POINT TO SPACE FOR ARG STRING.
CALL SETNB ; GET 1ST NONBLANK BYTE.
CALL TSTNT ; IS IT END OF LINE?
JRST MAREXA ; YES - ARGUMENT IS NULL.
CAIN RBYTE,"<" ; IS STRING BRACKETED?
JRST MARBRA
CAIN RBYTE,"↑" ; IS IT "↑" CONSTRUCTION?
JRST MARAR
; STRING OF FIRST TYPE; COLLECT UP TO A SEPARATOR.
MARSTR: CALL TSTNSP ; CHECK FOR A SEPARATOR.
JRST MAREXA
; ** CHARACTER ISN'T A DELIMITER; APPEND IT TO THE STRING
; BEING COLLECTED & INCREMENT ITS LENGTH.
CALL SMB ; STORE THE CHARACTER.
CALL GETNT ; GET NEXT BYTE
JRST MAREXA ; .. END OF LINE => QUIT.
JRST MARSTR ; GO BACK TO CHECK NEW BYTE.
MARERR: TRO RERR,ERRQ ;<<<< UNEXPECTED END OF LINE
MAREX: CALL TSTNT ; IS STRING DELIMITED BY END OF LINE?
CAIA ; YES -- DON'T SKIP DELIMITER.
CALL GETNB ; NO --- SKIP DELIMITER.
MAREXA: SETZ R4, ; APPEND A 0 BYTE TO THE STRING.
IDPB R4,R3
POP RLINK,R4 ; RESTORE REGISTER CONTENTS.
POP RLINK,R3
RETURN ; ... RETURN TO CALLER ...
; "↑\....\"
MARAR: CALL GETNT ; SKIP "↑".
JRST MARERR ; CAN'T TOLERATE END OF LINE HERE.
MOVE R1,RBYTE ; SAVE DELIMITER IN R1.
MARARB: CALL GETNT ; GET NEXT BYTE OF STRING.
JRST MARERR ; .. CAN'T BE END OF LINE.
CAMN RBYTE,R1 ; IS THIS THE DELIMITER?
JRST MAREX ; YES - QUIT HERE.
CALL SMB ; NO -- STORE THE BYTE.
JRST MARARB ; KEEP ON TRUCKIN'
; "<.....>"
MARBRA: MOVEI R1,1 ; SET BRACKET LEVEL TO 1.
MARB: CALL GETNT ; GET NEXT BYTE.
JRST MARERR ; .. CAN'T BE END OF LINE.
CAIN RBYTE,"<" ; IS IT NESTED MACRO ARG?
AOJ R1, ; YES .. INCR NEST LEVEL
CAIE RBYTE,">" ; IS IT END OF A BRACKETED STRING?
JRST MARBS ; NO .. JUST A STRING BYTE.
SOJLE R1,MAREX ; YES .. DECR NEST LEVEL
; BUT QUIT AT OUTERMOST ">"
MARBS: CALL SMB ; APPEND BYTE TO THE STRING.
JRST MARB ; GO BACK FOR MORE.
SMB: IDPB RBYTE,R3 ; STORE NEXT BYTE IN ARG STRING.
AOS ARGLEN ; INCREMENT STRING LENGTH.
TRNN R10,1 ; BUILDING A CALL BLOCK?
CALL WCIMT ; YES - ALSO WRITE INTO TREE.
RETURN
SUBTTL PSEUDO-OPS
.END: ;"END" PSEUDO-OP
SKIPN CONLVL ;IF IN CONDITIONAL
SKIPE REPLVL ; OR REPEAT,
TRO R15,ERRE ; FLAG ERROR
TLO R15,ENDFLG ;FLAG "END SEEN"
TLZ R16,SBTBIT ;TURN OFF SUBTITLE SWITCH
CALL EXPRF ;EVALUATE THE ADDRESS
END2: MOVEI R10,1 ; NULL, FORCE ODD VECTOR
MOVEM R10,PF1
MOVEM R10,ENDVEC
TRNE R15,ERRU ;ANY UNDEFINED SYMBOLS?
TRO R15,ERRP1 ; YES, PASS ONE ERROR
RETURN
OPCERR: ;ILLEGAL OP CODE
TRO R15,ERRO
RETURN
TSTEVN: ;TEST FOR EVEN
TRNN R5,1 ;ARE WE EVEN?
RETURN ; YES, JUST EXIT
TRO R15,ERRB ;NO, FLAG ERROR AND EVEN THINGS UP
PUSH R17,R1
CALL .EVEN
POP R17,R1
RETURN
.EVEN: ;"EVEN" PSEUDO OP
TRNN R5,1 ;EVEN?
RETURN ; YES, NO SEQUENCE BREAK
PCMOD: AOS R1,R5 ;GET PC
HRLI R1,(<RLDT10>B<MODOFF>) ;FLAG AS CLASS 10
JRST STCODE
.ODD: ; "ODD" PSEUDO-OP
TRNE RLOC,1 ; IS LOCATION ALREADY ODD?
RETURN ; YES - NOTHING TO DO
JRST PCMOD ; NO - INCR PC LIKE .EVEN
.LIMIT: ; ".LIMIT" PSEUDO-OP
TLNE R15,ABSFLG ;ABS MODE?
RETURN ; YES, IGNORE IT
CALL TSTEVN ;NO, MAKE SURE WE'RE EVEN
MOVSI R1,BC2(<RLDT11>B<MODOFF>)
CALL STCODE
MOVSI R1,BC2
JRST STCODE ;GENERATE TWO WORDS
ABS0: TLO R15,ABSFLG ;SET ABSOLUTE FLAG
TLZ R5,(PFMASK) ;CLEAR RELOCATION
RETURN
ASECT: MOVE R0,.ABS. ;FUDGE FOR ABS
JRST CSECT1 ;BRANCH AROUND TEST
CSECT: CALL LOCRES ; START NEW LOCAL SYMBOL BLOCK
TLNE R15,ABSFLG ;ABS MODE?
JRST OPCERR ; YES, ERROR
CALL GETSYM ;TRY FOR A SYMBOL
JFCL ; DEFAULT OR ABS
CSECT1: CALL TSTMAX ;TEST MAX PC
MOVSI R10,-↑D256 ;INIT FOR SEARCH
CSECT2: CAMN R0,SECNAM(R10) ;MATCH?
JRST CSECT3 ; YES
TRNE R10,-2 ;IF POINTING AT ONE
SKIPE SECNAM(R10) ;OR SLOT IS FULL,
AOBJN R10,CSECT2 ;LOOP
JUMPL R10,CSECT3 ;BRANCH IF GOOD
TRO R15,ERRA ;END, ERROR
RETURN
CSECT3: MOVEM R0,SECNAM(R10) ;SAVE NAME
MOVE R1,R5 ;GET CURRENT PC
LDB R2,SUBPNT ;CURRENT RELOCATION
HRRM R1,SECBAS(R2) ;STORE CURRENT
HRRZ R5,SECBAS(R10) ;GET NEW ONE
DPB R10,CCSPNT ;MAKE SURE RELOCATION IS SET
MOVE R1,R5
AOS R2,GLBPNT
MOVEM R0,GLBBUF(R2) ;STORE NAME
ANDI R1,177777
DPB R2,SUBPNT ;STORE POINTER
MOVEI R3,RLDT7
DPB R3,MODPNT ;SET CLASS 7
JRST STCODE
TSTMAX: LDB R3,CCSPNT ;GET CURRENT SEC
HLRZ R4,SECBAS(R3) ;MAX FOR THIS ONE
CAIGE R4,0(R5) ;NEW MAX?
HRLM R5,SECBAS(R3) ; YES
RETURN
.IDENT: ;IDENTIFY PROGRAM
SETZ R0,
MOVSI R1,(POINT 6,R0,) ;CREATE POINTER
CALL SETNB
CAIL R14,41
CAILE R14,137
JRST .IDERR ;NOT A LEGAL DELIMITER
CAIN R14,";"
JRST .IDERR ;MUST HAVE SOMETHING
MOVE R10,R14 ;SAVE DELIMITER
.IDNT2: CALL GETNT
JRST .IDCON ;EOL SO GO CONVERT TO MOD40
CAMN R10,R14 ;DELIMITER?
JRST .IDCON ;YES - CONVERT
CAIN R14,";"
JRST .IDCON
TLNN R1,770000
JRST .IDNT4
MOVEI R3,-40(R14) ;SAVE A SIXBIT COPY
LDB R2,ANPNTR ;TEST FOR LEGAL
CAIN R2,.HEX ; MOD40 CHARACTER
JRST .IDNT3
CAIE R2,.ALP
CAIN R2,.NUM
CAIA
JUMPN R3,.IDERR ;IF NOT SPACE THEN ERROR
.IDNT3: IDPB R3,R1 ;STORE AWAY THE CHAR
JRST .IDNT2 ;GET MORE
.IDNT4: CALL GETNT
JRST .IDCON
CAIE R14,";"
CAMN R10,R14
CAIA
TRO RERR,ERRQ ;MORE THAN 6 CHAR IN TITLE -FLAG Q ERROR
.IDCON: CALL SIXM40 ;GET A MOD40 COPY
MOVEM R0,PRGTTL ;SAVE THE TITLE
.IDNT5: JUMPE R14,CPOPJ
CALL GETNB
JRST .-2
RETURN
.IDERR: TRO RERR,ERRO
JRST .IDNT5
.RAD50: ;RADIX 50
CALL TSTEVN ; SET UP PC TO STORE WORDS.
SETZ R0, ; INIT RESULT VALUE = 0.
MOVEI R1,3 ; 3 BYTES TO GO IN CURRENT WORD.
; PARSE NEXT FIELD OF THE OPERAND.
.RADFL: CAIN RBYTE,"<" ; IS THIS A BRACKETED EXPR?
JRST RABRAC ; YES - EVALUATE IT.
JRST RADARB ; NO -- THIS IS ARBITRARY DELIM.
; END OF FIELD . . .
.RADFE: CALL GETNT ; SKIP FIELD DELIMITER.
JRST .RAFLU ; .. FLUSH AT END OF OPERAND.
CAIN RBYTE,";"
JRST .RAFLU
CAIE RBYTE," " ; IF NEXT BYTE IS BLANK OR TAB,
CAIN RBYTE,TAB ; JUST SKIP OVER IT.
JRST .RADFE
JRST .RADFL ; .. FOUND ANOTHER OPERAND ...
; ";" OR END OF LINE ENCOUNTERED -- FORCE OUT ANY
; PARTIALLY ASSEMBLED WORD OF RAD50 GOODIES. IF OPERAND
; WAS EXPLICITLY NULL, OUTPUT 1 WORD OF 0.
.RAFLU: CAIE R1,3 ; IS CURRENT WORD EMPTY?
JRST .RAFLL ; NO -- PAD & STORE IT.
SKIPE CODPNT ; YES - DO SAME ANYWAY IF
RETURN ; IT'S THE ENTIRE OPERAND.
.RAFLL: SETZ R10, ; APPEND 0'S TO PARTIAL WORD
CALL RABOUT ; UNTIL RABOUT FILLS & STORES IT.
JRST .RAFLU
; "<EXPR1,EXPR2,...,EXPRN>" ....
; EVALUATE EACH EXPRESSION AND USE IT AS THE ENCODED
; VALUE OF A BYTE.
RABRAC: PUSH RLINK,R0 ; SAVE WORD UNDER CONSTRUCTION
PUSH RLINK,R1 ; & BYTE COUNTER.
CALL GETNB ; SKIP "<" OR ",".
CALL EXPR ; EVALUATE NEXT EXPRESSION.
TRO RERR,ERRQ ; ... NULL OR INVALID
CAIGE R10,50 ; IS RESULT TOO LARGE?
JRST RABRDY ; NO -- KEEP IT.
SETZ R10, ; YES - FORCE IT TO 0
TRO RERR,ERRT ; & FLAG TRUNCATION ERROR.
RABRDY: POP RLINK,R1 ; RESTORE WORK REGS.
POP RLINK,R0
CALL RABOUT ; ENCODE EXPR VALUE.
CAIN RBYTE,"," ; DOES ANOTHER EXPR FOLLOW?
JRST RABRAC ; YES - GO GET IT.
CAIE RBYTE,">" ; NO -- IS END LEGIT?
TRO RERR,ERRQ ; NO... QUESTIONABLE SYNTAX.
JRST .RADFE ; YES.. END OF FIELD.
; "/[TEXT]/" ... TEXT WITH AN ARBITRARY DELIMITER
RADARB: MOVE R3,RBYTE ; SAVE DELIMITER.
RADARN: CALL GETNT ; GET NEXT CHARACTER.
JRST ASCQ ; ... UNEXPECTED END OF LINE
CAMN RBYTE,R3 ; IS THIS THE DELIMITER AGAIN?
JRST .RADFE ; YES - END OF FIELD
MOVEI R10,-40(RBYTE) ; NO -- CONVERT BYTE TO SIXBIT,
HLRZ R10,RADTBL(R10) ; THEN TO RAD50 VALUE.
CAIE R10,0 ; IS ENCODED VALUE 0?
JRST RADBOK ; NO -- IT'S VALID.
CAIE RBYTE," " ; YES - VALID ONLY IF
TRO RERR,ERRA ; IT'S A BLANK.
RADBOK: CALL RABOUT ; ENCODE THIS BYTE.
JRST RADARN ; GO BACK FOR THE NEXT ONE.
; SUBROUTINE RABOUT "OUTPUTS" ONE RAD50 BYTE. IT ENCODES
; BYTES INTO A WORD & STORES THE WORD WHEN IT BECOMES FULL.
RABOUT: IMULI R0,50 ; MULTIPLY PREVIOUS VALUE BY RADIX.
ADD R0,R10 ; ADD CURRENT BYTE VALUE.
SOJG R1,RABPAR ; DECREMENT BYTE COUNT.
RABSTO: MOVE R1,R0 ; *** WORD'S FULL - STORE IT ***
HRLI R1,BC2 ; INDICATE 16-BIT VALUE.
CALL STCODE ; STUFF IT.
SETZ R0, ; NEW WORD VALUE = 0,
MOVEI R1,3 ; NEW BYTE COUNT = 3.
RABPAR: RETURN
.RADIX: ;".RADIX n" PSEUDO-OP
MOVEI R2,DECRDX ;SET RADIX TO 10 TO EVALUATE OPERAND
CALL RADEXP ;EVALUATE OPERAND
JRST .RAD8 ; DEFAULT NULL TO OCTAL
SETZ R0, ;CLEAR AC
CAIN R10,↑D2 ;CHECK IF n=2
MOVEI R0,BINRDX ; YES, SET BINARY RADIX
CAIN R10,↑D4 ;CHECK IF n=4
MOVEI R0,QUARDX ; YES, SET QUATERNARY RADIX
.RAD8: CAIN R10,↑D8 ;CHECK IF n=8
MOVEI R0,OCTRDX ; YES, SET OCTAL RADIX
CAIN R10,↑D10 ;CHECK IF n=10
MOVEI R0,DECRDX ; YES, SET DECIMAL RADIX
CAIN R10,↑D16 ;CHECK IF n=16
MOVEI R0,HEXRDX ; YES, SET HEXADECIMAL RADIX
JUMPE R0,.RADER ;JUMP IF NOT LEGAL RADIX
HRRM R0,GLBRDX ;SET THE NEW RADIX
MOVEM R10,RADVAL ; SAVE ITS NUMERIC VALUE TOO!!!
RETURN ;EXIT GOOD
QERR: ; OTHER ROUTINES DO THIS TOO.
.RADER: TRO RERR,ERRQ ;ERROR IF n NOT ONE OF 2,4,8,10,16
RETURN ;EXIT W/O CHANGING RADIX
.OPDEF: ;.OPDEF HANDLER
TLNN R15,NSFFLG ; NONSTANDARD FEATURES ENABLED?
TRO R15,ERRO ; NO, FLAG ERROR
CALL GETSYM ;GET THE NAME
JRST .OPDE2 ; NULL, ERROR
CAIE R14,"," ;TEST FOR COMMA
JRST .OPDE2 ; MISSING
CALL GETNB ;BYPASS COMMA
PUSH R17,R0 ;STACK NAME
CALL GETSYM ;GET THE TYPE
JRST .OPDE1 ; NOT A SYMBOL, ERROR
CAIE R14,","
JRST .OPDE1 ;MISSING COMMA
CALL GETNB ;BYPASS COMMA
CALL OSRCH ;SEARCH THE OP-CODE TABLE
JRST .OPDE1 ; NOT THERE
CAIE R2,OCOP ;OP CODE?
JRST .OPDE1 ; NO, ERROR
PUSH R17,R1 ;OK, STACK TYPE
CALL ABSEXP ;COMPUTE BASIC VALUE
POP R17,R0 ;RETRIEVE TYPE
DPB R1,[POINT 16,R0,35] ;STORE NEW VALUE
EXCH R0,0(R17) ;EXCHANGE FOR NAME
CALL MSRCH ;SET SEARCH INDEX
JFCL ; MOX NIX IF FOUND
POP R17,R1 ;RETRIEVE VALUE
TLZ R1,(MDMASK) ;MASK MODE BITS
CALL INSRT ;INSERT IN TABLE
MOVSI R1,MAOP ;CREF AS MACRO
JRST CRFDEF ;CREF AND EXIT
.OPDE1: POP R17,0(R17) ;PRUNE STACK
.OPDE2: TRO R15,ERRA ;FLAG ERROR
RETURN ;EXIT
.GLOBL: ;.GLOBL PSEUDO-OP
TLNE R15,ABSFLG
JRST OPCERR
CALL GETSYM ;GET A SYMBOL
JRST .GLOB1 ; NULL, ERROR
CAMN R0,M40DOT ;MESSING WITH PC?
JRST .GLOB1 ; YES, ERROR
CALL SSRCH ;OK, SEARCH TABLE
JFCL
CALL CRFREF
TLNE R1,REGSYM ;REGISTER SYMBOL?
TLOA R1,MDFSYM ; YES, ERROR
TLOA R1,GLBSYM ;NO, FLAG GLOBAL
TRO R15,ERRR ; YES, FLAG REGISTER ERROR
CALL INSRT ;INSERT IN TABLE
CAIA
.GLOB1: TRO R15,ERRA ;ERROR FROM ABOVE
CAIE R14,"," ;MORE TO COME?
RETURN ; NO, EXIT
CALL GETNB ;YES, BYPASS COMMA
JRST .GLOBL ;LOOP
.TITLE: ;TITLE PSEUDO-OP
PUSH R17,R13 ; SAVE POINTER
PUSH R17,R14 ; SAVE CHARACTER
MOVE R11,[POINT 7,TTLMSG]
TLO R16,FOLBIT ; DON'T FOLD TITLE INTO UPPER CASE.
CAIA ; SKIP ILDB THIS FIRST TIME
TTLP: CALL GETCHR ; GET A CHAR
CALL TSTNT ; END OF LINE?
JRST TTLEND ; YES, FINISH IT UP
IDPB R14,R11 ; STORE CHAR IN BUFFER
JRST TTLP ; BACK AGAIN
TTLEND: SETZ R0
IDPB R0,R11 ; NULL BYTE INDICATES END
TLZ R16,FOLBIT ; RESUME FOLDING FOR GETSYM.
POP R17,R14 ; RESTORE CHAR
POP R17,R13 ; RESTORE POINTER
CALL GETSYM ;GET THE SYMBOL
JRST [
TRO R15,ERRA ;FLAG ERROR
JRST TTLRT
]
MOVEM R0,PRGTTL ;OK, STORE TITLE
IFN CCLSW,<
CALL PRNAM
>
SETOM TTLFLA ;SET FLAG
TTLRT: JUMPE R14,CPOPJ ;EXIT IF END OF LINE
CALL GETNB ;AVOID Q ERROR
JRST .-2
RETURN
.PDP10:
.EOT:
RETURN
IFN CCLSW,<
PRNAM:
SKIPN TTLFLA ;ONLY PRINT PROGRAM NAME ONCE
SKIPN CCLFLA ;ONLY PRINT IF CCL MODE
RETURN
PUSH R17,R16 ;SAVE FLAG STATUS
MOVSI R16,ERRBIT!LSTBIT!BINBIT ;TO ALLOW TTY OUTPUT
MOVE R0,PRGTTL ;GET PROGRAM TITLE
CALL M40SIX ;CONVERT MOD40 TO SIXBIT
CALL LSTSIX
CALL LSTCR
POP R17,R16
RETURN
>
.ASCIZ: TDZA R2,R2 ; ".ASCIZ" DIRECTIVE
.ASCII: MOVEI R2,1 ; ".ASCII" DIRECTIVE
TLO R16,FOLBIT ; OVERRIDE FOLDING TO COLLECT ASCII.
PUSH RLINK,RLOC ; SAVE CURRENT PC VALUE.
.ASCI1: CALL ASCOP ; PROCESS AN OPERAND.
.ASCI3: CALL GETNT ; CHECK NEXT CHARACTER.
JRST .ASCI2 ; ** END OF LINE
CAIN RBYTE,";" ; ** NOT EOL - IS IT START OF COMMENT?
JRST .ASCI2 ; .. YES - QUIT HERE.
CAIE RBYTE," " ; .. NO -- BLANK OR TAB?
CAIN RBYTE,TAB
JRST .ASCI3 ; YES - SKIP IT.
JRST .ASCI1 ; NO - HANDLE CONCATENATED OPERAND.
; END OF OPERAND FIELD. APPEND A 0 BYTE IF OPERATION
; IS .ASCIZ.
.ASCI2: SETZ RBYTE, ; READY A 0 BYTE.
CAIN R2, ; WHICH DIRECTIVE IS THIS?
CALL ASCOUT ; ** .ASCIZ - OUTPUT THE 0.
JRST .WORDX ; RESTORE PC VALUE ON EXIT.
; ---------- PROCESS AN OPERAND ------------
ASCOP: CAIN RBYTE,"<" ; IS OPERAND IN BRACKETS?
JRST ASCEXP ; YES - IT'S A NUMBER.
MOVE R3,RBYTE ; NO - SAVE DELIMITER BYTE.
ASCTEX: CALL GETNT ; GET NEXT BYTE.
JRST ASCTER ; END OF LINE ISN'T LEGAL.
CAMN RBYTE,R3 ; IS THIS THE DELIMITER?
RETURN ; YES -- QUIT HERE.
CALL ASCOUT ; NO -- STORE THE BYTE.
JRST ASCTEX
ASCTER: TRO RERR,ERRA ; ** ILLEGAL END OF LINE **
POP RLINK,0(RLINK) ; TIDY UP THE STACK.
JRST .ASCI2 ; DO A KOSHER EXIT.
; ------- PROCESS ONE OR MORE EXPRESSIONS
; ------- IN THE FORM "<#1,#2,...,#N>".
ASCEXP: PUSH RLINK,R2 ; SAVE .ASCII/.ASCIZ FLAG.
TLZ R16,FOLBIT ; RESUME FOLDING INPUT.
ASCNXT: CALL GETNB ; SKIP "<" OR ",".
CALL EXPR ; DECIPHER AN EXPRESSION
JRST ASCQ ; NULL OR INVALID - GIVE IT Q FLAG
PUSH RLINK,R14 ; SAVE THE TERMINATING DELIMITER.
MOVE R14,R10 ; COPY BINARY RESULT TO BYTE REG,
TRZE R14,777000 ; TEST FOR BAD MAGNITUDE.
TRO RERR,ERRT ; :: FLAG A TRUNCATION ERROR ::
CALL ASCOUT ; STORE THIS BYTE.
POP RLINK,R14 ; RELOAD NUMBER'S DELIMITER.
CAIN R14,"," ; "," => GET ANOTHER NUMBER.
JRST ASCNXT
TLO R16,FOLBIT ; QUIT FOLDING INPUT AGAIN.
POP RLINK,R2 ; RESTORE .ASCII/.ASCIZ FLAG.
CAIE R14,">" ; WAS ENDING DELIM PROPER?
ASCQ: TRO RERR,ERRQ ; -- NO - QUESTIONABLE SYNTAX.
RETURN
; STORE NEXT BYTE.
ASCOUT: MOVE R1,R14 ; COPY BYTE TO BE STORED TO PARM REG.
HRLI R1,BC1 ; SHOW BYTE COUNT = 1.
CALL STCODE ; STORE THE BYTE.
AOJA RLOC,CPOPJ ; INCREMENT PC AND RETURN.
.PAGE: ; FORCE A PAGE EJECT
TLNE RMODE,P1F ; IS THIS PASS 2?
RETURN ; NO - TAKE NO ACTION.
TRO R16,HDRBIT ; YES - GET A NEW PAGE
MOVE R0,LSTCTL ; GET LISTING FLAGS.
TRNN R0,LLD ; IS .NLIST LD IN EFFECT?
TLO R16,NLISLN ; YES -- DON'T LIST .PAGE
RETURN
.SBHED: ; SUBHEADING DIRECTIVE
TDOA R2,R2 ; SET R2 TO BITS TO FLAG .SBHED ENTRY.
.SBTTL: ;"SUBTITLE" PSEUDO-OP
SETZ R2, ; CLEAR R2 TO FLAG .SBTTL ENTRY.
TLO R16,FOLBIT ; DON'T FOLD INPUT.
TLNE RMODE,P1F ; IS THIS PASS 1?
JRST SBP1 ; YES - JUST LIST STUFF
; ---------- PASS 2 PROCESSING -----------
MOVE R11,[POINT 7,SUBMSG] ;OBTAIN POINTER TO BUFFER
JRST .+2 ;BYPASS ILDB FIRST TIME THRU
SBLP: CALL GETCHR ; GET NEXT CHARACTER.
CALL TSTNT ;END OF LINE SEEN?
JRST SBEND ;YES, GET OUT
IDPB R14,R11 ;PUT BYTE AWAY
JRST SBLP ;DO ANOTHER
SBEND: MOVEI 0 ;END OF SUBTITLE
IDPB R11 ;IS A ZERO BYTE
TLO R16,SBTBIT ;MARK THAT WE AHVE SEEN A SBTTL
CAIN R2,0 ; ** FORCE PAGE EJECT ONLY IF
RETURN ; ** OP WAS .SBHED, RATHER THAN .SBTTL,
TLNN R16,LOHBIT ; ** AND LAST OUTPUT WASN'T HEADER
TRO R16,HDRBIT
RETURN
; ------------- PASS 1 PROCESSING ---------------
SBP1: MOVE R0,LSTCTL ; IS TOC LISTING ENABLED?
TRNE R0,LTOC
SKIPGE LSTCNT
RETURN ; NO - QUIT.
TLOE R16,SBTBIT ; YES - SUBHEAD ALREADY SET?
JRST SBTOCL
; SUPPLY 'TABLE OF CONTENTS' AS SUBTITLE.
MOVE R0,[XWD TOCSUB,SUBMSG] ; COPY TOC PROSE
BLT R0,SUBMSG+SBMEND-TOCSUB ; INTO SUBTITLE BUFFER
TRO R16,HDRBIT ; FORCE PAGE SKIP
; LIST OPERAND FIELD OF .SBTTL DIRECTIVE
SBTOCL: CALL FORSEQ ; FORMAT SEQUENCE # FIELD.
SBSEQ: CALL LPTOUT ; LIST A BYTE.
ILDB R2,R6 ; GET NEXT BYTE OF FORMATTED SEQ.
JUMPN R2,SBSEQ ; REPEAT UNTIL FINDING 0.
CALL LSTTAB ; FOLLOW WITH 2 TABS.
CALL LSTTAB
CALL SETCHR ; LOAD FIRST BYTE OF SUBTITLE
SBTOCN: MOVE R2,R14 ; COPY BYTE TO R2 FOR LPTOUA
CALL TSTNT ; CHECK FOR END OF LINE
JRST SBENDL ; <- RET 0 - END OR NULL
; <- RET 1 - PART OF TEXT
CALL LPTOUA ; PRINT NEXT BYTE
SBTGNX: CALL GETCHR ; SCAN TO FOLLOWING BYTE.
JRST SBTOCN
SBENDL: JUMPE R2,SBTGNX ; IGNORE A NULL BYTE
TDZ R2,R2 ; END OF LINE -- PRINT CR/LF
CALL LPTOUA
RETURN
TOCSUB: ASCIZ / TABLE OF CONTENTS/
SBMEND= .
; ============ .LIST & .NLIST ============
.LIST: MOVE R0,[XWD LISSET,LISTBL] ; CALL SUBROUTINE TO PARSE
CALL ARGSET ; ARGUMENT FIELD
AOSA LSTCNT ; ** NO ARGS -- INCREMENT LIST LEVEL
RETURN
JRST LISTYP
.NLIST: MOVE R0,[XWD LISRES,LISTBL] ; CALL ARG PARSER
CALL ARGSET
SOSA LSTCNT ; ** NO ARGS -- DECREMENT LIST LEVEL
RETURN
LISTYP: HRRZ R0,LSTCTL ; EITHER .LIST OR .NLIST HAD NO ARGS
TRNN R0,LLD ; SHOULD IT BE LISTED?
TLO R16,NLISLN ; NO - SET "UNLIST LINE" FLAG
RETURN
LISSET: CALL LSSSUB ; /// EXECUTED BY ARGSET ///
LISRES: CALL LSRSUB ; /// EXECUTED BY ARGSET ///
LSSSUB: HRLZ R2,R2 ; MOVE MODE BIT TO LH.
IORM R2,LSTCTL ; OR IT ON IN MEMORY.
JRST SETLF ; SET LIST FLAGS & RETURN.
LSRSUB: HRLZ R2,R2 ; MOVE MODE BIT TO LH.
ANDCAM R2,LSTCTL ; CLEAR IT IN MEMORY.
; SET LIST FLAGS & RETURN.
; SETLF SETS THE EFFECTIVE LISTING MODE FLAGS
; IN THE RIGHT HALF OF LSTCTL TO ACCOUNT FOR
; DIRECTIVES IN THE SOURCE AND OVERRIDES IN
; THE COMMAND STRING. IT'S CALLED BY INITIALIZATION,
; SWITCH PROCESSING, AND THE TWO SUBROUTINES ABOVE.
; NOTE THAT THE MANIPULATIONS BELOW DEAL WITH ONLY
; THE RIGHT HALF OF R0 & R1. THE LEFT HALF GOES
; ALONG FOR THE RIDE, BUT NEVER GETS STORED.
SETLF: MOVS R0,LIWORD ; LOAD OVERRIDE MASK.
HLRZ R1,LSTCTL ; LOAD SOURCE MODES.
ANDCAM R0,R1 ; CLEAR OVERRIDDEN BITS.
AND R0,LIWORD ; R0 = OVERRIDDEN BITS TO BE
IOR R1,R0 ; FORCED ON.
HRRM R1,LSTCTL ; STORE FINAL RESULT.
RETURN
LISTBL: XWD -17,.+1 ; 15 ARGS IN LISTBL
ARG B,E,X,LBEX ; TABLE OF .LIST & .NLIST OPERANDS
ARG B,I,N,LBIN
ARG C,O,M,LCOM
ARG C,N,D,LCND
ARG L,D, ,LLD
ARG L,O,C,LLOC
ARG M,C, ,LMC
ARG M,D, ,LMD
ARG M,E, ,LME
ARG M,E,B,LMEB
ARG S,E,Q,LSEQ
ARG S,R,C,LSRC
ARG S,Y,M,LSYM
ARG T,O,C,LTOC
ARG T,T,M,LTTM
; =========== .ENABL & .DSABL ============
.ENABL:
PUSH RLINK,RMODE ; SAVE MODE FLAGS
MOVE R0,[XWD ENASET,ENATBL] ; LOAD PARMS & CALL ARGSET
CALL ARGSET ; TO SET FLAGS
TRO RERR,ERRQ ; NO PARMS => Q ERROR
POP RLINK,R0 ; RETRIEVE OLD FLAGS
XOR R0,RMODE ; R0 = BITS TURNED ON BY .ENABL
TLNE R0,ABSFLG ; WAS ABS MODE SET?
TLZ RLOC,(PFMASK) ; YES - RESET RELOCATION
RETURN
.DSABL:
MOVE R0,[XWD ENARES,ENATBL]
CALL ARGSET ; CALL SUBR TO INTERPRET ARGS
TRO RERR,ERRQ ; NONE => Q ERROR
RETURN
ENASET: CALL ENSSUB ; ** EXECUTED TO ENABLE A MODE **
ENARES: CALL ENRSUB ; ** EXECUTED TO DISABLE A MODE **
ENSSUB: HRLZ R2,R2 ; SET AN ENABL OPTION BIT.
IORM R2,ENACTL ; STORE IN ENACTL LH.
JRST SETEN ; RETURN VIA SETEN.
ENRSUB: HRLZ R2,R2 ; CLEAR AN ENABL OPTION BIT.
ANDCAM R2,ENACTL ; STORE IN ENACTL LH.
; RETURN VIA SETEN.
; SETEN SETS THE EFFECTIVE ENABL MODE BITS IN ENACTL
; AND IN RMODE (R15) IN ESSENTIALLY THE SAME WAY
; SETLF SETS LISTING MODES. THE ONLY DIFFERENCE IS
; IN COPYING THE RESULTING BIT VALUES INTO RMODE.
SETEN: MOVS R0,ENWORD ; GET OVERRIDE OPTION BITS.
HLRZ R1,ENACTL ; LOAD OPTIONS SET IN SOURCE.
ANDCAM R0,R1 ; CLEAR OVERRIDDEN BITS.
AND R0,ENWORD ; R0 = BITS TO FORCE ON.
IOR R1,R0 ; ... FORCE THEM.
HRRM R1,ENACTL ; STORE RESULT.
TLZ RMODE,ENMASK ; CLEAR ALL ENABL BITS IN RMODE.
TLO RMODE,0(R1) ; SET THOSE WHICH ARE STILL ON.
RETURN
ENATBL: XWD -14,.+1 ; .ENABL/.DSABL ARGUMENTS
ARG A,B,S,ABSFLG
ARG A,M,A,AMAFLG
ARG C,D,R,CDRFLG
ARG F,P,T,FPTFLG
ARG G,B,L,GBLFLG
ARG H,O,V,HOVFLG
ARG I,S,D,ISDFLG
ARG L,C, ,LCFLG
ARG L,S,B,LSBFLG
ARG N,S,F,NSFFLG
ARG P,N,C,PNCFLG
ARG R,E,G,REGFLG
; ************ .ERROR AND .PRINT *************
.ERROR: TRO RERR,ERRP ; FLAG LINE WITH "P" (!)
.PRINT: TLNE RMODE,P1F ; IGNORE .ERROR & .PRINT
RETURN ; ON PASS 1
TLO R16,LBLBIT!PF1BIT!ERRBIT ; PRINT LOC & EXPR VALUE
MOVEM RLOC,PF0 ; ON BOTH TTY & LISTING
; LIST EXPRESSION VALUE, IF ONE EXISTS
CALL EXPR ; EVALUATE EXPRESSION, IF ANY.
CAIA ; NO EXPRESSION - LEAVE PF1=0
MOVEM R10,PF1 ; STORE EXPR VALUE IN PRINT FIELD 1
RETURN ; LET ENDL DO THE REST.
.BYTE: ;"BYT" PSEUDO-OP
PUSH R17,R5 ;STACK PC
.BYTE1: CALL EXPRF ;EVALUATE EXPRESSION
JFCL ; ACCEPT NULLS
TRCN R10,177400 ;OVERFLOW?
JRST .+3 ; NO.
;HIGH BITS ARE NOW COMPLEMENTED.
TRZE R10,177400 ;MASK TO 8 BITS.
;ANY OVERFLOW
TRO R15,ERRT ;YES, FLAG IT
CALL TSTAR
LDB R2,MODPNT ;GET CLASS
CAIE R2,RLDT1
CAIN R2,RLDT15 ;IF RELOCATABLE,
TRO R15,ERRA ; ERROR
TLC R1,BC1!BC2 ;RESET TO ONE BYTE
CALL STCODE
CAIE R14,"," ;ANY MORE
JRST .WORDX ; NO, EXIT
CALL GETNB ;BYPASS COMMA
AOJA R5,.BYTE1 ;INCREMENT PC AND LOOP
.WORD: ;"WORD" PSEUDO-OP
CALL TSTEVN
PUSH R17,R5 ;STACK PC
.WORD1: CALL EXPRF ;EVALUATE EXPRESSION
JFCL ; ACCEPT NULLS
CALL TSTAR
CALL STCODE
CAIE R14,"," ;END OF STRING?
JRST .WORDX ; YES, EXIT
CALL GETNB ;BYPASS COMMA
ADDI R5,2 ;INCREMENT PC
JRST .WORD1 ;GO FOR MORE
.WORDX: POP R17,R5 ;RESTORE ORIGINAL PC
RETURN
.BLKW: TDZA R3,R3 ; "BLKW" PSEUDO-OP - R3 = 0
.BLKB: ;"BLKB" PSEUDO-OP
HRLZI R3,DEFSYM ; R3 = DEFSYM
PUSH RLINK,R3 ; SAVE WORD/BYTE FLAG (R3)
CALL EXPR ;EVALUATE EXPRESSION
TRO R10,1 ;DEFAULT NULL EXPR TO 1
CALL ABSTST ;TEST IF ABSOLUTE EXPRESSION
POP RLINK,R3 ; RESTORE WORD/BYTE FLAG
TLO R16,LBLBIT!PF1BIT ; FORCE LOC & EXPR TO PRINT
MOVEM RLOC,PF0 ; STORE LOC TO PRINT
MOVEM R10,PF1 ; STORE EXPR TO PRINT
TLON R3,DEFSYM ; CHECK IF THIS IS .BLKW
LSH R10,1 ; YES, MULT 2*EXPR
ORM R3,PF1 ; MAKE SURE ZERO PRINTS
ADD R5,R10 ; INCREMENT PC AS CALCULATED
MOVE R1,R5 ; GET PC
HRLI R1,(<RLDT10>B<MODOFF>) ; FLAG AS CLASS 10
JRST STCODE ; STOW CODE & EXIT
.ROUND: TLZA R15,FPTFLG ;CLEAR TRUNCATION FLAG
.TRUNC: TLO R15,FPTFLG ;SET TRUNCATION FLAG
RETURN
.FLT2: SKIPA R3,[2] ;TWO WORD FLOATING
.FLT4: MOVEI R3,4 ;FOUR WORD FLOATING
MOVEM R3,FLTLEN ;SET LENGTH FOR ROUNDING
.FLTC: CALL FLTG ;PROCESS FLOATING POINT
TLNE R15,FLTFLG ;ANY ERRORS?
TRO R15,ERRA ; YES
MOVN R6,FLTLEN ;SET NEGATIVE OF LENGTH
HRLZS R6 ;SET INDEX
.FLTC1: MOVE R1,FLTNUM(R6) ;GET A VALUE
HRLI R1,BC2
CALL STCODE ;STORE IT
AOBJN R6,.FLTC1 ;LOOP IF MORE
CAIE R14,"," ;MULTIPLE?
JRST .FLTC2 ; NO
CALL GETNB ;YES, MOVE PAST COMMA
JRST .FLTC ;GET ANOTHER
.FLTC2: HRROI R3,774000
MOVE R6,FLTLEN
CAIN R6,2 ;TWO WORD?
ANDM R3,FLTLST ; YES, TRUNCATE
MOVE R1,[POINT 7,FLTBUF] ;SET POINTER TO BUFFER
MOVEI R2,";"
IDPB R2,R1 ;STORE ";"
MOVEI R2,"("
IDPB R2,R1 ; AND "("
LDB R0,[POINT 9,FLTNUM,35-16+9]
MOVEI R2,"0"
TRZE R0,400 ;SIGN BIT?
MOVEI R2,"1" ; YES
IDPB R2,R1
MOVEI R2,SPACE
IDPB R2,R1
MOVSI R3,(POINT 3,R0,35-9)
.FLTC3: ILDB R2,R3 ;STORE EXPONENT
ADDI R2,"0"
IDPB R2,R1
TLNE R3,770000
JRST .FLTC3
MOVEI R2,SPACE
IDPB R2,R1
MOVE R3,[POINT 3,FLTLST] ;GET SET TO LIST FRACTION
MOVEI R0,↑D9 ;ASSUME DOPBLE WORD
CAIE R6,2
MOVEI R0,↑D19
.FLTC4: ILDB R2,R3
ADDI R2,"0"
IDPB R2,R1
SOJG R0,.FLTC4 ;LOOP IF NOT END
MOVEI R2,")" ;STORE END CHARACTERS
IDPB R2,R1
MOVEI R2,CRR
IDPB R2,R1
MOVEI R2,LF
IDPB R2,R1
IDPB R0,R1 ;STORE NULL
RETURN
FLTG:
TLZ R15,FLTFLG ;CLEAR ERROR FLAG
SETZB R0,FLTNUM
SETZB R1,FLTNUM+1
SETZB R2,FLTNUM+2
SETZB R3,FLTNUM+3
SETZM FLTLST ;CLEAR FOR EXPANDED LISTING
SETZM FLTLST+1
CAIN R14,"-"
TLO R0,(1B0)
EXCH R0,FLTNUM
SKIPL FLTNUM
CAIN R14,"+"
FLTG2: CALL GETCHR
CAIL R14,"0"
CAILE R14,"9"
JRST FLTG3
TLNE R0,760000
AOJA R3,FLTG2
ASHC R0,1
MOVEM R0,FLTTMP
MOVEM R1,FLTTMP+1
ASHC R0,2
ADD R0,FLTTMP
ADD R1,FLTTMP+1
ADDI R1,-"0"(R14)
TLZE R1,(1B0)
ADDI R0,1
AOBJP R3,FLTG2
FLTG3: CAIE R14,"."
JRST FLTG4
TRNE R2,400000
TLO R15,FLTFLG
MOVEI R2,400000(R3)
JRST FLTG2
FLTG4: CAIN R3,
TLO R15,FLTFLG
TRZN R2,400000
HRRZ R2,R3
HLRZS R3
SUB R2,R3
CAIE R14,"E"
JRST FLTG6
CALL GETCHR
PUSH R17,R0
PUSH R17,R1
SETZB R0,R1
CAIN R14,"-"
SOSA R1
CAIN R14,"+"
FLTG5: CALL GETCHR
CAIL R14,"0"
CAILE R14,"9"
JRST FLTG5A
IMULI R0,↑D10
ADDI R0,-"0"(R14)
JRST FLTG5
FLTG5A: CAIE R1,
MOVNS R0
ADD R2,R0
POP R17,R1
POP R17,R0
FLTG6: CAIN R1,0
JUMPE R0,FLTG12
TDZA R3,R3
FLTG7: ASHC R0,1
TLNN R0,200000
SOJA R3,FLTG7
JUMPL R2,FLTG9
FLTG8: SOJL R2,FLTG10
MOVEM R0,FLTTMP
MOVEM R1,FLTTMP+1
ASHC R0,-2
ADD R0,FLTTMP
ADD R1,FLTTMP+1
TLZE R1,(1B0)
ADDI R0,1
TLNE R0,(1B0)
CALL FLTG20
ADDI R3,3
JRST FLTG8
FLTG9: CAML R0,[↑D10B4]
CALL FLTG20
PUSH R17,R1+1
DIV R0,[↑D10B4]
DIV R1,[↑D10B4]
POP R17,R1+1
SUBI R3,4
AOJL R2,FLTG9
FLTG10: PUSH R17,R3 ;STACK EXPONENT
MOVSI R2,(1B<16-7>) ;SET ONE WORD ROUNDING BIT
SETZ R3, ;CLEAR LOW ORDER
SKIPA R4,FLTLEN ;GET LENGTH AND SKIP
ASHC R2,-↑D16 ;MOVE ROUNDING MASK
SOJG R4,.-1
TDNN R0,R2 ;TEST FOR ROUNDING REQUIRED
TDNE R1,R3
TLNE R15,FPTFLG ;YES, "ROUND" MODE?
JRST FLTG11 ;NO, FORGET ROUNDING
ASHC R2,1 ;SHIFT BIT UP ONE
ADD R0,R2
ADD R1,R3 ;ADD IN BIT
FLTG11: POP R17,R3 ;RESTORE EXPONENT
TLZE R1,(1B0) ;OVERFLOW, LOW ORDER?
ADDI R0,1 ; YES, ADD TO UPPER
TLNE R0,(1B0) ;OVERFLOW, HIGH ORDER?
CALL FLTG20 ; YES, CORRECT
LSH R1,1 ;MOVE OVER SIGN BIT
MOVEM R0,FLTLST ;STORE FOR EXPANDED LISTING
MOVEM R1,FLTLST+1
LSHC R0,-7 ;MAKE ROOM FOR EXPONENT
ADDI R3,↑D<35+35+128>
DPB R3,[POINT 8,R0,8]
LDB R2,[POINT 8,R0,8]
CAME R2,R3 ;OVER/UNDER FLOW?
TRO R15,ERRT ; YES
FLTG12: IOR R0,FLTNUM
MOVSI R2,-4
FLTG13: LDB R3,[POINT 16,R0,15]
MOVEM R3,FLTNUM(R2)
LSHC R0,↑D16
AOBJN R2,FLTG13
JRST SETNB
FLTG20: LSH R1,1
LSHC R0,-1
LSH R1,-1
AOJA R3,CPOPJ
SUBTTL ASSEMBLER DIRECTIVE ARGUMENT INTERPRETER
; SUBROUTINE ARGSET PARSES THE REMAINING INPUT ON THE LINE,
; CHECKING FOR ARGUMENTS SPECIFIED IN A TABLE SUPPLIED BY
; THE CALLER. WHEN IT FINDS ONE, IT EXECUTES AN INSTRUCTION
; SUPPLIED BY THE CALLER WITH A VALUE FROM THE TABLE IN R2.
; INPUT TO ARGSET:
; R0 HIGH ORDER HALFWORD = ADDRESS OF INSTRUCTION TO EXECUTE
; WHEN A PROPER ARG IS FOUND
; R0 LOW ORDER HALFWORD = ADDRESS OF ARGUMENT TABLE
; CALL IS VIA "PUSHJ RLINK,ARGSET"
; RETURNS:
; 0(RLINK) -- NO ARGUMENTS FOUND
; 1(RLINK) -- ONE OR MORE ARGUMENTS WERE FOUND
; IF AN INVALID ARGUMENT APPEARS IN THE SOURCE LINE
; ARGSET SETS "ERRQ" TO GENERATE A Q FLAG.
; FORMAT OF ARG TABLE:
; WORD 0: XWD -(# OF ENTRIES IN TABLE),.+1
; WORDS 1-N : VALUE,ARGCODE
;
; VALUE IS ANY VALUE DESIRED (LIKELY A BIT MASK)
; TO BE LOADED IN R2 WHEN THE ARG IS FOUND
; & THE CALLER'S INSTRUCTION IS EXECUTED.
; ARGCODE IS THE ARGUMENT IN MOD40 FORMAT
ARGSET: PUSH RLINK,R0 ; SAVE CALLER'S PARMS
CALL GETSYM ; DECODE NEXT SYMBOL
CAIA ; - SKIP IF NONE
JRST ARSER ; EXIT TO SEARCH TABLE
POP RLINK,R0 ;**** NO ARGUMENT -- POP STACK
RETURN ; & RETURN TO CALLER
; *** SCAN FOR NEXT ARGUMENT ***
ARNEX: IBP RBPTR ; SKIP ","
CALL GETSYM ; TRY FOR ANOTHER SYMBOL
JRST AREXIT ; NONE -- QUIT HERE
; SEARCH ARGUMENT TABLE FOR THE SYMBOL JUST FOUND
ARSER: TRZE R0, ; IS SYMBOL LONGER THAN 3 CHARS?
JRST ARBAD ; YES -- INVALID ARGUMENT
MOVSS R0, ; NO -- MOVE SYM TO RIGHT HALF
HRRZ R1,0(RLINK) ; LOAD TABLE LOC, THEN
MOVE R1,0(R1) ; LOOP CONTROL WORD INTO R1
ARSERL: MOVE R3,0(R1) ; LOAD ARG VALUE FROM TABLE
CAIN R0,(R3) ; DOES OPERAND MATCH?
JRST ARFOUN ; YES
AOBJN R1,ARSERL ; NO - KEEP SEARCHING
ARBAD: TRO RERR,ERRQ ; INVALID ARG -- SET Q FLAG
JRST AREXIT ; & QUIT
ARFOUN: HLRZ R2,R3 ; FOUND ARG -- LOAD VALUE
HLRZ R1,0(RLINK) ; FROM TABLE & EXECUTE
XCT 0(R1) ; CALLER'S INSTRUCTION
LDB R0,RBPTR ; CHECK NEXT SOURCE BYTE
CAIN R0,"," ; TEST FOR ","
JRST ARNEX ; "," => GET ANOTHER ARG
AREXIT: POP RLINK,R0 ; RETURN AFTER FINDING AN ARG
JRST CPOPJ1
SUBTTL REPEAT HANDLER
REPEA0: ;"REPEAT" PSEUDO-OP
CALL MDLTST ; TEST MD LISTING MODE
CALL ABSEXP ;EVALUATE EXPRESSION
TRNE R15,ERRU ;ANY UNDEFINED ERRORS?
TRO R15,ERRP1 ; YES, MENTION ON PASS 1
LSH R10,+↑D<36-16> ;ADJUST SIGN TO 36 BITS
ASH R10,-↑D<36-16>
CAIN R10,1 ;IF SINGLE,
JRST BEGR0 ; PROCESS IN LINE
PUSH R17,R10 ;STACK EXPRESSION
CALL ENDLR ;LIST LINE
CALL GETBLK ;MULTIPLE, SDT FOR STORAGE
PUSH R17,MWPNTR ;SAVE STARTING BLOCK ADDRESS
MOVEI R11,3
ADDM R11,MWPNTR ;POINT PAST POINTER STORAGE
SETZ R7, ;ZERO LEVEL COUNT
REPEA1: CALL GETMLI ;GET THE NEXT SOURCE LINE
JRST REPEA3 ; END OF FILE
CAMN R0,.REPTX
AOJA R7,REPEA2 ; INCREMENT AND BRANCH
CAME R0,.ENDMX ; CHECK FOR EITHER .ENDM OR .ENDR
CAMN R0,.ENDRX
SOJL R7,REPEA3 ; DECREMENT AND BRANCH IF END
REPEA2: TLO R16,FOLBIT ; DON'T FOLD LC TO UC IN DEFINITION.
SKIPA RBPTR,LINPNT ; POINT TO START OF LINE.
CALL WCIMT ;WRITE CHAR IN MACRO TREE
CALL GETCHR ;GET THE NEXT CHARACTER
JUMPN R14,.-2 ;TEST FOR CR
CALL ENDLR ;LIST THE LINE
TLNN R15,ENDFLG ;SKIP IF EOF SEEN
JRST REPEA1 ;TRY THE NEXT LINE
REPEA3: MOVEI R14,QUEREP ;END, SET TO CLOSE
CALL WTIMT ;WRITE FLAG AND "REPEAT END"
POP R17,R11 ;RETRIEVE STARTING POINTER
MOVEI R10,-1(R11) ;SET FOR PUSH
PUSH R10,R12 ;STORE READ POINTER
PUSH R10,REPPNT ; REPEAT POINTER
PUSH R10,REPEXP ; AND REPEAT EXPRESSION
MOVEM R11,REPPNT ;SET NEW REPEAT POINTER
POP R17,REPEXP ; AND REPEAT COUNT
; JRST REPEND
REPEND: ;REPEAT END
MOVE R12,REPPNT ;ASSUME ANOTHER ITERATION
ADDI R12,3 ;POINT PAST POINTERS
SOSL REPEXP ;END?
RETURN ; NO
MOVE R1,REPPNT ; YES, GET SET TO CLEAN UP
HRROI R10,2(R1) ;POINT TO TOP POINTER
POP R10,REPEXP ;REPLACE STORED ITEMS
POP R10,REPPNT
POP R10,R12
CALL REMMAC ;GARBAGE COLLECT
RETURN ;EXIT
; REPEATS CAN BE ENDED BY EITHER A .ENDM OR A .ENDR;
; .ENDM'S WHICH END A MACRO ARE PROCESSED ONLY BY
; THE MACRO DEFINITION PROCESSOR -- WHEN THE STATEMENT
; PROCESSOR FINDS A .ENDM, AND DISPATCHES TO LOCATION
; .ENDM, IT MUST BE THE END OF A REPEAT.
.ENDM:
ENDR0: ; ".ENDR" PSEUDO-OP
SKIPG REPLVL ;IN REPEAT?
JRST OPCERR ; NO, ERROR
SOSA REPLVL ;YES, DECREMENT LEVEL COUNT
BEGR0: AOS REPLVL ;REPEAT ONCE
RETURN
SUBTTL REPEAT/CONDITIONAL ROUTINES
.IFNDF: TDZA R2,R2
.IFDF: SETO R2, ;SET TRUE
SETOB R3,R4 ;SET RESULT AND CHAR TRUE (&)
.IFDF1: PUSH R17,R4 ;STACK CURRENT RESULTS
PUSH R17,R3
PUSH R17,R2
CALL GETSYM ;GET THE NEXT SYMBOL
TROA R15,ERRA ; NOT THERE, ERROR AND SKIP
CALL SSRCH ;SEARCH THE SYMBOL TABLE
SETZ R1, ; NOT THERE OR GETSYM ERROR
CAIE R0, ;DON'T CREF NULL
CALL CRFREF
TLNE R1,MDFSYM
TRO R15,ERRD ;FLAG IF MULTI-DEFINED SYM
TLNN R1,DEFSYM ;FLAGGED AS DEFINED?
TDZA R1,R1 ; NO, CLEAR TO ZERO
SETO R1, ; YES, SET TRUE
POP R17,R2 ;RETRIEVE REGISTERS
POP R17,R3
POP R17,R4
XCT [EXP <AND R3,R1>, <IOR R3,R1>]+1(R4)
MOVE R4,R2 ;ANTICIPATE END
EQV R4,R3
HRLI R4,1 ;MARK PNZ
CAIN R14,"&" ;TEST FOR OPS
MOVE R4,R2
CAIN R14,"!"
SETCM R4,R2
JUMPG R4,@[EXP BEGC0, FALSE]+1(R4)
CALL GETNB ;FOUND OP, BYPASS IT
JRST .IFDF1 ;LOOP
JMPER:
MOVE R1,CONDX+1(R3)
JRST 0(R1)
.IIF: TLO R16,IIFBIT ; MARK .IIF ENTRY TO CONDITIONAL STUFF
.IF:
CALL GETSYM ;GET CONDITION
TROA R15,ERRA ;NO CONDITION
CAIN RBYTE,"," ; WAS DELIMITER A COMMA?
CALL GETNB ; YES - SKIP IT.
MOVSI R3,-<CONDY-CONDX> ;SET FOR SCAN
TRNN R3,1 ;IGNORE ODD LOCATIONS
CAME R0,CONDX(R3) ;MATCH
AOBJN R3,.-2 ;NO
CAIG R3,
JRST JMPER
TROA R15,ERRA ;CONDITION DIDN'T MATCH
RETURN
.IFB: ;IF BLANK CONDITIONAL
SKIPG MACLVL ;IN MACRO EXPANSION
JRST OPCERR ;NO!
CALL MACARG ; PARSE THE ARGUMENT.
SKIPN ARGLEN ; FIELD WAS BLANK IF PARSED LENGTH = 0.
JRST BEGC0 ;IT WAS BLANK
JRST FALSE ;NOT BLANK
.IFNB:
SKIPG MACLVL ;IN MACRO EXPANSION
JRST OPCERR ;NO!
CALL MACARG ; GET THE ARGUMENT.
SKIPN ARGLEN ; IS ITS LENGTH 0?
JRST FALSE ;ARG WAS BLANK
JRST BEGC0
.IFT: ;GENERATING CODE UNDER .IFTF OR .IFF
SKIPG CONLVL ;EXPANDING A MACRO
JRST OPCERR
MOVE R1,.IFFLG
TRNN R1,TRUE ;SKIP IF TRUE
JRST .IFIF ;LAST CONDITION WAS FALSE
JRST BEGC01 ;LAST CONDITION WAS TRUE
.IFTF: ;GENERATING CODE UNDER .IFT,.IFF
SKIPG CONLVL ;EXPANDING A MACRO
JRST OPCERR ;NO
RETURN ;CODE GOES
.IFF: ;GENERATING CODE UNDER .IFTF, .IFT
SKIPG CONLVL ;EXPANDING MACRO
JRST OPCERR ;NO
MOVE R1,.IFFLG ; RELOAD LAST CONDITION WORD
TRNN R1,TRUE ;TEST LAST CONDITION RESULT
RETURN ;LAST CONDITION FALSE
JRST .IFIF ;LAST CONDITION WAS TRUE
FALSE: ;GET HERE WHEN OUTER LEVEL
;IS FALSE
TLZE R16,IIFBIT ; IS THIS A .IIF DIRECTIVE?
JRST GETEOL ; YES - JUST FLUSH THE LINE.
AOS CONLVL ;COULD GET OUT ON .IFF THEN .ENDC
MOVE R1,.IFFLG
LSH R1,1 ;SHIFT IN 0
MOVEM R1,.IFFLG ;MEANS FALSE
.IFIF: ;USED DURING 0 LEVEL OF NO CODE
;GENERATION
CALL CNLTST ;TEST FOR .NLIST
CALL ENDLR ;LIST THE LINE
CALL GETMLI ;GET NEXT LINE
RETURN ;EOF SEEN
MOVSI R3,-<.IFY-.IFX> ;SET FOR SCAN
TRNN R3,1 ;IGNORE IF ODD LOCATION
CAME R0,.IFX(R3)
AOBJN R3,.-2
CAIG R3, ;GREATER IF NO MATCH
JRST TESTIF ;IT'S AN IF
CAMN R0,.ENDCX ;NOT IF, IS IT ENDC
JRST ENDC0 ;YES IT WAS .ENDC
CALL TSTNT ;TERMINATOR
JRST .IFIF ;YES
CALL GETNT ;NO, GET ONE
JRST .IFIF ;GOT IT
JRST .-2
FAL: ;PREVIOUS CONDITION WAS FALSE
CAMN R0,.IFFX ;.IFF WHEN IN FALSE
JRST BEGC01 ;YES -- GO GENERATE CODE
CAMN R0,.IFTX
JRST .IFIF
JRST ..NOGO ;NO -- RETURN
TRU: ;LAST CONDITION WAS TRUE
CAMN R0,.IFTX ;.IFT WHEN IN TRUE
JRST BEGC01 ;YES,GENERATE CODE
CAMN R0,.IFFX
JRST .IFIF
JRST ..NOGO
TESTIF: ;UNDER FALSE, FOUND .IFF, .IFT,
;OR .IFTF, .IF CONDITION
CAMN R0,.IFTFX ;.IFTF
JRST BEGC01 ;YES
MOVE R1,.IFFLG
TRNN R1,TRUE ;ARE WE IN A TRUE CONDITION
JRST FAL
JRST TRU ;IN TRUE
..NOGO: AOS UNSLVL ;LEVEL COUNTER
CALL UNSCO2 ;FIND .ENDC
RETURN ;EOF SEEN
JRST .IFIF ;RETURN AFTER .ENDC MATCHING
IFZ0: JSP R3,IF0
CAIE R10,
IFNZ0: JSP R3,IF0
CAIN R10,
IFG0: JSP R3,IF0
CAIG R10,
IFGE0: JSP R3,IF0
CAIGE R10,
IFL0: JSP R3,IF0
CAIL R10,
IFLE0: JSP R3,IF0
CAILE R10,
IF0: PUSH R17,0(R3) ;STACK INSTRUCTION
CALL ABSEXP ;VALUATE EXPRESSION
LSH R10,+↑D<36-16> ;ADJUST SIGN
ASH R10,-↑D<36-16>
POP R17,R3 ;RETRIEVE INSTRUCTION
XCT R3 ;EXECUTE IT
JRST FALSE ; DIDN'T MAKE IT
JRST BEGC0 ;SATISFIED
.IFDIF: ; .IF DIF -- ARE ARGS DIFFERENT?
CALL IDNDIF ; COMPARE 2 STRINGS.
JRST BEGC0 ; .. DIFFERENT
JRST FALSE ; .. IDENTICAL
.IFIDN: ; .IF IDN -- ARE ARGS IDENTICAL?
CALL IDNDIF ; COMPARE 2 STRINGS.
JRST FALSE ; .. DIFFERENT
JRST BEGC0 ; .. IDENTICAL
IDNDIF: CALL MACARG ; GET A MACRO-TYPE ARGUMENT.
MOVE R3,[XWD ARGLEN,SECLEN] ; COPY IT TO A SAFE PLACE.
MOVE R1,ARGLEN ; MOVE (# BYTES)/4 + 2 WORDS.
LSH R1,-2
BLT R3,SECSTR+1(R1)
CAIN RBYTE,"," ; WAS ARGUMENT DELIMITER A COMMA?
CALL GETNB ; YES - SKIP IT.
CALL MACARG ; GET ANOTHER ARGUMENT.
MOVE R0,ARGLEN ; DOES LENGTH OF EACH ARG MATCH?
CAME R0,SECLEN
RETURN ; .. NO - RETURN +1.
MOVE R3,[POINT 7,ARGSTR] ; PREPARE TO COMPARE.
MOVE R4,[POINT 7,SECSTR]
IDNCMP: ILDB R1,R3 ; LOAD NEXT BYTE OF PRIMARY AND
ILDB R2,R4 ; SECONDARY STRINGS.
JUMPE R1,CPOPJ1 ; ** END OF STRING - RETURN +2
CAMN R1,R2 ; DO BYTES MATCH?
JRST IDNCMP ; YES - KEEP COMPARING.
RETURN ; NO -- RETURN +1.
UNSCON: SETZM UNSLVL ;CREAR LEVEL COUNT
UNSCO1: CALL CNLTST ; TEST FOR .NLIST CND
CALL ENDLR ;LIST THE LINE
CALL GETMLI ;GET THE NEXT LINE
RETURN ;EOF SEEN
MOVSI R3,-<.IFY-.IFX> ;SET FOR SCAN
TRNN R3,1 ;IGNORE IF ODD LOCATION
CAME R0,.IFX(R3) ;SKIP IF MATCH
AOBJN R3,.-2 ;LOOP IF NOT END
CAIGE R3, ;END, SKIP IF NO MATCH
JRST CHKADDR ;DON'T INCR FOR .IFF,ETC
CAMN R0,.ENDCX ;"ENDC"?
SOSLE UNSLVL ; YES, SKIP IF NOT NESTED
JRST UNSCO2 ; TRY FOR MORE.
JRST CPOPJ1 ;GOOD, RETURN+1
UNSCO2: CALL TSTNT ;TEST FOR TERMINATION
JRST UNSCO1 ; YES
CALL GETNT ;NO, GET ONE
JRST UNSCO1
JRST .-2
CHKADD: CAMN R0,.IFFX ;.IFF
JRST UNSCO2 ;YES, DON'T LOOK FOR .ENDC
CAMN R0,.IFTX ;.IFT
JRST UNSCO2 ;YES, DON'T LOOK FOR .ENDC
CAMN R0,.IFTFX ;.IFTF
JRST UNSCO2 ;YES, DON'T LOOK FOR .ENDC
AOS UNSLVL ;IT WAS .IF COND, LOOK FOR .ENDC
JRST UNSCO2
ENDC0: ; ".ENDC"
SKIPG CONLVL ;ARE WE IN A CONDITIONAL?
JRST OPCERR ; NO, ERROR
MOVE R1,.IFFLG
LSH R1,-1
MOVEM R1,.IFFLG
SOS CONLVL ;YES, DECREMENT LEVEL
JRST BEGC01
BEGC0: TLZE R16,IIFBIT ; IS THIS AN IMMEDIATE IF?
JRST IMII ; YES -- EXPAND REST OF LINE.
AOS CONLVL ;INCREMENT LEVEL
MOVE R1,.IFFLG
LSH R1,1
TRO R1,TRUE
MOVEM R1,.IFFLG
BEGC01: CALL CNLTST ; TEST FOR .NLIST CND
RETURN
IMII: CALL SETNB ; SUCCESSFUL IMMEDIATE IF . . .
CAIN RBYTE,"," ; WAS DELIMITER A COMMA?
CALL GETNB ; YES -- SKIP IT.
JRST STMNT ; ASSEMBLE REST OF LINE.
GETMLI: ;GET MACRO-TYPE LINE
CALL GETLIN ; GET A BASIC LINE
CALL MDLTST ; TEST MD LISTING MODE
GETML1: CALL GETSYM ;TRY FOR A SYMBOL
JRST GETML2 ; NO
CAIE R14,":" ;LABEL?
JRST GETML2 ; NO
CALL GETNB ;YES, GET ANOTHER
JRST GETML1
GETML2: TLNE R15,ENDFLG ;EOF SEEN?
RETURN ; YES, BAD EXIT
JRST CPOPJ1 ;GOOD EXIT
; SUBROUTINE MDLTST CHECKS THE MACRO DEFINITION LISTING
; CONTROL FLAG; IF IT ISN'T SET, .NLIST MD MUST BE
; IN EFFECT: SET NLISLN FLAG TO SUPPRESS LISTING
; OF THIS LINE.
MDLTST: PUSH R17,R0 ;SAVE FOR .IF'S
MOVE R0,LSTCTL ;LOAD LISTING CONTROL FLAGS
TRNN R0,LMD ; MD TO BE LISTED?
TLO R16,NLISLN ; NO - SUPPRESS LINE ON LISTING
POP R17,R0 ;FOR .IF'S
RETURN
; SUBROUTINE CNLTST CHECKS THE LISTING CONTROL FLAG
; WHICH GOVERNS LISTING OF UNEXPANDED CONDITIONAL
; CODE AND ALL .IF'S & .ENDC'S. THIS FLAG IS 0 IF
; .NLIST CND IS IN EFFECT; IF THIS IS THE CASE,
; CNLTST SETS THE NLISLN FLAG TO SUPPRESS
; LISTING OF THE CURRENT LINE.
CNLTST: PUSH R17,R0
MOVE R0,LSTCTL ;LOAD LISTING CONTROL FLAGS.
TRNN LCND ; .NLIST CND IN EFFECT?
TLO R16,NLISLN ; YES - SUPPRESS LINE LISTING
POP R17,R0
RETURN
SUBTTL MACRO-RELATED ASSEMBLER DIRECTIVES
.NARG: ; ==== .NARG ====
SKIPG MACLVL ; IS A MACRO EXPANDING?
JRST OPCERR ; NO -- ISSUE AN 'O' FLAG.
CALL GETSYM ; GET SYMBOL TO BE SET.
JRST QERR ; -- DISGUSTING SYNTAX IF NONE.
PUSH RLINK,R0 ; STACK THE SYMBOL FOR LATER USE.
MOVE R3,CALPNT ; LOCATE CURRENT CALL BLOCK.
HLRZ R10,3(R3) ; LOAD THE ARG COUNT.
JRST SYMDEF ; EQUATE SYMBOL TO ARG COUNT.
.NCHR: ; ====== .NCHR ======
CALL GETSYM ; GET SYMBOL TO ASSIGN A VALUE TO.
JRST QERR ; -- THERE'S GOTTA BE ONE!
PUSH RLINK,R0 ; SAVE ITS NAME FOR SYMDEF.
CALL SETNB ; IS DELIMITER A COMMA?
CAIN RBYTE,","
CALL GETNB ; YES - SKIP IT.
CALL MACARG ; GET A MACRO-TYPE ARGUMENT.
MOVE R10,ARGLEN ; LOAD LENGTH (# OF CHARACTERS)
JRST SYMDEF ; & ASSIGN IT TO THE SYMBOL.
.NTYPE: ; ===== .NTYPE =====
SKIPG MACLVL ; IS A MACRO EXPANDING?
TLNE RMODE,NSFFLG ; NO -- CHECK FOR NONSTANDARD FEATURES
CAIA ; YES - SKIP ERROR
JRST OPCERR ; NO - ISSUE AN 'O' FLAG.
CALL GETSYM ; GET SYMBOL TO BE SET
JRST QERR ; -- SYNTAX ERROR IF NONE.
PUSH RLINK,R0 ; STACK THE SYMBOL FOR SYMDEF.
CALL SETNB ; IS SYMBOL DELIMITER A COMMA?
CAIN RBYTE,","
CALL GETNB ; YES -- SKIP IT.
SETZM OFFSET ; CLEAR AEXT INDEX FOR AEXP.
CALL AEXP ; EVALUATE AN ADDRESS EXPRESSION.
MOVE R10,R0 ; LOAD ADDRESS MODE VALUE (6 BITS)
JRST SYMDEF ; & ASSIGN IT TO SYMBOL.
SUBTTL MACRO HANDLERS
; ... MACRO STORAGE BLOCK FORMATS ...
; CALL BLOCK
; 0 -- SAVED INPUT POINTER (FROM R12)
; 1 -- SAVED MACRO CALL POINTER (CALPNT)
; 2 -- BYTE POINTER TO MACRO PROTOTYPE
; 3LH -- ARGUMENT COUNT (# ARGS ACTUALLY SUPPLIED)
; 3RH -- LAST CHARACTER READ
; 4 -- ?????
; 5 & FOLLOWING ... ARGUMENT LIST AS AN ASCII STRING
; MACRO PROTOTYPE TEXT
; 0 -- REFERENCE COUNT
; 1 -- NUMBER OF DUMMY ARGUMENTS
; 2 -- BIT MASK INDICATING WHICH ARGS WERE PRECEDED BY "?"
; 3 & FOLLOWING ... PROTOTYPE TEXT AS AN ASCII STRING
; IRP ARGUMENT VALUE BLOCK
; 0 -- BYTE POINTER TO START OF ARGUMENT STRING
; 1 -- IRP TYPE FLAG: 0 FOR .IRP, 1 FOR .IRPC
; 2 & FOLLOWING ... ARGUMENTS AS A SINGLE ASCIZ STRING
; <<<<<<< .IRP & .IRPC >>>>>>>
; .... ADD A COMMENT BLOCK HERE ....
.IRP: TDZA R10,R10 ; FLAG .IRP INVOCATION.
.IRPC: MOVEI R10,1 ; FLAG .IRPC INVOCATION.
PUSH RLINK,R10 ; SAVE ENTRY FLAG ON STACK
CALL MDLTST ; TEST MACRO DEF LISTING MODE.
SETZM MACNAM ; ACT LIKE NAMELESS MACRO.
CALL GETSYM ; GET NAME OF THE ARGUMENT.
TRO RERR,ERRQ ; QUESTIONABLE SYNTAX IF NONE.
MOVEM R0,ARGLST ; SAVE ARG NAME.
CAIN RBYTE,"," ; IS ARG DELIM A COMMA?
CALL GETNB ; YES - SKIP IT.
; SAVE ARGUMENT STRING, THEN READ .IRP BLOCK DEFINITION.
CALL GETBLK ; GET SPACE FOR ARG BLOCK.
POP RLINK,R1 ; RETRIEVE IRP/IRPC FLAG.
PUSH RLINK,CALPNT ; SAVE CURRENT CALL BLOCK POINTER.
HRRZ R10,MWPNTR ; GET ADDR OF ARG BLOCK.
PUSH RLINK,R10 ; SAVE FOR LATER USE.
MOVEM R1,1(R10) ; STORE IRP/IRPC FLAG IN BLOCK.
MOVEI R0,2 ; SET INITIAL BYTE POINTER
ADD R0,MWPNTR ; FOR ARGUMENT TEXT.
MOVEM R0,MWPNTR
IBP R0
MOVEM R0,0(R10)
TLO R16,FOLBIT ; SUPPRESS CASE FOLDING.
CALL MACARG ; GET THE ARGUMENT FIELD.
MOVE R10,[POINT 7,ARGSTR] ; POINT TO IT.
; COPY ARGUMENT FIELD TO ARGUMENT VALUE BLOCK.
IRPA: ILDB RBYTE,R10 ; GET NEXT ARG BYTE.
IDPB RBYTE,MWPNTR ; WRITE IT IN ARG BLOCK.
JUMPN RBYTE,IRPA ; REPEAT TIL END OF ASCIZ STRING.
CALL DEFIRP ; DRAG IN THE IRP DEFINITION.
PUSH RLINK,R1 ; SAVE ITS ADDRESS ON STACK.
SETOM 0(R1) ; DELETE DEFINITION AFTER LAST CALL.
SETOM ARGDEL ; INIT ARG DELIMITER TO NON-0.
; -- CURRENT STACK CONTENTS:
; 0(RLINK) - ADDRESS OF DEFINITION BLOCK.
; -1(RLINK) - ADDRESS OF IRP ARGUMENT VALUE BLOCK.
; -2(RLINK) - CONTENTS OF CALPNT (POINTER TO CALL BLOCK
; OF A MACRO THAT INVOKED .IRP)
; GENERATE A CALL BLOCK FOR EACH ARGUMENT.
IRPNAR: HRRZ R1,-1(RLINK) ; LOCATE ARG BLOCK.
MOVE RBPTR,0(R1) ; POINT TO NEXT PROSE TO PARSE.
SKIPE 1(R1) ; WHICH BRAND OF IRP IS THIS?
JRST IRPCAR
; ; ///// .IRP /////
SKIPN ARGDEL ; WAS PREVIOUS ARG DELIM 0?
JRST IRPGO ; YES - IT WAS THE LAST.
HRRZ R1,0(RLINK) ; RETRIEVE DEFINITION ADDR.
CALL IRPAR ; LET CALL BLOCK GENERATOR
HRRZ R1,-1(RLINK) ; PARSE THE ARGUMENT.
MOVEM RBPTR,0(R1) ; STORE UPDATED ARG POINTER.
JRST IRPREQ ; REQUEUE CALL BLOCK JUST GEND.
; ; ///// .IRPC /////
IRPCAR: LDB RBYTE,RBPTR ; GET ARGUMENT BYTE.
JUMPE RBYTE,IRPGO ; QUIT IF IT'S THE ARG DELIMITER.
IBP RBPTR ; POINT TO NEXT BYTE.
LSH RBYTE,↑D29 ; CONVERT CURRENT BYTE TO
MOVEM RBYTE,ARGSTR ; ASCIZ STRING FORMAT & STORE.
MOVEM RBPTR,0(R1) ; SAVE UPDATED BYTE POINTER.
HRRZ R1,0(RLINK) ; LOAD ADDR OF DEFINITION BLOCK.
MOVE RBPTR,[POINT 7,ARGSTR,↑D6] ; POINT TO THE ARGUMENT.
CALL IRPCAL ; GENERATE CALL BLOCK.
; REQUEUE CALL BLOCK JUST GENERATED, UNLESS IT WAS FOR
; THE FIRST ARGUMENT. THE CALL BLOCK GENERATOR STACKS
; THEM, SO THE ORDER OF ARGUMENT SUBSTITUTION WOULD BE
; RIGHT TO LEFT WITHOUT THIS MANIPULATION.
IRPREQ: MOVE R0,-2(RLINK) ; LOCATE FIRST NON-IRP CALL BLOCK.
MOVE R1,CALPNT ; LOCATE BLOCK JUST GENERATED.
MOVE R2,1(R1) ; LOCATE ITS SUCCESSOR.
CAMN R0,R2 ; IS SUCCESSOR 1ST NON-IRP?
JRST IRPNAR ; YES - NO ACTION NEEDED
; (THIS WAS 1ST ARGUMENT)
MOVEM R2,CALPNT ; DEQUEUE THE NEW BLOCK.
MOVEM R0,1(R1) ; LINK IT TO 1ST NON-IRP.
; SCAN CALL BLOCK QUEUE FOR SPOT TO INSERT THE NEW ONE;
; IT SHOULD BE INSERTED BETWEEN IRP-GENERATED BLOCKS
; AND THE FIRST NON-IRP-GENERATED BLOCK.
CAIA ; DON'T MISS 1ST BLOCK.
IRPQSR: MOVE R2,1(R2) ; LOCATE NEXT BLOCK
CAME R0,1(R2) ; DOES IT POINT TO NON-IRP BLK?
JRST IRPQSR ; NO - KEEP SEARCHING.
MOVEM R1,1(R2) ; INSERT NEW BLOCK IN QUEUE.
MOVE R0,0(R1) ; SWAP SAVED INPUT POINTERS
MOVE R3,0(R2) ; IN NEW BLOCK & BLOCK JUST FOUND.
MOVEM R0,0(R2)
MOVEM R3,0(R1)
JRST IRPNAR ; GO BACK FOR NEXT ARG.
; ALL CALL BLOCKS READY ... START EXPANDING.
IRPGO: POP RLINK,R0 ; POP DEFINITION LOC OFF STACK
POP RLINK,R1 ; POP ARG BLOCK OFF.
POP RLINK, ; GET RID OF SAVED CALPNT.
JRST REMMAC ; DELETE ARG BLOCK & RETURN.
.MCALL: JRST GETEOL ; !!! TEMPORARY?!! !!
DEFIRP: ; ENTRY FROM .IRP TO MACRO DEFINITION
CALL GETBLK ; GET A BLOCK FOR DEFINITION.
PUSH RLINK,MWPNTR ; SAVE POINTER TO IT ON STACK.
MOVEI R1,3 ; SKIP TO TEXT STORAGE AREA.
ADDM R1,MWPNTR
MOVEI R7,1 ; INDICATE 1 ARGUMENT.
JRST DEF02 ; ENTER DEFINITION PROCESSING
; IN THE MIDDLE.
DEFIN0: ; .MACRO DIRECTIVE
CALL MDLTST ; ACT ON MD LISTING MODE
CALL GETSYM ;GET ITS NAME
JRST DEFERR ; ERROR, EXIT
MOVEM R0,MACNAM ; SAVE MACRO NAME IN NEST NAME TBL
CALL GETBLK ;OK, GET A BLOCK FROM STORAGE
CALL MSRCH ;SEE IF ALREADY DEFINED
MOVSI R1,MAOP ;NOT THERE, FLAG AS MACRO
TRNE R1,-1 ;PREVIUSLY DEFINED?
CALL DECMAC ; YES, DECREMENT REFERENCE
HRR R1,MWPNTR ;GET POINTER TO START OF BLOCK
CALL INSRT ;INSERT/DELETE IN SYMBOL TABLE
CALL CRFDEF
PUSH R17,MWPNTR ;STACK POINTER TO START OF BLOCK
MOVEI R1,3
ADDM R1,MWPNTR ;MOVE PAST REFERENCE LEVEL AND ARG COUNT
TDZ R7,R7 ; SET ARG COUNT = 0
SETZM MARMAS ; CLEAR PROTOTYPE ARGUMENT MASK.
CALL SETNB ; CHECK FOR "," AFTER MACRO NAME.
CAIN R14,"," ; IS IT ","?
DEF01: CALL GETNB ;MOVE PAST COMMA
CAIE RBYTE,"?" ; IS NEXT BYTE "?"?
JRST DEF01A ; NO -- THIS IS A MUNDANE ARGUMENT.
; YES - THIS ARG MAY REQUIRE AN
; AUTOMATICALLY GENNED SYMBOL.
MOVEI R0,1 ; SET A BIT IN THE ARG MASK CORRESPONDING
ROT R0,0(R7) ; TO THE RELATIVE POSITION OF THIS ARG.
IORM R0,MARMAS
CALL GETCHR ; SKIP THE "?".
DEF01A: CALL GETSYM ;GET AN ARG
JRST DEF02 ; NOT THERE
MOVEM R0,ARGLST(R7) ;STORE IN LIST
ADDI R7,1 ;BUMP POINTER
CAIN R14,"," ;ANY MORE?
JRST DEF01 ; YES
DEF02: PUSH R17,R7 ;STACK ARG COUNT
SETZM ARGLST(R7) ;MARK END
CALL ENDLR ;LIST THE LINE
SETZ R7, ;INIT LEVEL COUNT
; CODE FROM DEF03 TO DEF04 IS CONCERNED WITH
; KEEPING TRACK OF .MACRO/.ENDM PAIRS IN POTENTIALLY
; NESTED MACRO DEFINITIONS.
; WHEN A .MACRO DIRECTIVE IS FOUND, THE NESTING LEVEL
; IN R7 IS INCREMENTED, AND THE MACRO NAME IS RECORDED
; IN MACNAM(R7). R7 = 0 FOR THE OUTERMOST MACRO.
; .REPT, .IRP, AND .IRPC ARE TREATED AS NAMELESS MACRO
; DEFINITIONS (I.E., .MACRO WITHOUT AN OPERAND).
; WHEN A .ENDM IS FOUND THE ACTION DEPENDS ON ITS OPERAND.
; -- .ENDR IS TREATED AS A SYNONYM FOR .ENDM.
; NO OPERAND: THE NESTING LEVEL (R7) IS DECREMENTED.
; IF IT GOES NEGATIVE, THE OUTERMOST (I.E., CURRENT)
; MACRO DEFINITION IS TERMINATED.
; SYMBOLIC OPERAND: THE SYMBOL IS MATCHED WITH NAMES IN
; MACNAM. WHEN ONE MATCHES, THE NESTING LEVEL IS
; A) DECREMENTED (DEC'S WAY), OR
; B) SET TO THE OFFSET OF THE MACRO NAME IN MACNAM.
; THIS TERMINATES MACRO DEFINITIONS WITH HIGHER
; NESTING LEVELS WHICH ARE STILL OPEN.
; THE LATTER ACTION IS TAKEN ONLY IF NONSTANDARD
; FEATURES ARE ENABLED.
DEF03: CALL GETMLI ;GET THE NEXT LINE
JRST DEF13 ; EOF SEEN
CAME R0,.MACRY
CAMN R0,.MACRX
AOJA R7,DEF03B ;INCREMENT
CAME R0,.REPTX ; IS IT .REPT?
CAMN R0,.IRPOP ; .IRP?
AOJA R7,DEF03D ; YES - INCR CALL LEVEL
CAMN R0,.IRCOP ; IS IT .IRPC?
AOJA R7,DEF03D ; YES - LIKE .IRP (ETC)
CAME R0,.ENDMX
CAMN R0,.ENDRX ; IS OP .ENDR?
CAIA ; .ENDM OR .ENDR
JRST DEF04 ; NOT .MACRO OR .ENDM - SKIP
CALL GETSYM ; .ENDM -- GET ITS OPERAND, IF ANY
JRST DEF03A ; NO OPERAND -- JUST POP NEST LEVEL
; -- PROCESS A .ENDM SPECIFYING A SPECIFIC MACRO TO TERMINATE.
MOVE R1,R7 ; COPY NEST LEVEL TO SPARE REG
CAMN R0,MACNAM(R1) ; IS THIS THE .ENDM OPERAND?
JRST DEF03C ; YES - GO TO POPPER
SOJGE R1,.-2 ; NO - BACK UP TO HIER LEVEL
TRO RERR,ERRA ; NO SUCH MACRO IS OPEN . . .
JRST DEF03A ; GIVE IT AN "A" FLAG.
; -- NESTED .MACRO FOUND - ADD ITS NAME TO TABLE & INCR NEST LEVEL.
DEF03B: CALL GETSYM ; GET MACRO NAME
DEF03D: SETZ R0 ; NAMELESS .MACRO!.REPT!.IRP!.IRPC
; MACRO DIRECTIVES WITHOUT MACRO NAMES WILL BE FLAGGED
; WHEN THE MACRO IS DEFINED; IN THIS CASE THAT HAPPENS
; WHEN AN OUTER MACRO IS CALLED.
MOVEM R0,MACNAM(R7) ; STORE NAME IN NESTED NAME TABLE
JRST DEF04
; -- MODIFY NESTING LEVEL FOR A .ENDM WHICH TERMINATES
; A SPECIFIC MACRO.
DEF03C: TLNE RMODE,NSFFLG ; NONSTANDARD FEATURES ENABLED?
MOVE R7,R1 ; YES - SET, THEN POP, NEST LEVEL
DEF03A: SOJL R7,DEF13 ;END IF MINUS
DEF04: MOVE R13,LINPNT ;SET TO START OF LINE
TLO R16,FOLBIT ; LEAVE LOWER CASE INTACT.
DEF05: CALL GETCHR ;GET THE NEXT CHARACTER
DEF06: CAIE R14,"'" ;CONCATENATION CHARACTER?
JRST DEF06C ; NO, BRANCH AROUND
DEF06A: CALL GETCHR ;YES, GET THE NEXT CHARACTER
CAIE R14,"'" ;MULTIPLE?
JRST DEF06B ; NO
CALL WCIMT ;YES, SAVE ONLY ONE
JRST DEF06A ;TEST FOR MORE
DEF06B: TLO R15,CONFLG ;FLAG THE CONCATENATION CHARACTER
DEF06C: MOVE R0,RBYTE ; COPY BYTE IN CASE IT'S LOWER CASE.
CAIL RBYTE,140 ; IF NECESSARY, FOLD THE ORIGINAL
SUBI RBYTE,40 ; BYTE INTO UPPER CASE TO CHECK ITS TYPE.
; **** ADD A NEW COLUMN TO CHJTBL SOME DAY SOON ****
LDB R2,ANPNTR ;MAP
JUMPE R14,DEF12 ;BRANCH IF END OF LINE
CAIE R2,.ALP ;IF ALPHA
CAIN R2,.NUM ; OR NUMERIC
JRST DEF07 ; BRANCH
CAIN R2,.HEX ; SOME ALPHAS ARE TYPED
JRST DEF07 ; AS HEX DIGITS.
MOVE RBYTE,R0 ; RESTORE UNFOLDED BYTE.
CALL WCIMT ;WRITE IN TREE
JRST DEF05 ;TRY FOR ANOTHER
DEF07: TLZ R16,FOLBIT ; TURN FOLDING ON AGAIN . . .
SETZ R0, ;POSSIBLE ARGUMENT
MOVSI R3,(POINT 6,R0,)
MOVEM R13,SYMBEG ;SAVE START JUST IN CASE
DEF08: SUBI R14,40 ;CONVERT TO SIXBIT
TLNE R3,770000
IDPB R14,R3 ; YES, DO SO
CALL GETCHR ;GET THE NEXT CHARACTER
LDB R2,ANPNTR ;MAP
CAIE R2,.ALP ;IF ALPHA
CAIN R2,.NUM ; OR NUMERIC
JRST DEF08 ; BRANCH
CAIN R2,.HEX
JRST DEF08
CALL SIXM40
SETZ R2, ;INIT SEARCH INDEX
DEF09: SKIPN ARGLST(R2) ;TEST FOR END
JRST DEF10 ; YES
CAME R0,ARGLST(R2) ;NO, HAVE WE A MATCH?
AOJA R2,DEF09 ; NO,TRY THE NEXT SLOT
; ** FOUND MATCH -- IDENTIFY DUMMY SYMBOL IN THE PROTOTYPE TEXT.
TLZ R15,CONFLG ;REMOVE POSSIBLE CONCATENATION CHARACTER
MOVEI R14,101(R2) ;SET DUMMY SYMBOL POINTER
CALL WTIMT ;WRITE IN TREE
TLO R16,FOLBIT ; TURN OFF FOLDING AGAIN.
CALL SETCHR ;SET CHARACTER
CAIN R14,"'" ;CONCATENATION CHARACTER?
JRST DEF05 ; YES, BYPASS IT
JRST DEF06 ; NO, PROCESS IT
DEF10: MOVE R13,SYMBEG ;MISSED, RESET POINTER
TLO R16,FOLBIT ; QUIT FOLDING AGAIN.
CALL SETCHR ;RESET CHARACTER
DEF11: MOVE R0,RBYTE ; SAVE UNFOLDED BYTE, THEN
CAIL RBYTE,140 ; FOLD TO UPPER CASE TO CHECK
SUBI RBYTE,40 ; ITS TYPE.
LDB R2,ANPNTR ;MAP
MOVE RBYTE,R0 ; RESTORE UNFOLDED COPY OF BYTE.
CAIE R2,.ALP ;IF ALPHA
CAIN R2,.NUM ; OR NUMERIC
JRST DEF11A
CAIE R2,.HEX
JRST DEF06 ;ELSE BRANCH
DEF11A: CALL WCIMT ;OK, WRITE IN TREE
CALL GETCHR ;GET NEXT CHAR
JRST DEF11 ;TEST IT
DEF12: CALL ENDLR ;LIST IT
TLNN R15,ENDFLG ;SKIP IF EOF SEEN
JRST DEF03 ;GET THE NEXT LINE
DEF13:
MOVEI R14,QUEMAC ;FINISHED, SET "END OF MACRO DEFINITION"
CALL WTIMT ;WRITE IT, WITH QUE, IN TREE
POP R17,R2 ;RETRIEVE COUNT
POP R17,R1 ; AND POINTER TO START OF BLOCK
SETZM 0(R1) ;ZERO LEVEL COUNT
HRRZM R2,1(R1) ;STORE ARG COUNT IN SECOND RUNG
MOVE R0,MARMAS ; STORE "?" ARG BIT MASK
MOVEM R0,2(R1) ; IN THIRD WORD.
RETURN
DEFERR:
TRO R15,ERRQ
RETURN
CALLM:
MOVE R0,LSTCTL ; LOAD LIST CONTROL FLAGS
TRNN R0,LMC ; .NLIST MC IN EFFECT?
TLO R16,NLISLN ; YES - SUPPRESS LIST OF THIS LINE
IRPCAL: TLZA R16,IRPBIT ; ENTRY FROM .IRPC --
IRPAR: TLO R16,IRPBIT ; ENTRY FROM .IRP --
TLO R16,FOLBIT ; DON'T FOLD ARG VALUES.
PUSH R17,R1 ;SAVE POINTER TO DEFINITION BLOCK
CALL INCMAC ;INCREMENT THE REFERENCE COUNT
MOVE R7,1(R1) ;GET ARGUMENT COUNT
MOVE R0,2(R1) ; GET "?" ARGUMENT BIT MASK,
MOVEM R0,MARMAS ; SAVE IT IN MARMAS.
CALL GETBLK ;GET A BLOCK FROM FREE STORAGE
PUSH R17,MWPNTR ;SAVE THE STARTING ADDRESS
SETZM ARGCNT ; -- CLEAR ARGUMENT COUNT.
MOVEI R0,5
ADDM R0,MWPNTR ;MOVE BYTE POINTER PAST WORD STORAGE
MOVEI R14,QUEARG
CALL WTIMT ;INITIALIZE ARGUMENT LIST
JUMPE R7,MAC50 ;TEST FOR NO ARGS
MAC10: SETZM ARGLEN ; PRESUME ARG WILL BE OMITTED.
CALL SETNB ;SET NON-BLANK
CAIE R14,";" ;IF SEMI-COLON
CALL TSTNT ; OR TERMINATOR,
JRST MAC50A ; NO MORE ARGUMENTS.
AOS ARGCNT ; INCREMENT ARGUMENT COUNT.
CAIN R14,"," ; IS NEXT BYTE A COMMA?
JRST MAC40 ; YES -- EXPLICITLY NULL ARG.
CAIN R14,"\"
JRST MAC70 ;EXPRESSION TO ASCII CONVERSION
CALL MACART ; PARSE A MACRO ARG & STORE IN
; THE MACRO CALL BLOCK.
TLNN R16,IRPBIT ; IS THIS A .IRP?
JRST MAC40 ; NO -- MARK END OF ARGUMENT.
CAIN RBYTE,"," ; YES - SKIP COMMA, IF ANY.
IBP RBPTR ; KEEP DELIMITER IN RBYTE!
JRST MAC50A ; QUIT AFTER PRECISELY 1 ARG.
MAC40: ; END-OF-ARGUMENT PROCESSING
SKIPG ARGLEN ; WAS ARGUMENT NULL?
CALL GENSYM ; YES - GENERATE A LOCAL SYMBOL
; IF NECESSARY.
MAC41: PUSH RLINK,RBYTE ; SAVE ARGUMENT DELIMITER.
MOVEI RBYTE,QUEARG
CALL WTIMT ;MARK END OF ARGUMENT
POP RLINK,RBYTE ; RESTORE DELIMITER BYTE.
CAIN RBYTE,"," ; IS IT A COMMA?
IBP RBPTR ; YES - SKIP IT.
SOJG R7,MAC10 ;BRANCH IF MORE ARGS
MAC50A: MOVEM RBYTE,ARGDEL ; SAVE ARG DELIMITER (FOR .IRP)
MAC50: ;END OF LINE PROCESSOR
AOS ARGCNT ; INCREMENT ARG COUNT FOR SYM GENERATOR.
CALL GENSYM ; GEN A LOCAL SYMBOL IF NECESSARY.
MOVEI R14,QUEARG
CALL WTIMT ;PAD MISSING ARGS
SOJGE R7,MAC50
POP RLINK,R10 ; GET POINTER TO CALL BLOCK.
MOVEM R12,0(R10) ;SAVE CURRENT READ POINTER
MOVE R1,CALPNT
MOVEM R1,1(R10) ;SAVE CURRENT CALL BLOCK POINTER
MOVEM R10,CALPNT ;SET NEW POINTER
POP R17,R12 ;GET POINTER TO BASIC BLOCK
HRLI R12,(POINT 7,,) ;FORM A BYTE POINTER
MOVEM R12,2(R10) ;SAVE IT FOR DECMAC
HRRM R14,3(R10) ;SAVE LAST CHARACTER READ
MOVE R14,ARGCNT ; SAVE ARGUMENT COUNT
HRLM R14,3(R10) ; IN MACRO CALL BLOCK.
ADDI R12,3 ;POINT PAST WORD STORAGE
AOS MACLVL
; SAVE REPEAT AND CONDITIONAL NESTING LEVELS
; FOR LATER USE IF A .MEXIT IS ISSUED.
MOVE R14,MACLVL ; LOAD MACRO CALL LEVEL
MOVE R0,REPLVL ; SAVE .REPT LEVEL
MOVEM R0,MCLREP(R14)
MOVE R0,CONLVL ; SAVE NEXTED CONDITIONAL LEVEL
MOVEM R0,MCLCON(R14)
MOVE R0,UNSLVL ; SAVE UNSATISFIED COND LEVEL
MOVEM R0,MCLUNS(R14)
LDB RBYTE,RBPTR ; RESTORE LAST CHARACTER.
RETURN
MAC70: ;"\"
CALL GETNB ;BYPASS UNARY OP
PUSH R17,R7 ;PROTECT ARG COUNT
TLZ R16,FOLBIT ; FOLD TO UPPER CASE FOR EXPR EVALUATION.
CALL ABSEXP ;EVALUATE THE EXPRESSION
TLO R16,FOLBIT ; CEASE FOLDING AGAIN.
CALL MAC71 ;CONVERT TO ASCII
POP R17,R7 ;RESTORE ARG COUNT
CALL SETNB ; AND LAST CHARACTER
MAC70A: CAIE R4,SCSE ; IS EXPR DELIMITER A VALID ARG
CAIN R4,SCSE ; DELIMITER? (",", BLANK, ";", OR EOL)
JRST MAC40 ; YES - DO END-OF-AR PROCESSING.
TRO RERR,ERRQ ; NO -- FLAG QUESTIONABLE SYNTAX
CALL GETNB ; AND SKIP TO VALID DELIMITER.
JRST MAC70A
MAC71: IDIV R10,RADVAL ; DIVIDE NUMBER BY DEFAULT RADIX.
HRLM R11,0(R17)
CAIE R10, ;TEST FOR END
CALL MAC71
HLRZ R14,0(R17)
ADDI R14,"0" ;FORM TEXT
CAILE R14,"9" ; CHECK FOR HEX DIGITS A-F.
ADDI R14,"A"-"9"-1
JRST WCIMT ;WRITE INTO SKELETON
; SUBROUTINE GENSYM GENERATES A LOCAL SYMBOL IN THE
; RANGE OF 64$ - 127$ IF AN OMITTED ARGUMENT WAS FLAGGED
; WITH A "?" IN THE MACRO PROTOTYPE.
GENSYM: MOVEI R0,1 ; TRANSLATE FROM ARGUMENT #
MOVE R1,ARGCNT ; TO A MASK BIT.
ROT R0,-1(R1)
TDNN R0,MARMAS ; DOES THIS ONE WANT A SYMBOL?
RETURN ; NO -- IT'S HAPPY TO BE NULL.
; YES - .... GROAN.
MOVE R0,NEXGS ; GET VALUE FOR NEXT GENERATED SYMBOL.
TRZE R0,777400 ; DON'T LET IT EXCEED 127!
TRO RERR,ERRT ; * FLAG TRUNCATION ERROR IF IT DOES.
AOS NEXGS ; SET NEW VALUE FOR NEXT SYMBOL.
PUSH RLINK,RBYTE ; SAVE CURRENT SOURCE BYTE.
CALL LOCVRT ; CONVERT NUMERIC PART OF LOCAL SYMBOL.
MOVEI RBYTE,"$" ; APPEND "$".
CALL WCIMT ; WRITE IT IN CALL BLOCK.
POP RLINK,RBYTE ; REFURBISH USED REGISTER.
RETURN
; LOCVRT IS YET ANOTHER VARIANT ON THE UBIQUITOUS
; RECURSIVE SUBROUTINE THAT CONVERTS AN INTEGER
; TO DECIMAL. THIS ONE STUFFS ITS DIGITS INTO
; THE MACRO CALL BLOCK AS A PARAMETER VALUE.
LOCVRT: IDIVI R0,↑D10 ; PICK OFF THE NEXT DIGIT.
HRLM R1,0(RLINK) ; SAVE IT ON THE STACK.
CAIE R0,0 ; HAS QUOTIENT VANISHED?
CALL LOCVRT ; NO -- DO IT AGAIN.
HLRZ RBYTE,0(RLINK) ; YES - RETRIEVE THE DIGIT.
TRO RBYTE,"0" ; TRANSLATE IT TO ASCII.
JRST WCIMT ; WRITE IN MACRO TREE & RETURN.
; ########## .MEXIT ###########
; .MEXIT RESTORES THE LEVEL COUNTERS FOR REPEATS,
; CONDITIONALS, AND UNSATISFIED CONDITIONALS TO
; THEIR VALUES AT THE MACRO CALL. IT LISTS
; THE REMAINING MACRO LINES AND ENTERS .ENDM PROCESSING.
.MEXIT: SKIPG MACLVL ; IS A MACRO EXPANDING?
JRST OPCERR ; NO - FLAG THE LINE.
MOVE R14,MACLVL ; LOAD LEVEL OF NESTED CALLS
MOVE R0,MCLREP(R14) ; RESTORE REPEAT LEVEL
MOVEM R0,REPLVL
MOVE R0,MCLCON(R14) ; RESTORE COND LEVEL
MOVEM R0,CONLVL
MOVE R0,MCLUNS(R14) ; RESTORE UNSATISFIED LEVEL
MOVEM R0,UNSLVL
; LIST REMAINING LINES OF MACRO. NOTE THAT
; .ENDM PROCESSING (MACEND) IS ENTERED FROM
; READMC, WHICH IS CALLED BY CHAR2 IN CHAR,
; WHICH IS CALLED BY GETLIN. THE MACRO'S END
; IS DETECTED FROM HERE BY WATCHING FOR
; MACEND'S DECREMENT OF MACLVL.
MOVEM R14,MLSAVE ; SAVE MACLVL
MEXLST: CALL ENDLR ; LIST NEXT LINE.
CALL GETLIN ; GET ITS SUCCESSOR.
CALL GETEOL ; POSITION TO END OF LINE.
MOVE R0,MACLVL
CAMN R0,MLSAVE ; DID MACLVL CHANGE?
JRST MEXLST ; NO - CONTINUE LISTING.
RETURN ; YES - RETURN.
MACEND: ;END OF MACRO CALL
MOVE R10,CALPNT ;IN CASE WE GOT WIPED
MOVE R12,0(R10) ;RESET PREVIOUS READ POINTER
MOVE R1,1(R10)
MOVEM R1,CALPNT ;LIKEWISE
MOVE R1,2(R10) ;GET POINTER TO BASIC BLOCK
CALL DECMAC ;DECREMENT THE REFERENCE
HRRZ R14,3(R10) ;RESTORE LAST CHARACTER
MOVE R1,R10
CALL REMMAC ;RETURN THIS BLOCK FOR DEPOSIT
SOS R14,MACLVL ; DECREMENT MACRO CALL DEPTH LEVEL
RETURN ;FINIS
SUBTTL MACRO STORAGE HANDLERS
WTIMT: ;WRITE TWO CHARACTERS IN MACRO TREE
PUSH R17,R14 ;STACK CURRENT CHARACTER
MOVEI R14,RUBOUT ;SET FLAG CHARACTER
CALL WCIMT ;WRITE IT
POP R17,R14 ;RESTORE CHARCTER AND FALL THROUGH
WCIMT: ;WRITE CHARACTER IN MACRO TREE
TLZE R15,CONFLG ;CONCATENATION CHARACTER PENDING?
JRST WCIMT2 ; YES, WRITE IT OUT
IBP MWPNTR ;POINT TO ACTUAL WORD
SKIPN @MWPNTR ;END OF BLOCK?
JRST WCIMT1 ; YES, GET ANOTHER
DPB R14,MWPNTR ;NO, STORE BYTE
RETURN ;EXIT
WCIMT1: PUSH R17,MWPNTR ;NEAD A NEW BLOCK, SAVE CURRENT POINTER
CALL GETBLK ;GET IT
HRRZ R11,MWPNTR ;GET START OF NEW BLOCK
EXCH R11,0(R17) ;EXCHANGE WITH POINTER TO LAST
POP R17,0(R11) ;STORE VECTOR
JRST WCIMT ;TRY AGAIN
WCIMT2: PUSH R17,R14 ;STACK CURRENT CHARACTER
MOVEI R14,"'"
CALL WCIMT ;WRITE CONCATENATION CHARACTER
POP R17,R14 ;RESTORE CHARACTER
JRST WCIMT ;CONTINUE
GETBLK: ;GET A BLOCK FOR MACRO STORAGE
SKIPE R11,NEXT ;ANY REMNANTS OF GARBAGE COLLECTION?
JRST GETBL1 ; YES, RE-USE
PUSH R17,R7 ; NO, SAVE REGISTER
MOVEI R7,WPB
ADDB R7,JOBFF ;UPDATE FREE LOCATION POINTER
CAML R7,SYMBOT ;ANY ROOM?
CALL GETCOR ; NO, GET MORE CORE
MOVEI R11,-<WPB-1>(R7) ;POINT TO START OF BLOCK
POP R17,R7 ;RESTORE
SETZM WPB-1(R11) ;CLEAR VECTOR
GETBL1: HRLI R11,(POINT 7,,) ;FORM BYTE POINTER
MOVEM R11,MWPNTR ;SET NEW BYTE POINTER
HRLI R11,-<WPB-1> ;GET SET TO INITIALIZE BLOCK
SETOM 0(R11) ;CLEAR ENTRY
AOBJN R11,.-1 ;SET ALL EXCEPT LAST TO -1
PUSH R17,0(R11) ;GET TOP
POP R17,NEXT ;SET FOR NEXT BLOCK
SETZM 0(R11) ;CLEAR LAST WORD
RETURN ;EXIT
READMC: ;READ MACRO CHARACTER
CALL READMB ;GET A MACRO BYTE
CAIE R14,RUBOUT ;SPECIAL?
JRST CPOPJ1 ; NO, JUST EXIT
CALL READMB ;YES, GET TYPE
TRZE R14,100 ;SYMBOLIC?
JRST GETDS ; YES
JRST .(R14) ; NO, TRANSFER ON TYPE
PHASE 1
QUEMAC: JRST MACEND ;END OF MACRO
QUEARG: JRST DSEND ;END OF MACRO ARGUMENT
QUEREP: JRST REPEND ;END OF REPEAT
DEPHASE
READMB: ;READ MACRO BYTE
ILDB R14,R12 ;GET CHARACTER
JUMPN R14,CPOPJ ;EXIT IF NON-NULL
MOVE R12,0(R12) ;END OF BLOCK, GET LINK
HRLI R12,(POINT 7,,) ;SET ASCII BYTE POINTER
JRST READMB ;TRY AGAIN
GETDS: ;GET DUMMY SYMBOL
MOVE R11,CALPNT ;GET POINTER TO CALL BLOCK
MOVEM R12,4(R11) ;SAVE CURRENT READ POINTER
MOVE R12,R11 ;SET NEW READ POINTER
ADDI R12,5 ;MOVE PAST WORDS
MOVE R11,R14 ;GET ARG NUMBER
ANDI R11,37
GETDS1: PUSH R17,R11 ;STACK WORKING REGISTER
GETDS2: CALL READMB ;GET A MACRO BYTE
CAIE R14,RUBOUT ;FLAGGED?
JRST GETDS2 ; NO, TRY AGAIN
CALL READMB ;YES, BYPASS END CODE
POP R17,R11 ;RESTORE WORKING REGISTER
SOJG R11,GETDS1 ;TEST FOR COMPLETION
RETURN ; YES, EXIT
DSEND: ;DUMMY SYMBOL END
MOVE R12,CALPNT ;GET POINTER TO CALL BLOCK
MOVE R12,4(R12) ;RESTORE PREVIOUS READ POINTER
RETURN ;EXIT
INCMAC: ;INCREMENT MACRO STORAGE
AOS 0(R1)
RETURN
DECMAC: ;DECREMENT MACRO STORAGE
SOSL 0(R1) ;TEST FOR END
RETURN ; NO, EXIT
REMMAC: ;REMOVE MACRO STORAGE
PUSH R17,R1 ;SAVE POINTER
HRLS R1 ;SAVE CURRENT POINTER
HRR R1,WPB-1(R1) ;GET NEXT LINK
TRNE R1,-1 ;TEST FOR END (NULL)
JRST .-3 ; NO
HLRZS R1 ;YES, GET RETURN POINTER
HRL R1,NEXT ;GET CURRENT START OF CHAIN
HLRM R1,WPB-1(R1) ;STORE AT TOP
POP R17,R1 ;RESTORE BORROWED REGISTER
HRRZM R1,NEXT ;SET NEW START
RETURN ;EXIT
SUBTTL LISTING ROUTINES
; PRNTA LISTS ASSEMBLER - GENERATED INFORMATION
; AT THE LEFT SIDE OF EACH LINE:
; -- LINE NUMBER FIELD (CURRENTLY BLANK, MAY BE SET BY CREF)
; -- LOCATION (UNLESS .NLIST LOC IS IN EFFECT)
; -- BINARY CODE (UNLESS .NLIST BIN IS IN EFFECT)
; .. THREE WORDS OF BINARY CODE ARE LISTED
; IF TTM LISTING MODE IS NOT IN EFFECT.
; .. ONE WORD OF BINARY CODE IS LISTED
; IF TTM LISTING MODE IS IN EFFECT
; PRNTA IS CALLED FROM ONLY ONE PLACE (A LOCATION
; BETWEEN ENDL6 AND ENDL7).
PRNTA: ;PRINT BASIC LINE OCTAL
MOVE R0,LSTCTL ; **** SEQ # FIELD ****
TRNN R0,LSEQ ; SEQUENCE # TO BE LISTED?
JRST PRNTA0 ; NO - JUST TAB TO LOC FIELD
TLNE R16,BEXBIT ; YES - LIST SEQ UNLESS THIS
JRST PRNTA0 ; IS A BINARY EXTENSION LINE.
; =========== LIST LINE SEQUENCE NUMBER ===========
CALL FORSEQ ; FORMAT THE FIELD.
PRNSEQ: CALL LSTOUT ; LIST A BYTE OF IT.
ILDB R2,R6 ; GET NEXT BYTE
JUMPN R2,PRNSEQ ; REPEAT UNTIL FINDING 0 BYTE.
PRNTA0: CALL LSTTAB ;LIST A TAB
MOVE R0,LSTCTL ; **** LOCATION FIELD ****
TRNN R0,LLOC ; IS LOC TO BE LISTED?
JRST PRNTA1 ; NO - GO TO NEXT FIELD.
; YES - PRINT LOC IF IT WAS GENERATED.
SKIPE R10,PF0 ;FIRST FIELD TO BE PRINTED?
CALL PRNTWB ; YES
CALL LSTTAB ;OUTPUT TAB
PRNTA1: MOVE R0,LSTCTL ; **** BINARY FIELD ****
TRNN R0,LBIN ; BINARY TO BE LISTED?
RETURN ; NO -- DONE
; YES - LIST WHATEVER WAS GENERATED.
SKIPE R10,PF1 ;PRINT PF1
CALL PRNTWB
HRRZ R0,LSTCTL
TRNE R0,LTTM ; TELETYPE?
RETURN ; YES, THROUGH FOR NOW
CALL LSTTAB
SKIPE R10,PF2
CALL PRNTWB ; NO, LIST 2 MORE WORDS.
CALL LSTTAB
SKIPE R10,PF3
CALL PRNTWB
RETURN ;EXIT
PRNTWB: ;PRINT WORD OR BYTE
LDB R3,[POINT 2,R10,17]
CAIE R3,1
JRST PRNTWD ; YES
PRNTBY: ;PRINT BYTE
CALL LSTSP ;LIST THREE SPACES
CALL LSTSP
CALL LSTSP
MOVE R3,[POINT 3,R10,26]
ANDI R10,377
JRST PRNTWF
PRNTWD: MOVE R3,[POINT 3,R10,17]
PRNTWF: ILDB R2,R3
PUSH R17,R3
CALL LSTNUM ;LIST NUMBER
POP R17,R3
TLNE R3,770000
JRST PRNTWF
MOVEI R2,"'"
TLNE R10,GLBSYM
MOVEI R2,"G"
TDNE R10,[PFMASK] ;RELOCATABLE?
CALL LSTOUT ; YES
RETURN
; =========== SUBROUTINE FORSEQ -==============
; FORMAT A SEQUENCE NUMBER FOR AN OUTPUT LINE.
; THE BINARY LINE SEQUENCE NUMBER IS LOCATION SEQ;
; THE FORMATTED VERSION IS LOCATION FSEQ.
; IF THE LINE WAS EXPANDED FROM A MACRO, PRINT THE
; MACRO CALL NESTING LEVEL TO THE LEFT OF THE LINE
; NUMBER.
; AT RETURN, . . .
; FSEQ CONTAINS AN ASCIZ-STYLE STRING,
; R6 CONTAINS A POINTER TO ITS FIRST BYTE,
; R2 CONTAINS THE FIRST BYTE.
FORSEQ: SETZM FSEQ ; CLEAR FORMATTED STRING FIELDS.
SETZB R2,FSEQ+1 ; R2 = 0 TO COUNT BYTES.
MOVE R0,SEQ ; LOAD BINARY SEQUENCE NUMBER.
; SEQUENCE NUMBER CONVERSION IS BINARY TO DECIMAL, ONE BYTE
; AT A TIME VIA REPEATED DIVISION BY 10. BYTES ARE PUSHED
; ONTO THE STACK IN ASCENDING ORDER OF SIGNIFICANCE.
FSCVT: IDIVI R0,↑D10 ; DIVIDE TO GET (#/10, # MOD 10).
TRO R1,"0" ; CONVERT DIGIT TO ASCII.
PUSH RLINK,R1 ; PUSH IT ONTO THE STACK.
AOJ R2, ; INCREMENT DIGIT COUNT.
JUMPN R0,FSCVT ; REPEAT UNTIL QUOTIENT GOES TO 0.
; R2 = # OF SIGNIFICANT DIGITS. FIGURE OUT HOW MANY
; BLANKS TO FORMAT IN ORDER TO RIGHT-JUSTIFY THE SEQUENCE
; NUMBER. . .
; # OF BLANKS = 7 - M - S - E, WHERE
; M = # OF DIGITS IN MACRO LEVEL
; S = # OF SIGNIFICANT DIGITS
; E = # OF ERROR FLAGS PRINTED
; S IS IN R2; COMPUTE 7-E IN R0 BY COUNTING THE NUMBER
; OF BITS ON IN RERR (RIGHT HALF OF R15).
MOVEI R3,7
TLNN R16,MEXBIT ; IS THIS LINE FROM A MACRO EXPANSION?
JRST FSNM ; NO -- JUST FORMAT SEQ NUM.
MOVE R0,MACLVL ; YES - LOAD CALL NESTING LEVEL.
PUSH RLINK,R2 ; KEEP R2 KOSHER &
CALL LSTLNU ; PRINT MACLVL WITH A BORROWED SUBR.
POP RLINK,R2
FSNM: HRRZ R6,RERR ; SET R6 TO ERROR FLAGS.
JUMPE R6,FSCDUN ; DONE IF NO BITS ON.
; THE FOLLOWING LOOP IS ITERATED ONCE FOR EACH
; 1 BIT IN R6. R6 IS DESTROYED IN THE PROCESS
; OF COUNTING ITS BITS.
FSCNT: SOJ R3, ; DECREMENT BLANK COUNT.
MOVN R1,R6 ; A XOR (-A) TURNS OFF LOW BIT,
XOR R1,R6 ; WHEREVER IT MAY BE.
AND R1,R6 ; RECONSTRUCT HIGH ORDER BITS.
MOVE R6,R1 ; COPY BACK FOR NEXT ITERATION.
JUMPN R6,FSCNT ; REPEAT UNLESS NO BITS REMAIN.
; END OF BIT COUNT -- R3 = 7-M-E.
FSCDUN: MOVE R6,[POINT 7,FSEQ] ; LOAD SEQ FIELD POINTER.
SUB R3,R2 ; BLANK COUNT = (7-E)-S.
JUMPLE R2,FSDIGT ; BEWARE GOBS OF FLAGS!
MOVEI R1," " ; LOAD LITERAL BLANK TO DEPOSIT.
FSLEAD: IDPB R1,R6 ; SUPPLY A LEADING BLANK.
SOJG R3,FSLEAD ; REPEAT TIL COUNT IS EXHAUSTED.
; POP SIGNIFICANT DIGITS OFF THE STACK (IN DESCENDING
; ORDER OF SIGNIFICANCE) & APPEND TO FSEQ.
FSDIGT: POP RLINK,R1 ; GET NEXT DIGIT.
IDPB R1,R6 ; STORE IN FSEQ.
SOJG R2,FSDIGT ; REPEAT TIL ALL DIGITS DONE.
; LOAD REGS WITH BYTE & BYTE POINTER, THEN RETURN.
MOVE R6,[POINT 7,FSEQ] ; LOAD PTR TO START OF FIELD.
ILDB R2,R6 ; LOAD FIRST BYTE.
RETURN
SUBTTL OCTAL OUTPUT ROUTINES
STCODE: ;STOW CODE
PUSH R17,R3
AOS R3,CODPNT ;INCREMENT INDEX
MOVEM R1,CODBUF-1(R3) ;STORE
POP R17,R3
RETURN
PROCOD: ;PROCESS CODE
MOVE R6,CODPNT ;FETCH INDEX
SKIPN R1,CODBUF(R6) ;NULL?
RETURN ; YES, EXIT NULL
SETZM CODBUF(R6)
CALL PROWRD ;PROCESS WORD
MOVE R6,PFT0 ;TRANSFER PRINT STUFF
TLZN R16,LBLBIT ; ** PF0 IS ALREADY SET IF
; ** LBLBIT IS 1.
MOVEM R6,PF0
MOVE R6,PFT1
TLNN R16,PF1BIT ; IF PF1BIT SET, PRINT VALUE
; STORED IN PF1 BY SOME WEIRDO DIRECTIVE
MOVEM R6,PF1
AOS R6,CODPNT ;INCREMENT INDEX
HRRZ R0,LSTCTL ; IF TELETYPE FORMAT
TRNN R0,LTTM
SKIPN R1,CODBUF(R6) ; IF EMPTY,
JRST CPOPJ1 ; EXIT GOOD
SETZM CODBUF(R6)
CALL PROWRD
MOVE R6,PFT1
MOVEM R6,PF2
AOS R6,CODPNT ;MORE OF SAME
SKIPN R1,CODBUF(R6)
JRST CPOPJ1
SETZM CODBUF(R6)
CALL PROWRD
MOVE R6,PFT1
MOVEM R6,PF3
AOS CODPNT
JRST CPOPJ1
PROWRD: ;PROCESS WORD
SETZM PFT0 ;CLEAR TEMP PRINT BUFFERS
SETZM PFT1
LDB R2,MODPNT ;GET CLASS
ANDI R2,177 ;MASK OUT BYTE BIT
MOVE R10,RLDTBL(R2) ;GET PROPER TABLE ENTRY
MOVE R3,R5 ;GET A COPY OF THE PC
TLO R3,DEFSYM ;WITH DEFINED BIT SET
TLNE R1,BC1!BC2 ;CODE TO BE GENNED?
MOVEM R3,PFT0 ; YES, PRINT LOCATION
MOVE R4,R10 ;FLAGS TO R4
DPB R1,[POINT 36-8,R4,35] ;REMAINDER FROM R1
CAIN R2,RLDT1 ;SPECIAL IF CLASS 1
TLO R4,(1B<SUBOFF>)
CAIE R2,RLDT7 ;IF CLASS 7 OR 10
CAIN R2,RLDT10
MOVE R4,R3 ; USE PREVIOUS PC
MOVEM R4,PFT1 ;SET TEMP PRINT FIELD 1
TLNE RMODE,PNCFLG ; IS OBJECT OUTPUT BEING SUPPRESSED?
TLNE R15,P1F!ABSFLG ;PASS ONE?
JRST PROWR3 ; YES, BRANCH
LDB R3,TYPPNT ;GET BYTE COUNT
CAIN R2,RLDT11 ;TYPE 11?
MOVEI R3,4 ; YES, ALL IN ONE BUFFER
ADD R3,BYTCNT
HRRZ R4,R10
ADD R4,RLDCNT
CAIG R3,RLDLEN
CAILE R4,RLDLEN ;ROOM TO STORE?
CALL BLKDMP ; NO, DUP CURRENT BUFFER
SKIPN BYTCNT ;BUFFER EMPTY?
TLNN R1,BC1!BC2 ; YES, ANY CODE?
JRST PROWR1 ;OK, BYPASS
MOVEI R2,BKT3
CALL BSWORD ; NO, STORE BLOCK TYPE
MOVE R2,R5
CALL BSWORD ;STORE CURRENT ADDRESS
PROWR1: LDB R2,MODPNT ;GET THE TYPE
JUMPE R2,PROWR3 ;BRANCH IF ABSOLUTE
CALL RLDSTB ;STORE IT
TLNN R1,BC1!BC2 ;CODE?
TDZA R2,R2 ; NO, SET ZERO
MOVE R2,BYTCNT ;YES, SET BYTE POINT FOR REFERENCE
CALL RLDSTB
LDB R2,SUBPNT
JUMPE R2,PROWR2 ;BRANCH IF NOT EXTERNAL/REL
MOVS R2,GLBBUF(R2) ;GET GLOBAL NAME
CALL RLDSTW
HLRZS R2
CALL RLDSTW ; AND LEFT HALF
PROWR2: MOVE R2,R1 ;GET VALUE
TLNE R10,1 ;SHOULD WE STORE?
CALL RLDSTW ; YES
PROWR3: MOVE R2,R1 ;GET BASIC VALUE
TLNE R2,BC1!BC2 ;CODE?
CALL BYTOUT ; YES
LSH R2,-↑D8 ;SHIFT HIGH ORDER BYTE DOWN
TLNE R1,BC2 ;WORD?
CALL BYTOUT ; YES, OUTPUT HIGH BYTE
TLNN R1,BC1!BC2 ;CODE?
CALL BLKDMP ; NO, SPECIAL. DUMP THE BUFFER
RETURN
RLDSTW:
PUSH R17,R2
CALL RLDSTB
LSH R2,-↑D8
CALL RLDSTB
POP R17,R2
RETURN
RLDSTB: AOS R3,RLDCNT
MOVEM R2,RLDBLK-1(R3)
RETURN
RLDTBL:
PHASE 0
RLDT0: XWD DEFSYM! 0, 0
RLDT1: XWD DEFSYM! 1, 4
RLDT2: XWD 0! 0, 6
RLDT3: XWD DEFSYM! 1, 4
RLDT4: XWD 0! 0, 6
RLDT5: XWD GLBSYM! 1, 10
RLDT6: XWD GLBSYM! 1, 10
RLDT7: XWD 0! 1, 10
RLDT10: XWD DEFSYM! 1, 4
RLDT11: XWD DEFSYM! 0, 2
RLDT12: XWD 0! 0, 0
RLDT13: XWD 0! 0, 0
RLDT14: XWD 0! 0, 0
RLDT15: XWD DEFSYM! 1, 10
RLDT16: XWD DEFSYM! 1, 10
RLDT17: XWD 0! 0, 0
DEPHASE
ENDP: ;END OF PASS ROUTINES
CALL TSTMAX ;BE SURE TO TRAP MAX PC
LDB R2,CCSPNT
HRRM R5,SECBAS(R2) ;SET HIGH LOCATION
TLNN R15,P1F ;PASS 1?
JRST ENDP20 ; NO
; IF .ENABL GBL IS IN EFFECT, SCAN THE SYMBOL TABLE
; FOR UNDEFINED NAMES & RE-TYPE THEM AS GLOBAL.
TLNN RMODE,GBLFLG ; IS .ENABL GBL IN EFFECT?
JRST ENDSB ; NO -- LEAVE SYM TAB AS IS.
; YES - SCAN FOR UNDEFINED SYMS.
SETZ R7, ; CLEAR INDEX INTO TABLE.
ENDUS: ADDI R7,2 ; ADVANCE TO NEXT SYMBOL.
CAML R7,SYMLEN ; IS THIS THE END?
JRST ENDSB ; YES - ALL DONE.
; NO -- CHECK NEXT SYMBOL.
MOVE R0,@VALPNT ; LOAD SYMBOL'S DEFINITION.
TLNN R0,DEFSYM ; IS IT DEFINED?
TLO R0,GLBSYM ; NO -- MARK IT GLOBAL.
MOVEM R0,@VALPNT ; STORE NEW DEFINITION.
JRST ENDUS ; GO BACK FOR NEXT SYMBOL.
ENDSB: CALL SETBIN ;SET BINARY (OBJ OR BIN)
TLNE R15,ABSFLG ;YES, ABSOLUTE?
RETURN ; YES, NO ACTION
MOVE R0,PRGTTL ;GET PROGRAM TITLE
SETZ R1,
CALL HDROUD ;OUTPUT DOUBLE WORD
SETZ R6, ;INIT SECTOR COUNT
ENDP11: SETZ R7, ;INIT FOR TABLE SEARCH
MOVE R0,SECNAM(R6) ;GET SECTOR NAME
HLRZ R1,SECBAS(R6) ;GET ITS LENGTH
HRLI R1,450 ;ASSUME RELOCATABLE
CAIN R6, ;YES?
MOVSI R1,410 ; NO, ABS
ENDPO: CALL HDROUD ;OUTPUT IT
ENDP12: CALL GETSTE ;GET THE NEXT SYMBOL TABLE ENTRY
JRST ENDP15 ; END, BRANCH
TLNN R1,GLBSYM ;GLOBAL?
JRST ENDPLS ; NO -- PUT IT IN ISD IF WANTED.
LDB R2,SUBPNT ;GET RELOCATION
MOVSI R3,2150 ;ASSUME REL
JUMPN R6,ENDP13 ;BRANCH IF TRUE
MOVSI R3,2100 ;NO, ASSUME EXTERNAL
TLNN R1,DEFSYM ;TRUE?
JRST ENDP14 ; YES
TLOA R3,10 ;INTERNAL
ENDP13: TLNE R1,DEFSYM ;IF EXTERNAL
CAME R2,R6 ; OR NON-MATCH
JRST ENDP12
ENDP14: HLL R1,R3
JRST ENDPO ; OUTPUT IT & TRY FOR MORE.
ENDP15: ADDI R6,1 ;MOVE TO NEXT SECTOR
SKIPN SECNAM(R6) ;IF NON-NULL
CAIN R6,1 ; OR SECTOR 1,
JRST ENDP11 ;PROCESS
MOVE R1,ENDVEC ;GET END VECTOR
LDB R2,SUBPNT ;ISOLATE ITS RELOCATION
MOVE R0,SECNAM(R2) ;GET THE NAME
HRLI R1,1410 ;ASSUME ABSOLUTE
CAIE R2,
TLO R1,40 ;NO, RELOCATABLE
CALL HDROUD ;OUTPUT IT
CALL BLKDMP ;DUMP THE BLOCK
MOVEI R2,BKT2
CALL BSWORD ;SET BLOCK TYPE
CALL BLKDMP ;DUMP THE BUFFER
MOVEI R2,BKT4 ;OUTPUT A DUMMY CSECT
CALL BSWORD
MOVEI R2,RLDT7
CALL BSWORD
SETZ R2,
CALL BSWORD
CALL BSWORD
CALL BSWORD
JRST BLKDMP ;DUMP THE BUFFER AND EXIT
; SYM TABLE SCAN FOUND LOCAL SYMBOL; IF .ENABL ISD
; IS IN EFFECT, PUT OUT AN INTERNAL SYMBOL DEFINITION
; ENTRY IN THE GSD.
ENDPLS: TLNE RMODE,ISDFLG ; ISD ENTRIES WANTED?
TLNN R1,DEFSYM ; ... AND SYMBOL DEFINED?
JRST ENDP12 ; NO -- GO BACK FOR NEXT SYMBOL.
LDB R2,SUBPNT ; YES - FIND OUT IF THIS
CAMN R2,R6 ; IS THE SAME PSECT.
TLNE R0,200000 ; ALSO, DON'T OUTPUT LOCAL SYMBOLS.
JRST ENDP12
MOVSI R3,1000 ; SET ENTRY TYPE = ISD, FLAGS = 0.
TLNE R1,REGSYM ; IS THIS A REGISTER?
TLO R3,1 ; YES - SET FLAG BIT 0.
HLL R1,R3 ; COPY ENTRY TYPE & FLAGS,
JRST ENDPO ; PUT OUT THE ENTRY.
ENDP20: CALL BLKDMP ;END OF PASS 2
MOVE R2,ENDVEC ;GET THE VECTOR
TLNN R15,ABSFLG ;ABSOLUTE?
MOVEI R2,BKT6 ; NO, SET BLOCK TYPE
CALL BSWORD ;STORE IT
JRST BLKDMP ;DUMP THE BUFFER AND EXIT
HDROUD: ;OUTPUT DOUBLE WORD
MOVE R2,BYTCNT
CAILE R2,RLDLEN-↑D8+2 ;ROOM?
CALL BLKDMP ; NO
MOVEI R2,BKT1
SKIPN BYTCNT ;BUFFER INITIALIZED?
CALL BSWORD ; NO, DO SO
MOVE R2,R0 ;FIRST WORD
CALL HDROUW
MOVE R2,R1
HDROUW: PUSH R17,R2
HLRZ R2,0(R17) ;LEFT HALF
CALL HDROUH
POP R17,R2
HDROUH: PUSH R17,R2
CALL HDROUB
LDB R2,[POINT 8,0(R17),35-8]
CALL HDROUB
POP R17,R2
RETURN
HDROUB: JRST BSBYTE
BYTOUT: ;OUTPUT A BYTE OF CODE
TLNE R15,P1F ;PASS 1
AOJA R5,CPOPJ ; YES, JUST INCREMENT AND EXIT
TLNN R15,ABSFLG ;ABS MODE?
JRST BYTOU1 ; NO
MOVE R3,BYTCNT ;YES GET BYTE COUNT
CAIGE R3,DATLEN+2 ;OUT OF ROOM?
CAME R5,CURADR ; OR A SEQUENCE BREAK?
CALL BLKDMP ; YES, DUMP THE BUFFER
SKIPE BYTCNT ;DO WE NEED INITIALIZATION?
JRST BYTOU1 ; NO, STORE IT
PUSH R17,R2 ;STACK CURRENT CHARACTER
MOVE R2,R5 ;GET PC
CALL BSWORD ;STORE IT
MOVEM R5,CURADR ;NEW SEQUENCE BREAK TEST
POP R17,R2 ;RETRIEVE BYTE
BYTOU1: CALL BSBYTE ;STORE THE BYTE
AOS CURADR ;UPDATE CURRENT ADDRESS
AOJA R5,CPOPJ ;INCREMENT CLC AND EXIT
BSWORD: ;BINARY STORAGE OF WORD
PUSH R17,R2
CALL BSBYTE ;STORE LOW ORDER
LSH R2,-8 ;SHIFT DOWN HIGH ORDER
CALL BSBYTE ;STORE IT
POP R17,R2 ;RESTORE WORD
RETURN ; AND EXIT
BSBYTE: ;BINARY STORAGE OF BYTE
AOS R3,BYTCNT ;INCREMENT AND FETCH THE BYTE COUNT
MOVEM R2,DATBLK-1(R3) ;STORE CURRENT BYTE IN BUFFER
RETURN
BLKDMP: ;DUMP THE CURRENT BLOCK
SKIPN BYTCNT ;IS IT EMPTY?
JRST RLDDMP ; YES, TEST FOR REL BLOCK
PUSH R17,R1 ;GET A COUPLE OF SCRATCH REGISTERS
PUSH R17,R2
BLKDM1: MOVEI R2,01 ;BLOCK TYPE ONE
CALL BINWRD ;OUTPUT FLAG WORD
MOVE R2,BYTCNT ;FETCH BYTE COUNT
ADDI R2,4 ;FUDGE FOR HEADER
CALL BINWRD ;OUTPUT IT
HRLZ R1,BYTCNT ;GET BYTE COUNT
MOVNS R1 ;NEGATE BYTE CT
MOVE R2,DATBLK(R1) ;GET AN ITEM FROM THE DATA BLOCK
CALL BINOUT ;DUMP IT
AOBJN R1,.-2 ;RECYCLE IF NOT DONE
MOVN R2,CHKSUM ;GET NEG OF CHECKSUM.
CALL BINOUT ;DUMP IT
SETZ R2, ;FINISHED WITH BLOCK
MOVEI R1,↑D6
TLNN R15,ABSFLG
MOVEI R1,↑D8
CALL BINOUT ;DUMP SOME BLANK TAPE
SOJG R1,.-1
POP R17,R2 ;RESTORE REGISTERS
POP R17,R1
RLDDMP:
SKIPN RLDCNT
JRST BLKINI
PUSH R17,R1
PUSH R17,R2
HRLZ R1,RLDCNT
CALL BLKINI
MOVEI R2,BKT4
CALL BSWORD
MOVNS R1
MOVE R2,RLDBLK(R1)
CALL BSBYTE
AOBJN R1,.-2
CALL BLKDMP
POP R17,R2
POP R17,R1
BLKINI: ;CODE BLOCK INITIALIZATION
SETZM BYTCNT ;CLEAR BYTE COUNT
SETZM RLDCNT
RETURN ;EXIT
SUBTTL MEMORY MANAGEMENT
GETCOR: ;GET CORE
PUSH R17,R0 ;GET A COULPLE OF WORKING REGISTERS
PUSH R17,R1
HRRO R1,JOBREL ;GET TOP OF CURRENT CORE
MOVEI R0,CORINC(R1) ;COMPUTE NEXT K
CORE R0, ;MAKE A REQUEST
JRST ERRNC ;FORGET IT!
MOVEI R0,1(R1)
SUB R0,SYMBOT ;COMPUTE NUMBER OF ITEMS TO BE MOVED
POP R1,CORINC(R1) ;POP ITEM UP ONE K
SOJG R0,.-1 ;TEST FOR COMPLETION
MOVEI R1,CORINC ;UPDATE POINTERS
ADDM R1,SYMBOT
ADDM R1,SYMPNT
ADDM R1,VALPNT
ADDM R1,SYMTOP
POP R17,R1 ;RESTORE REGISTERS
POP R17,R0
RETURN ;EXIT
SUBTTL SYMBOL TABLE HANDLERS
MSRCH: TLOA R0,MACBIT
SSRCH: ;SYMBOL SEARCH
TLZ R0,MACBIT
CAMN R0,M40DOT ;PC?
JRST SSRCH3 ; YES
MOVE R7,DELTA ;SET OFFSET FOR INDEX
MOVE R2,R7
ASH R2,-1 ;SET INCREMENT
SSRCH1: CAMGE R0,@SYMPNT ;ARE WE LOOKING ABOVE SYMBOL?
JRST SSRCH2 ; YES, MOVE DOWN
CAMG R0,@SYMPNT ;NO, POSSIBLY AT IT?
JRST SSRCH4 ; YES
TDOA R7,R2 ; NO, INCREMENT INDEX
SSRCH2: SUB R7,R2 ;DECREMENT INDEX
ASH R2,-1 ;DECREMENT DELTA
CAMG R7,SYMLEN ;ARE WE OUT OF BOUNDS?
JUMPN R2,SSRCH1 ; NO, BRANCH IF NOT THROUGH
JUMPN R2,SSRCH2 ; YES, MOVE DOWN IF NOT THROUGH
SETZB R1,R2
SOJA R7,CPOPJ ;NOT FOUND, SET INDEX AND EXIT NORMAL
SSRCH3: MOVE R1,R5
TLOA R1,DEFSYM ;SET PC AS DEFINED
SSRCH4: MOVE R1,@VALPNT ;FOUND, FETCH VALUE
LDB R2,TYPPNT ;SET TYPE POINTER
JRST CPOPJ1 ;EXIT +1
INSRT: ;INSERT ITEM IN SYMBOL TABLE
CAMN R0,M40DOT ;PC?
JRST INSRT2 ; YES
CAMN R0,@SYMPNT ;IS IT HERE ALREADY?
JRST INSRT1 ; YES
MOVNI R6,2 ;NO, PREPARE TI INSERT
ADDB R6,SYMBOT ;DECREMENT POINTER TO BOTTOM OF TABLE
CAMG R6,JOBFF ;ARE WE INTRUDING ON THE MACROS?
CALL GETCOR ; YES, GET MORE CORE
MOVE R6,SYMBOT
HRLI R6,2(R6) ;SET UP BLT
BLT R6,@SYMPNT ;MOVE LOWER SYMBOLS DOWN
CALL SRCHI ;RE-INITIALIZE THE POINTERS
ADDI R7,2 ;COMPENSATE FOR SHIFT
MOVEM R0,@SYMPNT ;STORE SYMBOL
INSRT1: MOVEM R1,@VALPNT ;STORE VALUE
RETURN
INSRT2: MOVE R5,R1 ;".", SET PC
AND R5,[PCMASK] ;MAKE SURE ITS CLEAN
RETURN
; RESET CURRENT LOCAL SYMBOL BLOCK DUE TO FINDING
; A LABEL DEFINITION OR .CSECT DIRECTIVE, UNLESS
; .ENABL LSB HAS BEEN ISSUED TO PROLONG CURRENT BLOCK.
LOCRES: TLNE RMODE,LSBFLG ; .ENABL LSB IN EFFECT?
RETURN ; YES - DON'T DO ANYTHING.
AOS LSBLOC ; NO -- INCREMENT BLOCK NUMBER
MOVEI R1,↑D64 ; RESET VALUE OF NEXT LOCAL SYMBOL
MOVEM R1,NEXGS ; TO GENERATE IN A MACRO CALL.
RETURN ; RETURN
CRFDEF: TDZA R3,R3 ;CREF DEFINITION
CRFREF: HRROI R3,-1 ;CREF REFERENCE
TLNN R15,P1F ;IF PASS 1
TLNE R16,CSWBIT!LSTBIT ; OR CREF NOT REQUESTED
RETURN ;EXIT
PUSH R17,R1 ;GET WORKING REGISTERS
PUSH R17,R2
PUSH R17,R4
LDB R2,TYPPNT ;ISOLATE SYMBOL TYPE
MOVSI R1,-CRFLEN ;SET FOR SCAN
CRFRE1: SKIPN CRFNAM(R1) ;EMPTY SLOT?
JRST CRFRE2 ; YES
HRRZ R4,CRFTYP(R1) ;NO, GET TYPE
CAMN R0,CRFNAM(R1) ;TEST NAME
CAME R4,R2 ; AND TYPE
AOBJN R1,CRFRE1 ; NOT A MATCH
JUMPG R1,CRFRE3 ;EXIT IF OUT OF ROOM
CRFRE2: MOVEM R0,CRFNAM(R1) ;STORE NAME
HRRM R2,CRFTYP(R1) ; AND TYPE
CAIN R3, ;DEFINITION?
HRROS CRFTYP(R1) ; YES, SET LEFT HALF
CRFRE3: POP R17,R4 ;RESTORE REGISTERS
POP R17,R2
POP R17,R1
RETURN
CRFLIN: ;OUTPUT CREF LINE INFO
TLNN R15,P1F!EXTFLG ;IF PASS 1
TLNE R16,CSWBIT!LSTBIT ; OR CREF NOT REQUESTED
RETURN ; EXIT
TRZE R16,HDRBIT ;TIME FOR HEADER?
CALL HEADER ; YES
MOVEI R2,RUBOUT ;OK, RUBOUT "B"
CALL LSTDMP
MOVEI R2,"B"
CALL LSTDMP
MOVSI R6,-CRFLEN ;SET FOR SCAN
CRFLI1: SKIPN CRFNAM(R6) ;END?
JRST CRFLI4 ; YES
MOVE R2,CRFTYP(R6) ;NO, GET TYPE
TLNN R2,-1 ;DEFINITION?
SKIPA R2,CRFTBL(R2) ;NO
HLRZ R2,CRFTBL(R2) ;YES, USE LEFT HALF
HRLM R2,0(R17) ;SAVE ON STACK
LDB R2,[POINT 9,0(R17),8] ;GET FIRST CONTROL
CAIE R2, ;SKIP IF NULL
CALL LSTDMP ;OUTPUT IT
MOVE R0,CRFNAM(R6) ;GET THE NAME
CALL M40SIX ;CONVERT TO SIXBIT
PUSH R17,R0 ;SAVE A COPY
MOVEI R2,1 ;SET TO COUNT CHARACTERS
CRFLI2: LSH R0,6 ;SHIFT ONE CHARACTER
CAIE R0, ;ALL FINISHED?
AOJA R2,CRFLI2 ; NO, INCREMENT AND LOOP
CALL LSTDMP ;YES, OUTPUT CHARACTER COUNT
POP R17,R3 ;RETRIEVE THE NAME
CRFLI3: SETZ R2, ;CLEAR HIGH REGISTER
LSHC R2,6 ;SHIFT NEXT CHARACTER IN
ADDI R2,40 ;CONVERT TO ASCII
CALL LSTDMP ;OUTPUT IT
JUMPN R3,CRFLI3 ;LOOP IF MORE TO COME
LDB R2,[POINT 9,0(R17),17] ;FETCH TRAILING CHARACTER
CAIE R2,
CALL LSTDMP ;OUTPUT IF NON-NULL
CRFLI4: SETZM CRFNAM(R6) ;CLEAR NAME
SETZM CRFTYP(R6) ; AND TYPE
AOBJN R6,CRFLI1 ;TEST FOR MORE
MOVEI R2,RUBOUT ;FINISHED, NOW RUBOUT "C"
CALL LSTDMP
MOVEI R2,"C"
JRST LSTDMP ;LIST AND EXIT
CRFTBL:
PHASE 0
BYTE (9) 1, 2, 1, 0
MAOP: BYTE (9) 6, 0, 5, 0
OCOP: BYTE (9) 0, 0, 3, 0
DIOP: BYTE (9) 0, 0, 3, 0
DEPHASE
SRCHI: ;INITIALIZE FOR SEARCH
PUSH R17,R1 ;STACK WORKING REGISTERS
PUSH R17,R2
MOVE R1,SYMTOP ;GET THE TOP LOCATION
SUB R1,SYMBOT ;COMPUTE THE DIFFERENCE
MOVEM R1,SYMLEN ;SAVE IT
MOVEI R2,1 ;SET LOW BIT
LSH R2,1 ;SHIFT OVER ONE
TDZ R1,R2 ;CLEAR CORRESPONDING ONE
JUMPN R1,.-2 ;TEST FOR ALL BITS CLEARED
MOVEM R2,DELTA ;END, SAVE LEADING BIT FOR SEARCH OFFSET
MOVE R1,SYMBOT ;GET THE BASE
HRLI R1,(Z (R7)) ;SET INDEX
MOVEM R1,SYMPNT ;SET SYMBOL POINTER
SUBI R1,1
MOVEM R1,VALPNT ;SET VALUE POINTER
POP R17,R2 ;RESTORE REGISTERS
POP R17,R1
RETURN ;EXIT
SYMTB: ;LIST THE SYMBOL TABLE
SETZ R7, ;INITIALIZE POINTER
TRO R16,HDRBIT ;FLAG NEW PAGE
SYMTB1: MOVEI R6,SPL ;SET "SYMBOLS PER LINE"
HRRZ R0,LSTCTL ; TTY?
TRNE R0,LTTM
MOVEI R6,SPLTTY ; YES, REDUCE
SYMTB2: CALL GETSTE ;GET THE NEXT SYMBOL TABLE ENTRY
JRST SYMTB3 ; END
CALL LSTSTE ;LIST SYMBOL TABLE ENTRY
SOJG R6,SYMTB2 ;TEST FOR MORE ITEMS ON LINE
CALL LSTCR
JRST SYMTB1 ;START NEW LINE
SYMTB3: MOVE R0,M40DOT
MOVE R1,R5 ;PRINT PC
TLO R1,DEFSYM
CALL LSTSTE
CALL LSTCR
CALL LSTCR
MOVE R7,[XWD -↑D<256-2>,2]
SYMTB4: SKIPN SECNAM(R7)
RETURN
MOVE R0,SECNAM(R7)
HLRZ R1,SECBAS(R7)
DPB R7,SUBPNT ;SET SECTOR
TLO R1,LBLSYM ;SUPPRESS "="
CALL LSTSTE
CALL LSTCR
AOBJN R7,SYMTB4
RETURN
GETSTE: ;GET SYMBOL TABLE ENTRY
ADDI R7,2 ;MOVE UP TWO
CAML R7,SYMLEN ;TEST FOR END
RETURN ; YES, EXIT
MOVE R0,@SYMPNT
MOVE R1,@VALPNT
LDB R2,TYPPNT
JUMPN R2,GETSTE ;BYPASS IF OP
JRST CPOPJ1 ;OK, PERFORM SKIP-RETURN
LSTSTE: ;LIST SYMBOL TABLE ENTRY
CALL LSTSYM ;LIST IT
CALL LSTSP
MOVEI R2,"="
TLNE R1,LBLSYM
MOVEI R2,SPACE
CALL LSTOUT
MOVEI R2,"%"
TLNN R1,REGSYM ;REGISTER?
MOVEI R2,SPACE ; NO
CALL LSTOUT
TLNE R1,GLBSYM
TLNE R1,DEFSYM
SKIPA R10,[POINT 3,R1,17]
MOVE R10,[POINT 6,[SIXBIT /******/]]
LSTST1: ILDB R2,R10
CAIG R2,7
TROA R2,"0"
ADDI R2,40
CALL LSTOUT
TLNE R10,760000
JRST LSTST1
LDB R10,SUBPNT
MOVEI R2,SPACE
JUMPL R7,LSTST2
CAIE R10,
MOVEI R2,"R"
LSTST2: CALL LSTOUT
MOVEI R2,SPACE
JUMPL R7,LSTST3
TLNN R1,DEFSYM
MOVEI R2,"U"
TLNE R1,GLBSYM
MOVEI R2,"G"
LSTST3: CALL LSTOUT
CAIG R10,1
JRST LSTTAB
LDB R2,[POINT 3,R10,35-6]
CALL LSTNUM
LDB R2,[POINT 3,R10,35-3]
CALL LSTNUM
LDB R2,[POINT 3,R10,35]
CALL LSTNUM
JRST LSTTAB ;OUTPUT A TAB AND EXIT
; CONVERTS 6 SIXBIT CHARACTERS IN R0 TO 6 RAD50 CHARACTERS
; IN R0 AS 3 CHARCTERS IN A 16 BIT WORD IN EACH HALFWORD.
SIXM40: ;SIXBIT TO MOD40
PUSH R17,R1
PUSH R17,R2
PUSH R17,R3 ;STACK REGISTERS
SETZ R1,
MOVSI R3,(POINT 6,R0)
SIXM41: ILDB R2,R3 ;GET A CHARACTER
HLRZ R2,RADTBL(R2) ;MAP
IMULI R1,50
ADD R1,R2
TLNE R3,770000 ;FINISHED?
JRST SIXM41 ; NO
IDIVI R1,50*50*50 ;YES, SPLIT INTO HALVES
HRLZ R0,R1 ;HIGH ORDER
HRR R0,R2 ; AND LOW ORDER
POP R17,R3 ;RESTORE REGISTERS
POP R17,R2
POP R17,R1
RETURN
; INVERSE OF SIXM40
M40SIX: ;MOD40 TO SIXBIT
PUSH R17,R1
PUSH R17,R2
LDB R1,[POINT 16,R0,17]
IMULI R1,50*50*50 ;MERGE
HRRZS R0
ADD R0,R1
SETZ R2, ;ACCUMULATOR
M40SI1: IDIVI R0,50
HRRZ R1,RADTBL(R1) ;MAP
LSHC R1,-6 ;MOVE INTO COLLECTOR
JUMPN R0,M40SI1 ;TEST FOR END
MOVE R0,R2
POP R17,R2
POP R17,R1
RETURN
RADTBL:
XWD <$==0>, 0
XWD 0, "A"-40
XWD 0, "B"-40
XWD 0, "C"-40
XWD <$$==33>, "D"-40
XWD 0, "E"-40
XWD 0, "F"-40
XWD 0, "G"-40
XWD 0, "H"-40
XWD 0, "I"-40
XWD 0, "J"-40
XWD 0, "K"-40
XWD 0, "L"-40
XWD 0, "M"-40
XWD <$.==34>, "N"-40
XWD 0, "O"-40
XWD <$0==36>, "P"-40
XWD <$1==37>, "Q"-40
XWD <$2==40>, "R"-40
XWD <$3==41>, "S"-40
XWD <$4==42>, "T"-40
XWD <$5==43>, "U"-40
XWD <$6==44>, "V"-40
XWD <$7==45>, "W"-40
XWD <$8==46>, "X"-40
XWD <$9==47>, "Y"-40
XWD 0, "Z"-40
XWD 0, "$"-40
XWD 0, "."-40
XWD 0, 0
XWD 0, "0"-40
XWD 0, "1"-40
XWD 0, "2"-40
XWD <$A==1>, "3"-40
XWD <$B==2>, "4"-40
XWD <$C==3>, "5"-40
XWD <$D==4>, "6"-40
XWD <$E==5>, "7"-40
XWD <$F==6>, "8"-40
XWD <$G==7>, "9"-40
XWD <$H==10>, 0
XWD <$I==11>, 0
XWD <$J==12>, 0
XWD <$K==13>, 0
XWD <$L==14>, 0
XWD <$M==15>, 0
XWD <$N==16>, 0
XWD <$O==17>, 0
XWD <$P==20>, 0
XWD <$Q==21>, 0
XWD <$R==22>, 0
XWD <$S==23>, 0
XWD <$T==24>, 0
XWD <$U==25>, 0
XWD <$V==26>, 0
XWD <$W==27>, 0
XWD <$X==30>, 0
XWD <$Y==31>, 0
XWD <$Z==32>, 0
XWD 0, 0
XWD 0, 0
XWD 0, 0
XWD 0, 0
XWD 0, 0
OSRCH: ;OP TABLE SEARCH
TLZ R0,MACBIT ;CLEAR POSSIBLE MACRO BIT
MOVEI R2,1B↑L<OPTTOP-OPTBOT> ;SET UP OFFSET AND DELTA
MOVEI R1,1B↑L<OPTTOP-OPTBOT>/2
OSRCH1: CAMN R0,OPTBOT-2(R2) ;ARE WE LOOKING AT IT?
JRST OSRCH3 ; YES
CAML R0,OPTBOT-2(R2) ;TEST FOR DIRECTION OF NEXT MOVE
TDOA R2,R1 ;ADD
OSRCH2: SUB R2,R1 ;SUBTRACT
ASH R1,-1 ;HALVE DELTA
JUMPE R1,OSRCH4 ;EXIT IF END
CAILE R2,OPTTOP-OPTBOT ;YES, ARE WE OUTOF BOUNDS?
JRST OSRCH2 ;YES, MOVE DOWN
JRST OSRCH1 ;NO, TRY AGAIN
OSRCH3: MOVE R1,OPTBOT-1(R2) ;FOUND, PLACE VALUE IN R2
LDB R2,TYPPNT
TLNN R15,P1F ;IF PASS 1
CAIE R2,OCOP ; OR PSEUDO-OP
JRST CPOPJ1 ; EXIT
PUSH R17,R1 ;STACK RESULT
MOVSI R2,-8 ;SET FOR EIGHT BITS
TLNE R1,(1B0) ;THIS BIT SET?
AOS OPCCNT(R2) ; YES
LSH R1,1 ;SHIFT BITS
AOBJN R2,.-3 ;TEST FOR END
POP R17,R1 ;YES, RESTORE RESULT
LDB R2,TYPPNT
JRST CPOPJ1
OSRCH4: SETZB R1,R2
RETURN
TYPOFF== ↑D17 ;PACKING PARAMETERS
SUBOFF== ↑D15
MODOFF== ↑D7
BC1== 1
BC2== 2
DEFSYM== 400000 ;DEFINED SYMBOL
LBLSYM== 200000 ;LABEL
REGSYM== 100000 ;REGISTER
GLBSYM== 040000 ;GLOBAL
MDFSYM== 020000 ;MULTIPLY-DEFINED FLAG
TYPPNT: POINT 2,R1,TYPOFF ;TYPE POINTER
SUBPNT: POINT 8,R1,SUBOFF ;SUB-TYPE POINTER
CCSPNT: POINT 8,R5,SUBOFF ;CURRENT CSECT POINTER
MODPNT: POINT 8,R1,MODOFF
MOD20== 400000
MOD40== 200000
MACBIT== 400000
MDMASK== 377B<MODOFF>
PFMASK== 377B<SUBOFF>
ADMASK== 177777
PCMASK== PFMASK!ADMASK
M40DOT: GENM40 .
SUBTTL PREDEFINED SYMBOLS (PROTOTYPE SYMBOL TABLE)
PERMST:
XWD 400000,000000 ; TABLE BOTTOM MARKER
XWD DEFSYM!REGSYM,7 ; PC
GENM40 P,C
XWD DEFSYM!REGSYM,0 ; R0
GENM40 R,0
XWD DEFSYM!REGSYM,1 ; R1
GENM40 R,1
XWD DEFSYM!REGSYM,2 ; R2
GENM40 R,2
XWD DEFSYM!REGSYM,3 ; R3
GENM40 R,3
XWD DEFSYM!REGSYM,4 ; R4
GENM40 R,4
XWD DEFSYM!REGSYM,5 ; R5
GENM40 R,5
XWD DEFSYM!REGSYM,6 ; R6
GENM40 R,6
XWD DEFSYM!REGSYM,7 ; R7
GENM40 R,7
XWD DEFSYM!REGSYM,6 ; SP
GENM40 S,P
XWD DEFSYM,VERSION ; .MACN.
GENM40 .,M,A,C,N,.
XWD 0 ; END-OF-TABLE MARKER
XWD 377777,777777
PSLEN= .-PERMST-1 ; LENGTH OF PREDEFINED SYMBOLS
SUBTTL OP CODE TABLE
DEFINE OPCDEF (A,B,C,D,E,F,MOD,CLASS,VALUE)
<
GENM40 A,B,C,D,E,F
XWD MOD!<CLASS>B33!OCOP,VALUE
>
DEFINE DIRDEF (A,B,C,D,E,F,ADDRESS)
<
GENM40 A,B,C,D,E,F
IFDEF ADDRESS <
XWD DIOP,ADDRESS
>
IFNDEF ADDRESS <
XWD DIOP,NHY
>
>
NHY: TRO R15,ERRQ ;NOT HERE YET
RETURN
OPTBOT: ;OP TABLE BOTTOM
OPCDEF A,B,S,D, , , MOD40, OPCL1, 170600
OPCDEF A,B,S,F, , , MOD40, OPCL1, 170600
OPCDEF A,D,C, , , , MOD20!MOD40, OPCL1, 005500
OPCDEF A,D,C,B, , , MOD20!MOD40, OPCL1, 105500
OPCDEF A,D,D, , , , MOD20!MOD40, OPCL2, 060000
OPCDEF A,D,D,D, , , MOD40, OPCL11, 172000
OPCDEF A,D,D,F, , , MOD40, OPCL11, 172000
OPCDEF A,S,H, , , , MOD40, OPCL9, 072000
OPCDEF A,S,H,C, , , MOD40, OPCL9, 073000
OPCDEF A,S,L, , , , MOD20!MOD40, OPCL1, 006300
OPCDEF A,S,L,B, , , MOD20!MOD40, OPCL1, 106300
OPCDEF A,S,R, , , , MOD20!MOD40, OPCL1, 006200
OPCDEF A,S,R,B, , , MOD20!MOD40, OPCL1, 106200
OPCDEF B,C,C, , , , MOD20!MOD40, OPCL4, 103000
OPCDEF B,C,S, , , , MOD20!MOD40, OPCL4, 103400
OPCDEF B,E,Q, , , , MOD20!MOD40, OPCL4, 001400
OPCDEF B,G,E, , , , MOD20!MOD40, OPCL4, 002000
OPCDEF B,G,T, , , , MOD20!MOD40, OPCL4, 003000
OPCDEF B,H,I, , , , MOD20!MOD40, OPCL4, 101000
OPCDEF B,H,I,S, , , MOD20!MOD40, OPCL4, 103000
OPCDEF B,I,C, , , , MOD20!MOD40, OPCL2, 040000
OPCDEF B,I,C,B, , , MOD20!MOD40, OPCL2, 140000
OPCDEF B,I,S, , , , MOD20!MOD40, OPCL2, 050000
OPCDEF B,I,S,B, , , MOD20!MOD40, OPCL2, 150000
OPCDEF B,I,T, , , , MOD20!MOD40, OPCL2, 030000
OPCDEF B,I,T,B, , , MOD20!MOD40, OPCL2, 130000
OPCDEF B,L,E, , , , MOD20!MOD40, OPCL4, 003400
OPCDEF B,L,O, , , , MOD20!MOD40, OPCL4, 103400
OPCDEF B,L,O,S, , , MOD20!MOD40, OPCL4, 101400
OPCDEF B,L,T, , , , MOD20!MOD40, OPCL4, 002400
OPCDEF B,M,I, , , , MOD20!MOD40, OPCL4, 100400
OPCDEF B,N,E, , , , MOD20!MOD40, OPCL4, 001000
OPCDEF B,P,L, , , , MOD20!MOD40, OPCL4, 100000
OPCDEF B,P,T, , , , MOD20!MOD40, OPCL0, 000003
OPCDEF B,R, , , , , MOD20!MOD40, OPCL4, 000400
OPCDEF B,V,C, , , , MOD20!MOD40, OPCL4, 102000
OPCDEF B,V,S, , , , MOD20!MOD40, OPCL4, 102400
OPCDEF C,C,C, , , , MOD20!MOD40, OPCL0, 000257
OPCDEF C,F,C,C, , , MOD40, OPCL0, 170000
OPCDEF C,L,C, , , , MOD20!MOD40, OPCL0, 000241
OPCDEF C,L,N, , , , MOD20!MOD40, OPCL0, 000250
OPCDEF C,L,R, , , , MOD20!MOD40, OPCL1, 005000
OPCDEF C,L,R,B, , , MOD20!MOD40, OPCL1, 105000
OPCDEF C,L,R,D, , , MOD40, OPCL1, 170400
OPCDEF C,L,R,F, , , MOD40, OPCL1, 170400
OPCDEF C,L,V, , , , MOD20!MOD40, OPCL0, 000242
OPCDEF C,L,Z, , , , MOD20!MOD40, OPCL0, 000244
OPCDEF C,M,P, , , , MOD20!MOD40, OPCL2, 020000
OPCDEF C,M,P,B, , , MOD20!MOD40, OPCL2, 120000
OPCDEF C,M,P,D, , , MOD40, OPCL11, 173400
OPCDEF C,M,P,F, , , MOD40, OPCL11, 173400
OPCDEF C,N,Z, , , , MOD20!MOD40, OPCL0, 000254
OPCDEF C,O,M, , , , MOD20!MOD40, OPCL1, 005100
OPCDEF C,O,M,B, , , MOD20!MOD40, OPCL1, 105100
CMTOP: DIRDEF C,O,M,M,E,N, CMENT ;BO 14-JAN-75
OPCDEF D,E,C, , , , MOD20!MOD40, OPCL1, 005300
OPCDEF D,E,C,B, , , MOD20!MOD40, OPCL1, 105300
OPCDEF D,I,V, , , , MOD40, OPCL7, 071000
OPCDEF D,I,V,D, , , MOD40, OPCL11, 174400
OPCDEF D,I,V,F, , , MOD40, OPCL11, 174400
OPCDEF E,M,T, , , , MOD20!MOD40, OPCL6, 104000
OPCDEF H,A,L,T, , , MOD20!MOD40, OPCL0, 000000
OPCDEF I,N,C, , , , MOD20!MOD40, OPCL1, 005200
OPCDEF I,N,C,B, , , MOD20!MOD40, OPCL1, 105200
OPCDEF I,O,T, , , , MOD20!MOD40, OPCL0, 000004
OPCDEF J,M,P, , , , MOD20!MOD40, OPCL1, 000100
OPCDEF J,S,R, , , , MOD20!MOD40, OPCL5, 004000
OPCDEF L,D,C,D,F, , MOD40, OPCL11, 177400
OPCDEF L,D,C,F,D, , MOD40, OPCL11, 177400
OPCDEF L,D,C,I,D, , MOD40, OPCL14, 177000
OPCDEF L,D,C,I,F, , MOD40, OPCL14, 177000
OPCDEF L,D,C,L,D, , MOD40, OPCL14, 177000
OPCDEF L,D,C,L,F, , MOD40, OPCL14, 177000
OPCDEF L,D,D, , , , MOD40, OPCL11, 172400
OPCDEF L,D,E,X,P, , MOD40, OPCL14, 176400
OPCDEF L,D,F, , , , MOD40, OPCL11, 172400
OPCDEF L,D,F,P,S, , MOD40, OPCL1, 170100
OPCDEF L,D,S,C, , , MOD40, OPCL0, 170004
OPCDEF L,D,U,B, , , MOD40, OPCL0, 170003
OPCDEF M,A,R,K, , , MOD40, OPCL10, 006400
OPCDEF M,F,P,D, , , MOD40, OPCL1, 106500
OPCDEF M,F,P,I, , , MOD40, OPCL1, 006500
OPCDEF M,O,D,D, , , MOD40, OPCL11, 171400
OPCDEF M,O,D,F, , , MOD40, OPCL11, 171400
OPCDEF M,O,V, , , , MOD20!MOD40, OPCL2, 010000
OPCDEF M,O,V,B, , , MOD20!MOD40, OPCL2, 110000
OPCDEF M,T,P,D, , , MOD40, OPCL1, 106600
OPCDEF M,T,P,I, , , MOD40, OPCL1, 006600
OPCDEF M,U,L, , , , MOD40, OPCL7, 070000
OPCDEF M,U,L,D, , , MOD40, OPCL11, 171000
OPCDEF M,U,L,F, , , MOD40, OPCL11, 171000
OPCDEF N,E,G, , , , MOD20!MOD40, OPCL1, 005400
OPCDEF N,E,G,B, , , MOD20!MOD40, OPCL1, 105400
OPCDEF N,E,G,D, , , MOD40, OPCL1, 170700
OPCDEF N,E,G,F, , , MOD40, OPCL1, 170700
OPCDEF N,O,P, , , , MOD20!MOD40, OPCL0, 000240
OPCDEF R,E,S,E,T, , MOD20!MOD40, OPCL0, 000005
OPCDEF R,O,L, , , , MOD20!MOD40, OPCL1, 006100
OPCDEF R,O,L,B, , , MOD20!MOD40, OPCL1, 106100
OPCDEF R,O,R, , , , MOD20!MOD40, OPCL1, 006000
OPCDEF R,O,R,B, , , MOD20!MOD40, OPCL1, 106000
OPCDEF R,T,I, , , , MOD20!MOD40, OPCL0, 000002
OPCDEF R,T,S, , , , MOD20!MOD40, OPCL3, 000200
OPCDEF R,T,T, , , , MOD40, OPCL0, 000006
OPCDEF S,B,C, , , , MOD20!MOD40, OPCL1, 005600
OPCDEF S,B,C,B, , , MOD20!MOD40, OPCL1, 105600
OPCDEF S,C,C, , , , MOD20!MOD40, OPCL0, 000277
OPCDEF S,E,C, , , , MOD20!MOD40, OPCL0, 000261
OPCDEF S,E,N, , , , MOD20!MOD40, OPCL0, 000270
OPCDEF S,E,T,D, , , MOD40, OPCL0, 170011
OPCDEF S,E,T,F, , , MOD40, OPCL0, 170001
OPCDEF S,E,T,I, , , MOD40, OPCL0, 170002
OPCDEF S,E,T,L, , , MOD40, OPCL0, 170012
OPCDEF S,E,V, , , , MOD20!MOD40, OPCL0, 000262
OPCDEF S,E,X, , , , MOD40, OPCL1, 006700
OPCDEF S,E,Z, , , , MOD20!MOD40, OPCL0, 000264
OPCDEF S,O,B, , , , MOD40, OPCL8, 077000
OPCDEF S,P,L, , , , MOD40, OPCL13, 000230
OPCDEF S,T,A,0, , , MOD40, OPCL0, 170005
OPCDEF S,T,B,0, , , MOD40, OPCL0, 170006
OPCDEF S,T,C,D,F, , MOD40, OPCL12, 176000
OPCDEF S,T,C,D,I, , MOD40, OPCL12, 175400
OPCDEF S,T,C,D,L, , MOD40, OPCL12, 175400
OPCDEF S,T,C,F,D, , MOD40, OPCL12, 176000
OPCDEF S,T,C,F,I, , MOD40, OPCL12, 175400
OPCDEF S,T,C,F,L, , MOD40, OPCL12, 175400
OPCDEF S,T,D, , , , MOD40, OPCL12, 174000
OPCDEF S,T,E,X,P, , MOD40, OPCL12, 175000
OPCDEF S,T,F, , , , MOD40, OPCL12, 174000
OPCDEF S,T,F,P,S, , MOD40, OPCL1, 170200
OPCDEF S,T,Q,0, , , MOD40, OPCL0, 170007
OPCDEF S,T,S,T, , , MOD40, OPCL1, 170300
OPCDEF S,U,B, , , , MOD20!MOD40, OPCL2, 160000
OPCDEF S,U,B,D, , , MOD40, OPCL11, 173000
OPCDEF S,U,B,F, , , MOD40, OPCL11, 173000
OPCDEF S,W,A,B, , , MOD20!MOD40, OPCL1, 000300
OPCDEF S,X,T, , , , MOD20!MOD40, OPCL1, 006700
OPCDEF T,R,A,P, , , MOD20!MOD40, OPCL6, 104400
OPCDEF T,S,T, , , , MOD20!MOD40, OPCL1, 005700
OPCDEF T,S,T,B, , , MOD20!MOD40, OPCL1, 105700
OPCDEF T,S,T,D, , , MOD40, OPCL1, 170500
OPCDEF T,S,T,F, , , MOD40, OPCL1, 170500
OPCDEF W,A,I,T, , , MOD20!MOD40, OPCL0, 000001
OPCDEF X,O,R, , , , MOD40, OPCL5, 074000
DIRDEF .,A,B,S, , , ABS0
DIRDEF .,A,S,C,I,I, .ASCII
DIRDEF .,A,S,C,I,Z, .ASCIZ
DIRDEF .,A,S,E,C,T, ASECT
DIRDEF .,B,L,K,B, , .BLKB
DIRDEF .,B,L,K,W, , .BLKW
DIRDEF .,B,Y,T,E, , .BYTE
DIRDEF .,C,S,E,C,T, CSECT
DIRDEF .,D,S,A,B,L, .DSABL
DIRDEF .,E,N,A,B,L, .ENABL
DIRDEF .,E,N,D, , , .END
.ENDCX: DIRDEF .,E,N,D,C, , ENDC0
.ENDMX: DIRDEF .,E,N,D,M, , .ENDM
.ENDRX: DIRDEF .,E,N,D,R, , ENDR0
DIRDEF .,E,O,T, , , .EOT
DIRDEF .,E,R,R,O,R, .ERROR
DIRDEF .,E,V,E,N, , .EVEN
DIRDEF .,F,L,T,2, , .FLT2
DIRDEF .,F,L,T,4, , .FLT4
DIRDEF .,G,L,O,B,L, .GLOBL
DIRDEF .,I,D,E,N,T, .IDENT
.IFX:
DIRDEF .,I,F, , , , .IF
DIRDEF .,I,F,D,F, , .IFDF
DIRDEF .,I,F,E,Q, , IFZ0
.IFFX: DIRDEF .,I,F,F, , , .IFF
DIRDEF .,I,F,G, , , IFG0
DIRDEF .,I,F,G,E, , IFGE0
DIRDEF .,I,F,G,T, , IFG0
DIRDEF .,I,F,L, , , IFL0
DIRDEF .,I,F,L,E, , IFLE0
DIRDEF .,I,F,L,T, , IFL0
DIRDEF .,I,F,N,D,F, .IFNDF
DIRDEF .,I,F,N,E, , IFNZ0
DIRDEF .,I,F,N,Z, , IFNZ0
.IFTX: DIRDEF .,I,F,T, , , .IFT
.IFTFX: DIRDEF .,I,F,T,F, , .IFTF
DIRDEF .,I,F,Z, , , IFZ0
.IFY:
DIRDEF .,I,I,F, , , .IIF
.IRPOP: DIRDEF .,I,R,P, , , .IRP
.IRCOP: DIRDEF .,I,R,P,C, , .IRPC
DIRDEF .,L,I,M,I,T, .LIMIT
DIRDEF .,L,I,S,T, , .LIST
.MACRX: DIRDEF .,M,A,C,R, , DEFIN0
.MACRY: DIRDEF .,M,A,C,R,O, DEFIN0
DIRDEF .,M,C,A,L,L, .MCALL
DIRDEF .,M,E,X,I,T, .MEXIT
DIRDEF .,N,A,R,G, , .NARG
DIRDEF .,N,C,H,R, , .NCHR
DIRDEF .,N,L,I,S,T, .NLIST
DIRDEF .,N,T,Y,P,E, .NTYPE
DIRDEF .,O,D,D, , , .ODD
DIRDEF .,O,P,D,E,F, .OPDEF
DIRDEF .,P,A,G,E, , .PAGE
DIRDEF .,P,D,P,1,0, .PDP10
DIRDEF .,P,R,I,N,T, .PRINT
DIRDEF .,R,A,D,I,X, .RADIX
DIRDEF .,R,A,D,5,0, .RAD50
.REPTX: DIRDEF .,R,E,P,T, , REPEA0
DIRDEF .,R,O,U,N,D, .ROUND
DIRDEF .,S,B,H,E,D, .SBHED
DIRDEF .,S,B,T,T,L, .SBTTL
DIRDEF .,T,I,T,L,E, .TITLE
DIRDEF .,T,R,U,N,C, .TRUNC
DIRDEF .,W,O,R,D, , .WORD
OPTTOP: -1B36 ;OP TABLE TOP
CONDX:
DIRDEF B,,,,,,.IFB
DIRDEF D,F,,,,,.IFDF
DIRDEF D,I,F,,,,.IFDIF
DIRDEF E,Q,,,,,IFZ0
DIRDEF G,,,,,,IFG0
DIRDEF G,E,,,,,IFGE0
DIRDEF G,T,,,,,IFG0
DIRDEF I,D,N,,,,.IFIDN
DIRDEF L,,,,,,IFL0
DIRDEF L,E,,,,,IFLE0
DIRDEF L,T,,,,,IFL0
DIRDEF N,B,,,,,.IFNB
DIRDEF N,D,F,,,,.IFNDF
DIRDEF N,E,,,,,IFNZ0
DIRDEF N,Z,,,,,IFNZ0
DIRDEF Z,,,,,, IFZ0
CONDY:
SUBTTL CHARACTER DISPATCH ROUTINES
C1PNTR: POINT 4,CHJTBL(R14), 3
C2PNTR: POINT 4,CHJTBL(R14), 7
C3PNTR: POINT 4,CHJTBL(R14),11
C4PNTR: POINT 4,CHJTBL(R14),15
C5PNTR: POINT 4,CHJTBL(R14),19
C6PNTR: POINT 4,CHJTBL(R14),23
C7PNTR: POINT 4,CHJTBL(R14),27
C8PNTR: POINT 4,CHJTBL(R14),31
C9PNTR: POINT 4,CHJTBL(R14),35
ANPNTR= C8PNTR
CHJTBL: ;CHARACTER JUMP TABLE (STANFORD MOD BY BO 14-JAN-75)
PHASE 0
IFE STANSW,<
BYTE (4) , , , , ,SCLE,QJNU, , ; NULL
BYTE (4) , , , , ,SCIL, , , ; ILLCHR
BYTE (4) , , , , ,SCEL, , , ; ELLCHR
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
TAB: BYTE (4) , , , , ,SCSE,QJSP,.TAB, ; TAB
LF: BYTE (4) , , , , ,SCLE,QJCR, , ; LF
BYTE (4) , , , , , ,QJVT, , ;
FF: BYTE (4) , , , , ,SCLE,QJCR, , ; FF
CRR: BYTE (4) , , , , ,SCLE,QJCR, , ; CR
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , ,QJNU, , ; EOF
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
>;IFE STANSW
IFN STANSW,<
BYTE (4) , , , , ,SCLE,QJNU, , ; NULL
BYTE (4) , , , , , ,QJPC, , ; ↓
BYTE (4) , , , , , ,QJPC, , ; α
BYTE (4) , , , , , ,QJPC, , ; β
BYTE (4) , , , , , ,QJPC, , ; ∧
BYTE (4) , , , , , ,QJPC, , ; ¬
BYTE (4) , , , , , ,QJPC, , ; ε
BYTE (4) , , , , , ,QJPC, , ; π
BYTE (4) , , , , , ,QJPC, , ; λ
TAB: BYTE (4) , , , , ,SCSE,QJSP,.TAB, ; TAB
LF: BYTE (4) , , , , ,SCLE,QJCR, , ; LF
BYTE (4) , , , , , ,QJVT, , ;
FF: BYTE (4) , , , , ,SCLE,QJCR, , ; FF
CRR: BYTE (4) , , , , ,SCLE,QJCR, , ; CR
BYTE (4) , , , , , ,QJPC, , ; ∞
BYTE (4) , , , , , ,QJPC, , ; ∂
BYTE (4) , , , , , ,QJPC, , ; ⊂
BYTE (4) , , , , , ,QJPC, , ; ⊃
BYTE (4) , , , , , ,QJPC, , ; ∩
BYTE (4) , , , , , ,QJPC, , ; ∪
BYTE (4) , , , , , ,QJPC, , ; ∀
BYTE (4) , , , , , ,QJPC, , ; ∃
BYTE (4) , , , , , ,QJPC, , ; ⊗
BYTE (4) , , , , , ,QJPC, , ; ↔
BYTE (4) , , , , , ,QJPC, , ; _
BYTE (4) , , , , , ,QJPC, , ; →
BYTE (4) , , , , , ,QJPC, , ; ~
BYTE (4) , , , , , ,QJPC, , ; ≠
BYTE (4) , , , , , ,QJPC, , ; ≤
BYTE (4) , , , , , ,QJPC, , ; ≥
BYTE (4) , , , , , ,QJPC, , ; ≡
BYTE (4) , , , , , ,QJPC, , ; ∨
>;IFN STANSW
SPACE: BYTE (4) , , , , ,SCSE,QJSP,.TAB, ; SPACE
BYTE (4) , , ,EXOR, , ,QJPC, , ; !
BYTE (4) , , ,EXTE,TEDQ, ,QJPC, , ; "
BYTE (4) , , , , , ,QJPC, , ; #
BYTE (4) , , ,EXTE, , ,QJPC,.ALP, ; $
BYTE (4) , , ,EXTE,TEPC, ,QJPC, , ; %
BYTE (4) , , ,EXAN, , ,QJPC, , ; &
BYTE (4) , , ,EXTE,TESQ, ,QJPC, , ; '
BYTE (4) , , , , , ,QJPC, , ; (
BYTE (4) , , , , , ,QJPC, , ; )
BYTE (4) , , ,EXMU, , ,QJPC, , ; *
BYTE (4) , , ,EXPL,TEIG, ,QJPC, , ; +
BYTE (4) , , , , ,SCSE,QJPC, , ; ,
BYTE (4) , , ,EXMI,TE2C, ,QJPC, , ; -
BYTE (4) , , ,EXTE, , ,QJPC,.ALP, ; .
BYTE (4) , , ,EXDV, , ,QJPC, , ; /
BYTE (4) , , ,EXTE,TENM, ,QJPC,.NUM, ; 0
BYTE (4) , , ,EXTE,TENM, ,QJPC,.NUM, ; 1
BYTE (4) , , ,EXTE,TENM, ,QJPC,.NUM, ; 2
BYTE (4) , , ,EXTE,TENM, ,QJPC,.NUM, ; 3
BYTE (4) , , ,EXTE,TENM, ,QJPC,.NUM, ; 4
BYTE (4) , , ,EXTE,TENM, ,QJPC,.NUM, ; 5
BYTE (4) , , ,EXTE,TENM, ,QJPC,.NUM, ; 6
BYTE (4) , , ,EXTE,TENM, ,QJPC,.NUM, ; 7
BYTE (4) , , ,EXTE,TENM, ,QJPC,.NUM, ; 8
BYTE (4) , , ,EXTE,TENM, ,QJPC,.NUM, ; 9
BYTE (4) , , , , , ,QJPC, , ; :
BYTE (4) , , , , ,SCSE,QJPC, , ; ;
BYTE (4) , , ,EXTE,TEEX, ,QJPC, , ; <
BYTE (4) , , , , , ,QJPC, , ; =
BYTE (4) , , , , , ,QJPC, , ; >
BYTE (4) , , , , , ,QJPC, , ; ?
BYTE (4) , , , , , ,QJPC, , ; @
BYTE (4) , , ,EXTE,TEHX, ,QJPC,.HEX, ; A
BYTE (4) , , ,EXTE,TEHX, ,QJPC,.HEX,UPARB ; B
BYTE (4) , , ,EXTE,TEHX, ,QJPC,.HEX,UPARC ; C
BYTE (4) , , ,EXTE,TEHX, ,QJPC,.HEX,UPARD ; D
BYTE (4) , , ,EXTE,TEHX, ,QJPC,.HEX, ; E
BYTE (4) , , ,EXTE,TEHX, ,QJPC,.HEX,UPARF ; F
BYTE (4) , , ,EXTE, , ,QJPC,.ALP, ; G
BYTE (4) , , ,EXTE, , ,QJPC,.ALP,UPARH ; H
BYTE (4) , , ,EXTE, , ,QJPC,.ALP, ; I
BYTE (4) , , ,EXTE, , ,QJPC,.ALP, ; J
BYTE (4) , , ,EXTE, , ,QJPC,.ALP, ; K
BYTE (4) , , ,EXTE, , ,QJPC,.ALP, ; L
BYTE (4) , , ,EXTE, , ,QJPC,.ALP, ; M
BYTE (4) , , ,EXTE, , ,QJPC,.ALP, ; N
BYTE (4) , , ,EXTE, , ,QJPC,.ALP,UPARO ; O
BYTE (4) , , ,EXTE, , ,QJPC,.ALP, ; P
BYTE (4) , , ,EXTE, , ,QJPC,.ALP, ; Q
BYTE (4) , , ,EXTE, , ,QJPC,.ALP,UPARR ; R
BYTE (4) , , ,EXTE, , ,QJPC,.ALP, ; S
BYTE (4) , , ,EXTE, , ,QJPC,.ALP, ; T
BYTE (4) , , ,EXTE, , ,QJPC,.ALP, ; U
BYTE (4) , , ,EXTE, , ,QJPC,.ALP, ; V
BYTE (4) , , ,EXTE, , ,QJPC,.ALP, ; W
BYTE (4) , , ,EXTE, , ,QJPC,.ALP, ; X
BYTE (4) , , ,EXTE, , ,QJPC,.ALP, ; Y
BYTE (4) , , ,EXTE, , ,QJPC,.ALP, ; Z
BYTE (4) , , , , , ,QJPC, , ; [
BYTE (4) , , , , , ,QJPC, , ; \
BYTE (4) , , , , , ,QJPC, , ; ]
BYTE (4) , , ,EXTE,TEUP, ,QJPC, , ; ↑
BYTE (4) , , ,EXSH, , ,QJPC, , ; ←
IFE STANSW,<
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , ,SCLC,QJLC, , ;
BYTE (4) , , , , ,SCLC,QJLC, , ;
BYTE (4) , , , , ,SCLC,QJLC, , ;
BYTE (4) , , , , ,SCLC,QJLC, , ;
BYTE (4) , , , , ,SCLC,QJLC, , ;
BYTE (4) , , , , ,SCLC,QJLC, , ;
BYTE (4) , , , , ,SCLC,QJLC, , ;
BYTE (4) , , , , ,SCLC,QJLC, , ;
BYTE (4) , , , , ,SCLC,QJLC, , ;
BYTE (4) , , , , ,SCLC,QJLC, , ;
BYTE (4) , , , , ,SCLC,QJLC, , ;
BYTE (4) , , , , ,SCLC,QJLC, , ;
BYTE (4) , , , , ,SCLC,QJLC, , ;
BYTE (4) , , , , ,SCLC,QJLC, , ;
BYTE (4) , , , , ,SCLC,QJLC, , ;
BYTE (4) , , , , ,SCLC,QJLC, , ;
BYTE (4) , , , , ,SCLC,QJLC, , ;
BYTE (4) , , , , ,SCLC,QJLC, , ;
BYTE (4) , , , , ,SCLC,QJLC, , ;
BYTE (4) , , , , ,SCLC,QJLC, , ;
BYTE (4) , , , , ,SCLC,QJLC, , ;
BYTE (4) , , , , ,SCLC,QJLC, , ;
BYTE (4) , , , , ,SCLC,QJLC, , ;
BYTE (4) , , , , ,SCLC,QJLC, , ;
BYTE (4) , , , , ,SCLC,QJLC, , ;
BYTE (4) , , , , ,SCLC,QJLC, , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
ALTMOD: BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
RUBOUT: BYTE (4) , , , , , ,QJNU, , ;
>;IFE STANSW
IFN STANSW,<
BYTE (4) , , , , , ,QJPC, , ; `
BYTE (4) , , , , ,SCLC,QJLC, , ; a
BYTE (4) , , , , ,SCLC,QJLC, , ; b
BYTE (4) , , , , ,SCLC,QJLC, , ; c
BYTE (4) , , , , ,SCLC,QJLC, , ; d
BYTE (4) , , , , ,SCLC,QJLC, , ; e
BYTE (4) , , , , ,SCLC,QJLC, , ; f
BYTE (4) , , , , ,SCLC,QJLC, , ; g
BYTE (4) , , , , ,SCLC,QJLC, , ; h
BYTE (4) , , , , ,SCLC,QJLC, , ; i
BYTE (4) , , , , ,SCLC,QJLC, , ; j
BYTE (4) , , , , ,SCLC,QJLC, , ; k
BYTE (4) , , , , ,SCLC,QJLC, , ; l
BYTE (4) , , , , ,SCLC,QJLC, , ; m
BYTE (4) , , , , ,SCLC,QJLC, , ; n
BYTE (4) , , , , ,SCLC,QJLC, , ; o
BYTE (4) , , , , ,SCLC,QJLC, , ; p
BYTE (4) , , , , ,SCLC,QJLC, , ; q
BYTE (4) , , , , ,SCLC,QJLC, , ; r
BYTE (4) , , , , ,SCLC,QJLC, , ; s
BYTE (4) , , , , ,SCLC,QJLC, , ; t
BYTE (4) , , , , ,SCLC,QJLC, , ; u
BYTE (4) , , , , ,SCLC,QJLC, , ; v
BYTE (4) , , , , ,SCLC,QJLC, , ; w
BYTE (4) , , , , ,SCLC,QJLC, , ; x
BYTE (4) , , , , ,SCLC,QJLC, , ; y
BYTE (4) , , , , ,SCLC,QJLC, , ; z
BYTE (4) , , , , , ,QJPC, , ; {
BYTE (4) , , , , , ,QJPC, , ; |
ALTMOD: BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , ,QJPC, , ; }
RUBOUT: BYTE (4) , , , , , ,QJNU, , ;
>;IFN STANSW
DEPHASE
LIT
SUBTTL IMPURE AREA
IFNDEF NONREN, <RELOC 0> ;LOW SEG
PDPSTK: BLOCK PDPLEN
CMSEP: BLOCK 1
BZCOR: ;BEGINNING OF CORE TO BE INITIALIZED TO ZERO
.IFFLG: BLOCK 1
SYMPNT: BLOCK 1 ;POINTER TO SYMBOL TABLE MNEMONIC
VALPNT: BLOCK 1 ;POINTER TO SYMBOL TABLE VALUE
SYMBOT: BLOCK 1 ;BASE OF SYMBOL TABLE
SYMTOP: BLOCK 1 ;TOP OF SYMBOL TABLE
SYMLEN: BLOCK 1 ;LENGTH OF SYMBOL TABLE
DELTA: BLOCK 1 ;BINARY SEARCH OFFSET
MWPNTR: BLOCK 1 ;MACRO WRITE POINTER
NEXT: BLOCK 1 ;GARBAGE COLLECTION CHAIN
REPEXP: BLOCK 1 ;REPEAT EXPRESSION
REPPNT: BLOCK 1 ;REPEAT POINTER
REPLVL: BLOCK 1 ;REPEAT LEVEL COUNTER
CONLVL: BLOCK 1 ;CONDITIONAL LEVEL COUNTER
UNSLVL: BLOCK 1 ;UNSATISFIED CONDITIONAL NESTING LEVEL
SYMBEG: BLOCK 1 ;POINTER TO START OF SYMBOL FOR RESCAN PURPOSES
RUNTIM: BLOCK 1 ;RUN TIME
CMDSTR: BLOCK 1 ; COMMAND STRING POINTER
LINBUF: BLOCK CPL3/5+2 ;SOURCE LINE BUFFER
CURADR: BLOCK 1 ;CURRENT DATA BLOCK ADDRESS
BYTCNT: BLOCK 1 ;BYTE COUNT
CHKSUM: BLOCK 1 ;CHECK SUM
DATBLK: BLOCK DATLEN+10 ;DATA BLOCK
RLDBLK: BLOCK RLDLEN+10
RLDCNT: BLOCK 1
RELLVL: BLOCK 1 ;RELOCATION LEVEL
RECLVL: BLOCK 1 ;RECURSION LEVEL
FLTLST: BLOCK 2 ;FOR EXPANDED FLT PNT LISTING
FLTBUF: BLOCK ↑D8 ;DITTO
SEQNUM: BLOCK 1 ;SEQUENCE NUMBER
AC00: BLOCK 1 ;AC EXCHANGE BLOCK
AC01: BLOCK 1
AC02: BLOCK 1
AC03: BLOCK 1
AC04: BLOCK 1
AC05: BLOCK 1
AC06: BLOCK 1
AC07: BLOCK 1
AC10: BLOCK 1
AC11: BLOCK 1
AC12: BLOCK 1
AC13: BLOCK 1
AC14: BLOCK 1
IFE TENEX,<
DATE: BLOCK 1 ;DATE FOR HEADER
MSTIME: BLOCK 1 ;CURRENT TIME IN MILLISECONDS
>
IFN TENEX,<
DATSTR: BLOCK ↑D8 ; DATE & TIME AS ASCIZ STRING
>
PAGNUM: BLOCK 1 ;PAGE NUMBER
ERRCNT: BLOCK 1 ;ERROR COUNT
ARGCNT: BLOCK 1 ; MACRO ARGUMENT COUNTER
CALPNT: BLOCK 1 ;POINTER TO CURRENT MACRO CALL BLOCK
MACLVL: BLOCK 1 ;MACRO NESTING LEVEL
MLSAVE: BLOCK 1 ; MACRO LEVEL SAVED BY .MEXIT
MARMAS: BLOCK 1 ; MACRO ARGUMENT BIT MASK (FOR "?")
ARGLST: BLOCK ↑D65 ; TEMP STORAGE FOR MACRO ARGUMENTS
MACNAM: BLOCK MACNES ; NESTED MACRO DEFINITION NAME TABLE
MCLREP= MACNAM ; SAVED REPEAT LEVEL TABLE
MCLCON: BLOCK MACNES ; SAVED CONDITIONAL LEVEL TABLE
MCLUNS: BLOCK MACNES ; SAVED UNSATISFIED LEVEL TABLE
NEXGS: BLOCK 1 ; NUMERIC VALUE OF NEXT
; MACRO-GENERATED LOCAL SYMBOL
OPCODE: BLOCK 1 ;STORAGE FOR OP CODE
OPCCNT: BLOCK ↑D8
LSBLOC: BLOCK 1 ; LOCAL SYMBOL BLOCK NUMBER
PF0: BLOCK 1
PF1: BLOCK 1
PF2: BLOCK 1
PF3: BLOCK 1
PFT0: BLOCK 1
PFT1: BLOCK 1
CODPNT: BLOCK 1
CODBUF: BLOCK ↑D100
OFFSET: BLOCK 1 ;0 OF 1, FOR CEXT1 OR CEXT2
ADREXT: BLOCK 2
TABCNT: BLOCK 1
COLCNT: BLOCK 1
CRFNAM: BLOCK CRFLEN ;CREF NAME STORAGE
CRFTYP: BLOCK CRFLEN ;CREF TYPE STORAGE
FLTTMP: BLOCK 2 ;FLOATING POINT TEMP
FLTNUM: BLOCK 4 ;FLOATING POINT NUMBERS
FLTLEN: BLOCK 1 ;FLOATING LENGTH
SECBAS: BLOCK ↑D256
SECNAM: BLOCK ↑D256
GLBPNT: BLOCK 1
GLBBUF: BLOCK 40
PRGTTL: BLOCK 1
ENDVEC: BLOCK 1
TMPFIL: BLOCK 2 ;TMPCOR UUO ARGUMENT BLOCK
TTLFLA: BLOCK 1 ;=-1 IF PROGRAM NAME TYPED
JOBFFS: BLOCK 204*NUMBUF ;SOURCE BUFFER
TTISAV: BLOCK 1 ;TTI POINTER SAVE
XESAVE: BLOCK 1 ;FILE NAME STORAGE FOR TTY ERROR MESSAGES
XE: BLOCK 1 ;EXEC LOOKUP BLOCK
XE1: BLOCK 1
XE2: BLOCK 1
XE3: BLOCK 1
BINNAM: BLOCK 2
;BUFFER HEADER BLOCKS
TTIPNT: BLOCK 1
BINBUF: BLOCK 1
BINPNT: BLOCK 1
BINCNT: BLOCK 1
BINPCT: BLOCK 1 ;/P BIN COUNT
LSTBUF: BLOCK 1
LSTPNT: BLOCK 1
LSTBCT: BLOCK 1
SRCBUF: BLOCK 1
SRCPNT: BLOCK 1
SRCCNT: BLOCK 1
LINCNT: BLOCK 1 ;EXEC LINE COUNTER
IFN CMUSW,<
CMUSTR: BLOCK 2 ;STORAGE FOR CMUDEC USERID
CMUCTR: BLOCK 1 ; CONVERSION
CMUPTR: BLOCK 1
>
LSTCNT: BLOCK 1 ;LIST LEVEL COUNT
SUBMSG: BLOCK 30 ;SUBTITLE BUFFER AREA
TTLMSG: BLOCK 30 ; TITLE AREA
SEQ: BLOCK 1 ; LINE SEQUENCE NUMBER (BINARY)
FSEQ: BLOCK 2 ; FORMATTED LINE SEQUENCE NUMBER
LIWORD: BLOCK 1 ; LISTING OVERRIDE FLAGS
ENWORD: BLOCK 1 ; ENABLE OVERRIDE FLAGS
; **** CORE CLEARED BY INITIALIZATION ENDS HERE ****
EZCOR:
LSTCTL: BLOCK 1 ; LISTING CONTROL FLAGS
ENACTL: BLOCK 1
IFN CCLSW,<
CCLFLA: BLOCK 1 ;CCL MODE FLAG, =-1 IF CCL MODE
TMPFLA: BLOCK 1 ;TMPCOR UUO IN PROGRESS FLAG
INDFLA: BLOCK 1 ;INDIRECT FILE IN USE FLAG
JOBFFI: BLOCK 1 ;POINT TO RESTORE JOBFF
CMDBUF: BLOCK 1 ;BUFFER HEADER FOR CMD FILE INPUT
CMDPNT: BLOCK 1 ;BYTE POINTER
CMDCNT: BLOCK 1 ;BYTE COUNT
>
RADVAL: BLOCK 1 ; VALUE OF GLOBAL RADIX
; (GLBRDX CONTAINS FLAGS!)
GLBRDX: BLOCK 1 ;GLOBAL RADIX (SET BY .RADIX)
LOCRDX: BLOCK 1 ;LOCAL RADIX
SYMDEL: BLOCK 1 ; SYMBOL DELIMITER, SAVED BY GETSYM
ARGDEL: BLOCK 1 ; MACRO (.IRP) ARGUMENT DELIMITER
ARGLEN: BLOCK 1 ; LENGTH OF MACRO-TYPE ARGUMENT
ARGSTR: BLOCK ↑D100 ; SPACE FOR ARG AS ASCIZ STRING
SECLEN: BLOCK 1 ; LENGTH OF SECONDARY ARGUMENT
SECSTR: BLOCK ↑D100 ; SPACE FOR SAME
; HERE IS SOME PATCH AREA SPACE.....
PAT:
PATCH: BLOCK ↑D100
IFNDEF NONREN, <RELOC>
END START ;....MACN11