github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-02-16 12:53:06 +00:00
Code Issues Releases Wiki Activity
Files
1a68cec32841aa31915a6b6a9ec9cb0f9bb16589
PDP-10.its/src/gz/macn80.mid
Lars Brinkhoff 57a430d76d MACN80 - Z80 cross assembler.
2018-06-15 18:14:49 +02:00

8598 lines
226 KiB
Plaintext
Executable File
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
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
; 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)
P== 17 ; STACK PTR FOR SUBROUTINE LINKAGE
call=<pushj p,>
return=<popj p,>
CPOPJ1: AOS (P)
CPOPJ: POPJ P,
tyoch==1
lstch==2
binch==3
srcch==4
tmpch==5
tyich==6
define syscal op,args
.call [setz ? sixbit /op/ ? args ((setz))]
termin
define pbout
.iot tyoch,R1
termin
define psout
call psout.
termin
PDPLEN== 256. ; PUSH-DOWN POINTER LENGTH
PDPSTK: block pdplen
JCLBUF: block 50
^C_35
srcmax==20
srctab: block 4*srcmax
TRUE== 1
DEFINE GENM40 A,B,C,D,E,F ;GEN MOD 40
$!A*50*50+$!B*50+$!C,,$!D*50*50+$!E*50+$!F
TERMIN
RADTBL:
; Assignment of symbols for the mod 40 values of special
; characters isn't perfect, since Intel's special characters
; can't be used in PDP-10 labels:
; $$ = mod 40 value corresponding to "?"
; $. = mod 40 value corresponding to "@"
<$==0>,, SPACE-40
0,, "A-40
0,, "B-40
0,, "C-40
0,, "D-40
0,, "E-40
0,, "F-40
0,, "G-40
0,, "H-40
0,, "I-40
0,, "J-40
0,, "K-40
0,, "L-40
35,, "M-40
0,, "N-40
0,, "O-40
<$0==36>,, "P-40
<$1==37>,, "Q-40
<$2==40>,, "R-40
<$3==41>,, "S-40
<$4==42>,, "T-40
<$5==43>,, "U-40
<$6==44>,, "V-40
<$7==45>,, "W-40
<$8==46>,, "X-40
<$9==47>,, "Y-40
0,, "Z-40
0,, "?-40
0,, "@-40
0,, ".-40
0,, "0-40
<$$==33>,, "1-40
<$.==34>,, "2-40
<$A==1>,, "3-40
<$B==2>,, "4-40
<$C==3>,, "5-40
<$D==4>,, "6-40
<$E==5>,, "7-40
<$F==6>,, "8-40
<$G==7>,, "9-40
<$H==10>,, 0
<$I==11>,, 0
<$J==12>,, 0
<$K==13>,, 0
<$L==14>,, 0
<$M==15>,, 0
<$N==16>,, 0
<$O==17>,, 0
<$P==20>,, 0
<$Q==21>,, 0
<$R==22>,, 0
<$S==23>,, 0
<$T==24>,, 0
<$U==25>,, 0
<$V==26>,, 0
<$W==27>,, 0
<$X==30>,, 0
<$Y==31>,, 0
<$Z==32>,, 0
0,, 0
0,, 0
0,, 0
0,, 0
0,, 0
; 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 P,R1
PUSH P,R2
PUSH P,R3 ;STACK REGISTERS
SETZ R1,
MOVSI R3,(440600,,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 P,R3 ;RESTORE REGISTERS
POP P,R2
POP P,R1
RETURN
; INVERSE OF SIXM40
M40SIX: ;MOD40 TO SIXBIT
PUSH P,R1
PUSH P,R2
LDB R1,[222000,,R0]
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 P,R2
POP P,R1
RETURN
; 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- No longer used
IIFBIT== 200000 ; 1- .IIF (NOT .IF!) IN PROGRESS
REQBIT== 400000 ; 1- .REQUIRE in progress
; R16 - RH, Bits used by the assembler
SETBIT== 010000 ; 1- SET (not EQU) being assembled
FFBIT== 020000 ; 1- FORM-FEED SEEN
ASCBIT== 100000 ; 1- This line contains a .ASCIZ or .ASCII and
; binary output is to be suppressed
HDRBIT== 200000 ; 1- TIME FOR NEW LISTING PAGE
SEQBIT== 400000 ; 1- SEQUENCE NUMBER SEEN
; 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
HFKFLG== 000400 ; 1- Half-killed symbol mode enabled
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
Z80FLG== 200000 ; 1- Assemble CP & JP for Z80 (not 8080)
P1F== 400000 ; 1- PASS 1 IN PROGRESS
; ** ALL BITS CORRESPONDING TO .ENABL/.DSABL OPTIONS:
ENAMA1== ABSFLG+AMAFLG+CDRFLG+FPTFLG+GBLFLG+HOVFLG
ENAMA2== LCFLG+LSBFLG+PNCFLG+REGFLG+ISDFLG+HFKFLG+Z80FLG
ENMASK== ENAMA1+ENAMA2
ENDEF== LCFLG+PNCFLG+ABSFLG ; ***** DEFAULT ENABL MODES *****
; R15 - RH
ERRA== 400000 ; 1- OPERAND 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- INVALID NUMERIC DIGIT(S)
ERRZ== 000010 ; 1- MARGINAL INSTRUCTION
ERRP1== 000001
; -------- 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
LSON== 004000 ; SOURCE ORIENTED NUMBERING
LSRC== 010000 ; SOURCE CODE
LSYM== 020000 ; SYMBOL TABLE
LTOC== 040000 ; TABLE OF CONTENTS
LTTM== 100000 ; TELETYPE MODE
LASC== 200000 ; ASCII and ASCIZ output control
LDEF= 777777-LLD-LTTM-LSON ; ***** DEFAULT LIST MODES *****
DEFSYM== 400000 ;DEFINED SYMBOL
LBLSYM== 200000 ;LABEL
SETSYM== 100000 ; SET symbol
GLBSYM== 040000 ;GLOBAL
MDFSYM== 020000 ;MULTIPLY-DEFINED FLAG
HFKSYM== 010000 ; Half killed symbol
MD2SYM== 004000 ; Macro defined on pass 2.
TITLE.: SIXBIT /MACN80/
ASMVER: SIXBIT /V2.02 / ; ---- VERSIONS SHOULD CHANGE ON 1ST EDIT
tsint: loc 42
-tsintl,,tsint
loc tsint
p
0 ? 1_tyich ? 0 ? 0 ? status
tsintl=.-tsint
; Status interrupt routine...
STATUS:
PUSH P,R1
PUSH P,R2
PUSH P,R3 ; Save a few registers
movei R1,tyich
.ityic R1,
jrst stat1
caie R1,^T
jrst stat1
syscal ttyfls,[%clbit,,1 ? %climm,,tyich]
jfcl
HRROI R1,[ ASCIZ /A Pass / ]
call PSOUT. ; Print which pass its on
MOVEI R1,"2 ; Assume pass 2
TLNE R15,P1F ; Is it?
MOVEI R1,"1 ; No - set to pass 1
.iot tyoch,R1
HRROI R1,[ ASCIZ / - File: / ]
call PSOUT.
HRROI R1,SFILNM
call PSOUT.
HRROI R1,[ ASCIZ / Line: / ]
call PSOUT. ; Print line number now
MOVE R1,SEQ ; Get line number
call inout ; Print it
JFCL
.iot tyoch,[^M]
.iot tyoch,[^J]
stat1: POP P,R3 ; Restore registers
POP P,R2
POP P,R1
syscal dismis,[p]
.Lose %LsSys
inout: push p,R2
idivi R1,10.
skipe R1
call inout
addi R2,"0
.iot tyoch,R2
pop p,R2
return
CODLOC: BLOCK 1 ; Address of 1st data byte in CODBUF
CODPNT: BLOCK 1 ; Pointer to last byte in CODBUF
CODBUF: BLOCK 100. ; Binary output buffer
ILOC: BLOCK 1 ; PC at start of instruction
IPNT: BLOCK 1 ; CODPNT at start of instruction
SYMBEG: BLOCK 1 ;POINTER TO START OF SYMBOL FOR RESCAN PURPOSES
STRSYM: BLOCK 1 ; Unprocessed symbol at start of line,
; delimited by space or tab
OPCODE: BLOCK 1 ;STORAGE FOR OP CODE
INSLEN: BLOCK 1 ; Instruction length - 1
LOCRDX: BLOCK 1 ;LOCAL RADIX
STMNJT: ;STATEMENT JUMP TABLE. Indexed by type in OPTAB
OFFSET -.
JRST STMNT2 ;BASIC SYMBOL
MAOP:: JRST CALLM ;MACRO
OCOP:: JRST PROPC ;OP CODE
DIOP:: JRST 0(R1) ;PSEUDO-OP
OFFSET 0
OPFORT: ; Op format table for reg parsing
JFCL ; Type 0: No register operands
CALL OPFOR1 ; Type 1
CALL OPFOR2 ; Type 2
CALL OPFOR3 ; etc.
CALL OPFOR4
CALL OPFOR5
CALL OPFOR6
CALL OPFOR7
JRST Z80PRS ; Type 8: Z80 op code
; (identified by parsing operands)
JRST Z80JP ; Type 9: Z80 jump/call/return family
EXPRJT: ;EXPRESSION JUMP TABLE
OFFSET -.
JRST CPOPJ1 ;NOT AN OP NOR TERM; EXIT
EXTE:: JRST EXPR3 ; Possible logical operator
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)
OFFSET 0
TERMJT: ;TERM JUMP TABLE, indexed from C5PNTR in CHJTBL
OFFSET -.
RETURN ;NULL RETURN
TEIG:: JRST TERPL ; IGNORE (+)
TE2C:: CALL TERM2C ; - (2'S COMPLEMENT)
TEEX:: CALL TERMEX ; ( (EXPRESSION FOLLOWS)
TESQ:: CALL TERMSQ ; '
TEDL:: CALL TERMDL ; $
TENM:: CALL TERMNM ; 0-9
TEHX:: CALL TERMNM ; A-F (IF HEX ENABLED)
OFFSET 0
ILLCHR== 1 ;ILLEGAL CHARACTER SUBSTITUTE
ELLCHR== 2 ;END OF LOGICAL LINE CHARACTER
CHARTB: ;CHARACTER JUMP TABLE
OFFSET -.
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
OFFSET 0
SUBTTL RESERVED REGISTER SYMBOLS FOR Z80 PARSING
RSTAB:
GENM40 B ; Single standard regs:
1,,0 ; B,C,D,E,H,L,A
GENM40 C
1,,1
GENM40 D
1,,2
GENM40 E
1,,3
GENM40 H
1,,4
GENM40 L
1,,5
GENM40 M
1,,6
GENM40 A
1,,7
GENM40 B,C ; Standard register pairs:
2,,0 ; BC, DE, HL, SP, AF
GENM40 D,E
2,,1
GENM40 H,L
2,,2
GENM40 S,P
2,,3
GENM40 A,F
2,,4
GENM40 I ; Special Z80 registers:
3,,0 ; I, IX, IY, R
GENM40 I,X
3,,1
GENM40 I,Y
3,,2
GENM40 R
3,,3
GENM40 P,S,W ; 8080 alias for AF
2,,4
RSSIZE== <.-RSTAB>/2
RITAB: ; Register indirect evaluations
GENM40 H,L ; (HL): Type 4, value 0
4,,0
GENM40 D,E
4,,1
GENM40 B,C
4,,2
GENM40 S,P
4,,3
GENM40 I,X
4,,4
GENM40 I,Y
4,,5
GENM40 C
4,,6
RISIZE== <.-RITAB>/2
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
RADCHR: ; Radix selector codes
"H ; H -- Hexadecimal
"D ; D -- Decimal
"O ; O -- Octal
"Q ; Q -- Octal (not quaternary!)
"B ; B -- Binary
RADTAB: ; Matching radix codes
HEXRDX
DECRDX
OCTRDX
OCTRDX
BINRDX
C1PNTR: 400400,,CHJTBL(R14)
C2PNTR: 340400,,CHJTBL(R14)
C3PNTR: 300400,,CHJTBL(R14)
C4PNTR: 240400,,CHJTBL(R14)
C5PNTR: 200400,,CHJTBL(R14) ;Index into TERMJT
C6PNTR: 140400,,CHJTBL(R14) ;Index into SCHTAB
C7PNTR: 100400,,CHJTBL(R14)
C8PNTR: 040400,,CHJTBL(R14)
C9PNTR: 000400,,CHJTBL(R14)
CHJTBL: ;CHARACTER JUMP TABLE
OFFSET -.
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLE ? QJNU ? 0 ? .BYTE ; NULL
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCIL ? QJPC ? 0 ? .BYTE ; ^A
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCEL ? QJPC ? 0 ? .BYTE ; ^B
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLE ? QJNU ? 0 ? .BYTE ; ^C
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^D
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^E
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^F
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^G
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^H
TAB:: .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCSE ? QJSP ? .TAB ? .BYTE ; TAB
LF:: .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLE ? QJCR ? 0 ? .BYTE ; LF
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJVT ? 0 ? .BYTE ;
FF:: .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLE ? QJCR ? 0 ? .BYTE ; FF
CRR:: .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLE ? QJCR ? 0 ? .BYTE ; CR
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^N
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^O
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^P
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^Q
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^R
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^S
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^T
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^U
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^V
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^W
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^X
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^Y
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^Z
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ESC
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^\
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^]
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^^
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJCR ? 0 ? .BYTE ; EOL
SPACE: .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCSE ? QJSP ? .TAB ? .BYTE ; SPACE
.BYTE 4 ? 0 ? 0 ? 0 ? EXOR ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; !
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; "
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; #
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? TEDL ? 0 ? QJPC ? .DOL ? .BYTE ; $
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; %
.BYTE 4 ? 0 ? 0 ? 0 ? EXAN ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; &
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? TESQ ? 0 ? QJPC ? 0 ? .BYTE ; '
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? TEEX ? 0 ? QJPC ? 0 ? .BYTE ; (
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; )
.BYTE 4 ? 0 ? 0 ? 0 ? EXMU ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; *
.BYTE 4 ? 0 ? 0 ? 0 ? EXPL ? TEIG ? 0 ? QJPC ? 0 ? .BYTE ; +
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCSE ? QJPC ? 0 ? .BYTE ; ?
.BYTE 4 ? 0 ? 0 ? 0 ? EXMI ? TE2C ? 0 ? QJPC ? 0 ? .BYTE ; -
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; .
.BYTE 4 ? 0 ? 0 ? 0 ? EXDV ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; /
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? TENM ? 0 ? QJPC ? .NUM ? .BYTE ; 0
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? TENM ? 0 ? QJPC ? .NUM ? .BYTE ; 1
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? TENM ? 0 ? QJPC ? .NUM ? .BYTE ; 2
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? TENM ? 0 ? QJPC ? .NUM ? .BYTE ; 3
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? TENM ? 0 ? QJPC ? .NUM ? .BYTE ; 4
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? TENM ? 0 ? QJPC ? .NUM ? .BYTE ; 5
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? TENM ? 0 ? QJPC ? .NUM ? .BYTE ; 6
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? TENM ? 0 ? QJPC ? .NUM ? .BYTE ; 7
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? TENM ? 0 ? QJPC ? .NUM ? .BYTE ; 8
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? TENM ? 0 ? QJPC ? .NUM ? .BYTE ; 9
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; :
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCSE ? QJPC ? 0 ? .BYTE ; ;
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; <
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; =
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; >
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; ?
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; @
.BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? TEHX ? 0 ? QJPC ? .HEX ? .BYTE ; A
.BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? TEHX ? 0 ? QJPC ? .HEX ? .BYTE ; B
.BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? TEHX ? 0 ? QJPC ? .HEX ? .BYTE ; C
.BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? TEHX ? 0 ? QJPC ? .HEX ? .BYTE ; D
.BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? TEHX ? 0 ? QJPC ? .HEX ? .BYTE ; E
.BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? TEHX ? 0 ? QJPC ? .HEX ? .BYTE ; F
.BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; G
.BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; H
.BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; I
.BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; J
.BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; K
.BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; L
.BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; M
.BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; N
.BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; O
.BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; P
.BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; Q
.BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; R
.BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; S
.BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; T
.BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; U
.BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; V
.BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; W
.BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; X
.BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; Y
.BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; Z
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; [
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; \
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ]
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^
.BYTE 4 ? 0 ? 0 ? 0 ? EXSH ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; _
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; `
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; a
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; b
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; c
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; d
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; e
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; f
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; g
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; h
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; i
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; j
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; k
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; l
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; m
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; n
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; o
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; p
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; q
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; r
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; s
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; t
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; u
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; v
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; w
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; x
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; y
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; z
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; {
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; |
ALTMOD: .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; }
.BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ~
RUBOUT: .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJNU ? 0 ? .BYTE ;
OFFSET 0
GETSYT: ;GETSYM TABLE
OFFSET -.
JRST GETSY2 ;NON-ALPHA/NUMERIC
.TAB: JRST GETSY2 ;BLANK
.DOL: JRST GETSY2 ;Dollar sign
.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
OFFSET 0
SCHTAB: ;GETCHR table, indexed by C6PNTR from CHJTBL
OFFSET -.
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
OFFSET 0
GETLTS: ;Local symbol parse table
JRST GETLNS ; NON ALPHA-NUMERIC
JRST GETLNS ; BLANK OR TAB
JRST GETLDO ; Dollar sign
JRST GETLNS ; ALPHABETIC
JFCL ; NUMERIC
JRST GETLNS ; A-F
; Z80 jump conditions:
ZJCTAB: GENM40 N,Z ; NZ -- Nonzero
GENM40 Z ; Z -- Zero
GENM40 N,C ; NC -- No carry
GENM40 C ; C -- Carry
GENM40 P,O ; PO -- Parity odd
GENM40 P,E ; PE -- Parity even
GENM40 P ; P -- Plus
GENM40 M ; M -- Minus
DEFINE ARG A,B,C,VALUE ; ARG TABLE GENERATOR
VALUE,,$!A*50*50+$!B*50+$!C
TERMIN
LISTBL: -<LISTBX-LISTBL>,,.+1 ; -<# args>,<1st arg addr>
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,O,N,LSON
ARG S,R,C,LSRC
ARG S,Y,M,LSYM
ARG T,O,C,LTOC
ARG T,T,M,LTTM
ARG A,S,C,LASC
LISTBX=.
ENATBL: -<ENAEND-ENATBL>,,.+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 .,5,K,HFKFLG
ARG H,O,V,HOVFLG
ARG I,S,D,ISDFLG
ARG L,C,,LCFLG
ARG L,S,B,LSBFLG
ARG P,N,C,PNCFLG
ARG R,E,G,REGFLG
ARG Z,8,0,Z80FLG
ENAEND=.
M40NOT: GENM40 N,O,T
M40AND: GENM40 A,N,D
M40OR: GENM40 O,R
M40XOR: GENM40 X,O,R
M40MOD: GENM40 M,O,D
M40SHL: GENM40 S,H,L
M40SHR: GENM40 S,H,R
PSIXTP==cpopj
RFN"A==R1 ;terminator char, current char in RSIXTP
RFN"B==R2 ;Filename block, preserved
RFN"E==R3 ;flags
RFN"C==R13 ;preserved
RFN"D==R14 ;bp
fblk: block 4 ;A filename block
$$RFN==1
$$SWITCH==1
$$PFN==1
.insrt syseng;rfn
jclflg: block 1
rsixtp: skipn jclflg
return ;jclflg=0, no terminators
caie r1,"/
cain r1,",
jrst cpopj1
caie r1,"=
cain r1,"_
skipg jclflg ;jclflg=-1, only comma & switch
return
jrst cpopj1 ;jclflg=1, comma & switch & _=
SUBTTL ASSEMBLER PROPER
RUNTIM: BLOCK 1 ;RUN TIME
datstr: block 5 ;HH:MM:SS MM/DD/YY
datout: move r5,[440600,,r2]
ildb r6,r5 ? addi r6,40 ? idpb r6,r4
ildb r6,r5 ? addi r6,40 ? idpb r6,r4
idpb r3,r4
ildb r6,r5 ? addi r6,40 ? idpb r6,r4
ildb r6,r5 ? addi r6,40 ? idpb r6,r4
idpb r3,r4
ildb r6,r5 ? addi r6,40 ? idpb r6,r4
ildb r6,r5 ? addi r6,40 ? idpb r6,r4
return
SEXTS: sixbit/>/ ;We search this *backward*
sixbit/M8/
sixbit/M80/
sixbit/Z8/
sextsb: sixbit/Z80/
SWITCH: cain r1,"L ;/L means make a listing
jrst [tlz r16,lstbit
return]
cain r1,"S ;/S means syntax only (no binary)
jrst [tlo r16,binbit
return]
move r10,r1
hrroi r1,[asciz\AIllegal switch:/\] ? psout
move r1,r10
pbout
hrroi r1,[asciz/./]
jrst errout
MACN80:
MOVE P,[-PDPLEN,,PDPSTK-1] ; INIT STACK POINTER.
syscal open,[%clbit,,.uao\%tjdis ? %climm,,tyoch ? [sixbit/TTY/]]
.Lose %LsFil
syscal open,[%clbit,,.uai ? %climm,,tyich ? [sixbit/TTY/]]
.Lose %LsFil
MOVE R1,[-RQSTKL,,REQSTK-1] ; Get .REQUIRE stack pointer
MOVEM R1,REQSP ; and reset it
CALL SRCHI ; INITIALIZE SYMBOL TABLE.
MOVSI R16,BINBIT\LSTBIT\CSWBIT ; INIT FLAGS IN R16 LH.
SETZB R15,R5 ; Clear byte count and flag register
.break 12,[..rjcl,,Jclbuf] ;Get JCL
skipn Jclbuf
jrst NoJCL
ldb R1,[350700,,Jclbuf]
cain R1,"?
jrst Help
tlz R16,BINBIT ;Assume wants binary
move r14,[440700,,jclbuf]
movei r1,2 ;JCLFLG positive to accept backarrow
movem r1,jclflg
jcl: movei r2,srctab
jcl0: call rfn"rfn
movsi r4,'DSK ;If SNAME is given, device always
tlne r3,1_rfn"snm ;defaults back to DSK
tlne r3,1_rfn"dev
skipa
movem r4,0(r2)
tlnn r3,1_rfn"fn2 ;Do not default type (except by ^Y)
setzm 2(r2)
caie r1,"_
cain r1,"=
jrst [move r1,[srctab,,binblk] ;Move filename to BINBLK
blt r1,binblk+3
sos r1,jclflg
setom jclflg
jumpg r1,jcl ;Had just binfile=. Go on...
tlz r16,lstbit ;Else had a listing file
move r1,[srctab+4,,lstblk]
blt r1,lstblk+3
move r1,[lstblk,,srctab] ;Make it the default for 1st src
blt r1,srctab+3
jrst jcl]
move r3,r2
hrl r3,r3
addi r3,4
movei r2,(r3) ;Advance pointer
caie r1,",
jrst jclend ;All done
sosn jclflg
setom jclflg
blt r3,3(r2) ;Default next file from this one
caige r2,srctab+4*srcmax
jrst jcl0
hrroi r1,[asciz/AToo many source files/]
Errout: psout
.logout 1,
jclend: setzm jclflg
caie r1,^M
cain r1,^C
jrst FINI
hrroi r1,[asciz/AIllegal character in JCL/]
jrst errout
FINI: movsi r1,'DSK ;Default source files
skipn srctab+0
movem r1,srctab+0
skipn srctab+3
.suset [.rhsname,,srctab+3]
movei r3,srctab
fini1: skipn 1(r3)
jrst [hrroi r1,[asciz/ANo file name?/] ? jrst errout]
move r4,[sextsb-sexts,,sextsb]
skipe 2(r3)
tloa r4,-1 ;Already have type
fini2: pop r4,2(r3)
syscal open,[%clbit,,.uai ? %climm,,tmpch
0(r3) ? 1(r3) ? 2(r3) ? 3(r3)]
jrst [jumpge r4,fini2
move r2,r3 ? move r14,[440700,,sfilnm] ? call rfn"pfn
setz r1,
idpb r1,r14
hrroi r1,[asciz/AFile /] ? psout
hrroi r1,sfilnm ? psout
hrroi r1,[asciz/ not found./] ? jrst errout]
.close tmpch,
movei r3,4(r3) ;Next file
cail r3,(r2)
jrst fini3
move r1,-4(r3)
skipn 0(r3)
movem r1,0(r3)
move r1,-1(r3)
skipn 3(r3)
movem r1,3(r3)
jrst fini1
fini3: setzm (r2) ;Mark end of source files
move r1,srctab+0 ;Default listing file
skipn lstblk+0
movem r1,lstblk+0
move r1,srctab+3
skipn lstblk+3
movem r1,lstblk+3
move r1,srctab+1
skipn lstblk+1
movem r1,lstblk+1
movsi r1,'LST
skipn lstblk+2
movem r1,lstblk+2
MOVE R1,[440700,,LSTBUF] ; Get original output line pointer
MOVEM R1,LINPTR ; Set it
MOVEI R1,LSTBFL ;full count [ECL2]
MOVEM R1,LSTBFC ; set count [ECL2]
;; GJINF ; Get job info (controlling terminal #)
;; MOVE R1,LSTJFN ; Now get listing JFN
;; DVCHR ; Get device characteristics
;; HLRZ R2,R1 ; Get device designator
;; ANDI R2,777 ; Mask off device bits to get type #
;; CAIE R2,12 ; Terminal?
;; JRST .+3 ; No - skip this
;; CAIN R4,(R1) ; Units numbers match?
;; TLO R16,TTYBIT ; Yes - set TTY bit
call lptini
move r1,lstblk+0 ;Default binary file
skipn binblk+0
movem r1,binblk
move r1,lstblk+3
skipn binblk+3
movem r1,binblk+3
move r1,lstblk+1
skipn binblk+1
movem r1,binblk+1
movsi r1,'BIN
skipn binblk+2
movem r1,binblk+2
TLO R15,P1F ; Set for pass 1
MOVEi R1,SRCTAB ; Get back first JFN
movem r1,srcipt ;Save position in source list
CALL SFINIT ; Init it and open it
.suset [-2,,[.soption,,[optint,,] ;Enable ^T interrupts
.smsk2,,[1_tyich]]]
syscal ttyset,[%climm,,tyich ? [212020,,202020] ? [202020,,202020]]
.Lose %LsSys
TLNE R16,LSTBIT ; Have a listing file to open?
JRST ALLWEL ; No - skip OPENF
syscal open,[%clbit,,.uao ? %climm,,lstch
lstblk+0 ? lstblk+1 ? lstblk+2 ? lstblk+3]
.Lose %LsFil
ALLWEL:
.rdtime R1, ; GET TIME AT START OF ASSEMBLY.
MOVEM R1,RUNTIM ; SAVE FOR STATISTICS OUTPUT.
.rdatim R1, ;Sixbit time and date
move r4,[440700,,datstr]
rot r2,12. ;Put month first
movei R3,"/
call datout
move r2,r1
movei r3,40
idpb r3,r4
movei r3,":
call datout
setz r3,
idpb r3,r4
CALL ACEXCH ;SAVE EXEC AC'S
ASSEMB: ;ASSEMBLER PROPER
TLO R15,P1F ;SET FOR PASS 1
MOVE R3,[GENM40 .,M,A,I,N,.
]
MOVEM R3,PRGTTL ;INIT TITLE
CALL INIPAS ;INITIALIZE PASS ONE
CALL LINE ;GO DO PASS ONE.
CALL SETBIN ;SET BINARY (OBJ OR BIN)
TLZ R15,P1F ;RESET TO PASS 2
TRO R16,HDRBIT ; FORCE PAGE SKIP AFTER TOC.
;;RESET INPUT COMMAND STRING
CALL ACEXCH ; Get EXEC's ACs
;; TRZ R16,ENDBIT\FFBIT ; Clear a couple of bits
trz r16,ffbit
MOVEi R1,SRCTAB ; Get first file JFN
movem r1,srcipt
setzm srcjfn
CALL SFINIT ; Init the first file
CALL ACEXCH
CALL INIPAS
trze r16,errbit ;Somehow this seems to get turned on
.value
CALL LINE ;CALL THE ASSEMBLER (PASS TWO)
MOVE R0,LSTCTL ; Load listing control flags.
TLNE R16,LSTBIT ;LISTING?
TRNE R0,LSYM ; SYM TAB BIT SET?
CALL SYMTB ; YES - LIST SYMBOL TABLE.
CALL LSTCR ;SKIP ONE LINE
CALL ACEXCH ;SWAP AC'S
START2: PUSH P,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 ; Insure that summaries will list.
CALL LSTCR ;SKIP A LINE
MOVEI R2,"? ;ASSUME ERROR
SKIPE R11,ERRCNT ;TEST ERRORS, LOAD R11
CALL LSTOUT
MOVEI R10,[ASCIZ / Errors detected: %/]
CALL LSTMCR
CALL LSTCR
MOVE R10,[440700,,[ASCIZ / */]]
CALL LSTASC
MOVEi R10,jclbuf
CALL LSTASC ;PRINT OUT COMMAND STRING
POP P,R0
.rdtime R1,
SUB R1,RUNTIM ; Now get difference
MOVE R11,R1 ; Load it into right register
IDIVi R11,30. ; Convert to seconds
MOVEI R10,[ASCIZ / Run-time: % seconds/]
CALL LSTMCR
CALL LSTCR
;; JRST EXIT ; CLOSE OUT
;;EXIT:
.close lstch,
tlnn r16,binbit
call bincls
move r2,srcipt
addi r2,4
hrroi r1,[asciz/AToo many source files./]
skipe (r2) ; Test if any more files
psout
.logout 1,
INIPAS:
CALL CODRES ; Reset binary output info.
SETZM CURSUM ; Initial codes segment checksum = 0
MOVEI R0,DECRDX ;SET DEFAULT GLOBAL RADIX TO DECIMAL
MOVEM R0,GLBRDX
MOVEI R0,10.
MOVEM R0,RADVAL
SETZM LSTCNT ; Reset .list/.nlist level.
HRLZI R0,LDEF ; SET DEFAULT LISTING MODES.
MOVEM R0,LSTCTL
CALL SETLF
HRLZI R0,ENDEF ; SET DEFAULT .ENABL MODES.
LDB R1,[360600,,srctab+2] ; Check 1st byte of 1st src extension.
CAIN R1,'Z ; Is it "Z"?
TLO R0,Z80FLG ; Yes - Default to Z80 mode.
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 r5,(1_<35.-suboff>)
MOVEI R0,64. ; INITIAL VALUE FOR NEXT
MOVEM R0,NEXGS ; MACRO-GENERATED LOCAL = 64.
SETZM PAGNUM ; Initialize page number
SETZM SEQ ; SET LINE SEQ # = 0.
SETZM LSBLOC ; LOCAL SYMBOL BLOCK # = 0.
SETZM REPLVL
SETZM REQCNT ; Init require index
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
NoJcl:
Help: hrroi r1,[asciz\A:macn80 [[binary file][,list file] =] [srcfile,...]
(where at least one file must be specified). Also recognizes flags:
/L - make a listing file (default when a list file is specified).
/S - do not make a binary file
Filenames default from each other all around. Default binary type is BIN.
Default listing type is LST. Default source type is Z80, but it searches for
other stuff (Z8, M80, M8 and finally >) if there is no Z80.\]
psout
.logout 1,
STMNT: ;STATEMENT PROCESSOR
;On startup, RLOC (R5) has PC, CONPNT has code buffer pointer
MOVEM RLOC,ILOC ; Record PC @ start of line
MOVE R0,CODPNT ; and CODPNT for use
MOVEM R0,IPNT ; in listing generated code.
SETZM STRSYM ;Presume no symbol at start of line.
STMNT0: CALL GETSYM ;TRY FOR SYMBOL
RETURN ; No symbol: Must be blank line or comment.
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 ; Not op: Presume label for EQU, etc.
JRST STMNT3 ; Op: Bypass reference recording.
STMNT1: TLNE RMODE,P1F ; Which pass is this?
JRST STM1A ; Pass 1: Must be macro call.
TLNN R1,MD2SYM ; Pass 2: Defined on this pass?
JRST STMNT2 ; No -- Must be macro definition
; Yes - Macro call.
STM1A: PUSH P,R1
TLNE R0,MACBIT ;SPECIAL TEST FOR OPDEFS
MOVSI R1,MAOP ; SET TO MACRO
CALL CRFREF ;CREF IT
POP P,R1 ;RETRIEVE VALUE/TYPE
LDB R2,TYPPNT ;RESTORE TYPE
STMNT3: XCT STMNJT(R2) ;EXECUTE TABLE
; Found symbol at start of line not followed by ":" or "=",
; and not a macro name or op code.
; 1. If such a symbol has already been encountered flag
; questionable syntax; the previous symbol will be ignored.
; 2. Save the symbol (in mod40 format) in STRSYM, for later
; processing by EQU or SET directives.
; 3. If the symbol is delimited by any character other than
; blank or tab flag questionable syntax.
; 4. Return to STMNT0 to process next symbol, hopefully an op code.
STMNT2: SKIPE STRSYM ; Starting symbol already defined?
TRO RERR,ERRQ ; Yes - Note questionable syntax.
MOVEM R0,STRSYM ; Save symbol for later reference.
MOVE R1,SYMDEL
CAIE R1,SPACE ; Is symbol's delimiter
CAIN R1,TAB ; blank or tab?
JRST STMNT0 ; Yes - Try to parse op code.
TRO RERR,ERRQ ; No -- Mark crummy syntax first.
JRST STMNT0
SYMPNT: BLOCK 1 ; Pointer to symbol mnemonic, rad50 fmt
VALPNT: BLOCK 1 ; Pointer to symbol value & attributes
CR1PNT: BLOCK 1 ; Pointer to symbol's 1st cross ref word
CR2PNT: BLOCK 1 ; Pointer to symbol's 2nd cross ref word
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
CALL SSRCH ;SEARCH THE SYMBOL TABLE
JRST LABEL1 ; NOT THERE
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
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: CALL INSRT ; Set name & value in symbol table.
TLNN R1,MDFSYM ; Is label multiply defined?
JRST LABEL5 ; No -- Set normal definition entry.
SETZ R0, ; Yes - Don't change cross-ref def.
TROA RERR,ERRM ; & flag multiple definition.
LABEL5: MOVE R0,SEQ ; Set line number of definition
HRLM R0,@CR1PNT ; in cross ref info.
TLNN R15,P1F ; Which pass is this?
JRST STMNT ; Pass 2 - Process rest of line.
; Pass 1 - Check for unresolved
; forward JRPs.
SKIPG FJLIST ; Is forward JRP list empty?
JRST STMNT ; Yes - Process rest of line.
; No -- . . .
; Check for action required to resolve forward JRPs.
; This label could be one addressed by a preceding JRP.
; First, purge the forward JRP list of entries whose
; instruction end addresses are more than 127 bytes
; ahead of the current location. This commits these
; JRPs to remain as JP's, rather than being translated
; to JR's.
FJ1P: HRRZ R1,RLOC ; Set r1 to offset of 1st JRP's
SUB R1,FJLIST+2 ; instruction end address from .
TRNN R1,777400 ; Is offset > 127?
JRST FJCHEK ; No -- Check for JRP resolution.
; Yes - . . .
; Purge first entry from forward JRP list.
SOSE R1,FJLIST ; Decrement entry count.
JRST FJ1PD ; > 0: Shuffle list entries.
SETZM CONSYM ; = 0: Clear CONSYM & quit.
JRST STMNT
FJ1PD: LSH R1,1 ; Convert entry count to index.
MOVE R2,[FJLIST+3,,FJLIST+1] ; Shuffle entire list forward
BLT R2,FJLIST(R1) ; over (deleted) first entry.
; Clean up CONSYM list to delete entries which would only
; be useful for the FJLIST entry just deleted. These entries
; represent labels with addresses less than the instruction
; end address in the new first entry in FJLIST.
PCS1: SKIPN CONSYM ; Is CONSYM already empty?
JRST FJ1P ; Yes - Check next FJLIST entry.
; No -- Check 1st CONSYM entry.
HLRZ R0,CONSYM+1 ; Get address of 1st symbol in list.
CAML R0,FJLIST+2 ; Is it below next JRP end address?
JRST FJ1P ; No -- Quit CONSYM cleanup.
; Yes - . . .
; Delete first entry in CONSYM list.
SOS R1,CONSYM ; Decrement list's entry count.
MOVE R2,[CONSYM+2,,CONSYM+1] ; Set up for block transfer.
BLT R2,CONSYM+1(R1) ; Copy entry n+1 over entry n for all
; entries in list.
JRST PCS1 ; Check new 1st entry in CONSYM.
; Check to see if this label definition allows taking
; some appropriate action to resolve conditional address
; assignments for a forward JRP. This processing uses
; the following logic:
; Case 1: New label matches first entry in FJLIST . . .
; 1. If label's offset from JRP is less than 128 bytes,
; then decrement the conditional addresses of all
; labels between the JRP and the current address.
; 2. Delete the first FJLIST entry (describing the
; resolved JRP).
; 3. CONSYM cleanup:
; a. If FJLIST is now empty, clear CONSYM and quit;
; b. Else:
; 1. Delete CONSYM entries whose addresses are less
; than the instruction end address in the new
; first entry in FJLIST.
; 2. Repeat resolution processing from the beginning
; (case identification).
; Case 2: New label matches entry in FJLIST other than 1st entry . . .
; 1. If label's offset from JRP is less than 128 bytes,
; then decrement the conditional addresses of all
; labels between the JRP and the current address.
; 2. Delete the FJLIST entry for the resolved JRP.
; 3. Repeat resolution processing from the beginning
; (case identification).
; Case 3: New label doesn't match any entry in FJLIST . . .
; Append an entry to CONSYM for the new label and quit.
; In this description "quit" means assemble the rest of the line.
; Resolution processing iterates until it quits in one of two ways:
; - In case 1, the last forward JRP was resolved.
; - In case 3, at least one unresolved forward JRP remains
; but the label being defined is not the destination
; of any forward JRP.
; Search FJLIST for JRP's to the label defined on this line
; and identify which of the three cases of resolution processing
; this is.
FJCHEK: MOVE R0,@SYMPNT ; Get the label in mod40 format.
CAMN R0,FJLIST+1 ; Does 1st FJLIST entry match label?
JRST FJC1 ; Yes - Case 1.
; No -- Scan FJLIST.
MOVE R1,FJLIST ; R1 = # of entries to scan.
MOVEI R2,FJLIST+1 ; R2 = address of 1st entry.
FJCSCN: CAMN R0,0(R2) ; Is JRP operand this label?
JRST FJC2 ; Yes - Case 2.
ADDI R2,2 ; No -- Check next entry.
SOJG R1,FJCSCN
; Case 3: No JRP destination matches this label.
; The which was just defined has a conditional value,
; pending resolution of at least one previous forward JRP.
; Append an entry to CONSYM for this label.
MOVE R1,CONSYM ; Get CONSYM's entry count.
CAIL R1,64. ; Is there room for another entry?
0 ; %%%% temp %%%% - no!
AOS R1,CONSYM ; Yes - Increment entry count.
MOVEI R0,@VALPNT ; Prepare entry: pointer to symtab
HRL R0,RLOC ; value word in RH, value in LH.
MOVEM R0,CONSYM(R1) ; Store new entry at end of list.
JRST STMNT ; Process rest of line.
; Case 2: R2 points to FJLIST entry for a JRP resolved
; by this label definition.
FJC2: CALL FADDUP ; Update conditional addresses
; if JRP will generate JR.
; Delete the FJLIST entry for the JRP just resolved.
HRLZI R1,2(R2) ; Set up regs for a block transfer
HRR R1,R2 ; to copy end of list forward
SOS R2,FJLIST ; over the entry being deleted.
LSH R2,1 ; (. . . and decrement entry count)
BLT R1,FJLIST(R2)
JRST FJCHEK ; Repeat resolution processing
; in case more than 1 JRP is
; resolved by this label.
; Case 1: New label resolves 1st JRP in FJLIST.
; Start by updating conditional addresses if necessary.
FJC1: MOVEI R2,FJLIST+1 ; Point to resolved FJLIST entry.
CALL FADDUP ; Update conditional addresses if
; JRP will become JR.
; Delete the first (resolved) FJLIST entry.
SOSE R1,FJLIST ; Decrement FJLIST entry count.
JRST FJC1A ; .. More left: Update lists.
; .. FJLIST emptied: . . .
; The entry being deleted was for the last unresolved
; forward JRP. Leave FJLIST clear, clear CONSYM, and
; quit.
SETZM CONSYM ; Clear conditional symbol list.
JRST STMNT ; Process rest of line.
; Entry being deleted isn't the only one . . .
FJC1A: LSH R1,1 ; Set index to locate last entry.
MOVE R2,[FJLIST+3,,FJLIST+1] ; Use block transfer to copy
BLT R2,FJLIST(R1) ; entire end of list over 1st entry.
; Delete CONSYM entries for symbols which precede the first
; remaining unresolved forward JRP.
FJC1D: SKIPN CONSYM ; Is CONSYM list already empty?
JRST FJCHEK ; Yes - Iterate again.
; No -- Check 1st entry.
HLRZ R0,CONSYM+1 ; Get addr from 1st CONSYM entry.
CAML R0,FJLIST+2 ; Is it below 1st unresolved JRP?
JRST FJCHEK ; No -- Iterate again.
; Yes - Delete this entry.
SOS R1,CONSYM ; Decrement entry count.
MOVE R2,[CONSYM+2,,CONSYM+1] ; Copy all entries forward
BLT R2,CONSYM+1(R1) ; except the first.
JRST FJC1D ; Check new 1st entry.
; Forward JRP list:
; Location FJLIST contains the number of entries currently in the list;
; Entries begin at FJLIST+1.
; Entry format:
; +0 JRP destination symbol in mod40 format
; +1 JRP instruction end address (opcode address + 2)
FJLIST: BLOCK 65.
; Conditionally defined symbol list:
; Location CONSYM contains the number of entries currently in the list;
; Entries begin at CONSYM+1.
; Entry format:
; +0 LH: Address currently assigned to symbol
; +0 RH: Address of "value" word in symbol table entry
CONSYM: BLOCK 65.
; Subroutine FADDUP:
; Update address of labels and forward JRP ends
; within the range of a forward JRP being resolved.
; -- If the current address - 1 is more than 127 bytes beyond
; the JRP end address, pass 2 will generate a JP and no
; address modification is required.
; -- Else pass 2 will generate a JR, and the values of labels
; within this range must be decremented. This includes the
; value of the label just defined and the value of RLOC.
; At entry to FADDUP R2 points to the FJLIST entry
; for the JRP being resolved.
FADDUP: MOVE R1,RLOC ; Compute .-1-(JRP end addr).
SOJ R1, ; This is the offset which would
SUB R1,1(R2) ; be assembled as a JR operand.
TRNE R1,777400 ; Is the offset within range for a JR?
RETURN ; No -- Don't modify addresses.
; Yes - Update label definitions.
SOJ RLOC, ; Decrement current location.
HRRM RLOC,@VALPNT ; Reset value of label just defined.
; Update end addresses of forward JRPs which follow
; the one being resolved.
MOVEI R1,2(R2) ; R1 = ptr to next entry in FJLIST.
MOVE R0,R1 ; Compute (negated) number of
SUBI R0,FJLIST+1 ; entries remaining in FJLIST
LSH R0,-1 ; from this point.
SUB R0,FJLIST
JUMPE R0,FAD2 ; ..JRP being resolved is last in list:
; Skip JRP end address update.
HRL R1,R0 ; .. Not last: Set up to loop thru
; remaining entries.
FAD3: AOJ R1, ; Point to end addr in this entry.
SOS 0(R1) ; Decrement JRP end address.
AOBJN R1,FAD3 ; Repeat until reaching end of list.
; Update addresses of conditionally defined symbols
; which follow the JRP being resolved.
FAD2: SKIPG R1,CONSYM ; Is CONSYM table empty?
RETURN ; Yes - Nothing more to update.
; No -- Scan it.
; Scan CONSYM from back to front, looking for labels
; between the resolved JRP and the current address.
FAD1: HLRZ R0,CONSYM(R1) ; Get next entry's label address.
CAMGE R0,1(R2) ; Is it above the resolved JRP?
RETURN ; No -- Finished with symbol update.
SOJ R0, ; Yes - Decrement symbol's addr.
HRLM R0,CONSYM(R1) ; Reset label addr in CONSYM entry.
HRRZ R3,CONSYM(R1) ; Get pointer to symtab's value word.
HRRM R0,0(R3) ; Update value in symbol table.
SOJG R1,FAD1 ; Check previous entry.
RETURN ; Updated entire table - 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.
Locras: AOS LSBLOC ; NO -- INCREMENT BLOCK NUMBER
MOVEI R1,64. ; RESET VALUE OF NEXT LOCAL SYMBOL
MOVEM R1,NEXGS ; TO GENERATE IN A MACRO CALL.
RETURN ; RETURN
ASGMT: ;ASSIGNMENT PROCESSOR
PUSH P,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: SKIPE STRSYM ; Is something to be equated or set?
TRO RERR,ERRQ ; Yes - Can't do 2 in 1 line.
POP P,STRSYM ; Set STRSYM to equatee symbol.
JRST SET80 ; Skip check for Z80 SET op code.
SET80: TROA R16,SETBIT ; Indicate SET in progress.
EQU: TRZ R16,SETBIT ; Indicate EQU in progress.
SKIPE STRSYM ; Is there a symbol to set?
JRST SET2 ; Yes - Proceed.
SET1: TRO RERR,ERRQ ; Flag bad syntax.
RETURN ; Quit without doing anything.
SET2: CALL EXPR ; Get value to assign to symbol.
JRST SET1 ; None => bad syntax.
SETENT: PUSH P,R1 ; Save value while muddling thru symtab
MOVE R0,STRSYM ; Retrieve symbol to be defined.
SETZM STRSYM ; Show it's been processed.
CALL SSRCH ; Look it up.
JRST SET3 ; New symbol's always legal.
TLNN R1,DEFSYM ; Name's known; Is it defined?
JRST SET3 ; No -- Perfectly legal.
; Symbol is already defined. This is legal only if
; the operation in progress is SET (not EQU) and the
; existing definition was also performed by a SET.
TLNE R1,SETSYM ; Is existing definition a SET symbol
TRNN R16,SETBIT ; and current operation another SET?
JRST SETM. ; No -- Multiple definition illegal.
; Yes - Multiple definition allowed.
; Note that the following code retains any attribute bits
; already set for the SET symbol.
SET3: POP P,R3 ; Retrieve expression value.
HRR R1,R3 ; Set symbol value = expr value.
HRROM R1,PF1 ; Set for alternate binary list format.
TLZE R16,GEQBIT ; Is this a global set (==)?
TLO R1,GLBSYM ; Yes - Set "global" attribute.
TRNE R16,SETBIT ; Is this a SET rather than EQU?
TLO R1,SETSYM ; Yes - Set "set" attribute.
TLO R1,DEFSYM ; In any case mark it as "defined".
CALL INSRT ; Insert or reset symbol table entry.
MOVE R0,SEQ ; Get current line number.
HRLM R0,@CR1PNT ; Store as symbol's definition line.
RETURN
; Multiple definition processing . . .
; Pass 1:
; Multiple definition attempted for a symbol defined
; by EQU or by a label: Flag it and process the EQU
; or SET anyway.
; Pass 2:
; If previous definition is only from pass 1, the symbol's
; multiple definition flag is 0: Just check to be sure
; it's value is the same & issue a phase error flag if it
; isnt. If MDFSYM was set, flag the multiple definition
; for the benefit of listing output. In all cases finish
; by processing the EQU or SET, no matter how illegal it is.
SETM.: TLNN R15,P1F ; Which pass is this?
JRST SETM2 ; Pass 2
; Pass 1
SETM1: TRO RERR,ERRM ; Set multiple definition error flag.
TLO R1,MDFSYM ; Set same attribute for symbol.
JRST SET3 ; Proceed as if it's ok.
SETM2: ; Pass 2 checks . . .
TLNE R1,MDFSYM ; Did pass 1 report it multiply defined?
JRST SETM1 ; Yes - Flag this line & proceed.
TDC R1,0(P) ; No -- . . .
TRNE R1,-1 ; Pass 1 value = pass 2 value?
TRO RERR,ERRP ; No -- Flag phase error.
JRST SET3 ; Set the symbol's value.
PROPC: ;PROCESS OP CODES
; At entry register 1 contains the op table entry
; for this machine instruction.
; 1. Set INSLEN to length of instruction (in bytes) - 1;
; this indicates how many bytes (0, 1, or 2) of immediate
; data must be assembled.
; 2. Set OPCODE to the instruction's op skeleton.
; 3. Select a register operand parser to match the instruction
; type and call it. This routine ors register fields into
; OPCODE.
; 4. Copy OPCODE into CODBUF, the object output buffer.
; 5. If INSLEN > 0 assemble INSLEN bytes (1 or 2) of immediate
; data into CODBUF.
LDB R2,SUBPNT ; Retrieve instruction type.
LDB R0,LENPNT ; Get instruction length code.
MOVEM R0,INSLEN ; INSLEN = length code.
MOVEM R1,OPCODE ; OPCODE = skeleton for 1st byte.
; Only the low order 8 bits of OPCODE will be used for
; code generation. Extraneous fields stored by the preceding
; instruction will be ignored.
XCT OPFORT(R2) ; Parse register operand(s).
MOVE R1,OPCODE ; Copy OPCODE into CODBUF.
IDPB R1,CODPNT
SKIPN R1,INSLEN ; Is immediate data required?
JRST OPEX ; No -- Update PC & exit.
; Yes - Assemble an expression.
SOJG R1,LONG ; Check operand length.
; Assemble 1 byte of immediate data.
CALL EXPR ; Evaluate operand expression.
TRO RERR,ERRA ; No valid expression => error.
HRRZ R0,R1 ; Test for negative expression
TRZ R0,600377 ; before testing for excessive value.
CAIN R0,177400 ; Was expression negative?
JRST PSNT ; Yes - Don't diagnose byte oflo.
TRZE R1,177400 ; Truncate expr value to 8 bits.
TRO RERR,ERRT ; Truncated 1-bits: Flag error.
PSNT: IDPB R1,CODPNT ; Store expr value in single byte.
ADDI RLOC,2 ; Update PC.
RETURN ; Done: Exit.
; Assemble 2 bytes of immediate data.
LONG: CALL EXPR ; Evaluate operand expression.
TRO RERR,ERRA ; No valid expression => error.
IDPB R1,CODPNT ; Store low order byte first
LSH R1,-8 ; in CODBUF,
IDPB R1,CODPNT ; then high order byte.
ADDI RLOC,3 ; Update PC.
RETURN ; Done: Exit.
OPEX: AOJ RLOC, ; Update PC for 1-byte instruction.
RETURN ; Exit.
SUBTTL 8080 instruction assembly
; Instruction format 1:
; ---------------------------------
; ! ! !
; ! op code ! regm !
; ! ! !
; ---------------------------------
; : 7 : 6 : 5 : 4 : 3 : 2 : 1 : 0 :
OPFOR1: CALL REGM ; Evaluate register expression.
TRO RERR,ERRA ; None => operand error.
IORM R1,OPCODE ; Or reg value into skeleton.
RETURN
; Direct return is acceptable for format 1 because these
; instructions have no immediate data; the source register
; is the last field to be parsed.
; Instruction format 2:
; ---------------------------------
; ! ! ! !
; ! op ! regm ! op !
; ! ! ! !
; ---------------------------------
; : 7 : 6 : 5 : 4 : 3 : 2 : 1 : 0 :
OPFOR2: CALL REGM ; Evaluate register expression.
TRO RERR,ERRA ; None => operand error.
LSH R1,3 ; Shift reg value for destination field
POP4E: IORM R1,OPCODE ; Or into instruction skeleton.
SKIPCO: SKIPN INSLEN ; Is additional data required?
RETURN ; No -- Return.
; Yes - Skip reg expr's delimiter.
; Skip delimiter following a destination register specification.
SKIPCM: CALL SETCHR ; %%%%
CAIE RBYTE,", ; Is delimiter a comma?
TROA RERR,ERRQ ; No -- Flag questionable syntax.
JRST GETCHR ; Yes - Skip it & return.
RETURN ; -- Return after syntax error.
; Instruction format 3:
; ---------------------------------
; ! ! ! !
; ! op ! regm ! regm !
; ! ! ! !
; ---------------------------------
; : 7 : 6 : 5 : 4 : 3 : 2 : 1 : 0 :
OPFOR3: CALL REGM ; Evaluate first register expression.
TRO RERR,ERRA ; None => operand error.
LSH R1,3 ; Align value with destination field.
IORM R1,OPCODE ; Or into instruction skeleton.
CALL SKIPCM ; Skip "," following destination reg.
CALL REGM ; Evaluate second register expression.
TRO RERR,ERRA ; None => operand error.
IORM R1,OPCODE ; Or into source field in skeleton.
RETURN
; Instruction format 4:
; ---------------------------------
; ! ! ! !
; ! op ! rp ! op code !
; ! ! ! !
; ---------------------------------
; : 7 : 6 : 5 : 4 : 3 : 2 : 1 : 0 :
OPFOR4: CALL RP ; Evaluate reg pair expression.
TRO RERR,ERRA ; None => operand error.
POP4: LSH R1,4 ; Align reg value with rp field.
JRST POP4E ; Finish as in format 2.
; Instruction format 5:
; Same as format 4 except for parsing the rp (register pair) field --
; "PSW", rather than "SP", maps into value 3.
OPFOR5: CALL RP5 ; Evaluate variant of rp expression.
TRO RERR,ERRA ; None => operand error.
JRST POP4 ; Finish as in format 2.
; Instruction format 6:
; Same as format 2 except that the "destination" field is
; set to an arbitrary 3-bit expression value, rather than
; to a register address.
; The only instruction using format 6 is RST. In order to
; allow assembling both 8080 and Z80 RST syntax, the expression
; value (n from "RST n") is compiled as follows:
; n < 8: assembled value = n
; n > 7: assembled value = n/8; operand error if
; n/8 > 7 or n mod 8 <> 0.
OPFOR6: CALL EXPR ; Evaluate an expression.
TRO RERR,ERRA ; None => operand error.
TRNN R1,777770 ; Is expression value > 7?
JRST OPF6C ; No -- Compile 8080 RST syntax.
; Yes - Compile Z80 RST syntax.
TRNE R1,7 ; Is expression mod 8 = 0?
TRO RERR,ERRA ; No -- Report operand error.
LSH R1,-3 ; Divide expression value by 8.
TRZE R1,777770 ; Is resulting value still too large?
TRO RERR,ERRA ; Yes - Report operand error.
OPF6C: LSH R1,3 ; Align value with "destination" field.
IORM R1,OPCODE ; Or into op skeleton.
RETURN
; Instruction format 7:
; Same as format 4 except that only two register pairs
; (B & D) may be specified.
OPFOR7: CALL RP7 ; Evaluate variant of rp expr.
TRO RERR,ERRA ; None => operand error.
JRST POP4 ; Finish as in format 4.
SUBTTL Z80 Instruction assembly
; First parse the instruction's operands; the op code can't
; be identified without knowing the operand type!
; Operand type & value codes are . . .
; Type code Value
; --------- -----
; [null] 0 0
; register: 1
; B 0
; C 1
; D 2
; E 3
; H 4
; L 5
; A 7
; register pair: 2
; BC 0
; DE 1
; HL 2
; SP 3
; AF 4
; AF' 5
; special registers: 3
; I 0
; IX 1
; IY 2
; R 3
; Indirect: 4
; (HL) 0
; (DE) 1
; (BC) 2
; (SP) 3
; (IX) 4
; (IY) 5
; (C) 6
; (IX+d) 5 d
; (IY+d) 6 d
; expr 7 expr
; (expr) 8 expr
; At entry to Z80PRS R1's low order half contains a pointer
; to the parse table for the given Z80 op code.
OP1: BLOCK 1 ; Encoded first operand for Z80 instr.
OP2: BLOCK 1 ; Encoded 2nd operand for Z80 instr.
Z80PRS:
PUSH P,R1 ; Save Z80 op table pointer.
SETZM OP1 ; Initialize OP1 & OP2 to represent
SETZM OP2 ; null arguments.
CALL SETNB ; Check next byte.
CAIE R4,SCLE ; Is it an end of line char or ";"?
CAIN RBYTE,";
JRST Z80LUP ; Yes - Leave both operands null.
CAIN RBYTE,", ; Is it ","?
JRST Z80OP2 ; Yes - Leave 1st operand null.
CALL Z80OP ; Parse one operand.
MOVEM R1,OP1 ; Store its encoded value.
CALL SETNB ; Check next byte.
Z80OP2: CAIN RBYTE,", ; Is 1st operand followed by ","?
CALL GETNB ; Yes - Skip it.
CAIE R4,SCLE ; Is next byte an end of line character
CAIN RBYTE,"; ; or ";"?
JRST Z80LUP ; Yes - Leave 2nd operand null.
CALL Z80OP ; Encode the 2nd operand.
MOVEM R1,OP2 ; Store it.
; Encoded values have been set for both operands;
; Look up the operand types in the op code's parse table
; to identify the instruction to assemble.
Z80LUP: POP P,R2 ; Retrieve op parse table address.
Z80LSR: HLRZ R1,0(R2) ; Get 1st op type from table,
HLRZ R0,OP1 ; get actual 1st operand type.
CAME R0,R1 ; Does 1st operand type match?
JRST Z80LNX ; No -- Skip this table entry.
; Yes - Check for suitable value.
HRRZ R1,0(R2) ; Check required operand value.
TRNE R1,400000 ; Is any operand value satisfactory?
JRST O1OK ; Yes - 1st operand suits tbl entry.
HRRZ R0,OP1 ; No -- Check for exact value match.
CAME R0,R1 ; Does value match exactly?
JRST Z80LNX ; No -- Skip this table entry.
; Yes - 1st operand matches.
; First operand matches current table entry:
; Check second operand.
O1OK: HLRZ R1,1(R2) ; Get required 2nd op type from table,
HLRZ R0,OP2 ; get actual 2nd operand type.
CAME R0,R1 ; Does 2nd operand type match?
JRST Z80LNX ; No -- Skip this table entry.
; Yes - Check for suitable value.
HRRZ R1,1(R2) ; Check required operand value.
TRNE R1,400000 ; Is any value satisfactory?
JRST Z80OF ; Yes - Instr matches this entry.
HRRZ R0,OP2 ; No -- Check for exact value match.
CAMN R0,R1 ; Does value match exactly?
JRST Z80OF ; Yes - Instr matches this entry.
; No -- Skip this entry.
; Skip to next entry in Z80 instruction parse table.
Z80LNX: ADDI R2,4 ; Point to next entry.
SKIPE 0(R2) ; Is this end-of-table marker?
JRST Z80LSR ; No -- Check next entry.
; Yes - Illegal operand(s) for
; this op code!
TRO RERR,ERRA ; Set A flag & don't assemble anything.
RETURN
; Found entry in Z80 instruction parse table to match
; current input line; set up to assemble the instruction.
Z80OF: MOVE R1,3(R2) ; Set OPCODE to op skeleton
MOVEM R1,OPCODE ; (up to 4 8-bit bytes).
MOVS R1,2(R2) ; Fetch instruction type code.
; [LH = operand length code]
PUSH P,R1 ; Save format & length code for
; common exit routines.
XCT Z80JT(R1) ; Assemble according to format
Z80JT: JRST ZFOR0 ; Format 0
JRST ZFOR1 ; Format 1
JRST ZFOR2 ; .
JRST ZFOR3 ; .
JRST ZFOR4 ; .
JRST ZFOR5
JRST ZFOR6
JRST ZFOR7
JRST ZFOR8
JRST ZFOR9
JRST ZFOR10
JRST ZFOR11
JRST ZFOR12
JRST ZFOR13
JRST ZFOR14
JRST ZFOR15
; Parse a single operand for a Z80 instruction.
Z80OP: CAIN RBYTE,"( ; Does operand start with "("?
JRST ZIN ; Yes - Probably indirect register.
; No -- . . .
CALL GETSYM ; Try to collect a symbol.
JRST ZEXPR ; No symbol: Assume an expression.
MOVE R2,[-RSSIZE,,RSTAB] ; Prepare to scan table of
; reserved (register) symbols.
RSSER: CAMN R0,0(R2) ; Does symbol match this table entry?
JRST RSGOT ; Yes - Found it.
AOJ R2, ; No -- Skip to next table entry.
AOBJN R2,RSSER
; Symbol wasn't in table: Backtrack to its beginning
; and treat it as an expression.
MOVE RBPTR,SYMBEG ; Point to start of symbol again.
ZEXPR: CALL EXPR ; Evaluate the expression.
TRO RERR,ERRA ; .. Flag error if no expr.
HRLI R1,7 ; Set operand type = 7 for expr,
RETURN ; return type & expr value.
; Found symbol in table: Return its value.
RSGOT: MOVE R1,1(R2)
CAME R1,[2,,4] ; Is this "AF"?
RETURN ; No -- Return this value.
CAIE RBYTE,"' ; Yes - Check for "AF'".
RETURN ; ... Just AF
CALL GETNB ; ... AF' -- Skip "'".
MOVE R1,[2,,5] ; Indicate reg pair 5 instead of 4.
RETURN
; Operand starts with "(": Look for reserved register symbols
; which may be parenthesized.
ZIN: CALL GETNB ; Skip "(".
CALL GETSYM ; Collect a symbol.
JRST ZIEXPR ; No symbol: Must be "(expr)".
MOVE R2,[-RISIZE,,RITAB] ; Prepare to scan table of register
; names which may be prefixed by "(".
RISER: CAMN R0,0(R2) ; Does symbol match this table entry?
JRST RIGOT ; Yes - Look no farther.
AOJ R2, ; No -- Scan on.
AOBJN R2,RISER
; "(" isn't followed by a suitable register name:
; Assume operand is "(expr)".
MOVE RBPTR,SYMBEG ; Backtrack to start of symbol.
ZIEXPR: CALL EXPR ; Evaluate expression.
TRO RERR,ERRA ; Flag an error if no valid expr found.
HRLI R1,8 ; Set operand type = 8 for "(expr)".
JRST IRET1 ; Skip ")" and return.
; Got a register name in indirect or indexed context,
; such as "(HL)" or "(IX+d)".
RIGOT: MOVE R1,1(R2) ; Pick up type & value code.
CAME R1,[4,,4] ; Is operand "(IX" or "(IY" so far?
CAMN R1,[4,,5]
JRST RINCK ; Yes - Check for "+d)".
IRET1: CALL SETNB ; Check terminator byte:
IRET2: CAIN RBYTE,") ; It should be ")".
JRST GETNB ; Ok -- Skip ")" & return.
TRO RERR,ERRA ; Bad - Flag error & return.
RETURN
; Decide whether operand is of form "(IX)" or "(IX+d)".
RINCK: CAIE RBYTE,"+ ; Is byte after reg name "+"?
JRST IRET2 ; No -- Must be "(IX)" or "(IY)".
; Yes - Must be indexed form.
AOJ R1, ; New operand type = old value + 1
HRLZ R1,R1 ; to indicate (IX+d) or (IY+d).
PUSH P,R1 ; Save new operand type.
CALL EXPR ; Evaluate "+d".
TRO RERR,ERRA ; Flag operand error if d invalid.
POP P,R2 ; Retrieve type code.
HLL R1,R2 ; Return type code & value of d.
JRST IRET1 ; Skip ")" and return.
; Common finish points for assembling Z80 instructions:
ZFLONG: MOVE 2,[241000,,OPCODE] ; Long instruction
MOVEI R0,2 ; Set basic instruction length.
JRST ZFMEM
ZFSHOR: MOVE 2,[341000,,OPCODE] ; Short instruction
MOVEI R0,1 ; Set basic instruction length.
; Set memory operands (if any) in the op skeleton.
ZFMEM: POP P,R1 ; Retrieve format & mem op code.
HLRZ R1,R1 ; R1 = memory operand code.
ADD R0,MEMOPL(R1) ; Add mem op length to instr. length.
MOVEM R0,INSLEN
XCT GENMEM(R1) ; Select action to suit mem op code:
MEMOPL: 0 ; Memory operand length
1 ; for each operand code
1
2
2
2
GENMEM: JRST ZFIN ; 0 -- No memory operands
JRST GM011 ; 1 -- Op1 is a 1-byte operand
JRST GM021 ; 2 -- Op2 is a 1-byte operand
JRST GM012 ; 3 -- Op1 is a 2-byte operand
JRST GM022 ; 4 -- Op2 is a 2-byte operand
JRST GM2OP ; 5 -- Op1 & op2 are both 1-byte ops
GM011: MOVE R1,OP1 ; Assemble op1 as a 1-byte operand.
JRST GM000
GM021: MOVE R1,OP2 ; Assemble op2 as a 1-byte operand.
GM000: HRRZ R0,R1 ; Check for negative expression
TRZ R0,600377 ; before testing for truncation error.
CAIN R0,177400 ; Was expression negative?
JRST GMNOTE ; Yes - No truncation error.
TRNE R1,177400 ; Is op value more than 8 bits-worth?
TRO RERR,ERRT ; Yes - Flag truncation error.
GMNOTE: IDPB R1,R2
JRST ZFIN
GM012: MOVE R1,OP1 ; Assemble op1 as a 2-byte operand.
JRST GMOL
GM022: MOVE R1,OP2 ; Assemble op2 as a 2-byte operand.
GMOL: IDPB R1,R2 ; Assemble a 2-byte operand.
LSH R1,-8
IDPB R1,R2
JRST ZFIN
GM2OP: MOVE R1,OP1 ; Assemble both op1 & op2
IDPB R1,R2 ; as 1-byte operands.
MOVE R1,OP2
IDPB R1,R2
ZFIN: MOVE 2,[441000,,OPCODE] ; Set pointer to 1st skeleton byte.
ZFINL: ILDB R1,R2 ; Get next byte from filled in skeleton
IDPB R1,CODPNT ; Output it.
AOJ RLOC, ; Increment location counter.
SOSLE INSLEN ; Decrement byte count.
JRST ZFINL ; Repeat until entire instr's out.
RETURN
ZFOR0= ZFSHOR ; Z80 format 0: Nothing more than
; memory operands, at most.
ZFOR1: MOVE R2,OP2 ; Z80 format 1:
TLNN R2,-1 ; Choose rightmost operand
MOVE R2,OP1 ; as source register.
LDB R0,[341000,,OPCODE]
IOR R0,R2 ; Or source reg into op code byte.
DPB R0,[341000,,OPCODE]
JRST ZFSHOR
ZFOR2: HRRZ R2,OP1 ; Z80 format 2:
LSH R2,3 ; First operand is destination register
LDB R0,[341000,,OPCODE]
IOR R0,R2 ; Or destination reg into op code.
DPB R0,[341000,,OPCODE]
JRST ZFSHOR
ZFOR3: HRRZ R1,OP1 ; Z80 format 3:
LSH R1,3 ; First operand is destination reg,
IOR R1,OP2 ; 2nd operand is source register.
LDB R0,[341000,,OPCODE]
IOR R0,R1 ; Or source & destination with op code.
DPB R0,[341000,,OPCODE]
JRST ZFSHOR
ZFOR4: HRRZ R2,OP1 ; Z80 format 4:
ZF6A: CAIGE R2,4 ; First operand is register pair
JRST ZF4A ; other than AF or AF'.
TRO RERR,ERRA ; AF or AF' was specified: Flag error
MOVEI R2,0 ; & assemble 0 as reg value.
ZF4A: LSH R2,4 ; Align with rp field.
LDB R0,[341000,,OPCODE]
IOR R0,R2 ; Or reg pair into op code.
DPB R0,[341000,,OPCODE]
JRST ZFSHOR
ZFOR5: HRRZ R2,OP1 ; Z80 format 5:
CAIG R2,2 ; First operand is register pair
JRST ZF5A ; other than SP or AF'.
CAIE R2,4 ; Reg pair is SP, AF, or AF'; is it AF?
JRST ZF5B ; No -- Illegal.
MOVEI R2,3 ; Yes - Map AF value (4) to proper
JRST ZF5A ; object code value (3).
ZF5B: MOVEI R2,0 ; SP or AF' was specified: Assemble 0
TRO RERR,ERRA ; and flag an error.
JRST ZF5A
ZF5A= ZF4A ; Same object format as format 4.
ZFOR6: HRRZ R2,OP2 ; Z80 format 5:
JRST ZF6A ; Same as format 4, but register
; is identified by 2nd operand instead
; of first.
ZFOR7: 0 ; Z80 Format 7: Reserved
ZFOR8= ZFLONG ; Z80 format 8:
; Nothing but memory operands
ZFOR9: MOVE R1,OP2 ; Z80 format 9:
TLNN R1,-1 ; Pick rightmost operand
MOVE R1,OP1 ; as source register.
ZF9A: LDB R0,[241000,,OPCODE]
IOR R0,R1 ; Or register value into op code.
DPB R0,[241000,,OPCODE]
JRST ZFLONG
ZFOR10: HLRZ R1,OP1 ; Z80 format 10:
SOJN R1,ZF10A ; .. Be sure op1 is a register.
HRRZ R1,OP1 ; Normal case: First operand
LSH R1,3 ; is destination register.
JRST ZF9A
ZF10A: HRRZ R1,OP2 ; Abnormal case [OUT (C),r]:
LSH R1,3 ; Second operand is source register
JRST ZF9A ; in destination register field.
ZFOR11: HRRZ R2,OP1 ; Z80 format 11:
ZF12A: CAIG R2,3 ; First operand is register pair
JRST ZF11A ; other than AF or AF'.
MOVEI R2,0 ; AF or AF': Assemble 0 and
TRO RERR,ERRA ; flag an error.
ZF11A: LSH R2,4 ; Align reg pair value with obj field.
LDB R0,[241000,,OPCODE]
IOR R0,R2 ; Or rp value into 2nd byte of instr.
DPB R0,[241000,,OPCODE]
JRST ZFLONG ; Assemble memory operands, if any.
ZFOR12: HRRZ R2,OP2 ; Z80 format 12:
JRST ZF12A ; Same as format 11, but with
; register pair defined by second
; operand instead of first.
ZFOR13: POP P,R1 ; Z80 format 13:
MOVEI R1,4 ; Discard stacked length code,
MOVEM R1,INSLEN ; force instruction length to 4 bytes.
MOVE R2,[241000,,OPCODE] ; Set pointer for 1-byte operand.
JRST GM011 ; Store op1 as 1-byte operand &
; finish up.
ZFOR14: HRRZ R1,OP1 ; Z80 format 14:
CAILE R1,7 ; First operand is bit #; Is it < 8?
TRO RERR,ERRT ; No -- Flag truncation error.
TRZ R1,777770 ; Insure bit # is between 0 & 7.
LDB R0,[241000,,OPCODE] ; Get 2nd opcode byte.
LSH R1,3 ; Align bit # with "b" field.
IOR R0,R1 ; Or bit number into op code.
MOVE R1,OP2 ; Get 2nd ("m") operand.
CAMN R1,[4,,0] ; Is this "(HL)"?
MOVEI R1,6 ; Yes - Supply correct operand value
TLZ R1,777777 ; Insure operand type is cleared.
IOR R0,R1 ; Or operand address into op code.
DPB R0,[241000,,OPCODE] ; Store completed op code byte.
JRST ZFLONG ; Finish up.
ZFOR15: POP P,R1 ; Z80 format 15:
MOVEI R1,4 ; Discard table's length code,
MOVEM R1,INSLEN ; force instruction length to 4 bytes.
HRRZ R1,OP1 ; Get first operand (bit #).
CAILE R1,7 ; Is bit # < 8?
TRO RERR,ERRT ; No -- Flag truncation error.
TRZ R1,777770 ; Insure bit # is in valid range.
LDB R0,[041000,,OPCODE] ; Get last byte of opcode.
LSH R1,3 ; Align bit # with "b" field.
IOR R0,R1 ; Or bit number into opcode.
DPB R0,[041000,,OPCODE] ; Store updated opcode byte.
MOVE R2,[241000,,OPCODE] ; Set pointer & store "d" from
JRST GM021 ; "(IX+d)" or "(IY+d)".
SUBTTL Z80 jump/call/return instruction assembly
Z80JP:
SETZM OPCODE ; Initialize op skeleton to 0.
XCT Z80CTL(R1) ; Choose processing to suit op code.
Z80CTL: JRST ZJP ; Subtype 0: JP
JRST ZJR ; Subtype 1: JR
JRST ZJRP ; Subtype 2: JRP
JRST ZDJNZ ; Subtype 3: DJNZ
JRST ZCALL ; Subtype 4: CALL
JRST ZRET ; Subtype 5: RET
; JP: May be . . .
; JP nn
; JP cc,nn
; JP (HL)
; JP (IX)
; JP (IY)
ZJP: TLNN R15,Z80FLG ; Assembling for a Z80?
JRST JUMPOS ; No -- 8080 jump if positive
; Yes - Z80 jump of some sort
CALL SETNB ; Check first operand byte.
CAIN RBYTE,"( ; Is operand in register indirect mode?
JRST JPAREG ; Yes - Look for specific operands.
MOVEI R0,3 ; No -- Preset instruction length
MOVEM R0,INSLEN ; for a 3-byte instruction.
CALL ZJCOND ; Look for a jump condition code.
JRST ZJPNC ; No condition: Assemble JP nn.
; Assemble JP cc,nn.
IORI R0,302 ; Or op code skeleton with cond code.
DPB R0,[341000,,OPCODE] ; Store op code byte.
CALL GETNB ; Skip "," after condition code.
JRST ZJPNN ; Assemble jump address.
; Assemble JP nn.
ZJPNC: MOVEI R0,303 ; Set op code for unconditional jump.
DPB R0,[341000,,OPCODE] ; Store it.
; Assemble "nn" of either "JP nn" or "JP cc,nn".
ZJPNN: CALL EXPR ; Evaluate expression as jump address.
TRO RERR,ERRA ; .. No expr: Flag error & use 0.
DPB R1,[241000,,OPCODE] ; Store expression value
LSH R1,-8 ; in opcode skeleton.
DPB R1,[141000,,OPCODE]
JRST ZFIN ; Output the instruction.
; JP with Z80 mode off: Assemble as 8080 JP (Z80 JP p,).
JUMPOS: MOVEI R0,362 ; Set opcode for jump if positive.
DPB R0,[341000,,OPCODE]
MOVEI R0,3 ; Set instruction length to 3 bytes.
MOVEM R0,INSLEN
JRST ZJPNN ; Assemble jump's destination address.
; Register indirect addressing:
; "JP (HL)", "JP (IX)", or "JP (IY)".
JPAREG: CALL Z80OP ; Parse register indirect expression.
CAMN R1,[4,,0] ; Is it "(HL)"?
JRST JPAHL
CAMN R1,[4,,4] ; Is it "(IX)"?
JRST JPAIX
CAMN R1,[4,,5] ; Is it "(IY)"?
JRST JPAIY
; Illegal register indirect operand:
; Assemble 3 bytes of 0 to allow lots of patching.
MOVEI R0,3 ; Set instruction length
MOVEM R0,INSLEN ; to 3 bytes.
JRST ZFIN ; Output 0's.
; "JP (HL)" . . .
JPAHL: MOVEI R0,351 ; Set opcode (equivalent to PCHL).
DPB R0,[341000,,OPCODE]
MOVEI R0,1 ; Set instruction length to 1 byte.
MOVEM R0,INSLEN
JRST ZFIN ; Output the instruction.
; "JP (IX)" . . .
JPAIX: MOVE R0,[.BYTE 8 ? 335 ? 351 ? .BYTE ? ] ; Load op code.
JRST JPAIXY ; Output it.
; "JP (IY)" . . .
JPAIY: MOVE R0,[.BYTE 8 ? 375 ? 351 ? .BYTE ? ] ; Load op code.
; Operand is either (IX) or (IY) . . .
JPAIXY: MOVEM R0,OPCODE ; Store opcode.
MOVEI R0,2 ; Set instruction length to 2 bytes.
MOVEM R0,INSLEN
JRST ZFIN ; Output the instruction.
; Subroutine ZJCOND: Parse a Z80 jump condition
; Return to 0(P) indicates no valid jump condition was found;
; Return to 1(P) indicates a valid condition was found, and
; R0 contains the matching condition code bits shifted
; into alignment with the cc field in JP, CALL, and RET
; instructions.
; ZRCOND is an alternate entry to ZJCOND, and is used by
; RET parsing. ZJCOND requires that the condition code
; be followed by a comma in order to be recognized as a cc,
; rather than a jump address symbol, whereas ZRCOND doesn't
; make this check.
ZRCOND:
CALL GETSYM ; Try to get a symbol.
RETURN ; .. No symbol => no return condition
JRST ZJRCND ; Search cc table for this symbol.
ZJCOND:
CALL GETSYM ; Try to get a symbol.
RETURN ; .. No symbol => no jump condition.
CAIE RBYTE,", ; Was symbol followed by ","?
JRST SNOTJC ; No -- Backtrack & return false.
; Yes - Search table of conditions.
ZJRCND: MOVE R1,[-8,,ZJCTAB] ; Prepare to scan jump cond table.
ZJCSER: CAMN R0,0(R1) ; Does symbol match this condition?
JRST GOTJC ; Yes - Found jump condition.
AOBJN R1,ZJCSER ; No -- Scan on.
; Symbol didn't match any valid jump condition:
; Backtrack over the symbol and return to 0(P).
SNOTJC: MOVE RBPTR,SYMBEG ; Set source byte pointer back to
CALL SETNB ; start of symbol, set to its 1st char,
RETURN ; and return to caller.
; Found jump condition in table: Set R0 to cc value
; (offset from start of table) shifted to align with
; normal cc fields.
GOTJC: HLRZ R0,R1 ; R0 = table offset - 8.
ADDI R0,8 ; R0 = table offset = cc value.
LSH R0,3 ; Align to or into cc field.
HRRZ R0,R0 ; Clear stray bit in left half of R0.
JRST CPOPJ1 ; Return to 1(P).
; JR: Jump relative
; This can be either "JR e" or "JR cc,e", where the only
; legal values for cc in this instruction are NZ, Z, NC, and C.
ZJR: MOVEI R0,2 ; Set instruction length
MOVEM R0,INSLEN ; to 2 bytes.
CALL ZJCOND ; Look for a jump condition field.
JRST ZJRNC ; .. No cond: Unconditional JR.
; Conditional JR: Check for valid condition for this instruction.
CAIG R0,30 ; Is condition code > 3?
JRST ZJRC ; No -- It's valid.
TRO RERR,ERRA ; Yes - Report operand error.
CALL GETNB ; Skip "," after cc.
JRST ZJRNC ; Assemble as unconditional JR.
ZJRC: IORI R0,040 ; Or op code with condition code.
DPB R0,[341000,,OPCODE] ; Store op code in instr. skeleton.
CALL GETNB ; Skip "," after cc field.
JRST JRDISP ; Evaluate displacement.
; Unconditional JR . . .
ZJRNC: MOVEI R0,030 ; Set op code for unconditional
DPB R0,[341000,,OPCODE] ; JR in instruction skeleton.
; Assemble displacement for both breeds of JR.
JRDISP: CALL EXPR ; Evaluate expr for dest address.
TROA RERR,ERRA ; .. No expr: Flag err & assemble
; nop: JR $+2.
SUBI R1,2(RLOC) ; Disp = expr-pc-2 to allow for
; pc update.
TRNN R1,177600 ; Are bits 7-15 all 0?
JRST JRDOK ; Yes - Valid positive displacement.
HRRZ R0,R1 ; No -- Check for negative disp.
TRZ R0,600177 ; Check high order 9 bits . . .
CAIN R0,177600 ; Are they all 1 bits?
JRST JRDOK ; Yes - Valid negative displacement.
TRO RERR,ERRT ; No -- Flag truncation error &
MOVEI R1,-2 ; assemble JR $ (inf loop).
JRDOK: DPB R1,[241000,,OPCODE] ; Store displacement in op skeleton.
JRST ZFIN ; Output the instruction.
; JRP: Assemble either a JR or a JP, depending on which
; is appropriate to the type of the instruction's operands
; and how far the destination is from the current address.
ZJRP: CALL SETNB ; Check next byte.
CAIN RBYTE,"( ; Is this a reg indirect expression?
JRST ZJP ; Yes - Assemble a JP.
; No -- Check further.
CALL ZJCOND ; Parse a condition code, if one exists
MOVEI R0,7 ; -- No cc: Flag this via value 7.
PUSH P,R0 ; Save cc value for later reference.
CAIN RBYTE,", ; Was there a cc terminated by ","?
CALL GETNB ; Yes - Skip the comma.
; Get jump's destination address.
; This must be a symbol which corresponds (either now or later)
; to a label in the source.
CALL GETSYM ; Get destination symbol.
JRST ZJPERR ; None -- Assemble JP & flag it.
CALL SSRCH ; Look up the symbol.
CALL INSRT ; No symtab entry - Insert one.
CALL CRFREF ; Record the reference.
TLNE R1,MDFSYM ; Is this symbol multiply defined?
TRO RERR,ERRD ; Yes - Give this line a D flag.
TLNN R1,DEFSYM ; Is this symbol defined?
JRST ZJRPU ; No -- Prob. fwd ref on pass 1.
; Yes - Check offset.
SUBI R1,2(RLOC) ; Dest offset for JR = dest-pc-2.
TRNN R1,177600 ; Are high 9 bits of offset 0?
JRST ZJRPJR ; Yes - Valid positive offset.
HRRZ R0,R1 ; No -- Check for negative offset.
TRZ R0,600177
CAIN R0,177600 ; Are high 9 bits of offset 1?
JRST ZJRPJR ; Yes - Valid negative offset.
; No -- Destination is out of range
; for JR: Assemble JP.
ADDI R1,2 ; Translate expression value
ADD R1,RLOC ; back to destination address.
JRST ZJRPJP
; Jump is to an undefined symbol; This should be either
; a global symbol or a forward reference on pass 1.
ZJRPU: TLNE R1,GLBSYM ; Is this a global (external) symbol?
JRST ZJRPJP ; Yes - Generate JP.
TRO RERR,ERRU ; No -- Flag ref to undefined sym.
TLNN R15,P1F ; Is this pass 1?
JRST ZJPERR ; No -- Generate JP 0.
; Yes - Assume forward ref.
; Apparent forward reference in pass 1:
; Record it in the forward JRP list and presume
; a JP should be generated. If label definition later
; finds the destination within range for a JR it will
; decrement the addresses of labels within this JRP's range
; so that pass 2 will generate the proper code.
MOVE R1,FJLIST ; Get fwd JRP list's entry count.
CAIL R1,32. ; Is there room for another entry?
0 ; %%%% temp %%%% no - add diag & halt.
LSH R1,1 ; Yes - Get index for 1st empty slot
MOVE R0,@SYMPNT ; Set new entry: Operand symbol 1st.
MOVEM R0,FJLIST+1(R1)
MOVEI R0,2(RLOC) ; 2nd word is instruction end address
MOVEM R0,FJLIST+2(R1) ; (start addr + 2).
AOS FJLIST ; Increment list's entry count.
JRST ZJRPJP ; Generate JP for now.
; Destination's close: Generate a JR, unless this is
; a conditional jump for one of the conditions which
; can't be tested by a JR.
ZJRPJR: POP P,R0 ; Retrieve condition code.
CAIL R0,40 ; Is this a cond invalid for JR?
JRST ZJRPPP ; Yes - Assemble JP.
; No -- Assemble JR.
CAIN R0,7 ; Is this an unconditional jump?
JRST ZJRPUN ; Yes - Set op code to suit.
IORI R0,040 ; No -- Or op code with cc bits.
JRST ZJRPRS
ZJRPUN: MOVEI R0,030 ; Supply op code for uncond. JR.
ZJRPRS: DPB R0,[341000,,OPCODE] ; Store op code.
DPB R1,[241000,,OPCODE] ; Store JR displacement.
MOVEI R0,2 ; Set instruction length
MOVEM R0,INSLEN ; to 2 bytes.
JRST ZFIN ; Output the instruction.
; Can't assemble JR for various reasons: Assemble JP.
ZJPERR: TRO RERR,ERRA ; No destination address: Flag error
SETZ R1, ; and assemble JP 0
JRST ZJRPJP ; to allow patching.
ZJRPPP: PUSH P,R0 ; Cond code forces JP: Restack cc
; to simplify entry to ZJRPJP.
ZJRPJP: MOVEI R0,3 ; Set instruction length to 3 bytes.
MOVEM R0,INSLEN
POP P,R0 ; Retrieve condition code.
CAIN R0,7 ; Is this a conditional jump?
JRST ZJRPNU ; No -- Assemble uncond. op code.
IORI R0,302 ; Yes - Or op code with cc field.
JRST ZJRPE
ZJRPNU: MOVEI R0,303 ; Supply op code for unconditional JP.
ZJRPE: DPB R0,[341000,,OPCODE] ; Store op code in skeleton.
DPB R1,[241000,,OPCODE] ; Store LSB of destination address.
LSH R1,-8
DPB R1,[141000,,OPCODE] ; Store MSB of destination address.
JRST ZFIN ; Output the instruction.
; Assemble DJNZ after the fashion of a JR.
ZDJNZ: MOVEI R0,2 ; Set instruction length
MOVEM R0,INSLEN ; to 2 bytes.
MOVEI R0,020 ; Store op code
DPB R0,[341000,,OPCODE] ; in instruction skeleton.
JRST JRDISP ; Assemble relative displacement.
; CALL . . .
ZCALL: MOVEI R0,3 ; Set instruction length to 3 bytes.
MOVEM R0,INSLEN
CALL ZJCOND ; Try to parse a condition code field.
JRST ZCUN ; .. No cc: Unconditional call.
; .. Cc: Conditional call.
IORI R0,304 ; Or op code with cc field.
DPB R0,[341000,,OPCODE] ; Store opcode.
CALL GETNB ; Skip comma delimiting cc field.
JRST ZJPNN ; Assemble call address as in
; a JP instruction.
ZCUN: MOVEI R0,315 ; Set opcode for unconditional call.
DPB R0,[341000,,OPCODE]
JRST ZJPNN ; Assemble call address.
; RET . . .
ZRET: MOVEI R0,1 ; Set instruction length to 1 byte.
MOVEM R0,INSLEN
CALL ZRCOND ; Try to parse a condition code field.
JRST ZRUN ; .. No cc: Unconditional return.
; .. Cc: Conditional return.
IORI R0,300 ; Or opcode with cc field.
DPB R0,[341000,,OPCODE] ; Store opcode.
JRST ZFIN ; Output the instruction.
ZRUN: MOVEI R0,311 ; Set opcode for unconditional return.
DPB R0,[341000,,OPCODE]
JRST ZFIN ; Output the instruction.
SUBTTL Register expression evaluation: regm, rp, rp5, & rp7
; regm expression evaluation
; The following symbols are treated as reserved within
; the context of source or destination fields which
; require regm expressions:
; symbol: A B C D E H L M
; matching value: 7 0 1 2 3 4 5 6
; A regm expression is either one of these reserved symbols
; or an absolute expression which evaluates to a value
; in the range [0,7].
; Note that 8080 architecture uses M as a pseudo-register
; representing the byte addressed by HL. This allows
; assembling such memory references as register references.
; At exit R1 contains the value of the regm expression,
; truncated to 3 bits. Successful return is to 1(P),
; 0(P) if the next input text was not a valid regm expression.
GLBPNT: BLOCK 1
GLBBUF: BLOCK 40
REGM:
CALL SETCHR ; %%%%
LDB R0,C8PNTR ; Check type of next input byte.
CAIE R0,.ALP
CAIN R0,.HEX
JRST RMALPH ; Alphabetic: Check for reserved name.
; Non-alpha: Treat as expression.
RMEXP: CALL EXPR ; Evaluate an absolute expression.
RETURN ; If EXPR fails, REGM fails.
TRZE R1,777770 ; Is value too large?
TRO RERR,ERRT ; Yes - Truncate & flag error.
JRST CPOPJ1 ; Take "success" exit.
; Check for one of the reserved register names.
RMALPH: MOVE R2,RBYTE ; Save current input byte.
MOVE R3,RBPTR ; Save current input pointer.
CALL GETCHR ; Get next byte.
CAIE R4,SCSE
CAIN R4,SCLE ; Is it a delimiter?
JRST RMA1 ; Yes - Check saved input byte.
; No -- Can't be 1-byte symbol.
; Input wasn't a reserved register name.
; Back up the input pointer to its original position
; and try to parse the input as an expression.
RMBACK: MOVE RBPTR,R3 ; Restore original input pointer value.
CALL SETCHR ; Restore info on byte pointed to.
JRST RMEXP ; Try to parse an expression.
; Input is a single alphabetic byte followed by a delimiter.
; Look for it in table of reserved register symbols.
RMA1: MOVE R1,REGMAP-"A(R2) ; Get byte's matching value.
TRZE R1,777770 ; Is it valid?
JRST RMBACK ; No -- Parse as expression.
JRST CPOPJ1 ; Yes - Return this value.
; ***** Warning: "@" and "?" cause REGMAP to be indexed by -1 and -2,
; ***** picking up the values of the two previous instructions.
REGMAP: ; Values matching reserved names
7 ; A
0 ; B
1 ; C
2 ; D
3 ; E
-1 ; F - invalid
-1 ; G - invalid
4 ; H
-1 ; I - invalid
-1 ; J - invalid
-1 ; K - invalid
5 ; L
6 ; M
-1 ; N - invalid
-1 ; O - invalid
-1 ; P - invalid
-1 ; Q - invalid
-1 ; R - invalid
-1 ; S - invalid
-1 ; T - invalid
-1 ; U - invalid
-1 ; V - invalid
-1 ; W - invalid
-1 ; X - invalid
-1 ; Y - invalid
-1 ; Z - invalid
; Register pair expression evaluation
; rp expressions recognize "B", "D", "H", and "SP"
; as reserved names with values of 0, 1, 2, and 3, respectively.
; Anything else is parsed as an absolute expression.
; At return the expression value is R1, truncated to 2 bits.
; Successful return is to 1(P), failure return to 0(P).
RP:
CALL SETCHR ; %%%%
MOVE R3,RBPTR ; Save input pointer for possible rescan
; Check for possible beginnings of reserved register pair names.
RP5ENT: CAIN RBYTE,"H ; .. "H"
JRST RPHL
CAIN RBYTE,"D ; .. "D"
JRST RPDE
CAIN RBYTE,"B ; .. "D"
JRST RPBC
CAIE RBYTE,"S ; .. "SP"
JRST RPEXP ; None of above: Parse as expr.
; First input byte is "S". Check up to 2 more bytes to see
; if this is "SP<delimiter>". If it isn't, restore input pointer
; to its original value and try to parse an expression.
CALL GETCHR ; Get byte following "S".
CAIE RBYTE,"P ; Is it "P"?
JRST RPBEXP ; No -- Look for expression.
MOVEI R1,3 ; Preload return value 3 for SP.
JRST RPCDEL ; Check for delimiter next.
; Current input matches a reserved name. Preload associated
; value in R1 for return & check next byte: If it's a delimiter
; take successful return, else restore original input pointer
; and try to parse an expression.
RPDE: MOVEI R1,1 ; "D" => reg pair DE.
JRST RPCDEL
RPBC: TDZA R1,R1 ; "B" => reg pair BC.
RPHL: MOVEI R1,2 ; "H" => reg pair HL.
RPCDEL: CALL GETCHR ; Get next input byte.
CAIE R4,SCSE
CAIN R4,SCLE ; Is it a delimiter?
JRST CPOPJ1 ; Yes - Return reserved name value.
; No -- Try parsing as expression.
RPBEXP: MOVE RBPTR,R3 ; Restore original input pointer.
CALL SETCHR ; Prime for next parser.
RPEXP: CALL EXPR ; Parse input as expression.
RETURN ; No expr => no rp expr.
TRZE R1,777774 ; Is expression in proper range?
TRO RERR,ERRT ; No -- Truncate & flag error.
JRST CPOPJ1 ; Take "success" return.
; rp5 expression evaluation
; rp5 expressions are identical to rp expressions except
; that "PSW", rather than "SP", is the reserved name
; corresponding to value 3.
RP5:
CALL SETCHR ; %%%%
MOVE R3,RBPTR ; Save current input pointer.
CAIE RBYTE,"P ; Is next input byte "P"?
JRST RP5ENT ; No -- Parse as rp expression.
; Yes - Look for "SW<delimiter>".
CALL GETCHR ; Check for "S".
CAIE RBYTE,"S
JRST RPBEXP ; Not S => expression.
CALL GETCHR ; Check for "W".
CAIE RBYTE,"W
JRST RPBEXP ; Not W => expression.
; Initial input is "PSW": Preload return value (3)
; and check for delimiter, as in ordinary rp expressions.
MOVEI R1,3 ; Prepare to return 3 as rp5 value.
JRST RPCDEL ; Check for delimiter.
; rp7 expression evaluation
; rp7 expressions are identical to rp expressions, except
; that only BC and DE (values 0 & 1) may be specified.
RP7:
CALL RP ; Parse a full rp expression.
RETURN ; Propagate a failure return.
TRZE R1,2 ; Is rp value valid for rp7?
TRO RERR,ERRT ; No -- Truncate & flag error.
JRST CPOPJ1 ; Take "success" return.
; %%%%%%% glitches:
; "sp" for rp5 will be parsed as reserved name instead of expr.
; "DE" or "SP" for rp7 will get T flag instead of A.
OPCERR: ;ILLEGAL OP CODE
TRO R15,ERRO
RETURN
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
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
CALL EXPR0 ;GO EVALUATE EXPRESSION
RETURN ; NULL, EXIT
SOSLE RELLVL ;RELOCATION LEVEL .GT. 1?
TRO RERR,ERRA ; YES, FLAG ERROR
MOVE R1,R10 ; Insure expr value returned in R1.
JRST CPOPJ1 ;EXIT GOOD
EXPR0: ;EXPRESSION PROCESSOR
PUSH P,LOCRDX ;SAVE CURRENT RADIX
CALL TERM ;GET THE FIRST TERM
JRST EXPEX ; NULL, GO EXIT
CALL SETNB ; Set to check next nonblank character.
POP P,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(P) ;AND SAVE OP ADDRESS
PUSH P,R10 ;STACK CURRENT VALUE
PUSH P,LOCRDX ;SAVE CURRENT RADIX
CALL TERM ;GET NEXT TERM
TRO RERR,ERRQ ; NULL, FLAG ERROR
CALL SETNB ; Set to check next nonblank character.
POP P,LOCRDX ;RESTORE RADIX
POP P,R1 ;GET PREVIOUS VALUE
HLRZ R2,0(P) ; 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
EXPEX: POP P,LOCRDX ;RESTORE RADIX
RETURN ;EXIT
; Check for operators spelled out by Intel:
; AND, OR, XOR, MOD, SHL, and SHR.
EXPR3: PUSH P,RBPTR ; Save current input pointer.
CALL GETSYM ; Get a symbol.
JFCL ; Guaranteed there'll be one.
SETZ R2, ; Presume it won't match an operator.
CAMN R0,M40AND ; Check for "AND".
MOVEI R2,EXPRAN
CAMN R0,M40OR ; Check for "OR".
MOVEI R2,EXPROR
CAMN R0,M40XOR ; "XOR"
MOVEI R2,EXPRXR
CAMN R0,M40MOD ; "MOD"
MOVEI R2,EXPRMD
CAMN R0,M40SHL ; "SHL"
MOVEI R2,EXPRSH
CAMN R0,M40SHR ; "SHR"
MOVEI R2,EXPRSR
SKIPE R2 ; Was the symbol one of these?
JRST [SUB P,[1,,1] ; Yes - Discard old RBPTR
JRST EXPR2 ] ; and evaluate
POP P,RBPTR ; No -- Restore ptr to unknown input
JRST CPOPJ1 ; & exit with current expression value.
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
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(P) ;INDICATE GOOD RESULT
EXPRM2: XCT [ADDM R10,R1 ? SUBM R10,R1](R6) ;PERFORM OP
DPB R1,[002000,,R10] ;STORE TRIMMED RESULT
RETURN ;EXIT
EXPRPX: ;UPDATE RELOCATION LEVEL
TLNE R10,(PFMASK) ;IF ABS,
TLNE R10,GLBSYM ; OR GLOBAL,
RETURN ; NO ACTION
XCT [AOSA RELLVL ? SOSGE RELLVL](R6)
TRO R15,ERRA ; NEGATIVE COUNT, ERROR
RETURN
EXPROR: JSP R3,EXPXCT ; ! or OR
IOR R10,R1
EXPRXR: JSP R3,EXPXCT ; XOR
XOR R10,R1
EXPRAN: JSP R3,EXPXCT ; & or AND
AND R10,R1
EXPRMU: JSP R3,EXPXCT ; *
IMUL R10,R1
EXPRDV: JSP R3,EXPXCT ; /
CALL [ ANDI R10,177777
IDIV R10,R1
RETURN ]
EXPRMD: JSP R3,EXPXCT ; MOD
CALL [ IDIV R10,R1
MOVE R10,R11
RETURN ]
EXPRSR: MOVNS R10 ; SHR -- Make shift count negative.
HRRZ R10,R10 ; Keep relocation bits clear.
EXPRSH: JSP R3,EXPXCT ; _ or SHL
CALL [ ANDI R10,177777 ;get rid of extended sign
LSH R10,0(R1) ; so this is a logical shift
RETURN ]
EXPXCT: PUSH P,0(R3) ;STACK INSTRUCTION
CALL EXPXC1 ;TEST FOR ABSOLUTE
EXCH R10,R1
CALL EXPXC1 ;DITTO FOR OTHER
POP P,R3 ;FETCH INSTRUCTION
XCT R3 ;EXECUTE IT
ANDI R10,177777 ;MAKE ABSOLUTE
JRST CPOPJ1 ;GOOD EXIT
EXPXC1: CALL ABSTST ;TEST FOR ABSOLUTE
LSH R10,<36.-16.>
ASH R10,-<36.-16.> ;EXTEND SIGN
RETURN
ABSEXP: ;ABSOLUTE EXPRESSION
CALL EXPR
TRO R15,ERRA
ABSTST: TLZE R10,(<GLBSYM_18.>\pfmask)
TRO R15,ERRA ;ERROR IF GLOBAL OR RELOCATABLE
ANDI R10,177777
RETURN
TERPL: CALL GETNB ; Skip "+"
TERM: ;TERM PROCESSOR
SETZB R10,R1 ;RETURN VALUE IN R10
CALL GETSYM ;TRY FOR SYMBOL
JRST TERM4 ; NOT A SYMBOL
CAMN R0,M40NOT ; Is this a unary NOT?
JRST TERMNT ; Yes . . .
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 ;CLEAR ALL BITS
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
JRST CPOPJ1 ;GOOD EXIT
TERMNM: ;NUMERIC TERM
PUSH P,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,10. ;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
TERMNA: CAIL R14,"0 ;CHECK IF NUMERIC
JRST TERMN1 ; POSSIBLY, GO CHECK FURTHER
; Found a non-numeric digit:
TERMN3: MOVE R4,[-5,,0] ; Set up to scan radix ident table.
TERMN4: CAMN RBYTE,RADCHR(R4) ; Is terminator this radix selector?
JRST TERMN5 ; Yes - Force to matching radix.
AOBJN R4,TERMN4 ; No -- Check next radix selector.
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,[-1_16.] ;OVERFLOW?
TRO RERR,ERRT ; YES, FLAG truncation ERROR
POP P,R6 ;RESTORE R6.
JRST SETNB ; Find next nonblank byte & exit.
; Found a radix selector in RADCHR: Set selected radix
; to the matching value from RADTAB.
TERMN5: MOVE R6,RADTAB(R4) ; Get mask bit for selected radix.
CALL GETNB ; Skip the radix selector byte.
JRST TERMN7 ; Check for valid value in this radix.
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+10.(R14) ;ADD NUMERIC VALUE OF DIGIT
CAIE RBYTE,"D ; Is this digit "B" or "D"?
CAIN RBYTE,"B
CAIA ; Yes - May be a radix selector.
JRST TERMN2 ; No -- Rejoin numeric loop.
; Digit was "B" or "D": Decide whether this is a hex digit
; or a radix selector for binary or decimal by checking for
; the next byte being a delimiter.
PUSH P,RBPTR ; Save current input pointer.
CALL GETCHR ; Get next byte.
CAIE R4,SCSE ; Is it a separator or line-end byte?
CAIN R4,SCLE
JRST TERMN9 ; Yes - Select binary or decimal.
; No -- Continue collecting hex.
MOVEI R11,"D ; Indicate largest digit in hex range.
SUB P,[1,,1] ; Discard old input pointer.
JRST TERMNA ; Continue with next digit.
TERMN9: POP P,RBPTR ; Restore old input pointer.
CALL SETCHR ; Restore "B" or "D" as current byte.
JRST TERMN3 ; Select binary or decimal radix.
TERMSQ: ; "'"
; Collect an ASCII string delimited by single quotes.
; If more than two bytes are supplied, the last two
; determine the 16-bit value of the expression.
TLO R16,FOLBIT ; Suppress folding to collect ASCII.
TSQ1: CALL GETNT ; Get anything except EOL.
JRST TERMQE ; EOL: Flag error & quit here.
CAIN RBYTE,"' ; Is next byte "'"?
JRST TSQ2 ; Yes - Probably end of string.
; No -- Make it LSB of term value.
TSQ3: LSH R10,8 ; Shift term value left 1 byte.
IOR R10,RBYTE ; Set LSB = new byte.
JRST TSQ1 ; Get next character.
TSQ2: CALL GETCHR ; "'" encountered: Get next byte.
CAIN RBYTE,"' ; Is this a "''" sequence?
JRST TSQ3 ; Yes - Equivalent to "'" as data.
TLZ R16,FOLBIT ; No -- Restore folding.
JRST SETCHR ; Return with folded input byte.
TERMDL: ; "$"
MOVE R10,RLOC ; Term value = current PC value.
JRST GETCHR ; Skip "$" and return.
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
TERMNT: ; NOT
CALL TERM ; Get another term.
TRO RERR,ERRQ ; None => syntax error.
TRC R10,-1 ; Complement it.
TRZ R10,600000 ; Trim it to 16 bits.
JRST CPOPJ1 ; Exit as if successful.
TERMEX: ;"("
PUSH P,RELLVL ; Save current relocation level on stack.
SETZM RELLVL ; Start nested expression at reloc level 0.
SETZ r6, ; Clear possible record of "-" preceding "(".
CALL GETNB ;GOBBLE "("
; Try to resolve ambiguity between
; "(machine instruction)" and "(expression)".
CALL GETSYM ; Try to get a symbol.
JRST TERMX0 ; None -- must be (expr).
CALL OSRCH ; Got one - Is it an op code?
JRST TERMA1 ; No -- Treat as (expr).
; Yes - Assume (machine instr).
; "(machine instruction)" . . .
PUSH P,RLOC ; Save info destroyed by
PUSH P,OPCODE ; assembling a machine instruction.
PUSH P,CODPNT
PUSH P,INSLEN
CALL PROPC ; Assemble the parenthesized instr.
HRRZ R10,OPCODE ; Return its op code byte
TRZ R10,777400 ; as the term value.
POP P,INSLEN ; Restore info needed to assemble
POP P,CODPNT ; the instruction whose operand
POP P,OPCODE ; was an instruction.
POP P,RLOC
CALL SETNB ; %%%% [insure Rbyte gets ")"]
JRST TERMX2 ; Finish parsing term via ")" check.
; "(expression)" . . .
TERMA1: MOVE RBPTR,SYMBEG ; Restore pointer to start of expr.
TERMX0: CALL EXPR0 ;GET AN EXPRESSION
TRO RERR,ERRQ ; ERROR IF NULL
TERMX2: POP P,RELLVL ; Restore relocation level.
CAIE R14,") ;CHECK FOR CLOSING ")"
TROA RERR,ERRQ ; NO, FLAG ERROR
JRST GETNB ; YES, GOBBLE ">" & EXIT
WPB== 30. ; MACRO BLOCK SIZE
MACNES== 32. ; MACRO NESTING LIMIT
; -- THIS APPLIES TO BOTH NESTED MACRO
; DEFINITIONS AND NESTED CALLS.
PRGTTL: BLOCK 1
SUBMSG: BLOCK 30 ;SUBTITLE BUFFER AREA
TTLMSG: BLOCK 30 ; TITLE AREA
TTLFLA: BLOCK 1 ;=-1 IF PROGRAM NAME TYPED
FSEQ: BLOCK 2 ; FORMATTED LINE SEQUENCE NUMBER
CURSUM: BLOCK 1 ; Current value of checksum for a code segment
GLBRDX: BLOCK 1 ;GLOBAL RADIX (SET BY .RADIX)
RADVAL: BLOCK 1 ; VALUE OF GLOBAL RADIX
; (GLBRDX CONTAINS FLAGS!)
SKPCNT: BLOCK 1 ; Number of lines to skip following "skip n".
LSTCNT: BLOCK 1 ;LIST LEVEL COUNT
LSTCTL: BLOCK 1 ; LISTING CONTROL FLAGS
LIWORD: BLOCK 1 ; LISTING OVERRIDE FLAGS
ENACTL: BLOCK 1
ENWORD: BLOCK 1 ; ENABLE OVERRIDE FLAGS
NEXGS: BLOCK 1 ; NUMERIC VALUE OF NEXT
; MACRO-GENERATED LOCAL SYMBOL
PAGNUM: BLOCK 1 ;PAGE NUMBER
SEQ: BLOCK 1 ; LINE SEQUENCE NUMBER (BINARY)
LSBLOC: BLOCK 1 ; LOCAL SYMBOL BLOCK NUMBER
REPLVL: BLOCK 1 ;REPEAT LEVEL COUNTER
REQCNT: BLOCK 1 ; Level counter of .REQUIREs
CONLVL: BLOCK 1 ;CONDITIONAL LEVEL COUNTER
UNSLVL: BLOCK 1 ;UNSATISFIED CONDITIONAL NESTING LEVEL
NEXT: BLOCK 1 ;GARBAGE COLLECTION CHAIN
REPEXP: BLOCK 1 ;REPEAT EXPRESSION
REPPNT: BLOCK 1 ;REPEAT POINTER
ARGCNT: BLOCK 1 ; MACRO ARGUMENT COUNTER
ARGLEN: BLOCK 1 ; LENGTH OF MACRO-TYPE ARGUMENT
ARGSTR: BLOCK 100. ; SPACE FOR ARG AS ASCIZ STRING
ARGDEL: BLOCK 1 ; MACRO (.IRP) ARGUMENT DELIMITER
MWPNTR: BLOCK 1 ;MACRO WRITE POINTER
RELLVL: BLOCK 1 ;RELOCATION LEVEL
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 65. ; 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
OPCCNT: BLOCK 8.
CALLM:
MOVE R0,LSTCTL ; LOAD LIST CONTROL FLAGS
TRNN R0,LMC ; .NLIST MC IN EFFECT?
JRST [ TLO R16,NLISLN ; Yes - suppress list of this line
JRST IRPCAL ] ; and continue
TRNN R0,LME ; Should we print PC?
SKIPN MACLVL ; No - but first level always gets printed
MOVEM RLOC,PF0 ; Set PC for printout
IRPCAL: TLZA R16,IRPBIT ; ENTRY FROM .IRPC --
IRPAR: TLO R16,IRPBIT ; ENTRY FROM .IRP --
TLO R16,FOLBIT ; DON'T FOLD ARG VALUES.
PUSH P,R1 ;SAVE POINTER TO DEFINITION BLOCK
AOS (R1) ; 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 P,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 P,RBYTE ; SAVE ARGUMENT DELIMITER.
MOVEI RBYTE,QUEARG
CALL WTIMT ;MARK END OF ARGUMENT
POP P,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
PUSH P,ARGCNT ; Save arg counter
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+1
POP P,ARGCNT ; Restore arg count
POP P,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 P,R12 ;GET POINTER TO BASIC BLOCK
HRLI R12,(440700,,0) ;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 P,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 P,R7 ;RESTORE ARG COUNT
CALL SETNB ; AND LAST CHARACTER
MAC70A: CAIE R4,SCLE ; 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(P)
CAIE R10, ;TEST FOR END
CALL MAC71
HLRZ R14,0(P)
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 P,RBYTE ; SAVE CURRENT SOURCE BYTE.
CALL LOCVRT ; CONVERT NUMERIC PART OF LOCAL SYMBOL.
MOVEI RBYTE,"$ ; APPEND "$".
CALL WCIMT ; WRITE IT IN CALL BLOCK.
POP P,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,10. ; PICK OFF THE NEXT DIGIT.
HRLM R1,0(P) ; SAVE IT ON THE STACK.
CAIE R0,0 ; HAS QUOTIENT VANISHED?
CALL LOCVRT ; NO -- DO IT AGAIN.
HLRZ RBYTE,0(P) ; YES - RETRIEVE THE DIGIT.
TRO RBYTE,"0 ; TRANSLATE IT TO ASCII.
JRST WCIMT ; WRITE IN MACRO TREE & RETURN.
SUBTTL MACRO STORAGE HANDLERS
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
WTIMT: ;WRITE TWO CHARACTERS IN MACRO TREE
PUSH P,R14 ;STACK CURRENT CHARACTER
MOVEI R14,RUBOUT ;SET FLAG CHARACTER
CALL WCIMT ;WRITE IT
POP P,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 P,MWPNTR ;NEAD A NEW BLOCK, SAVE CURRENT POINTER
CALL GETBLK ;GET IT
HRRZ R11,MWPNTR ;GET START OF NEW BLOCK
EXCH R11,0(P) ;EXCHANGE WITH POINTER TO LAST
POP P,0(R11) ;STORE VECTOR
JRST WCIMT ;TRY AGAIN
WCIMT2: PUSH P,R14 ;STACK CURRENT CHARACTER
MOVEI R14,"'
CALL WCIMT ;WRITE CONCATENATION CHARACTER
POP P,R14 ;RESTORE CHARACTER
JRST WCIMT ;CONTINUE
; --- 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 P,R3 ; SAVE WORK REGISTERS.
PUSH P,R4
SETZM ARGLEN ; INIT STRING LENGTH TO 0.
MOVE R3,[440700,,ARGSTR] ; POINT TO SPACE FOR ARG STRING.
CALL SETNB ; GET 1ST NONBLANK BYTE.
CAIN R4,SCLE ; 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: CAIN R4,SCSE ; 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 P,R4 ; RESTORE REGISTER CONTENTS.
POP P,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 SYMBOL TABLE HANDLERS
; Symbol table entry format:
; @SYMPNT Symbol in rad50 format
; Bit 0 = 1 => symbol is macro name
; @VALPNT Left half: Attribute bits
; Right half: Value
; Remaining two words contain cross-ref info:
; @CR1PNT Left half: Line # of symbol definition
; Right half: Line # of first reference
; @CR2PNT Left half: Line # of second reference
; Right half: Link to reference block
; 0 in any cross-ref field => "none".
DELTA: BLOCK 1 ;BINARY SEARCH OFFSET
MSRCH: TLOA R0,MACBIT
SSRCH: ;SYMBOL SEARCH
TLZ R0,MACBIT
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
CAIG R2,1 ; Is DELTA too small now?
JRST SSRCH3 ; Yes - No such symbol defined.
CAMG R7,SYMLEN ; No -- Out of bounds?
JRST SSRCH1 ; No -- Check this entry.
JRST SSRCH2 ; Yes - Move back down.
SSRCH3: SETZB R1,R2
SUBI R7,2 ; Set index to start (not middle!)
RETURN ; of entry and take not-found exit.
SSRCH4: MOVE R1,@VALPNT ;FOUND, FETCH VALUE
LDB R2,TYPPNT ;SET TYPE POINTER
JRST CPOPJ1 ;EXIT +1
SUBTTL OP CODE TABLE
TYPOFF== 17. ;PACKING PARAMETERS
SUBOFF== 15.
LENOFF== 11.
BC1== 1
BC2== 2
;;TYPPNT: POINT 2,R1,TYPOFF ;TYPE POINTER
;;SUBPNT: POINT 4,R1,SUBOFF ;SUB-TYPE POINTER
;;LENPNT: POINT 2,R1,LENOFF ;INSTRUCTION LENGTH POINTER
;;CCSPNT: POINT 8,R5,SUBOFF ;CURRENT CSECT POINTER
typpnt: <<35.-typoff>_12.>+000200,,r1
subpnt: <<35.-suboff>_12.>+000400,,r1
lenpnt: <<35.-lenoff>_12.>+000200,,r1
MACBIT== 400000
;;PFMASK== 377B<SUBOFF>
pfmask==377_<35.-suboff>
ADMASK== 177777
;;;;PCMASK== PFMASK\ADMASK
PCMASK== ADMASK
DEFINE OP A,B,C,D,E,F,TYPE,LENGTH,VALUE
GENM40 A,B,C,D,E,F
<OCOP\<<TYPE>_2>\<<LENGTH>_6>>,,VALUE
TERMIN
DEFINE DIRDEF A,B,C,D,E,F,ADDRESS
GENM40 A,B,C,D,E,F
DIOP,,ADDRESS
TERMIN
OPTBOT: ;OP TABLE BOTTOM
OP A,C,I,,,,0,1,316 ; ACI CE
OP A,D,C,,,,8,0,ADCTAB ; ADC [88 or Z80 op]
OP A,D,D,,,,8,0,ADDTAB ; ADD [80 or Z80 op]
OP A,D,I,,,,0,1,306 ; ADI C6
OP A,N,A,,,,1,0,240 ; ANA A0
OP A,N,D,,,,8,0,ANDTAB ; AND [Z80 op]
OP A,N,I,,,,0,1,346 ; ANI E6
OP B,I,T,,,,8,0,BITTAB ; BIT [Z80 op]
OP C,A,L,L,,,9,0,4 ; CALL [CD & Z80 op]
OP C,C,,,,,0,2,334 ; CC DC
OP C,C,F,,,,0,0,077 ; CCF 3F [Z80 op for CMC]
OP C,M,,,,,0,2,374 ; CM FC
OP C,M,A,,,,0,0,057 ; CMA 2F
OP C,M,C,,,,0,0,077 ; CMC 3F
OP C,M,P,,,,1,0,270 ; CMP B8
OP C,N,C,,,,0,2,324 ; CNC D4
OP C,N,Z,,,,0,2,304 ; CNZ C4
;;;; OP C,P,,,,,0,2,364 ; CP F4
;;;; OP C,P,,,,,8,0,CPTAB ; CP [Z80 op]
DIRDEF C,P,,,,,CPOP
;******************************************************************
; CP assembles as either a Z80 compare or an 8080 call-if-positive,
; depending on the setting of Z80FLG.
;******************************************************************
OP C,P,D,,,,8,0,CPDTAB ; CPD [Z80 op]
OP C,P,D,R,,,8,0,CPDRTB ; CPDR [Z80 op]
OP C,P,E,,,,0,2,354 ; CPE EC
OP C,P,I,,,,8,0,CPITAB ; CPI [May be Z80 op]
OP C,P,I,R,,,8,0,CPIRTB ; CPIR [Z80 op]
OP C,P,L,,,,0,0,057 ; CPL 2F [Z80 op for CMA]
OP C,P,O,,,,0,2,344 ; CPO E4
OP C,Z,,,,,0,2,314 ; CZ CC
OP D,A,A,,,,0,0,047 ; DAA 27
OP D,A,D,,,,4,0,011 ; DAD 09
DIRDEF D,B,,,,,DB
OP D,C,R,,,,2,0,005 ; DCR 05
OP D,C,X,,,,4,0,013 ; DCX 0B
OP D,E,C,,,,8,0,DECTAB ; DEC [Z80 op]
OP D,I,,,,,0,0,363 ; DI F3
DIRDEF D,I,S,A,B,L,.DSABL
OP D,J,N,Z,,,9,0,3 ; DJNZ [Z80 instruction]
DIRDEF D,S,,,,,DS
DIRDEF D,W,,,,,DW
OP E,I,,,,,0,0,373 ; EI FB
DIRDEF E,N,A,B,L,E,.ENABL
DIRDEF E,N,D,,,,..END
ENDIF: DIRDEF E,N,D,I,F,,ENDC0
ENDM: DIRDEF E,N,D,M,,,.ENDM
DIRDEF E,Q,U,,,,EQU
OP E,X,,,,,8,0,EXTAB ; EX [Z80 op]
OP E,X,X,,,,0,0,331 ; EXX [Z80 op]
OP H,A,L,T,,,0,0,166 ; HALT 76 [Z80 op for HLT]
OP H,L,T,,,,0,0,166 ; HLT 76
IF: DIRDEF I,F,,,,,INIF
OP I,M,0,,,,8,0,IM0TAB ; IM0 [Z80 op]
OP I,M,1,,,,8,0,IM1TAB ; IM1 [Z80 op]
OP I,M,2,,,,8,0,IM2TAB ; IM2 [Z80 op]
OP I,N,,,,,8,0,INTAB ; IN [DB or Z80 op]
OP I,N,C,,,,8,0,INCTAB ; INC [Z80 op]
OP I,N,D,,,,8,0,INDTAB ; IND [Z80 op]
OP I,N,D,R,,,8,0,INDRTB ; INDR [Z80 op]
OP I,N,I,,,,8,0,INITAB ; INI [Z80 op]
OP I,N,I,R,,,8,0,INIRTB ; INIR [Z80 op]
OP I,N,R,,,,2,0,004 ; INR 04
OP I,N,X,,,,4,0,003 ; INX 03
OP J,C,,,,,0,2,332 ; JC DA
OP J,M,,,,,0,2,372 ; JM FA
OP J,M,P,,,,0,2,303 ; JMP C3
OP J,N,C,,,,0,2,322 ; JNC D2
OP J,N,Z,,,,0,2,302 ; JNZ C2
OP J,P,,,,,9,0,0 ; JP [F2 orZ80 op]
;*************************************************************
; JP is ambiguous between 8080 & Z80 assembly language;
; Which way it assembles depends on the setting of Z80FLG
; (set by "enable z80flg" or "disabl z80flg").
;*************************************************************
OP J,P,E,,,,0,2,352 ; JPE EA
OP J,P,O,,,,0,2,342 ; JPO E2
OP J,R,,,,,9,0,1 ; JR [Z80 op]
OP J,R,P,,,,9,0,2 ; JRP [Z80 op, JR or JP]
OP J,Z,,,,,0,2,312 ; JZ CA
OP L,D,,,,,8,0,LDTAB ; LD [Z80 instructions]
OP L,D,A,,,,0,2,072 ; LDA 3A
OP L,D,A,X,,,7,0,012 ; LDAX 0A
OP L,D,D,,,,8,0,LDDTAB ; LDD [Z80 op]
OP L,D,D,R,,,8,0,LDDRTB ; LDDR [Z80 op]
OP L,D,I,,,,8,0,LDITAB ; LDI [Z80 op]
OP L,D,I,R,,,8,0,LDIRTB ; LDIR [Z80 op]
OP L,H,L,D,,,0,2,052 ; LHLD 2A
DIRDEF L,I,S,T,,,.LIST
OP L,X,I,,,,4,2,001 ; LXI 01
MACRO: DIRDEF M,A,C,R,O,,DEFIN0
DIRDEF M,E,X,I,T,,.MEXIT
OP M,O,V,,,,3,0,100 ; MOV 40
OP M,V,I,,,,2,1,006 ; MVI 06
DIRDEF N,A,R,G,,,.NARG
DIRDEF N,C,H,R,,,.NCHR
OP N,E,G,,,,8,0,NEGTAB ; NEG [Z80 op]
DIRDEF N,L,I,S,T,,.NLIST
OP N,O,P,,,,0,0,000 ; NOP 00
OP O,R,,,,,8,0,ORTAB ; OR [Z80 op]
OP O,R,A,,,,1,0,260 ; ORA B0
DIRDEF O,R,G,,,,ORG
OP O,R,I,,,,0,1,366 ; ORI F6
OP O,T,D,R,,,8,0,OTDRTB ; OTDR [Z80 op]
OP O,T,I,R,,,8,0,OTIRTB ; OTIR [Z80 op]
OP O,U,T,,,,8,0,OUTTAB ; OUT [D3 or Z80 op]
OP O,U,T,D,,,8,0,OUTDTB ; OUTD [Z80 op]
OP O,U,T,I,,,8,0,OUTITB ; OUTI [Z80 op]
DIRDEF P,A,G,E,,,.PAGE
OP P,C,H,L,,,0,0,351 ; PCHL E9
OP P,O,P,,,,8,0,POPTAB ; POP [C1 or Z80 instr]
OP P,U,S,H,,,8,0,PUSHTB ; PUSH [C5 or Z80 instr]
DIRDEF R,A,D,I,X,,..RADIX
OP R,A,L,,,,0,0,027 ; RAL 17
OP R,A,R,,,,0,0,037 ; RAR 1F
OP R,C,,,,,0,0,330 ; RC D8
OP R,E,S,,,,8,0,RESTAB ; RES [Z80 op]
OP R,E,T,,,,9,0,5 ; RET [C9 & Z80 op]
OP R,E,T,I,,,8,0,RETITB ; RETI [Z80 op]
OP R,E,T,N,,,8,0,RETNTB ; RETN [Z80 op]
OP R,I,M,,,,0,0,040 ; RIM 20 [8085 op]
OP R,L,,,,,8,0,RLTAB ; RL [Z80 op]
OP R,L,A,,,,0,0,027 ; RLA 17 [Z80 op for RAL]
OP R,L,C,,,,8,0,RLCTAB ; RLC 07 or Z80 op
OP R,L,C,A,,,0,0,007 ; TLCA 07 [Z80 op for RLC]
OP R,L,D,,,,8,0,RLDTAB ; RLD [Z80 op]
OP R,M,,,,,0,0,370 ; RM F8
OP R,N,C,,,,0,0,320 ; RNC D0
OP R,N,Z,,,,0,0,300 ; RNZ C0
OP R,P,,,,,0,0,360 ; RP F0
OP R,P,E,,,,0,0,350 ; RPE E8
OP R,P,O,,,,0,0,340 ; RPO E0
OP R,R,,,,,8,0,RRTAB ; RR [Z80 op]
OP R,R,A,,,,0,0,037 ; RRA 1F [Z80 op for RAR]
OP R,R,C,,,,8,0,RRCTAB ; RRC 0F or Z80 op
OP R,R,C,A,,,0,0,017 ; RRCA 0F [Z80 op for RRC]
OP R,R,D,,,,8,0,RRDTAB ; RRD [Z80 op]
OP R,S,T,,,,6,0,307 ; RST C7
OP R,Z,,,,,0,0,310 ; RZ C8
OP S,B,B,,,,1,0,230 ; SBB 98
OP S,B,C,,,,8,0,SBCTAB ; SBC [Z80 op]
OP S,B,I,,,,0,1,336 ; SBI DE
OP S,C,F,,,,0,0,067 ; SCF 37 [Z80 op for STC]
DIRDEF S,E,T,,,,SET
;***************************************************************
; SET is ambiguous: If Z80FLG is set, SET directive
; processing enters Z80PRS to assemble a Z80 bit-set
; operation; otherwise it handles an 8080 assembly-time
; assignment. SETT is synonymous with 8080 SET, even
; when Z80FLG is set.
;***************************************************************
DIRDEF S,E,T,T,,,SET80 ; Z80 version of 8080 SET
OP S,H,L,D,,,0,2,042 ; SHLD 22
OP S,I,M,,,,0,0,060 ; SIM 30 [8085 op]
DIRDEF S,K,I,P,,,SKIP.
OP S,L,A,,,,8,0,SLATAB ; SLA [Z80 op]
OP S,P,H,L,,,0,0,371 ; SPHL F9
OP S,R,A,,,,8,0,SRATAB ; SRA [Z80 op]
OP S,R,L,,,,8,0,SRLTAB ; SRL [Z80 op]
OP S,T,A,,,,0,2,062 ; STA 32
OP S,T,A,X,,,7,0,002 ; STAX 02
OP S,T,C,,,,0,0,067 ; STC 37
OP S,U,B,,,,8,0,SUBTAB ; SUB [90 or Z80 op]
DIRDEF S,U,B,H,E,D,.SBHED
DIRDEF S,U,B,T,T,L,.SBTTL
OP S,U,I,,,,0,1,326 ; SUI D6
DIRDEF T,I,T,L,E,,.TITLE
OP X,C,H,G,,,0,0,353 ; XCHG EB
OP X,O,R,,,,8,0,XORTAB ; XOR [Z80 op]
OP X,R,A,,,,1,0,250 ; XRA A8
OP X,R,I,,,,0,1,356 ; XRI EE
OP X,T,H,L,,,0,0,343 ; XTHL E3
DIRDEF .,C,K,S,U,M,.CKSUM
DIRDEF .,E,R,R,O,R, .ERROR
;; DIRDEF .,G,L,O,B,L,.GLOBL
.IFX: DIRDEF .,I,F,,,,.IF
.IFFX: DIRDEF .,I,F,F,,,.IFF
.IFTX: DIRDEF .,I,F,T,,,.IFT
.IFTFX: DIRDEF .,I,F,T,F,,.IFTF
.IFY: DIRDEF .,I,I,F,,,.IIF
DIRDEF .,I,N,S,E,R,.INSERT
.IRPOP: DIRDEF .,I,R,P,,,.IRP
.IRCOP: DIRDEF .,I,R,P,C,,.IRPC
;; DIRDEF .,L,I,M,I,T,.LIMIT
DIRDEF .,O,P,D,E,F,.OPDEF
DIRDEF .,P,R,I,N,T,.PRINT
;; DIRDEF .,P,S,E,C,T,PSECT
.REPTX: DIRDEF .,R,E,P,T,,REPEA0
OPTTOP: -1_-1 ;OP TABLE TOP
SUBTTL Z80 Parse tables for individual mnemonics
; Table entry format:
; XWD type,value ; Type & value code for 1st operand
; XWD type,value ; Type & value code for 2nd operand
; XWD format,memopcode
; BYTE (8) [op skeleton]
; Operand type & value codes are . . .
; Type code Value
; --------- -----
; [null] 0 0
; register: 1 [also called regm]
; B 0
; C 1
; D 2
; E 3
; H 4
; L 5
; M 6
; A 7
; register pair: 2
; BC 0
; DE 1
; HL 2
; SP 3
; AF 4
; AF' 5
; special registers: 3
; I 0
; IX 1
; IY 2
; R 3
; Indirect: 4
; (HL) 0
; (DE) 1
; (BC) 2
; (SP) 3
; (IX) 4
; (IY) 5
; (C) 6
; (IX+d) 5 d
; (IY+d) 6 d
; expr 7 expr
; (expr) 8 expr
; Memopcode (memory operands code) is . . .
; 0 No memory operands are appended to basic op skeleton
; 1 Op1 is a 1-byte memory operand
; 2 Op2 is a 1-byte memory operand
; 3 Op1 is a 2-byte memory operand
; 4 Op2 is a 2-byte memory operand
; 5 Op1 & op2 are both 1-byte memory operands
; Format codes & the instruction formats they represent . . .
; -- All formats except 13 & 15 may be followed by
; a one-byte operand, a two-byte operand, or
; two one-byte operands.
; ---------------------------------
; Format 0: ! opcode !
; --7---6---5---4---3---2---1---0--
; ---------------------------------
; Format 1: ! opcode ! regm !
; --7---6---5---4---3---2---1---0--
; ---------------------------------
; Format 2: ! op ! regm ! op !
; --7---6---5---4---3---2---1---0--
; ---------------------------------
; Format 3: ! op ! regm ! regm !
; --7---6---5---4---3---2---1---0--
; ---------------------------------
; Format 4: ! op ! rp[1] ! op !
; --7---6---5---4---3---2---1---0--
; ---------------------------------
; Format 5: ! op ! rp5 ! op !
; --7---6---5---4---3---2---1---0--
; ---------------------------------
; Format 6: ! op ! rp[2] ! op !
; --7---6---5---4---3---2---1---0--
; ---------------------------------
; Format 7: ! op ! rp7 ! op !
; --7---6---5---4---3---2---1---0--
; ---------------------------------
; ! opcode !
; Format 8: --7---6---5---4---3---2---1---0--
; ! opcode !
; --7---6---5---4---3---2---1---0--
; ---------------------------------
; ! opcode !
; Format 9: --7---6---5---4---3---2---1---0--
; ! opcode ! reg !
; --7---6---5---4---3---2---1---0--
; ---------------------------------
; ! opcode !
; Format 10: --7---6---5---4---3---2---1---0--
; ! op ! reg ! op !
; --7---6---5---4---3---2---1---0--
; ---------------------------------
; ! opcode !
; Format 11: --7---6---5---4---3---2---1---0--
; ! op ! rp[1] ! op !
; --7---6---5---4---3---2---1---0--
; ---------------------------------
; ! opcode !
; Format 12: --7---6---5---4---3---2---1---0--
; ! op ! rp[2] ! op !
; --7---6---5---4---3---2---1---0--
; ---------------------------------
; ! opcode !
; --7---6---5---4---3---2---1---0--
; ! opcode !
; Format 13: --7---6---5---4---3---2---1---0--
; ! displacement value !
; --7---6---5---4---3---2---1---0--
; ! opcode !
; --7---6---5---4---3---2---1---0--
; ---------------------------------
; ! opcode !
; Format 14: --7---6---5---4---3---2---1---0--
; ! op ! bit ! reg !
; --7---6---5---4---3---2---1---0--
; ---------------------------------
; ! opcode !
; --7---6---5---4---3---2---1---0--
; ! opcode !
; Format 15: --7---6---5---4---3---2---1---0--
; ! displacement value !
; --7---6---5---4---3---2---1---0--
; ! op ! bit ! op !
; --7---6---5---4---3---2---1---0--
LDTAB: ; LD
1,,-1
1,,-1 ; LD r,r'
3,,0
.BYTE 8 ? 100 ? .BYTE
1,,-1
7,,-1 ; LD r,n
2,,2
.BYTE 8 ? 006 ? .BYTE
1,,-1
4,,0 ; LD r,(HL)
3,,0
.BYTE 8 ? 106 ? .BYTE
1,,-1
5,,-1 ; LD r,(IX+d)
10.,,2
.BYTE 8 ? 335 ? 106 ? .BYTE
1,,-1
6,,-1 ; LD r,(IY+d)
10.,,2
.BYTE 8 ? 375 ? 106 ? .BYTE
4,,0
1,,-1 ; LD (HL),r
3,,0
.BYTE 8 ? 160 ? .BYTE
5,,-1
1,,-1 ; LD (IX+d),r
9.,,1
.BYTE 8 ? 335 ? 160 ? .BYTE
6,,-1
1,,-1 ; LD (IY+d),r
9.,,1
.BYTE 8 ? 375 ? 160 ? .BYTE
4,,0
7,,-1 ; LD (HL),n
2,,2
.BYTE 8 ? 066 ? .BYTE
5,,-1
7,,-1 ; LD (IX+d),n
8,,5
.BYTE 8 ? 335 ? 066 ? .BYTE
6,,-1
7,,-1 ; LD (IY+d),n
8,,5
.BYTE 8 ? 375 ? 066 ? .BYTE
1,,7
4,,2 ; LD A,(BC)
0,,0
.BYTE 8 ? 012 ? .BYTE
1,,7
4,,1 ; LD A,(DE)
0,,0
.BYTE 8 ? 032 ? .BYTE
1,,7
8,,-1 ; LD A,(nn)
2,,4
.BYTE 8 ? 072 ? .BYTE
4,,2
1,,7 ; LD (BC),A
0,,0
.BYTE 8 ? 002 ? .BYTE
4,,1
1,,7 ; LD (DE),A
0,,0
.BYTE 8 ? 022 ? .BYTE
8,,-1
1,,7 ; LD (nn),A
0,,3
.BYTE 8 ? 062 ? .BYTE
1,,7
3,,0 ; LD A,I
8,,0
.BYTE 8 ? 355 ? 127 ? .BYTE
1,,7
3,,3 ; LD A,R
8,,0
.BYTE 8 ? 355 ? 137 ? .BYTE
3,,0
1,,7 ; LD I,A
8,,0
.BYTE 8 ? 355 ? 107 ? .BYTE
3,,3
1,,7 ; LD R,A
8,,0
.BYTE 8 ? 355 ? 117 ? .BYTE
2,,-1
7,,-1 ; LD dd,nn
4,,4
.BYTE 8 ? 001 ? .BYTE
3,,1
7,,-1 ; LD IX,nn
8,,4
.BYTE 8 ? 335 ? 041 ? .BYTE
3,,2
7,,-1 ; LD IY,nn
8,,4
.BYTE 8 ? 375 ? 041 ? .BYTE
2,,2
8,,-1 ; LD HL,(nn)
0,,4
.BYTE 8 ? 052 ? .BYTE
2,,-1
8,,-1 ; LD dd,(nn)
11.,,4
.BYTE 8 ? 355 ? 113 ? .BYTE
3,,1
8,,-1 ; LD IX,(nn)
8,,4
.BYTE 8 ? 335 ? 052 ? .BYTE
3,,2
8,,-1 ; LD IY,(nn)
8,,4
.BYTE 8 ? 375 ? 052 ? .BYTE
8,,-1
2,,2 ; LD (nn),HL
0,,3
.BYTE 8 ? 042 ? .BYTE
;;;; 8,,-1
;;;; 2,,-1 ; LD (nn),dd
;;;; 11.,,3
;;;; .BYTE 8 ? 355 ? 103 ? .BYTE
8,,-1
2,,0 ; LD (nn),BC
8,,3
.BYTE 8 ? 355 ? 103 ? .BYTE
8,,-1
2,,1 ; LD (nn),DE
8,,3
.BYTE 8 ? 355 ? 123 ? .BYTE
8,,-1
2,,3 ; LD (nn),SP
8,,3
.BYTE 8 ? 355 ? 163 ? .BYTE
8,,-1
3,,1 ; LD (nn),IX
8,,3
.BYTE 8 ? 335 ? 042 ? .BYTE
8,,-1
3,,2 ; LD (nn),IY
8,,3
.BYTE 8 ? 375 ? 042 ? .BYTE
2,,3
2,,2 ; LD SP,HL
0,,0
.BYTE 8 ? 371 ? .BYTE
2,,3
3,,1 ; LD SP,IX
8,,0
.BYTE 8 ? 335 ? 371 ? .BYTE
2,,3
3,,2 ; LD SP,IY
8,,0
.BYTE 8 ? 375 ? 371 ? .BYTE
0 ; End of LD parse table
PUSHTB: ; PUSH
2,,-1
0 ; PUSH qq
5,,0
.BYTE 8 ? 305 ? .BYTE
3,,1
0 ; PUSH IX
8,,0
.BYTE 8 ? 335 ? 345 ? .BYTE
3,,2
0 ; PUSH IY
8,,0
.BYTE 8 ? 375 ? 345 ? .BYTE
1,,0
0 ; PUSH B [8080 syntax]
0
.BYTE 8 ? 305 ? .BYTE
1,,2
0 ; PUSH D [8080 syntax]
0
.BYTE 8 ? 325 ? .BYTE
1,,4
0 ; PUSH H [8080 syntax]
0
.BYTE 8 ? 345 ? .BYTE
0 ; End of PUSH parse table
POPTAB: ; POP
2,,-1
0 ; POP qq
5,,0
.BYTE 8 ? 301 ? .BYTE
3,,1
0 ; POP IX
8,,0
.BYTE 8 ? 335 ? 341 ? .BYTE
3,,2
0 ; POP IY
8,,0
.BYTE 8 ? 375 ? 341 ? .BYTE
1,,0
0 ; POP B [8080 syntax]
0
.BYTE 8 ? 301 ? .BYTE
1,,2
0 ; POP D [8080 syntax]
0
.BYTE 8 ? 321 ? .BYTE
1,,4
0 ; POP H [8080 syntax]
0
.BYTE 8 ? 341 ? .BYTE
0 ; End of POP parse table
EXTAB: ; EX
2,,1
2,,2 ; EX DE,HL
0
.BYTE 8 ? 353 ? .BYTE
2,,4
2,,5 ; EX AF,AF'
0
.BYTE 8 ? 010 ? .BYTE
4,,3
2,,2 ; EX (SP),HL
0
.BYTE 8 ? 343 ? .BYTE
4,,3
3,,1 ; EX (SP),IX
8,,0
.BYTE 8 ? 335 ? 343 ? .BYTE
4,,3
3,,2 ; EX (SP),IY
8,,0
.BYTE 8 ? 375 ? 343 ? .BYTE
0 ; End of EX parse table
LDITAB: ; LDI
0
0 ; LDI
8,,0
.BYTE 8 ? 355 ? 240 ? .BYTE
0 ; End of LDI parse table
LDIRTB: ; LDIR
0
0 ; LDIR
8,,0
.BYTE 8 ? 355 ? 260 ? .BYTE
0 ; End of LDIR parse table
LDDTAB: ; LDD
0
0 ; LDD
8,,0
.BYTE 8 ? 355 ? 250 ? .BYTE
0 ; End of LDD parse table
LDDRTB: ; LDDR
0
0 ; LDDR
8,,0
.BYTE 8 ? 355 ? 270 ? .BYTE
0 ; End of LDDR parse table
CPITAB: ; CPI
0
0 ; CPI
8,,0
.BYTE 8 ? 355 ? 241 ? .BYTE
7,,-1
0 ; CPI n [8080 instruction]
0,,1
.BYTE 8 ? 376 ? .BYTE
0 ; End of CPI parse table
CPIRTB: ; CPIR
0
0 ; CPIR
8,,0
.BYTE 8 ? 355 ? 261 ? .BYTE
0 ; End of CPIR parse table
CPDTAB: ; CPD
0
0 ; CPD
8,,0
.BYTE 8 ? 355 ? 251 ? .BYTE
0 ; End of CPD parse table
CPDRTB: ; CPDR
0
0 ; CPDR
8,,0
.BYTE 8 ? 355 ? 271 ? .BYTE
0 ; End of CPDR parse table
ADDTAB: ; ADD
1,,7
1,,-1 ; ADD A,r
1,,0
.BYTE 8 ? 200 ? .BYTE
1,,7
7,,-1 ; ADD A,n
0,,2
.BYTE 8 ? 306 ? .BYTE
1,,7
4,,0 ; ADD A,(HL)
0,,0
.BYTE 8 ? 206 ? .BYTE
1,,7
5,,-1 ; ADD A,(IX+d)
8,,2
.BYTE 8 ? 335 ? 206 ? .BYTE
1,,7
6,,-1 ; ADD A,(IY+d)
8,,2
.BYTE 8 ? 375 ? 206 ? .BYTE
1,,-1
0 ; ADD r [8080 syntax]
1,,0
.BYTE 8 ? 200 ? .BYTE
2,,2
2,,-1 ; ADD HL,ss
6,,0
.BYTE 8 ? 011 ? .BYTE
3,,1
2,,0 ; ADD IX,BC
8,,0
.BYTE 8 ? 335 ? 011 ? .BYTE
3,,1
2,,1 ; ADD IX,DE
8,,0
.BYTE 8 ? 335 ? 031 ? .BYTE
3,,1
3,,1 ; ADD IX,IX
8,,0
.BYTE 8 ? 335 ? 051 ? .BYTE
3,,1
2,,3 ; ADD IX,SP
8,,0
.BYTE 8 ? 335 ? 071 ? .BYTE
3,,2
2,,0 ; ADD IY,BC
8,,0
.BYTE 8 ? 375 ? 011 ? .BYTE
3,,2
2,,1 ; ADD IY,DE
8,,0
.BYTE 8 ? 375 ? 031 ? .BYTE
3,,2
3,,2 ; ADD IY,IY
8,,0
.BYTE 8 ? 375 ? 051 ? .BYTE
3,,2
2,,3 ; ADD IY,SP
8,,0
.BYTE 8 ? 375 ? 071 ? .BYTE
0 ; End of ADD parse table
ADCTAB: ; ADC
1,,7
1,,-1 ; ADC A,r
1,,0
.BYTE 8 ? 210 ? .BYTE
1,,7
7,,-1 ; ADC A,n
0,,2
.BYTE 8 ? 316 ? .BYTE
1,,7
4,,0 ; ADC A,(HL)
0,,0
.BYTE 8 ? 216 ? .BYTE
1,,7
5,,-1 ; ADC A,(IX+d)
8,,2
.BYTE 8 ? 335 ? 216 ? .BYTE
1,,7
6,,-1 ; ADC A,(IY+d)
8,,2
.BYTE 8 ? 375 ? 216 ? .BYTE
1,,-1
0 ; ADC r [8080 syntax]
1,,0
.BYTE 8 ? 210 ? .BYTE
2,,2
2,,-1 ; ADC HL,ss
12.,,0
.BYTE 8 ? 355 ? 112 ? .BYTE
0 ; End of ADC parse table
SUBTAB: ; SUB
1,,-1
0 ; SUB r
1,,0
.BYTE 8 ? 220 ? .BYTE
7,,-1
0 ; SUB n
0,,1
.BYTE 8 ? 326 ? .BYTE
4,,0
0 ; SUB (HL)
0,,0
.BYTE 8 ? 226 ? .BYTE
5,,-1
0 ; SUB (IX+d)
8,,1
.BYTE 8 ? 335 ? 226 ? .BYTE
6,,-1
0 ; SUB (IY+d)
8,,1
.BYTE 8 ? 375 ? 226 ? .BYTE
0 ; End of SUB parse table
SBCTAB: ; SBC
1,,7
1,,-1 ; SBC A,r
1,,0
.BYTE 8 ? 230 ? .BYTE
1,,7
7,,-1 ; SBC A,n
0,,2
.BYTE 8 ? 336 ? .BYTE
1,,7
4,,0 ; SBC A,(HL)
0,,0
.BYTE 8 ? 236 ? .BYTE
1,,7
5,,-1 ; SBC A,(IX+d)
8,,2
.BYTE 8 ? 335 ? 236 ? .BYTE
1,,7
6,,-1 ; SBC A,(IY+d)
8,,2
.BYTE 8 ? 375 ? 236 ? .BYTE
2,,2
2,,-1 ; SBC HL,ss
12.,,0
.BYTE 8 ? 355 ? 102 ? .BYTE
0 ; End of SBC parse table
ANDTAB: ; AND
1,,-1
0 ; AND r
1,,0
.BYTE 8 ? 240 ? .BYTE
7,,-1
0 ; AND n
0,,1
.BYTE 8 ? 346 ? .BYTE
4,,0
0 ; AND (HL)
0,,0
.BYTE 8 ? 246 ? .BYTE
5,,-1
0 ; AND (IX+d)
8,,1
.BYTE 8 ? 335 ? 246 ? .BYTE
6,,-1
0 ; AND (IY+d)
8,,1
.BYTE 8 ? 375 ? 246 ? .BYTE
0 ; End of AND parse table
ORTAB: ; OR
1,,-1
0 ; OR r
1,,0
.BYTE 8 ? 260 ? .BYTE
7,,-1
0 ; OR n
0,,1
.BYTE 8 ? 366 ? .BYTE
4,,0
0 ; OR (HL)
0,,0
.BYTE 8 ? 266 ? .BYTE
5,,-1
0 ; OR (IX+d)
8,,1
.BYTE 8 ? 335 ? 266 ? .BYTE
6,,-1
0 ; OR (IY+d)
8,,1
.BYTE 8 ? 375 ? 266 ? .BYTE
0 ; End of OR parse table
XORTAB: ; XOR
1,,-1
0 ; XOR r
1,,0
.BYTE 8 ? 250 ? .BYTE
7,,-1
0 ; XOR n
0,,1
.BYTE 8 ? 356 ? .BYTE
4,,0
0 ; XOR (HL)
0,,0
.BYTE 8 ? 256 ? .BYTE
5,,-1
0 ; XOR (IX+d)
8,,1
.BYTE 8 ? 335 ? 256 ? .BYTE
6,,-1
0 ; XOR (IY+d)
8,,1
.BYTE 8 ? 375 ? 256 ? .BYTE
0 ; End of XOR parse table
CPTAB: ; CP
1,,-1
0 ; CP r
1,,0
.BYTE 8 ? 270 ? .BYTE
7,,-1
0 ; CP n
0,,1
.BYTE 8 ? 376 ? .BYTE
4,,0
0 ; CP (HL)
0,,0
.BYTE 8 ? 276 ? .BYTE
5,,-1
0 ; CP (IX+d)
8,,1
.BYTE 8 ? 335 ? 276 ? .BYTE
6,,-1
0 ; CP (IY+d)
8,,1
.BYTE 8 ? 375 ? 276 ? .BYTE
0 ; End of CP parse table
INCTAB: ; INC
1,,-1
0 ; INC r
2,,0
.BYTE 8 ? 004 ? .BYTE
4,,0
0 ; INC (HL)
0,,0
.BYTE 8 ? 064 ? .BYTE
5,,-1
0 ; INC (IX+d)
8,,1
.BYTE 8 ? 335 ? 064 ? .BYTE
6,,-1
0 ; INC (IY+d)
8,,1
.BYTE 8 ? 375 ? 064 ? .BYTE
2,,-1
0 ; INC ss
4,,0
.BYTE 8 ? 003 ? .BYTE
3,,1
0 ; INC IX
8,,0
.BYTE 8 ? 335 ? 043 ? .BYTE
3,,2
0 ; INC IY
8,,0
.BYTE 8 ? 375 ? 043 ? .BYTE
0 ; End of INC parse table
DECTAB: ; DEC
1,,-1
0 ; DEC r
2,,0
.BYTE 8 ? 005 ? .BYTE
4,,0
0 ; DEC (HL)
0,,0
.BYTE 8 ? 065 ? .BYTE
5,,-1
0 ; DEC (IX+d)
8,,1
.BYTE 8 ? 335 ? 065 ? .BYTE
6,,-1
0 ; DEC (IY+d)
8,,1
.BYTE 8 ? 375 ? 065 ? .BYTE
2,,-1
0 ; DEC ss
4,,0
.BYTE 8 ? 013 ? .BYTE
3,,1
0 ; DEC IX
8,,0
.BYTE 8 ? 335 ? 053 ? .BYTE
3,,2
0 ; DEC IY
8,,0
.BYTE 8 ? 375 ? 053 ? .BYTE
0 ; End of DEC parse table
NEGTAB: ; NEG
0
0 ; NEG
8,,0
.BYTE 8 ? 355 ? 104 ? .BYTE
0 ; End of NEG parse table
IM0TAB: ; IM0
0
0 ; IM0
8,,0
.BYTE 8 ? 355 ? 106 ? .BYTE
0 ; End of IM0 parse table
IM1TAB: ; IM1
0
0 ; IM1
8,,0
.BYTE 8 ? 355 ? 126 ? .BYTE
0 ; End of IM1 parse table
IM2TAB: ; IM2
0
0 ; IM2
8,,0
.BYTE 8 ? 355 ? 136 ? .BYTE
0 ; End of IM2 parse table
RLCTAB: ; RLC
0
0 ; RLC [8080 op for RLCA]
0,,0
.BYTE 8 ? 007 ? .BYTE
1,,-1
0 ; RLC r
9,,0
.BYTE 8 ? 313 ? 000 ? .BYTE
4,,0
0 ; RLC (HL)
8,,0
.BYTE 8 ? 313 ? 006 ? .BYTE
5,,-1
0 ; RLC (IX+d)
13.,,0
.BYTE 8 ? 335 ? 313 ? 0 ? 006 ? .BYTE
6,,-1
0 ; RLC (IY+d)
13.,,0
.BYTE 8 ? 375 ? 313 ? 0 ? 006 ? .BYTE
0 ; End of RLC parse table
RLTAB: ; RL
1,,-1
0 ; RL r
9,,0
.BYTE 8 ? 313 ? 020 ? .BYTE
4,,0
0 ; RL (HL)
8,,0
.BYTE 8 ? 313 ? 026 ? .BYTE
5,,-1
0 ; RL (IX+d)
13.,,0
.BYTE 8 ? 335 ? 313 ? 0 ? 026 ? .BYTE
6,,-1
0 ; RL (IY+d)
13.,,0
.BYTE 8 ? 375 ? 313 ? 0 ? 026 ? .BYTE
0 ; End of RL parse table
RRCTAB: ; RRC
0
0 ; RRC [8080 op for RRCA]
0,,0
.BYTE 8 ? 017 ? .BYTE
1,,-1
0 ; RRC r
9,,0
.BYTE 8 ? 313 ? 010 ? .BYTE
4,,0
0 ; RRC (HL)
8,,0
.BYTE 8 ? 313 ? 016 ? .BYTE
5,,-1
0 ; RRC (IX+d)
13.,,0
.BYTE 8 ? 335 ? 313 ? 0 ? 016 ? .BYTE
6,,-1
0 ; RRC (IY+d)
13.,,0
.BYTE 8 ? 375 ? 313 ? 0 ? 016 ? .BYTE
0 ; End of RRC parse table
RRTAB: ; RR
1,,-1
0 ; RR r
9,,0
.BYTE 8 ? 313 ? 030 ? .BYTE
4,,0
0 ; RR (HL)
8,,0
.BYTE 8 ? 313 ? 036 ? .BYTE
5,,-1
0 ; RR (IX+d)
13.,,0
.BYTE 8 ? 335 ? 313 ? 0 ? 036 ? .BYTE
6,,-1
0 ; RR (IY+d)
13.,,0
.BYTE 8 ? 375 ? 313 ? 0 ? 036 ? .BYTE
0 ; End of RR parse table
SLATAB: ; SLA
1,,-1
0 ; SLA r
9,,0
.BYTE 8 ? 313 ? 040 ? .BYTE
4,,0
0 ; SLA (HL)
8,,0
.BYTE 8 ? 313 ? 046 ? .BYTE
5,,-1
0 ; SLA (IX+d)
13.,,0
.BYTE 8 ? 335 ? 313 ? 0 ? 046 ? .BYTE
6,,-1
0 ; SLA (IY+d)
13.,,0
.BYTE 8 ? 375 ? 313 ? 0 ? 046 ? .BYTE
0 ; End of SLA parse table
SRATAB: ; SRA
1,,-1
0 ; SRA r
9,,0
.BYTE 8 ? 313 ? 050 ? .BYTE
4,,0
0 ; SRA (HL)
8,,0
.BYTE 8 ? 313 ? 056 ? .BYTE
5,,-1
0 ; SRA (IX+d)
13.,,0
.BYTE 8 ? 335 ? 313 ? 0 ? 056 ? .BYTE
6,,-1
0 ; SRA (IY+d)
13.,,0
.BYTE 8 ? 375 ? 313 ? 0 ? 056 ? .BYTE
0 ; End of SRA parse table
SRLTAB: ; SRL
1,,-1
0 ; SRL r
9,,0
.BYTE 8 ? 313 ? 070 ? .BYTE
4,,0
0 ; SRL (HL)
8,,0
.BYTE 8 ? 313 ? 076 ? .BYTE
5,,-1
0 ; SRL (IX+d)
13.,,0
.BYTE 8 ? 335 ? 313 ? 0 ? 076 ? .BYTE
6,,-1
0 ; SRL (IY+d)
13.,,0
.BYTE 8 ? 375 ? 313 ? 0 ? 076 ? .BYTE
0 ; End of SRL parse table
RLDTAB: ; RLD
0
0 ; RLD
8,,0
.BYTE 8 ? 355 ? 157 ? .BYTE
0 ; End of RLD parse table
RRDTAB: ; RRD
0
0 ; RRD
8,,0
.BYTE 8 ? 355 ? 147 ? .BYTE
0 ; End of RRD parse table
BITTAB: ; BIT
7,,-1
1,,-1 ; BIT b,r
14.,,0
.BYTE 8 ? 313 ? 100 ? .BYTE
7,,-1
4,,0 ; BIT b,(HL)
14.,,0
.BYTE 8 ? 313 ? 100 ? .BYTE
7,,-1
5,,-1 ; BIT b,(IX+d)
15.,,0
.BYTE 8 ? 335 ? 313 ? 0 ? 106 ? .BYTE
7,,-1
6,,-1 ; BIT b,(IY+d)
15.,,0
.BYTE 8 ? 375 ? 313 ? 0 ? 106 ? .BYTE
0 ; End of BIT parse table
SETTAB: ; SET
7,,-1
1,,-1 ; SET b,r
14.,,0
.BYTE 8 ? 313 ? 300 ? .BYTE
7,,-1
4,,0 ; SET b,(HL)
14.,,0
.BYTE 8 ? 313 ? 300 ? .BYTE
7,,-1
5,,-1 ; SET b,(IX+d)
15.,,0
.BYTE 8 ? 335 ? 313 ? 0 ? 306 ? .BYTE
7,,-1
6,,-1 ; SET b,(IY+d)
15.,,0
.BYTE 8 ? 375 ? 313 ? 0 ? 306 ? .BYTE
0 ; End of SET parse table
RESTAB: ; RES
7,,-1
1,,-1 ; RES b,r
14.,,0
.BYTE 8 ? 313 ? 200 ? .BYTE
7,,-1
4,,0 ; RES b,(HL)
14.,,0
.BYTE 8 ? 313 ? 200 ? .BYTE
7,,-1
5,,-1 ; RES b,(IX+d)
15.,,0
.BYTE 8 ? 335 ? 313 ? 0 ? 206 ? .BYTE
7,,-1
6,,-1 ; RES b,(IY+d)
15.,,0
.BYTE 8 ? 375 ? 313 ? 0 ? 206 ? .BYTE
0 ; End of RES parse table
RETITB: ; RETI
0
0 ; RETI
8,,0
.BYTE 8 ? 355 ? 115 ? .BYTE
0 ; End of RETI parse table
RETNTB: ; RETN
0
0 ; RETN
8,,0
.BYTE 8 ? 355 ? 105 ? .BYTE
0 ; End of RETN parse table
INTAB: ; IN
7,,-1
0 ; IN n [8080 syntax]
0,,1
.BYTE 8 ? 333 ? .BYTE
1,,7
8,,-1 ; IN A,(n)
0,,2
.BYTE 8 ? 333 ? .BYTE
1,,-1
4,,6 ; IN r,(C)
10.,,0
.BYTE 8 ? 355 ? 100 ? .BYTE
0 ; End of IN parse table
INITAB: ; INI
0
0 ; INI
8,,0
.BYTE 8 ? 355 ? 242 ? .BYTE
0 ; End of INI parse table
INIRTB: ; INIR
0
0 ; INIR
8,,0
.BYTE 8 ? 355 ? 262 ? .BYTE
0 ; End of INIR parse table
INDTAB: ; IND
0
0 ; IND
8,,0
.BYTE 8 ? 355 ? 252 ? .BYTE
0 ; End of IND parse table
INDRTB: ; INDR
0
0 ; INDR
8,,0
.BYTE 8 ? 355 ? 272 ? .BYTE
0 ; End of INDR parse table
OUTTAB: ; OUT
7,,-1
0 ; OUT n [8080 syntax]
0,,1
.BYTE 8 ? 323 ? .BYTE
8,,-1
1,,7 ; OUT (n),A
0,,1
.BYTE 8 ? 323 ? .BYTE
4,,6
1,,-1 ; OUT (C),r
10.,,0
.BYTE 8 ? 355 ? 101 ? .BYTE
0 ; End of OUT parse table
OUTITB: ; OUTI
0
0 ; OUTI
8,,0
.BYTE 8 ? 355 ? 243 ? .BYTE
0 ; End of OUTI parse table
OTIRTB: ; OTIR
0
0 ; OTIR
8,,0
.BYTE 8 ? 355 ? 263 ? .BYTE
0 ; End of OTIR parse table
OUTDTB: ; OUTD
0
0 ; OUTD
8,,0
.BYTE 8 ? 355 ? 253 ? .BYTE
0 ; End of OUTD parse table
OTDRTB: ; OTDR
0
0 ; OTDR
8,,0
.BYTE 8 ? 355 ? 273 ? .BYTE
0 ; End of OTDR parse table
OSRCH: ;OP TABLE SEARCH
TLZ R0,MACBIT ;CLEAR POSSIBLE MACRO BIT
MOVEI R2,1_<35.-.LZ <OPTTOP-OPTBOT>,> ;SET UP OFFSET AND DELTA
MOVEI R1,<1_<35.-.LZ <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 TYPE IN R2
LDB R2,TYPPNT
JRST CPOPJ1
OSRCH4: SETZB R1,R2
RETURN
PF0: BLOCK 1
PF1: BLOCK 1
PF2: BLOCK 1
PF3: BLOCK 1
PFT0: BLOCK 1
PFT1: BLOCK 1
SRCJFN: BLOCK 1 ; Current source JFN
SFILNM: BLOCK 20. ; Source file name string area
SRCCNT: BLOCK 1 ;Count of chars in source buffer
SRCPNT: BLOCK 1 ;Pointer into source buffer
srcbsz==2000 ;Buffer a page at a time...
srcbuf: block srcbsz
srclen: block 1 ;Total size in bytes of current input file
srcpos: block 1 ;# bytes which have been read already.
srcipt: block 1 ;Pointer to SRCTAB for last real input file
;(i.e. doesn't change for .INSERTed files)
REQSP: BLOCK 1 ; Require stack pointer
RQSTKL== 20.*3. ; Length of the require stack
REQSTK: BLOCK RQSTKL ; Require stack space
;;r1 has the filename block
SFINIT: aos srcjfn ;Indicate that a different file now
;(In the ITS version, this is only used in
;endlr, for checking if file has changed and
;hence filename must be typed out...)
syscal open,[%clbit,,.uai ? %climm,,srcch
0(r1) ? 1(r1) ? 2(r1) ? 3(r1)]
.Lose %LsFil
syscal fillen,[%climm,,srcch ? %clout,,srclen]
.Lose %LsFil
setzm srcpos
SFINI1: syscal rfname,[%climm,,srcch
%clout,,0(r1) ? %clout,,1(r1)
%clout,,2(r1) ? %clout,,3(r1)]
.Lose %LsFil
; Create new source file string name
push p,r2
push p,r3
push p,r4
push p,r1
push p,r14
move r2,r1
move r14,[440700,,SFILNM] ; Address to place string
call rfn"pfn
setz r1,
idpb r1,r14
pop p,r14
setzm srccnt ;Set byte count
move r2,[440700,,srcbuf]
movem r2,srcpnt ;Set new byte pointer
pop p,r1
move r2,2(r1) ;Get file type in sixbit
setz r4, ;Accumulate leading digits as the version
sfini4: ldb r3,[360600,,r2] ;E.g. 221ASM would be version 221
caig r3,'9 ;No version will be version 0...
caige r3,'0
jrst sfini5
imuli r4,10.
addi r4,-'0(r3)
lsh r2,6
jrst sfini4
sfini5: hrli r4,defsym
;;SETVEC:
PUSH P,R0 ; Save a register
MOVE R0,[ GENM40 .,V,R,S,N,.
]
CALL SSRCH ; Find it in the symbol table
JFCL ; Forget can't find return
MOVE R1,R4 ; Get value
TLO R1,HFKSYM ; Make .VRSN. half killed
CALL INSRT ; and insert it
POP P,R0
pop p,r4
pop p,r3
pop p,r2
return
.insu: tro r15,erru
return
.insert:
TDZ R6,R6 ; Clear page throw flag
skipl reqsp ;Make sure not nested too deeply
jrst .insu
MOVE R14,R13 ; Load string pointer to the filename
SOJ R14, ; Back up 5 bytes
IBP R14 ? IBP R14 ? IBP R14 ? IBP R14 ; Forward 4 bytes
move r4,r14 ;Save
setz r1, ;fake an eol at comment.
.ins1: move r2,r1
ildb r1,r4
jumpe r1,.ins2
caie r2,40
cain r2,^I
caie r1,";
jrst .ins1
setz r2, ;Have <sp><semi>, must be a comment
dpb r2,r4
.ins2: push p,r1 ;Save the char
syscal rfname,[%climm,,srcch ;Default from current source file
%clout,,fblk+0
%clout,,fblk+1
%clout,,fblk+2
%clout,,fblk+3]
.Lose %LsFil
setzm fblk+1 ;Except for filename
movei r2,fblk
call rfn"rfn
pop p,r1 ;Undo fake eol
dpb r1,r4
skipn fblk+1
jrst .insu ;No filename
syscal open,[%clbit,,.uai ? %climm,,tmpch
fblk ? fblk+1 ? fblk+2 ? fblk+3]
jrst .insu ;No file
.close tmpch,
TLO R16,REQBIT ; Say that we in a .REQUIRE
;; AOS R3,REQCNT ; Bump and load counter
; Now we are ready to get input from a new file so we must save the status,
; byte count, JFN, and other stuff about the previous source file.
;;REQSAV:
MOVE R4,REQSP ; Get require stack pointer
PUSH R4,SRCJFN
move r1,srcpos ;Save logical filepos
sub r1,srccnt
push r4,r1
.access srcch,r1 ;Make it physically true as well
push r4,srclen ;Save source file length
MOVEM R4,REQSP ; Save the stack pointer
.iopush srcch, ;Make channel available
; Now we can initialize the new source file
movei r1,fblk
CALL SFINIT ; Init the new file
CAIE R6, ; Don't do page throw if .INSERT
TRO R16,HDRBIT ; If .REQUIRE or .INCLUDE then page throw
JRST GETEOL ; Go to end of the line and return
;; Read a character from current source
CHAR:
JUMPN R12,[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
CHAR1A: SOSGE SRCCNT ;DECREMENT ITEM COUNT
JRST CHAR4 ;GET ANOTHER BUFFER IF NECESSARY
ILDB RBYTE,SRCPNT ; LOAD NEXT BYTE.
CHAR1: LDB R2,C7PNTR ;MAP CHARACTER TYPE.
XCT CHARTB(R2) ;DECIDE WHAT TO DO
RETURN ;ACCEPT IT
CHAR4:
MOVE R14,R1 ; Save R1
PUSH P,R3 ; Save some other registers
PUSH P,R4
move r1,srclen
sub r1,srcpos ;# chars remaining
jumple r1,CHAR4A ;All chars read - get next file if any
caile r1,srcbsz ;read at most srcbsz this time
movei r1,srcbsz
addm r1,srcpos ;New position
movem r1,srccnt ;New count
move r2,[440700,,srcbuf]
movem r2,srcpnt ;New pointer
syscal siot,[%climm,,srcch ? r2 ? r1]
.Lose %LsFil
jumpe r1,char4b
movn r1,r1 ;This shouldn't happen, but...
addm r1,srccnt
addm r1,srcpos
CHAR4B: POP P,R4 ; Restore saved registers
POP P,R3
MOVE R1,R14 ; All restored
JRST CHAR1A ; Get next byte
CHAR4A: .close srcch, ;All done with this file
TLNE R16,REQBIT ; Were we in a .REQUIRE?
JRST REQPOP ; Yes
movei r1,4 ; Try next input filename
addb r1,srcipt
skipn (r1)
JRST CHAR6 ;All done
CALL SFINIT ; Init this file
TRO R16,HDRBIT ; New header page please
JRST CHAR4B ;Go clean up stack and get next char
CHAR6: ; No more input file test for end
TLO R15,ENDFLG ; Set flag to indicate so
MOVEI R14,LF ; End with LF
POP P,R4 ; Restore saved registers
POP P,R3
MOVE R1,R14
RETURN ; Back to caller
; Here we must pop off saved pointers and counts to get back to the source
; input that we were using prior to the .REQUIRE
REQPOP:
MOVE R4,REQSP ; Get back saved stack pointer
pop r4,srclen
pop r4,srcpos
POP R4,SRCJFN
CAMN R4,[-RQSTKL,,REQSTK-1] ; Back to original SP?
TLZ R16,REQBIT ; Yes - out of .REQUIRE now
MOVEM R4,REQSP ; Save stack pointer
.iopop srcch, ;Restore state of channel
movei r1,fblk
call sfini1 ;Restore SFILNM, @VERS@, srccnt,srcpnt
JRST CHAR4B ; Resume
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
OFFSET 1-.
QUEMAC:: JRST MACEND ;END OF MACRO
QUEARG:: JRST DSEND ;END OF MACRO ARGUMENT
QUEREP:: JRST REPEND ;END OF REPEAT
OFFSET 0
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,(440700,,0) ;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 P,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 P,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
CPL1== 72. ; CHARACTERS PER LOGICAL LINE
CPL2== 83. ; CHARACTERS PER PHYSICAL LINE
GETLIN: ;GET THE NEXT SOURCE LINE
TLZ R16,NLISLN\MEXBIT\FOLBIT ; RESET LIST-RELATED FLAGS
; AND INPUT FOLDING OVERRIDE.
AOS SEQ ; INCREMENT LINE SEQUENCE #
MOVEI R6,1 ;SET COUNT TO FIRST CHAR
MOVE R13,[440700,,LINBUF] ;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: TLNE R15,ENDFLG ;PERCHANCE END OF FILE?
TRO R15,ERRE ; YES, FLAG "NO END STATEMENTT"
MOVE R13,[440700,,LINBUF] ;SET FOR READ
JRST GETNB ;RETURN WITH FIRST NON-BLANK
macmem: PgmEnd ;Start of free memory for macro/cref storage
SYMBOT: PgmEnd ;BASE OF SYMBOL TABLE
SYMTOP: PgmEnd+PSLEN ;TOP OF SYMBOL TABLE
SYMLEN: BLOCK 1 ;LENGTH OF SYMBOL TABLE
symrel: ;;Relocate symbol table
push p,r2
push p,r1
move r1,symtop
addi r1,3777 ;Get at least a page
trz r1,1777
.suset [.smemt,,r1]
move r2,symtop
hrl r2,symlen
tlo r2,400000
soj r1,
movem r1,symtop
pop r2,(r1)
soj r1,
jumpl r2,.-2
aoj r1,
movem r1,symbot
pop p,r1
pop p,r2
jrst SRCHI ;Exit through reinit routine
; GBLOCK gets a block of storage from the area
; used for macro info, but initializes it differently.
; It clears the entire block.
; At return the block's start address is in R2;
; All other registers are intact.
GBLOCK: SKIPE R2,NEXT ; Garbage collected block available?
JRST GBLK1 ; Yes - Use it.
MOVEI R2,WPB ; No -- Get virgin memory.
addb r2,macmem ; Allocate the new block.
camle r2,symbot ; Does it overlap the symbol table?
call symrel ; Yes -- move up the symbol table to make room
movei r2,-wpb(r2) ; Point to block's first word.
SETZM WPB-1(R2) ; Clear link field in last word.
GBLK1: PUSH P,WPB-1(R2) ; Dequeue block from garbage list,
POP P,NEXT ; if that's where it is.
HRLI R2,-WPB ; Clear entire block.
SETZM 0(R2)
AOBJN R2,.-1
MOVEI R2,-WPB(R2) ; Set R2 to block's bottom address.
RETURN ; Return.
GETBLK: ;GET A BLOCK FOR MACRO STORAGE
SKIPE R11,NEXT ;ANY REMNANTS OF GARBAGE COLLECTION?
JRST GETBL1 ; YES, RE-USE
MOVEI R11,WPB
ADDB R11,macmem ;UPDATE FREE LOCATION POINTER
CAMLe R11,SYMBOT ;ANY ROOM?
call symrel ;No -- move up symbol table to make room
MOVEI R11,-WPB(R11) ;POINT TO START OF BLOCK
SETZM WPB-1(R11) ;CLEAR link field
GETBL1: HRLI R11,(440700,,0) ;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 P,0(R11) ;GET TOP
POP P,NEXT ;SET FOR NEXT BLOCK
SETZM 0(R11) ;CLEAR LAST WORD
RETURN ;EXIT
SRCHI: ;INITIALIZE FOR SEARCH
PUSH P,R1 ;STACK WORKING REGISTERS
PUSH P,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,<R7> ;SET INDEX
MOVEM R1,SYMPNT ;SET SYMBOL POINTER
SUBI R1,1
MOVEM R1,VALPNT ;SET VALUE POINTER
SUBI R1,1
MOVEM R1,CR1PNT ; Set pointer to 1st cross ref word.
SUBI R1,1
MOVEM R1,CR2PNT ; Set pointer to 2nd cross ref word.
POP P,R2 ;RESTORE REGISTERS
POP P,R1
RETURN ;EXIT
insrt0: call symrel
INSRT: ;INSERT ITEM IN SYMBOL TABLE
CAMN R0,@SYMPNT ;IS IT HERE ALREADY?
JRST INSRT1 ; YES
MOVNI R6,4 ;NO, PREPARE TO INSERT
ADD R6,SYMBOT ;DECREMENT POINTER TO BOTTOM OF TABLE
CAMGe R6,macmem ;ARE WE INTRUDING ON THE MACROS?
jrst insrt0 ;Yes - shift it all up (who, me, efficient?)
movem r6,symbot
HRLI R6,4(R6) ;SET UP BLT
BLT R6,@SYMPNT ;MOVE LOWER SYMBOLS DOWN
CALL SRCHI ;RE-INITIALIZE THE POINTERS
ADDI R7,4 ;COMPENSATE FOR SHIFT
MOVEM R0,@SYMPNT ;STORE SYMBOL
INSRT1: MOVEM R1,@VALPNT ;STORE VALUE
RETURN
SUBTTL PSEUDO-OPS
ENDVEC: BLOCK 1
SET: TLNN RMODE,Z80FLG ; Which source language is in use?
JRST SET80 ; -- 8080: Set a variable
; -- Z80: Assemble bit set op.
MOVEI R1,SETTAB ; Point to Z80 SET parse table.
JRST Z80PRS ; Enter Z80 parsing.
; CP opcode: Assemble either Z80 compare or
; 8080 call-if-positive, depending on Z80FLG.
CPOP: MOVEI R1,CPTAB ; Preload Z80 CP parse table address.
TLNE RMODE,Z80FLG ; Is assembly for Z80?
JRST Z80PRS ; Yes - Assemble Z80 compare.
; No -- Assemble 8080 call-positive.
MOVEI R1,364 ; Load opcode.
IDPB R1,CODPNT ; Store it for output.
CALL EXPR ; Evaluate call address.
TRO RERR,ERRA ; .. Flag error if no valid expr.
IDPB R1,CODPNT ; \
LSH R1,-8 ; *--- Store dest addr for output.
IDPB R1,CODPNT ; /
ADDI RLOC,3 ; Update "$" for 3-byte instruction.
RETURN
ORG: ; ORG: Set location counter.
CALL CODOUT ; Dump any current binary output.
MOVE R0,CODPNT ; Set IPNT to show
MOVEM R0,IPNT ; line has no data.
CALL EXPR ; Get new value for PC.
TROA RERR,ERRA ; None => operand error, keep old pc
MOVE RLOC,R1 ; Set location counter = expr.
HRROM RLOC,PF1 ; Print new PC in alternate format.
MOVEM RLOC,CODLOC ; Set address for next data byte.
RETURN
..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
SETZ R10, ; If null force transfer loc = 0.
HRROM R10,PF1 ; List transfer address in alt fmt.
MOVEM R10,ENDVEC
TRNE R15,ERRU ;ANY UNDEFINED SYMBOLS?
TRO R15,ERRP1 ; YES, PASS ONE ERROR
RETURN
; .CKSUM is equivalent to a DB directive which stores
; the negation of the sum of all bytes between the
; last .CKSUM directive and the current location.
; The basic intention for .CKSUM is to provide a way
; to assemble checksums automatically at the end of
; ROM chips. If the code being output in a segment
; includes ORG directives which leave gaps in the chip,
; .CKSUM's behavior assumes these gaps contain 0.
.CKSUM:
CALL CODOUT ; Update CURSUM & output all bytes
; of segment except the checksum.
MOVE R0,CODPNT ; Update IPNT to match new CODPNT
MOVEM R0,IPNT ; to insure proper listing.
MOVN R1,CURSUM ; Checksum = negation of sum of all
; previous bytes in segment.
IDPB R1,CODPNT ; Store the checksum.
AOJ RLOC, ; Increment the current location.
RETURN ; That's all.
; Note that event though the checksum byte is logically part of
; the preceding segment (so that the entire segment sums to 0)
; it is handled as the first byte of the next segment in order
; to simplify implementation. When .CKSUM returns the new segment
; consists of one byte, whose value is the negation of CURSUM;
; this is equivalent to resetting the checksum for the next segment.
DS: ; Define Storage directive
CALL CODOUT ; Dump binary before resetting PC.
MOVE R0,CODPNT ; Set IPNT to show
MOVEM R0,IPNT ; no data on line.
TLO R16,LBLBIT ; Force loc to print.
CALL EXPR ; Get length of area to reserve.
TROA RERR,ERRQ ; No expr: Flag error, keep old PC.
ADD RLOC,R1 ; New PC = old + area length
MOVEM RLOC,CODLOC ; Set address for next binary data.
RETURN
DW: ; Define Word(s) directive
CALL EXPR ; Get a 16-bit expression.
JRST QERR ; None => invalid syntax.
IDPB R1,CODPNT ; Store LSB in code buffer.
LSH R1,-8 ; Align MSB for store.
IDPB R1,CODPNT ; Store MSG in code buffer.
ADDI RLOC,2 ; Adjust PC for this "word".
CAIE RBYTE,", ; Is next byte a comma?
RETURN ; No -- Finished.
CALL GETNB ; Yes - Skip it & get another word.
JRST DW
DB: ; Define Byte(s) directive
CALL SETNB ; %%%%
CAIN RBYTE,"' ; Is first byte of field "'"?
JRST DBA ; Yes - Get ASCII string.
CALL EXPR ; No -- Get 8-bit expression.
JRST QERR ; No expr => bad syntax.
HRRZ R0,R1 ; Test for negative expression
TRZ R0,600377 ; before testing for excessive value.
CAIN R0,177400 ; Was expression negative?
JRST DB2 ; Yes - Don't flag truncation error.
TRZE R1,777400 ; Will expr value fit in a byte?
TRO RERR,ERRT ; No -- Truncate & flag error.
DB2: IDPB R1,CODPNT ; Store byte in code buffer.
AOJ RLOC, ; Increment PC to account for it.
DB1: CAIE RBYTE,", ; Is next byte a comma?
RETURN ; No -- Finished.
CALL GETNB ; Yes - Skip it & get another field.
JRST DB
; Field starts with "'": Gather an ASCII string up to a matching
; "'". "''" represents a singe "'" as a data byte.
DBA: TLO R16,FOLBIT ; Override folding to gather string.
DBA1: CALL GETNT ; Get anything except an EOL.
JRST QERR ; EOL => invalid syntax.
CAIN RBYTE,"' ; Is this byte a string delimiter?
JRST DBA2 ; Yes - Check further.
; No -- Accept it as data.
DBA3: IDPB RBYTE,CODPNT ; Deposit byte in code buffer.
AOJA RLOC,DBA1 ; Increment PC & get next byte.
DBA2: CALL GETCHR ; Found "'".
CAIN RBYTE,"' ; Is it followed by another one?
JRST DBA3 ; Yes - Treat it as data byte.
TLZ R16,FOLBIT ; No -- Reset folding mode,
JRST DB1 ; and check for another field.
..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,2. ;CHECK IF n=2
MOVEI R0,BINRDX ; YES, SET BINARY RADIX
CAIN R10,4. ;CHECK IF n=4
MOVEI R0,QUARDX ; YES, SET QUATERNARY RADIX
.RAD8: CAIN R10,8. ;CHECK IF n=8
MOVEI R0,OCTRDX ; YES, SET OCTAL RADIX
CAIN R10,10. ;CHECK IF n=10
MOVEI R0,DECRDX ; YES, SET DECIMAL RADIX
CAIN R10,16. ;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
.OPDEF: ;.OPDEF HANDLER
CALL GETSYM ;GET THE NAME
JRST .OPDE2 ; NULL, ERROR
CAIE R14,", ;TEST FOR COMMA
JRST .OPDE2 ; MISSING
CALL GETNB ;BYPASS COMMA
PUSH P,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 P,R1 ;OK, STACK TYPE
CALL ABSEXP ;COMPUTE BASIC VALUE
POP P,R0 ;RETRIEVE TYPE
DPB R10,[002000,,R0] ;STORE NEW VALUE
EXCH R0,0(P) ;EXCHANGE FOR NAME
CALL MSRCH ;SET SEARCH INDEX
JFCL ; MOX NIX IF FOUND
POP P,R1 ;RETRIEVE VALUE
TLNN RMODE,P1F ; Is this pass 2?
TLO R1,MD2SYM ; Yes - Mark as defined on pass 2.
CALL INSRT ;INSERT IN TABLE
MOVE R0,SEQ ; Get current line number.
HRLM R0,@CR1PNT ; Set in cross ref's definition field.
RETURN
.OPDE1: POP P,0(P) ;PRUNE STACK
.OPDE2: TRO R15,ERRA ;FLAG ERROR
RETURN ;EXIT
.TITLE: ;TITLE PSEUDO-OP
MOVE R11,[440700,,TTLMSG]
TLO R16,FOLBIT ; DON'T FOLD TITLE INTO UPPER CASE.
CAIN RBYTE,"' ; Is first byte of title "'"?
JRST TITLEI ; Yes - Use Intel format string.
; No -- Gather string to EOL.
PUSH P,RBPTR ; Save current input pointer.
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 P,R13 ; RESTORE POINTER
CALL GETSYM ;GET THE SYMBOL
JRST TTLRT ; Don't set title if no symbol.
MOVEM R0,PRGTTL ;OK, STORE TITLE
SETOM TTLFLA ;SET FLAG
TTLRT: JUMPE R14,CPOPJ ;EXIT IF END OF LINE
CALL GETNB ;AVOID Q ERROR
JRST .-2
RETURN
; Intel format TITLE operand: Title string is delimited
; by "'" and "''" must be translated to "'" as a data byte.
TITLEI: MOVE RBYTE,RBPTR ; Use RBYTE temporarily to generate
IBP RBYTE ; pointer to byte after "'".
PUSH P,RBYTE ; Save for symbol lookup.
CAIA ; No deposit for leading delimiter.
TITLED: IDPB RBYTE,R11 ; Deposit next byte of data in string.
CALL GETNT ; Get next byte of string.
JRST TITLEE ; EOL => missing delimiter.
CAIE RBYTE,"' ; Is this a delimiter?
JRST TITLED ; No -- Deposit it.
; Yes - Check for consecutive delims
CALL GETNT ; Get byte following delimiter.
JRST TTLEND ; EOL => legit end of string.
CAIN RBYTE,"' ; Is it another delimiter?
JRST TTLEND ; No -- End string.
JRST TITLED ; Yes - Treat it as data.
TITLEE: TRO RERR,ERRQ ; Missing delimiter: Bad syntax.
JRST TTLEND
TOCSUB: ASCIZ / Table of Contents/
SBMEND= .
.PAGE: ; FORCE A PAGE EJECT
SKIPL LSTCNT ; If .NLIST is in effect don't do it
TLNE RMODE,P1F ; IS THIS PASS 2?
RETURN ; NO - TAKE NO ACTION.
MOVE R0,LSTCTL ; Get listing mode flags
TLNE R16,MEXBIT ; If in macro expansion and
TRNE R0,LME ; listing is suppressed then skip
TRO R16,HDRBIT ; New page
SKIPEX: TRNN R0,LLD ; IS .NLIST LD IN EFFECT?
TLO R16,NLISLN ; YES -- DON'T LIST .PAGE
RETURN
; SKIP n directive: Skip n lines.
SKIP.: SKIPL LSTCNT ; Ignore if listing suppressed
TLNE RMODE,P1F ; or not running in pass 2.
JRST GETEOL
MOVE R0,LSTCTL ; Also ignore if in macro expansion
TLNE R16,MEXBIT ; and LIST ME not in effect.
TRNE R0,LME
CAIA
JRST GETEOL
SKIP1: CALL EXPR ; Get number of lines to skip.
MOVEI R1,1 ; Default to 1.
TRZE R1,777700 ; Limit skip count to 63.
TRO RERR,ERRT ; Flag any value > 63.
HRRZM R1,SKPCNT ; Save for end of line processing.
JRST SKIPEX ; Don't list "SKIP n" if
; NLIST LD in effect.
.SBHED: ; SUBHEADING DIRECTIVE
TDZA R2,R2 ; CLEAR R2 TO FLAG .SBHED ENTRY.
.SBTTL: ;"SUBTITLE" PSEUDO-OP
SETO R2, ; SET R2 TO BITS 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 -----------
SKIPA R11,[440700,,SUBMSG] ;OBTAIN POINTER TO BUFFER
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 HAVE SEEN A SBTTL
CAIN R2,0 ; Was this a subhed directive?
TRO R16,HDRBIT ; Yes - Force a page skip.
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,[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
; ============ .LIST & .NLIST ============
.LIST: MOVE R0,[LISSET,,LISTBL] ; CALL SUBROUTINE TO PARSE
CALL ARGSET ; ARGUMENT FIELD
AOSA LSTCNT ; ** NO ARGS -- INCREMENT LIST LEVEL
RETURN
JRST LISTYP
.NLIST: MOVE R0,[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
; =========== .ENABL & .DSABL ============
.ENABL:
PUSH P,RMODE ; SAVE MODE FLAGS
MOVE R0,[ENASET,,ENATBL] ; LOAD PARMS & CALL ARGSET
CALL ARGSET ; TO SET FLAGS
TRO RERR,ERRQ ; NO PARMS => Q ERROR
POP P,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,[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.
tlne r2,Lsbflg ; Was a local symbol block enabled?
call Locras ; Yes - Reset local symbol block.
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
; ************ .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.
SUBTTL MACRO-RELATED ASSEMBLER DIRECTIVES
.NARG: ; ==== .NARG ====
SKIPG MACLVL ; Is a macro expanding?
JRST OPCERR ; NO -- ISSUE AN 'O' FLAG.
MOVE R3,CALPNT ; LOCATE CURRENT CALL BLOCK.
HLRZ R1,3(R3) ; LOAD THE ARG COUNT.
SETCAL: TRO R16,SETBIT ; Indicate SET (not EQU) in progress.
JRST SETENT ; Set location field symbol.
.NCHR: ; ====== .NCHR ======
CALL MACARG ; GET A MACRO-TYPE ARGUMENT.
MOVE R1,ARGLEN ; LOAD LENGTH (# OF CHARACTERS)
JRST SETCAL ; Enter SET processing.
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 P,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 P,R1 ; RETRIEVE IRP/IRPC FLAG.
PUSH P,CALPNT ; SAVE CURRENT CALL BLOCK POINTER.
HRRZ R10,MWPNTR ; GET ADDR OF ARG BLOCK.
PUSH P,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,[440700,,ARGSTR] ; POINT TO IT.
; COPY ARGUMENT FIELD TO ARGUMENT VALUE BLOCK.
IRPA: ILDB RBYTE,R10 ; Get first argument byte.
MOVEM RBYTE,ARGDEL ; Save it as first delimiter value.
; The initial setting of ARGDEL is 0 if no arguments are
; supplied (".irp dummy,<>", for instance), else nonzero.
CAIA ; Enter loop.
IRPB: ILDB RBYTE,R10 ; GET NEXT ARG BYTE.
IDPB RBYTE,MWPNTR ; WRITE IT IN ARG BLOCK.
JUMPN RBYTE,IRPB ; REPEAT TIL END OF ASCIZ STRING.
CALL DEFIRP ; DRAG IN THE IRP DEFINITION.
PUSH P,R1 ; SAVE ITS ADDRESS ON STACK.
SETOM 0(R1) ; DELETE DEFINITION AFTER LAST CALL.
; -- CURRENT STACK CONTENTS:
; 0(P) - ADDRESS OF DEFINITION BLOCK.
; -1(P) - ADDRESS OF IRP ARGUMENT VALUE BLOCK.
; -2(P) - CONTENTS OF CALPNT (POINTER TO CALL BLOCK
; OF A MACRO THAT INVOKED .IRP)
; GENERATE A CALL BLOCK FOR EACH ARGUMENT.
IRPNAR: HRRZ R1,-1(P) ; 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(P) ; RETRIEVE DEFINITION ADDR.
CALL IRPAR ; LET CALL BLOCK GENERATOR
HRRZ R1,-1(P) ; 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,29. ; CONVERT CURRENT BYTE TO
MOVEM RBYTE,ARGSTR ; ASCIZ STRING FORMAT & STORE.
MOVEM RBPTR,0(R1) ; SAVE UPDATED BYTE POINTER.
HRRZ R1,0(P) ; LOAD ADDR OF DEFINITION BLOCK.
MOVE RBPTR,[350700,,ARGSTR] ; 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(P) ; 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 P,R0 ; POP DEFINITION LOC OFF STACK
POP P,R1 ; POP ARG BLOCK OFF.
POP P, ; GET RID OF SAVED CALPNT.
JRST REMMAC ; DELETE ARG BLOCK & RETURN.
DEFIRP: ; ENTRY FROM .IRP TO MACRO DEFINITION
CALL GETBLK ; GET A BLOCK FOR DEFINITION.
PUSH P,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
MOVE R0,STRSYM ; Get macro name from front of line.
JUMPE R0,DEFERR ; If none, can't define macro.
SETZM STRSYM ; Indicate name's been processed.
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
TLNN RMODE,P1F ; Is this pass 2?
TLO R1,MD2SYM ; Yes - Mark as defined on pass 2.
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
MOVE R0,SEQ ; Set cross ref's definition field
HRLM R0,@CR1PNT ; to current line number.
PUSH P,MWPNTR ;STACK POINTER TO START OF BLOCK
MOVEI R1,3
ADDM R1,MWPNTR ;MOVE PAST REFERENCE LEVEL AND ARG COUNT
SETZM MARMAS ; CLEAR PROTOTYPE ARGUMENT MASK.
CALL SETNB ; %%%%
TDZA R7,R7 ; Set arg count = 0 & don't skip a byte.
DEF01: CALL GETNB ;MOVE PAST COMMA
DEF01B: ; [ECL3]
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
; the following is to make .MACRO allow blanks or tabs [ECL3]
; between arguments [ECL3]
CAIE R14,"; ;statement ends on semi-colon [ECL3].
CAIN R4,SCLE ; or end of line
JRST DEF02
JRST DEF01B ;failing to find an end of [ECL3]
;line, we assume the next [ECL3]
;is a new arg separated from [ECL3]
;the previous one by blanks [ECL3]
;and/or tabs. Treat like a [ECL3]
;comma already skipped. [ECL3]
DEF02: PUSH P,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
CAMN R0,MACRO ; Is this "macro"?
AOJA R7,DEF03B ; Yes - Increment nest level & proceed.
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,ENDM ; Is op "ENDM"?
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: MOVE R7,R1 ; YES - SET, THEN POP, NEST LEVEL
DEF03A: SOJL R7,DEF13 ;END IF MINUS
DEF04: MOVE R13,[440700,,LINBUF] ;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,C8PNTR ;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,(440600,,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,C8PNTR ;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,C8PNTR ;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 P,R2 ;RETRIEVE COUNT
POP P,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
; ########## .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.
MOVE R0,MACLVL
CAME R0,MLSAVE ; DID MACLVL CHANGE?
JRST STMNT ; Yes - process this line 1st, return
CALL GETEOL ; No -- Position to end of line.
JRST MEXLST ; Continue until exiting this level.
DECMAC: ;DECREMENT MACRO STORAGE
SOSL 0(R1) ;TEST FOR END
RETURN ; NO, EXIT
REMMAC: ;REMOVE MACRO STORAGE
PUSH P,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 P,R1 ;RESTORE BORROWED REGISTER
HRRZM R1,NEXT ;SET NEW START
RETURN ;EXIT
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,+<36.-16.> ;ADJUST SIGN TO 36 BITS
ASH R10,-<36.-16.>
CAIN R10,1 ;IF SINGLE,
JRST BEGR0 ; PROCESS IN LINE
PUSH P,R10 ;STACK EXPRESSION
CALL ENDLR ;LIST LINE
CALL GETBLK ;MULTIPLE, SDT FOR STORAGE
PUSH P,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
CAMN R0,ENDM ; Is this "ENDM"?
SOJL R7,REPEA3 ; DECREMENT AND BRANCH IF END
REPEA2: TLO R16,FOLBIT ; DON'T FOLD LC TO UC IN DEFINITION.
SKIPA RBPTR,[440700,,LINBUF] ; 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 P,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 P,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 P,R4 ;STACK CURRENT RESULTS
PUSH P,R3
PUSH P,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 P,R2 ;RETRIEVE REGISTERS
POP P,R3
POP P,R4
XCT [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,@[BEGC0 ? FALSE]+1(R4)
IBP RBPTR ;FOUND OP, BYPASS IT
JRST .IFDF1 ;LOOP
JMPER:
MOVE R1,CONDX+1(R3)
JRST 0(R1)
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:
.IFFLG: BLOCK 1
INIF: ; Intel IF directive
CALL EXPR ; Evaluate true/false expression.
TROA RERR,ERRQ ; No expr => bad syntax.
JUMPN R1,BEGC0 ; Assemble if expr <> 0,
JRST FALSE ; skip block if expr = 0.
.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
.IFBAD: 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
JRST BEGC01 ; Yes - test if this should list
.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
JRST BEGC01 ; 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,ENDIF ; Not IF -- Is it ENDIF?
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 P,0(R3) ;STACK INSTRUCTION
CALL ABSEXP ;VALUATE EXPRESSION
LSH R10,+<36.-16.> ;ADJUST SIGN
ASH R10,-<36.-16.>
POP P,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
SECLEN: BLOCK 1 ; LENGTH OF SECONDARY ARGUMENT
SECSTR: BLOCK 100. ; SPACE FOR SAME
.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,[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,[440700,,ARGSTR] ; PREPARE TO COMPARE.
MOVE R4,[440700,,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,ENDIF ; "ENDIF"?
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
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 "CALL ARGSET"
; RETURNS:
; 0(P) -- NO ARGUMENTS FOUND
; 1(P) -- 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 P,R0 ; SAVE CALLER'S PARMS
CALL GETSYM ; DECODE NEXT SYMBOL
CAIA ; - SKIP IF NONE
JRST ARSER ; EXIT TO SEARCH TABLE
POP P,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(P) ; 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(P) ; 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 P,R0 ; RETURN AFTER FINDING AN ARG
JRST CPOPJ1
; 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 P,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 P,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 P,R0
MOVE R0,LSTCTL ;LOAD LISTING CONTROL FLAGS.
TRNN LCND ; .NLIST CND IN EFFECT?
TLO R16,NLISLN ; YES - SUPPRESS LINE LISTING
POP P,R0
RETURN
; 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(P)
; WITH R0 = 0.
; IF THE NEXT NONBLANK TEXT IS A SYMBOL, GETSYM RETURNS TO
; 1(P) 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
SYMDEL: BLOCK 1 ; SYMBOL DELIMITER, SAVED BY GETSYM
GETSYM: ;GET A SYMBOL
CALL SETNB ;BYPASS LEADING BLANKS
MOVEM R13,SYMBEG ;SAVE START FOR RESCAN
MOVSI R1,(440600,,R0) ;SET POINTER
TDZA R0,R0 ;CLEAR AC AND SKIP
GETSY1: CALL GETCHR ;GET NEXT CHARACTER
LDB R2,C8PNTR ;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
; ******* 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,C8PNTR ; LOAD ITS TYPE
XCT GETLTS(R2) ; -- CHECK TYPE
IMULI R0,10. ; TYPE IS NUMERIC -- ACCUMULATE
GETLSY: SUBI R14,"0 ; BINARY INTEGER.
ADD R0,R14
JRST GETL1
GETLDO: CALL GETCHR ; Dollar sign -- SKIP THIS BYTE
CAIE R0, ; INSURE THAT INTEGER IS
CAIL R0,65536. ; 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
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 (P) ; NO -- RETURN + 2.
RETURN ; YES - RETURN + 1.
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
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.
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
psout.: push p,r2
hlrz r2,r1
cain r2,-1
hrli r1,440700
skipa
psout1: .iot tyoch,r2
ildb r2,r1
jumpn r2,psout1
psout2: pop p,r2
return
PAGSIZ==84. ; Default page size is 54 lines.
COLLPT== 132. ;CPL LPT
COLTTY== 79. ;CPL TTY
$CRLF: .BYTE 7 ? CRR ? LF ? 0 ? .BYTE
TABCNT: BLOCK 1
COLCNT: BLOCK 1
LINCNT: BLOCK 1 ;EXEC LINE COUNTER
INPGNM: BLOCK 1 ; Input file page number
CPL3== 144. ; CHARACTERS PER .PDP10 LINE
LINBUF: BLOCK CPL3/5+2 ;SOURCE LINE BUFFER
LSTFIL:
MOVE R10,[440700,,SFILNM] ; Load source file name pointer
CALL LSTASC ; List it
JRST LSTTAB ; List a tab and return
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
EXCH R1,R2 ; Save R1 and get the byte
PBOUT ; Output the byte
EXCH R1,R2 ; Restore R1
RETURN ;EXIT
LSTOU1:
PUSH P,R1
HRROI R1,$CRLF
PSOUT
POP P,R1
RETURN ;CR-LF TO TTY
LPTOUT: ;OUTPUT TO LISTING DEVICE
SKIPGE LSTCNT ;IF LIST LEVEL IS NEGATIVE
RETURN ;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 P,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 P,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
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
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
SUBTTL Print header on page routine
HEADER: CALL ACEXCH ;YES, SAVE THE ACCUMULATORS
PUSH P,R16 ;SAVE CURRENT FLAGS
MOVEI R2,FF ;GET A FORM FEED
CALL LSTOUT ;OUTPUT IT
MOVEI R10,PAGSIZ+3 ;RESET LINE COUNTER REGISTER
MOVEM R10,LINCNT ;...
SKIPN TTLFLA ;DO WE HAVE TITLE?
JRST [ MOVE R0,PRGTTL ; No - get program title
CALL LSTSYM ; and print it
JRST .+3 ] ; Merge back
MOVE R10,[440700,,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
MOVE R10,[440700,,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,40
CALL LSTOUT ;SPACE
AOS INPGNM ; Increment source-oriented page number.
AOS R11,PAGNUM ; Increment actual page number.
MOVE R2,LSTCTL ; Check for source-oriented numbering . . .
TRNE R2,LSON ; .list son in effect?
MOVS R11,INPGNM ; Yes - Get input-related page number.
; No -- Keep output page number.
HLLM R11,(P) ; Save page extension, if any.
TLZ R11,-1 ; Trim down to source or listing page number.
CALL DNC ; Convert to decimal and print it.
HLRZ R11,(P) ; Retrieve page extension.
JUMPE R11,NOPGEX ; ... 0 means there isn't one.
MOVEI R2,"- ; Output the separator for "page-ext".
CALL LSTOUT
CALL DNC ; Convert & print the extension.
NOPGEX: CALL LSTCR ; Terminate the line.
;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,[440700,,SUBMSG] ; POINT TO SUBTITLE BUFFER
CALL LSTASC ; LIST IT.
NOSBTL: CALL LSTCR ; END THE LINE.
CALL LSTCR ;SECOND LINE CRLF
POP P,R2 ;RESTORE FLAGS
JRST ACEXCH ;RESTORE F4 REGS AND EXIT
LSTSYM: ;LIST SYMBOL
PUSH P,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 P,R1 ;STACK A WORKING REGISTER
MOVSI R1,(440600,,R0)
LSTSY1: ILDB R2,R1
ADDI R2,40 ;CONVERT TO ASCII
CALL LSTOUT
TLNE R1,770000 ;TEST FOR END
JRST LSTSY1
LSTRET: POP P,R1
POP P,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 P,R1 ; SAVE WORKING REGS
PUSH P,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 P,R3 ; RESTORE WORK REGS & RETURN
JRST LSTRET
; RECURSIVE SUBROUTINE TO PRINT A DECIMAL NUMBER
; DECREMENTING A BYTE COUNT IN R3 ....
LSTLNU: IDIVI R0,10. ; GENERATE NEXT DIGIT.
HRLM R1,0(P) ; 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(P) ; PICK UP NEXT DIGIT,
JRST LSTNUM ; PRINT IT, & POP BACK TO CALLER.
LSTASC: ILDB R2,R10 ; LOAD NEXT BYTE.
JUMPE R2,CPOPJ ; QUIT WHEN FINDING A 0 BYTE.
CALL LSTOUT ; OUTPUT THE BYTE.
JRST LSTASC
LSTSIX: MOVSI R6,(440600,,R0)
LSTSI1: ILDB R2,R6
JUMPE R2,CPOPJ
ADDI R2,40
CALL LSTOUT
TLNE R6,770000
JRST LSTSI1
RETURN
LST3SP: ;LIST SPACES
CALL LSTSP
LST2SP: CALL LSTSP
LSTSP: MOVEI R2,SPACE
JRST LSTOUT
DNC: IDIVI R11,10. ;RECURSIVE SUBROUTINE
HRLM R12,0(P) ;SAVE REMAINDER ON PUSHDOWN LIST
CAIE R11, ;ALL DONE?
CALL DNC ;NO, CALL DNC AGAIN
HLRZ R2,0(P) ;RETRIEVE NUMBER FROM PD LIST
JRST LSTNUM ;LIST NUMERIC AND EXIT
; List a 16-bit hex address, in right half of R0.
LSTHEX: MOVE R1,[200400,,R0] ; Set pointer before 1st hex digit.
; Output hex digits until the byte pointer increments
; from R0 to R1.
LSTH1: ILDB R2,R1 ; Get next hex digit.
TRNE R1,1 ; Did pointer increment past R0?
RETURN ; Yes - Finished.
TRO R2,"0 ; Convert to ascii for 0-9.
CAILE R2,"9 ; Was this digit in range A-F?
ADDI R2,7 ; Yes - Convert to alphabetic ascii.
PUSH P,R0 ; Save registers from LSTOUT.
PUSH P,R1
CALL LSTOUT ; Output the byte.
POP P,R1 ; Restore registers.
POP P,R0
JRST LSTH1 ; Repeat for next digit.
; List a single hex byte.
LSTHB: MOVE R1,[100400,,R0] ; Set pointer for rightmost 8 bits.
JRST LSTH1 ; Output 2 digits.
LSTNUM: TROA R2,"0 ;LIST NUMERIC
ADDI R2,40 ;CONVERT SIXBIT TO ASCII
JRST LSTOUT
; =========== 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,10. ; DIVIDE TO GET (#/10, # MOD 10).
TRO R1,"0 ; CONVERT DIGIT TO ASCII.
PUSH P,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 P,R2 ; KEEP R2 KOSHER &
CALL LSTLNU ; PRINT MACLVL WITH A BORROWED SUBR.
POP P,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,[440700,,FSEQ] ; LOAD SEQ FIELD POINTER.
SUB R3,R2 ; BLANK COUNT = (7-E)-S.
JUMPLE R2,FSDIGT ; BEWARE GOBS OF FLAGS!
MOVEI R1,40 ; 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 P,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,[440700,,FSEQ] ; LOAD PTR TO START OF FIELD.
ILDB R2,R6 ; LOAD FIRST BYTE.
RETURN
; 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
; Enter line number of a reference
; in a symbol's cross ref list.
CRFREF:
TLNE R15,P1F ; Is this pass 2?
RETURN ; No -- Don't bother with ref's.
PUSH P,R1 ; Save volatile registers.
PUSH P,R2
MOVE R1,@CR1PNT ; Retrieve 1st cref word.
TRNE R1,-1 ; Is 1st reference slot empty?
JRST CREF1 ; No -- Check second.
HRR R1,SEQ ; Yes - Set it to
MOVEM R1,@CR1PNT ; current line number.
JRST CRET ; Return.
CREF1: MOVE R1,@CR2PNT ; Retrieve 2nd cref word.
TLNE R1,-1 ; Is 2nd ref slot empty?
JRST CREF2 ; No -- Look for 1st ref block.
HRL R1,SEQ ; Yes - Set it to current line #.
MOVEM R1,@CR2PNT
JRST CRET ; Return.
CREF2: HRRZ R2,R1 ; Set R2 = addr(1st cref block).
JUMPN R2,CREF3 ; Proceed if one exists.
; Symbol table entry doesn't have any reference blocks linked
; to it. Allocate the first one and set last half word of
; cref info in the symtab entry to point to it.
CALL GBLOCK ; Get a block for reference info.
HRR R1,R2 ; Set new block loc in symtab link.
MOVEM R1,@CR2PNT
JRST CREF9 ; Set first entry in new block.
CREF3: HRLI R2,-<WPB-1> ; Scan all but last word of ref block.
CREF4: MOVE R1,0(R2) ; Get next word.
TLNE R1,-1 ; Is 1st (left) slot open?
JRST CREF5 ; No -- Try right half.
HRL R1,SEQ ; Yes - Set it.
MOVEM R1,0(R2)
JRST CRET ; Return.
CREF5: TRNE R1,-1 ; Is 2nd (right) slot open?
JRST CREF6 ; No -- Try next word.
HRR R1,SEQ ; Yes - Set it.
MOVEM R1,0(R2)
JRST CRET ; Return.
CREF6: AOBJN R2,CREF4 ; Advance to next word.
; This block's full: Get next.
MOVE R1,R2 ; Save pointer to current block.
SKIPE R2,0(R2) ; Is there another block in chain?
JRST CREF3 ; Yes - Search it.
CALL GBLOCK ; No -- Get a new one.
HRRM R2,0(R1) ; Set link to new block.
CREF9: MOVE R1,SEQ ; Set first entry in a new block
HRLM R1,0(R2) ; to current line number.
CRET: POP P,R2 ; Restore volatile registers.
POP P,R1
RETURN ; Return.
LSTBUF: BLOCK 50 ; Output line buffer area [ECL2]
LSTBFL=<.-LSTBUF>*5-1 ; number of characters buffer [ECL2]
; will hold [ECL2]
LSTBFC: BLOCK 1 ; count of chars left in lstbuf [ECL2]
LINPTR: BLOCK 1 ; Changing string pointer
LSTDMP:
TLNE R16,LSTBIT ; Need to print?
RETURN ; No, just return now
IDPB R2,LINPTR ; No - save it in the line
SOSG LSTBFC ; Full buffer? [ECL2]
JRST LSTDM1 ; yes, dump the buffer [ECL2]
CAIE R2,LF ; Dump the line?
RETURN ; Return now
LSTDM1:
PUSH P,R1 ; Save some registers for SOUT
PUSH P,R2
PUSH P,R3
SETZ R3, ; ASCIZ string to output
IDPB R3,LINPTR ; Make it so
;; MOVE R1,LSTJFN ; Load listing JFN
HRROI R2,LSTBUF ; Get pointer to the output line buffer
;; SOUT ; Dump it
tlza r2,337077
lstdmi: .iot lstch,r1
ildb r1,r2
jumpn r1,lstdmi
MOVE R1,[440700,,lstbuf] ; Load original string pointer
MOVEM R1,LINPTR ; Reset byte pointer
MOVEI R1,LSTBFL ; buffer length [ECL2]
MOVEM R1,LSTBFC ; count left [ECL2]
POP P,R3 ; Restore clobbered registers
POP P,R2
POP P,R1
RETURN ; Exit
; Output code accumulated in CODBUF and reset the buffer
; for further assembly.
; Alternate entries are TROUT, which outputs a transfer address
; when the code buffer is empty, and CODRES, which is used
; to reset buffer info at the start of each pass.
; Output record format:
; +0 LSB of data start address
; +1 MSB of data start address
; +2 Count of data bytes (n)
; +3 to +(n+2) Data
; +(n+3) Negated checksum
CHKSUM: BLOCK 1 ;CHECK SUM
CODOUT:
; First update the checksum value for the current code segment.
MOVE R1,CURSUM ; Current sum value = cursum.
MOVE R2,[441000,,CODBUF] ; Set pointer to start of CODBUF.
CSUP: CAMN R2,CODPNT ; At end of data in CODBUF?
JRST CSET ; Yes - Set checksum.
ILDB R0,R2 ; No -- Get next byte.
ADD R1,R0 ; Sum = sum + (current byte).
JRST CSUP ; Repeat until reaching end of data.
CSET: MOVEM R1,CURSUM ; Store updated checksum value.
MOVE R0,CODPNT ; Retrieve current buffer pointer.
CAMN R0,[441000,,CODBUF] ; Is the buffer empty?
JRST CODRES ; Yes - Skip physical output.
TROUT: TLNE R15,P1F ; Is this pass 1?
JRST CODRES ; Yes - Just reset the buffer.
TLNE R16,BINBIT ; Is binary output suppressed?
JRST CODRES ; Yes - Skip physical output.
; Output the data start address.
;; MOVE R1,BINJFN ; Preload output file's jfn.
HRRZ R2,CODLOC ; Get PC value for start of line.
ADDM R2,CHKSUM ; Subtract from checksum.
;; BOUT ; Output it.
call binout
HRRZ R2,CODLOC ; Retrieve data address again.
LSH R2,-8 ; Discard LSB, align MSB for output.
ADDM R2,CHKSUM ; Account for it in checksum.
;; BOUT ; Output it.
call binout
; Compute length of data and subtract each data byte from
; the checksum. Data will ultimately be output via SOUT.
; This code operates correctly even when the buffer is
; empty, as required for output of a transfer address.
MOVE R2,[441000,,CODBUF] ; Point to first data byte.
SETZ R3, ; Initial count = 0.
CODOU1: CAMN R2,CODPNT ; Has scan reached end of data?
JRST CODOU2 ; Yes - Do physical i/o.
ILDB R0,R2 ; No -- Get next byte.
ADDM R0,CHKSUM ; Subtract byte from checksum.
SOJA R3,CODOU1 ; Count the byte & go back for next.
CODOU2: MOVN R2,R3 ; Output byte count as positive #.
ADDM R2,CHKSUM ; Include it in checksum.
;; BOUT
call binout
JUMPE R3,CODOU3 ; Skip SOUT if there's no data.
;; MOVE R2,[441000,,CODBUF] ; Output the data as a single string.
;; SOUT
push p,r4
move r4,[441000,,codbuf]
bnsout: ildb r2,r4
call binout
aojl r3,bnsout
pop p,r4
CODOU3: MOVN R2,CHKSUM ; Finally, output the checksum.
;; BOUT
call binout
; Reset code buffer information.
CODRES: MOVEM RLOC,CODLOC ; Next data addr is current PC.
MOVE R0,[441000,,CODBUF] ; Reset buffer pointer
MOVEM R0,CODPNT ; to start of buffer.
SETZM CHKSUM ; Initial checksum = 0.
RETURN
binblk: 0 ? 0 ? 0 ? 0
lstblk: 0 ? 0 ? 0 ? 0
; Now we can open the file (end of pass 1).
SETBIN:
TLNE R16,BINBIT ; Do we have a binary file to open?
RETURN ; Nope, return then
CALL ACEXCH ; Get EXEC's ACs
syscal open,[%clbit,,.uio ? %climm,,binch
binblk+0 ? binblk+1 ? binblk+2 ? binblk+3]
.Lose %LsFil
JRST ACEXCH ; Swap AC's and return
binsz=2000
binbf: block binsz
binptr: 441000,,binbf
binout: idpb R2,binptr
move R1,binptr
came R1,[041000,,binbf+binsz-1]
return
move R1,[441000,,binbf]
movem R1,binptr
hrli R1,444400
movei R2,binsz
syscal siot,[%climm,,binch ? R1 ? R2]
.Lose %LsFil
return
bincls: skipge r1,binptr
jrst bincl1 ;Negative, must be 441000,,binbf
movei r1,1-binbf(r1)
move r2,[444400,,binbf]
syscal siot,[%climm,,binch ? r2 ? r1]
.Lose %LsFil
bincl1: .close binch,
return
XESAVE: BLOCK 1 ;FILE NAME STORAGE FOR TTY ERROR MESSAGES
ERRCNT: BLOCK 1 ;ERROR COUNT
ENDLR: ;END OF LINE PROCESSOR
; The following test detects an extraneous symbol
; at the start of a line: If the first item on a line
; is a symbol it should have been processed by EQU or SET,
; which reset STRSYM to 0.
SKIPE STRSYM ; Unprocessed symbol at start of line?
TRO RERR,ERRQ ; Yes - Flag error & ignore it.
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: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
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 R1,SRCJFN ; Get current source file JFN
CAMN R1,XESAVE ; Same as before?
JRST ENDL4 ; Yes - don't print file name
MOVEM R1,XESAVE ; No - save it for next time and print filename
HRROI R1,SFILNM ; String pointer to current source file
PSOUT ; Print it
HRROI R1,$crlf
PSOUT
ENDL4: HRLZ R0,R15 ;PUT FLAGS IN AC0 LEFT
MOVE R1,[440700,,[ASCII /ABDEILMOPQRTUNZ/]]
ENDL5: ILDB R2,R1 ;FETCH CHARACTER
CAIGE 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 ENDL12 ; YES - JUST CLEAN UP
MOVE R0,LSTCTL ; Get listing mode flags
; *** 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.
TRNE R0,LME ; Is .LIST ME in effect?
JRST ENDL6A ; Yes - List the line.
TRNN R0,LMEB ; No -- .LIST MEB in effect?
JRST ENDL12 ; No -- Don't list it.
MOVE R0,IPNT ; Yes - List only if
CAMN R0,CODPNT ; it generated code.
JRST ENDL12
; *** 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:
TRNN R16,ASCBIT ; Suppress binary listing?
JRST ENDL6B ; No - don't fiddle with listing mode
TLNE R16,BEXBIT ; Continuation of a line?
JRST ENDL11 ; Yes - skip all of this then
PUSH P,R0 ; Save current listing mode
TRZE R0,LBIN ; Test binary listing bit and clear it
MOVEM R0,LSTCTL ; Wasn't off so set this mode word
CALL PRNTA ; List it
POP P,LSTCTL ; Restore listing mode word
TRNA ; Skip over binary listing call
ENDL6B: CALL PRNTA ;LIST THE OCTAL
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,[440700,,LINBUF] ;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
TLNE RMODE,P1F ; Which pass is this?
JRST ENDL12 ; 1 -- No listing.
MOVE R0,IPNT ; 2 -- Did binary output listing
CAMN R0,CODPNT ; overflow its field?
JRST ENDL12 ; No -- Line listing's complete.
; Yes - List binary extension
; on new line.
; ****** BINARY EXTENSION PROCESSING *******
TLO R16,BEXBIT ; FLAG STATE OF LISTING EXTENSION.
MOVE R0,LSTCTL ; CHECK LIST OPTIONS --
TRNE R0,LBEX ; ARE BINARY EXTENSIONS TO LIST?
JRST ENDLC ; Yes - List it.
; No -- Finish up.
ENDL12:
HRRZ R0,CODPNT ; Get current binary output pointer.
CAIL R0,CODBUF+30 ; About 128 bytes available?
CALL CODOUT ; Yes - Dump the buffer.
SKIPL LSTCNT ; If .NLIST'd then forget formfeed check
TRNN R16,FFBIT ;FORM FEED ENCOUNTERED?
JRST ENDLI ; NO
TLNN RMODE,P1F ; IF THIS IS PASS 2 . . .
TRO R16,HDRBIT ;SET HEADER BIT
HLLOS INPGNM ; Skip to next page.
ENDLI: TRZ R16,ASCBIT\FFBIT ; Reset ASCII output flag and formfeed bit
ENDLIF: AND R5,[PCMASK] ;CLEAN UP PC
SETZM GLBPNT ;CLEAR GLOBAL POINTER
SETZB R2,PF1
DPB R2,[350700,,LINBUF] ;FLAG LINE
TRZ R15,-1
TLZ R16,ERRBIT\LBLBIT\PF1BIT\BEXBIT
SKIPN R4,SKPCNT ; Is current line .skip directive?
RETURN ; No -- Return.
SETZB R2,SKPCNT ; Yes - Skip some lines.
SKIPL.: CALL LSTOUT ; List an empty line.
SOJG R4,SKIPL. ; Iterate (SKPCNT) times.
RETURN
; PRNTA LISTS ASSEMBLER - GENERATED INFORMATION
; AT THE LEFT SIDE OF EACH LINE:
; -- LINE NUMBER FIELD
; -- 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.
TLNE R16,LBLBIT ;Force loc to be printed?
JRST PRNTAL ; Yes, go print it
SKIPE PF1 ; Alternate output format to be used?
JRST PRNTA3 ; Yes - Leave loc field blank.
MOVE R0,IPNT ; No -- . . .
CAMN R0,CODPNT ; Any code generated on this line?
JRST PRNTA3 ; No -- Leave loc field blank.
PRNTAL: MOVE R0,ILOC ; Yes - List PC value
CALL LSTHEX ; at start of line.
PRNTA3: CALL LSTTAB ;OUTPUT TAB
PRNTA1: MOVE R0,LSTCTL ; **** BINARY FIELD ****
TRNN R0,LBIN ; BINARY TO BE LISTED?
JRST PRNTA2 ; No - fill fields with tabs
; YES - LIST WHATEVER WAS GENERATED.
MOVE R0,PF1 ; Retrieve "alternate" binary field.
JUMPE PRNTA4 ; Alternate list format requested?
CALL LSTHEX ; Yes - List 16-bit address
JRST PRNTA2 ; stored in PF1.
PRNTA4: MOVE R10,IPNT ; Get pointer to line's 1st byte of data
CAMN R10,CODPNT ; Was any data generated?
JRST PRNTA2 ; No -- Leave field blank.
; Yes - List data from CODBUF.
; List data generated by current line. Limit this to
; 7 bytes for output to a line printer, or 3 bytes for
; output to a teletype. Remaining data will appear on
; subsequent lines if .LIST BEX is in effect.
MOVEI R6,11. ; Set byte counter for 11 bytes.
MOVE R0,LSTCTL ; Retrieve listing flags.
TRNE R0,LTTM ; Is .LIST TTM in effect?
MOVEI R6,7 ; Yes - Reset for 7 bytes.
PRNTA5: ILDB R0,R10 ; Get next byte of binary data.
CALL LSTHB ; List it.
CAME R10,CODPNT ; Was it the last byte generated?
SOJG R6,PRNTA5 ; No -- List next byte if room allows
; Finished listing available data or available space to format
; was exhausted: Save necessary info for binary extension processing
; and align to source field.
MOVEM R10,IPNT ; Save pointer to last byte output.
CAILE R6,8. ; Is there space for 2 tabs?
CALL LSTTAB ; Yes - List first.
CAILE R6,4 ; Space for 1 tab yet?
CALL LSTTAB ; Yes - List it.
RETURN
PRNTA2:
CALL LSTTAB ; Tab across PF1
MOVE R0,LSTCTL ; Get listing mode
TRNN R0,LTTM ; Teletype mode?
CALL LSTTAB ; No - fill with a tab
RETURN ; Yes- return
SEQND: BLOCK 1 ; # of significant digits in largest seq #.
SYMTB: ;LIST THE SYMBOL TABLE
;; MOVE R1,[440700,,SUBMSG] ; Set subhead string.
;; HRROI R2,[ASCIZ /Symbol table/ ]
;; SETZ R3,
;; SOUT ; Copy string via SOUT.
move r1,[ascii/Symbo/]
movem r1,submsg
move r1,[ascii/l tab/]
movem r1,submsg+1
move r1,[ascii/le/]
movem r1,submsg+2
SETZ R7, ; Set initial table index = 0.
;; IDPB R7,R1 ; Use it as delimiter for string.
TLO R16,SBTBIT ; Indicate subtitle present.
TRO R16,HDRBIT ; Force a page skip.
MOVE R0,SEQ ; Check on number of significant
CALL NSIG ; digits in last sequence number.
MOVEM R4,SEQND ; Save to compute line # padding count.
SYMTBE: CALL LSTCR ; Terminate current line.
CALL GETSTE ; Get next symbol table entry.
RETURN ; No more => quit.
CALL LSTSYM ; List the symbol itself.
CALL LSTTAB ; Tab to definition field.
HLRZ R0,@CR1PNT ; Get definition line number.
SKIPE R0 ; 0 => undefined symbol.
CALL LSTLN ; List definition line #.
CALL LSTTAB ; Tab to value field.
MOVE R0,@VALPNT ; Get symbol's value.
TLNE R0,DEFSYM ; Is symbol defined?
CALL LSTHEX ; Yes - Output value in hex.
; No -- Leave field blank.
; List references to this symbol.
CALL SYMSET ; Set counter for # ref's to go
; before starting new line.
HRRZ R0,@CR1PNT ; Get first reference.
JUMPE R0,SYMTBE ; 0 => no ref's: Done with symbol.
CALL LSTTAB ; Tab to first ref field.
HRRZ R0,@CR1PNT ; Retrieve 1st ref line number.
CALL LSTLN ; List it.
HLRZ R0,@CR2PNT ; Check second reference.
JUMPE R0,SYMTBE ; 0 => No more for this symbol.
CALL LSTTAB ; Tab to second ref field.
HLRZ R0,@CR2PNT ; Restore ref line number.
CALL LSTLN ; List it.
HRRZ R0,@CR2PNT ; Get link to first ref block.
JUMPE R0,SYMTBE ; None => done with symbol.
SOJ R10, ; Account for starting with 2 refs.
SYMTB2: MOVE R11,R0 ; Set pointer & counter
HRLI R11,-<WPB-1> ; to scan ref block.
SYMTB3: HLRZ R0,0(R11) ; Check left half of current word.
JUMPE R0,SYMTBE ; Empty => no more for this symbol.
SOJG R10,.+2 ; Is there room on the line for 1 more?
CALL SYMRLE ; No -- Advance to next line.
CALL LSTTAB ; Tab to next ref field.
HLRZ R0,0(R11) ; Retrieve current reference.
CALL LSTLN ; List it.
HRRZ R0,0(R11) ; Repeat same procedure
JUMPE R0,SYMTBE ; for reference in right half
SOJG R10,.+2 ; of current word.
CALL SYMRLE
CALL LSTTAB
HRRZ R0,0(R11)
CALL LSTLN
AOBJN R11,SYMTB3 ; Advance to next word.
; Block's full: Find next block, if any.
MOVE R0,0(R11) ; Get link to next ref block.
JUMPN R0,SYMTB3 ; One exists: Scan it.
JRST SYMTBE ; No more: End for this symbol.
; Filled a line with references & there's another to print.
SYMRLE: CALL LSTCR ; Terminate current line.
CALL LSTTAB ; Output 2 tabs; caller will
CALL LSTTAB ; supply 3rd to align with
; 1st reference field.
; Reset count of available reference fields left in line.
SYMSET: MOVEI R10,12. ; Presume 12 fields for a printer.
HRRZ R0,LSTCTL ; Check for .LIST TTM . . .
TRNE R0,LTTM ; Listing in teletype mode?
MOVEI R10,7 ; Yes - Limit it to 7 refs/line.
RETURN
GETSTE: ;GET SYMBOL TABLE ENTRY
ADDI R7,4 ;MOVE UP four
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
; Compute number of significant decimal digits for
; the number in R0.
; At return R4 = digit count, R0 = 0.
NSIG: SETZ R4, ; Initial digit count = 0.
NSIG1: AOJ R4, ; Increment digit count.
IDIVI R0,10. ; Divide # or last quotient by 10.
JUMPN R0,NSIG1 ; Repeat if quotient > 0.
RETURN
; List a "middle-adjusted" line number:
; This means supplying minimal padding on left to align
; rightmost digits of each line number with rightmost
; digit of largest line number.
LSTLN: PUSH P,R0 ; Save number to be listed.
CALL NSIG ; Get # of significant digits in it.
SUB R4,SEQND ; Padding count =
JUMPE R4,LSTLN2 ; # digits in largest line number
MOVNS R4 ; - # digits in this line number.
MOVEI R2,40 ; Load padding byte for output calls.
LSTLN1: CALL LSTOUT ; List a leading blank.
SOJG R4,LSTLN1 ; Iterate to suit padding count.
LSTLN2: POP P,R0 ; Restore line number to output.
JRST LSTLNU ; List it & return to caller.
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
;Really should check for being inside an .INSERT, so might have
;channels pushed? Especially on pass1.
.close srcch,
;;END OF PASS
TLNN R15,P1F ;PASS 1?
JRST [CALL CODOUT ;END OF PASS 2
MOVE R2,ENDVEC ;GET THE VECTOR
MOVEM R2,CODLOC ; Set transfer address as data loc.
JRST TROUT] ; Output transfer record & return
;;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?
return ; NO -- LEAVE SYM TAB AS IS.
; YES - SCAN FOR UNDEFINED SYMS.
SETZ R7, ; CLEAR INDEX INTO TABLE.
ENDUS: ADDI R7,4 ; ADVANCE TO NEXT SYMBOL.
CAML R7,SYMLEN ; IS THIS THE END?
return ; 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.
LSTMCR: CALL LSTMSG
JRST LSTCR ;LIST MESSAGE AND CRR
LSTMSG: TLOA R10,(440700,,0) ;SET BYTE POINTER AND SKIP
LSTMS4: CALL LSTOUT ;TYPE CHARACTER
LSTMS5: ILDB R2,R10 ;GET CHARACTER
JUMPE R2,CPOPJ ;TEST FOR END
CAIE R2,"% ; Special for number print?
JRST LSTMS4 ; No - take as a valid character
CALL DNC ; Print number
JRST LSTMS5 ;GET NEXT CHARACTER
consta
variab
PgmEnd==.
;; SUBTTL Predefined symbols (prototype symbol table)
400000,,000000 ; Table bottom marker
0 ; End-of-table marker
0 ; (1 complete entry)
0
377777,,777777
PSLEN=.-PgmEnd-1
end macn80
Reference in New Issue View Git Blame Copy Permalink