Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
decus/20-0140/cross.mac
There are 3 other files named cross.mac in the archive. Click here to see a list.
XLIST
DEFINE DEFTTL (NAME,MAJOR,MINOR,EDIT,DATE)
<
LALL
TITLE NAME V'MAJOR DATE
SUBTTL INITIALIZATION
; COPYRIGHT DIGITAL EQUIPMENT CORPORATION
; 1977, 1978
MNNUM== "MINOR"-100
IFIDN <MINOR> <> <MNNUM==0>
IFIDN <DATE> <> <DEBUG==0>
DEFINE DEFOUT <
OUTSTR [ASCIZ /NAME: /]>
TWOSEG
LOC <.JBVER==:137>
EXP 0B2!<MAJOR>B11!<MNNUM>B17!EDIT
LOC <.JBREN==:124>
0,,START
RELOC 0
RELOC 400000
SYN RELOC,.LOC
SYN RELOC,.RELOC
SYSPPN: 1,,4
SYSDEV: SIXBIT /DSK/ ;SYSTEM DEVICE
TITLE: ASCIZ /NAME MAJOR'MINOR(EDIT)/
ENTRY COLD
EXTERNAL .JBREL,.JBFF,.JBUUO,.JB41,.JBHRL
SALL
>
LIST
DEFTTL <CROSS - MICRO PROCESSOR ASSEMBLER>,6,,31,<9-FEB-78>
DEFINE ASCNAM <
EXP "C","R","O","S","S">
SUBTTL CONCISE CHANGE HISTORY
COMMENT %
Edit # Description
*********************************************************************
1 FIRST VERSION OF X6502 CROSS ASSEMBLER
2 ADD PAPER TAPE FEATURE FOR KIM-1
3 FIX LISTING FORMAT, FIX .ASCII/Z PSEUDO OPS
4 FIX .NTYPE AND MISC. OTHERS
5 MORE LISTING FORMAT FIX, ADD TIMING CODE
6 RANDOM AEXP BUGS (ALLOW NEG EXPRESSIONS)
7 JSR HAD WRONG TIMING INFO, BCS HAD WRONG OP-CODE
10 MAKE .ADDR PSEUDO-OP TO GENERATE LOW,HIGH , .WORD
TO GENERATE HIGH,LOW
11 FIRST VERSION W/ 8080 CODE ADDED
12 ADDED PTP FORMAT & TIMING FOR 8080
13 FIRST VERSION W/ 6800 CODE ADDED
14 FIX BUGS IN M6800 CODE
15 ADD ".LIST MB" FOR MACRO BINARY ONLY (NO SOURCE)
16 ADD Z80 OPCODE INFO
17 FIX REGISTER INIT LOGIC
20 ADD 8008 MACHINE DEFS (USING 8080 COMPATIBLE MNEMONICS)
21 ADD 8008 MACHINE DEFS (USING ORIGINAL INTEL MNEMONICS)
ADD NOP TO PREVIOUS 8008 MNEMONICS
22 ADD /OCT SWITCH TO PROVIDE OCTAL LISTINGS.
FIX PROBLEM GENERATING HIGH OR LOW BYTES OF ADDRESS TAGS FOR
IMMEDIATE MODE 8008 BY CHANGING PARSING TO PERMIT THE USE OF
TAG FOR LOWER HALF OR TAG^ FOR UPPER HALF.
23 FIX TIMING INFORMATION FOR 8008 CONDITIONAL JUMPS & CALLS
24 FIX TTY LISTING FORMAT AND CORRECT EXPR^ TO WORK CORRECTLY
WITH OTHER EXPRESSION MODIFIERS
25 FIX PTP OUTPUT FOR 16-BIT WORD FORMATS (DON'T SWAP BYTES)
26 ADD CDP1802 MACHINE (RCA COSMAC)
27 CHANGE BINARY PREFIX (PERCENT) FOR 6800 AND 6502 ONLY,
ALL OTHERS -- REGISTER DEFINITION
30 RE-FIX TTY LISTING FORMAT.
31 ADD .ENABL M85 FOR 8085 OP CODES (RIM,SIM)
%
SUBTTL VARIABLE PARAMETERS
DEFINE GENPAR (NAME,VALUE)
<
IFNDEF NAME, <NAME== VALUE>
>
GENPAR PAGSIZ,^D54 ; NUMBER OF LINES ON A PAGE
GENPAR NUMBUF,2 ; NUMBER OF BUFFERS PER DEVICE
GENPAR CORINC,2000 ; CORE INCREMENT
GENPAR SPL,4 ; SYMBOLS PER LINE (SYMBOL TABLE LISTING)
GENPAR SPLTTY,3 ; SYMBOLS PER LINE (TTY)
GENPAR DATLEN,^D350 ; DATA BLOCK LENGTH
GENPAR RLDLEN,^D40
GENPAR LSRNGE,^D65534 ;LOCAL SYMBOL RANGE
GENPAR WPB,10 ; MACRO BLOCK SIZE
GENPAR CPL,^D132 ; CHARACTERS PER LINE
GENPAR PDPLEN,100 ; PUSH-DOWN POINTER LENGTH
GENPAR COLLPT,^D128 ;CPL LPT
GENPAR COLTTY,^D72 ;CPL TTY
GENPAR TTLLEN,COLLPT-^D<8*5> ;TITLE AND SUB-TITLE BUFFER SIZE
GENPAR LCFDEF,LC.MB!LC.ME!LC.MEB!LC.LD ;DEFAULT LISTING SUPPRESSION
BKT1== 1
BKT2== 2
BKT3== 3
BKT4== 4
BKT6== 6
.LOC
IFDEF DEBUG <
PATCH: BLOCK 100 ;DEBUGGING PATCH AREA >
RSXSW: BLOCK 1 ;NON-ZERO IF RSW PSECT DEFAULTS
;ARE ENABLED
PDPSTK: BLOCK PDPLEN
CCLTOP: BLOCK 1 ;TOP OF CCL STORAGE
CCLPNT: BLOCK 1 ;CCL POINTER
BZCOR:
.RELOC
SUBTTL ACCUMULATOR ASSIGNMENTS
SYM= 0 ; ACCUMULATION OF SIXBIT SYMBOL, SCRATCH
T1= 1 ; SYMBOL VALUE AND FLAGS SET BY SRCH. SCRATCH
T2= 2 ; SCRATCH
T3= 3 ; UNIVERSAL SCRATCH
T4= 4 ; UNIVERSAL SCRATCH +1
PC= 5 ; LOCATION COUNTER
Q1= 6 ; SCRATCH
Q2= 7 ; SYMBOL TABLE SEARCH INDEX
VAL= 10 ; EXPRESSION OR TERM VALUE, SCRATCH
Q3= 11 ; SCRATCH
ASM= 12 ;
LBP= 13 ; LINE BUFFER BYTE POINTER
CHR= 14 ; CURRENT CHARACTER (ASCII)
FLG= 15 ; LH - ASSEMBLER FLAGS, RH - ERROR FLAGS
EXF= 16 ; EXEC FLAGS
P= 17 ; PUSH-DOWN POINTER
SUBTTL FLAG REGISTERS
; EXF - LH
LSTBIT== 000001 ; 1- SUPPRESS LISTING OUTPUT
BINBIT== 000002 ; 1- SUPPRESS BINARY OUTPUT
CRFBIT== 000004 ; 1- CREF DISABLED
OCTBIT== 000010 ; 1- LIST OCTAL
SOLBIT== 000020 ; 1- SEQUENCE OUTPUT LINES
NSWBIT== 000040 ; 1- SUPPRESS ERRORS ON TTY
FMTBIT== 000100 ; 1- GNS MODE
TTYBIT== 000200 ; 1- LISTING IS ON TTY
ERRBIT== 000400 ; 1- ERROR MESSAGES ENABLED
P1LBIT== 001000 ; 1- LIST ON PASS 1
CDRBIT== 002000 ; 1- /CDR MODE
LPTBIT== 004000 ; 1- SUPPRESS LISTING TO LPT
GBLDIS== 010000 ; 1- DEFAULT GLOBALS DISABLED
INFBIT== 020000 ; 1- VALID INFORMATION SEEN
HDRBIT== 040000 ; 1- TIME FOR NEW LISTING PAGE
REGBIT== 100000 ; 1- REGISTERS SET AT COMMAND LEVEL
MODBIT== 200000 ; 1- USER MODE AC'S SET
GBLCCL== 400000 ;INDICATES WHETHER GBLDIS WAS SET BEFORE
;SOURCE SCANNING BEGAN
; EXF - RH
RSXBIT== 000001 ; 1- RSX defaults freshly enabled
; FLG - LH
PSWFLG== 000004 ; 1- PTP FORMAT OUTPUT
ASZFLG== 000010 ; 1- ASCIZ MODE
NQEFLG== 000020 ; 1- NO "Q" ERRORS AT END OF LINE
ENDFLG== 000040 ; 1- END OF SOURCE ENCOUNTERED
FFFLG== 000100 ; 1- ISOLATED FORM FEED
FMTFLG== 000200 ; 1- OVER-RIDE LC.FMT
LSBFLG== 000400 ; 1- NEW LOCAL SYMBOL RANGE
DEFFLG== 001000 ; 1- CREF DEFINITION
DSTFLG== 002000 ; 1- CREF DESTINATION
DS2FLG== 004000 ; 1- DITTO, 2ND FIELD
DISBIT== 010000 ; 1- DISABLE CURRENTLY IN EFFECT
LHMFLG== 020000 ; 1- MOVE LISTING TO LH MARGIN
FLTFLG== 040000 ; 1- ERROR ENCOUNTERED IN FLOATING ROUTINE
ISWFLG== 100000 ; 1- /I SEEN
P1F== 400000 ; 1- PASS 1 IN PROGRESS
SUBTTL ERROR FLAGS
ERR.A== 400000
ERR.B== 200000
ERR.D== 100000
ERR.E== 040000
ERR.I== 020000
ERR.L== 010000
ERR.M== 004000
ERR.O== 002000
ERR.P== 001000
ERR.Q== 000400
ERR.R== 000200
ERR.T== 000100
ERR.U== 000040
ERR.N== 000020
ERR.Z== 000010 ;MARGINAL INSTRUCTION
ERR.X== 000004
ERR.P1== 000001
ERRMNE: ASCIZ /ABDEILMOPQRTUNZX/
;DEFINE ERROR TYPES CONSIDERED "FATAL"
QMEMSK== ERR.A!ERR.B!ERR.D!ERR.E!ERR.I!ERR.L!ERR.M
QMEMSK==QMEMSK! ERR.O!ERR.P!ERR.Q!ERR.R!ERR.T!ERR.U!ERR.N
SUBTTL MICRO DEFINITIONS
;ADDRESSING MODES
.M65A1==1 ;ABSOLUTE OR ZERO PAGE
.M65A2==2 ; LOC,X "
.M65A3==3 ; LOC,Y "
.M63A4==4 ; (LOC,X)
.M65A5==5 ; (LOC),Y
.M65A6==6 ; (LOC)
.M65A7==7 ; #<EXPR>
.M65ZO==7 ;ZERO PAGE OFFSET
.M65RG==20 ;IMPLIED ADDRS (A,S,X,Y,P)
AM%IND==1B0 ;INDIRECT SEEN "("
AM%ZP==1B1 ;ADDRESS .LT. 256 (00-FF)
AM%ACC==1B2 ;ADDRESS IS ACCUMULATOR "A"
;HEX CODE DEFINITIONS
%%0==0
%%1==1
%%2==2
%%3==3
%%4==4
%%5==5
%%6==6
%%7==7
%%8==10
%%9==11
%%A==12
%%B==13
%%C==14
%%D==15
%%E==16
%%F==17
;MACHINE TYPE CODES
M65==0 ;MOS 6502
M68==1 ;MOTOROLA 6800
M80==2 ;8080/Z80
M88==3 ;8008 - UPWARD COMPATIBLE
M08==4 ;8008/MPS - INTEL
M18==5 ;RCA CDP1802 (COSMAC)
MF8==6 ;FAIRCHILD F8
MXX==7 ;MAX TYPE +1 FOR PSRCH (DIRECTIVES)
;ADDRESS MODES FOR 6800
.M68A1==1 ;IMMEDIATE (8/16 BIT)
.M68A2==2 ;DIRECT (ZERO PAGE)
.M68A3==3 ;RELATIVE (BRANCHES)
.M68A4==4 ;ABSOLUTE ADDRS
SUBTTL MISCELLANEOUS PARAMETERS
TTYDEV== 000010 ; 1- DEVICE IS A TTY
PTRDEV== 000200 ; 1- DEVICE IS A PTR
LPTDEV== 040000 ; 1- DEVICE IS A LPT
CDRDEV== 100000 ; 1- DEVICE IS A CDR
IODATA== 200000 ; 1- IO DATA ERROR
IODEV== 100000 ; 1- IO PARITY ERROR
IOWRLK== 400000 ; 1- IO WRITE LOCK ERROR
IOBKTL== 040000 ; 1- IO BLOCK TOO LARGE
IOEOF== 020000 ; 1- END OF FILE ON IO DEVICE
; DEVICE PARAMETERS
BIN== 1
LST== 2
SRC== 3
CCL== 3
CRF== 4
MAC== 5
SWI== 6 ;CHANNEL NUMBER FOR SWITCH.INI
INBIT== 2 ;DEVICE CAN DO INPUT
ALMODE== 1 ;ASCII LINE MODE
.IOASC== 0 ;ASCII MODE
IO.EOF== 1B22 ;EOF BIT IN DEVICE STATUS
SUBTTL OPDEFS
OPDEF CALL [PUSHJ P,]
OPDEF RETURN [POPJ P,]
OPDEF SPUSH [PUSH P,]
OPDEF SPOP [POP P,]
OPDEF RESET [CALLI 0]
OPDEF DEVCHR [CALLI 4]
OPDEF CORE [CALLI 11]
OPDEF EXIT [CALLI 12]
OPDEF DATE [CALLI 14]
OPDEF APRENB [CALLI 16]
OPDEF MSTIME [CALLI 23]
OPDEF RUNTIM [CALLI 27]
OPDEF ZBINK [CLOSE BIN,]
OPDEF OUTCHR [TTCALL 1,]
OPDEF OUTSTR [TTCALL 3,]
OPDEF INCHWL [TTCALL 4,]
DEFINE GENM40 (SYM) <
..V==0 ;;INIT SYMBOL
..M==50*50 ;;INIT MULTIPLIER
..C==-3 ;;INIT COUNT
IRPC <SYM>,<
..T==..M*$'SYM
IFL ..C,<..V==<..T,,0>+..V>
IFGE ..C,<..V==..V+..T>
..C==..C+1
IFE ..C,<..M==50*50*50>
..M==..M/50
>
EXP ..V
>
;TABLE LENGTH CHECKING MACRO
DEFINE CHKTAB (TNAME) <
IFN <.-TNAME-MXX>,<
PRINTX TABLE TNAME IS INCORRECT LENGTH (SEE MXX)
>
>
SUBTTL UUO HANDLERS
DEFINE UUODEF (NAME,SUBR)
<
OPDEF NAME [<.-UUOTBL>B8]
Z SUBR
>
UUOTBL: ;UUO TRANSFER TABLE
0 ;ZERO IS ILLEGAL
UUODEF DEVSET, DEVSE0 ;DEVICE INITIALIZATION
UUODEF FERROR, FERRO0 ;FATAL ERROR
UUODEF LSTSTR, LSTST0 ;LIST ASCIZ STRING
UUODEF LSTMSG, LSTMS0 ;LIST ASCIZ MESSAGE
UUODEF DNC, DNC0 ;DECIMAL NUMBER CONVERSION
UUODEF LSTSYM, LSTSY0 ;LIST SYMBOL
OPDEF LSTSIX [LSTSYM 2,]
UUODEF LSTICH, LSTIC0 ;LIST IMMEDIATE CHARACTER
UUODEF SETLCT, SETLC0 ;SET LCTST
; UUODEF TSTLCT, TSTLC0 ;SKIP IF ARG NOT SET IN LCFLGS
; UUODEF TSTEDT, TSTED0 ;SKIP IF NOT SET
UUODEF WCIMT, WCIMT0 ;WRITE CHARACTER IN MACRO TREE
; UUODEF ERRSET, ERRSE0 ;SET ERROR FLAG (FLG RH)
; UUODEF ERRSKP, ERRSK0 ;DITTO, AND SKIP
UUODEF ERRXIT, ERRXI0 ;DITTO, AND EXIT
OPDEF SKPLCR [TLNE ASM,] ;REPLACES TSTLCT
OPDEF SKPLCS [TLNN ASM,] ;SKIP IF LISTING CONTROL SET
OPDEF SKPEDR [TRNE ASM,] ;REPLACES TSTEDT
OPDEF SKPEDS [TRNN ASM,] ;SKIP IF ENABLE SET
OPDEF ERRSET [TRO FLG,]
OPDEF ERRSKP [TROA FLG,]
BLOCK 40+UUOTBL-. ;ZERO REMAINDER OF TABLE
UUOPRO: ;UUO PROCESSOR
SPUSH T2 ;STACK WORK REGISTER
LDB T2,[POINT 9,.JBUUO,8] ;GET INDEX
SKIPN T2,UUOTBL(T2) ;FETCH VECTOR, NULL?
HALT . ; YES, ERROR
EXCH T2,0(P) ;NO, SET VECTOR AND RESTORE REG
RETURN ; "CALL" THE ROUTINE
SUBTTL EXEC INITIALIZATION
COLD: ;INITIAL ENTRY POINT
SETZM RSXSW ;ENABLE RSX DEFAULTS
HLLZS EXF ;CLEAR RH EXF
START: SETZM CCLTOP ;CLEAR CCL POINTER
NXTCCL: RESET
SKIPE T3,CCLTOP ;CCL IN PROGRESS?
HRRZM T3,.JBFF ; YES
MOVE 0,.JBFF ;GET FIRST FREE
ADDI 0,200*NUMBUF*2+200+200 ;MAKE ROOM FOR BUFFERS, ETC.
CORE 0, ;SET CORE
HALT . ; DIDN'T MAKE IT
MOVSI P,-P
SETZM SYM(P)
AOBJN P,.-1
MOVEI T1,M65 ;SET DEFAULT MACHINE TYPE
MOVEM T1,MACHT
TLO ASM,LCFDEF ;SET DEFAULT LISTING FLAGS
TRO ASM,ED.ABS ;DEFAULT ABSOLUTE
HRLI EXF,BINBIT!LSTBIT!CRFBIT ;INIT "EXEC" FLAG REGISTER
MOVE P,[IOWD PDPLEN,PDPSTK] ;BASIC PDP
MOVSI T3,-<EZCOR-BZCOR>
SETZM BZCOR(T3) ;CLEAR VARIABLES
AOBJN T3,.-1
MOVE 0,[CALL UUOPRO]
MOVEM 0,.JB41 ;SET UUO TRAP
MOVEI 0,ERR.X
MOVEM 0,ERRSUP ;DEFAULT DISABLE OF "X" FLAG
CALL SETSYM
SETZM 0
RUNTIM 0, ;GET CURRENT RUN TIME,
MOVEM 0,RUNTIM
DATE 0, ; AND DATE,
MOVEM 0,DATE
MSTIME 0, ; AND TIME
MOVEM 0,MSTIME
TLZ EXF,GBLDIS
SUBTTL SWITCH.INI PROCESSING
MOVE T2,[XWD SWIOPN,LSWOPN]
BLT T2,LSWOPN+2
MOVE T2,[XWD SWILOO,LSWLOO]
BLT T2,LSWLOO+3
OPEN SWI,LSWOPN ;INITIALIZE CHANNEL
HALT .
LOOKUP SWI,LSWLOO ;OPEN FILE
JRST SWIEND ;SWITCH.INI NOT PRESENT
INBUF SWI,1 ;SET UP THE RING WITH ONLY ONE BUFFER
CALL SWIRD ;GET FIRST BUFFERFUL
JRST SWIEND ;...MUST HAVE BEEN EMPTY
MOVE T2,SWIBUF+2 ;COLLECT BYTE COUNT
SWINB: ;LOOK FOR NON-BLANKS
CALL SWICHR ;GET A CHARCTER
JRST SWIEND ;ALL DONE
CAIE CHR,SPACE
CAIN CHR,TAB
JRST SWINB ;BYPASS THIS BLANK-TYPE CHARACTER
MOVSI T1,-5 ;SET UP COUNTER
JRST .+3 ;BYPASS FIRST COLLECTION
SWICMP: ;COMPARE SYMBOL WITH "CROSS"
CALL SWICHR
JRST SWIEND
CAME CHR,NMTABL(T1)
JRST SWIEOL ;NO GOOD. GO TO END OF LINE.
AOBJN T1,SWICMP ;BACK FOR MORE(PERHAPS)
;MATCHED!
MOVE Q1,[POINT 7,SWIBYT] ;PREPARE TO FILL INTERMED. BUFFER
SWIMOV: ;FILL INTERMEDIATE BUFFER
CALL SWICHR ;GET ONE
JRST SWIGET
CAIN CHR,CRR ;END OF LINE?
JRST SWIGET ;YES
CAIN CHR,"-" ;HYPHEN?
JRST SWICON ;YES...ASSUME CONTINUATION
IDPB CHR,Q1 ;ELSE, PUT THE CHARACTER INTO THE BUFFER
JRST SWIMOV ;CONTINUE
SWICON: ;PROCESS LINE CONTINUATION
CALL SWICHR
JRST SWIERR ;PROBLEMS...
CAIE CHR,CRR ;EOL YET?
JRST SWICON ;NO
CALL SWICHR ;CHECK FOR PRESENCE OF LINE FEED
CAIA ;THIS IS THE ERROR RETURN
CAIE CHR,LF ;SKIP IF LINE FEED
JRST SWIERR ;CRAP OUT
JRST SWIMOV ;BACK FOR CONTINUATION LINE
SWIGET:
SETZ CHR,
IDPB CHR,Q1
MOVE LBP,[POINT 7,SWIBYT,6] ;FAKE UP AC13 FOR GETNB, ET.AL.
CALL SETNB
CAIE CHR,"/" ;FIRST CHARACTER A SLASH?
JRST SWIERR ;NO.
CALL SSWPRO ;GO PROCESS SWITCHES
SWIEND:
CLOSE SWI,
OUTSTR [BYTE (7) CRR,LF,0]
JRST START0
SWIERR: ;ERROR IN SWITCH.INI
OUTSTR [BYTE (7) CRR,LF,0]
OUTSTR [ASCIZ /? ERROR IN SWITCH.INI FILE/]
OUTSTR [BYTE (7) CRR,LF,0]
EXIT
;SUBROUTINES
SWIRD: ;GET A BUFFERFUL OF DATA
IN SWI, ;GET IT
JRST CPOPJ1 ;GOOD...TAKE SKIP RETURN
STATO SWI,IO.EOF ;WAS IT AN END OF FILE?
OUTSTR [ASCIZ /ERROR IN READING SWITCH.INI/]
RETURN ;TAKE NORMAL RETURN
SWICHR: ;GET A SINGLE CHARACTER IN AC14
SOJL T2,SWCHR2 ;JUMP ON END-OF-FILE
IBP SWIBUF+1 ;INCREMENT INPUT BYTE POINTER
MOVE CHR,@SWIBUF+1 ;GET ENTIRE WORD
TRNE CHR,1 ;LINE NUMBER?
JRST SWICH1 ;YES
LDB CHR,SWIBUF+1 ;GET THE CHARACTER
CAIL CHR,"A"+40 ;LOWER-CASE?
CAILE CHR,"Z"+40 ;...?
CAIA ;NO
SUBI CHR,40 ;CONVERT TO UPPER CASE
JRST CPOPJ1 ;TAKE SKIP-RETURN
SWICH1: ;LINE SEQ NUMBER
AOS SWIBUF+1 ;INCREMENT POINTER AROUND LSN
SUBI T2,5 ;DECREMENT COUNTER
JUMPGE T2,SWICHR ;IF COUNT OK, BACK FOR MORE
;ELSE, FALL INTO COLLECTION OF ANOTHER LOAD
SWCHR2:
CALL SWIRD ;GET ANOTHER LOAD
RETURN ;TERMINAL RETURN
MOVE T2,SWIBUF+2 ;GET BYTE COUNT
JRST SWICHR ;BACK FOR MORE
;LOOK FOR END OF LINE
SWEOL0: CALL SWICHR
JRST SWIEND
SWIEOL:
CAIE CHR,LF ;LINE FEED?
JRST SWEOL0 ;NO
JRST SWINB ;NEW LINE AT LAST
;DATA AREAS
NMTABL: ASCNAM ;NAME TO MATCH
SWIOPN:
EXP .IOASC ;ASCII MODE
SIXBIT /DSK/ ;DEVICE
XWD 0,SWIBUF
SWILOO:
SIXBIT /SWITCH/
SIXBIT /INI/
EXP 0
XWD 0,0 ;USE CURRENT PPN
.LOC
LSWOPN: BLOCK 3
LSWLOO: BLOCK 4
SWIBUF: BLOCK 3 ;BUFFER HEADER
SWIBYT: BLOCK ^D29 ;INTERMEDIATE BUFFER FOR CROSS LINE
.RELOC
SUBTTL CONTINUATION OF OPENING FESTIVITIES
START0:
SKIPN CCLTOP
OUTCHR ["*"] ;AWAKEN THE USER
MOVE LBP,.JBFF
HLL LBP,ASCBYT
MOVEM LBP,TTIBEG
START1: CALL CCLGET ;GET A TTI CHAR
CAIE CHR,SPACE
CAIN CHR,TAB
JRST START1 ;IGNORE BLANKS
CAIL CHR,"A"+40 ;UPPER CASE?
CAILE CHR,"Z"+40
CAIA
SUBI CHR,40 ; YES, CONVERT TO UPPER
CAIN CHR,CRR
JRST START1 ;DITTO FOR CR'S
CAIE CHR,LF ;IF LINE FEED
CAIN CHR,ALTMOD ; OR ALTMODE,
MOVEI CHR,0 ;SET END OF ENTRY
DPB CHR,LBP
IBP LBP
JUMPN CHR,START1
ADDI LBP,1
HRRZM LBP,.JBFF
MOVE LBP,TTIBEG
SETCHR ;SET THE FIRST CHAR
JUMPE CHR,NXTCCL ;RESTART IF NOTHING TO PROCESS
CALL GETBIN ;INIT THE BINARY
TLNN FLG,PSWFLG ;PTP MODE?
JRST STRT1A ;NO, PROCEED
SETSTS BIN,.IOASC ;YES, SET ASCII MODE
HRLI T3,(POINT 7,,0)
HLLM T3,BINPNT ;CHANGE BYTE PNTR
STRT1A: CAIE CHR,"," ;ANOTHER FIELD?
JRST START2 ; NO
GETCHR ;YES, BYPASS COMMA
CALL GETLST ;INIT THE LISTING FILE
START2: MOVE T3,SYSDEV
MOVEM T3,DEVNAM
DEVSET MAC,1
XWD 0,MACBUF
MOVE T3,.JBFF
MOVEM T3,JOBFFM
INBUF MAC,NUMBUF
CAIE CHR,"_" ;TEST FOR LEGAL SEPARATOR
CAIN CHR,"<" ;>
MOVEI CHR,"="
CAIE CHR,"="
FERROR [ASCIZ /NO = SEEN/] ;FATAL ERROR
MOVEM LBP,TTISAV ;SAVE FOR PASS2 RESCAN
HLLZM ASM,LCFLGS
MOVE T3,[XWD LCBLK,LCSAVE]
BLT T3,LCSAVE+LCLEN-1 ;SAVE LISTING FLAGS
HRRZM ASM,EDFLGS
MOVE T3,[XWD EDBLK,EDSAVE]
BLT T3,EDSAVE+EDLEN-1 ; AND ENABLE/DISABLE FLAGS
MOVE T3,.JBFF
MOVEM T3,CRFBAS
CALL ACEXCH ;GET USER AC'S
SKIPE CCLTOP
DEFOUT
SKIPN CCLTOP
OUTSTR [BYTE (7) CRR,LF,0] ;CONFIRM ALL'S WELL
CALL ASSEMB ;CALL THE ASSEMBLER
SETZM T3
RUNTIM T3,
MOVEM T3,RUNTIM+2
TLNN EXF,LSTBIT
CALL SYMTB
SETZM T3
RUNTIM T3,
MOVEM T3,RUNTIM+3
CALL ACEXCH ;GET EXEC AC'S
SKPINC ;RESET POSSIBLE ^O
JFCL
CALL LSTCR ;LIST A CR/LF
SPUSH EXF
SKIPN ERRCNT
SKIPN CCLTOP
TLO EXF,ERRBIT ;MESSAGE TO LPT AND TTY
TLZ EXF,NSWBIT ;CLEAR /N
CALL LSTCR
SKIPE Q3,ERRCNT ;ANY ERRORS?
LSTICH "?" ; YES, FLAG THE LISTING
LSTMSG [ASCIZ / ERRORS DETECTED: 5/]
SKIPE Q3,ERRCNT+1 ;ANY NON-FATAL ERRORS?
LSTMSG [ASCIZ -/5-] ; YES
SKIPE Q3,DGCNT ;ANY DEFAULT GLOBALS?
LSTMSG [ASCIZ / DEFAULT GLOBALS GENERATED: 5/];GUESS SO
LSTMSG [ASCIZ /00/]
SPOP SYM
TLNE SYM,NSWBIT ;WAS /N SET?
TLO EXF,NSWBIT ; YES, RE-SET IT
SETZM STLBUF
LSTICH SPACE
LSTICH "*"
LSTSTR @TTIBEG
LSTMSG [ASCIZ /0 RUN-TIME: /]
MOVSI T1,-3
START4: MOVE T3,RUNTIM+1(T1)
SUB T3,RUNTIM(T1)
IDIVI T3,^D1000
DNC T3
LSTICH SPACE
AOBJN T1,START4
SKIPN Q3,TIMCNT
JRST START5
LSTMSG [ASCIZ /(5-/]
MOVE T3,TIMTIM
IDIVI T3,^D1000
MOVE Q3,T3
LSTMSG [ASCIZ /5) /]
START5: LSTMSG [ASCIZ /SECONDS0/]
HRRZ Q3,.JBREL ;GET TOP OF COR
ASH Q3,-^D10 ;CONVERT TO "K"
ADDI Q3,1 ;BE HONEST ABOUT IT
LSTMSG [ASCIZ / CORE USED: 5K0/]
SKPEDS ED.WRP
JRST START6
MOVE T3,WRPCNT+1
IMULI T3,^D100
IDIV T3,WRPCNT
MOVE Q3,T3
LSTMSG [ASCIZ / WRAP-AROUND: 5%0/]
START6: CALL LSTCR
;FALL INTO THE NEXT PAGE...
EXIT: TLNE EXF,MODBIT ;EXEC MODE?
CALL ACEXCH ; NO, GET AC'S
CLOSE LST, ;CLOSE THE LISTING FILE
TLNE FLG,PSWFLG ;PTP OUTPUT?
TLNE EXF,BINBIT ; AND BIN FILE OPEN?
JRST EXIT1 ;NO - DON'T BOTHER
HRRZ T1,MACHT ;ELSE DO MACHINE WRAPUP
CALL @EOFTB(T1)
EXIT1: CLOSE BIN, ;CLOSE THE BINARY FILE
TLON EXF,LSTBIT ;WAS THERE A LISTING FILE?
CALL LSTTST ;YES, TEST FOR FINAL ERROR
TLON EXF,BINBIT ;IS THERE A BINARY FILE?
CALL BINTST ;YES, TEST FOR FINAL ERROR
TDZE CHR,CHR ;END OF COMMAND STRING?
FERROR [ASCIZ /NOT ALL INPUT FILES PROCESSED/] ; NO
JRST NXTCCL ;RESTART
FERRO0: ; "FERROR" UUO
TRZE EXF,RSXBIT ;NON-RSX DEFAULTS FRESHLY ENABLED?
JRST START ;YES. IT'S OK...
PUSH P,.JBUUO ;SAVE ARG
TLNE EXF,MODBIT
CALL ACEXCH ;SET EXEC AC'S
HRLI EXF,ERRBIT!LSTBIT!BINBIT!CRFBIT ;FUDGE FLAGS
LSTMSG [ASCIZ /0? /]
LSTMSG @0(P) ;OUTPUT BASIC MESSAGE
LSTMSG [ASCIZ /00*/]
MOVEI T3,0
DPB T3,LBP
LSTSTR @TTIBEG
LSTICH "?"
LSTMSG [ASCIZ /00/] ;TWO CR/LF'S
JRST START
EOFTB: CPOPJ ;6502
CPOPJ ;6800
M80EOF ;8080
M80EOF: MOVEI T2,"$" ;EOF CHARACTER
CALL BCHOUT
MOVEI T2,CRR ;CRLF
CALL BCHOUT
MOVEI T2,LF
CALL BCHOUT ;...
JRST BINDMP ;DUMP BUFFERS
.LOC
RUNTIM: BLOCK 4
DATE: BLOCK 1
MSTIME: BLOCK 1
ERRCNT: BLOCK 2
DGCNT: BLOCK 1 ;NUMBER OF DEFAULT GLOBALS GENERATED
.RELOC
TIMTST: JFCL
CAIA
AOS 0(P)
SPOP TIMTMP
SPUSH T2
SETZM T2
RUNTIM T2,
EXCH T2,0(P)
CALL @TIMTMP
CAIA
AOS -1(P)
EXCH T2,-1(P)
MOVEM T2,TIMTMP
SETZM T2
RUNTIM T2,
SUB T2,0(P)
ADDM T2,TIMTIM
AOS TIMCNT
SPOP T2
SPOP T2
JRST @TIMTMP
.LOC
TIMTIM: BLOCK 1
TIMCNT: BLOCK 1
TIMTMP: BLOCK 1
.RELOC
SUBTTL FILE INITIALIZATION
GETBIN: ;GET BINARY FILE
MOVE T3,SYSDEV
MOVEM T3,DEVNAM ;SET DEFAULT DEVICE
CALL CSIFLD ;GET THIS FIELD
RETURN ; NO, EXIT
CAIN CHR,"@" ;CCL?
JRST CCLSET ; YES
DEVSET BIN,10 ;INIT IMAGE MODE
XWD BINBUF,0 ;ARG
OUTBUF BIN,NUMBUF ;BUMP .JBFF
MOVE T3,[XWD DEVNAM,BINBLK]
BLT T3,BINBLK+4 ;SAVE NAME FOR LATER ENTER
TLZ EXF,BINBIT ;INDICATE GOOD BINARY FILE
RETURN
SETBIN: ;SET BIN (END OF PASS 1)
TLNE EXF,BINBIT ;ANY BINARY?
RETURN ; NO, EXIT
CALL ACEXCH ;YES, GET EXEC AC'S
MOVS T3,[XWD DEVNAM,BINBLK]
BLT T3,DEVNAM+4 ;SET UP BLOCK
SKIPE T3,FILEXT ;EXPLICIT EXTENSION?
JRST SETBI1 ; YES
MOVSI T3,(SIXBIT /OBJ/)
SKPEDR ED.ABS ;ABS MODE?
MOVSI T3,(SIXBIT /BIN/) ; YES
TLNE FLG,PSWFLG ;PTP FILE?
MOVSI T3,(SIXBIT /PTP/)
SETBI1: HLLZM T3,FILEXT ;SET IN LOOKUP BLOCK
ENTER BIN,FILNAM ;ENTER FILE NAME IN DIRECTORY
FERROR [ASCIZ /NO ROOM FOR 3/] ; FULL
SETZM RECCNT ;CLEAR RECORD COUNT
JRST ACEXCH ;TOGGLE AC'S AND EXIT
GETLST: ;GET LISTING FILE
MOVE T3,SYSDEV
MOVEM T3,DEVNAM ;SET DEFAULT DEVICE
CALL CSIFLD ;GET THIS FIELD
RETURN ; NO, EXIT
DEVSET LST,1 ;INIT ASCII MODE
XWD LSTBUF,0
OUTBUF LST,NUMBUF
SKIPN T3,FILEXT ;EXPLICIT EXTENSION?
MOVSI T3,(SIXBIT /LST/) ; NO, SUPPLY ONE
HLLZM T3,FILEXT
ENTER LST,FILNAM
FERROR [ASCIZ /NO ROOM FOR 3/] ; FULL
MOVE SYM,DEVNAM
DEVCHR SYM, ;GET DEVICE CHARACTERISTICS
MOVEI T3,LC.TTM
TLNE SYM,TTYDEV ;IS DEVICE TELETYPE?
TLOA EXF,TTYBIT ; YES, FLAG AND SKIP
TDNE T3,LCMSK ;NO, TTM SEEN?
CAIA
TLO ASM,0(T3) ;NO, SUPPRESS TELETYPE MODE
TLZ EXF,LSTBIT ;INDICATE A GOOD LISTING FILE
JRST LPTINI ;INIT LINE OUTPUT AND EXIT
SETCRF:
TLNE EXF,LSTBIT!CRFBIT
RETURN
CALL ACEXCH
CALL GETCOR
MOVE T3,SYSDEV
MOVEM T3,DEVNAM
DEVSET CRF,10
XWD CRFBUF,0
OUTBUF CRF,
MOVEI SYM,3
PJOB T2,
SETCR1: IDIVI T2,^D10
ADDI T3,"0"-40
LSHC T3,-6
SOJG SYM,SETCR1
HRRI T4,(SIXBIT /CRF/)
MOVEM T4,CRFNAM
MOVEM T4,FILNAM
MOVSI T3,(SIXBIT /TMP/)
MOVEM T3,FILEXT
SETZM FILPPN
ENTER CRF,FILNAM
FERROR [ASCIZ /NO ROOM FOR 3/]
JRST ACEXCH
SETSRC: ;SET FOR SOURCE SCAN (EACH PASS)
CALL ACEXCH ;GET EXEC AC'S
SETZM T3
RUNTIM T3,
MOVEM T3,RUNTIM+1
MOVE LBP,TTISAV ;SET CHAR POINTER
SETCHR ;SET THE FIRST CHARACTER
MOVE T3,SYSDEV
MOVEM T3,DEVNAM ;SET DEFAULT DEVICE NAME
SETZM PPNSAV ;CLEAR PROJECT-PROGRAMMER NUMBER
SETZM LINNUM ;CLEAR SEQUENCE NUMBER
SETZM LINNUB ; AND ITS BACKUP
TLNE EXF,SOLBIT ;SEQUENCE OUTPUT LINES?
AOS LINNUM ; YES, PRESET
MOVS T3,[XWD LCBLK,LCSAVE]
BLT T3,LCBLK+LCLEN-1 ;RESTORE LC FLAGS
HLL ASM,LCFLGS
MOVS T3,[XWD EDBLK,EDSAVE]
BLT T3,EDBLK+EDLEN-1 ; AND ENABLE/DISABLE FLAGS
HRR ASM,EDFLGS
CALL GETSRC ;PROCESS FIRST FIELD
JRST ACEXCH ;EXCHANGE AC'S AND EXIT
GETSRC: ;GET A SOURCE FILE
GETCHR ;BYPASS DELIMITER
CALL CSIFLD ;GET THE FIELD
FERROR [ASCIZ /NULL SOURCE FIELD/] ; NO
DEVSET SRC,1 ;INIT DEVICE
XWD 0,SRCBUF
MOVEI T3,JOBFFS
EXCH T3,.JBFF ;SET TO TOP OF INPUT BUFFER
INBUF SRC,NUMBUF
MOVEM T3,.JBFF ;RESTORE .JBFF
MOVE SYM,DEVNAM
DEVCHR SYM,
TLNN SYM,TTYDEV
JRST GETSR3
OUTSTR [BYTE (7) 15,12]
SKPINC ;TYPED AHEAD?
CAIA ; NO
RETURN ;YES, NO MESSAGE
OUTSTR [ASCIZ /READY/]
OUTSTR [BYTE (7) 15,12]
RETURN
GETSR3: SKIPE T1,FILEXT ;EXPLICIT EXTENSION?
JRST GETSR1 ; YES
MOVE T3,[-MXX,,TYPET]
GETSR5: HLLZ T1,0(T3) ;FILE EXTN
CALL GETSR2 ;TRY IT
JRST GETSR4 ;SUCCESS
AOBJN T3,GETSR5 ;TRY AGAIN
SETZM T1
GETSR1: CALL GETSR2 ; NO, TRY NULL NEXT
JRST GETSR6 ;SUCCESS - CHECK WHAT TYPE
;NO DICE
FERROR [ASCIZ /CANNOT FIND 3/]
GETSR2: HLLZM T1,FILEXT ;SAVE EXTENSION IN LOOKUP BLOCK
LOOKUP SRC,FILNAM ;LOOKUP FILE NAME
JRST CPOPJ1 ; NOT FOUND, SKIP-RETURN
MOVE T1,[XWD FILNAM,SRCSAV]
BLT T1,SRCSAV+1
RETURN ;EXIT
GETSR6: HLRZ SYM,FILEXT ;WHAT SUCCEEDED
MOVE T3,[-MXX,,TYPET]
GTSR6A: HLRZ T2,0(T3) ;TABLE VALUE
CAME SYM,T2 ;MATCH?
AOBJN T3,GTSR6A ;NO - TRY AGAIN
JUMPGE T3,CPOPJ ;EXIT IF NONE FOUND
GETSR4: HRRZ T1,0(T3) ;MACHINE CODE
SETMCH: MOVEM T1,MACHT ;SET MACHINE TYPE
RETURN
TYPET: 'M65',,M65
'M68',,M68
'M80',,M80
'M88',,M88
'M08',,M08
'M18',,M18
'MF8',,MF8
CHKTAB (TYPET)
CCLSET: ;SET CCL INPUT
SKIPE CCLTOP
FERROR [ASCIZ /NESTED CCL'S/]
MOVE SYM,DEVNAM
DEVCHR SYM,
TDC SYM,[XWD 2,2]
TDNE SYM,[XWD 2,2] ;LEGIT FILE?
FERROR [ASCIZ /DEVICE INPUT ERROR FOR COMMAND STRING/]
DEVSET CCL,1 ;YES, INIT
XWD 0,SRCBUF ;BORROW SOURCE BUFFER
SKIPE T3,FILEXT ;EXPLICIT EXTENSION?
JRST CCLSE1 ; YES
MOVSI T3,(SIXBIT /CCL/) ;TRY THE DEFAULT
HLLZM T3,FILEXT
LOOKUP CCL,FILNAM
TDZA T3,T3 ; MISSED
JRST CCLSE2 ;OK
CCLSE1: HLLZM T3,FILEXT
LOOKUP CCL,FILNAM
FERROR [ASCIZ /CANNOT FIND 3/] ;MISSED COMPLETELY
CCLSE2: MOVE T1,.JBFF ;GET CURRENT FIRST FREE
HRLI T1,(POINT 7,,) ;FORM BYTE POINTER
MOVEM T1,CCLPNT ;SAVE IT
MOVEI T3,JOBFFS ;SET TO READ INTO SOURCE BUFFER
MOVEM T3,.JBFF
INBUF CCL,NUMBUF
SETZM FLG ;CLEAR ERROR FLAG
CCLSE3: CALL CHAR ;GET A CHARACTER
TLZE FLG,ENDFLG ;END?
JRST CCLSE4 ; YES
TRZE FLG,-1 ;NO, GOOD CHARACTER?
JRST CCLSE3 ;NO, GET ANOTHER
HRRZ Q1,T1 ;COLLECT RIGHT HALF OF BYTE POINTER
CAML Q1,.JBREL ;COMPARE IT TO LAST FREE CORE ADDR
FERROR [ASCIZ /CCL FILE TOO LARGE/];
IDPB CHR,T1 ;STORE THE CHAR
JRST CCLSE3 ;BACK FOR MORE
CCLSE4: SETZM CHR
IDPB CHR,T1 ;STORE TERMINATOR
AOS T1
HRRZM T1,CCLTOP ;SET TOP POINTER
JRST NXTCCL
CCLGET: ;GET A CCL CHAR
SKIPN CCLTOP ;ANY CCL?
JRST CCLGE1 ; NO
ILDB CHR,CCLPNT ;YES, GET A CHAR
JUMPN CHR,CPOPJ ;EXIT IF NON-NULL
EXIT ; FINIS
CCLGE1:
INCHWL CHR ;GET A TTY CHAR
RETURN
DEVSE0: ; "DEVSET" UUO
MOVE T3,.JBUUO
HRRZM T3,DEVBLK ;SET MODE
MOVE T4,DEVNAM
MOVEM T4,DEVBLK+1 ;XFER NAME
MOVE T4,@0(P) ;FETCH ARG (BUFFER ADDRESS)
MOVEM T4,DEVBLK+2
AND T3,[Z 17,] ;MASK TO AC FIELD
IOR T3,[OPEN DEVBLK] ;FORM UUO
XCT T3
FERROR [ASCIZ /CANNOT ENTER 3/] ;MISSED
CALL SWPRO ;PROCESS SWITCHES
CPOPJ1: AOS 0(P) ;BYPASS ARG
CPOPJ: RETURN
.LOC ;FILE INITIALIZATION VARIABLES
DEVBLK: BLOCK 3 ;"OPEN" BLOCK
;FOLLOWING 5 MUST BE KEPT TOGETHEI
DEVNAM: BLOCK 1 ;DEVICE NAME
FILNAM: BLOCK 1 ;FILE NAME
FILEXT: BLOCK 1 ;EXTENSION
BLOCK 1
FILPPN: BLOCK 1 ;PROJECT-PROGRAMMER NUMBER
BINBLK: BLOCK 5 ;STORAGE FOR ABOVE
BINBUF: BLOCK 1 ;BINARY BLOCK HEADER
BINPNT: BLOCK 1
BINCNT: BLOCK 1
BINPCT: BLOCK 1
LSTBUF: BLOCK 1
LSTPNT: BLOCK 1
LSTCNT: BLOCK 1
CRFBUF: BLOCK 1
CRFPNT: BLOCK 1
CRFCNT: BLOCK 1
SRCBUF: BLOCK 1
SRCPNT: BLOCK 1
SRCCNT: BLOCK 1
SRCSAV: BLOCK 2
TTIBEG: BLOCK 1 ;BEGINNING OF TTY BUFFER
TTISAV: BLOCK 1 ;TELETYPE POINTER SAVE
PPNSAV: BLOCK 1 ;PPN STORAGE
CRFBAS: BLOCK 1
JOBFFS: BLOCK 204*NUMBUF ;SOURCE BUFFER
.RELOC
SUBTTL COMMAND STRING FIELD SCANNER
CSIFLD: ;PROCESS CLMMAND SCANNER FIELD
TLZ EXF,INFBIT ;CLEAR INFO BIT
CALL CSISYM ;TRY FOR A SYMBOL
CAIE CHR,":" ;DEVICE?
JRST CSIFL1 ; NO
MOVEM SYM,DEVNAM ;YES, STORE IT
GETCHR ;BYPASS COLON
CALL CSISYM ;GET ANOTHER SYMBOL
CSIFL1: MOVEM SYM,FILNAM ;ASSUME FILE NAME
SETZM FILEXT ;CLEAR EXTENSION
CAIE CHR,"." ;EXPLICIT ONE?
JRST CSIFL2 ; YES
GETCHR ;BYPASS PERIOD
CALL CSISYM ;GET EXTENSION
HLLOM SYM,FILEXT ;STUFF IT
CSIFL2: CAIE CHR,"[" ;PPN?
JRST CSIFL6 ; NO
SETZM PPNSAV ;CLEAR CELL
CSIFL3: HRLZS PPNSAV ;MOVE RH TO LH
CSIFL4: GETCHR ;GET THE NEXT CHAR
CAIN CHR,"]" ;FINISHED?
JRST CSIFL5 ; YES
CAIN CHR,"," ;SEPARATOR?
JRST CSIFL3 ; YES
CAIL CHR,"0" ;TEST FOR OCTAL NUMBER
CAILE CHR,"7"
FERROR [ASCIZ /ILLEGAL PPN/]
HRRZ T3,PPNSAV ;MERGE NEW CHAR
IMULI T3,8
ADDI T3,-"0"(CHR)
HRRM T3,PPNSAV
JRST CSIFL4 ;LOOP
CSIFL5: GETCHR
CSIFL6: MOVE T3,PPNSAV
MOVEM T3,FILPPN ;SAVE BACKGROUND PPN
TLNE EXF,INFBIT ;ANYTHING PROCESSED?
JRST CPOPJ1 ; YES, SKIP-EXIT
JRST SWPRO ;NO, BE SURE TO PROCESS SWITCHES
CSISYM: ;COMMAND SCANNER SYMBOL
CALL GETSYM ;GET ONE IN RAD50
JUMPE SYM,CPOPJ ;EXIT IF NULL
TLO EXF,INFBIT ;OK, SET INFO BIT
JRST M40SIX ;CONVERT TO SIXBIT
SSWPRO: ;SPECIAL ENTRY POINT FOR SWITCH.INI PROCESSING
SETOM SWPENT ;SIGNAL SOURCE OF CALL
CAIA
SWPRO: ;SWITCH PROCESSOR
SETZM SWPENT ;SIGNAL NORMAL ENTRY
CAIE CHR,"/" ;SWITCH?
RETURN ; NO, EXIT
CALL GETNB ;YES, BYPASS SLASH
CALL CSISYM ;GET THE SYMBOL
MOVSI T3,-<SWPRTE-SWPRT> ;SET FOR TABLE SCAN
AOBJN T3,.+1
CAME SYM,SWPRT-1(T3) ;COMPARE
AOBJN T3,.-2 ; NO
JUMPG T3,SWPRO1 ;MISSED, ERROR
SETZM ARGCNT ;CLEAR ARGUMENT COUNT
XCT SWPRT(T3)
TRZN FLG,-1 ;SKIP IF ERRORS ENCOUNTERED
JRST SWPRO ;TRY FOR MORE
SWPRO1:
SKIPN SWPENT ;SWITCH.INI?
FERROR [ASCIZ /BAD SWITCH/] ;NO. ABORT NORMALLY
JRST SWIERR
SETM68: SKIPA T1,[M68] ;6800 MACHINE TYPE
SETM65: MOVEI T1,M65 ;6502 MACHINE TYPE
JRST SETMCH ;STORE TYPE CODE
SETM88: SKIPA T1,[M88] ;8008 COMPATIBLE MNEMONICS
SETM08: MOVEI T1,M08 ;8008 INTEL MNEMONICS
JRST SETMCH
SETM18: SKIPA T1,[M18] ;1802 MACHINE TYPE
SETM80: MOVEI T1,M80 ;8080/Z80 MACHINE TYPE
JRST SETMCH
SETMF8: MOVEI T1,MF8 ;F8 MACHINE TYPE
JRST SETMCH
DEFINE GENSWT (MNE,ACTION) ;GENERATE SWITCH TABLE
<
SIXBIT /MNE/
ACTION
>
SWPRT: ;SWITCH PROCESSOR TABLE
GENSWT LI,<CALL .LIST>
GENSWT NL,<CALL .NLIST>
GENSWT EN,<CALL .ENABL>
GENSWT DS,<CALL .DSABL>
GENSWT CRF,<TLZ EXF,CRFBIT>
GENSWT N,<TLO EXF,NSWBIT>
GENSWT I,<TLO FLG,ISWFLG>
GENSWT P,<TLZ FLG,ISWFLG>
GENSWT GNS,<CALL SWPGNS>
GENSWT SOL,<TLO EXF,SOLBIT>
GENSWT CDR,<TLO EXF,CDRBIT>
GENSWT EQ,<CALL PROEQ>
GENSWT NSQ,<CALL PRONSQ>
GENSWT M80,<CALL SETM80>
GENSWT M65,<CALL SETM65>
GENSWT M68,<CALL SETM68>
GENSWT M88,<CALL SETM88>
GENSWT M08,<CALL SETM08>
GENSWT M18,<CALL SETM18>
GENSWT MF8,<CALL SETMF8>
GENSWT PTP,<TLO FLG,PSWFLG>
GENSWT OCT,<TLO EXF,OCTBIT>
SWPRTE:
SWPGNS: TLO EXF,FMTBIT ;SET FLAG
MOVEI T3,LC.SEQ!LC.LOC!LC.BIN!LC.BEX!LC.ME!LC.TOC
TLO ASM,0(T3) ;SUPPRESS SELECTED FLAGS
IORM T3,LCMSK ;ALSO RESTRICT SOURCE OVER-RIDES
RETURN
PROEQ: CALL GSARG
RETURN
CALL SSRCH
JFCL
TLON T1,DEFSYM
TRZ T1,177777
CALL INSRT
JRST PROEQ
PRONSQ: SETZM P10SEQ
SETOM P10SEQ+1
RETURN
.LOC
SWPENT: BLOCK 1 ;NON-ZERO IN SWPRO IF ENTERED FROM
;SWITCH.INI PROCESSING
.RELOC
SUBTTL HEADER ROUTINE
HEADER: CALL ACEXCH ;YES, SAVE THE ACCUMULATORS
SPUSH EXF ;SAVE CURRENT FLAGS
TLO EXF,NSWBIT ;DON'T OUTPUT TO TTY
MOVEI T2,FF ;GET A FORM FEED
CALL LSTDMP ;OUTPUT IT
MOVEI T3,PAGSIZ+3 ;RESET LINE COUNTER REGISTER
MOVEM T3,LPPCNT
MOVN Q3,COLCNT ;GET COLUMNS PER LINE
SUBI Q3,8*5+3 ;LEAVE ROOM FOR DATE, ETC.
MOVE T1,[POINT 7,TTLBUF]
TDZA VAL,VAL ;ZERO COUNT
HEADE3: CALL LSTOUT
ILDB T2,T1 ;FETCH CHAR FROM BUFFER
CAIN T2,TAB ;TAB?
IORI VAL,7 ; YES, FUDGE
ADDI VAL,1
CAMGE VAL,Q3
JUMPN T2,HEADE3
CALL LSTTAB
LSTSTR TITLE
CALL LST2SP
;THE FOLLOWING SECTION PRINTS THE DATE, WHICH IS FOUND IN
;REGISTER XDATE IN THE FORM
; ((Y-1964)*12 + (M-1))*31 + (D-1)
MOVE VAL,DATE ;GET THE DATE IN VAL
IDIVI VAL,^D31 ;DIVIDE BY 31 DECIMIAL
ADDI Q3,1
DNC Q3 ;OUTPUT DAY
IDIVI VAL,^D12 ;DIVIDE BY 12 DECIMAL
LSTSIX MONTH(Q3)
MOVEI Q3,^D64(VAL) ;GET THE YEAR
DNC Q3
CALL LST2SP ;OUTPUT TAB
MOVE T3,MSTIME ;GET THE CURRENT TIME
IDIVI T3,^D60*^D1000 ;NUMBER OF MIN. SINCE MIDNITE
IDIVI T3,^D60 ;NUMBER OF HOURS
SPUSH T4 ;SAVE MINUTES
CAIG T3,9
LSTICH "0"
DNC T3 ;OUTPUT THE HOURS
LSTICH ":" ;OUTPUT A COLON AFTER THE HOURS
SPOP Q3 ;PUT MINUTES IN OUTPUT AC
CAIG Q3,^D9 ;IS IT A ONE-DIGIT NUMBER?
LSTICH "0" ;YES, OUTPUT A ZERO
DNC Q3 ;OUTPUT THE MINUTES
TLNE FLG,P1F
JRST HEADE1
MOVE Q3,PAGNUM ;GET PAGE NUMBER
LSTMSG [ASCIZ / PAGE 5/]
AOSE Q3,PAGEXT ;INCREMENT, PICK UP, AND TEST
LSTMSG [ASCIZ /-5/]
HEADE1: CALL LSTCR
TLNN EXF,SOLBIT ;SEQUENCE OUTPUT?
JRST HEADE2
AOS PAGNUM ; YES, BUMP COUNT
SETOM PAGEXT
HEADE2: LSTSIX SRCSAV
HLLZ SYM,SRCSAV+1
JUMPE SYM,.+3
LSTICH "."
LSTSIX SYM
CALL LSTTAB
LSTSTR STLBUF ;LIST SUB-TITLE
CALL LSTCR
CALL LSTCR
SPOP T2 ;RESTORE FLAGS
TLNN T2,NSWBIT
TLZ EXF,NSWBIT
JRST ACEXCH ;RESTORE F4 REGS AND EXIT
MONTH:
SIXBIT /-JAN-/
SIXBIT /-FEB-/
SIXBIT /-MAR-/
SIXBIT /-APR-/
SIXBIT /-MAY-/
SIXBIT /-JUN-/
SIXBIT /-JUL-/
SIXBIT /-AUG-/
SIXBIT /-SEP-/
SIXBIT /-OCT-/
SIXBIT /-NOV-/
SIXBIT /-DEC-/
.LOC
PAGNUM: BLOCK 1 ;PAGE NUMBER
PAGEXT: BLOCK 1 ;PAGE EXTENSION
.RELOC
SUBTTL AC EXCHANGE LOOP
ACEXCH: ;SWAP AC'S
TLC EXF,MODBIT ;TOGGLE MODE BIT
EXCH SYM,AC00
EXCH T1,AC01
EXCH T2,AC02
EXCH T3,AC03
EXCH T4,AC04
EXCH PC,AC05
EXCH Q1,AC06
EXCH Q2,AC07
EXCH VAL,AC10
EXCH Q3,AC11
; EXCH ASM,AC12
EXCH LBP,AC13
EXCH CHR,AC14
RETURN
.LOC
AC00: BLOCK 1
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
.RELOC
SUBTTL BINARY OUTPUT ROUTINE
BINOUT: ;BINARY OUTPUT
SPUSH T2
ANDI T2,377 ;MASK TO 8 BITS
ADDM T2,CHKSUM ;UPDATE CHECKSUM
BINOU2: TLNE EXF,BINBIT ;BINARY REQUESTED?
JRST BINOU6 ; NO, EXIT
TLNN FLG,ISWFLG ;PACKED MODE?
JRST BINOU3 ; YES
CALL BCHOUT ;OUTPUT CHAR TO FILE
JRST BINOU6
BINOU3: SOSLE BINPCT
JRST BINOU4
CALL BINDMP
MOVE T3,BINCNT
IMULI T3,4
MOVEM T3,BINPCT
BINOU4: MOVN T3,BINPCT
ANDI T3,3
JUMPN T3,BINOU5
SOS BINCNT
IBP BINPNT
BINOU5: DPB T2,BINTBL(T3)
BINOU6: SPOP T2
RETURN
BINDMP: OUTPUT BIN,
BINTST: STATO BIN,IODATA!IODEV!IOWRLK!IOBKTL
RETURN
FERROR [ASCIZ /BINARY OUTPUT ERROR/]
BINTBL:
POINT 8,@BINPNT,17
POINT 8,@BINPNT, 9
POINT 8,@BINPNT,35
POINT 8,@BINPNT,27
;BASIC OUTPUT A CHARACTER ROUTINE
BCHOUT: SOSG BINCNT
CALL BINDMP
IDPB T2,BINPNT
RETURN
BHXOUT: SPUSH T1 ;SAVE REGS
SPUSH T2 ;SAVE REGS
ANDI T2,377 ;MASK TO 8 BITS
ADDM T2,CHKSUM ;...
MOVSI T1,(POINT 4,0(P),35-8)
BHXOU1: ILDB T2,T1 ;GET CHAR
CAILE T2,^D9 ;DIGIT
ADDI T2,"A"-"9"-1 ;NOPE, HEXIT
ADDI T2,"0" ;MAKE ASCII
CALL BCHOUT ;DUMP IT
TLNE T1,770000 ;DONE
JRST BHXOU1 ;NO - GET MORE
SPOP T2
SPOP T1 ;RESTORE
RETURN ;AND RETURN
SUBTTL LISTING OUTPUT
LSTST0: TDZA T3,T3 ; "LSTSTR" UUO
LSTMS0: SETOM T3 ; "LSTMSG" UUO
HLLM T3,0(P) ;SAVE FLAG
MOVEI VAL,@.JBUUO ;FETCH ARG
TLOA VAL,(POINT 7,,) ;SET BYTE POINTER AND SKIP
LSTMS1: CALL LSTOUT ;TYPE CHARACTER
LSTMS2: ILDB T2,VAL ;GET CHARACTER
JUMPE T2,CPOPJ ;TEST FOR END
CAIL T2,"0" ;TEST FOR SWITCH
CAILE T2,"5"
JRST LSTMS1 ;NO, TYPE THE CHARACTER
SKIPL 0(P) ;STRING?
JRST LSTMS1 ; YES, PRINT NUMERICS
XCT LMT-"0"(T2) ;EXECUTE TABLE
JRST LSTMS2 ;GET NEXT CHARACTER
LMT:
CALL LSTCR ; 0 - CR/LF
LSTICH 0(CHR) ; 1 - CHARACTER
CALL LM2 ; 2 - DEV:
CALL LM3 ; 3 - DEV:FILNAM.EXT
HALT .
DNC Q3 ; 5 - DECIMAL NUMBER
LM2: LSTSIX DEVNAM
LSTICH ":"
RETURN
LM3: CALL LM2
LSTSIX FILNAM
LSTICH "."
HLLZ SYM,FILEXT
LSTSIX SYM
RETURN
DNC0: ; "DNC" UUO
MOVE T3,@.JBUUO ;FETCH ARG
LDB T4,[POINT 4,.JBUUO,12]
DNC1: SPUSH T4
IDIVI T3,^D10
HRLM T4,-1(P)
SPOP T4
SOS T4
SKIPE T3
CALL DNC1
DNC2: HLRZ T2,0(P)
SOJL T4,LSTNUM
LSTICH SPACE
JRST DNC2
LSTSY0: ;"LSTSYM" UUO
SPUSH SYM ;STACK A COUPLE REGISTERS
SPUSH T1
LDB T2,[POINT 4,.JBUUO,12] ;FETCH FLAG
DPB T2,[POINT 1,-2(P),0]
MOVE SYM,@.JBUUO ;FETCH WORD
TRNN T2,2 ;SIXBIT?
CALL M40SIX ; NO, CONVERT TO IT
MOVSI T1,(POINT 6,SYM)
LSTSY1: ILDB T2,T1 ;GET THE NEXT CHAR
SKIPL -2(P) ;IF NO FLAG,
JUMPE T2,LSTSY2 ; BRANCH ON BLANK
ADDI T2,40 ;CONVERT TO ASCII
CALL LSTOUT ;LIST IT
TLNE T1,770000
JRST LSTSY1
LSTSY2: SPOP T1
SPOP SYM
RETURN
LSTIC0: ; "LSTICH" UUO
MOVEI T2,@.JBUUO
JRST LSTOUT
LSTFLD: ;LIST FIELD
MOVEI T2,5 ;5-COL FIELDS
MOVEM T2,FLDCNT ;SET COUNT
JUMPE VAL,LSTFL1 ;EXIT IF NULL
CALL LSTWB ;LIST WORD/BYTE
MOVEI T2,"'"
TLNE VAL,GLBSYM
MOVEI T2,"G"
TDNE VAL,[PFMASK] ;RELOCATABLE?
CALL LSTOUT
LSTFL1: SKIPN VAL,FLDCNT ;GET COUNT
RETURN ;ZERO - RETURN
CALL LSTSP ;SPACE OVER
SOJG VAL,.-1
RETURN ;RETURN WHEN DONE
LSTWB: ;LIST WORD OR BYTE
LDB T3,[POINT 2,VAL,17]
CAIN T3,1
JRST LSTBY1 ;BYTE
LSTWRD: TLNE EXF,OCTBIT ;WORD - OCTAL FORMAT?
SKIPA T3,[POINT 3,VAL,35-18] ;OCTAL
MOVE T3,[POINT 4,VAL,35-16] ;HEX
JRST LSTWD1
LSTBYT: CALL LSTSP ;LIST BYTE (SPACES FIRST)
LSTBY1: TRZ VAL,177400 ;CLEAR BITS
TLNN EXF,OCTBIT ;OCTAL FORMAT?
JRST LSTBY2 ;HEX
CALL LSTSP
MOVE T3,[POINT 3,VAL,35-9]
JRST LSTWD1 ;OCTAL FORMAT
LSTBY2: CALL LST2SP
MOVE T3,[POINT 4,VAL,35-8]
LSTWD1: ILDB T2,T3
SPUSH T3 ;SAVE PNTR
CAILE T2,^D9 ;DIGIT?
ADDI T2,"A"-"9"-1 ;ADD IN HEX OFFSET
ADDI T2,"0" ;MAKE INTO ASCII
CALL LSTOUT
SPOP T3
TLNE T3,770000
JRST LSTWD1 ;GET NEXT CHAR
RETURN
LST3SP: ;LIST SPACES
CALL LSTSP
LST2SP: CALL LSTSP
LSTSP: MOVEI T2,SPACE
JRST LSTOUT
LSTNUM: TROA T2,"0" ;LIST NUMERIC
LSTASC: ADDI T2,40 ;CONVERT SIXBIT TO ASCII
JRST LSTOUT
LSTCR: TDZA T2,T2 ;LIST CR-LF
LSTTAB: MOVEI T2,TAB ;LIST A TAB
LSTOUT: ;LISTING ROUTINE
SOS FLDCNT ;DECR COUNTER
TLNN EXF,LSTBIT!LPTBIT ;LISTING REQUESTED?
CALL LPTOUT ; YES
TLNE EXF,ERRBIT ;ERROR LISTING?
TLNE EXF,NSWBIT!TTYBIT ; YES, TO TTY?
RETURN ; NO
JUMPE T2,LSTOU1 ;BRANCH IF CR-LF
OUTCHR T2 ;LIST CHARACTER
RETURN ;EXIT
LSTOU1: OUTSTR [BYTE (7) CRR, LF, 0]
RETURN ;CR-LF TO TTY
.LOC
FLDCNT: BLOCK 1 ;COUNTER FOR LSTFLD
.RELOC
LPTOUT: ;OUTPUT TO LISTING DEVICE
TLNN EXF,FMTBIT ;FMT MODE?
JRST LPTOU1 ;NO, NORMAL
TLNN FLG,FMTFLG ;YES, IN OVER-RIDE?
RETURN ; NO
JUMPN T2,LSTDMP ;YES
JRST LPTOU5
LPTOU1: TLZE EXF,HDRBIT ;TIME FOR A HEADING?
CALL HEADER ; YES
JUMPE T2,LPTOU5 ;BRANCH IF CR-LF
CAIN T2,TAB
JRST LPTOU4 ;DON'T LIST TABS IMMEDIATELY
AOSLE COLCNT ;OFF LINE?
JRST LPTOU2
SKIPE TABCNT ;ANY IMBEDDED TABS?
CALL PROTAB ; YES, PROCESS THEM
JRST LSTDMP ;LIST THE CHARACTER
LPTOU2: SKIPN WRPSAV
MOVEM LBP,WRPSAV
RETURN
LPTOU4: AOS TABCNT ;TAB, BUMP COUNT
SPUSH T2
MOVEI T2,7
IORM T2,COLCNT
AOS COLCNT
SPOP T2
RETURN
LPTOU5: MOVEI T2,CRR ;CR-LF
CALL LSTDMP
MOVEI T2,LF
LPTOU6: CALL LSTDMP
SOSG LPPCNT ;END OF PAGE?
LPTINI: TLO EXF,HDRBIT ; YES, SET FLAG
LPTINF: MOVNI T2,COLTTY ;SET FOR COLUMN COUNT
SKPLCR LC.TTM
MOVNI T2,COLLPT
MOVEM T2,COLCNT
SETZB T2,TABCNT ;ZERO TAB COUNT AND REGISTER
SETZM WRPSAV
RETURN
PROTAB: ;PROCESS IMBEDDED TABS
SKIPG TABCNT ;ANY LEFT?
RETURN ; NO
SOS TABCNT ;YES, DECREMENT COUNT
SPUSH T2
MOVEI T2,TAB
CALL LSTDMP ;LIST ONE
SPOP T2
JRST PROTAB ;TEST FOR MORE
LSTDMP: SOSG LSTCNT ;DECREMENT ITEM COUNT
CALL LSTDM1 ;EMPTY ENTIRE BUFFER
IDPB T2,LSTPNT ;STORE THE CHARACTER
CAIN T2,LF ;IF LINE FEED,
TLNN EXF,TTYBIT ; AND LISTING IS ON TTY, DUMP BUFFER
RETURN
;DUMP THE BUFFER
LSTDM1: OUTPUT LST, ;EMPTY A BUFFER
LSTTST: STATO LST,IODATA!IODEV!IOWRLK!IOBKTL ;CHECK FOR ERRORS
RETURN ;NO, EXIT
FERROR [ASCIZ /LISTING OUTPUT ERROR/]
.LOC
COLCNT: BLOCK 1 ;COLUMN COUNT
TABCNT: BLOCK 1 ;TAB COUNT
LPPCNT: BLOCK 1 ;LINES/PAGE COUNT
WRPSAV: BLOCK 1
WRPCNT: BLOCK 2
.RELOC
SUBTTL SOURCE INPUT
CHAR: CALL CHARLC
CAIN T2,QJLC
SUBI CHR,40
RETURN
CHARLC:
CHAR0: SKIPE MCACNT
JRST CHAR10
SKIPE MSBMRP
JRST CHAR2 ;BRANCH IF IN MACRO
SOSGE SRCCNT ;DECREMENT ITEM COUNT
JRST CHAR4 ;GET ANOTHER BUFFER IF NECESSARY
IBP SRCPNT ;INCREMENT THE BYTE POINTER
MOVE CHR,@SRCPNT ;PICK UP AN ENTIRE WORD FROM BUFFER
TRZE CHR,1 ;IS THE SEQUENCE NUMBER BIT ON?
JRST CHAR8 ;YES, SKIP AROUND IT
LDB CHR,SRCPNT ;NO, PICK UP A GOOD CHARACTER
CHAR1: LDB T2,C7PNTR ;MAP
XCT CHARTB(T2) ;DECIDE WHAT TO DO
RETURN ;ACCEPT IT
CHAR2: CALL READMC ;GET A CHARACTER FROM MACRO TREE
JRST CHAR0 ; NULL, TRY AGAIN
JRST CHAR1 ;TEST IT
CHAR4: INPUT SRC, ;CALL MONITIOR FOR A BUFFER
STATZ SRC, IODATA+IODEV+IOBKTL+IOWRLK
CHAR4A: FERROR [ASCIZ /INPUT DATA ERROR/]
STATO SRC, IOEOF ;WAS AN END OF FILE REACHED?
JRST CHAR0 ;GET NEXT CHAR
CHAR5: CLOSE SRC,
SKIPE AC14 ;CRR SEEN BY COMMAND SCANNER?
TLNN EXF,MODBIT
JRST CHAR6
CALL ACEXCH ;GET EXEC AC'S
CALL GETSRC ;GET THE NEXT SOURCE FILE
CALL ACEXCH ;SAVE EXEC AC'S AND RETURN
JRST CHAR0
CHAR6: TLO FLG,ENDFLG ;YES, FLAG END
MOVEI CHR,LF ;MAKE IT A LINE
JRST CHAR1
CHAR8: SKIPL P10SEQ+1
MOVEM CHR,P10SEQ
MOVSI CHR,(<TAB>B6)
IORM CHR,P10SEQ+1
AOS SRCPNT ;INCREMENT POINTER PAST WORD
MOVNI CHR,5 ;GET -5
ADDM CHR,SRCCNT ;SUBTRACT 5 FROM WORD COUNT
JRST CHAR0
CHAR10: SOSGE MACBUF+2 ;MORE CHARS TO GET W/OUT INPUT?
JRST CHAR11 ;NO
IBP MACPNT ;INCREMENT MACRO POINTER
MOVE CHR,@MACPNT ;GET A WHOLE WORD FROM SOURCE BUFFER
TRZE CHR,1 ;SEQUENCE NUMBER?
JRST CHAR12 ;YES.
LDB CHR,MACPNT
JRST CHAR1
CHAR11: INPUT MAC,
STATZ MAC,740000
JRST CHAR4A
STATO MAC,IOEOF
JRST CHAR
JRST CHAR6
CHAR12: SKIPL P10SEQ+1 ;SOMETHING THERE ALREADY?
MOVEM CHR,P10SEQ ;NO
MOVSI CHR,(<TAB>B6)
IORM CHR,P10SEQ+1
AOS MACPNT ;BOOST POINTER AROUND SEQ NR & TAB
MOVNI CHR,5 ;SET UP -5
ADDM CHR,MACBUF+2 ;DECREMENT THE WORD COUNT
JRST CHAR10 ;GO BACK AND TRY AGAIN
CHARTB: ;CHARACTER JUMP TABLE
PHASE 0
MOVEI CHR,RUBOUT ;ILLEGAL CHARACTER
QJNU:! JRST CHAR0 ;NULL, TRY AGAIN
QJCR:! JFCL ;END OF STATEMENT
QJVT:! MOVEI CHR,LF ;VERTICAL TAB
QJTB:! JFCL ;TAB
QJSP:! JFCL ;SPACE
QJPC:! JFCL ;PRINTING CHARACTER
QJLC:! JFCL
DEPHASE
SUBTTL BASIC ASSEMBLY LOOP
ASSEMB: ;ASSEMBLER PROPER
TLO FLG,P1F ;SET FOR PASS 1
MOVE T3,.MAIN.
MOVEM T3,PRGTTL ;INIT TITLE
MOVE T3,.ABS.
MOVEM T3,SECNAM ;INIT ABSOLUTE SECTOR
MOVE T3,[XWD [ASCIZ /.MAIN./],TTLBUF]
BLT T3,TTLBUF+2
MOVE T3,[XWD [ASCIZ /TABLE OF CONTENTS/],STLBUF]
BLT T3,STLBUF+4 ;PRESET SUBTTL BUFFER
CALL INIPAS ;INITIALIZE PASS ONE
CALL BLKINI ;INITIALIZE BINARY OUTPUT
TLNE EXF,GBLDIS ;HAVE DFLT GLOBALS BEEN DISABLED?
TLOA EXF,GBLCCL ;YES. SAVE SETTING
TLZ EXF,GBLCCL ;RESET CCL-LEVEL DLFT GLOBAL SW
CALL LINE ;GO DO PASS ONE.
TLZ FLG,P1F ;RESET TO PASS 2
TLNE EXF,GBLCCL ;SHLD GBLDIS REMAIN SET?
TLOA EXF,GBLDIS ;YES
TLZ EXF,GBLDIS ;...
CALL SETCRF ;SET CREF OUTPUT FILE
SKIPN CCLTOP
JRST ASSEM1
TLO EXF,LPTBIT!ERRBIT ;LIST TO TTY
LSTSYM PRGTTL
CALL LSTCR
TLZ EXF,LPTBIT!ERRBIT
ASSEM1:
CALL INIPAS
SETZM STLBUF
CALL LINE ;CALL THE ASSEMBLER (PASS TWO)
RETURN
LINE: ;PROCESS ONE LINE
CALL GETLIN ;GET A SOURCE LINE
CALL STMNT ;PROCESS ONE STATEMENT
CALL ENDL ;PROCESS END OF LINE
TLZN FLG,ENDFLG ;TEST FOR END STATEMENT
JRST LINE ;GET THE NEXT LINE
JRST ENDP ;END OF PASS
INIPAS:
CALL SETSRC ;RESET INPUT COMMAND STRING
SKPEDR ED.ABS ;ABSOLUTE?
TDZA PC,PC ; YES, SET PC TO ZERO
MOVSI PC,(1B<SUBOFF>) ; NO, SET TO RELOCATABLE
HRRZ T3,MACHT ;GET MACHINE TYPE
CALL @MCHINI(T3) ;M-DEPENDANT INIT
MOVSI T3,-^D256
SETZM SECBAS(T3) ;INIT SECTOR BASES
AOBJN T3,.-1
SETZM MSBMRP
SETZM MSBLVL ;RESET MACRO INFO
SETZM LSBNUM
CALL LSBINC ;INIT LOCAL SYMBOLS
MOVEI T3,^D10 ;DEFAULT BASE 10
MOVEM T3,CRADIX
MOVEI SYM,1
MOVEM SYM,PAGNUM ;INITIALIZE PAGE NUMBER
MOVEM SYM,ERPNUM ; AND ERROR PAGE NUMBER
SETOM ERPBAK ;BE SURE TO PRINT FIRST TIME
SETOM PAGEXT ; AND EXTENSION
TLO EXF,HDRBIT
SETZM CNDMSK ;CLEAR CONDITIONAL MASK
SETZM CNDWRD ; AND TEST WORD
SETZM CNDLVL
SETZM CNDMEX
MOVEM ASM,TIMBLK ;PRESERVE R12
SETZM REPSW ;CLEAR REPEAT SWITCH
SETZM REPBLK ;;AND FIRST WORD OF BLOCK
MOVEI ASM,REPBLK-1 ;INITIALIZE 'STACK' POINTER
MOVEM ASM,REPCT ;.....
MOVE ASM,[REPBLK,,REPBLK+1];PREPARE FOR AND....
BLT ASM,REPBLK+^D127 ;...EXECUTE THE BLT TO CLEAR THE STACK
SETZ ASM, ;CLEAR THE REGISTER
EXCH ASM,TIMBLK ;AND THEN TIMBLK W/ REG RESTORE
SETZM TIMBLK+1
SETZM PHAOFF
SETZM WRPCNT
SETZM WRPCNT+1
JRST ENDLI ;EXIT THROUGH END OF LINE ROUTINE
.MAIN.: GENM40 <.MAIN.>
.ABS.: GENM40 <. ABS.>
MCHINI: CPOPJ ;*** 6502 ***
CPOPJ ;*** 6800 ***
M80INI ;*** 8080 ***
M88INI ;*** 8008 ***
M08INI ;
M18INI ;*** 1802 ***
CPOPJ ;*** F8 ***
CHKTAB (MCHINI)
M88INI:
M08INI:
M18INI:
M80INI: TLNN EXF,REGBIT ;ENABLED AT COMMAND LEVEL?
CALL .ENABA ;NO - SET DEFALUT REGS
RETURN
SUBTTL STATEMENT EVALUATOR
STMNT: ;STATEMENT PROCESSOR
SETZM ARGCNT
SKIPN CNDWRD ;UNSATISIFIED CONDITIONAL?
SKIPE CNDMEX ;OR PERHAPS AN .MEXIT?
JRST STMNT5 ;YES...
STMNTF: SETZM ARGCNT ;CLEAR ARGUMENT COUNT
CALL GETSYM ;TRY FOR SYMBOL
JUMPE SYM,STMNT3 ;BRANCH IF NULL
CAIN CHR,":" ;LABEL?
JRST LABEL ; YES
CAIN CHR,"=" ;ASSIGNMENT?
JRST ASGMT ; YES
CALL OSRCH ;NO, TRY MACROS OR OPS
JRST STMNT2 ;TREAT AS EXPRESSION
STMNT1: CALL CRFOPR ;CREF OPERATOR REFERENCE
LDB T2,TYPPNT ;RESTORE TYPE
XCT STMNJT(T2) ;EXECUTE TABLE
STMNJT: ;STATEMENT JUMP TABLE
PHASE 0
JRST STMNT2 ;BASIC SYMBOL
MAOP:! JRST MACROC ;MACRO
Z8OP:! JRST PROPCZ ;Z80 OP CODE
OCOP:! JRST PROPC ;OP CODE
DIOP:! JRST 0(T1) ;PSEUDO-OP
DEPHASE
STMNT2: MOVE LBP,SYMBEG ;NON-OP SYMBOL, RESET CHAR POINTER
CALL SETNB ;SET CURRENT CHAR
CAIE CHR,";" ;IF SEMI-COLON
CAIN CHR,0 ; OR LINE TERMINATOR,
RETURN ; NULL LINE
JRST .BYTE ;NEITHER, TREAT AS ".BYTE"
STMNT3: CALL GETLSB ;IT'S A LOCAL SYMBOL, RIGHT?
JUMPE SYM,STMNT2 ;WRONG.
CAIE CHR,":" ;THEN IT'S A LABEL, RIGHT?
JRST STMNT2 ;SORRY, WRONG AGAIN. IT'S AN EXPRESSION
CAMLE PC,LSBMAX ;WITHIN RANGE?
ERRSET ERR.A ; NO, ERROR
JRST LABELF
STMNT4: CALL GETNB
CAIN CHR,":" ;ANOTHER COLON?
CALL GETNB ;YES...BYPASS IT.
STMNT5: ;TRAP FOR .MEXIT OR UNSATISIFED CONDITIONALS
CALL GETSYM
CAIN CHR,":"
JRST STMNT4
CAIN CHR,"="
JRST STMNT6
CALL TSTMLI ;CONDITIONED OUT
CAIE T3,DCCND ;TEST FOR CONDITIONAL OP CODE
CAIN T3,DCCNDE
JRST STMNT1 ; YES, PROCESS IT
STMNT6: SETLCT LC.CND ;NO, SET LISTING FLAG
TLO FLG,NQEFLG
RETURN
LABEL: ;LABEL PROCESSOR
CALL LSBTST ;TEST FOR NEW LOCAL SYM RANGE
LABELF: MOVSI T4,0 ;ASSUME NO GLOBAL DEFINITION
CALL GETNB ;BYPASS COLON
CAIE CHR,":" ;ANOTHER COLON?
JRST .+3 ;NO
MOVSI T4,GLBSYM ;GET GLOBAL FLAG
CALL GETNB ;BYPASS SECOND COLON
SPUSH T4 ;STACK GLOBAL FLAG
CALL SSRCH ;SEARCH SYMBOL TABLE
JRST LABEL0 ;NOT THERE.
TLNE T1,REGSYM ;REGISTER?
JRST LABEL2 ;YES, ERROR
LABEL0: TLNE T1,DEFSYM ;SYMBOL DEFINED?
JRST LABEL1 ;YES
TLNE T1,FLTSYM ;DEFAULTED GLOBAL SYMBOL?
TLZ T1,FLTSYM!GLBSYM ;YES-CLEAR FLAGS.
TDO T1,0(P) ;INSERT GLOBAL BIT
TDO T1,PC ;SET CURRENT PC VALUE
LABEL1: MOVE T3,T1 ;COPY VALUE REGISTER
TDC T3,PC ;COMPARE WITH PC
TDNN T3,[PCMASK] ;EQUAL ON MEANINGFUL BITS
JRST LABEL3 ; YES
LABEL2: TLNN FLG,P1F ;NO, PASS 1?
TLNE T1,MDFSYM ;NO, MULTIPLY DEFINED ALREADY?
TLOA T1,MDFSYM ; YES, FLAG SYMBOL
ERRSET ERR.P ;NO, PHASE ERROR
CAIA
LABEL3: TLO T1,LBLSYM!DEFSYM ;OK, FLAG AS LABEL
CAMN SYM,M40DOT ;PERCHANCE PC?
ERRSKP ERR.M ; YES, FLAG ERROR AND SKIP
CALL INSRT ;INSERT/UPDATE
TLNE T1,MDFSYM ;MULTIPLY DEFINED?
ERRSET ERR.M ; YES
SPOP T4 ;CLEAN STACK
CALL SETNB ;
MOVEM LBP,CLILBL
CALL CRFDEF
CALL SETPF0
JRST STMNTF ;RETURN TO STATEMENT EVALUATOR
ASGMT: ;ASSIGNMENT PROCESSOR
MOVSI T4,0 ;ASSUME NO GLOBAL DEFINITION
CALL GETNB ;GET NEXT NON-BLANK
CAIE CHR,"=" ;ANOTHER EQUALS?
JRST .+3 ;NO
MOVSI T4,GLBSYM ;SET GLOBAL SYMBOL FLAG
CALL GETNB ;GET NEXT NON-BLANK
SPUSH T4 ;STACK FLAG
SPUSH SYM ;STACK SYMBOL
CALL RELEXP
CALL SETPF1
JRST ASGMT0
ASGMTF: CALL SETPF1
ASGMTX: MOVSI T4,0 ;SET ZERO FLAG
EXCH T4,0(P) ;EXCHANGE WITH SYMBOL
SPUSH T4 ;STACK SYMBOL AGAIN
ASGMT0: SPOP SYM ;RETRIEVE SYMBOL
CALL SSRCH ;SEARCH TABLE
JFCL ;NOT THERE YET
CALL CRFDEF
TLNE T1,LBLSYM ;LABEL?
JRST ASGMT1 ; YES, ERROR
TLNE T1,FLTSYM ;DEFAULTED GLOBAL SYMBOL?
TLZ T1,FLTSYM!GLBSYM ;YES-CLEAR DEFAULT FLAGS
AND T1,[XWD GLBSYM!MDFSYM,0] ;MASK
TRNN FLG,ERR.U!ERR.A ;ANY UNDEFINED SYMBOLS OR ADDRSNG ERRS?
TLO T1,DEFSYM ; NO, FLAG AS DEFINED
TDOA T1,VAL ;MERGE NEW VALUE
ASGMT1: TLO T1,MDFSYM ; ERROR, FLAG AS MULTIPLY DEFINED
TLNE T1,MDFSYM ;EVER MULTIPLY DEFINED?
ERRSET ERR.M ; YES
CAME SYM,M40DOT ;LOCATION COUNTER?
TDO T1,0(P) ;NO - MERGE GLOBAL DEFINITION BIT
SPOP T4 ;CLEAN STACK
CAME SYM,M40DOT ;SKIP IF LOCATION COUNTER
JRST INSRT ;INSERT AND EXIT
CALL TSTMAX ;TEST FOR NEW HIGH
LDB T2,SUBPNT
LDB T3,CCSPNT
CAME T2,T3 ;CURRENT SECTOR?
ASGMT2: ERRXIT ERR.A!ERR.P1 ; ERROR, DON'T STORE
CALL INSRT
JRST SETRLD
SUBTTL END OF LINE PROCESSOR
ENDL: ;END OF LINE PROCESSOR
SKIPE MCACNT
JRST ENDLI
SKIPE ARGPNT
HALT .
SETCHR
CAIA
ENDL01: CALL GETNB ;SET NON-BLANK CHARACTER
CAIE CHR,0 ;IF CR/LF
CAIN CHR,";" ; OR COMMENT,
JRST ENDL02 ; BRANCH
TLNE FLG,NQEFLG ;NO, OK?
JRST ENDL01 ; YES, TRY AGAIN
ERRSET ERR.Q ; NO, FLAG ERROR
ENDL02: SKPLCR LC.COM ;COMMENT SUPPRESSION?
MOVEM LBP,CLIPNT+1 ; YES, MARK IT
MOVE T1,CLIPNT
SKPLCR LC.SRC ;SOURCE SUPPRESSION?
MOVEM T1,CLIPNT+1 ; YES
SETZM CODPNT ;INITIALIZE FOR CODE OUTPUT
CALL PROCOD ;PROCESS CODE
JFCL ; NO CODE, IGNORE THIS TIME
ENDL10: TDZ FLG,ERRSUP
TRNE FLG,-1-ERR.P1
TRZ FLG,ERR.P1
TRZN FLG,ERR.P1 ;PASS 1 ERROR?
TLNN FLG,P1F ; NO, ARE WE IN PASS2?
CAIA ; YES, LIST THIS LINE
TRZ FLG,-1 ;PASS 1, CLEAR ANY ERROR FLAGS
TRNE FLG,-1 ;ANY ERRORS?
TLO EXF,ERRBIT ; YES, SET BIT
TLNE EXF,ERRBIT!P1LBIT ;ERRORS OR PASS1 LISTING?
JRST ENDL11 ; YES
TLNN EXF,LSTBIT
TLNE FLG,FFFLG ;NO, PASS ONE?
JRST ENDL41 ; YES, DON'T LIST
SKIPL LCLVLB ;IF LISTING DIRECTIVE
SKIPGE T2,LCLVL ; OR LISTING SUPPRESSED,
JRST ENDL41 ; BYPASS
SKPLCR @LCTST ; AND SUPPRESSION BITS
JUMPLE T2,ENDL41 ; YES
TLNE FLG,P1F
JRST ENDL42
JRST ENDL20 ;NO, LIST THIS LINE
ENDL11: TRNN FLG,-1 ;ARE WE HERE DUE TO ERRORS?
JRST ENDL20 ; NO
TRNE FLG,-1-ERR.Q ;ERRORS OTHER THAN "Q"?
TRZ FLG,ERR.Q ; YES, DON'T LIST IT
TRNE FLG,QMEMSK ;ANY FATAL TYPES?
AOSA ERRCNT ; YES
AOS ERRCNT+1 ;NO, TALLY SECONDARY
MOVE T3,LINPNT
MOVEM T3,CLIPNT ;LIST ENTIRE LINE
SETZM CLIPNT+1
TLO EXF,LPTBIT
MOVE Q3,ERPNUM
CAME Q3,ERPBAK
LSTMSG [ASCIZ /**PAGE 50/]
MOVEM Q3,ERPBAK
TLZ EXF,LPTBIT
HRLZ SYM,FLG ;PUT FLAGS IN AC0 LEFT
MOVE T1,[POINT 7,ERRMNE,]
ENDL12: ILDB T2,T1 ;FETCH CHARACTER
SKIPGE SYM ;THIS CHARACTER?
CALL LSTOUT ; YES
LSH SYM,1
JUMPN SYM,ENDL12 ;TEST FOR END
ENDL20: SKPLCR LC.SEQ
JRST [CALL LST2SP
JRST ENDL23]
TLO FLG,FMTFLG
MOVE T1,LINNUM
EXCH T1,LINNUB
CAME T1,LINNUB
JRST ENDL21
SKIPLE Q3,MSBLVL
LSTMSG [ASCIZ / (5)/]
JRST ENDL22
ENDL21: HRRZ SYM,COLCNT
IDIVI SYM,8
MOVE T3,LINNUM
IDIVI T3,^D10
ADDI T1,1
JUMPN T3,.-2
CALL LSTSP
CAIGE T1,5
AOJA T1,.-2
DNC LINNUM
ENDL22: CALL LSTTAB
ENDL23: TLO FLG,FMTFLG
TLNE FLG,LHMFLG ;TO BE LEFT-JUSTIFIED?
JRST ENDL30 ; YES
SKPLCR LC.LOC
JRST ENDL24 ;SKIP
MOVE VAL,PF0 ;FIRST FIELD TO BE PRINTED?
CALL LSTFLD ; YES
ENDL24: SKPLCR LC.BIN
JRST ENDL25
MOVE VAL,PF1 ;PRINT PF1
CALL LSTFLD
SKPLCS LC.TTM
JRST ENDL25 ; YES, THROUGH FOR NOW
MOVE VAL,PF2
CALL LSTFLD ; NO, LIST
MOVE VAL,PF3
CALL LSTFLD
MOVE T1,COLCNT
CAIE T1,140 ;NO TAB IF PAST COL 140
ENDL25: CALL LSTTAB ;TAB OVER
; ..
; ..
ENDL30: SKIPE P10SEQ
LSTSTR P10SEQ
TLNN FLG,P1F
SKPEDS ED.TIM ;TIMING REQUESTED?
JRST ENDL35 ; NO
SKIPN T1,TIMBLK+1 ;YES, ANY INCREMENT?
JRST ENDL34 ; NO, JUST A TAB
ADDM T1,TIMBLK ;YES, UPDATE MASTER
IDIVI T1,^D10
SPUSH T2
DNC 4,T1
LSTICH "."
SPOP T2
LSTICH "0"(T2)
SETZM TIMBLK+1 ;CLEAR INCREMENT
ENDL34: CALL LSTTAB
ENDL35: SKIPN MSBLVL ;IN MACRO?
JRST ENDL37 ;NO - CONTINUE
MOVEI T3,LC.MB ;YES - WANT BINARY ONLY?
TDNE T3,LCTST ;???
JRST ENDL40 ;YES - SKIP SOURCE LISTING
ENDL37: SKIPN LBP,CLIPNT ;ANY LINE TO LIST?
JRST ENDL40 ; NO
SKIPE T3,CDRCHR ;CDR CHAR TO STUFF?
DPB T3,CDRPNT ; YES, DO SO
MOVEI T3,0
DPB T3,CLIPNT+1 ;MARK END OF PRINTING LINE
ENDL36: LDB T2,LBP ;SET FIRST CHARACTER
ILDB T1,ILCPNT
SKIPE ILCPNT
TLO T1,(1B0)
DPB T3,ILCPNT
JUMPE T2,ENDL33
ENDL31: CALL LSTOUT ;LIST THIS CHARACTER
ILDB T2,LBP ;GET THE NEXT
ENDL32: JUMPN T2,ENDL31 ;LOOP IF NOT END
ENDL33: JUMPE T1,ENDL40 ;BRANCH IF NO ILLEGAL CHARS STORED
MOVEI T2,"?" ;YES, MARK THE LISTING
CALL LSTOUT
HRRZ T2,T1 ;GET SAVED CHARACTER
MOVEI T1,0 ;RESET ILLEGAL CHARACTER
JRST ENDL32
ENDL40: SKPEDR ED.WRP
SKIPN LBP,WRPSAV
JRST ENDL44
AOS WRPCNT+1
SPUSH COLCNT
CALL LSTCR
SPOP T3
ADD T3,COLCNT
MOVNS T3
IDIVI T3,^D8
MOVEM T3,TABCNT
JRST ENDL36
ENDL44: AOS WRPCNT
CALL LSTCR ;LIST CR/LF
ENDL42: TLNE EXF,SOLBIT ;SEQUENCE OUTPUT?
SKPLCR LC.BEX ; YES, EXTENSION LINE?
CAIA ; YES, IGNORE
AOS LINNUM ;NO, BUMP LINE NUMBER
ENDL41: CALL ENDLIF ;SEMI-INIT LINE
CALL PROCOD ;PROCESS ADDITIONAL CODE, IF ANY
JRST ENDL50
SETLCT LC.BEX
JRST ENDL10 ;MORE CODE, LOOP
ENDL50: SKIPN T3,FFCNT ;FORM FEED ENCOUNTERED?
JRST ENDLI ; NO
SETZM TIMBLK ;RESET TIMING AT END OF LINE
HRRZS T3
TLNN FLG,P1F ;SKIP IF PASS 1
SKIPGE LCLVL
CAIA
TLO EXF,HDRBIT ;SET HEADER BIT
JUMPE T3,ENDLI
TLNN EXF,SOLBIT
ADDM T3,PAGNUM ;YES, BUMP PAGE NUMBER
SETOM PAGEXT
TLNE EXF,FMTBIT
TLNE FLG,P1F
JRST ENDLI
TLO FLG,FMTFLG
LSTICH CRR
LSTICH FF
SOJG T3,.-2
ENDLI: SETZM CODPNT
SETZM LCTST
SETZM GLBPNT
SETZM FFCNT
TLZ FLG,FMTFLG
SETZM LINPNT
SETZM CLIPNT+1
ENDLIF: AND PC,[PCMASK] ;CLEAN UP PC
SETZM PF0 ;CLEAR PRINT WORDS
SETZM PF1
SETZM PF2
SETZM PF3
SETZM CLIPNT
SETZM CLILBL
SETZM LCLVLB
SKIPL T3,P10SEQ+1
MOVEM T3,P10SEQ
SETZM CDRCHR
SETZM ILCPNT
TRZ FLG,-1
TLZ FLG,NQEFLG!FFFLG!DSTFLG!DS2FLG!LHMFLG
TLZ EXF,ERRBIT!P1LBIT
RETURN
.LOC
PF0: BLOCK 1 ;PRINT FIELD STORAGE
PF1: BLOCK 1
PF2: BLOCK 1
PF3: BLOCK 1
PFT0: BLOCK 1 ;TEMPS FOR ABOVE
PFT1: BLOCK 1
LINNUM: BLOCK 1 ;SEQUENCE NUMBER
LINNUB: BLOCK 1
P10SEQ: BLOCK 2
.RELOC
SUBTTL ERROR FLAGGING
ERRSK0: AOSA 0(P) ;FLAG ERROR AND SKIP
ERRXI0: SPOP 0(P) ;FLAG ERROR AND EXIT
ERRSE0: TRO FLG,@.JBUUO ;FLAG ERROR
RETURN
SUBTTL OP CODE HANDLERS
PROPCZ:
LDB T2,SUBPNT ;GET TYPE CODE
TLO T1,-1 ;MARK Z80 OPCODE
SKPEDS ED.Z80 ;ALLOWED?
ERRSET ERR.Z ;NO - FLAG IT
HRRZM T1,MZ8TMP ;SAVE PARAM ADDRS
HRR T1,0(T1) ;SET UP RHS (SAME AS 80)
JRST PROPC1 ;JOIN COMMON CODE
PROPC: ;PROCESS OP CODES
LDB T2,SUBPNT ;GET CLASS
HRLI T1,BC1 ;ONE BYTE ONLY
PROPC1: MOVEM T1,OPCODE ;SAVE TABLE ADDRS
SETZM ADRLOW
SETZM ADRHGH
MOVE T3,MACHT ;GET MACHINE TYPE
XCT MOVTBL(T3) ;GET PROPER DISPATCH ENTRY
TRZ T3,777 ;MASK OFF XTRA BITS
TLO FLG,0(T3) ;SET CREF FLAGS
HLRZS T3 ;GET DISPATCH
CALL 0(T3) ;PERFORM ADDRESS PARSE
MOVE T3,MACHT ;MACHINE TYPE
JRST @STOTBL(T3) ;STORE FOR CODE(S)
MOVTBL: MOVE T3,PRPM65(T2) ;*** 6502 ***
MOVE T3,PRPM68(T2) ;*** 6800 ***
MOVE T3,PRPM80(T2) ;*** 8080 ***
MOVE T3,PRPM88(T2) ;*** 8008 ***
MOVE T3,PRPM08(T2) ;
MOVE T3,PRPM18(T2) ;*** 1802 ***
MOVE T3,PRPMF8(T2) ;*** F8 ***
CHKTAB (MOVTBL)
STOTBL: M65STO
M68STO
M80STO
M88STO
M08STO
M18STO
MF8STO
CHKTAB (STOTBL)
;STORE OP LOW HIGH
M80STO: SKIPL OPCODE ;CHECK SPECIAL
JRST M65STO ;NO - SAME AS 6502
MOVE T1,@MZ8TMP ;GET REMAINDER OF OP
LSH T1,-^D10 ;POSITION HIGH BYTE
ANDI T1,177400 ;MASK BYTE
IOR T1,OPCODE ;FETCH LOW BYTE
HRLI T1,BC2 ;ASSUME 2-BYTES
TRNN T1,177400 ;HAVE HIGH BYTE?
HRLI T1,BC1 ;NO - SINGLE BYTE
MOVEM T1,OPCODE ;STORE OPCODE INFO
;FALL INTO M65STO
M88STO: ;8008 - SAME AS 6502
M08STO:
M65STO: SKIPE T1,OPCODE ;FETCH OPCODE
CALL STCODE ;STASH OPCODE
SKIPE T1,ADRLOW ;LOW ADDRS BITS
CALL STCODE
SKIPE T1,ADRHGH ;HIGH ADDRS BITS
CALL STCODE ;STASH
RETURN
;STORE OP HIGH LOW
MF8STO:
M18STO:
M68STO: SKIPE T1,OPCODE ;FETCH OPCODE
CALL STCODE ;STASH OPCODE
SKIPE T1,ADRHGH ;HIGH ADDRS BITS
CALL STCODE
SKIPE T1,ADRLOW ;LOW ADDRS BITS
CALL STCODE ;STASH
RETURN
;6502 OPCODE CLASS HANDLERS
M65CL5: ;CLASS 1 WITH DEST CREF
MOVEI T2,^D20 ;XTRA 2 CYCLES FOR THESE
ADDM T2,TIMBLK+1
M65CL1: CALL M65AEX ;GET ADDRS EXPRESSION
JRST POPERA ;ADDRESS ERROR
HRRZ T3,T4 ;GET ADDRESS TYPE
TLNE T4,(AM%ACC) ;ARG WAS ACCUMULATOR
JRST [MOVEI T2,^D20 ;TWO CYCLES FOR ACCUM
ADDM T2,TIMBLK+1
JRST M65C4A] ;TREAT AS IMPLIED
CAIN T3,.M65A6 ;INDIRECT INVALID
JRST POPERA
CAIG T3,.M65A3 ;EASY CASES
JRST M65C1A ;HANDLE ABS
CAIN T3,.M65A7 ;IMMEDIATE (#)
JRST [MOVEI T2,^D20 ;TWO CYCLES FOR IMMEDIATE
ADDM T2,TIMBLK+1
JRST M65C1B]
MOVEI T2,^D50 ;ASSUME (IND),Y
CAIN T3,.M63A4 ;IS IT (INC,X)?
ADDI T2,^D10 ;YES
ADDM T2,TIMBLK+1
TLC T4,(AM%IND!AM%ZP) ;THESE MUST BE ON NOW
TLCE T4,(AM%IND!AM%ZP)
JRST POPERA ;ADDRESS ERROR
M65C1D: HRLI T1,BC1 ;SINGLE BYTE
MOVEM T1,ADRLOW ;SAVE IT
HRRZ T1,OPCODE ;GET OPCODE TABLE PNTR
LDB T2,[POINT 9,2(T1),35]
MOVNS T2 ;NEGATE THIS (DIVIDEND)
ADDM T2,TIMBLK+1 ;ADJUST TIME BLOCK
LDB T1,OPPNT(T3) ;FETCH OPCODE
JUMPE T1,POPERA ;DONt HAVE THIS MODE
JRST M651A1 ;COMMON EXIT
M65C1A: MOVEI T2,^D40 ;BASIC ABSOLUTE
ADDM T2,TIMBLK+1
TLNE T4,(AM%IND) ;BETTER BE OFF
JRST POPERA ;SORRY
CALL POPSTA ;STASH ADDRS
TLNE T4,(AM%ZP)
ADDI T3,.M65ZO ;OFFSET ADDRS MODE
HRRZ T1,OPCODE ;OPCODE TABLE
LDB T2,[POINT 9,2(T1),35]
TRZN T2,400 ;XTRA?
MOVNS T2 ;AMOUNT TO ADJUST BASIC TIME
ADDM T2,TIMBLK+1
LDB T2,OPPNT(T3) ;GET OPCODE
JUMPE T2,[SUBI T3,.M65ZO
LDB T1,OPPNT(T3)
JUMPE T1,POPERA ;ERROR IF NONE HERE
JRST M651A1]
MOVE T1,T2 ;COPY OPCODE TO CORRECT PLACE
TLNN T4,(AM%ZP) ;ZERO PAGE?
JRST M651A1 ;NO - STORE
MOVNI T2,^D10 ;YES - GET REFUND
CAIN T3,.M65A1+.M65ZO ;FOR REAL ZERO PAGE ONLY
ADDM T2,TIMBLK+1
SETZM ADRHGH ;AND NO HIGH BYTE THEN
M651A1: MOVEI T2,0 ;ASSUME NONE
TRZE T1,400 ;CHECK XTRA CYCLE
MOVEI T2,^D10 ;YES
ADDM T2,TIMBLK+1 ;ACCOUNT FOR IT
HRRM T1,OPCODE ;STORE OPCODE
RETURN ;AND RETURN
M65C1B: TLNE T4,(AM%ZP) ;ONE BYTE?
TLNE T4,(AM%IND) ; AND NO INDIRECT
JRST POPERA ; ELSE ERROR
JRST M65C1D ;JOIN COMMON CASE
;GENERAL ROUTINES
POPERA: MOVEI T1,00 ;MAKE INTO BREAK
HRRM T1,OPCODE
ERRSET ERR.A
RETURN ;RETURN ERROR
OPCERR: ERRSET ERR.O
MOVEI T1,00 ;STORE ZERO
HRRM T1,OPCODE
RETURN
POPSTA: LDB T2,[POINT 8,T1,35]
HRLI T2,BC1 ;SAVE LOW ORDER ADDRS
MOVEM T2,ADRLOW
LDB T2,[POINT 8,T1,35-8]
HRLI T2,BC1 ;ONE BYTE
MOVEM T2,ADRHGH ;NO, SAVE HIGH ORDER ADDRS
RETURN
M80BYT: CALL BYTEXP ;GET 8-BIT EXPR
TLNE VAL,REGSYM ;NO REGS ALLOWED HERE
ERRSET ERR.A
HRLI T1,BC1 ;SET CODE
MOVEM T1,ADRLOW ;SAVE BYTE
RETURN
RELBYT: CALL RELADR ;PARSE RELATIVE ADDRS
MOVNS VAL ;NEGATE
TRNE VAL,200 ;NEGATIVE ADDRS
TRC VAL,177400 ;CHECK FOR MORE THAN 1 BYTE
TRNE VAL,177400
ERRSET ERR.A ;ADDRESS ERROR
TRNE FLG,ERR.A
MOVEI VAL,377 ;MAKE JMP .
HRLI VAL,BC1 ;ONE BYTE
MOVEM VAL,ADRLOW ;SAVE XFER BYTE
RETURN ; AND EXIT
M65CL2: CALL RELBYT ;PARSE RELATIVE ADDRS TO ADRLOW
MOVEI T2,^D20 ;2 CYCLES FOR RELATIVE
ADDM T2,TIMBLK+1
RETURN ;AND RETURN
;MAKE ADDRS <LOC>-.-2
RELADR: CALL EXPR ;PARSE EXPRESSION
ERRSET ERR.A
SETZB T4,RELLVL ;SET RELOC LEVEL
CALL EXPRPX ;CHECK IT
MOVE T1,PC ;GET PC
ADDI T1,2 ;OFFSET FOR CURRENT LOC
CALL EXPRMI ;SUBTRACT
ERRSET ERR.A
CALL ABSTST ;CHECK ABSOLUTE
RETURN ;DONE
M65CL3: CALL M65AEX ;GET ADDRESS MODE
JRST POPERA ;ADDRESS ERROR
MOVEI T2,^D30 ;ASSUME 3 CYCLES
TLNE T4,(AM%IND) ;INDIRECT?
ADDI T2,^D20 ;YES - THEN 5 CYCLES
ADDM T2,TIMBLK+1
TLZ T4,(AM%ZP) ;CLEAR THIS
CALL POPSTA ;STORE ADDRS
M65C4A: HRRZ T1,OPCODE
LDB T1,OPPNT(T4) ;USE INDIRECT/ABS ENTRY
JUMPE T1,POPERA ;ERROR IF ZERO
HRRM T1,OPCODE ;STORE
RETURN
M65CL4: ;USE COMMON ROUTINE
POPTIM: HRRZ T3,OPCODE ;GET TABLE ENTRY
LDB T2,[POINT 9,T3,26]
ADDM T2,TIMBLK+1 ;UPDATE TIMING INFO
ANDI T3,377 ;ISOLATE OP-CODE
HRRM T3,OPCODE ;STORE
RETURN ;EXIT
;6800 OPCODE CLASS HANDLERS
M68CL4: ;CLASS 1 W/MODIFICATION
M68CL1: CALL M68AEX ;GET ADDRS EXPRESSION
JRST POPERA
HRRZ T3,T4 ;GET ADDRS TYPE
M68C1A: CAIN T3,.M68A2 ;JUST ADDRS?
JRST M68C1C ;YES - CHECK FOR Z.P.
SPUSH T3 ;SAVE MODE INFO
SPUSH T4
CALL BYTTST ;CHECK FOR REAL BYTE
SPOP T4 ;RESTORE MODE
SPOP T3
HRLI T1,BC1 ;STORE BYTE
MOVEM T1,ADRLOW
M68C1B: SETZM ADRHGH ;NO HIGH PART
M68CLO: HRRZ T1,OPCODE ;GET OP TABLE ADDRS
LDB T1,OPPNT(T3) ;FETCH ACTUAL BYTE
JUMPE T1,POPERA ;ADDRS ERROR
HRRM T1,OPCODE ;STASH OPCODE
RETURN ;EXIT
M68C1C: CALL POPSTA ;STORE ARGS
TLNE T4,(AM%ZP) ;ZERO PAGE?
JRST [HRRZ T1,OPCODE
LDB T1,OPPNT(T3) ;CHECK IF DIR ADDRS OK
JUMPN T1,M68C1B
JRST .+1] ;NO - HANDLE 16-BIT
MOVEI T3,.M68A4 ; AND SETUP EXT ADDRS
JRST M68CLO ;STORE OP
;OP CLASS 2 - RELATIVE ADDRS
M68CL2: JRST RELBYT ;COOK UP RELADR
;OP CLASS 3 - IMPLIED
M68CL3: JRST POPTIM ;JUST DO TIMING
;OP CLASS 5 - (ALLOW 16-BIT IMMEDIATES)
M68CL5: CALL M68AEX ;GET ADDRS EXPR
JRST POPERA
HRRZ T3,T4 ;GET TYPE CODE
CAIE T3,.M68A1 ;IMMED?
JRST M68C1A ;NO - HANDLE NORMAL CASE
CALL POPSTA ;STORE ADDRS FIELD
JRST M68CLO ; AND OPCODE
;8080/Z80 OPCODE CLASS HANDLERS
;OPLC1 - MOV
M80CL1: SETZM MZ8MOV ;CLEAR TEMP
CALL EXPR ;GET AN EXPRESSION
ERRSET ERR.A
TLZN VAL,REGSYM ;REGISTER?
JRST [CALL MZ8CL1 ;PARSE Z80 INDEX ARG
JRST POPERA ;ERROR
JRST .+1] ;CONTINUE PROCESSING
SPUSH VAL ;SAVE VALUE
CAIE CHR,"," ;COMMA DELIMITER?
JRST [POP P,VAL ;CLEAN PDL
JRST POPERA]
CALL GETNB ;GET NEXT NON-BLANK
CALL EXPR ;GET 2ND ARG
ERRSET ERR.A
TLZN VAL,REGSYM
JRST [CALL MZ8CL1 ;PARSE INDEX EXPR
JRST [SPOP VAL ;CLEAN PDL
JRST POPERA]
JRST .+1]
HRRZ T1,OPCODE ;GET BASIC VALUE
LDB T2,[POINT 9,T1,26] ;GET TIMING INFO
ANDI T1,377 ;OP-CODE ONLY
DPB VAL,[POINT 3,T1,35]
SPOP T3 ;RETRIEVE OTHER REG
DPB T3,[POINT 3,T1,32]
HRRM T1,OPCODE ;STASH OPCODE
CAIE VAL,6 ;CHECK MEMORY OPERAND
CAIN T3,6 ; FOR EITHER
ADDI T2,^D20 ;INCREASE TIME
ADDM T2,TIMBLK+1 ;ACCUMULATE TIMING INFO
CAIN T1,166 ;ACTUALLY 76 HEX
ERRSET ERR.A
SKIPN T2,MZ8MOV ;WAS THIS FOR THE Z80?
RETURN
HRRZ T1,OPCODE ;GET LOW BYTE
TRZ T2,377 ;CLEAR LOW GARBAGE
IOR T1,T2 ;COMBINE
MOVEM T1,OPCODE ;RE-STASH (HAS BC2 ON)
RETURN
.LOC
MZ8MOV: BLOCK 1 ;TEMP STORAGE FOR Z80 MOV INSTR
MZ8TMP: BLOCK 1 ;TEMP STORAGE FOR Z80 STORE
.RELOC
MZ8CL1: SPUSH OPCODE ;SAVE THIS
SETZM OPCODE ; SOME GOOD TRASH
CALL MZ8IDX ;SEE IF D(II)
JRST [SPOP OPCODE ;RESTORE VALUE
RETURN] ;ERROR EXIT
MOVEM T1,MZ8MOV ;SAVE TEMP
SPOP OPCODE ;RESTORE OPCODE
MOVE VAL,[REGSYM,,6] ;RETURN MEMORY OPERAND
JRST CPOPJ1 ;GOOD RETURN
;OPCL2 - OP ADDRS
M80CL2: CALL EXPR ;GET ADDRS EXPR
ERRSET ERR.Q ;NULL EXPR
CALL POPTIM ;HANDLE TIMING INFO
TLNE VAL,REGSYM ;DISALLOW REGS
JRST POPERA
HRRZ T1,VAL ;GOOD PLACE
JRST POPSTA ;STORE ADDRS (LOW,HIGH)
;OPCL3 - OP
M80CL3: JRST POPTIM ;HANDLE TIMING AND RETURN
;OPCL4 - OP REG OR OP BYTE(II)
M80CL4: CALL EXPR ;GET AN EXPRESSION
ERRSET ERR.Q
TLNN VAL,REGSYM ;A REGISTER SYMBOL?
JRST MZ8CL4 ;POSSIBLE Z80 INSTR
HRRZ T2,VAL ;GET VALUE OR REG INDEX
M80CLO: HRRZ T1,OPCODE ;GET TABLE ADDRS
CAILE T2,^D9 ;CHECK MAX REG VALUE
JRST [LDB T3,OPPNT1+1 ;ILLEGAL IF 16BIT REG
JUMPN T3,POPERA ;JUMP IF NOT B,D,SP,ETC..
SKPEDS ED.Z80 ;Z80 ALLOWED
ERRSET ERR.Z ;NO - FLAG ERROR
JRST MZ8CLO] ;PROCESS Z80 OP
LDB T3,[POINT 9,2(T1),35]
CAIN T2,6 ;CHECK "M"
ADDI T3,^D30 ;ADD 3 CYCLES FOR MEM
LDB T1,OPPNT1(T2) ;GET ACTUAL OPCODE
JUMPE T1,POPERA ;NO SUCH
TRZE T1,400 ;CHECK FOR SPECL TIMING
ADDI T3,^D20 ;2 XTRA CYCLES
HRRM T1,OPCODE ;STASH GOOD VALUE
ADDM T3,TIMBLK+1 ;ACCOUNT TIME
RETURN
MZ8CL4: CALL MZ8IDX ;HANDLE INDEXED VALUE
JRST POPERA ;ADDRS ERROR
RETURN ;DONE - RETURN
MZ8IDX: CAIE CHR,"(" ;CHECK INDEX
RETURN ;NOPE - ERROR
SKPEDS ED.Z80 ;Z80 ENABLED?
ERRSET ERR.Z ;NO - FLAG ERROR
CALL BYTTST ;VALIDATE BYTE (8-BIT)
HRLI VAL,BC1 ;SAVE VALUE
MOVEM VAL,ADRLOW ; AS 3RD BYTE FOR THIS OP
CALL GETNB ;SKIP PAREN
CALL EXPR ;GET EXPRESSION IN PARENS
ERRSET ERR.Q
TLZE VAL,REGSYM ;BETTER BE A REG
CAIGE VAL,12 ; AND X OR Y
RETURN ;ADDRS LOSAGE
CAIE CHR,")" ;CHECK TERMINATOR
ERRSET ERR.Q
CALL GETNB ;SKIP IT
HRRZ T2,VAL ;COPY VALUE TO HERE
CALL MZ8CLO ;MAKE OPCODE
JRST CPOPJ1 ; AND GIVE GOOD RETURN
MZ8CLO: MOVEI T3,IX_^D8 ;HIGH BYTE FOR "X"
CAIE T2,12 ;WAS IT X OR Y
MOVEI T3,IY_^D8 ;MUST BE "Y"
HRRZ T1,OPCODE ;GET TABLE ADDRS
JUMPE T1,MZ8CLA ;SPECIAL CASE IF ZERO
LDB T1,OPPNT1+12 ;GET LOW BYTE OF OP
SKIPN T1 ;VALID OP
ERRSET ERR.A ;NO - ERROR
MZ8CLA: IOR T1,T3 ;COMBINE FOR 16-BIT OPCODE
HRLI T1,BC2 ;FLAG AS 2BYTE
MOVEM T1,OPCODE ;STORE
RETURN ; AND RETURN
;OPCL5 - OP REG,BYTE OR OP BYTE(II),BYTE
M80CL5: CALL EXPR ;GET EXPR
ERRSET ERR.A
TLZN VAL,REGSYM ;REGISTER SYMBOL?
JRST MZ8CL5 ;CHECK FOR D(II)
CALL REGTST ;VALIDATE REGISTER
CAIE CHR,"," ;PARSE A COMMA
JRST POPERA ;ERROR
SPUSH VAL ;SAVE VALUE
CALL GETNB
CALL M80BYT ;GET A BYTE INTO ADRLOW
SPOP T2 ;GET BACK REGISTER
M80C5A: HRRZS T2
JRST M80CLO ;GET OPCODE
MZ8CL5: CALL MZ8IDX ;PARSE INDEX EXPR
JRST POPERA ;FAILURE
CAIE CHR,"," ;BETTER BE A COMMA
JRST POPERA
CALL GETNB ;SKIP IT
SPUSH ADRLOW ;SAVE THIS
CALL M80BYT ;PARSE A BYTE
MOVEM T1,ADRHGH ;SAVE AS HIGH BYTE
SPOP ADRLOW ;RESTORE LOW BYTE
RETURN ;DONE - RETURN
;OPCL6 - OP REG,ADDRS
M80CL6: CALL EXPR ;PARSE EXPRESSION
ERRSET ERR.Q ;HUH?
TLZN VAL,REGSYM
JRST POPERA ;NOT A VALID REG
CAIE CHR,"," ;BETTER BE A COMMA
JRST POPERA ;ERROR
SPUSH VAL ;SAVE VALUE
CALL GETNB ;GET NEXT CHAR
CALL EXPR ;PARSE ADDRS
ERRSET ERR.Q
TLNE VAL,REGSYM ;DISALLOW REGS
JRST [SPOP VAL ;PRUNE PDL
JRST POPERA]
HRRZ T1,VAL ;PUT HERE FOR COMMON ROUTINE
CALL POPSTA ;STASH ADDRS
SPOP T2 ;RESTORE REG VALUE
CAIGE T2,12 ;MAYBE X OR Y
JRST M80C5A ;NO - FETCH OPCODE
JRST MZ8CLO ;YES - BUILD OP
;OPCL7 - OP BYTE
M80CL7: CALL M80BYT ;GET BYTE
JRST POPTIM ; AND RETURN (ADJUST TIME)
;OPCL8 - RST #
M80CL8: CALL REGEXP ;GET 0-7
TLNE VAL,REGSYM
JRST POPERA ;NO REGS HERE
HRRZ T2,VAL ;SET UP FOR OPCODE SELECT
JRST M80CLO ;...
;OPCL9 - BIT , SET , RES #,DEST
M80CL9: SETZM MZ8MOV ;CLEAR TEMP
CALL REGEXP ;GET NUMBER 0-7
TLNE VAL,REGSYM ;REGISTER INVALID
JRST POPERA ;EXIT CODE
CAIE CHR,"," ;MUST BE COMMA
JRST POPERA ;ELSE ERROR
CALL GETNB ;SKIP OVER IT
M80C9C: SPUSH VAL ;SAVE BIT #
CALL EXPR ;GET NEXT EXPRESSION
ERRSET ERR.Q
TLZN VAL,REGSYM ;REGISTER?
JRST [CALL MZ8CL1 ;NO - TRY DD(II)
JRST [SPOP VAL ;ERROR
JRST POPERA]
JRST .+1]
HRRZ T1,OPCODE ;GET BASIC VALUE
ANDI T1,377 ;JUST OP
DPB VAL,[POINT 3,T1,35] ;STORE REG #
SPOP T3 ;GET BIT # BACK
CAIE T3,-1 ;ALL ONES?
DPB T3,[POINT 3,T1,32] ;STORE BIT
SKIPE T2,MZ8MOV ;INDEXED?
JRST M80C9A ;YES - 4 BYTE OP
IOR T1,[BC2,,BITV_^D8] ;FORM 2 BYTE OP
MOVEM T1,OPCODE ;ACTUAL OP
RETURN
M80C9A: ANDI T2,177400 ;ISOLATE BITS WE WANT
IOR T2,[BC2,,BITV] ;FORM OPCODE
MOVEM T2,OPCODE ;SAVE IT
HRLI T1,BC1 ;FORM LAST BYTE
MOVEM T1,ADRHGH ;SAVE AS HIGH ADDR BYTE
RETURN ;EXIT
;OPCL10 - OP RELATIVE
M80C10: JRST RELBYT ;COOK UP RELADR
;OPCL11 - OP DEST (KIND OF LIKE BIT INSTRS)
M80C11: SETZM MZ8MOV ;CLEAR THIS
MOVEI VAL,-1 ;SPECIAL FLAG FOR BIT #
JRST M80C9C ;ENTER COMMON CODE
;OPCL12 - OP (8085 ONLY)
M80C12: SKPEDS ED.M85 ;ENABLED?
JRST OPCERR ;NO - NO SUCH OPCODE
JRST POPTIM ;HANDLE TIMING ETC.
;8008 OPCODE CLASS HANDLERS
;OPCL1 - MOV
M88CL1: CALL REGEXP ;GET AN EXPRESSION
ERRSET ERR.A ;???
TLZN VAL,REGSYM ;MUST BE REGISTER
JRST POPERA
CAIE CHR,"," ;MUST BE COMMA
JRST POPERA ;ELSE ERROR
SPUSH VAL ;SAVE VALUE
CALL GETNB ;SKIP OVER IT
CALL REGEXP ;GET A REGISTER EXPR
TLZN VAL,REGSYM ;MUST BE A REG
JRST [SPOP VAL
JRST POPERA] ;ERROR IF NOT REG
HRRZ T1,OPCODE ;GET BASIC VALUE
LDB T2,[POINT 9,T1,26] ;GET TIMING INFO
ANDI T1,377 ;OP-CODE ONLY
DPB VAL,[POINT 3,T1,35]
SPOP T3 ;DESTINATION REG
DPB T3,[POINT 3,T1,32]
HRRM T1,OPCODE ;STASH OP
CAIE T3,7 ;CHECK FOR EITHER MEMORY OPERAND
CAIN VAL,7
ADDI T2,^D20 ;YES - EXTRA CYCLES
CAIN VAL,7 ;READ OR WRITE
ADDI T2,^D10 ;READ - 1 MORE CYCLE
ADDM T2,TIMBLK+1 ;ADD TO TIMING INFO
CAIN T1,377 ;ACUALLY FF HEX
ERRSET ERR.A
RETURN ;ALL DONE
;OPCL2 - OP ADDRS
M88CL2: JRST M80CL2 ;SAME AS 8080/Z80
;OPCL3 - OP
M88CL3: JRST POPTIM ;HANDLE TIMING AND RETURN
;OPCL4 - OP REG
M88CL4: CALL REGEXP ;GET REGISTER EXPR
TLZN VAL,REGSYM ;MUST BE REGISTER SYMBOL
JRST POPERA ; ELSE ERROR
HRRZ T2,VAL ;GET REG VALUE
M88CLO: HRRZ T1,OPCODE ;OPCODE TABLE ADDRS
LDB T3,[POINT 9,2(T1),35] ;FETCH TIMING INFO
CAIN T2,7 ;MEMORY OPERAND
ADDI T3,^D30 ;XTRA CYCLES IF MEMORY
LDB T1,OPPNT1(T2) ;FETCH ACTUAL OPCODE
JUMPE T1,POPERA ;ERROR IF ZERO
HRRM T1,OPCODE ;STASH OP
ADDM T3,TIMBLK+1 ;UPDATE TIMING
RETURN ;RETURN
;OPCL5 - OP REG,BYTE
M88CL5: CALL REGEXP ;GET REGISTER EXPR
TLZN VAL,REGSYM ;MUST BE REGISTER SYMBOL
JRST POPERA ; ELSE ERROR
CAIE CHR,"," ;CHECK COMMA DELIMITER
JRST POPERA ;ERROR
SPUSH VAL ;SAVE VALUE
CALL GETNB ;SKIP OVER COMMA
CALL M80BYT ;GET A BYTE INTO ADRLOW
SPOP T2 ;GET BACK REGISTER
HRRZS T2 ;REG VALUE ONLY
JRST M88CLO ;COMMON OPCODE HANDLER
;OPCL6 - OP BYTE
M88CL6: CALL EXPR ;GET 8-BIT EXPR OR HALF ADDRESS CONSTANT
ERRSET ERR.Q
MOVE T1,VAL ;GET VALUE
HRLI T1,BC1 ;SET CODE
MOVEM T1,ADRLOW ;SAVE BYTE
JRST POPTIM ; AND RETURN (ADJUST TIME)
;OPCL7 - IN N (0-7)
M88CL7: CALL REGEXP ;GET 0-7
TLNE VAL,REGSYM ;MUST NOT BE REGISTER SYMBOL
JRST POPERA
MOVE T4,[POINT 3,T1,34]
M88C7A: HRRZ T1,OPCODE ;GET BASIC VALUE
LDB T3,[POINT 9,T1,26]
ADDM T3,TIMBLK+1 ;TIMING UPDATE
ANDI T1,377 ;OPCODE ONLY
DPB VAL,T4 ;STASH VAL INTO OP
HRRM T1,OPCODE ;SAVE OPCODE
RETURN ;AND RETURN
;OPCL8 - OUT N (0-27)
M88CL8: CALL EXPR ;GET EXPRS
ERRSET ERR.A
TLZN VAL,REGSYM ;NO REGS
CAILE VAL,27 ;CHECK MAX VALUE
JRST POPERA
ADDI VAL,10 ;ADD IN OFFSET
MOVE T4,[POINT 5,T1,34]
JRST M88C7A ;COMMON CODE
;OPCL9 - RST N (0-7)
M88CL9: CALL REGEXP ;NUMBER IN RANGE 0-7
TLNE VAL,REGSYM ;DISSALLOW REGS
JRST POPERA
MOVE T4,[POINT 3,T1,32]
JRST M88C7A ;JOIN COMMON CODE
;1802 OPCODE CLASS HANDLERS
;OPCL1 - OP REG
M18CL1: CALL EXPR ;GET EXPRS
ERRSET ERR.A
TDZE VAL,[<GLBSYM>B17!377B<SUBOFF>!177760]
ERRSET ERR.R ;NOT VALID RANGE
TLZN VAL,REGSYM ;MUST BE A REG SYM
JRST POPERA ;ERROR
M18CLO: HRRZ T1,OPCODE ;FIRST PART OF OPCODE
ANDI VAL,17 ;MASK TO WANTED BITS
IOR T1,VAL ;OR INTO OPCODE
SKIPN T1 ;00 - ILLEGAL
ERRSET ERR.A
HRRM T1,OPCODE ; AND STORE
M18TIM: MOVEI T1,^D160 ;ADJUST TIMING FOR 1 BYTE INSTR
ADDM T1,TIMBLK+1 ;...
RETURN ; AND EXIT
;OPCL2 - OP
M18CL2: JRST M18TIM ;HACK TIMING AND EXIT
;OPCL3 - OP BYTE
M18CL3: CALL M80BYT ;GET BYTE
JRST M18TIM ;HANDLE TIME AS 1 BYTE
;OPCL4 - OP ADDR
M18CL4: CALL EXPR ;GET ADDRS EXPR
ERRSET ERR.Q ;NULL EXPR
MOVEI T1,^D240 ;TIMING INFO FOR 3 BYTER
ADDM T1,TIMBLK+1
TLNE VAL,REGSYM ;DISALLOW REGS
JRST POPERA
HRRZ T1,VAL
JRST POPSTA ;STORE ADDRS (LOW,HIGH)
;OPCL5 - OP ADDR (LOW BYTE)
M18CL5: CALL EXPR ;GET EXPRS
ERRSET ERR.Q ;NULL ADDRS
TLNE VAL,REGSYM ;NO REGS ALLOWED
JRST POPERA
MOVE T1,PC ;GET CURRENT PC
ADDI T1,1 ;STEP TO ADDRS BYTE PC
ANDI T1,177400 ;MASK TO PAGE NUMBER
HRRZ T2,VAL ;GET DEST ADDRS
ANDI T2,177400 ;MASK PAGE NUMBER
CAME T1,T2 ;SAME?
ERRSET ERR.A ;NO - SET ADDRS ERROR
ANDI VAL,377 ;KEEP LOW BYTE
HRLI VAL,BC1 ;SET CODE
MOVEM VAL,ADRLOW ;SAVE IT
JRST M18TIM ; UPDATE TIMING AND EXIT
;OPCL6 - INP N (1-7)
M18CL6: CALL REGEXP ;GET NUMBER IN RANGE 0-7
HRRZ T1,VAL ;VALUE ONLY
SKIPE T1 ;ZERO ILLEGAL
TLNE VAL,REGSYM ;DISALLOW REGS
JRST POPERA
JRST M18CLO ;HANDLE AS CLASS 1
;OP-CODE DISPATCH TABLES FOR ALL MACHINES
PRPM65: ;TABLE FOR 6502
PHASE 0
0 ;ILLEGAL
OPCL1:! XWD M65CL1,0 ;GENERAL ADDRESSES
OPCL2:! XWD M65CL2,0 ;BRANCHES
OPCL3:! XWD M65CL3,0 ;JUMP INSTR (SPECIAL)
OPCL4:! XWD M65CL4,0 ;IMPLIED
OPCL5:! XWD M65CL5,DSTFLG ;SAME AS CLASS 1
DEPHASE
PRPM68: ;TABLE FOR 6800
PHASE 0
0 ;ILLEGAL
OPCL1:! XWD M68CL1,0 ;GENERAL ADDRESSES
OPCL2:! XWD M68CL2,0 ;BRANCHES
OPCL3:! XWD M68CL3,0 ;IMPLIED
OPCL4:! XWD M68CL4,DSTFLG ;SAME AS CLASS 1
OPCL5:! XWD M68CL5,0 ;CLASS 1 W/ 16-BIT IMMED.
DEPHASE
PRPM80: ;TABLE FOR 8080
PHASE 0
0
OPCL1:! XWD M80CL1,0 ;MOV INSTRUCTIONS
OPCL2:! XWD M80CL2,0 ;JUMP/CALL INSTRS
OPCL3:! XWD M80CL3,0 ;IMPLIED ADDRS/REG
OPCL4:! XWD M80CL4,0 ;REGISTER
OPCL5:! XWD M80CL5,0 ;MVI
OPCL6:! XWD M80CL6,0 ;LXI
OPCL7:! XWD M80CL7,0 ;ACCUM IMMED
OPCL8:! XWD M80CL8,0 ;RST
OPCL9:! XWD M80CL9,0 ;BIT FIDDLING INSTRS
OPCL10:!XWD M80C10,0 ;JUMP RELATIVE
OPCL11:!XWD M80C11,0 ;FANCY ROTATE/SHIFT
OPCL12:!XWD M80C12,0 ;RIM/SIM (8085)
DEPHASE
PRPM88: ;TABLE FOR 8008
PRPM08:
PHASE 0
0
OPCL1:! XWD M88CL1,0 ;MOV INSTRUCTIONS
OPCL2:! XWD M88CL2,0 ;JUMP/CALL INSTRS
OPCL3:! XWD M88CL3,0 ;IMPLIED REG/ADDRS
OPCL4:! XWD M88CL4,0 ;REGISTER
OPCL5:! XWD M88CL5,0 ;MVI REG,BYTE
OPCL6:! XWD M88CL6,0 ;ACCUM IMMED
OPCL7:! XWD M88CL7,0 ;INPUT
OPCL8:! XWD M88CL8,0 ;OUTPUT
OPCL9:! XWD M88CL9,0 ;RESET (RST)
DEPHASE
PRPM18: ;TABLE FOR 1802
PHASE 0
0
OPCL1:! XWD M18CL1,0 ;REGISTER OPS
OPCL2:! XWD M18CL2,0 ;IMPLIED ADDRS (SKIPS)
OPCL3:! XWD M18CL3,0 ;IMMED.
OPCL4:! XWD M18CL4,0 ;LONG BRANCH
OPCL5:! XWD M18CL5,0 ;SHORT BRANCH
OPCL6:! XWD M18CL6,0 ;INPUT/OUTPUT
DEPHASE
PRPMF8: ;TABLE FOR F8
PHASE 0
0
DEPHASE
.LOC
OPCODE: BLOCK 1
ADRLOW: BLOCK 1
ADRHGH: BLOCK 1
TIMBLK: BLOCK 2 ;TIMING INFO
MACHT: BLOCK 1 ;MACHINE TYPE CODE
.RELOC
OPPNT: POINT 9,[0],35 ;ERROR IF ZERO
OPPNT1: POINT 9,0(T1),8 ;MODE 1
POINT 9,0(T1),17 ;MODE 2
POINT 9,0(T1),26 ;MODE 3
POINT 9,0(T1),35 ;MODE 4
POINT 9,1(T1),8 ;MODE 5
POINT 9,1(T1),17 ;MODE 6
POINT 9,1(T1),26 ;MODE 7
POINT 9,1(T1),35 ;MODE 10
POINT 9,2(T1),8 ;MODE 11
POINT 9,2(T1),17 ;MODE 12
POINT 9,2(T1),26 ;MODE 13
SUBTTL DIRECTIVES
.ABS: MOVEI T3,ED.ABS
TDNE T3,EDMSK ;MASKED OUT?
RETURN ; YES
TRO ASM,0(T3) ;NO, SET IT
HRRM ASM,EDFLGS
TLZ PC,(PFMASK) ;CLEAR RELOCATION
RETURN
.ASECT= OPCERR
.CSECT= OPCERR
.GLOBL= OPCERR
.LOCAL= OPCERR
.LIMIT= OPCERR
.PSECT= OPCERR
TSTMAX: LDB T3,CCSPNT ;GET CURRENT SEC
HLRZ T4,SECBAS(T3) ;MAX FOR THIS ONE
CAIGE T4,0(PC) ;NEW MAX?
HRLM PC,SECBAS(T3) ; YES
RETURN
.LOC
SECNAM: BLOCK ^D256 ;SECTOR NAMES
SECBAS: BLOCK ^D256 ;SECTOR BASES
SECLCF: BLOCK ^D<256/36>+1 ;SECTOR LOCAL FLAGS
SECLCP: BLOCK 1 ;SECTOR LOCAL POINTER
PSCFLG: BLOCK ^D256 ;PSECT ATTRIBUTE FLAGS
;THOSE SLOTS WHICH CORRESPOND TO PSECTS HAVE ALL ONES IN THE LH
;OF THE WORD
PSCTSW: BLOCK 1 ;SET TO ONES DURING PSECT PROCESSING
.RELOC
DEFINE ATARG (SYM,BIT,SET)
<
SYM==SET'B<35-BIT>
GENM40 <SYM>
EXP SET'B0!1B<35-BIT>
>
ATRARG: ;ATTRIBUTE ARGUMENT TABLE
ATARG <HGH>,0,1
ATARG <LOW>,0,0
ATARG <CON>,2,0
ATARG <OVR>,2,1
ATARG <RW>,4,0
ATARG <RO>,4,1
ATARG <ABS>,5,0
ATARG <REL>,5,1
ATARG <LCL>,6,0
ATARG <GBL>,6,1
ATARG <I>,7,0
ATARG <D>,7,1
ATREND: ;END OF TABLE
.PHASE:
CALL RELEXP
MOVE T3,PC
TRO T3,600000
SUB T3,VAL
TLNE T3,(PFMASK)
ERRXIT ERR.A!ERR.P1
ANDI T3,177777
MOVEM T3,PHAOFF
.PHASX: TRZ VAL,600000
SPUSH M40DOT
JRST ASGMTF
.DEPHA: SETZM VAL
EXCH VAL,PHAOFF
.DEPHX: ADD VAL,PC
JRST .PHASX
.LOC
PHAOFF: BLOCK 1
.RELOC
.BLKB: TDZA T3,T3
.BLKW: SETOM T3
HLLM T3,0(P)
CALL SETPF0 ;LIST LOCATION
CALL EXPR
MOVEI VAL,1
CALL ABSTST
CALL SETPF1
SKIPGE 0(P)
ASH VAL,1
ADD VAL,PC
TRZ VAL,600000
SPUSH M40DOT
JRST ASGMTX
.EQUIV: ;.EQUIV DEFSYM,ANYSYM
CALL GSARG ;GET SYMBOLIC ARG
JRST OPCERR ; ERROR
MOVEM SYM,.EQUI9 ;OK, SAVE IT
CALL GSARG ;GET SECOND ARG
JRST OPCERR ; MISSING
EXCH SYM,.EQUI9 ;GET FIRST MNEMONIC
CALL OSRCH ;TEST FOR MACRO/OP CODE
JRST .EQUI1 ; NO
CALL CRFOPR
JRST .EQUI2
.EQUI1: CALL SSRCH ;NO, TRY USER SYMBOL
JRST OPCERR ; MISSING
CALL CRFREF
.EQUI2: CAIN T2,MAOP ;FOUND, MACRO?
CALL INCMAC ;YES, INCREMENT USE LEVEL
MOVE SYM,.EQUI9 ;GET SECOND MNEMONIC
MOVEM T1,.EQUI9 ;SAVE VALUE
CAIE T2,0 ;USER SYMBOL?
MOVEI T2,1 ;NO NO, TREAT AS OP
SPUSH T2
CALL @[EXP SSRCH,MSRCH](T2) ;CALL PROPER SEARCH
JFCL
CAIN T2,MAOP ;MACRO?
TRNE T2,-1
CAIA
CALL DECMAC ; YES, DECREMENT REFERENCE
MOVE T1,.EQUI9 ;GET NEW VALUE
SPOP T2
CALL @[EXP CRFDEF,CRFOPD](T2)
JRST INSRT ;INSERT AND EXIT
.LOC
.EQUI9: BLOCK 1
.RELOC
.PDP10: RETURN ;NO-OP, FOR COMPATIBILITY W/ MACX11
.TITLE: ;TITLE PSEUDO-OP
SPUSH SYMEND ;SAVE START
CALL GETSYM ;GET THE SYMBOL
SPOP LBP
SKIPN SYM ;ONE FOUND?
ERRXIT ERR.A ; NO, FLAG ERROR AND EXIT
MOVEM SYM,PRGTTL ;YES, STORE TITLE
MOVEI T1,TTLBUF ;POINT TO TITLE BUFFER
JRST .SBTT1 ;EXIT THROUGH SUB-TITLE
.SBTTL: ;SUB-TITLE PROCESSOR
MOVE LBP,SYMEND
TLNN FLG,P1F ;PASS ONE?
JRST .SBTT3 ; NO
MOVEM LBP,CLIPNT ;YES, FUDGE FOR TABLE OF CONTENTS
SKPLCS LC.TOC
TLO EXF,P1LBIT
TLO FLG,NQEFLG!LHMFLG
RETURN
.SBTT3: MOVEI T1,STLBUF ;POINT TO PROPER BUFFER
.SBTT1: HRLI T1,(POINT 7,) ;COMPLETE BYTE POINTER
MOVEI T2,TTLLEN ;SET COUNT
.SBTT2: GETCHR ;GET THE NEXT CHARACTER
SOSL T2
IDPB CHR,T1 ;STORE IN BUFFER
JUMPN CHR,.SBTT2
IDPB CHR,T1 ;BE SURE TO STORE TERMINATOR
RETURN
.LOC
TTLBUF: BLOCK <TTLLEN+4>/5+1 ;TITLE BUFFER
STLBUF: BLOCK <TTLLEN+4>/5+1 ;SUB-TITLE BUFFER
PRGTTL: BLOCK 1 ;PROGRAM TITLE
PRGIDN: BLOCK 1 ;PROGRAM IDENT
.RELOC
.REM: ;REMARK
JUMPE CHR,OPCERR ;ERROR IF EOL
SPUSH CHR
.REM1: GETCHR
.REM2: CAMN CHR,0(P)
JRST .REM3
JUMPN CHR,.REM1
CALL ENDL
TLNE FLG,ENDFLG
JRST .REM4
CALL GETLIN
SKPLCS LC.TTM
TLO FLG,LHMFLG ;LEFT JUSTIFY IF IN TTM MODE
JRST .REM2
.REM3: CALL GETNB
.REM4: SPOP 0(P)
RETURN
.ERROR: TLNE FLG,P1F ; ".ERROR", PASS ONE?
RETURN ; YES, IGNORE
AOS ERRCNT
.PRINT: ; ".PRINT" DIRECTIVE
TLO EXF,ERRBIT ;FORCE TTY LISTING
CALL SETPF0
CALL EXPR ;ANY EXPRESSION?
RETURN ; NO
JRST SETPF1
.EOT:
RETURN
.ROUND: TDZA T3,T3
.TRUNC: MOVEI T3,1
MOVEI T1,ED.FPT
TDNN T1,EDMSK
XCT [EXP <TRZ ASM,0(T1)> , <TRO ASM,0(T1)>](T3)
HRRM ASM,EDFLGS
RETURN
.RADIX: MOVEI T3,^D10
EXCH T3,CRADIX
SPUSH T3
CALL ABSEXP
CAIL VAL,^D2
CAILE VAL,^D10
ERRSKP ERR.N
MOVEM VAL,0(P)
POP P,CRADIX
RETURN
.LOC
CRADIX: BLOCK 1 ;CURRENT RADIX
.RELOC
.END: ;"END" PSEUDO-OP
SKIPE CNDLVL ;IF IN CONDITIONAL
ERRSET ERR.E ; FLAG ERROR
TLO FLG,ENDFLG ;FLAG "END SEEN"
CALL EXPR ;EVALUATE THE ADDRESS
END2: MOVEI VAL,0 ; NULL, USE ZERO
MOVEM VAL,ENDVEC
TRNE FLG,ERR.U ;ANY UNDEFINED SYMBOLS?
ERRSET ERR.P1 ; YES, PASS ONE ERROR
JRST SETPF1
.LOC
ENDVEC: BLOCK 1 ;END VECTOR
.RELOC
SUBTTL DATA-GENERATING DIRECTIVES
.ASCII: TLZA FLG,ASZFLG ; ".ASCII" DIRECTIVE
.ASCIZ: TLO FLG,ASZFLG ; ".ASCIZ" DIRECTIVE
.ASCI2: CALL GTCHR ;GET A TEXT CHARACTER
JRST .ASCI6 ; NO
TRZE VAL,177400 ;OVERFLOW?
ERRSET ERR.T ; YES
.ASCI3: MOVE T1,VAL ;COPY CHARACTER
HRLI T1,BC1 ;SINGLE BYTE
CALL STCODE
JRST .ASCI2 ;GET NEXT CHAR
.ASCI6: HRLZI T1,BC1 ;MAYBE NULL
TLZE FLG,ASZFLG ;ASCIZ?
CALL STCODE ;YES - DUMP NULL
RETURN ;RETURN
.BYTE: ;"BYT" PSEUDO-OP
SPUSH PC ;STACK PC
.BYTE1: CALL EXPR ;EVALUATE EXPRESSION
JFCL ; ACCEPT NULLS
TRNE VAL,177400 ;ANY HIGH ORDER BITS SET?
TRC VAL,177400 ; YES, TOGGLE FOR TEST
CALL TSTARB ;TEST ARITHMETIC BYTE
TLC T1,BC1!BC2 ;RESET TO ONE BYTE
CALL STCODE
HRROS ARGCNT
CALL TGARG ;ANY MORE?
JRST .WORDX ; NO
AOJA PC,.BYTE1 ;INCREMENT PC AND LOOP
.WORD: TDZA T2,T2 ;"WORD" PSEUDO-OP
.ADDR: SETO T2, ;"ADDR" PSEUDO-OP
SPUSH PC ;STACK PC
SPUSH T2 ;STACK FLAG
.ADDR1: CALL EXPR ;GET EXPRESSION
JFCL ;ACCEPT NULLS
CALL TSTAR
TLC T1,BC1!BC2 ;MAKE INTO SINGLE BYTE
HRRZ T2,T1 ;COPY VALUE
SKIPN 0(P) ;WORD/ADDR?
JRST [LSH T2,-^D8 ;WORD - DO HIGH BYTE FIRST
EXCH T1,T2
HLL T1,T2 ;GET BACK FLAGS
CALL STCODE ;STASH
MOVE T1,T2 ;NOW DO LOW BYTE
TRZ T1,177400
JRST .ADDR2]
TRZ T1,177400 ;LOW BYTE
CALL STCODE
LSH T2,-^D8
HRR T1,T2 ;HIGH VALUE
.ADDR2: CALL STCODE
HRROS ARGCNT
CALL TGARG ;END OF STRING
JRST .ADDRX ;YES, EXIT
ADDI PC,2 ;ADVANCE PC
JRST .ADDR1
.ADDRX: SPOP PC ;CLEAN OFF STACK
.WORDX: SPOP PC ;RESTORE PC
RETURN
.FLT2: SKIPA T3,[2] ;TWO WORD FLOATING
.FLT4: MOVEI T3,4 ;FOUR WORD FLOATING
MOVEM T3,FLTLEN ;SET LENGTH FOR ROUNDING
.FLT2A: CALL FLTG ;PROCESS FLOATING POINT
TLNE FLG,FLTFLG ;ANY ERRORS?
ERRSET ERR.A ; YES
MOVN Q1,FLTLEN ;SET NEGATIVE OF LENGTH
HRLZS Q1 ;SET INDEX
.FLT2B: MOVE T1,FLTNUM(Q1) ;GET A VALUE
HRLI T1,BC2
CALL STCODE ;STORE IT
AOBJN Q1,.FLT2B ;LOOP IF MORE
HRROS ARGCNT
CALL TGARG ;MORE?
RETURN ; NO
JRST .FLT2A ;GET ANOTHER
SUBTTL "A" EXPRESSION EVALUATOR
M65AEX: ;"A" EXPRESSION EVALUATOR FOR 6502
CALL M65A0A
TRNE T4,-1 ;SOMETHING?
AOS 0(P) ;YES, GOOD RETURN
RETURN
M65A0A: SPUSH [0] ;INIT MODE
M65A01: CAIN CHR,"#"
JRST M65A02 ;PARSE CONSTANT
CAIN CHR,"("
JRST M65A05 ;SET INDIRECT
CAIN CHR,"A"
JRST M65A40 ;PROCESS ACCUMULATOR
JRST M65A10 ;NORMAL EXPRESSION
M65A02: CALL GETNB ;PASS OVER #
CALL BYTEXP ;GET BYTE EXPRESSION
SPOP T4
HRRI T4,.M65A7 ;IMMEDIATE EXPRESSION
JRST M65AR2 ;EXIT (TEST FOR BYTE)
M65A05: MOVSI T4,(AM%IND) ;SET INDIRECT BIT
TDNE T4,0(P) ;CHECK IF 2ND TIME HERE
ERRSET ERR.Q
IORM T4,0(P)
CALL GETNB ;BYPASS CHARACTER
JRST M65A01
;HERE TO PARSE A NORMAL ADDRESS EXPRESSION
M65A10: CALL EXPR
ERRSET ERR.Q
SPOP T4 ;GET MODES
CAIN CHR,"," ;CHECK FOR COMMA
JRST M65A20 ;HANDLE INDEXING
CAIN CHR,")" ;POSSIBLE INDIRECT
JRST M65A30
TLNE T4,(AM%IND) ;ERROR?
ERRSET ERR.Q
HRRI T4,.M65A1 ;ABSOLUTE ADDRS
JRST M65AR1 ;RETURN
;COMMA SEEN
M65A20: CALL GETNB ;PASS OVER ,
CAIN CHR,"X" ;X INDEX?
JRST M65A25 ;YES , CHECK IT OUT
CAIN CHR,"Y" ;Y INDEX
TLNE T4,(AM%IND) ;YES, INDIRECT SEEN?
ERRSET ERR.Q ;YES, ERROR
HRRI T4,.M65A3 ;OK - IDEXED BY "Y"
JRST M65ART
M65A25: HRRI T4,.M65A2 ;ASSUME INDEXED BY X
TLNN T4,(AM%IND) ;UNLESS INDIRECT SEEN
JRST M65ART
CALL GETNB ;PASS TO NEXT CHAR
HRRI T4,.M63A4 ;INDIRECT INDEXED
CAIE CHR,")" ;CHECK SYNTAX
ERRSET ERR.Q
JRST M65ART ;RETURN VALUE ETC.
;END OF INDIRECT SPEC ")" SEEN
M65A30: TLON T4,(AM%IND) ;FUDGE CLOSE BRACKET
ERRSET ERR.Q ;ERROR IF NOT ALREADY ON
CALL GETNB ;PASS OVER ")"
HRRI T4,.M65A6 ;ASSUME PLAIN INDIRECT
CAIE CHR,"," ;COMMA IS DIFFERENT
JRST M65AR1 ;EXIT AT CHARACTER
CALL GETNB ;PASS OVER COMMA
CAIE CHR,"Y" ;ONLY VALID CHARACTER
ERRSET ERR.Q
HRRI T4,.M65A5 ;INDEXED INDIRECT
JRST M65ART ;RETURN
;HERE WHEN "A" SEEN
M65A40: MOVEM LBP,SYMBEG ;INCASE NOT JUST AN "A"
CALL GETNB ;PASS OVER CHAR
CAIE CHR,0 ;ACCEPT ONLY EOL
CAIN CHR,";" ; AND COMMENTS
JRST M65A45
MOVE LBP,SYMBEG ;RESTORE PNTR
CALL SETNB ;AND CHARACTER
JRST M65A10 ; AND PARSE AS EXPRESSION
M65A45: SPOP T4 ;GET MODES
TLO T4,(AM%ACC)
HRRI T4,.M65A6 ;FUDGE INDIRECT
RETURN ;RETURN
;COMMON A-EXPRESSION RETURN
M65ART: CALL GETNB ;SKIP TERMINATOR
M65AR1: MOVE T1,VAL ;COPY EXPRESSION TO CORRECT PLACE
TRNE FLG,ERR.U ;IF UNDEFINED THEN DONE
RETURN ; TEST PAGE 0
M65AR2: TRNN T1,177400 ;CHECK PAGE 0
TLO T4,(AM%ZP)
RETURN ;RETURN
;"A" EXPRESSION EVALUATOR FOR 6800
M68AEX: CALL M68A0A ;CALL INNER ROUTINE
TRNE T4,-1 ;ANYTHING?
AOS 0(P) ;YES - SKIP RETRN
RETURN
M68A0A: SPUSH [0] ;INIT MODE INFO
CAIN CHR,"#" ;IMMED?
JRST M68A20 ;YES - HANDLE
CALL EXPR ;GET EXPRESSION
ERRSET ERR.Q
SPOP T4 ;GET MODES
CAIN CHR,"," ;CHECK FOR INDEXED
JRST M68A10
HRRI T4,.M68A2 ;NO - JUST SAY ADDRS
JRST M65AR1 ;COMMON EXIT
;COMMA SEEN
M68A10: CALL GETNB ;SKIP OVER IT
CAIE CHR,"X" ;ONLY LEGAL CHAR
ERRSET ERR.Q
HRRI T4,.M68A3 ;SET MODE 3
JRST M65ART ;EXIT - SKIP CHAR
;# SEEN
M68A20: CALL GETNB ;SKIP OVER CHAR
CALL EXPR ;EVAL EXPR
ERRSET ERR.Q
SPOP T4 ;GET MODE
HRRI T4,.M68A1 ;SET IMMEDIATE
JRST M65AR1 ;COMMON EXIT
TSTARB: ;TEST ARITHMETIC BYTE
CALL TSTAR ;TEST ARITHMETIC
TRZE T1,177400 ;OVERFLOW?
ERRSET ERR.A ; YES
LDB T2,MODPNT ;GET CLASS BITS
CAIE T2,RLDT1 ;IF ONE
CAIN T2,RLDT15 ; OR FIFTEEN
ERRSET ERR.A ;THEN ERROR
SKIPE T2 ;ABSOLUTE?
TRO T2,200 ; NO - MAKE BIT MODIFY
DPB T2,MODPNT ;...
RETURN
TSTAR: ;TEST ADDITIVE RELOCATION (0,1,5,15)
MOVE T1,VAL ;COPY TO FINAL AC
LDB T2,SUBPNT ;GET RELOCATION
HRLI T1,BC2 ;SET FOR TWO BYTES
JUMPE T2,CPOPJ ;EXIT IF ABS
MOVEI T3,RLDT5 ;ASSUME EXTERNAL
TLNE VAL,GLBSYM ;GLOBAL?
JRST TSTAR1 ; YES
MOVEI T3,RLDT1
LDB T4,CCSPNT
CAMN T2,T4 ;CURRENT SECTOR?
JRST TSTAR3 ; YES
MOVE T4,SECNAM(T2)
AOS T2,GLBPNT
MOVEM T4,GLBBUF(T2) ;STORE SECTOR NAME
MOVEI T3,RLDT15 ;TYPE 15
TSTAR1: DPB T2,SUBPNT
TSTAR2: DPB T3,MODPNT
RETURN
TSTAR3: SKPEDR ED.PIC ;PIC ENABLED?
ERRSET ERR.R ; YES, NO DIRECT REFS TO CURRENT
JRST TSTAR2
.LOC
GLBPNT: BLOCK 1
GLBBUF: BLOCK 40
.RELOC
SUBTTL EXPRESSION EVALUATOR
ABSEXP: ;ABSOLUTE EXPRESSION
CALL EXPR
ERRSET ERR.A
ABSTST: TLZE VAL,(<GLBSYM>B17!377B<SUBOFF>)
ERRSET ERR.A ;ERROR IF GLOBAL OR RELOCATABLE
ANDI VAL,177777
RETURN
RELEXP: ;RELOCATABLE EXPRESSION
CALL EXPR
ERRSET ERR.A
RELTST: TLNE VAL,GLBSYM ;NO GLOBALS ALLOWED
JRST ABSTST ;LET ABS FLAG IT
RETURN
REGEXP: ;REGISTER EXPRESSION
CALL EXPR
ERRSET ERR.A ; NULL, ERROR
REGTST: TDZE VAL,[<GLBSYM>B17!377B<SUBOFF>!177770]
ERRSET ERR.R ; ERROR
RETURN
BYTEXP: ;BYTE EXPRESSION (8-BITS)
CALL EXPR ;GATHER EXPRESSION
ERRSET ERR.Q ; NULL, ERROR
BYTTST: TRNE VAL,177400 ;ANY HIGH ORDER BITS?
TRC VAL,177400 ;TOGGLE FOR TEST
JRST TSTARB
EXPR: ;EXPRESSION PROCESSOR, REGISTER ALLOWED
CALL TERM ;GET THE FIRST TERM
POPJ P, ; NULL, EXIT
SETZB T4,RELLVL ;CLEAR RELOCATION LEVEL COPNT
CALL EXPRPX ;SET, IF NECESSARY
EXPR1: CAIE CHR,"^" ;UPPER HALF ADDRESS?
JRST EXPR2 ;NO
LSH VAL,-10 ;YES, SHIFT OFF LOWER BITS
CALL GETNB ;BYPASS THE ^
JRST EXPR3
EXPR2: LDB T3,C4PNTR ;MAP CHARACTER USING COLUMN 4
JUMPE T3,EXPR3 ;BRANCH IF NULL
SPUSH EXPRJT(T3) ;STACK ENTRY
SPUSH VAL ;STACK CURRENT VALUE
CALL GETNB ;BYPASS OP
CALL TERM ;GET THE NEXT EXPRESSION TERM
ERRSET ERR.Q ; NULL, FLAG ERROR
SPOP T1 ;GET PREVIOUS VALUE
SPOP T2
CALL 0(T2) ;CALL ROUTINE
ERRSET ERR.A ; ERROR
TRZ VAL,600000 ;CLEAR ANY OVERFLOW
JRST EXPR1 ;TEST FOR MORE
EXPR3: SOSLE RELLVL ;RELOCATION LEVEL .GT. 1?
ERRSET ERR.A ; YES
JRST CPOPJ1 ;EXIT GOOD
EXPRJT: ;EXPRESSION JUMP TABLE
PHASE 0
0
EXPL:! MOVEI T2,EXPRPL ; +
EXMI:! MOVEI T2,EXPRMI ; -
EXOR:! IOR VAL,EXPXCT ; !
EXAN:! AND VAL,EXPXCT ; &
EXMU:! IMUL VAL,EXPXCT ; *
EXDV:! IDIV VAL,EXPXCT ; /
EXSH:! LSH VAL,EXPXCI(T1) ; _
DEPHASE
EXPRPL: ; +
TDZA T4,T4 ;ZERO FOR ADD
EXPRMI: ; -
HRROI T4,1 ;ONE FOR SUBTRACT
CALL EXPRPX ;UPDATE RELOCATION COUNT
EXPRP1: LDB T2,SUBPNT ;GET RELOCATION
EXCH VAL,T1
LDB T3,SUBPNT
TLNE T1,REGSYM
TLO VAL,REGSYM ;TRANSFER REGISTER FLAG
JUMPE T3,EXPRM1 ;BRANCH IF SUBTRACTING ABS
TLON T4,-1 ;NOT ABS, FIRST-TIME ADDITION?
JRST EXPRP1 ; YES, REVERSE
TLNN T1,GLBSYM ;IF EITHER IS GLOBAL,
TLNE VAL,GLBSYM
JRST EXPRM2 ; ERROR
CAME T2,T3 ;LAST CHANCE, BOTH SAME RELOCATION
JRST EXPRM2 ; FORGET IT
SKIPN RELLVL ;IF BACK TO ZERO,
TLZ VAL,(PFMASK) ;MAKE ABSOLUTE
EXPRM1: AOS 0(P) ;INDICATE GOOD RESULT
EXPRM2: XCT [EXP <ADDM VAL,T1>,<SUBM VAL,T1>](T4) ;PERFORM OP
DPB T1,[POINT 16,VAL,35] ;STORE TRIMMED RESULT
RETURN ;EXIT
EXPRPX: ;UPDATE RELOCATION LEVEL
TLNE VAL,(PFMASK) ;IF ABS,
TLNE VAL,GLBSYM ; OR GLOBAL,
RETURN ; NO ACTION
XCT [EXP <AOSA RELLVL>,<SOSGE RELLVL>](T4)
ERRSET ERR.A ; NEGATIVE COUNT, ERROR
RETURN
EXPXCI: TRZA T2,-1 ;IMMEDIATE FORM OF EXPXCT
EXPXCT: HRRI T2,T1 ;COMPLETE INSTRUCTION
SPUSH T2 ;STACK INSTRUCTION
CALL EXPXC1 ;TEST FOR ABSOLUTE
EXCH VAL,T1
CALL EXPXC1 ;DITTO FOR OTHER
SPOP T2 ;FETCH INSTRUCTION
XCT T2 ;EXECUTE IT
ANDI VAL,177777 ;MAKE ABSOLUTE
JRST CPOPJ1 ;GOOD EXIT
EXPXC1: CALL ABSTST ;TEST FOR ABSOLUTE
LSH VAL,^D<36-16>
ASH VAL,-^D<36-16> ;EXTEND SIGN
RETURN
.LOC
RELLVL: BLOCK 1 ;RELOCATION LEVEL
.RELOC
SUBTTL TERM EVALUATOR
TERM: ;TERM PROCESSOR
SETZB VAL,T1 ;RETURN VALUE IN VAL
CALL GETSYM ;TRY FOR SYMBOL
JUMPE SYM,TERM4 ; NOT A SYMBOL
CALL SSRCH ;SEARCH TABLE
JRST TERM2 ; NOT THERE
TERM0: CALL CRFREF ;
TLNE T1,MDFSYM ;MULTIPLY DEFINED?
ERRSET ERR.D ;YES
TLNN T1,DEFSYM!GLBSYM ;UNDEFINED?
ERRSET ERR.U ;YES. NOTE THAT THIS TRAP CAN BE
;ENTERED ONLY WHEN THE DEFAULT GLOBALS ARE DISABLED.
MOVE T3,T1 ;GET EXTRA COPY
TLZ T1,776000-REGSYM ;CLEAR ALL BUT REGISTER BIT
TLNN T3,DEFSYM ;DEFINED?
TLNN T3,GLBSYM ; NO, GLOBAL?
JRST TERM1 ; LOCAL
TLO T1,GLBSYM ;JUST GLOBAL
AOS T4,GLBPNT ;GLOBAL
MOVEM SYM,GLBBUF(T4) ;SAVE NAME
DPB T4,SUBPNT ;SAVE NUMBER IN RELOCATION
TERM1: MOVE VAL,T1 ;RESULT TO VAL
JRST CPOPJ1 ;GOOD EXIT
TERM2: CALL OSRCH ;TRY OP CODES
JRST TERM3 ; NO
CAIE T2,OCOP ;PSEUDO-OP?
JRST TERM3 ; YES
CALL CRFOPR
HRRZ VAL,T1 ;YES, TREAT AS NUMERIC
JRST CPOPJ1 ;GOOD EXIT
TERM3: CALL SSRCH ;NOT YET DEFINED
SKPEDS ED.ABS ;SKIP IF ABSOLUTE ASSEMBLY
TLNE EXF,GBLDIS ;ARE DEFAULT GLOBALS ENABLED?
JRST TERM5 ;NO.
TLO T1,FLTSYM!GLBSYM ;DEFAULT GLOBAL SYMBOL
CALL INSRT
JRST TERM0
TERM4: LDB T2,C5PNTR ;NON-SYMBOLIC
XCT TERMJT(T2) ;EXECUTE TABLE
JRST CPOPJ1 ;GOOD EXIT
TERM5: ;DEFAULT GLOBALS DISALLOWED
CALL INSRT
CALL CRFREF
ERRSET ERR.U ;FLAG THE STATEMENT
JRST CPOPJ1 ;TAKE THE SKIP RETURN
TERMJT: ;TERM JUMP TABLE
PHASE 0
RETURN ;NULL RETURN
TEPL:! CALL TERMPL ; +
TEMI:! CALL TERMMI ; -
TEUA:! CALL TERMUA ; ^
TEAB:! CALL TERMAB ; <>
TESQ:! CALL TERMSQ ; '
TEDQ:! CALL TERMDQ ; "
TEPC:! CALL TERMPC ; %
TENM:! CALL TERMNM ; 0-9
TEHX:! CALL TERMHX ; $
TEOC:! CALL TERMOC ; @
DEPHASE
TERMPL: ; +
CALL GETNB
CALL TERM
ERRSET ERR.A
RETURN
TERMMI: ; -
CALL TERMUC
ADDI VAL,1
TRZ VAL,600000
RETURN
TERMUA: ; ^
CALL GETNB
CAIN CHR,"F"
JRST TERMUF
CAIN CHR,"C"
JRST TERMUC
SETZ T3,
CAIN CHR,"D"
MOVEI T3,^D10
CAIN CHR,"O"
MOVEI T3,^D8
CAIN CHR,"B"
MOVEI T3,^D2
SKIPN T3
ERRXIT ERR.A
SPUSH CRADIX
MOVEM T3,CRADIX
CALL TERMPL
SPOP CRADIX
RETURN
TERMUC: CALL TERMPL
CALL ABSTST
TRC VAL,177777
RETURN
TERMUF: CALL GETNB
MOVEI T3,4
MOVEM T3,FLTLEN
CALL FLTG
TLNE FLG,FLTFLG
ERRSET ERR.A
LDB VAL,[POINT 16,FLTNUM,35]
RETURN
TERMAB: ; <>
CALL GETNB
SPUSH RELLVL
CALL EXPR
ERRSET ERR.A
CAIE CHR,">" ;"<"
ERRSKP ERR.A
CALL GETNB
SPOP RELLVL
RETURN
TERMPC: ; %
MOVE T3,MACHT ;CHECK MACHINE TYPE
CAIE T3,M68 ;FOR 6800
CAIN T3,M65 ; OR 6502
JRST TERMBN ;TREAT % AS BINARY PREFIX
CALL GETNB ;SKIP OVER CHARACTER
CALL TERM ;GET A TERM
ERRSET ERR.R ; INVALID REG
TLZE VAL,(<GLBSYM>B17!377B<SUBOFF>)
ERRSET ERR.R ;ERROR IF GLOBAL OR RELOC
TLO VAL,REGSYM ;SET FLAG
RETURN ;EXIT
TERMNM: ;NUMERIC TERM
SETZB SYM,T1 ;CLEAR ACS
TERMN1: IMULI VAL,^D10 ;DECIMAL ACCUMULATOR
ADDI VAL,-"0"(CHR)
IMUL T1,CRADIX
ADDI T1,-"0"(CHR)
CAIGE SYM,-"0"(CHR) ;HIGHEST NUMBER SO FAR?
MOVEI SYM,-"0"(CHR) ; YES, SAVE IT
GETCHR ;GET THE NEXT CHARACTER
CAIL CHR,"0" ;TEST NUMERIC
CAILE CHR,"9"
CAIA ; NO
JRST TERMN1 ;YES, PROCESS IT
CAIE CHR,"." ;DECIMAL POINT?
JRST TERMN2 ; NO
CALL GETNB ;YES, BYPASS IT
JRST TERMN3 ;SKIP AROUND TEST
TERMN2: CAIN CHR,"$"
JRST TERMN4
CAML SYM,CRADIX ;IN BOUNDS?
ERRSKP ERR.N ; YES, FLAG ERROR AND LEAVE DECIMAL
MOVE VAL,T1 ;NO, MOVE OCTAL IN
TERMN3: TDZE VAL,[-1B19] ;OVERFLOW?
ERRSET ERR.T ; YES, FLAG TRUNCATION ERROR
JRST SETNB
TERMN4: MOVE SYM,VAL
HRL SYM,LSBNUM
TLO SYM,ST.LSB
TLO FLG,LSBFLG
CALL SSRCH
ERRSET ERR.U
MOVE VAL,T1
JRST GETNB
TERMDQ: ; """
GETCHR ;GET THE NEXT NON-TERMINATOR
JUMPE CHR,TERMQE ; END OF LINE, ERROR
LDB VAL,LBP ;LOAD UN-MAPPED CHARACTER
GETCHR ;TRY ONE MORE
JUMPE CHR,TERMQE ; ERROR
LDB CHR,LBP
DPB CHR,[POINT 8,VAL,35-8] ;STORE IN UPPER
JRST GETNB ;RETURN WITH NEXT NON-BLANK
TERMSQ: ; "'"
GETCHR ;GET NON-TERMINATOR
JUMPE CHR,TERMQE ; TERMINATOR, ERROR
LDB VAL,LBP ;LOAD UN-MAPPED CHARACTER
JRST GETNB ;RETURN NON-BLANK
TERMQE: ERRSET ERR.Q ;RAN OUT OF CHARACTERS
RETURN
TERMBN: MOVEI T3,^D2 ;BINARY CONSTANT
TERMOC: MOVEI T3,^D8 ;OCTAL CONSTANT
SPUSH CRADIX
MOVEM T3,CRADIX
CALL TERMPL
SPOP CRADIX
RETURN
TERMHX: SETZ VAL, ;INIT NUMBER
MOVEI T3,4 ;MAX 4 DIGITS
TERMH1: CALL GETNB ;PASS OVER CHAR
JUMPE CHR,TERMH2
CAIL CHR,"0" ;CHECK VALID
CAILE CHR,"F" ;RANGE
JRST TERMH2 ;CHECK TERMINATOR
CAIGE CHR,"A"
CAIG CHR,"9"
SKIPA
JRST TERMH2
CAILE CHR,"9" ;ADJUST ALPHAS
SUBI CHR,"A"-"9"-1
LSH VAL,4 ;SHIFT OVER
ADDI VAL,-"0"(CHR) ;ADD IN CHARACTER
SOJG T3,TERMH1
TERMH2: JUMPE T3,GETNB ;GET NEXT CHAR IF 4 SEEN
RETURN ;ELSE ALREADY HAVE IT
SUBTTL SYMBOL/CHARACTER HANDLERS
GETSYM: ;GET A SYMBOL
MOVEM LBP,SYMBEG ;SAVE START FOR RESCAN
SETZB SYM,T1 ;CLEAR AC AND COUNT
GETSY1: MOVEM LBP,SYMEND ;SAVE END
LDB T2,ANPNTR ;MAP CHARACTER TYPE
XCT GETSYT(T2) ;EXECUTE TABLE
JRST SETNB ; FINISHED, RETURN NEXT NON-BLANK
CAIL T1,6 ;OVERFLOW?
JRST GETSY2 ; YES, DON'T STORE
HLRZ T3,RADTBL-40(CHR) ;MAP CHAR
IMUL T3,RAD50M(T1) ;SKIFT IT
ADD SYM,T3 ;ACCUMULATE
GETSY2: GETCHR ;GET THE NEXT CHAR
AOJA T1,GETSY1 ;TRY FOR MORE
GETSYT: ;GETSYM TABLE
PHASE 0
JFCL ;NON-ALPHA/NUMBERIC
.DOT:! TLNN EXF,MODBIT ;DITTO
.ALP:! CAIA
.NUM:! CALL GETSY3 ;NUMERIC, DOUBLE TEST
DEPHASE
GETSY3: TLNE EXF,MODBIT ;ACCEPT IF IN COMMAND STRING
JUMPE SYM,CPOPJ ; NO, NULL IF FIRST
JRST CPOPJ1
RAD50M: ;RAD50 MULTIPLIERS
XWD 50*50,
XWD 50,
XWD 1,
XWD ,50*50
XWD ,50
XWD ,1
GETLSB: ;GET LOCAL SYMBOL
SETZM SYM
GETLS1: CAIL CHR,"0" ;TEST RANGE
CAILE CHR,"9"
JRST GETLS2 ; OUTSIDE
IMULI SYM,^D10 ;OK, ACCUMULATE NUMBER
ADDI SYM,-"0"(CHR)
GETCHR
JRST GETLS1
GETLS2: JUMPE SYM,GETLS3
CAIE CHR,"$"
JRST GETLS3
CAILE SYM,^D32767 ;NUMBER TOO LARGE?
ERRSET ERR.T ; YES, ERROR
HRL SYM,LSBNUM ;STUFF IN BLOCK NUMBER
TLO SYM,ST.LSB ;FLAG IT
TLO FLG,LSBFLG
JRST GETNB
GETLS3: MOVE LBP,SYMBEG ;MISSED, RESTORE POINTER
SETZM SYM
JRST SETNB
OPDEF GETNB [CALL .]
GETNB: ;GET NON-BLANK CHARACTER
IBP LBP ;INDEX BYTE POINTER
OPDEF SETNB [CALL .]
SETNB: ;SET TO NON-BLANK CHARACTER
SETCHR ;SET CHARACTER IN CHR
CAIE CHR,SPACE ;IF SPACE
CAIN CHR,TAB ; OR TAB;
JRST GETNB ; BYPASS
RETURN ;OTHERWISE EXIT
; OPDEF GETCHR [ILDB CHR,LBP]
OPDEF GETCHR [CALL .]
GETCHR: ;GET THE NEXT CHARACTER
IBP LBP ;INDEX BYTE POINTER
; OPDEF SETCHR [LDB CHR,LBP]
OPDEF SETCHR [CALL .]
SETCHR: ;SET THE CURRENT CHAR IN CHR
LDB CHR,LBP
CAIL CHR,"A"+40
CAILE CHR,"Z"+40
RETURN
SUBI CHR,40
RETURN
.LOC
SYMBEG: BLOCK 1 ;SYMBOL START
SYMEND: BLOCK 1 ;SYMBOL END
.RELOC
SUBTTL ARGUMENT HANDLERS
TGARG: ;TEST FOR GENERAL ARGUMENT
SETZM GTCDEL ;CLEAR DELIMITER
TLNN EXF,MODBIT ;EXEC MODE?
JRST TGARG1 ; YES
CAIE CHR,";" ;EOL?
CAIN CHR,0
RETURN ; YES
SKIPL ARGCNT ;END OF EXPRESSION?
JRST TGARG5 ; NO
HRRZS ARGCNT ;YES, CLEAR FLAG
CAIN CHR,"," ;REQUIRED COMMA SEEN?
JRST TGARG2 ; YES
RETURN ;NO, CONSIDER NULL
TGARG5: SKIPE ARGCNT ;NO, FIRST ARGUMENT?
CAIE CHR,"," ; NO, COMMA TO BYPASS?
JRST TGARG3 ; NO
JRST TGARG2 ;YES
TGARG1: CAIE CHR,":" ;EXEC MODE, ARGUMENT?
RETURN ; NO
TGARG2: CALL GETNB ;YES, BYPASS TERMINATOR
TGARG3: AOS ARGCNT ;INCREMENT ARG COUNT
JRST CPOPJ1 ;GOOD EXIT
GSARG: ;GET SYMBOLIC ARGUMENT
CALL TGARG ;TEST FOR EXISTENCE
RETURN ; NO
GSARGF: CALL GETSYM ;YES, GET SYMBOL
JUMPN SYM,CPOPJ1 ;GOOD EXIT
ERRSET ERR.A ; ERROR
RETURN ;ERROR, BAD EXIT
.LOC
ARGBLK: ;GENERAL ARGUMENT BLOCK
ARGPNT: BLOCK 1 ;POINTER TO PREVIOUS
ARGBEG: BLOCK 1 ;START OF ARG
ARGEND: BLOCK 1 ;END OF ARG
ARGCHC: BLOCK 1 ;CHARACTER COUNT
ARGTXP: BLOCK 1 ;TEXT POINTER
ARGCNT: BLOCK 1 ;ARGUMENT NUMBER COUNT
ARGLEN== .-ARGBLK
.RELOC
GTCHR: ;GET TEXT CHARACTER
SKIPE GTCDEL ;DELIMITER IN PROGRESS?
JRST GTCHR3 ; YES
SKIPE ARGCNT ;NO, FIRST ARG?
CAIE CHR,";" ;NO, EOL?
CAIN CHR,0
RETURN ; YES, TAKE NULL EXIT
CAIE CHR,"<" ;EXPRESSION MODE?
JRST GTCHR2 ; NO
CALL GETNB ;YES, BYPASS CHARACTER
SPUSH SYM ;STACK REGISTERS
SPUSH T1
CALL ABSEXP ;EVALUATE EXPRESSION
SPOP T1
SPOP SYM
CAIE CHR,">" ;GOOD TERMINATION?
ERRSKP ERR.A ; NO
CALL GETNB ;YES, BYPASS IT
GTCHR1: AOS ARGCNT ;BUMP ARG COUNT
JRST CPOPJ1 ;GOOD EXIT
GTCHR2: MOVEM CHR,GTCDEL ;SET DELIMITER
GTCHR3: GETCHR ;GET THE NEXT CHARACTER
CAME CHR,GTCDEL ;TERMINATOR?
JRST GTCHR4 ; NO
SETZM GTCDEL ;YES, CLEAR DELIMITEP
CALL GETNB ;BYPASS DELIMITER
;BLOWUP IF THE LINE IS HENCEFORTH EMPTY
JRST GTCHR ;TRY AGAIN
GTCHR4: LDB VAL,LBP ;GET UN-MAPPED COPY
JUMPN VAL,GTCHR1 ;BRANCH IF NOT EOL
MOVEI 6,";" ;SEE IF LAST DELIMITER WAS A SEMICOLON
CAME Q1,GTCDEL ;WAS IT?
ERRSET ERR.A ;NO, FLAG ERROR
SETZM GTCDEL
RETURN ;NULL EXIT
.LOC ;ARGUMENT STORAGE WORDS
GTCDEL: BLOCK 1 ;ARGUMENT DELIMITER
.RELOC
SUBTTL END OF PASS ROUTINES
ENDP: ;END OF PASS ROUTINES
CALL TSTMAX ;BE SURE TO TRAP MAX PC
LDB T2,CCSPNT
HRRM PC,SECBAS(T2) ;SET HIGH LOCATION
TLNN FLG,P1F ;PASS 1?
JRST ENDP20 ; NO
CALL SETBIN ;SET BINARY (OBJ OR BIN)
RETURN ; AND EXIT
ENDP20: CALL BLKDMP ;END OF PASS 2
MOVEI T2,BKT6 ;ASSUME RELOCATABLE
SKPEDR ED.ABS ;ABSOLUTE?
MOVE T2,ENDVEC ; YES, SET XFER VECTOR
CALL BSWORD ;STORE IT
JRST BLKDMP ;DUMP THE BUFFER AND EXIT
SUBTTL CODE ROLL HANDLERS
SETRLD: ;SET RLD HEADER
MOVE T1,PC
ADD T1,PHAOFF
ANDI T1,177777
HRLI T1,(<RLDT10>B<MODOFF>)
STCODE: ;STOW CODE
SPUSH T3
AOS T3,CODPNT ;INCREMENT INDEX
MOVEM T1,CODBUF-1(T3) ;STORE
SPOP T3
RETURN
PROCOD: ;PROCESS CODE
CALL PROCO1 ;PROCESS ONE WORD
RETURN ; NULL, EXIT
MOVEM SYM,PF0 ;OK, SET PRINT FIELDS
MOVEM T1,PF1
SKPLCR LC.TTM ;EXIT IF TTY
CALL PROCO1
JRST CPOPJ1 ; NULL, BUT GOOD EXIT
MOVEM T1,PF2
CALL PROCO1
JRST CPOPJ1
MOVEM T1,PF3
JRST CPOPJ1
PROCO1: CALL FETCOD ;FETCH AN ENTRY
RETURN ; END
CALL PROWRD ;PROCESS WORD
MOVE SYM,PFT0 ;TRANSFER PRINT STUFF
MOVE T1,PFT1
JRST CPOPJ1
SETPF0: ;SET PRINT FIELD 0
MOVE T3,PC
TLO T3,DEFSYM
MOVEM T3,PF0
RETURN
SETPF1: ;SET PRINT FIELD 1
MOVE T3,VAL
TLO T3,DEFSYM
MOVEM T3,PF1
RETURN
FETCOD: MOVE T3,CODPNT ;FETCH INDEX
SKIPN T1,CODBUF(T3) ;NULL?
RETURN ; YES, EXIT NULL
SETZM CODBUF(T3)
AOS CODPNT ;BUMP POINTER
JRST CPOPJ1
PROWRD: ;PROCESS WORD
LDB T2,MODPNT ;GET CLASS
ANDI T2,177 ;MASK OUT BYTE BIT
MOVE VAL,RLDTBL(T2) ;GET PROPER TABLE ENTRY
MOVE T3,PF0
MOVE T4,PF1
CAIE T2,RLDT7
CAIN T2,RLDT10
JRST PROWR6
MOVE T3,PC ;GET A COPY OF THE PC
TLO T3,DEFSYM ;WITH DEFINED BIT SET
TLNN T1,BC1!BC2 ;CODE TO BE GENNED?
SETZM T3 ; NO, DON'T PRINT LOCATION
MOVE T4,VAL ;FLAGS TO T4
DPB T1,[POINT 36-8,T4,35] ;REMAINDER FROM T1
CAIN T2,RLDT1 ;SPECIAL IF CLASS 1
TLO T4,(1B<SUBOFF>)
PROWR6: MOVEM T3,PFT0
MOVEM T4,PFT1 ;SET TEMP PRINT FIELD 1
PROWR3: LDB T2,[POINT 8,T1,35-8]
TLNE T1,BC2 ;HIGH BYTE?
CALL BYTOUT ; YES, OUTPUT HIGH BYTE
LDB T2,[POINT 8,T1,35]
TLNE T1,BC1!BC2 ;CODE?
CALL BYTOUT ; YES, OUTPUT LOW BYTE
TLNN T1,BC1!BC2 ;CODE?
CALL BLKDMP ; NO, SPECIAL. DUMP THE BUFFER
RETURN
RLDTBL:
PHASE 0
RLDT0:! XWD DEFSYM! 0, 0
RLDT1:! XWD DEFSYM! 1, 4
RLDT2:! XWD 0! 0, 6
RLDT3:! XWD DEFSYM! 1, 4
RLDT4:! XWD 0! 0, 6
RLDT5:! XWD GLBSYM! 1, 10
RLDT6:! XWD GLBSYM! 1, 10
RLDT7:! XWD 0! 1, 10
RLDT10:! XWD DEFSYM! 1, 4
RLDT11:! XWD DEFSYM! 0, 2
RLDT12:! XWD 0! 0, 0
RLDT13:! XWD 0! 0, 0
RLDT14:! XWD 0! 0, 0
RLDT15:! XWD DEFSYM! 1, 10
RLDT16:! XWD DEFSYM! 1, 10
RLDT17:! XWD 0! 0, 0
DEPHASE
.LOC
CODPNT: BLOCK 1 ;CODE ROLL POINTER
CODBUF: BLOCK ^D100 ;CODE ROLL BUFFER
.RELOC
SUBTTL OCTAL OUTPUT ROUTINES
BYTOUT: ;OUTPUT A BYTE OF CODE
TLNN FLG,P1F ;PASS 1
SKPEDR ED.NPP
JRST BYTOU2 ; YES, JUST INCREMENT AND EXIT
SKPEDS ED.ABS
JRST BYTOU1 ; NO
MOVE T3,BYTCNT ;YES GET BYTE COUNT
TLNE FLG,PSWFLG ;PTP OUTPUT?
JRST [CAIGE T3,^D24+2 ;BUFFER FULL?
CAME PC,CURADR
CALL BLKDMP ;DUMP BUFFER
JRST BYTOUA]
CAIGE T3,DATLEN+2 ;OUT OF ROOM?
CAME PC,CURADR ; OR A SEQUENCE BREAK?
CALL BLKDMP ; YES, DUMP THE BUFFER
BYTOUA: SKIPE BYTCNT ;DO WE NEED INITIALIZATION?
JRST BYTOU1 ; NO, STORE IT
SPUSH T2 ;STACK CURRENT CHARACTER
MOVE T2,PC ;GET PC
CALL BSWORD ;STORE IT
MOVEM PC,CURADR ;NEW SEQUENCE BREAK TEST
SPOP T2 ;RETRIEVE BYTE
BYTOU1: CALL BSBYTE ;STORE THE BYTE
AOS CURADR ;UPDATE CURRENT ADDRESS
BYTOU2: MOVEI T3,LC.ME
SKPLCR LC.MB ;SKIP IF WE WANT BINARY
SKPLCS LC.MEB ;MACRO EXPANSION OF BINARY?
ANDCAM T3,LCTST ; YES, DISABLE LC.ME
SKPLCS LC.MB ;BINARY ONLY?
SETLCT LC.MB ;YES - FLAG LISTING TEST
AOJA PC,CPOPJ ;INCREMENT CLC AND EXIT
BSWORD: ;BINARY STORAGE OF WORD
SPUSH T2
CALL BSBYTE ;STORE LOW ORDER
LDB T2,[POINT 8,0(P),35-8] ;FETCH HIGH BYTE
CALL BSBYTE ;STORE IT
SPOP T2 ;RESTORE WORD
RETURN ; AND EXIT
BSBYTE: ;BINARY STORAGE OF BYTE
AOS T3,BYTCNT ;INCREMENT AND FETCH THE BYTE COUNT
MOVEM T2,DATBLK-1(T3) ;STORE CURRENT BYTE IN BUFFER
RETURN
BLKDMP: ;DUMP THE CURRENT BLOCK
SKIPN BYTCNT ;IS IT EMPTY?
JRST BLKINI ; YES, RE-INIT
SPUSH T1 ;GET A COUPLE OF SCRATCH REGISTERS
SPUSH T2
BLKDM1: TLNE FLG,PSWFLG ;PTP MODE?
JRST PTPDMP ;YES - SPECIAL DUMP
MOVEI T2,01 ;BLOCK TYPE ONE
CALL BINOUT ;OUTPUT FLAG WORD
LSH T2,-8
CALL BINOUT
MOVE T2,BYTCNT ;FETCH BYTE COUNT
ADDI T2,4 ;FUDGE FOR HEADER
CALL BINOUT ;OUTPUT IT
LSH T2,-8
CALL BINOUT
HRLZ T1,BYTCNT ;GET BYTE COUNT
MOVNS T1 ;NEGATE BYTE CT
MOVE T2,DATBLK(T1) ;GET AN ITEM FROM THE DATA BLOCK
CALL BINOUT ;DUMP IT
AOBJN T1,.-2 ;RECYCLE IF NOT DONE
MOVN T2,CHKSUM ;GET NEG OF CHECKSUM.
CALL BINOUT ;DUMP IT
SETZ T2, ;FINISHED WITH BLOCK
MOVEI T1,^D6
CALL BINOUT ;DUMP SOME BLANK TAPE
SOJG T1,.-1
SPOP T2 ;RESTORE REGISTERS
SPOP T1
BLKINI: ;CODE BLOCK INITIALIZATION
SETZM BYTCNT ;CLEAR BYTE COUNT
RETURN ;EXIT
;SPECIAL PTP FORMAT OUTPUT FOR KIM-1, 8080, ETC...
;(T1 & T2 ON STACK)
PTPDMP: TLNE EXF,BINBIT ;BINARY ON?
JRST PTPDMX ;NO - EXIT
MOVE T1,DATBLK ;EXCHANGE (CORRECT)
EXCH T1,DATBLK+1 ; ADDRS BYTES
MOVEM T1,DATBLK ;...
MOVE T1,MACHT ;GET MACHINE TYPE
CALL @RECHD(T1) ;DO INIT
JUMPGE T1,PTPDM2 ;DONE IF ZERO
PTPDM1: MOVE T2,0(T1) ;FETCH BYTE
CALL BHXOUT ;DUMP IT
AOBJN T1,PTPDM1 ;LOOP
PTPDM2: MOVE T1,MACHT ;MACHINE TYPE
CALL @GCKSUM(T1) ;OUTPUT CHECKSUM
MOVEI T2,CRR ;ADD CRLF
CALL BCHOUT
MOVEI T2,LF ;...
CALL BCHOUT
MOVEI T1,6
MOVEI T2,0 ;DUMP 6 NULLS
CALL BCHOUT
SOJG T1,.-1
AOS RECCNT ;COUNT # OF RECORDS
PTPDMX: SPOP T2 ;RESTORE REGS
SPOP T1
JRST BLKINI ;RETURN
;MACHINE DEPENDENT RECORD HEADER SETUP
RECHD: M65HED ;6502
M68HED ;6800
M80HED ;8080
M88HED ;8008
M08HED
M18HED
MF8HED
CHKTAB (RECHD)
;CHECKSUM FETCH
GCKSUM: M65CKS ;6502 CHECKSUM
M68CKS ;6800
M80CKS ;8080 CHECKSUM
M88CKS ;8008 CHECKSUM
M08CKS
M18CKS
MF8CKS
CHKTAB (GCKSUM)
;6502 RECORD HEADER ROUTINE
M18HED:
MF8HED:
M68HED:
M65HED: MOVEI T2,";" ;BEGINNING OF RECORD
M80HX: CALL BCHOUT
MOVE T2,BYTCNT ;FETCH BYTE COUNT
SUBI T2,2 ;ADJUST FOR ADDRS
SETZM CHKSUM ;START CHECKSUM NOW
CALL BHXOUT ;DUMP COUNT
HRLZ T1,BYTCNT ;GET BYTE COUNT FOR
MOVNS T1 ;AOBJN PNTR
HRRI T1,DATBLK ;...
RETURN
;8080 RECORD HEADER ROUTINE
M88HED: ;8008 ENTRY
M08HED:
M80HED: MOVEI T2,":" ;RECORD MARK
CALL M80HX ;COMMON CODE
MOVE T2,0(T1) ;OUTPUT ADDRS BYTES
CALL BHXOUT
MOVE T2,1(T1) ;...
CALL BHXOUT
MOVEI T2,0 ;DUMP A ZERO BYTE (REC TYPE CODE)
CALL BHXOUT
ADD T1,[2,,2] ;UPDATE AOBJN PNTR
RETURN ;RETURN
;CHECKSUM ROUTINES
M18CKS:
MF8CKS:
M68CKS:
M65CKS: MOVE T1,CHKSUM ;GET CHECKSUM
MOVE T2,T1 ;COPY TO 2
LSH T2,-^D8 ;HIGH BYTE FIRST
CALL BHXOUT
MOVE T2,T1 ;THEN LOW BYTE
JRST BHXOUT ; AND RETURN
M88CKS: ;8008 ENTRY
M08CKS:
M80CKS: MOVN T2,CHKSUM ;NEGATE
JRST BHXOUT ; AND DUMP ONE BYTE ONLY
.LOC
RECCNT: BLOCK 1 ;COUNT OF RECORDS
CURADR: BLOCK 1 ;SEQUENCE BREAK TEST
CHKSUM: BLOCK 1 ;CHECK SUM
BYTCNT: BLOCK 1 ;BYTE COUNT
DATBLK: BLOCK DATLEN+10 ;ABS BUFFER
.RELOC
SUBTTL INPUT LINE ACCUMULATORS
GETLIN: ;GET THE NEXT SOURCE LINE
SETZM CRRCNT
SETZM LINCHC
SETZM LINTBC ;TAB ORIENTED CHAR COUNT
MOVE LBP,[POINT 7,LINBUF]
GETLI1: CALL CHARLC ;GET AN INPUT CHARACTER
LDB T2,C7PNTR ;GET CHARCTERISTICS
XCT GETLIT(T2) ;EXECUTE TABLE
SKIPE CRRCNT ;OK, ANY IMBEDDED CR'S?
CALL ILCPRO ; YES, ERROR
AOS T3,LINCHC
CAIL T3,CPL
ERRSKP ERR.L
IDPB CHR,LBP
AOS LINTBC ;UPDATE TAB COUNT
JRST GETLI1 ; OK, STORE IT
GETLI2: MOVEI T3,7
IORM T3,LINTBC ;FUDGE TAB COUNT
RETURN
GETLI3: CAIE CHR,CRR ;TERMINATOR, CR?
JRST GETLI5 ; NO, A REAL ONE
SKIPN CRRCNT ;YES, FIRST?
AOSA CRRCNT ; YES, FLAG IT
GETLI4: CALL ILCPRO ; NO, ERROR
JRST GETLI1
GETLI5: CAIN CHR,FF ;FORM FEED?
SKIPE MCACNT
JRST GETLI6 ; NO
SKIPN LINCHC
TLO FLG,FFFLG
AOS FFCNT
AOS ERPNUM ;BUMP ERROR PAGE COUNT
GETLI6: MOVEI CHR,0
IDPB CHR,LBP
MOVEI LBP,LINBUF
HLL LBP,ASCBYT
MOVEM LBP,LINPNT
MOVEM LBP,CLIPNT
SKIPE MCACNT
JRST SETNB
SKIPN MSBMRP ;MACRO EXPANSION?
AOSA CHR ; NO, INCREMENT LINE COUNT
SETLCT LC.ME ; IGNORE MEB FOR NOW
TLNN EXF,SOLBIT ;SEQUENCE OUTPUT LINES?
ADDM CHR,LINNUM ; NO, BUMP
TLNE FLG,ENDFLG ;PERCHANCE END OF FILE?
ERRSET ERR.E ; YES, FLAG "NO END STATEMENT"
LDB T3,CDRPNT
MOVEM T3,CDRCHR
MOVEI T3,0
TLNE EXF,CDRBIT ;/CDR MODE?
DPB T3,CDRPNT ; YES, STUFF A NULL
JRST SETNB ;RETURN WITH FIRST NON-BLANK
GETLC: SKPEDS ED.LC
SUBI CHR,40
RETURN
ILCPRO: ;ILLEGAL CHARACTER PROCESSOR
ERRSET ERR.I ;FLAG ERROR
SKIPN ILCPNT ;FIRST IN THIS LINE?
MOVEM LBP,ILCPNT ; YES
RETURN
GETLIT: ;GETLIN MAP TABLE
PHASE 0
JRST GETLI4
QJNU:! JRST GETLI4 ;ILLEGAL CHARACTER
QJCR:! JRST GETLI3
QJVT:! JRST GETLI3
QJTB:! CALL GETLI2
QJSP:! JFCL
QJPC:! JFCL
QJLC:! CALL GETLC
DEPHASE
GETMLI: ;GET MACRO-TYPE LINE
CALL GETLIN ;GET A STANDARD LINE
CALL GETSYM
TSTMLI: SKIPE SYM
CALL OSRCH
SETZB T1,T2 ; NO
CAIE T2,DIOP ;DIRECTIVE?
TDZA T3,T3 ; NO
LDB T3,SUBPNT ;YES, RETURN WITH FLAGS
RETURN
CDRPNT: POINT 7,LINBUF+^D14,6+7+7 ;POINTER TO COLUMN 73
.LOC
CDRCHR: BLOCK 1 ;/CDR SAVE CHARACTER
LINPNT: BLOCK 1 ;POINTER TO START OF LINE
CLIPNT: BLOCK 2
CLILBL: BLOCK 1
ILCPNT: BLOCK 1 ;ILLEGAL CHARACTER POINTER
FFCNT: BLOCK 1 ;TERMINATION CHARACTER
ERPNUM: BLOCK 1 ;ERROR PAGE NUMBER
ERPBAK: BLOCK 1 ;ONE MESSAGE PER PAGE
CRRCNT: BLOCK 1
LINCHC: BLOCK 1
LINTBC: BLOCK 1
LINBUF: BLOCK CPL/5+2
.RELOC
SUBTTL SYMBOL TABLE LISTING
SYMTB: ;LIST THE SYMBOL TABLE
TLNN EXF,CRFBIT ;CREF SUPPRESSED?
JRST CRFLST ; NO, DO IT
SKPLCR LC.SYM ;HOW ABOUT SYMBOL TABLE?
RETURN ; NO, EXIT
SETZ Q2, ;INITIALIZE POINTER
TLO EXF,HDRBIT ;FLAG NEW PAGE
MOVE T3,[XWD [ASCIZ /SYMBOL TABLE/],STLBUF]
BLT T3,STLBUF+4
SYMTB1: MOVEI Q1,SPLTTY ;SET "SYMBOLS PER LINE"
SKPLCR LC.TTM ;TELETYPE?
MOVEI Q1,SPL ; NO
SYMTB2: CALL GETSTE ;GET THE NEXT SYMBOL TABLE ENTRY
JRST SYMTB3 ; END
TLNE SYM,ST.MAC!ST.LSB
JRST SYMTB2
CALL LSTSTE ;LIST SYMBOL TABLE ENTRY
SOJG Q1,SYMTB2 ;TEST FOR MORE ITEMS ON LINE
CALL LSTCR
JRST SYMTB1 ;START NEW LINE
SYMTB3: MOVE SYM,M40DOT
MOVE T1,PC ;PRINT PC
TLO T1,DEFSYM
CALL LSTSTE
SYMTBF: CALL LSTCR
CALL LSTCR
RETURN
CRFLST:
MOVE SYM,M40DOT
CALL SRCHF
JFCL
MOVE T1,PC
TLO T1,DEFSYM
CALL INSRTF
SETZB SYM,Q2
CALL CRFPUT ;OUTPUT A NULL
CRFL01: CALL GETSTE
JRST CRFL10
TLNE SYM,ST.MAC!ST.LSB
JRST CRFL01
CALL CRFPUT
MOVE SYM,T1
CALL CRFPUT
JRST CRFL01
CRFL10: RELEAS SRC,
MOVE T3,[XWD [ASCIZ /CROSS REFERENCE TABLE/],STLBUF]
BLT T3,STLBUF+6
MOVSI SYM,(1B0)
MOVEM SYM,CRFMIN
SETCAM SYM,CRFMAX
SETOM CRFTMP
CRFL20: CLOSE CRF,
MOVE T3,SYSDEV
MOVEM T3,DEVNAM
DEVSET CRF,10
XWD 0,CRFBUF
MOVEI T3,JOBFFS
MOVEM T3,.JBFF
INBUF CRF,NUMBUF
MOVE T3,CRFBAS
MOVEM T3,.JBFF
MOVE T3,CRFNAM
MOVEM T3,FILNAM
MOVSI T3,(SIXBIT /TMP/)
MOVEM T3,FILEXT
SETZM FILPPN
LOOKUP CRF,FILNAM
HALT .
SETZM LINNUM
SETZM NEXT
CALL SETSYM
CRFL30: CALL CRFGET
JRST CRFL50
JUMPE SYM,CRFL50
TLNE SYM,-1 ;SYMBOL?
JRST CRFL31 ; YES
CAMGE SYM,LINNUM ;NO, VALID LINE NUMBER?
HALT . ; NO
MOVEM SYM,LINNUM ;YES, SET IT
JRST CRFL30
CRFL31: TLC SYM,(1B0)
MOVEM SYM,CRFSAV
TRZ SYM,600000 ;CLEAR FLAGS
CRFL32: CAML SYM,CRFMIN
CAML SYM,CRFMAX
JRST CRFL30
HRRZ T3,.JBFF
ADDI T3,WPB+10
CAMGE T3,SYMBOT
JRST CRFL40
MOVE T3,.JBREL
CORE T3,
HALT .
HLRZ T4,.JBHRL
ADD T4,.JBREL
ASH T4,-^D10
CAILE T3,1(T4)
JRST CRFL40
MOVNI Q2,2
ADD Q2,SYMLEN
CAIG Q2,4
HALT .
MOVE T1,@SYMPNT
MOVEM T1,CRFMAX
MOVE T1,@VALPNT
CALL REMMAC
HRRZ T2,.JBREL
CRFL33: MOVE T3,-4(T2)
MOVEM T3,-2(T2)
SUBI T2,1
SOJGE Q2,CRFL33
MOVEI T2,2
ADDM T2,SYMBOT
CALL SRCHI
CAML SYM,CRFMAX
JRST CRFL30
CRFL40: CALL SRCHF ;SEARCH SYMBOL TABLE
CAIA
JRST CRFL41
CALL GETBLK ;GET A STORAGE BLOCK
HRLI T1,(POINT 18,,35)
MOVEM T1,0(T1) ;STORE TERMINAL
CALL INSRTF
SPUSH T1
JRST CRFL4X
CRFL41: SPUSH T1
MOVE T1,0(T1) ;GET CURRENT POINTER
LDB T2,T1 ;PEEK AT LAST
LDB T3,[POINT 16,T2,35]
CAMN T3,LINNUM ;NEW LINE?
JRST CRFL43 ; YES
CRFL4X: IBP T1 ;NO, BUMP POINTER
SKIPE 0(T1) ;END OF BLOCK?
JRST CRFL42 ; NO
MOVE T2,T1 ;YES, SAVE CURRENT POINTER
CALL GETBLK ;GET ANOTHER BLOCK
HRLI T1,(POINT 18,,17)
HRRZM T1,0(T2) ;SET LINK
CRFL42: MOVE T2,LINNUM ;SET LINE NUMBER
CRFL43: SPOP T3 ;RESTORE VALUE
MOVE SYM,CRFSAV
ANDI SYM,600000 ;ISOLATE FLAGS
IOR T2,SYM ;MERGE INTO VALUE
DPB T2,T1 ;SET IT
MOVEM T1,0(T3) ;STORE NEW POINTER
JRST CRFL30
CRFL50: MOVSI T3,(1B0)
MOVEM T3,CRFSAV
MOVEI Q2,0
CRFL51: CALL GETSTE
JRST CRFL60
SPUSH T1
LDB T2,[POINT 2,SYM,1]
CAME T2,CRFTMP
TLO EXF,HDRBIT
MOVEM T2,CRFTMP
CAIN T2,2
CRFL52: CAMG SYM,CRFSAV
JRST CRFL53
MOVEM SYM,CRFSAV+1
CALL CRFGET
SETOM SYM
TLC SYM,(1B0)
MOVEM SYM,CRFSAV
CALL CRFGET
JFCL
EXCH SYM,CRFSAV+1
JRST CRFL52
CRFL53: CAME SYM,CRFSAV
TDZA T1,T1
MOVE T1,CRFSAV+1
CALL LSTSTQ
SPOP T1
SPUSH 0(T1)
CRFL54: MOVN T3,COLCNT
CAIL T3,8
JRST CRFL55
CALL LSTCR
CALL LSTTAB
MOVE T2,CRFTMP
CAIN T2,2
SKPLCR LC.SYM
JRST CRFL55
CALL LSTTAB
CALL LSTTAB
CRFL55: ILDB Q3,T1
JUMPN Q3,CRFL56
MOVE T1,0(T1)
HRLI T1,(POINT 18,)
JRST CRFL55
CRFL56: ANDI Q3,177777
DNC 5,Q3
LDB Q3,T1
TRNE Q3,400000
LSTICH "#"
TRNE Q3,200000
LSTICH "*"
CALL LSTTAB
CAME T1,0(P)
JRST CRFL54
SPOP 0(P)
CALL LSTCR
JRST CRFL51
CRFL60: HRLOI T3,377777
EXCH T3,CRFMAX
MOVEM T3,CRFMIN
CAME T3,CRFMAX
JRST CRFL20
SETZM FILNAM
RENAME CRF,FILNAM
JFCL
JRST SYMTBF
CRFGET: SOSLE CRFCNT
JRST CRFGE1
INPUT CRF,
STATZ CRF,IOEOF
RETURN
CRFGE1: ILDB SYM,CRFPNT
JRST CPOPJ1
.LOC
CRFNAM: BLOCK 1
CRFTMP: BLOCK 1
CRFMAX: BLOCK 1
CRFMIN: BLOCK 1
CRFSAV: BLOCK 2
.RELOC
LSTSTQ: LDB T2,[POINT 2,SYM,1]
TRC T2,2
SKPLCS LC.SYM
JUMPE T2,LSTSTE
LSTSYM SYM
JRST LSTTAB
LSTSTE: ;LIST SYMBOL TABLE ENTRY
LSTSYM 1,SYM ;LIST IT
MOVEI T2,"="
TLNE T1,LBLSYM
MOVEI T2,SPACE
CALL LSTOUT
MOVEI T2,"%"
TLNN T1,REGSYM ;REGISTER?
MOVEI T2,SPACE ; NO
CALL LSTOUT
LDB VAL,[POINT 16,T1,35]
TLNE T1,DEFSYM
JRST LSTST1
LSTSTR [ASCIZ /******/]
CAIA
LSTST1: CALL LSTWRD
LDB VAL,SUBPNT
MOVEI T2,SPACE
JUMPL Q2,LSTST2
SKIPE VAL
MOVEI T2,"R"
LSTST2: CALL LSTOUT
MOVEI T2,SPACE
JUMPL Q2,LSTST3
TLNN T1,DEFSYM!GLBSYM ;DEFINED SYMBOL?
MOVEI T2,"U" ;NO. NOTE THAT THIS TRAP WILL
;BE ENTERED ONLY WHEN THE DEFAULT
;GLOBALS ARE DISABLED.
CALL LSTOUT
MOVEI T2,SPACE
TLNE T1,GLBSYM
MOVEI T2,"G"
LSTST3: CALL LSTOUT
MOVEI T2,SPACE ;ASSUME NOT DEFAULTED GLOBAL
JUMPL Q2,LSTST4 ;IF LT DON'T CHECK
TLNE T1,FLTSYM ;DEFAULTED GLOBAL?
MOVEI T2,"X" ;YES
LSTST4: CALL LSTOUT ;OUTPUT CHARACTER
CAILE VAL,1
CALL LSTBYT ;OUTPUT SECTION NR WITH 2 LEADING SPACES
JRST LSTTAB
SUBTTL USER SYMBOL TABLE HANDLERS
MSRCH: TLOA SYM,ST.MAC
SSRCH: ;SYMBOL SEARCH
TLZ SYM,ST.MAC
CAMN SYM,M40DOT ;PC?
JRST SSRCH3 ; YES
SRCHF: MOVE Q2,DELTA ;SET OFFSET FOR INDEX
MOVE T2,Q2
ASH T2,-1 ;SET INCREMENT
SSRCH1: CAMGE SYM,@SYMPNT ;ARE WE LOOKING ABOVE SYMBOL?
JRST SSRCH2 ; YES, MOVE DOWN
CAMG SYM,@SYMPNT ;NO, POSSIBLY AT IT?
JRST SSRCH4 ; YES
TDOA Q2,T2 ; NO, INCREMENT INDEX
SSRCH2: SUB Q2,T2 ;DECREMENT INDEX
ASH T2,-1 ;DECREMENT DELTA
CAMG Q2,SYMLEN ;ARE WE OUT OF BOUNDS?
JUMPN T2,SSRCH1 ; NO, BRANCH IF NOT THROUGH
JUMPN T2,SSRCH2 ; YES, MOVE DOWN IF NOT THROUGH
SETZB T1,T2
SOJA Q2,CPOPJ ;NOT FOUND, SET INDEX AND EXIT NORMAL
SSRCH3: MOVE T1,PC
TLOA T1,DEFSYM ;SET PC AS DEFINED
SSRCH4: MOVE T1,@VALPNT ;FOUND, FETCH VALUE
LDB T2,TYPPNT ;SET TYPE POINTER
JRST CPOPJ1 ;EXIT +1
INSRT: ;INSERT ITEM IN SYMBOL TABLE
CAMN SYM,M40DOT ;PC?
JRST INSRT2 ; YES
INSRTF: CAMN SYM,@SYMPNT ;IS IT HERE ALREADY?
JRST INSRT1 ; YES
MOVNI Q1,2 ;NO, PREPARE TI INSERT
ADDB Q1,SYMBOT ;DECREMENT POINTER TO BOTTOM OF TABLE
CAMG Q1,.JBFF ;ARE WE INTRUDING ON THE MACROS?
CALL GETCOR ; YES, GET MORE CORE
MOVE Q1,SYMBOT
HRLI Q1,2(Q1) ;SET UP BLT
BLT Q1,@SYMPNT ;MOVE LOWER SYMBOLS DOWN
CALL SRCHI ;RE-INITIALIZE THE POINTERS
ADDI Q2,2 ;COMPENSATE FOR SHIFT
MOVEM SYM,@SYMPNT ;STORE SYMBOL
INSRT1: MOVEM T1,@VALPNT ;STORE VALUE
RETURN
INSRT2: MOVE PC,T1 ;".", SET PC
AND PC,[PCMASK] ;MAKE SURE ITS CLEAN
RETURN
SRCHI: ;INITIALIZE FOR SEARCH
SPUSH T1 ;STACK WORKING REGISTERS
SPUSH T2
MOVE T1,SYMTOP ;GET THE TOP LOCATION
SUB T1,SYMBOT ;COMPUTE THE DIFFERENCE
MOVEM T1,SYMLEN ;SAVE IT
MOVEI T2,1 ;SET LOW BIT
LSH T2,1 ;SHIFT OVER ONE
TDZ T1,T2 ;CLEAR CORRESPONDING ONE
JUMPN T1,.-2 ;TEST FOR ALL BITS CLEARED
MOVEM T2,DELTA ;END, SAVE LEADING BIT FOR SEARCH OFFSET
MOVE T1,SYMBOT ;GET THE BASE
HRLI T1,(Z (Q2)) ;SET INDEX
MOVEM T1,SYMPNT ;SET SYMBOL POINTER
SUBI T1,1
MOVEM T1,VALPNT ;SET VALUE POINTER
SPOP T2 ;RESTORE REGISTERS
SPOP T1
RETURN ;EXIT
GETSTE: ;GET SYMBOL TABLE ENTRY
ADDI Q2,2 ;MOVE UP TWO
CAML Q2,SYMLEN ;TEST FOR END
RETURN ; YES, EXIT
MOVE SYM,@SYMPNT
MOVE T1,@VALPNT
LDB T2,TYPPNT
JRST CPOPJ1 ;OK, PERFORM SKIP-RETURN
.LOC
SYMPNT: BLOCK 1 ;POINTER TO SYMBOL TABLE MNEMONIC
VALPNT: BLOCK 1 ;POINTER TO SYMBOL TABLE VALUE
SYMLEN: BLOCK 1 ;SYMBOL TABLE LENGTH
DELTA: BLOCK 1 ;BINARY SEARCH OFFSET
.RELOC
SUBTTL CREF HANDLERS
CRFOPD: TLOA FLG,DEFFLG ;CREF OP DEFINITION
CRFOPR: TLZ FLG,DEFFLG ;CREF OP REFERENCE
TLNN EXF,LSTBIT!CRFBIT
TLNE FLG,P1F
RETURN
SPUSH SYM
TLNN SYM,ST.MAC
TLO SYM,ST.MAC!ST.LSB
CALL CRFREX
SPOP SYM
RETURN
CRFDEF: TLOA FLG,DEFFLG
CRFREF: TLZ FLG,DEFFLG
TLNN EXF,LSTBIT!CRFBIT
TLNE FLG,P1F
RETURN
TLNE SYM,ST.MAC!ST.LSB
RETURN
CRFREX: SPUSH SYM
TLNE FLG,DEFFLG
TRO SYM,400000
TLNE FLG,DSTFLG
TRO SYM,200000
EXCH SYM,LINNUM
CAME SYM,CRFSAV
CALL CRFPUT
MOVEM SYM,CRFSAV
EXCH SYM,LINNUM
CALL CRFPUT
SPOP SYM
RETURN
CRFPUT: SOSG CRFCNT
CALL CRFDMP
IDPB SYM,CRFPNT
RETURN
CRFDMP: OUTPUT CRF,
CRFTST: STATZ CRF,IODATA!IODEV!IOWRLK!IOBKTL
FERROR [ASCIZ /CREF OUTPUT ERROR/]
RETURN
SUBTTL MEMORY MANAGEMENT
GETCOR: ;GET CORE
SPUSH SYM ;GET A COULPLE OF WORKING REGISTERS
SPUSH T1
HRRO T1,.JBREL ;GET TOP OF CURRENT CORE
MOVEI SYM,CORINC(T1) ;COMPUTE NEXT K
CORE SYM, ;MAKE A REQUEST
FERROR [ASCIZ /INSUFFICIENT CORE/]
MOVEI SYM,1(T1)
SUB SYM,SYMBOT ;COMPUTE NUMBER OF ITEMS TO BE MOVED
POP T1,CORINC(T1) ;POP ITEM UP ONE K
SOJG SYM,.-1 ;TEST FOR COMPLETION
MOVEI T1,CORINC ;UPDATE POINTERS
ADDM T1,SYMBOT
ADDM T1,SYMPNT
ADDM T1,VALPNT
ADDM T1,SYMTOP
SPOP T1 ;RESTORE REGISTERS
SPOP SYM
RETURN ;EXIT
.LOC
SYMBOT: BLOCK 1 ;SYMBOL TABLE BBASE
SYMTOP: BLOCK 1 ;SYMBOL TABLE TOP
.RELOC
SETSYM: ;SET SYMBOL TABLE
HRRZ T3,.JBREL
MOVEM T3,SYMTOP ;SET TOP OF SYMBOL TABLE
SUBI T3,2
MOVEM T3,SYMBOT ; AND BOTTOM
MOVSI T3,(1B0)
MOVEM T3,@SYMBOT ;SET BOTTOM AND
SETCAM T3,@SYMTOP ; TOP BUMPERS
JRST SRCHI
SUBTTL ENABLE/DISABLE HANDLERS
.ENABL: ; ".ENABL" DIRECTIVE
TLZ FLG,DISBIT ;SET THIS INDICATOR BIT
TDZA T3,T3 ;CLEAR AC3 AND SKIP
.DSABL: MOVEI T3,1 ; ".DSABL" DIRECTIVE
HRLM T3,0(P) ;SAVE FLAG
SKIPE T3 ;WAS IT A DISABLE?
TLO FLG,DISBIT ;YEAH, KLUDGE IT UP SOME MORE
.ENAB1: CALL GETEDT ;ARGS, GET ONE
JRST .ENAB2 ; BRANCH IF NULL
HLRZ T2,0(P) ;GET INDEX
MOVE T3,EDMSK ;SET REGS
TLNN EXF,MODBIT ;COMMAND STRING?
TDOA T3,T1 ; YES, SET MASK AND SKIP
TDNN T3,T1 ;NO, SUPPRESSED?
XCT [EXP <TROA ASM,(T1)>,<TRZA ASM,(T1)>](T2)
SETZM T1
TRO ASM,ED.ABS
MOVEM T3,EDMSK
SKPEDR ED.ABS ;ABS?
TLZ PC,(PFMASK) ; YES, JUST IN CASE
TRNE T1,ED.LSB
CALL .ENAB3
TRNE T1,ED.GBL ;DEALING WITH DEFAULT GLOBALS?
CALL .ENAB4 ;YES
TRNE T1,ED.REG ;DEALING WITH REGISTER DEFAULTS
CALL .ENAB9 ;YES
TLNE EXF,MODBIT
TRNN T1,ED.NPP
CAIA
CALL SETRLD
TRNN T1,ED.ERF
JRST .ENAB1
MOVE LBP,SYMBEG
GETCHR
GETCHR
.ENAB5: GETCHR
MOVSI T3,1
MOVE T4,[POINT 7,ERRMNE]
.ENAB6: LSH T3,-1
ILDB SYM,T4
JUMPE SYM,.ENAB7
CAME SYM,CHR
JRST .ENAB6
XCT [EXP <ANDCAM T3,ERRSUP>, <IORM T3,ERRSUP>](T2)
TLO T2,(1B0)
JRST .ENAB5
.ENAB7: CAMN LBP,SYMEND
JRST .ENAB8
ERRSET ERR.A
ANDCAM FLG,ERRSUP
TLO T2,(1B0)
.ENAB8: MOVEI T3,-1-ERR.P1
TLZN T2,(1B0)
XCT [EXP <ANDCAM T3,ERRSUP>, <IORM T3,ERRSUP>](T2)
MOVE LBP,SYMEND
CALL SETNB
JRST .ENAB1
.ENAB2: HRRM ASM,EDFLGS
SKIPN ARGCNT ;END, ANY ARGS?
ERRSET ERR.A ; NO, ERROR
RETURN
.ENAB3: ;LSB TEST
TLNN EXF,MODBIT ;COMMAND STRING?
ERRSKP ERR.A ; YES, ERROR
JUMPE T2,LSBINC ;NO, NEW BLOCK IF .ENABL
RETURN
.ENAB4: ;DEFAULT GLOBALS
TLNE FLG,DISBIT ;ENABLE DEFAULT GLOBALS?
TLOA EXF,GBLDIS ;NO.
TLZ EXF,GBLDIS ;YES
RETURN
.ENAB9: ;DEFAULT REGISTER STUFF
TLO EXF,REGBIT ;TELL THE WORLD THAT WE WERE HERE.
TLNE FLG,DISBIT ;ENABLE?
JRST .ENABB ;NO. PARDON THE HEX...
.ENABA: ;SET UP DEFAULT REGISTER DEFINITIONS
SPUSH PC ;SAVE AC5 FOR SCRATCH
MOVE PC,MACHT ;GET MACHINE TYPE
SKIPN PC,REGPTR(PC) ;HAVE REGS?
JRST .ENABE ;NO - JUST RETURN
.ENABC: MOVE T1,MACHT ;GET MACHINE TYPE
XCT REGTBL(T1) ;GET REGISTER SYMBOL
CALL SSRCH ;SRCH FOR IT TO SET UP SYMPNT,VALPNT
JFCL ;IT DOESN'T REALLY MATTER IF IT'S HERE OR NOT
TLNE T1,DFLSYM ;WAS IT ALREADY A DEFAULT SYMBOL?
JRST .ENABE ;YES. DON'T CHANGE THEM
MOVEM T1,REGSAV(PC) ;SAVE AWAY THE OLD VALUE
SETZM T1 ;CLEAR WHATEVER WAS THERE BEFORE
TLO T1,REGSYM!DEFSYM!DFLSYM ;SET DEFINITION, REGISTER AND
;DEFAULT BITS
ADDI T1,0(PC) ;GENERATE VALUE
CALL INSRT ;AND PUT IT INTO THE TABLE
AOBJN PC,.ENABC ;LOOP OVER ALL
.ENABE: SPOP PC ;RESTORE AC5.
RETURN ;RETURN
.ENABB: ;DISABLE THE DEFAULT VALUES
SPUSH PC ;GENERATE A SCRATCH REGISTER
MOVE PC,MACHT ;GET MACHINE TYPE
SKIPN PC,REGPTR(PC) ;GET REGISTER POINTER
JRST .ENABF ;EXIT IF NO REGS
.ENABD: MOVE T1,MACHT ;LOAD MACHINE TYPE CODE
XCT REGTBL(T1) ;GET T1BOL
CALL SSRCH ;FIND IT
JFCL ;DOESN'T MATTER...
TLNN T1,DFLSYM ;IS IT ALREADY A NON-DEFAULT?
JRST .ENABF ;YES. DON'T FUTZ AROUND.
MOVE T1,REGSAV(PC) ;RESTORE THE OLD VALUE
CALL INSRT ;AND STUFF IT BACK IN
AOBJN PC,.ENABD ;LOOP OVER ALL
.ENABF: SPOP PC ;RESTORE AC5
RETURN ;AND RETURN
.LOC
NREGS==^D16 ;MAX NUMBER OF REGS
REGSAV: BLOCK NREGS ;AREA TO STORE REGISTER DEFINITIONS
;WHILE DEFAULTS ARE ENABLED
.RELOC
;TABLES FOR REGISTER SETTING , INDEXED BY MACHINE TYPE
REGPTR: 0 ;6502
0 ;6800
-^D12,,0 ;8080/Z80
-^D8,,0 ;8008
-^D8,,0
-^D16,,0 ;1802
0 ;F8
CHKTAB (REGPTR)
REGTBL: 0 ;6502
0 ;6800
MOVE SYM,REGM80(PC) ;8080/Z80
MOVE SYM,REGM88(PC) ;8008
MOVE SYM,REGM08(PC)
MOVE SYM,REGM18(PC) ;1802
0 ;F8
CHKTAB (REGTBL)
GETEDT: ;GET ED TYPE
CALL GSARG ;TRY FOR ARGUMENT
RETURN ; MISSED
HLLZS SYM
MOVSI T3,-<EDTBLE-EDTBL> ;SET FOR SEARCH
CAME SYM,EDTBL(T3) ;MATCH?
AOBJN T3,.-1 ; NO
SETZM T1
SKIPL T3 ;FOUND?
ERRSKP ERR.A ; NO, ERROR
MOVEI T1,1 ;YES, SET FLAG
LSH T1,0(T3) ;COMPUTE BIT POSITION
JRST CPOPJ1
DEFINE EDTGEN (SYM)
<
ED.'SYM== 1_.
GENM40 <SYM>
>
EDTBL:
PHASE 0
EDTGEN <LSB>
EDTGEN <FPT>
EDTGEN <ABS>
EDTGEN <COM>
EDTGEN <NPP>
EDTGEN <ERF>
EDTGEN <AMA>
EDTGEN <PIC>
EDTGEN <TIM>
EDTGEN <LC>
EDTGEN <WRP>
EDTGEN <GBL>
EDTGEN <REG>
EDTGEN <Z80>
EDTGEN <M85>
DEPHASE
EDTBLE:
.LOC
EDBLK:
EDFLGS: BLOCK 1 ;FLAGS
EDMSK: BLOCK 1 ;MASK
EDLVL: BLOCK 1 ;LISTING LEVEL
ERRSUP: BLOCK 1
EDLEN== .-EDBLK
EDSAVE: BLOCK EDLEN ;STORAGE FOR ABOVE
.RELOC
SUBTTL LOCAL SYMBOL HANDLERS
LSBTST: SKPEDR ED.LSB
RETURN
TLNE FLG,LSBFLG
LSBINC: ;LOCAL SYMBOL BLOCK INCREMENT
AOS LSBNUM ;INCREMENT BLOCK NUMBER
MOVEI T3,LSRNGE-1
ADD T3,PC
MOVEM T3,LSBMAX ;SET MAX RANGE
MOVEI T3,^D64-1
MOVEM T3,LSBGEN ;PRESET GENERATED SYMBOL NUMBER
TLZ FLG,LSBFLG
RETURN
.LOC
LSBNUM: BLOCK 1
LSBGEN: BLOCK 1
LSBMAX: BLOCK 1 ;MAX RANGE
.RELOC
SUBTTL LISTING CONTROL
.LIST: TDZA T3,T3 ; ".LIST" DIRECTIVE
.NLIST: MOVEI T3,1 ; ".NLIST" DIRECTIVE
HRLM T3,0(P) ;SAVE FLAG
.LIST1: CALL GETLCT ;ARGS, GET ONE
JRST .LIST2 ; BRANCH IF NULL
HLRZ T2,0(P) ;GET INDEX
MOVE T3,LCMSK ;SET REGS
TLNN EXF,MODBIT ;COMMAND STRING?
TDOA T3,T1 ; YES, SET MASK AND SKIP
TDNN T3,T1 ;NO, SUPPRESSED?
XCT [EXP <TLZA ASM,(T1)>,<TLOA ASM,(T1)>](T2)
SETZM T1
MOVEM T3,LCMSK
JRST .LIST1
.LIST2: SKIPE ARGCNT ;END, ANY ARGS?
JRST LPTINF
HLRZ T2,0(P) ;SET INDEX
TLNE EXF,MODBIT ;COMMAND STRING?
JRST .LIST3 ; NO
SETOM T3
XCT [EXP <HRRZM T3,LCLVL>, <HLLZM T3,LCLVL>](T2)
RETURN
.LIST3: XCT [EXP <AOS LCLVL>,<SOS LCLVL>](T2)
.LIST4: SKPLCR LC.LD ;LISTING DIRECTIVE SUPPRESSED?
SETOM LCLVLB ; YES, FLAG IT
RETURN
SETLC0: ;"SETLCT" OPDEF
EXCH T3,LCTST ;FETCH TEST WORD
TRO T3,@.JBUUO ;SET BIT(S)
EXCH T3,LCTST ;RESTORE
RETURN
.PAGE:
HRROS FFCNT
JRST .LIST4
GETLCT: ;GET LC TYPE
CALL GSARG ;TRY FOR ARGUMENT
RETURN ; MISSED
MOVSI T3,-<LCTBLE-LCTBL> ;SET FOR SEARCH
CAME SYM,LCTBL(T3) ;MATCH?
AOBJN T3,.-1 ; NO
SETZM T1
SKIPL T3 ;FOUND?
ERRSKP ERR.A ; NO, ERROR
MOVEI T1,1 ;YES, SET FLAG
LSH T1,0(T3) ;COMPUTE BIT POSITION
JRST CPOPJ1
DEFINE LCTGEN (SYM)
<
LC.'SYM== 1_.
GENM40 <SYM>
>
LCTBL:
PHASE 0
LCTGEN <SEQ>
LCTGEN <LOC>
LCTGEN <BIN>
LCTGEN <SRC>
LCTGEN <COM>
LCTGEN <BEX>
LCTGEN <MD>
LCTGEN <MB>
LCTGEN <MC>
LCTGEN <ME>
LCTGEN <MEB>
LCTGEN <CND>
LCTGEN <LD>
LCTGEN <TTM>
LCTGEN <TOC>
LCTGEN <SYM>
DEPHASE
LCTBLE:
.LOC
LCBLK:
LCFLGS: BLOCK 1 ;FLAGS
LCMSK: BLOCK 1 ;MASK
LCLVL: BLOCK 1 ;LISTING LEVEL
LCLEN== .-LCBLK
LCSAVE: BLOCK LCLEN ;STORAGE FOR ABOVE
LCTST: BLOCK 1 ;TEST WORD
LCLVLB: BLOCK 1
.RELOC
SUBTTL CONDITIONALS
.IIF: ;IMMEDIATE IF
CALL CNDSET
CALL TCON ;TEST ARGS
JRST .IIF1 ;FALSE
MOVE T2,LBP ;FETCH CHARACACTER POINTER
CAIN CHR,"," ;SITTING ON COMMA?
IBP T2 ; YES, MOVE ONE CHAR PAST
CALL TGARG ;TEST FOR ARG
JRST OPCERR ; MISSING, ERROR
SKIPE T3,CLILBL
ERRSET ERR.Q
SKPLCR LC.CND
MOVEM T2,CLIPNT ;SAVE NEW START
JRST STMNT
.IIF1: TLO FLG,NQEFLG ;UNSAT, IGNORE REST OF LINE
JRST .ENDCX
.IFZ:
.IFEQ:
.IFNZ:
.IFNE:
.IFG:
.IFGT:
.IFL:
.IFLT:
.IFGE:
.IFLE:
.IFDF:
.IFNDF:
CALL CNDSET ;TEST LABEL
HRLZS SYM ;LEFT JUSTIFY ARGUMENT
SKIPE CNDWRD ;SUPPRESSED?
TLOA FLG,NQEFLG ; YES, BUMP LEVEL BUT IGNORE
CALL TCONF ;NO, PROCESS ARGUMENT
JRST CNDXF ; FALSE
JRST CNDXT ;TRUE
.IF: ;".IF" DIRECTIVE
CALL CNDSET
SKIPE CNDWRD ;SUPPRESSED?
TLOA FLG,NQEFLG ; YES, BUMP LEVEL BUT IGNORE
CALL TCON ;TEST
CNDXF: SKIPA T3,[-1] ;FALSE
CNDXT: SETZM T3
MOVE T4,CNDMSK
LSHC T3,-1 ;SET HIGH ORDER BIT OF MASK
MOVEM T4,CNDMSK
MOVE T4,CNDWRD
LSHC T3,-1 ;DITTO FOR TEST WORD
MOVEM T4,CNDWRD
AOS VAL,CNDLVL ;BUMP LEVEL
JRST .ENDCF
.IFT: SKIPA T3,CNDMSK ;".IFT"
.IFF: SETCM T3,CNDMSK ;".IFF"
CAIA
.IFTF: SETZM T3
HLLM T3,0(P) ;PROTECT IT
CALL CNDSET ;TEST FOR LABEL
LDB T3,[POINT 1,0(P),0] ;GET SIGN BIT
DPB T3,[POINT 1,CNDWRD,0]
JRST .ENDCX
.ENDC: ;".ENDC" DIRECTIVE
SKIPG CNDLVL ;IN CONDITIONAL?
JRST OPCERR ; NO
MOVE T3,CNDMSK
LSH T3,1 ;MOVE MASK BITS DOWN
MOVEM T3,CNDMSK
MOVE T3,CNDWRD
LSH T3,1 ;DITTO FOR TEST WORD
MOVEM T3,CNDWRD
SOS VAL,CNDLVL
.ENDCF: HRLI VAL,1 ;PRINT BYTE
CALL SETPF1
.ENDCX: SKIPG LCLVL
SKPLCS LC.CND
RETURN
SKIPN T3,CLILBL
SETLCT LC.CND
MOVEM T3,CLIPNT+1
RETURN
CNDSET: ;SET PRIOR CONDITIONS
SKPLCR LC.CND ;CONDITIONAL SUPPRESSION?
SKIPE CNDWRD ;SKIP IF IN SAT MODE
SETZM CLILBL
RETURN ;NO
TCON: ;TEST CONDITIONAL
CALL GSARG ;TEST FOR ARGUMENTS
JRST TCON2 ; NO, ERROR
TCONF: SETZM CNDREQ ;CLEAR "REQUEST"
SETZM CNDRES ; AND RESULT
MOVSI T1,-<TCONTE-TCONT> ;SET FOR SCAN
TCON1: HLLZ T2,TCONT(T1) ;TRY LEFT HALF
CAMN SYM,T2 ;MAKE IT?
JRST TCON4 ; YES
HRLZ T2,TCONT(T1) ;NO, TRY RIGHT HALF
CAMN SYM,T2
JRST TCON3
AOBJN T1,.+1
AOBJN T1,TCON1 ;LOOP IF NOT END
TCON2: ERRSET ERR.A ;NO MATCH, ERROR
RETURN
TCON3: SETOM CNDREQ ;RIGHT HALF, "FALSE"
TCON4: MOVE T2,TCONT+1(T1) ;FOUND, GET ADDRESS
HLLZM T2,CNDINS ;SAVE POSSIBLE INSTRUCTION
CALL 0(T2) ;CALL HANDLER
MOVE T3,CNDREQ ;GET REQUEST
CAMN T3,CNDRES ;MATCH?
AOS 0(P) ; YES, SKIP-RETURN
RETURN
DEFINE GTCON (SYM,ADDR)
<
GENM40 <SYM>
ADDR
>
TCONT:
GTCON <EQ NE >,<CAIE VAL,TCONA>
GTCON <Z NZ >,<CAIE VAL,TCONA>
GTCON <GT LE >,<CAIG VAL,TCONA>
GTCON <G LE >,<CAIG VAL,TCONA>
GTCON <LT GE >,<CAIL VAL,TCONA>
GTCON <L GE >,<CAIL VAL,TCONA>
GTCON <P1 P2 >,<Z TCONP>
GTCON <DF NDF>,<Z TCONS>
GTCON <B NB >,<Z TCONB>
GTCON <IDNDIF>,<Z TCOND>
GTCON <LI NL >,<Z TCONL>
GTCON <EN DS >,<Z TCONED>
TCONTE:
TCONA: ;ARITHMETIC CONDITIONALS
CALL TGARG ;TEST FOR ARGUMENT
ERRSET ERR.A ; NULL, ERROR
CALL ABSEXP ;EVALUATE THE EXPRESSION
HRROS ARGCNT
LSH VAL,+^D<36-16>
ASH VAL,-^D<36-16> ;EXTEND SIGN
XCT CNDINS ;EXECUTE INSTRUCTION
SETOM CNDRES ; FALSE
RETURN
TCONS: ;TEST SYMBOLIC CONDITIONALS
CALL TGARG ;TEST FOR ANOTHER ARG
ERRSET ERR.A ; NO, ERROR
MOVE T1,CNDREQ
MOVEM T1,CNDRES
SPUSH CNDREQ
TCONS1: CALL GETSYM
SKIPN SYM
ERRSKP ERR.A
CALL SSRCH ;SEARCH THE SYMBOL TABLE
SETZ T1, ; NOT THERE OR GETSYM ERROR
SKIPE SYM
CALL CRFREF
TLNE T1,MDFSYM
ERRSET ERR.D ;FLAG IF MULTI-DEFINED SYM
TLNE T1,DEFSYM ;FLAGGED AS DEFINED?
TDZA T1,T1
SETOM T1
SPOP SYM
CAME T1,CNDRES
SETCAM SYM,CNDRES
MOVE T1,CNDREQ
CAIN CHR,"&"
JRST TCONS2
CAIE CHR,"!"
RETURN
SETCA T1,
TCONS2: SPUSH T1
CALL GETNB
JRST TCONS1
TCONB: ;.IFB, .IFNB
CALL TGARG
RETURN ; NO ARG, OK
CALL GGARG
CALL SETNB ;BYPASS ALL BLANKS
CAIE CHR,0
SETOM CNDRES
JRST PGARG
TCOND:
CALL TGARG
ERRSET ERR.A
CALL GGARG
SPUSH ARGBEG
HRRZ Q1,ARGCHC ;PICK UP CHARACTER COUNT
JUMPE Q1,TCOND2 ;JUMP IF ARGUMENT IS NON-NULL
MOVE SYM,CHR
GETCHR
JUMPN CHR,.-2
TCOND2: GETNB
CALL TGARG
ERRSET ERR.A
CALL GGARG
SPOP SYM
TCOND1: SETCHR
IBP LBP
MOVE T2,CHR
EXCH SYM,LBP
SETCHR
IBP LBP
EXCH SYM,LBP
CAME T2,CHR
SOSA CNDRES ;MISSED
JUMPN CHR,TCOND1
CALL PGARG
SPUSH LBP ;END OF SECOND ARGUMENT
CALL PGARG ;RESTORE FIRST ARGUMENT
SPOP LBP
JRST SETCHR ;SET FINAL CHARACTER
TCONL:
CALL GETLCT
JRST TCONL1
SKPLCR 0(T1)
SETOM CNDRES
RETURN
TCONL1: SKIPGE LCLVL
SETOM CNDRES
RETURN
TCONED:
CALL GETEDT
JFCL
SKPEDS 0(T1)
SETOM CNDRES
RETURN
TCONP: TLNN FLG,P1F ;PASS 1?
SETOM CNDRES ;NO - PASS 2
RETURN
.LOC
CNDMSK: BLOCK 1 ;MASK BITS SET BY .IF
CNDWRD: BLOCK 1 ;CNDMSK, ADJUSTED FOR .IFT, ETC.
CNDLVL: BLOCK 1 ;CONDITIONAL LEVEL COUNT
CNDREQ: BLOCK 1 ;CONDITIONAL "REQUEST" TYPE
CNDRES: BLOCK 1 ;RESULT
CNDINS: BLOCK 1 ;STORAGE FOR INSTRUCTION
CNDMEX: BLOCK 1 ;MEXIT IN PROGRESS
.RELOC
SUBTTL MACRO STORAGE HANDLERS
GETBLK: ;GET A BLOCK FOR MACRO STORAGE
SKIPE T1,NEXT ;ANY REMNANTS OF GARBAGE COLLECTION?
JRST GETBL1 ; YES, RE-USE
MOVEI T1,WPB
ADDB T1,.JBFF ;UPDATE FREE LOCATION POINTER
CAML T1,SYMBOT ;ANY ROOM?
CALL GETCOR ; NO, GET MORE CORE
SUBI T1,WPB ;POINT TO START OF BLOCK
SETZM WPB-1(T1) ;CLEAR VECTOR
GETBL1: HLL T1,TXTBYT ;FORM BYTE POINTER
MOVEM T1,MWPNTR ;SET NEW BYTE POINTER
HRLI T1,-<WPB-1> ;GET SET TO INITIALIZE BLOCK
SETOM 0(T1) ;CLEAR ENTRY
AOBJN T1,.-1 ;SET ALL EXCEPT LAST TO -1
PUSH P,0(T1) ;GET TOP
POP P,NEXT ;SET FOR NEXT BLOCK
SETZM 0(T1) ;CLEAR LAST WORD
MOVE T1,MWPNTR ;RETURN POINTER IN T1
RETURN ;EXIT
TXTBYT: POINT 8,,7
ASCBYT: POINT 7,,6
INCMAC: ;INCREMENT MACRO STORAGE
AOSA 0(T1)
DECMAC: ;DECREMENT MACRO STORAGE
SOSL 0(T1) ;TEST FOR END
RETURN ; NO, EXIT
REMMAC: ;REMOVE MACRO STORAGE
SPUSH T1 ;SAVE POINTER
REMMA1: HRLS T1 ;SAVE CURRENT POINTER
HRR T1,WPB-1(T1) ;GET NEXT LINK
TRNE T1,-1 ;TEST FOR END (NULL)
JRST REMMA1 ; NO
HLRZS T1 ;YES, GET RETURN POINTER
HRL T1,NEXT ;GET CURRENT START OF CHAIN
HLRM T1,WPB-1(T1) ;STORE AT TOP
SPOP T1 ;RESTORE BORROWED REGISTER
HRRZM T1,NEXT ;SET NEW START
RETURN ;EXIT
.LOC
NEXT: BLOCK 1 ;BLOCK CHAIN POINTER
MWPNTR: BLOCK 1 ;MACRO WRITE POINTER
.RELOC
SUBTTL REPEAT/MACRO ROUTINES
CF.SPC== 200 ;HIGH ORDER BIT INVOKES SPECIAL MODE
CF.DSY== 100 ;DUMMY SYMBOL
CF.TRP== 040 ;FLAGS END OF PROTOTYPE
CF.ARG== 020 ;TRAPPED AT READMC/SETASC
CH.MAC== CF.SPC!CF.TRP!T.MACR ;END OF MACRO
CH.RPT== CF.SPC!CF.TRP!T.REPT ;END OF REPEAT
CH.IRP== CF.SPC!CF.TRP!T.IRP ;END OF IRP
CH.EOE== CF.SPC!CF.ARG!1 ;END OF ENTRY
CH.FIN== CF.SPC!CF.ARG!2 ;IRP ARG DELIMITER
; THIS MACRO PUSHES THE ITERATION COUNT FOR REPEAT BLOCKS ONTO A PSEUDO-STACK CALLED REPBLK.
;THE POINTER IS CALLED REPCT. THE COUNT IS ASSUMED TO BE IN REGISTER 'REG'.
DEFINE RCTPSH (REG)
<
AOS REPCT ;PUSH THE POINTER
MOVEM REG,@REPCT ;STACK THE COUNT
AOS @REPCT ;COMPENSATE FOR THE XTRA ENDM THAT WILL BE SEEN
SETOM REPSW ;TELL EVERYBODY WE'RE IN A REPEAT BLOCK
>
.REPT: ;.REPT DIRECTIVE
CALL ABSEXP ;EVALUATE ABSOLUTE EXPRESSION
TRNE VAL,1B20 ;NEGATIVE?
SETZM VAL ; YES, SET TO ZERO
RCTPSH VAL ;PUSH THE COUNT
SPUSH VAL ;SAVE
PUSH P,[0] ;TO KEEP .RIF HAPPY
.REPTF: CALL GETBLK ;GET STORAGE
PUSH P,MWPNTR ;SAVE STARTING LOCATION
SETZM @MWPNTR ;CLEAR LEVEL COUNT
AOS MWPNTR ;START IN NEXT WORD
SETZM @MWPNTR ;CLEAR SECOND WORD
AOS MWPNTR
CALL TMCLBL
SETLCT LC.MD!LC.MC ;FLAG AS CALL
SETZM MACCNT ;INIT ARG COUNT
.REPT1: CALL ENDL
CALL GETMLI ;GET A LINE
SETLCT LC.MD!LC.MC ;FLAG FOR LISTING
CAIN T3,DCRPT
AOS MACCNT
CAIN T3,DCRPTE
SOSL MACCNT ;TEST FOR END
TLNE FLG,ENDFLG ;OR END OF INPUT
JRST .REPT2 ; YES
MOVE LBP,LINPNT
SETCHR
CAIA
GETCHR ;STORE LINE
WCIMT 0(CHR)
JUMPN CHR,.-2 ;TEST FOR EOL
JRST .REPT1
.REPT2: MOVEI CHR,CH.RPT
.REPTX: WCIMT 0(CHR) ;MARK END OF STORAGE
CALL MPUSH ;STACK
POP P,MSBTXP ;SET TEXT POINTER
POP P,MSBAUX ; AND .RIF EXPRESSION
POP P,MSBCNT ; AND COUNT
HRLZS MSBCNT ;MOVE COUNT TO LEFT HALF
JRST MPOP ;TEST FOR END
ENDRPT: ;END OF REPEAT
ENDIRP: AOS T3,MSBCNT ;BUMP COUNT, PLACE IN REG
HLRZ T4,T3 ;GET END VALUE
CAIGE T4,0(T3) ;FINISHED?
JRST CPOPJ1 ; YES
MOVE T3,MSBTXP ;NO, SET READ POINTER
ADDI T3,2
MOVEM T3,MSBMRP
RETURN
.ENDM:
.ENDR: JRST OPCERR ;CAN'T OCCUR OUTSIDE OF DEFINITION
.IRP: TDZA T3,T3 ;".IRP", CLEAR FLAG
.IRPC: MOVEI T3,1 ;".IRPC", SET FLAG
ADDI T3,1
MOVEM T3,IRPTYP ;STORE IT
CALL TGARG ;TEST FOR GENERAL ARGUMENT
JRST OPCERR ; MISSING, ERROR
CALL GGARG ;PROCESS THE ARGUMENT
SETZM ARGCNT
CALL PROMA ;PROCESS DUMMY ARGS
CALL PGARG
SETZM IRPCNT
SETZM IRPMAX
CALL GETBLK
MOVEM T1,IRPBEG ;SAVE START
.IRP1: AOS T3,IRPCNT ;BUMP COUNT
HRRZ T4,MACCNT ;GET ARGUMENT COUNT
CAMLE T3,T4 ;THROUGH?
JRST .IRP2 ; YES
CALL TGARG
JFCL
CALL GGARG
CALL MCFINF
WCIMT CH.FIN
HRRZ T3,ARGCNT
CAMLE T3,IRPMAX
MOVEM T3,IRPMAX
CALL PGARG
JRST .IRP1
.IRP2: WCIMT CH.FIN
EXCH ASM,IRPMAX ;GET THE ITERATION COUNT WHERE WE CAN USE IT AND.....
RCTPSH ASM ;PUSH IT ONTO THE 'STACK'
EXCH ASM,IRPMAX ;NOW PUT THINGS BACK WHERE THEY BELONG.
SPUSH IRPMAX
SPUSH IRPBEG
CALL TMCLBL
SETLCT LC.MD!LC.MC
CALL ENDL ;POLISH OFF LINE
CALL GETBLK
SPUSH MWPNTR
CALL PROMT ;PROCESS TEXT
SETLCT LC.MD!LC.MC ;ARGUMENT
MOVEI CHR,CH.IRP ;MARK AS .IRP
JRST .REPTX ;EXIT THROUGH .REPT
.MACR: ;.MACR DIRECTIVE
.MACRO:
CALL GSARG ;GET THE NAME
JRST OPCERR
MACROF: MOVEM SYM,MACNAM ;SAVE NAME
CALL MSRCH
MOVSI T1,MAOP ;RETURN POINT IF NAME NOT FOUND
LDB T2,TYPPNT ;ISOLATE TYPE
CAIE T2,MAOP ;MACRO?
JRST OPCERR ; NO, ERROR
TRNE T1,-1
CALL DECMAC
HLLM T1,0(P) ;SAVE FLAGS, ETC.
CALL GETBLK
HLL T1,0(P) ;RESTORE FLAGS
CALL INSRT
CALL CRFOPD
CALL PROMA ;PROCESS MACRO ARGUMENTS
CALL TMCLBL
SETLCT LC.MD
CALL ENDL ;WRITE OUT THE LINE
CALL PROMT ;PROCESS MACRO TEXT
SETLCT LC.MD ; ARGUMENT
WCIMT CH.MAC ;FLAG END
CALL GSARG ;ARGUMENT?
RETURN ; NO
CAME SYM,MACNAM ;YES, DOES IT MATCH NAME?
ERRSET ERR.A ; NO, ERROR
RETURN
PROMA: ;PROCESS MACRO ARGUMENTS
SETZM DSYLST ;MARK END OF LIST
SETZM MACCNT ;ZERO NUMBER
PROMA1: CALL TGARG ;TEST FOR ARGUMENT
RETURN ; NO
CAIE CHR,"?" ;YES, PERHAPS GENERATION?
JRST PROMA2 ;NO
MOVN T3,MACCNT ;YES, GET COUNT
MOVSI T4,(1B0)
LSH T4,0(T3) ;SHIFT BIT
IORM T4,MACCNT ;SAVE IT
CALL GETNB ;BYPASS UNARY
PROMA2: CALL GSARGF ;GET THE ARGUMENT
RETURN ; ERROR
AOS T3,MACCNT ;OK, BUMP COUNT
MOVEM SYM,DSYLST-1(T3) ;STORE MNEMONIC
SETZM DSYLST(T3)
JRST PROMA1 ;TRY FOR MORE
TMCLBL: MOVE T3,@0(P)
SKPLCR (T3)
SKIPN T3,CLILBL
RETURN
MOVEM T3,CLIPNT+1
JRST CPOPJ1
PROMT: ;PROCESS MACRO TEXT
SETZB T3,@MWPNTR ;CLEAR LEVEL COUNT
AOS MWPNTR
EXCH T3,MACCNT ;SET AND CLEAR COUNT
MOVEM T3,@MWPNTR
AOS MWPNTR
PROMT1: CALL GETMLI ;PUTS THE TYPE BITS IN AC3
XCT @0(P) ;EXECUTE ARGUMENT
CAIN T3,DCMAC ;MACRO/RPT TYPE INSTRUCTION?
AOS MACCNT ;YES
CAIN T3,DCMACE ;END?
SOSL MACCNT ;YES
TLNE FLG,ENDFLG ;END ENCOUNTERED?
JRST CPOPJ1 ;YES. RETURN AND BYPASS ARGUMENT
CAIN T3,DCMCAL ;".MCALL"?
SKIPN MCACNT ; YES, NESTED?
CAIA ; NO
CALL MCALLT ;YES, TEST FOR ADDITIONS
MOVE LBP,LINPNT
SETCHR
PROMT2: CALL GETSYM
JUMPE SYM,PROMT4
SETZM T2
PROMT3: SKIPN T3,DSYLST(T2)
JRST PROMT4
CAME T3,SYM
AOJA T2,PROMT3
SOS CONCNT
WCIMT CF.SPC!CF.DSY+1(T2)
SOS CONCNT
SKIPA LBP,SYMEND
PROMT4: MOVE LBP,SYMBEG
SETCHR
PROMT5: CAMN LBP,SYMEND
JRST PROMT6
WCIMT 0(CHR)
GETCHR
JRST PROMT5
PROMT6: JUMPE CHR,PROMT8
SKPEDR ED.COM
CAIE CHR,";"
JRST PROMT7
GETCHR
CAIN CHR,";"
JRST PROMT8
WCIMT ";"
JRST PROMT2
PROMT7: CAIN CHR,"'"
AOSA CONCNT
WCIMT 0(CHR)
GETCHR
JRST PROMT2
PROMT8: WCIMT 0
SKIPE ARGEND
HALT .
SETCHR
SKIPGE MACCNT
JRST GETSYM
CALL ENDL
JRST PROMT1
MACROC: ;MACRO CALL
CALL SETPF0
TRNN T1,-1 ;EMPTY?
JRST OPCERR ;OP VALUE = 0?
SPUSH T1 ;STACK ADDRESS
MOVE T3,1(T1)
MOVEM T3,MACCNT ;SET COUNT
CALL INCMAC
CALL GETBLK
SPUSH MWPNTR ;STACK START ADDRESS
CALL MCFIN
WCIMT CH.FIN ;PAD ANY MISSING ARGUMENTS
MOVEI CHR,CH.MAC
CALL MPUSH
POP P,MSBAUX
SPOP T1
HLL T1,TXTBYT
MOVEM T1,MSBTXP
ADDI T1,2
MOVEM T1,MSBMRP
MOVE T3,ARGCNT
HRLZM T3,MSBCNT ;SET FOR ".NARG"
CALL TMCLBL
SETLCT LC.MC
RETURN
MCFIN: SETZM IRPTYP
MCFINF: SETZM ARGCNT
SETZM ARGINC
MCFIN1: MOVE T3,IRPTYP
CALL @[EXP MCFMAC, MCFIRP, MCFIRC](T3)
RETURN
WCIMT CH.EOE
JRST MCFIN1
MCFIRC: JUMPE CHR,MCFIRX
WCIMT 0(CHR)
AOS ARGCNT
GETCHR
JRST CPOPJ1
MCFMAC: MOVE T3,ARGCNT
ADD T3,ARGINC
SUB T3,MACCNT
TRNN T3,(1B0)
RETURN
MCFIRP: CALL TGARG
MCFIRX: AOSA ARGINC
JRST MCFOK
CALL MCFGEN
SKIPN IRPTYP
JRST CPOPJ1
RETURN
MCFOK: AOS 0(P) ;ALL GOOD EXITS NOW
CAIN CHR,"\" ;TEST UNARIES
JRST MCFOK2
CALL GGARG
JUMPE CHR,MCFOK1
WCIMT 0(CHR)
GETCHR
JUMPN CHR,.-2
JRST PGARG
MCFOK1: CALL MCFGEN
JFCL
JRST PGARG
MCFOK2: CALL GETNB ;"\", BYPASS
CAIN CHR,"\" ;DOPBLE?
JRST MCFOK3 ; YES
CALL ABSEXP ;NO, EVALUATE EXPRESSION
HRROS ARGCNT
MOVE T3,VAL ;SET
MOVE T1,CRADIX ;SET CHARACTERISTICS
HRLI T1,"0"
JRST MCFDIV
MCFOK3: CALL GETNB ;BYPASS SECOND "\"
CALL ABSEXP
HRROS ARGCNT
MOVE SYM,VAL ;GET VALUE
CALL M40SIX ;CONVERT TO SIXBIT
MOVE T3,SYM
MOVE T1,[XWD 40,100]
JRST MCFDIV
MCFDIV: IDIVI T3,0(T1) ;DIVIDE NUMBER
HRLM T4,0(P) ;STACK REMAINDER
SKIPE T3 ;ANY MORE?
CALL MCFDIV ; YES
HLRZ T3,0(P) ;NO,RETRIEVE NUMBER
HLRZ T4,T1 ;GET CONSTANT
ADD T3,T4 ;ADD IT IN
WCIMT 0(T3) ;STORE IT
RETURN
MCFGEN: ;GENERAT SYMBOL
HLLZ T3,MACCNT
MOVE T4,ARGCNT
ADD T4,ARGINC
LSH T3,-1(T4)
JUMPE T3,CPOPJ
JUMPG T3,CPOPJ1
AOS T3,LSBGEN ;BUMP GENERATED SYMBOL NUMBER
MOVE T1,[XWD "0",^D10] ;SET CHARACTERISTICS
CALL MCFDIV ;OUTPUT
WCIMT "$" ;COMPLETE GENED SYMBOL
JRST CPOPJ1
.NARG:
CALL GSARG ;FETCH SYMBOL
JRST OPCERR ; MISSING, ERROR
SPUSH SYM ;STACK THE SYMBOL
HLRZ VAL,MSBCNT ;GET COUNT
JRST ASGMTF ;EXIT THROUGH "="
.NCHR:
CALL GSARG ;GET THE SYMBOL
JRST OPCERR ; MISSING, ERROR
SPUSH SYM ;OK, STACK IT
CALL TGARG ;TEST FOR SECOND ARG
JFCL ; EH?
CALL GGARG ;FETCH THE ARG
SPUSH ARGCHC ;SAVE COUNT
CALL PGARG ;FLUSH STORAGE
SPOP VAL ;COUNT TO VAL
HRRZS VAL
JRST ASGMTF ;EXIT THROUGH "="
.NTYPE:
CALL GSARG ;GET THE SYMBOL
JRST OPCERR ; MISSING, ERROR
SPUSH SYM ;OK, STACK IT
CALL TGARG ;TEST FOR SECOND ARG
JFCL ; EH?
CALL M65AEX ;PROCESS ADDRESS EXPRESSION
JFCL
HRRZ VAL,T4 ;GET TYPE CODE
TLNE T4,(AM%ACC) ;ACCUMULATOR
JRST [MOVEI VAL,.M65RG
JRST .NTYP1] ;TYPE := IMPLIED
CAILE VAL,.M65A3 ;ZERO PAGE TYPES?
JRST .NTYP1 ;NO - DONE
TLNE T4,(AM%ZP) ;ADDRS .LE. $FF
ADDI VAL,.M65ZO ;YES - SAY SO
.NTYP1: SETZM CODPNT ;CLEAR CODE ROLL
SETZM CODBUF
JRST ASGMTF ;EXIT THROUGH "="
.MCALL:
CALL MCALLT ;TEST ARGUMENTS
SKIPN MCACNT
RETURN
TLNE FLG,P1F
SKIPN T3,JOBFFM
JRST MCALL6
EXCH T3,.JBFF
INBUF MAC,NUMBUF
MOVEM T3,.JBFF
MOVE T3,[XWD MACLUP,MACFIL]
BLT T3,MACPPN
LOOKUP MAC,MACFIL ;TRY FOR SYSMAC IN USER UFD. PRESENT?
CAIA ;NO
JRST MCALL3 ;YES
MOVE T3,SYSPPN ;NOT FOUND. SET UP FOR SEARCH IN SYS:
MOVEM T3,MACPPN ;*
LOOKUP MAC,MACFIL ;TRY AGAIN. GOOD?
JRST MCALL6 ;NOPE.
MCALL3: SETZM MCATMP
MCALL4: CALL GETMLI
TLNE FLG,ENDFLG
JRST MCALL6
CAIN T3,DCMACE
SOS MCATMP
CAIE T3,DCMAC
JRST MCALL4
AOS T3,MCATMP
CAIE T3,1
JRST MCALL4
CALL GSARG
JRST MCALL3
CALL MSRCH
CAIA
TRNE T1,-1
JRST MCALL4
CALL MACROF
TLNE FLG,ENDFLG
JRST MCALL6
SOSLE MCACNT
JRST MCALL3
JRST MCALL7
MCALL6: ERRSET ERR.A
MCALL7: SETZM MCACNT
TLZ FLG,ENDFLG
RETURN
MCALLT: CALL GSARG ;GET NEXT ARGUMENT
RETURN ; END, EXIT
CALL MSRCH ;FOUND, ALREADY PROCESSED?
AOSA MCACNT ; NO, INCREMENT COUNT AND SKIP
JRST MCALLU ; YES, IGNORE
MOVSI T1,MAOP ;FLAG AS MACRO
CALL INSRT ;INSERT
MCALLU: CALL CRFOPD
JRST MCALLT
MACLUP: SIXBIT /SYSMAC/
SIXBIT /SML/
EXP 0
XWD 0,0
.LOC
MACFIL: BLOCK 1
MACEXT: BLOCK 1
BLOCK 1
MACPPN: BLOCK 1
JOBFFM: BLOCK 1
MCACNT: BLOCK 1 ;MACRO CALL COUNT
MCATMP: BLOCK 1
MACBUF: BLOCK 1
MACPNT: BLOCK 1
BLOCK 1
.RELOC
SUBTTL MACRO STORAGE HANDLERS
WCIMT0: ;WRITE CHARACTER IN MACRO TREE
SPUSH T2 ;STACK WORK REGISTER
MOVEI T2,@.JBUUO ;FETCH ARG
SOSL CONCNT ;ANY CONCATENATION CHARS?
WCIMT "'" ;YES, WRITE THEM
SETZM CONCNT ;CLEAR COUNT
JUMPN T2,WCIMT1 ;BRANCH IF NON-DELIMITER
MOVEI T2,LF
WCIMT1: CALL WCIMT2 ;WRITE IT
SPOP T2
RETURN
WCIMT2: TRNN T2,177 ;ATTEMPT TO WRITE A NULL?
HALT . ; YES, NASTY
SKIPN @MWPNTR ;END OF BLOCK?
JRST WCIMT3 ; YES, GET ANOTHER
DPB T2,MWPNTR ;NO, STORE BYTE
IBP MWPNTR ;POINT TO NEXT BYTE
RETURN ;EXIT
WCIMT3: SPUSH T1
PUSH P,MWPNTR ;NEAD A NEW BLOCK, SAVE CURRENT POINTER
CALL GETBLK ;GET IT
HRRZS T1 ;GET START OF NEW BLOCK
EXCH T1,0(P) ;EXCHANGE WITH POINTER TO LAST
POP P,0(T1) ;STORE VECTOR
SPOP T1
JRST WCIMT2 ;TRY AGAIN
READMC: ;READ MACRO CHARACTER
CALL READMB ;GET A MACRO BYTE
READMF: TRNN CHR,CF.SPC ;SPECIAL?
JRST CPOPJ1 ; NO
TRNE CHR,CF.DSY ;YES, DUMMY SYMBOL?
JRST READM1 ; YES
TRNE CHR,CF.TRP ;END OF SOMETHIN?
JRST MPOP ; YES
TRNE CHR,CF.ARG ;NO, CHAR TRAP AT THIS LEVEL?
SKIPN T3,CALSAV
JRST CPOPJ1
MOVEM T3,MSBMRP
SETZM CALSAV
JRST READMC
READM1: TRZ CHR,CF.SPC!CF.DSY
MOVE T3,MSBAUX
EXCH T3,MSBMRP
MOVEM T3,CALSAV
MOVE T4,MSBTYP
CAIE T4,CH.IRP ;IRP?
JRST READM5 ; NO
MOVEI T4,0(CHR)
READM2: SOJLE T4,READM4
READM3: CALL READMB
CAIE CHR,CH.FIN
JRST READM3
JRST READM2
READM4: HRRZ CHR,MSBCNT
READM5: MOVEI T4,0(CHR) ;GET COUNT
READM6: SOJLE T4,READMC
READM7: CALL READMB
CAIN CHR,CH.FIN
JRST READMF
CAIE CHR,CH.EOE
JRST READM7
JRST READM6
READMB: ;READ MACRO BYTE
LDB CHR,MSBMRP ;GET CHARACTER
IBP MSBMRP
JUMPN CHR,CPOPJ ;EXIT IF NON-NULL
MOVE CHR,MSBMRP
MOVE CHR,0(CHR) ;END OF BLOCK, GET LINK
HLL CHR,TXTBYT ;FORM BYTE POINTER
MOVEM CHR,MSBMRP
JRST READMB ;TRY AGAIN
.MEXIT:
SKIPN MSBTYP ;IN MACRO?
JRST OPCERR ; NO, ERROR
SETOM CNDMEX ;SET FLAG
RETURN
MPUSH:
CALL GETBLK
MOVSI T3,-<MSBLEN>
PUSH P,MWPNTR
MPUSH1: SETZM T4
EXCH T4,MSBTYP(T3)
MOVEM T4,@MWPNTR
AOS MWPNTR
AOBJN T3,MPUSH1
MOVEM CHR,MSBTYP
POP P,MSBPBP
AOS MSBLVL
RETURN
MPOP:
SKIPN MSBLVL
HALT .
CAMN CHR,MSBTYP
JRST MPOP1
CALL MPOP1
ERRSET ERR.A
JRST MPOP
MPOP1: TRC CHR,CF.SPC!CF.TRP
CAIL CHR,T.MIN
CAILE CHR,T.MAX
HALT .
SKIPN REPSW ;ARE WE INSIDE A REPEAT BLOCK?
JRST MPOP3 ;NO, SO DON'T MESS AROUND
SOSLE @REPCT ;DECREMENT THE TOP LEVEL OF THE STACK
JRST MPOP4 ;IF WE'RE STILL IN THE TOP LEVEL, SPLIT.
SETZM CNDMEX ;OTHERWISE, ENABLE CODE GENERATION AGAIN,
SOS REPCT ;POP THE STACK,
EXCH ASM,REPCT ;,
CAIN ASM,REPBLK-1 ;AND SEE IF IT'S EMPTY. IS IT?
SETZM REPSW ;YES, SO TELL FOLKS WE'RE NOT IN A REPEAT ANY MORE.
EXCH ASM,REPCT ;NOW PUT THINGS BACK WHERE THEY BELONG
CAIA
MPOP3: SETZM CNDMEX
MPOP4: SPUSH LBP
XCT MPOPT(CHR)
JRST MPOP2
SKIPE T1,MSBTXP
CALL DECMAC
SKIPE T1,MSBAUX
CALL REMMAC
SKIPN T1,MSBPBP
HALT .
MOVSI T3,0(T1)
HRRI T3,MSBTYP
BLT T3,MSBTYP+MSBLEN-1
CALL REMMAC
SOS MSBLVL
MPOP2: SPOP LBP
RETURN
MPOPT:
PHASE 0
HALT .
T.MIN== .
T.MACR:!CAIA
T.REPT:!CALL ENDRPT
T.IRP:! CALL ENDIRP
T.MAX== .-1
DEPHASE
.LOC
MSBTYP: BLOCK 1
MSBPBP: BLOCK 1
MSBTXP: BLOCK 1
MSBAUX: BLOCK 1
MSBMRP: BLOCK 1
MSBCNT: BLOCK 1
MSBLEN== .-MSBTYP
CALSAV: BLOCK 1
MACCNT: BLOCK 1
MSBLVL: BLOCK 1
MACNAM: BLOCK 1
CONCNT: BLOCK 1
DSYLST: BLOCK ^D65 ;MACRO ARGUMENT STORAGE
IRPTYP: BLOCK 1 ;1=IRP,2=IRPC
IRPBEG: BLOCK 1
IRPCNT: BLOCK 1
IRPMAX: BLOCK 1
ARGINC: BLOCK 1
REPSW: BLOCK 1 ;SET NON-ZERO WHILE INSIDE IRP,IRPC,REPT
REPCT: BLOCK 1 ;POINTER TO 'STACK' IN REPBLK.
REPBLK: BLOCK ^D128 ;'STACK' FOR REPEAT ITERATION COUNTS
.RELOC
GGARG:
SPUSH LBP ;SAVE START OF FIELD
MOVEM LBP,SYM ;AND END
MOVEI T1,0 ;ZERO CHARACTER COUNT
CAIE CHR,"<"
JRST GGARG2
SETZM T2
GETCHR
MOVEM LBP,0(P) ;SAVE NEW START
MOVEM LBP,SYM ; AND END
GGARG1: JUMPE CHR,GGARG6
CAIN CHR,"<"
AOS T2
CAIN CHR,">"
SOJL T2,GGARG7
CALL GGARG9
JRST GGARG1
GGARG2: CAIE CHR,"^"
JRST GGARG5
CALL GETNB
CAILE CHR,40
CAILE CHR,137
JRST GGARG6
MOVE T2,CHR
GETCHR
MOVEM LBP,0(P) ;SAVE NEW START
MOVEM LBP,SYM ; AND END
GGARG3: JUMPE CHR,GGARG6
CAMN CHR,T2
JRST GGARG7
CALL GGARG9
JRST GGARG3
GGARG5: CAIE CHR,";"
CAIN CHR,","
JRST GGARG8
CAIE CHR,SPACE
CAIN CHR,TAB
JRST GGARG8
JUMPE CHR,GGARG8
CALL GGARG9
JRST GGARG5
GGARG6: ERRSKP ERR.A
GGARG7: GETCHR
GGARG8: SPUSH SYM ;STACK END
SPUSH T1 ; ANC COUNT
SPUSH MWPNTR ;PROTECT POINTER
CALL GETBLK ;GET STORAGE
SPOP MWPNTR
MOVE T2,T1 ;GET COPY OF STORAGE POINTER
HRLI T2,ARGBLK
BLT T2,ARGLEN-1(T1) ;ZIP CUREENT
MOVEM T1,ARGPNT ;SET NEW POINTER
SPOP ARGCHC ;SET COUNT
SPOP ARGEND
SPOP ARGBEG
LDB T3,ARGEND
HRLM T3,ARGCHC
MOVEI T3,0
DPB T3,ARGEND
MOVEM LBP,ARGTXP ;SAVE END OF FIELD
MOVE LBP,ARGBEG ;SET TO START OF ARG
JRST SETCHR ;SET IT
GGARG9: GETCHR ;GET THE NEXT CHARACTER
MOVEM LBP,SYM ;SET NEW END
AOJA T1,CPOPJ ;INCREMENT COUNT AND EXIT
PGARG: ;POP GENARAL ARGUMENT
SKIPN LBP,ARGTXP ;SET TEXT POINTER
HALT .
SKIPN T1,ARGPNT ;GET POINTER TO PREVIOUS
HALT .
SKIPN ARGEND
HALT .
HLRZ T3,ARGCHC
DPB T3,ARGEND
HRLZ T3,T1
HRRI T3,ARGBLK
BLT T3,ARGBLK+ARGLEN-1 ;XFER DATA
CALL REMMAC ;RETURN BLOCK FOR DEPOSIT
JRST SETNB ;SET NON-BLANK AND EXIT
SUBTTL FLOATING POINT EVALUATOR
FLTG:
TLZ FLG,FLTFLG ;CLEAR ERROR FLAG
SETZB SYM,FLTNUM
SETZB T1,FLTNUM+1
SETZB T2,FLTNUM+2
SETZB T3,FLTNUM+3
CAIN CHR,"-"
TLO SYM,(1B0)
EXCH SYM,FLTNUM
SKIPL FLTNUM
CAIN CHR,"+"
FLTG2: GETCHR
CAIL CHR,"0"
CAILE CHR,"9"
JRST FLTG3
TLNE SYM,760000
AOJA T3,FLTG2
ASHC SYM,1
MOVEM SYM,FLTTMP
MOVEM T1,FLTTMP+1
ASHC SYM,2
ADD SYM,FLTTMP
ADD T1,FLTTMP+1
ADDI T1,-"0"(CHR)
TLZE T1,(1B0)
ADDI SYM,1
AOBJP T3,FLTG2
FLTG3: CAIE CHR,"."
JRST FLTG4
TRNE T2,400000
TLO FLG,FLTFLG
MOVEI T2,400000(T3)
JRST FLTG2
FLTG4: SKIPN T3
TLO FLG,FLTFLG
TRZN T2,400000
HRRZ T2,T3
HLRZS T3
SUB T2,T3
CAIE CHR,"E"
JRST FLTG6
GETCHR
SPUSH SYM
SPUSH T1
SETZB SYM,T1
CAIN CHR,"-"
TLOA T1,(1B0)
CAIN CHR,"+"
FLTG5: GETCHR
CAIL CHR,"0"
CAILE CHR,"9"
JRST FLTG5A
IMULI SYM,^D10
ADDI SYM,-"0"(CHR)
AOJA T1,FLTG5
FLTG5A: TLZE T1,(1B0)
MOVNS SYM
SKIPN T1
TLO FLG,FLTFLG
ADD T2,SYM
SPOP T1
SPOP SYM
FLTG6: CAIN T1,0
JUMPE SYM,FLTG12
TDZA T3,T3
FLTG7: ASHC SYM,1
TLNN SYM,200000
SOJA T3,FLTG7
JUMPL T2,FLTG9
FLTG8: SOJL T2,FLTG10
MOVEM SYM,FLTTMP
MOVEM T1,FLTTMP+1
ASHC SYM,-2
ADD SYM,FLTTMP
ADD T1,FLTTMP+1
TLZE T1,(1B0)
ADDI SYM,1
TLNE SYM,(1B0)
CALL FLTG20
ADDI T3,3
JRST FLTG8
FLTG9: CAML SYM,[^D10B4]
CALL FLTG20
SPUSH T1+1
DIV SYM,[^D10B4]
DIV T1,[^D10B4]
SPOP T1+1
SUBI T3,4
AOJL T2,FLTG9
FLTG10: SPUSH T3 ;STACK EXPONENT
MOVSI T2,(1B<16-7>) ;SET ONE WORD ROUNDING BIT
SETZ T3, ;CLEAR LOW ORDER
SKIPA T4,FLTLEN ;GET LENGTH AND SKIP
ASHC T2,-^D16 ;MOVE ROUNDING MASK
SOJG T4,.-1
TDNN SYM,T2 ;TEST FOR ROUNDING REQUIRED
TDNE T1,T3
SKPEDR ED.FPT ;YES, ".ROUND" MODE?
JRST FLTG11 ; NO, FORGET ROUNDING
ASHC T2,1 ;SHIFT BIT UP ONE
ADD SYM,T2
ADD T1,T3 ;ADD IN BIT
FLTG11: SPOP T3 ;RESTORE EXPONENT
TLZE T1,(1B0) ;OVERFLOW, LOW ORDER?
ADDI SYM,1 ; YES, ADD TO UPPER
TLNE SYM,(1B0) ;OVERFLOW, HIGH ORDER?
CALL FLTG20 ; YES, CORRECT
LSH T1,1 ;MOVE OVER SIGN BIT
LSHC SYM,-7 ;MAKE ROOM FOR EXPONENT
ADDI T3,^D<35+35+128>
DPB T3,[POINT 8,SYM,8]
LDB T2,[POINT 8,SYM,8]
CAME T2,T3 ;OVER/UNDER FLOW?
ERRSET ERR.T ; YES
FLTG12: IOR SYM,FLTNUM
MOVSI T2,-4
FLTG13: LDB T3,[POINT 16,SYM,15]
MOVEM T3,FLTNUM(T2)
LSHC SYM,^D16
AOBJN T2,FLTG13
JRST SETNB
FLTG20: LSH T1,1
LSHC SYM,-1
LSH T1,-1
AOJA T3,CPOPJ
.LOC
FLTNUM: BLOCK 4 ;FLOATING POINT NUMBER
FLTLEN: BLOCK 1 ;LENGTH
FLTTMP: BLOCK 2
.RELOC
SUBTTL SIXBIT/RAD50 CONVERSION ROUTINES
SIXM40: ;SIXBIT TO RAD50
SPUSH T1
SPUSH T2
SPUSH T3 ;STACK REGISTERS
SETZ T1,
MOVSI T3,(POINT 6,SYM)
SIXM41: ILDB T2,T3 ;GET A CHARACTER
HLRZ T2,RADTBL(T2) ;MAP
IMULI T1,50
ADD T1,T2
TLNE T3,770000 ;FINISHED?
JRST SIXM41 ; NO
IDIVI T1,50*50*50 ;YES, SPLIT INTO HALVES
HRLZ SYM,T1 ;HIGH ORDER
HRR SYM,T2 ; AND LOW ORDER
SPOP T3 ;RESTORE REGISTERS
SPOP T2
SPOP T1
RETURN
M40SIX: ;RAD50 TO SIXBIT
SPUSH T1
SPUSH T2
SPUSH T3
LDB T1,[POINT 16,SYM,17]
IMULI T1,50*50*50 ;MERGE
ANDI SYM,177777
ADD SYM,T1
SETZ T2, ;ACCUMULATOR
MOVSI T3,-6
M40SI1: IDIVI SYM,50
HRRZ T1,RADTBL(T1) ;MAP
LSHC T1,-6 ;MOVE INTO COLLECTOR
AOBJN T3,M40SI1 ;TEST FOR END
MOVE SYM,T2
SPOP T3
SPOP T2
SPOP T1
RETURN
RADTBL:
XWD <$==0>, 0
XWD 0, "A"-40
XWD 0, "B"-40
XWD 0, "C"-40
XWD <$$==33>, "D"-40
XWD 0, "E"-40
XWD 0, "F"-40
XWD 0, "G"-40
XWD 0, "H"-40
XWD 0, "I"-40
XWD 0, "J"-40
XWD 0, "K"-40
XWD 0, "L"-40
XWD 0, "M"-40
XWD <$.==34>, "N"-40
XWD 0, "O"-40
XWD <$0==36>, "P"-40
XWD <$1==37>, "Q"-40
XWD <$2==40>, "R"-40
XWD <$3==41>, "S"-40
XWD <$4==42>, "T"-40
XWD <$5==43>, "U"-40
XWD <$6==44>, "V"-40
XWD <$7==45>, "W"-40
XWD <$8==46>, "X"-40
XWD <$9==47>, "Y"-40
XWD 0, "Z"-40
XWD 0, "$"-40
XWD 0, "."-40
XWD 0, 0
XWD 0, "0"-40
XWD 0, "1"-40
XWD 0, "2"-40
XWD <$A==1>, "3"-40
XWD <$B==2>, "4"-40
XWD <$C==3>, "5"-40
XWD <$D==4>, "6"-40
XWD <$E==5>, "7"-40
XWD <$F==6>, "8"-40
XWD <$G==7>, "9"-40
XWD <$H==10>, 0
XWD <$I==11>, 0
XWD <$J==12>, 0
XWD <$K==13>, 0
XWD <$L==14>, 0
XWD <$M==15>, 0
XWD <$N==16>, 0
XWD <$O==17>, 0
XWD <$P==20>, 0
XWD <$Q==21>, 0
XWD <$R==22>, 0
XWD <$S==23>, 0
XWD <$T==24>, 0
XWD <$U==25>, 0
XWD <$V==26>, 0
XWD <$W==27>, 0
XWD <$X==30>, 0
XWD <$Y==31>, 0
XWD <$Z==32>, 0
XWD 0, 0
XWD 0, 0
XWD 0, 0
XWD 0, 0
XWD 0, 0
SUBTTL PERMANENT SYMBOL TABLE ROUTINES
OSRCH: ;OP TABLE SEARCH
CALL MSRCH ;TRY FOR USER-DEFINED OPS FIRST
TLZA SYM,ST.MAC ; NO, CLEAR FLAG AND SKIP
JRST CPOPJ1 ;YES, GOOD EXIT
MOVE T3,MACHT ;GET MACHINE TYPE
CALL PSRCH ;SEARCH PERM SYMBOL TABLE
SKIPA T3,[MXX] ;FAILED - TRY DIRECTIVE
JRST CPOPJ1 ;SUCCESS
PSRCH:
HLRZ T2,DELTAX(T3) ;SET UP OFFSET AND DELTA
HRRZ T1,DELTAX(T3)
PSRCH1: CAMN SYM,@OPTBOT(T3) ;ARE WE LOOKING AT IT?
JRST PSRCH3 ; YES
CAML SYM,@OPTBOT(T3) ;TEST FOR DIRECTION OF NEXT MOVE
TDOA T2,T1 ;ADD
PSRCH2: SUB T2,T1 ;SUBTRACT
ASH T1,-1 ;HALVE DELTA
JUMPE T1,PSRCH4 ;EXIT IF END
CAMLE T2,OPTSIZ(T3) ;YES, ARE WE OUT OF BOUNDS?
JRST PSRCH2 ;YES, MOVE DOWN
JRST PSRCH1 ;NO, TRY AGAIN
PSRCH3: MOVE T1,@OPTBT1(T3) ;FOUND, PLACE VALUE IN T1
LDB T2,TYPPNT
JRST CPOPJ1
PSRCH4: SETZB T1,T2
RETURN
;MACHINE TYPE TABLES FOR PSRCH
DELTAX: 1B^L<M65TOP-M65BOT>,,1B^L<M65TOP-M65BOT>/2
1B^L<M68TOP-M68BOT>,,1B^L<M68TOP-M68BOT>/2
1B^L<M80TOP-M80BOT>,,1B^L<M80TOP-M80BOT>/2
1B^L<M88TOP-M88BOT>,,1B^L<M88TOP-M88BOT>/2
1B^L<M08TOP-M08BOT>,,1B^L<M08TOP-M08BOT>/2
1B^L<M18TOP-M18BOT>,,1B^L<M18TOP-M18BOT>/2
1B^L<MF8TOP-MF8BOT>,,1B^L<MF8TOP-MF8BOT>/2
CHKTAB (DELTAX)
1B^L<DIRTOP-DIRBOT>,,1B^L<DIRTOP-DIRBOT>/2
OPTBOT: Z M65BOT-2(T2)
Z M68BOT-2(T2)
Z M80BOT-2(T2)
Z M88BOT-2(T2)
Z M08BOT-2(T2)
Z M18BOT-2(T2)
Z MF8BOT-2(T2)
CHKTAB (OPTBOT)
Z DIRBOT-2(T2)
OPTBT1: Z M65BOT-1(T2)
Z M68BOT-1(T2)
Z M80BOT-1(T2)
Z M88BOT-1(T2)
Z M08BOT-1(T2)
Z M18BOT-1(T2)
Z MF8BOT-1(T2)
CHKTAB (OPTBT1)
Z DIRBOT-1(T2)
OPTSIZ: M65TOP-M65BOT
M68TOP-M68BOT
M80TOP-M80BOT
M88TOP-M88BOT
M08TOP-M08BOT
M18TOP-M18BOT
MF8TOP-MF8BOT
CHKTAB (OPTSIZ)
DIRTOP-DIRBOT
SUBTTL SYMBOL TABLE FLAGS
TYPOFF== ^D17 ;PACKING PARAMETERS
SUBOFF== ^D14
MODOFF== ^D7
BC1== 1
BC2== 2
DEFSYM== 400000 ;DEFINED SYMBOL
LBLSYM== 200000 ;LABEL
REGSYM== 100000 ;REGISTER
GLBSYM== 040000 ;GLOBAL
MDFSYM== 020000 ;MULTIPLY-DEFINED FLAG
FLTSYM== 010000 ;DEFAULTED GLOBAL SYMBOL
DFLSYM== 004000 ;DEFAULT SYMBOL DEFINITION
TYPPNT: POINT 3,T1,TYPOFF ;TYPE POINTER
SUBPNT: POINT 7,T1,SUBOFF ;SUB-TYPE POINTER
CCSPNT: POINT 7,PC,SUBOFF ;CURRENT CSECT POINTER
MODPNT: POINT 8,T1,MODOFF
ST.MAC== 200000
ST.LSB== 400000
MDMASK== 377B<MODOFF>
PFMASK== 377B<SUBOFF>
ADMASK== 177777
PCMASK== PFMASK!ADMASK
DCCND== 1
DCCNDE== 2
DCMAC== 3
DCMACE== 4
DCRPT== DCMAC
DCRPTE== DCMACE
DCMCAL== 7
M40DOT: GENM40 <.>
SUBTTL PERMANENT SYMBOL TABLE
REGM80:
GENM40 <B>
GENM40 <C>
GENM40 <D>
GENM40 <E>
GENM40 <H>
GENM40 <L>
GENM40 <M>
GENM40 <A>
GENM40 <SP>
GENM40 <PSW>
GENM40 <X>
GENM40 <Y>
REGM88:
REGM08:
GENM40 <A>
GENM40 <B>
GENM40 <C>
GENM40 <D>
GENM40 <E>
GENM40 <H>
GENM40 <L>
GENM40 <M>
REGM18:
GENM40 <R0>
GENM40 <R1>
GENM40 <R2>
GENM40 <R3>
GENM40 <R4>
GENM40 <R5>
GENM40 <R6>
GENM40 <R7>
GENM40 <R8>
GENM40 <R9>
GENM40 <R10>
GENM40 <R11>
GENM40 <R12>
GENM40 <R13>
GENM40 <R14>
GENM40 <R15>
;MACRO TO DEFINE OPCODE SYMBOL TABLE
DEFINE M65OPS <
M65DEF <ADC>,OPCL1,<6D,7D,79,61,71,00,69,65,75,00>
M65DEF <AND>,OPCL1,<2D,3D,39,21,31,00,29,25,35,00>
M65DEF <ASL>,OPCL5,<0E,11E,00,00,00,0A,00,06,16,00>
M65DEF <BCC>,OPCL2,<90>
M65DEF <BCS>,OPCL2,<B0>
M65DEF <BEQ>,OPCL2,<F0>
M65DEF <BIT>,OPCL1,<2C,00,00,00,00,00,00,24,00,00>
M65DEF <BMI>,OPCL2,<30>
M65DEF <BNE>,OPCL2,<D0>
M65DEF <BPL>,OPCL2,<10>
M65DEF <BRK>,OPCL4,<00>,^D70
M65DEF <BVC>,OPCL2,<50>
M65DEF <BVS>,OPCL2,<70>
M65DEF <CLC>,OPCL4,<18>,^D20
M65DEF <CLD>,OPCL4,<D8>,^D20
M65DEF <CLI>,OPCL4,<58>,^D20
M65DEF <CLV>,OPCL4,<B8>,^D20
M65DEF <CMP>,OPCL1,<CD,DD,D9,C1,D1,00,C9,C5,D5,00>
M65DEF <CPX>,OPCL1,<EC,00,00,00,00,00,E0,E4,00,00>
M65DEF <CPY>,OPCL1,<CC,00,00,00,00,00,C0,C4,00,00>
M65DEF <DEC>,OPCL5,<CE,1DE,00,00,00,00,00,C6,D6,00>
M65DEF <DEX>,OPCL4,<CA>,^D20
M65DEF <DEY>,OPCL4,<88>,^D20
M65DEF <EOR>,OPCL1,<4D,5D,59,41,51,00,49,45,55,00>
M65DEF <INC>,OPCL5,<EE,1FE,00,00,00,00,00,E6,F6,00>
M65DEF <INX>,OPCL4,<E8>,^D20
M65DEF <INY>,OPCL4,<C8>,^D20
M65DEF <JMP>,OPCL3,<4C,00,00,00,00,6C,00,00,00,00>
M65DEF <JSR>,OPCL1,<20,00,00,00,00,00,00,00,00,00>,424
M65DEF <LDA>,OPCL1,<AD,BD,B9,A1,B1,00,A9,A5,B5,00>
M65DEF <LDX>,OPCL1,<AE,00,BE,00,00,00,A2,A6,00,B6>
M65DEF <LDY>,OPCL1,<AC,BC,00,00,00,00,A0,A4,B4,00>
M65DEF <LSR>,OPCL5,<4E,15E,00,00,00,4A,00,46,56,00>
M65DEF <NOP>,OPCL4,<EA>,^D20
M65DEF <ORA>,OPCL1,<0D,1D,19,01,11,00,09,05,15,00>
M65DEF <PHA>,OPCL4,<48>,^D30
M65DEF <PHP>,OPCL4,<08>,^D30
M65DEF <PLA>,OPCL4,<68>,^D40
M65DEF <PLP>,OPCL4,<28>,^D40
M65DEF <ROL>,OPCL5,<2E,13E,00,00,00,2A,00,26,36,00>
M65DEF <ROR>,OPCL5,<6E,17E,00,00,00,6A,00,66,76,00>
M65DEF <RTI>,OPCL4,<40>,^D60
M65DEF <RTS>,OPCL4,<60>,^D60
M65DEF <SBC>,OPCL1,<ED,FD,F9,E1,F1,00,E9,E5,F5,00>
M65DEF <SEC>,OPCL4,<38>,^D20
M65DEF <SED>,OPCL4,<F8>,^D20
M65DEF <SEI>,OPCL4,<78>,^D20
M65DEF <STA>,OPCL5,<8D,19D,199,81,91,00,00,85,95,00>,^D20
M65DEF <STX>,OPCL5,<8E,00,00,00,00,00,00,86,00,196>,^D20
M65DEF <STY>,OPCL5,<8C,00,00,00,00,00,00,84,94,00>,^D20
M65DEF <TAX>,OPCL4,<AA>,^D20
M65DEF <TAY>,OPCL4,<A8>,^D20
M65DEF <TSX>,OPCL4,<BA>,^D20
M65DEF <TXA>,OPCL4,<8A>,^D20
M65DEF <TXS>,OPCL4,<9A>,^D20
M65DEF <TYA>,OPCL4,<98>,^D20
> ;END OF M65OPS
DEFINE M68OPS <
M68DEF <ABA>,OPCL3,<1B>
M68DEF <ADCA>,OPCL1,<89,99,A9,B9>
M68DEF <ADCB>,OPCL1,<C9,D9,E9,F9>
M68DEF <ADDA>,OPCL1,<8B,9B,AB,BB>
M68DEF <ADDB>,OPCL1,<CB,DB,EB,FB>
M68DEF <ANDA>,OPCL1,<84,94,A4,B4>
M68DEF <ANDB>,OPCL1,<C4,D4,E4,F4>
M68DEF <ASL>,OPCL1,<00,00,68,78>
M68DEF <ASLA>,OPCL3,<48>
M68DEF <ASLB>,OPCL3,<58>
M68DEF <ASR>,OPCL1,<00,00,67,77>
M68DEF <ASRA>,OPCL3,<47>
M68DEF <ASRB>,OPCL3,<57>
M68DEF <BCC>,OPCL2,<24>
M68DEF <BCS>,OPCL2,<25>
M68DEF <BEQ>,OPCL2,<27>
M68DEF <BGE>,OPCL2,<2C>
M68DEF <BGT>,OPCL2,<2E>
M68DEF <BHI>,OPCL2,<22>
M68DEF <BITA>,OPCL1,<85,95,A5,B5>
M68DEF <BITB>,OPCL1,<C5,D5,E5,F5>
M68DEF <BLE>,OPCL2,<2F>
M68DEF <BLS>,OPCL2,<23>
M68DEF <BLT>,OPCL2,<2D>
M68DEF <BMI>,OPCL2,<2B>
M68DEF <BNE>,OPCL2,<26>
M68DEF <BPL>,OPCL2,<2A>
M68DEF <BR>,OPCL2,<20>
M68DEF <BRA>,OPCL2,<20>
M68DEF <BSR>,OPCL2,<8D>
M68DEF <BVC>,OPCL2,<28>
M68DEF <BVS>,OPCL2,<29>
M68DEF <CBA>,OPCL3,<11>
M68DEF <CLC>,OPCL3,<0C>
M68DEF <CLI>,OPCL3,<0E>
M68DEF <CLR>,OPCL4,<00,00,6F,7F>
M68DEF <CLRA>,OPCL3,<4F>
M68DEF <CLRB>,OPCL3,<5F>
M68DEF <CLV>,OPCL3,<0A>
M68DEF <CMPA>,OPCL1,<81,91,A1,B1>
M68DEF <CMPB>,OPCL1,<C1,D1,E1,F1>
M68DEF <COM>,OPCL4,<00,00,63,73>
M68DEF <COMA>,OPCL3,<43>
M68DEF <COMB>,OPCL3,<53>
M68DEF <CPX>,OPCL5,<8C,9C,AC,BC>
M68DEF <DAA>,OPCL3,<19>
M68DEF <DEC>,OPCL4,<00,00,6A,7A>
M68DEF <DECA>,OPCL3,<4A>
M68DEF <DECB>,OPCL3,<5A>
M68DEF <DES>,OPCL3,<34>
M68DEF <DEX>,OPCL3,<09>
M68DEF <EORA>,OPCL1,<88,98,A8,B8>
M68DEF <EORB>,OPCL1,<C8,D8,E8,F8>
M68DEF <INC>,OPCL4,<00,00,6C,7C>
M68DEF <INCA>,OPCL3,<4C>
M68DEF <INCB>,OPCL3,<5C>
M68DEF <INS>,OPCL3,<31>
M68DEF <INX>,OPCL3,<08>
M68DEF <JMP>,OPCL1,<00,00,6E,7E>
M68DEF <JSR>,OPCL1,<00,00,AD,BD>
M68DEF <LDAA>,OPCL1,<86,96,A6,B6>
M68DEF <LDAB>,OPCL1,<C6,D6,E6,F6>
M68DEF <LDS>,OPCL5,<8E,9E,AE,BE>
M68DEF <LDX>,OPCL5,<CE,DE,EE,FE>
M68DEF <LSR>,OPCL4,<00,00,64,74>
M68DEF <LSRA>,OPCL3,<44>
M68DEF <LSRB>,OPCL3,<54>
M68DEF <NEG>,OPCL4,<00,00,60,70>
M68DEF <NEGA>,OPCL3,<40>
M68DEF <NEGB>,OPCL3,<50>
M68DEF <NOP>,OPCL3,<01>
M68DEF <ORAA>,OPCL1,<8A,9A,AA,BA>
M68DEF <ORAB>,OPCL1,<CA,DA,EA,FA>
M68DEF <PSHA>,OPCL3,<36>
M68DEF <PSHB>,OPCL3,<37>
M68DEF <PULA>,OPCL3,<32>
M68DEF <PULB>,OPCL3,<33>
M68DEF <ROL>,OPCL4,<00,00,69,79>
M68DEF <ROLA>,OPCL3,<49>
M68DEF <ROLB>,OPCL3,<59>
M68DEF <ROR>,OPCL4,<00,00,66,76>
M68DEF <RORA>,OPCL3,<46>
M68DEF <RORB>,OPCL3,<56>
M68DEF <RTI>,OPCL3,<3B>
M68DEF <RTS>,OPCL3,<39>
M68DEF <SBA>,OPCL3,<10>
M68DEF <SBCA>,OPCL1,<82,92,A2,B2>
M68DEF <SBCB>,OPCL1,<C2,D2,E2,F2>
M68DEF <SEC>,OPCL3,<0D>
M68DEF <SEI>,OPCL3,<0F>
M68DEF <SEV>,OPCL3,<0B>
M68DEF <STAA>,OPCL4,<00,97,A7,B7>
M68DEF <STAB>,OPCL4,<00,D7,E7,F7>
M68DEF <STS>,OPCL4,<00,9F,AF,BF>
M68DEF <STX>,OPCL4,<00,DF,EF,FF>
M68DEF <SUBA>,OPCL1,<80,90,A0,B0>
M68DEF <SUBB>,OPCL1,<C0,D0,E0,F0>
M68DEF <SWI>,OPCL3,<3F>
M68DEF <TAB>,OPCL3,<16>
M68DEF <TAP>,OPCL3,<06>
M68DEF <TBA>,OPCL3,<17>
M68DEF <TPA>,OPCL3,<07>
M68DEF <TST>,OPCL1,<00,00,6D,7D>
M68DEF <TSTA>,OPCL3,<4D>
M68DEF <TSTB>,OPCL3,<5D>
M68DEF <TSX>,OPCL3,<30>
M68DEF <TXS>,OPCL3,<35>
M68DEF <WAI>,OPCL3,<3E>
> ;END OF M68OPS
DEFINE M80OPS <
M80DEF <ACI>,OPCL7,<CE>,^D70
M80DEF <ADC>,OPCL4,<88,89,8A,8B,8C,8D,8E,8F,00,00,8E>,^D40
M80DEF <ADD>,OPCL4,<80,81,82,83,84,85,86,87,00,00,86>,^D40
M80DEF <ADI>,OPCL7,<C6>,^D70
M80DEF <ANA>,OPCL4,<A0,A1,A2,A3,A4,A5,A6,A7,00,00,A6>,^D40
M80DEF <ANI>,OPCL7,<E6>,^D70
MZ8DEF <BIT>,OPCL9,<40>
M80DEF <CALL>,OPCL2,<CD>,^D170
M80DEF <CC>,OPCL2,<DC>,^D110
MZ8DEF <CCD>,OPCL3,<A9>,<ED>
MZ8DEF <CCDR>,OPCL3,<B9>,<ED>
MZ8DEF <CCI>,OPCL3,<A1>,<ED>
MZ8DEF <CCIR>,OPCL3,<B1>,<ED>
M80DEF <CM>,OPCL2,<FC>,^D110
M80DEF <CMA>,OPCL3,<2F>,^D40
M80DEF <CMC>,OPCL3,<3F>,^D40
M80DEF <CMP>,OPCL4,<B8,B9,BA,BB,BC,BD,BE,BF,00,00,BE>,^D40
M80DEF <CNC>,OPCL2,<D4>,^D110
MZ8DEF <CNO>,OPCL2,<E4>
M80DEF <CNZ>,OPCL2,<C4>,^D110
MZ8DEF <CO>,OPCL2,<EC>
M80DEF <CP>,OPCL2,<F4>,^D110
M80DEF <CPE>,OPCL2,<EC>,^D110
M80DEF <CPI>,OPCL7,<FE>,^D70
M80DEF <CPO>,OPCL2,<E4>,^D110
M80DEF <CZ>,OPCL2,<CC>,^D110
M80DEF <DAA>,OPCL3,<27>,^D40
M80DEF <DAD>,OPCL4,<09,00,19,00,29,00,00,00,39>,^D100
MZ8DEF <DADC>,OPCL4,<4A,00,5A,00,6A,00,00,00,7A>,<ED>
MZ8DEF <DADX>,OPCL4,<09,00,19,00,00,00,00,00,39,00,29>,<DD>
MZ8DEF <DADY>,OPCL4,<09,00,19,00,00,00,00,00,39,00,29>,<FD>
M80DEF <DCR>,OPCL4,<05,0D,15,1D,25,2D,135,3D,00,00,35>,^D50
M80DEF <DCX>,OPCL4,<0B,00,1B,00,2B,00,00,00,3B,00,2B>,^D50
M80DEF <DI>,OPCL3,<F3>,^D40
MZ8DEF <DJNZ>,OPCL10,<10>
MZ8DEF <DSBC>,OPCL4,<42,00,52,00,62,00,00,00,72>,<ED>
M80DEF <EI>,OPCL3,<FB>,^D40
MZ8DEF <EXAF>,OPCL3,<08>
MZ8DEF <EXX>,OPCL3,<D9>
M80DEF <HLT>,OPCL3,<76>,^D70
MZ8DEF <IM0>,OPCL3,<46>,<ED>
MZ8DEF <IM1>,OPCL3,<56>,<ED>
MZ8DEF <IM2>,OPCL3,<5E>,<ED>
M80DEF <IN>,OPCL7,<DB>,^D100
MZ8DEF <IND>,OPCL3,<AA>,<ED>
MZ8DEF <INDR>,OPCL3,<BA>,<ED>
MZ8DEF <INI>,OPCL3,<A2>,<ED>
MZ8DEF <INIR>,OPCL3,<B2>,<ED>
MZ8DEF <INP>,OPCL4,<40,48,50,58,60,68,00,78>,<ED>
M80DEF <INR>,OPCL4,<04,0C,14,1C,24,2C,134,3C,00,00,34>,^D50
M80DEF <INX>,OPCL4,<03,00,13,00,23,00,00,00,33,00,23>,^D50
M80DEF <JC>,OPCL2,<DA>,^D100
M80DEF <JM>,OPCL2,<FA>,^D100
M80DEF <JMP>,OPCL2,<C3>,^D100
MZ8DEF <JMPR>,OPCL10,<18>
M80DEF <JNC>,OPCL2,<D2>,^D100
MZ8DEF <JNO>,OPCL2,<E2>
M80DEF <JNZ>,OPCL2,<C2>,^D100
MZ8DEF <JO>,OPCL2,<EA>
M80DEF <JP>,OPCL2,<F2>,^D100
M80DEF <JPE>,OPCL2,<EA>,^D100
M80DEF <JPO>,OPCL2,<E2>,^D100
MZ8DEF <JRC>,OPCL10,<38>
MZ8DEF <JRNC>,OPCL10,<30>
MZ8DEF <JRNZ>,OPCL10,<20>
MZ8DEF <JRZ>,OPCL10,<28>
M80DEF <JZ>,OPCL2,<CA>,^D100
MZ8DEF <LBCD>,OPCL2,<4B>,<ED>
M80DEF <LDA>,OPCL2,<3A>,^D130
MZ8DEF <LDAI>,OPCL3,<57>,<ED>
MZ8DEF <LDAR>,OPCL3,<5F>,<ED>
M80DEF <LDAX>,OPCL4,<0A,00,1A>,^D70
MZ8DEF <LDD>,OPCL3,<A8>,<ED>
MZ8DEF <LDDR>,OPCL3,<B8>,<ED>
MZ8DEF <LDED>,OPCL2,<5B>,<ED>
MZ8DEF <LDI>,OPCL3,<A0>,<ED>
MZ8DEF <LDIR>,OPCL3,<B0>,<ED>
M80DEF <LHLD>,OPCL2,<2A>,^D160
MZ8DEF <LIXD>,OPCL2,<2A>,<DD>
MZ8DEF <LIYD>,OPCL2,<2A>,<FD>
MZ8DEF <LSPD>,OPCL2,<7B>,<ED>
M80DEF <LXI>,OPCL6,<01,00,11,00,21,00,00,00,31,00,21>,^D100
M80DEF <MOV>,OPCL1,<40>,^D50
M80DEF <MVI>,OPCL5,<06,0E,16,1E,26,2E,36,3E,00,00,36>,^D70
MZ8DEF <NEG>,OPCL3,<44>,<ED>
M80DEF <NOP>,OPCL3,<00>,^D40
M80DEF <ORA>,OPCL4,<B0,B1,B2,B3,B4,B5,B6,B7,00,00,B6>,^D40
M80DEF <ORI>,OPCL7,<F6>,^D70
M80DEF <OUT>,OPCL7,<D3>,^D100
MZ8DEF <OUTD>,OPCL3,<AB>,<ED>
MZ8DEF <OUTDR>,OPCL3,<BB>,<ED>
MZ8DEF <OUTI>,OPCL3,<A3>,<ED>
MZ8DEF <OUTIR>,OPCL3,<B3>,<ED>
MZ8DEF <OUTP>,OPCL4,<41,49,51,59,61,69,00,79>,<ED>
M80DEF <PCHL>,OPCL3,<E9>,^D50
MZ8DEF <PCIX>,OPCL3,<E9>,<DD>
MZ8DEF <PCIY>,OPCL3,<E9>,<FD>
M80DEF <POP>,OPCL4,<C1,00,D1,00,E1,00,00,00,00,F1,E1>,^D100
M80DEF <PUSH>,OPCL4,<C5,00,D5,00,E5,00,00,00,00,F5,E5>,^D110
M80DEF <RAL>,OPCL3,<17>,^D40
MZ8DEF <RALR>,OPCL11,<10>
M80DEF <RAR>,OPCL3,<1F>,^D40
MZ8DEF <RARR>,OPCL11,<18>
M80DEF <RC>,OPCL3,<D8>,^D50
MZ8DEF <RES>,OPCL9,<80>
M80DEF <RET>,OPCL3,<C9>,^D100
MZ8DEF <RETI>,OPCL3,<4D>,<ED>
MZ8DEF <RETN>,OPCL3,<45>,<ED>
M80DEF <RIM>,OPCL12,<20>
M80DEF <RLC>,OPCL3,<07>,^D40
MZ8DEF <RLCR>,OPCL11,<00>
MZ8DEF <RLD>,OPCL3,<6F>,<ED>
M80DEF <RM>,OPCL3,<F8>,^D50
M80DEF <RNC>,OPCL3,<D0>,^D50
MZ8DEF <RNO>,OPCL3,<E0>
M80DEF <RNZ>,OPCL3,<C0>,^D50
MZ8DEF <RO>,OPCL3,<E8>
M80DEF <RP>,OPCL3,<F0>,^D50
M80DEF <RPE>,OPCL3,<E8>,^D50
M80DEF <RPO>,OPCL3,<E0>,^D50
M80DEF <RRC>,OPCL3,<0F>,^D40
MZ8DEF <RRCR>,OPCL11,<08>
MZ8DEF <RRD>,OPCL3,<67>,<ED>
M80DEF <RST>,OPCL8,<C7,CF,D7,DF,E7,EF,F7,FF>,^D110
M80DEF <RZ>,OPCL3,<C8>,^D50
M80DEF <SBB>,OPCL4,<98,99,9A,9B,9C,9D,9E,9F,00,00,9E>,^D40
MZ8DEF <SBCD>,OPCL2,<43>,<ED>
M80DEF <SBI>,OPCL7,<DE>,^D70
MZ8DEF <SDED>,OPCL2,<53>,<ED>
MZ8DEF <SET>,OPCL9,<C0>
M80DEF <SHLD>,OPCL2,<22>,^D160
M80DEF <SIM>,OPCL12,<30>
MZ8DEF <SIXD>,OPCL2,<22>,<DD>
MZ8DEF <SIYD>,OPCL2,<22>,<FD>
MZ8DEF <SLAR>,OPCL11,<20>
M80DEF <SPHL>,OPCL3,<F9>,^D50
MZ8DEF <SPIX>,OPCL3,<F9>,<DD>
MZ8DEF <SPIY>,OPCL3,<F9>,<FD>
MZ8DEF <SRAR>,OPCL11,<28>
MZ8DEF <SRLR>,OPCL11,<38>
MZ8DEF <SSPD>,OPCL2,<73>,<ED>
M80DEF <STA>,OPCL2,<32>,^D130
MZ8DEF <STAI>,OPCL3,<47>,<ED>
MZ8DEF <STAR>,OPCL3,<4F>,<ED>
M80DEF <STAX>,OPCL4,<02,00,12>,^D70
M80DEF <STC>,OPCL3,<37>,^D40
M80DEF <SUB>,OPCL4,<90,91,92,93,94,95,96,97,00,00,96>,^D40
M80DEF <SUI>,OPCL7,<D6>,^D70
M80DEF <XCHG>,OPCL3,<EB>,^D40
M80DEF <XRA>,OPCL4,<A8,A9,AA,AB,AC,AD,AE,AF,00,00,AE>,^D40
M80DEF <XRI>,OPCL7,<EE>,^D70
M80DEF <XTHL>,OPCL3,<E3>,^D180
MZ8DEF <XTIX>,OPCL3,<E3>,<DD>
MZ8DEF <XTIY>,OPCL3,<E3>,<FD>
> ;END OF M80OPS
DEFINE M88OPS <
M88DEF <ACI>,OPCL6,<0C>,^D80
M88DEF <ADC>,OPCL4,<88,89,8A,8B,8C,8D,8E,8F>,^D50
M88DEF <ADD>,OPCL4,<80,81,82,83,84,85,86,87>,^D50
M88DEF <ADI>,OPCL6,<04>,^D80
M88DEF <ANA>,OPCL4,<A0,A1,A2,A3,A4,A5,A6,A7>,^D50
M88DEF <ANI>,OPCL6,<24>,^D80
M88DEF <CALL>,OPCL2,<4E>,^D110
M88DEF <CC>,OPCL2,<62>,^D90
M88DEF <CM>,OPCL2,<72>,^D90
M88DEF <CMP>,OPCL4,<B8,B9,BA,BB,BC,BD,BE,BF>,^D50
M88DEF <CNC>,OPCL2,<42>,^D90
M88DEF <CNZ>,OPCL2,<4A>,^D90
M88DEF <CP>,OPCL2,<52>,^D90
M88DEF <CPE>,OPCL2,<7A>,^D90
M88DEF <CPI>,OPCL6,<3C>,^D80
M88DEF <CPO>,OPCL2,<5A>,^D90
M88DEF <CZ>,OPCL2,<6A>,^D90
M88DEF <DCR>,OPCL4,<00,09,11,19,21,29,31,00>,^D50
M88DEF <HLT>,OPCL3,<00>,^D40
M88DEF <IN>,OPCL7,<41>,^D80
M88DEF <INR>,OPCL4,<00,08,10,18,20,28,30,00>,^D50
M88DEF <JC>,OPCL2,<60>,^D90
M88DEF <JM>,OPCL2,<70>,^D90
M88DEF <JMP>,OPCL2,<4C>,^D110
M88DEF <JNC>,OPCL2,<40>,^D90
M88DEF <JNZ>,OPCL2,<48>,^D90
M88DEF <JP>,OPCL2,<50>,^D90
M88DEF <JPE>,OPCL2,<78>,^D90
M88DEF <JPO>,OPCL2,<58>,^D90
M88DEF <JZ>,OPCL2,<68>,^D90
M88DEF <MOV>,OPCL1,<C0>,^D50
M88DEF <MVI>,OPCL5,<06,0E,16,1E,26,2E,36,3E>,^D80
M88DEF <NOP>,OPCL3,<C0>,^D50
M88DEF <ORA>,OPCL4,<B0,B1,B2,B3,B4,B5,B6,B7>,^D50
M88DEF <ORI>,OPCL6,<34>,^D80
M88DEF <OUT>,OPCL8,<51>,^D60
M88DEF <RAL>,OPCL3,<12>,^D50
M88DEF <RAR>,OPCL3,<1A>,^D50
M88DEF <RC>,OPCL3,<23>,^D30
M88DEF <RET>,OPCL3,<0F>,^D50
M88DEF <RLC>,OPCL3,<02>,^D50
M88DEF <RM>,OPCL3,<33>,^D30
M88DEF <RNC>,OPCL3,<03>,^D30
M88DEF <RNZ>,OPCL3,<08>,^D30
M88DEF <RP>,OPCL3,<13>,^D30
M88DEF <RPE>,OPCL3,<3B>,^D30
M88DEF <RPO>,OPCL3,<1B>,^D30
M88DEF <RRC>,OPCL3,<0A>,^D50
M88DEF <RST>,OPCL9,<05>,^D50
M88DEF <RZ>,OPCL3,<28>,^D30
M88DEF <SBB>,OPCL4,<98,99,9A,9B,9C,9D,9E,9F>,^D50
M88DEF <SBI>,OPCL6,<1C>,^D80
M88DEF <SUB>,OPCL4,<90,91,92,93,94,95,96,97>,^D50
M88DEF <SUI>,OPCL6,<14>,^D80
M88DEF <XRA>,OPCL4,<A8,A9,AA,AB,AC,AD,AE,AF>,^D50
M88DEF <XRI>,OPCL6,<2C>,^D80
> ;END OF M88OPS
DEFINE M08OPS <
M08DEF <ACA>,OPCL3,<88>,^D50
M08DEF <ACB>,OPCL3,<89>,^D50
M08DEF <ACC>,OPCL3,<8A>,^D50
M08DEF <ACD>,OPCL3,<8B>,^D50
M08DEF <ACE>,OPCL3,<8C>,^D50
M08DEF <ACH>,OPCL3,<8D>,^D50
M08DEF <ACI>,OPCL6,<0C>,^D80
M08DEF <ACL>,OPCL3,<8E>,^D50
M08DEF <ACM>,OPCL3,<8F>,^D80
M08DEF <ADA>,OPCL3,<80>,^D50
M08DEF <ADB>,OPCL3,<81>,^D50
M08DEF <ADC>,OPCL3,<82>,^D50
M08DEF <ADD>,OPCL3,<83>,^D50
M08DEF <ADE>,OPCL3,<84>,^D50
M08DEF <ADH>,OPCL3,<85>,^D50
M08DEF <ADI>,OPCL6,<04>,^D80
M08DEF <ADL>,OPCL3,<86>,^D50
M08DEF <ADM>,OPCL3,<87>,^D80
M08DEF <CAL>,OPCL2,<46>,^D110
M08DEF <CFC>,OPCL2,<42>,^D90
M08DEF <CFP>,OPCL2,<5A>,^D90
M08DEF <CFS>,OPCL2,<52>,^D90
M08DEF <CFZ>,OPCL2,<4A>,^D90
M08DEF <CPA>,OPCL3,<B8>,^D50
M08DEF <CPB>,OPCL3,<B9>,^D50
M08DEF <CPC>,OPCL3,<BA>,^D50
M08DEF <CPD>,OPCL3,<BB>,^D50
M08DEF <CPE>,OPCL3,<BC>,^D50
M08DEF <CPH>,OPCL3,<BD>,^D50
M08DEF <CPI>,OPCL6,<3C>,^D80
M08DEF <CPL>,OPCL3,<BE>,^D50
M08DEF <CPM>,OPCL3,<BF>,^D80
M08DEF <CTC>,OPCL2,<62>,^D90
M08DEF <CTP>,OPCL2,<7A>,^D90
M08DEF <CTS>,OPCL2,<72>,^D90
M08DEF <CTZ>,OPCL2,<6A>,^D90
M08DEF <DCB>,OPCL3,<09>,^D50
M08DEF <DCC>,OPCL3,<11>,^D50
M08DEF <DCD>,OPCL3,<19>,^D50
M08DEF <DCE>,OPCL3,<21>,^D50
M08DEF <DCH>,OPCL3,<29>,^D50
M08DEF <DCL>,OPCL3,<31>,^D50
M08DEF <HLT>,OPCL3,<00>,^D40
M08DEF <INB>,OPCL3,<08>,^D50
M08DEF <INC>,OPCL3,<10>,^D50
M08DEF <IND>,OPCL3,<18>,^D50
M08DEF <INE>,OPCL3,<20>,^D50
M08DEF <INH>,OPCL3,<28>,^D50
M08DEF <INL>,OPCL3,<30>,^D50
M08DEF <INP>,OPCL7,<41>,^D80
M08DEF <JFC>,OPCL2,<40>,^D90
M08DEF <JFP>,OPCL2,<58>,^D90
M08DEF <JFS>,OPCL2,<50>,^D90
M08DEF <JFZ>,OPCL2,<48>,^D90
M08DEF <JMP>,OPCL2,<44>,^D110
M08DEF <JTC>,OPCL2,<60>,^D90
M08DEF <JTP>,OPCL2,<78>,^D90
M08DEF <JTS>,OPCL2,<70>,^D90
M08DEF <JTZ>,OPCL2,<68>,^D90
M08DEF <LAA>,OPCL3,<C0>,^D50
M08DEF <LAB>,OPCL3,<C1>,^D50
M08DEF <LAC>,OPCL3,<C2>,^D50
M08DEF <LAD>,OPCL3,<C3>,^D50
M08DEF <LAE>,OPCL3,<C4>,^D50
M08DEF <LAH>,OPCL3,<C5>,^D50
M08DEF <LAI>,OPCL6,<06>,^D80
M08DEF <LAL>,OPCL3,<C6>,^D50
M08DEF <LAM>,OPCL3,<C7>,^D80
M08DEF <LBA>,OPCL3,<C8>,^D50
M08DEF <LBB>,OPCL3,<C9>,^D50
M08DEF <LBC>,OPCL3,<CA>,^D50
M08DEF <LBD>,OPCL3,<CB>,^D50
M08DEF <LBE>,OPCL3,<CC>,^D50
M08DEF <LBH>,OPCL3,<CD>,^D50
M08DEF <LBI>,OPCL6,<0E>,^D80
M08DEF <LBL>,OPCL3,<CE>,^D50
M08DEF <LBM>,OPCL3,<CF>,^D80
M08DEF <LCA>,OPCL3,<D0>,^D50
M08DEF <LCB>,OPCL3,<D1>,^D50
M08DEF <LCC>,OPCL3,<D2>,^D50
M08DEF <LCD>,OPCL3,<D3>,^D50
M08DEF <LCE>,OPCL3,<D4>,^D50
M08DEF <LCH>,OPCL3,<D5>,^D50
M08DEF <LCI>,OPCL6,<16>,^D80
M08DEF <LCL>,OPCL3,<D6>,^D50
M08DEF <LCM>,OPCL3,<D7>,^D80
M08DEF <LDA>,OPCL3,<D8>,^D50
M08DEF <LDB>,OPCL3,<D9>,^D50
M08DEF <LDC>,OPCL3,<DA>,^D50
M08DEF <LDD>,OPCL3,<DB>,^D50
M08DEF <LDE>,OPCL3,<DC>,^D50
M08DEF <LDH>,OPCL3,<DD>,^D50
M08DEF <LDI>,OPCL6,<1E>,^D80
M08DEF <LDL>,OPCL3,<DE>,^D50
M08DEF <LDM>,OPCL3,<DF>,^D80
M08DEF <LEA>,OPCL3,<E0>,^D50
M08DEF <LEB>,OPCL3,<E1>,^D50
M08DEF <LEC>,OPCL3,<E2>,^D50
M08DEF <LED>,OPCL3,<E3>,^D50
M08DEF <LEE>,OPCL3,<E4>,^D50
M08DEF <LEH>,OPCL3,<E5>,^D50
M08DEF <LEI>,OPCL6,<26>,^D80
M08DEF <LEL>,OPCL3,<E6>,^D50
M08DEF <LEM>,OPCL3,<E7>,^D80
M08DEF <LHA>,OPCL3,<E8>,^D50
M08DEF <LHB>,OPCL3,<E9>,^D50
M08DEF <LHC>,OPCL3,<EA>,^D50
M08DEF <LHD>,OPCL3,<EB>,^D50
M08DEF <LHE>,OPCL3,<EC>,^D50
M08DEF <LHH>,OPCL3,<ED>,^D50
M08DEF <LHI>,OPCL6,<2E>,^D80
M08DEF <LHL>,OPCL3,<EE>,^D50
M08DEF <LHM>,OPCL3,<EF>,^D80
M08DEF <LLA>,OPCL3,<F0>,^D50
M08DEF <LLB>,OPCL3,<F1>,^D50
M08DEF <LLC>,OPCL3,<F2>,^D50
M08DEF <LLD>,OPCL3,<F3>,^D50
M08DEF <LLE>,OPCL3,<F4>,^D50
M08DEF <LLH>,OPCL3,<F5>,^D50
M08DEF <LLI>,OPCL6,<36>,^D80
M08DEF <LLL>,OPCL3,<F6>,^D50
M08DEF <LLM>,OPCL3,<F7>,^D80
M08DEF <LMA>,OPCL3,<F8>,^D70
M08DEF <LMB>,OPCL3,<F9>,^D70
M08DEF <LMC>,OPCL3,<FA>,^D70
M08DEF <LMD>,OPCL3,<FB>,^D70
M08DEF <LME>,OPCL3,<FC>,^D70
M08DEF <LMH>,OPCL3,<FD>,^D70
M08DEF <LMI>,OPCL6,<3E>,^D90
M08DEF <LML>,OPCL3,<FE>,^D70
M08DEF <NDA>,OPCL3,<A0>,^D50
M08DEF <NDB>,OPCL3,<A1>,^D50
M08DEF <NDC>,OPCL3,<A2>,^D50
M08DEF <NDD>,OPCL3,<A3>,^D50
M08DEF <NDE>,OPCL3,<A4>,^D50
M08DEF <NDH>,OPCL3,<A5>,^D50
M08DEF <NDI>,OPCL6,<24>,^D80
M08DEF <NDL>,OPCL3,<A6>,^D50
M08DEF <NDM>,OPCL3,<A7>,^D80
M08DEF <NOP>,OPCL3,<C0>,^D50
M08DEF <ORA>,OPCL3,<B0>,^D50
M08DEF <ORB>,OPCL3,<B1>,^D50
M08DEF <ORC>,OPCL3,<B2>,^D50
M08DEF <ORD>,OPCL3,<B3>,^D50
M08DEF <ORE>,OPCL3,<B4>,^D50
M08DEF <ORH>,OPCL3,<B5>,^D50
M08DEF <ORI>,OPCL6,<34>,^D80
M08DEF <ORL>,OPCL3,<B6>,^D50
M08DEF <ORM>,OPCL3,<B7>,^D80
M08DEF <OUT>,OPCL8,<51>,^D60
M08DEF <RAL>,OPCL3,<12>,^D50
M08DEF <RAR>,OPCL3,<1A>,^D50
M08DEF <RET>,OPCL3,<07>,^D50
M08DEF <RFC>,OPCL3,<03>,^D30
M08DEF <RFP>,OPCL3,<1B>,^D30
M08DEF <RFS>,OPCL3,<13>,^D30
M08DEF <RFZ>,OPCL3,<0B>,^D30
M08DEF <RLC>,OPCL3,<02>,^D50
M08DEF <RRC>,OPCL3,<0A>,^D50
M08DEF <RST>,OPCL9,<05>,^D50
M08DEF <RTC>,OPCL3,<23>,^D30
M08DEF <RTP>,OPCL3,<3B>,^D30
M08DEF <RTS>,OPCL3,<33>,^D30
M08DEF <RTZ>,OPCL3,<2B>,^D30
M08DEF <SBA>,OPCL3,<98>,^D50
M08DEF <SBB>,OPCL3,<99>,^D50
M08DEF <SBC>,OPCL3,<9A>,^D50
M08DEF <SBD>,OPCL3,<9B>,^D50
M08DEF <SBE>,OPCL3,<9C>,^D50
M08DEF <SBH>,OPCL3,<9D>,^D50
M08DEF <SBI>,OPCL6,<1C>,^D80
M08DEF <SBL>,OPCL3,<9E>,^D50
M08DEF <SBM>,OPCL3,<9F>,^D80
M08DEF <SUA>,OPCL3,<90>,^D50
M08DEF <SUB>,OPCL3,<91>,^D50
M08DEF <SUC>,OPCL3,<92>,^D50
M08DEF <SUD>,OPCL3,<93>,^D50
M08DEF <SUE>,OPCL3,<94>,^D50
M08DEF <SUH>,OPCL3,<95>,^D50
M08DEF <SUI>,OPCL6,<14>,^D80
M08DEF <SUL>,OPCL3,<96>,^D50
M08DEF <SUM>,OPCL3,<97>,^D80
M08DEF <XRA>,OPCL3,<A8>,^D50
M08DEF <XRB>,OPCL3,<A9>,^D50
M08DEF <XRC>,OPCL3,<AA>,^D50
M08DEF <XRD>,OPCL3,<AB>,^D50
M08DEF <XRE>,OPCL3,<AC>,^D50
M08DEF <XRH>,OPCL3,<AD>,^D50
M08DEF <XRI>,OPCL6,<2C>,^D80
M08DEF <XRL>,OPCL3,<AE>,^D50
M08DEF <XRM>,OPCL3,<AF>,^D80
> ;END OF M08OPS
DEFINE M18OPS <
M18DEF <ADC>,OPCL2,<74>
M18DEF <ADCI>,OPCL3,<7C>
M18DEF <ADD>,OPCL2,<F4>
M18DEF <ADI>,OPCL3,<FC>
M18DEF <AND>,OPCL2,<F2>
M18DEF <ANI>,OPCL3,<FA>
M18DEF <BDF>,OPCL5,<33>
M18DEF <BGE>,OPCL5,<33>
M18DEF <BL>,OPCL5,<3B>
M18DEF <BM>,OPCL5,<3B>
M18DEF <BNF>,OPCL5,<3B>
M18DEF <BNQ>,OPCL5,<39>
M18DEF <BNZ>,OPCL5,<3A>
M18DEF <BN1>,OPCL5,<3C>
M18DEF <BN2>,OPCL5,<3D>
M18DEF <BN3>,OPCL5,<3E>
M18DEF <BN4>,OPCL5,<3F>
M18DEF <BPZ>,OPCL5,<33>
M18DEF <BQ>,OPCL5,<31>
M18DEF <BR>,OPCL5,<30>
M18DEF <BZ>,OPCL5,<32>
M18DEF <B1>,OPCL5,<34>
M18DEF <B2>,OPCL5,<35>
M18DEF <B3>,OPCL5,<36>
M18DEF <B4>,OPCL5,<37>
M18DEF <DEC>,OPCL1,<20>
M18DEF <DIS>,OPCL2,<71>
M18DEF <GHI>,OPCL1,<90>
M18DEF <GLO>,OPCL1,<80>
M18DEF <IDL>,OPCL2,<00>
M18DEF <INC>,OPCL1,<10>
M18DEF <INP>,OPCL6,<68>
M18DEF <IRX>,OPCL2,<60>
M18DEF <LBDF>,OPCL4,<C3>
M18DEF <LBNF>,OPCL4,<CB>
M18DEF <LBNQ>,OPCL4,<C9>
M18DEF <LBNZ>,OPCL4,<CA>
M18DEF <LBQ>,OPCL4,<C1>
M18DEF <LBR>,OPCL4,<C0>
M18DEF <LBZ>,OPCL4,<C2>
M18DEF <LDA>,OPCL1,<40>
M18DEF <LDI>,OPCL3,<F8>
M18DEF <LDN>,OPCL1,<00>
M18DEF <LDX>,OPCL2,<F0>
M18DEF <LDXA>,OPCL2,<72>
M18DEF <LSDF>,OPCL2,<CF>
M18DEF <LSIE>,OPCL2,<CC>
M18DEF <LSKP>,OPCL2,<C8>
M18DEF <LSNF>,OPCL2,<C7>
M18DEF <LSNQ>,OPCL2,<C5>
M18DEF <LSNZ>,OPCL2,<C6>
M18DEF <LSQ>,OPCL2,<CD>
M18DEF <LSZ>,OPCL2,<CE>
M18DEF <MARK>,OPCL2,<79>
M18DEF <NBR>,OPCL5,<38>
M18DEF <NLBR>,OPCL4,<C8>
M18DEF <NOP>,OPCL2,<C4>
M18DEF <OR>,OPCL2,<F1>
M18DEF <ORI>,OPCL3,<F9>
M18DEF <OUT>,OPCL6,<60>
M18DEF <PHI>,OPCL1,<B0>
M18DEF <PLO>,OPCL1,<A0>
M18DEF <REQ>,OPCL2,<7A>
M18DEF <RET>,OPCL2,<70>
M18DEF <RSHL>,OPCL2,<7E>
M18DEF <RSHR>,OPCL2,<76>
M18DEF <SAV>,OPCL2,<78>
M18DEF <SD>,OPCL2,<F5>
M18DEF <SDB>,OPCL2,<75>
M18DEF <SDBI>,OPCL3,<7F>
M18DEF <SDI>,OPCL3,<FD>
M18DEF <SEP>,OPCL1,<D0>
M18DEF <SEQ>,OPCL2,<7B>
M18DEF <SEX>,OPCL1,<E0>
M18DEF <SHL>,OPCL2,<FE>
M18DEF <SHLC>,OPCL2,<7E>
M18DEF <SHR>,OPCL2,<F6>
M18DEF <SHRC>,OPCL2,<76>
M18DEF <SKP>,OPCL2,<38>
M18DEF <SM>,OPCL2,<F7>
M18DEF <SMB>,OPCL2,<77>
M18DEF <SMBI>,OPCL3,<7F>
M18DEF <SMI>,OPCL3,<FF>
M18DEF <STR>,OPCL1,<50>
M18DEF <STXD>,OPCL2,<73>
M18DEF <XOR>,OPCL2,<F3>
M18DEF <XRI>,OPCL3,<FB>
>
DEFINE MF8OPS <
>
DEFINE M65DEF (OP,CLASS,VALUE,TIM<0>)<
GENM40 <OP>
..F==0
IFIDN <CLASS>,<OPCL1>,<
..F==1
<CLASS>B32!OCOP,,OP'%0
>
IFIDN <CLASS>,<OPCL5>,<
..F==1
<CLASS>B32!OCOP,,OP'%0
>
IFIDN <CLASS>,<OPCL3>,<
..F==1
<CLASS>B32!OCOP,,OP'%0
>
IFE ..F,<
HX (..T,VALUE)
<CLASS>B32!OCOP,,<TIM_^D9>+..T
>
>
DEFINE DIRDEF (SYM,TYPE)<
IFDEF SYM,<
GENM40 <SYM>
<TYPE+0>B32!DIOP,,SYM
>
>
DEFINE HX(VAR,VAL) <
VAR==0
IRPC <VAL>,<VAR==VAR*20+%%'VAL>
>
;SOME USEFUL VALUES FOR Z80
HX (IX,<DD>) ;HIGH BYTE FOR (X)
HX (IY,<FD>) ;HIGH BYTE FOR (Y)
HX (BITV,<CB>) ;OP BYTE FOR BIT/RES/SET INSTRS
;ALSO RLCR/RALR/RRCR/RARR/SLAR/SRAR/SRLR
M65BOT: ;OP TABLE BOTTOM
M65OPS ;EXPAND OPTABLE
M65TOP: -1B36 ;OP TABLE TOP
DEFINE M80DEF (OP,CLASS,VALUE,TIM<0>)<
GENM40 <OP>
..F==0
IFIDN <CLASS>,<OPCL4>,<
..F==1
<CLASS>B32!OCOP,,OP'%2
>
IFIDN <CLASS>,<OPCL5>,<
..F==1
<CLASS>B32!OCOP,,OP'%2
>
IFIDN <CLASS>,<OPCL6>,<
..F==1
<CLASS>B32!OCOP,,OP'%2
>
IFIDN <CLASS>,<OPCL8>,<
..F==1
<CLASS>B32!OCOP,,OP'%2
>
IFE ..F,<
HX (..T,VALUE)
<CLASS>B32!OCOP,,<TIM_^D9>+..T
>
>
DEFINE MZ8DEF (OP,CLASS,VALUE,HIGH<0>,TIM<0>) <
GENM40 <OP>
..F==0
IFIDN <CLASS>,<OPCL4>,<
..F==1
HX (..T,HIGH)
<CLASS>B32!Z8OP,,[<1B18+..T>,,OP'%2]
>
IFE ..F,<
HX (..H,HIGH)
HX (..L,VALUE)
<CLASS>B32!Z8OP,,[1B18+..H,,<TIM_^D9>+..L]
>
>
M80BOT: ;OP TABLE BOTTOM 8080
M80OPS
M80TOP: -1B36 ;OP TABLE TOP
DEFINE M88DEF (OP,CLASS,VALUE,TIM<0>)<
GENM40 <OP>
..F==0
IFIDN <CLASS>,<OPCL4>,<
..F==1
<CLASS>B32!OCOP,,OP'%3
>
IFIDN <CLASS>,<OPCL5>,<
..F==1
<CLASS>B32!OCOP,,OP'%3
>
IFE ..F,<
HX (..T,VALUE)
<CLASS>B32!OCOP,,<TIM_^D9>+..T
>
>
M88BOT: ;OP TABLE BOTTOM 8008
M88OPS
M88TOP: -1B36 ;OP TABLE TOP COMPATIBLE MNEMONICS
DEFINE M08DEF (OP,CLASS,VALUE,TIM<0>)<
GENM40 <OP>
HX (..T,VALUE)
<CLASS>B32!OCOP,,<TIM_^D9>+..T
>
M08BOT: ;OP TABLE BOTTOM 8008
M08OPS
M08TOP: -1B36 ;OP TABLE TOP
DEFINE M18DEF (OP,CLASS,VALUE)<
GENM40 <OP>
HX (..T,VALUE)
<CLASS>B32!OCOP,,..T
>
M18BOT: ;OP TABLE BOTTOM 1802
M18OPS
M18TOP: -1B36 ;OP TABLE TOP
DEFINE MF8DEF (OP,CLASS,VALUE)<
GENM40 <OP>
HX (..T,VALUE)
<CLASS>B32!OCOP,,..T
>
MF8BOT: ;OP TABLE BOTTOM F8
MF8OPS
MF8TOP: -1B36 ;OP TABLE TOP
DEFINE M68DEF (OP,CLASS,VALUE,TIM<0>)<
GENM40 <OP>
..F==0
IFIDN <CLASS>,<OPCL1>,<
..F==1
<CLASS>B32!OCOP,,OP'%1
>
IFIDN <CLASS>,<OPCL4>,<
..F==1
<CLASS>B32!OCOP,,OP'%1
>
IFIDN <CLASS>,<OPCL5>,<
..F==1
<CLASS>B32!OCOP,,OP'%1
>
IFE ..F,<
HX (..T,VALUE)
<CLASS>B32!OCOP,,<TIM_^D9>+..T
>
>
M68BOT: ;OP CODE TABLE FOR 6800
M68OPS
M68TOP: -1B36 ;OP TABLE TOP
DIRBOT: ;DIRECTIVE TABLE BOTTOM
DIRDEF <.ABS >
DIRDEF <.ADDR >
DIRDEF <.ASCII>
DIRDEF <.ASCIZ>
DIRDEF <.ASECT>
DIRDEF <.BLKB >
DIRDEF <.BLKW >
DIRDEF <.BYTE >
DIRDEF <.CSECT>
DIRDEF <.DEPHA>
DIRDEF <.DSABL>
DIRDEF <.ENABL>
DIRDEF <.END >
DIRDEF <.ENDC >,DCCNDE
DIRDEF <.ENDM >,DCMACE
DIRDEF <.ENDR >,DCRPTE
DIRDEF <.EOT >
DIRDEF <.EQUIV>
DIRDEF <.ERROR>
DIRDEF <.FLT2 >
DIRDEF <.FLT4 >
DIRDEF <.GLOBL>
DIRDEF <.IF >,DCCND
DIRDEF <.IFDF >,DCCND
DIRDEF <.IFEQ >,DCCND
DIRDEF <.IFF >,DCCND
DIRDEF <.IFG >,DCCND
DIRDEF <.IFGE >,DCCND
DIRDEF <.IFGT >,DCCND
DIRDEF <.IFL >,DCCND
DIRDEF <.IFLE >,DCCND
DIRDEF <.IFLT >,DCCND
DIRDEF <.IFNDF>,DCCND
DIRDEF <.IFNE >,DCCND
DIRDEF <.IFNZ >,DCCND
DIRDEF <.IFT >,DCCND
DIRDEF <.IFTF >,DCCND
DIRDEF <.IFZ >,DCCND
DIRDEF <.IIF >
DIRDEF <.IRP >,DCMAC
DIRDEF <.IRPC >,DCMAC
DIRDEF <.LIMIT>
DIRDEF <.LIST >
DIRDEF <.LOCAL>
DIRDEF <.MACR >,DCMAC
DIRDEF <.MACRO>,DCMAC
DIRDEF <.MCALL>,DCMCAL
DIRDEF <.MEXIT>
DIRDEF <.NARG >
DIRDEF <.NCHR >
DIRDEF <.NLIST>
DIRDEF <.NTYPE>
DIRDEF <.PAGE >
DIRDEF <.PDP10>
DIRDEF <.PHASE>
DIRDEF <.PRINT>
DIRDEF <.PSECT>
DIRDEF <.RADIX>
DIRDEF <.REM >
DIRDEF <.REPT >,DCRPT
DIRDEF <.ROUND>
DIRDEF <.SBTTL>
DIRDEF <.TITLE>
DIRDEF <.TRUNC>
DIRDEF <.WORD>
DIRTOP: -1B36 ;DIRECTIVE TAABLE TOP
;NOW EXPAND ACTUAL OP TABLE VALUES
DEFINE M65DEF(OP,CLASS,LST,TIM<0>)<
IFIDN <CLASS>,<OPCL1>,<
OP'%0: MKOPTB (<LST>,TIM)
>
IFIDN <CLASS>,<OPCL3>,<
OP'%0: MKOPTB (<LST>,TIM)
>
IFIDN <CLASS>,<OPCL5>,<
OP'%0: MKOPTB (<LST>,TIM)
>
>
DEFINE M80DEF(OP,CLASS,LST,TIM<0>)<
IFIDN <CLASS>,<OPCL4>,<
OP'%2: MKOPTB (<LST>,TIM)
>
IFIDN <CLASS>,<OPCL5>,<
OP'%2: MKOPTB (<LST>,TIM)
>
IFIDN <CLASS>,<OPCL6>,<
OP'%2: MKOPTB (<LST>,TIM)
>
IFIDN <CLASS>,<OPCL8>,<
OP'%2: MKOPTB (<LST>,TIM)
>
>
DEFINE MZ8DEF (OP,CLASS,LST,HGH<0>,TIM<0>) <
M80DEF (OP,CLASS,<LST>,TIM)
>
DEFINE M88DEF(OP,CLASS,LST,TIM<0>)<
IFIDN <CLASS>,<OPCL4>,<
OP'%3: MKOPTB (<LST>,TIM)
>
IFIDN <CLASS>,<OPCL5>,<
OP'%3: MKOPTB (<LST>,TIM)
>
>
DEFINE M68DEF(OP,CLASS,LST,TIM<0>)<
IFIDN <CLASS>,<OPCL1>,<
OP'%1: MKOPTB (<LST>,TIM)
>
IFIDN <CLASS>,<OPCL4>,<
OP'%1: MKOPTB (<LST>,TIM)
>
IFIDN <CLASS>,<OPCL5>,<
OP'%1: MKOPTB (<LST>,TIM)
>
>
DEFINE MKOPTB (ARGLST,TIM)<
..N==1
REPEAT ^D11,<
DEFARG (\..N)
..N==..N+1
>
..N==1
IRP <ARGLST>,<
ASGARG (\..N,ARGLST)
..N=..N+1
>
BYTE (9)Z1,Z2,Z3,Z4
BYTE (9)Z5,Z6,Z7,Z10
BYTE (9)Z11,Z12,Z13,TIM
>
DEFINE DEFARG (N) <Z'N==0>
DEFINE ASGARG (N,VAL)< HX (Z'N,VAL) >
M65OPS ;EXPAND 6502
M68OPS ;EXPAND 6800
M80OPS ;EXPAND 8080/Z80
M88OPS ;EXPAND 8008
0
SUBTTL CHARACTER DISPATCH ROUTINES
C1PNTR: POINT 4,CHJTBL(CHR), 3
C2PNTR: POINT 4,CHJTBL(CHR), 7
C3PNTR: POINT 4,CHJTBL(CHR),11
C4PNTR: POINT 4,CHJTBL(CHR),15
C5PNTR: POINT 4,CHJTBL(CHR),19
C6PNTR: POINT 4,CHJTBL(CHR),23
C7PNTR: POINT 4,CHJTBL(CHR),27
C8PNTR: POINT 4,CHJTBL(CHR),31
C9PNTR: POINT 4,CHJTBL(CHR),35
ANPNTR== C8PNTR
CHJTBL: ;CHARACTER JUMP TABLE
PHASE 0
BYTE (4) , , , , , ,QJNU, , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
TAB:! BYTE (4) , , , , , ,QJTB, , ; TAB
LF:! BYTE (4) , , , , , ,QJCR, , ; LF
BYTE (4) , , , , , ,QJVT, , ;
FF:! BYTE (4) , , , , , ,QJCR, , ; FF
CRR:! BYTE (4) , , , , , ,QJCR, , ; CR
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , ,QJNU, , ; EOF
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
SPACE:! BYTE (4) , , , , , ,QJSP, , ; SPACE
BYTE (4) , , ,EXOR, , ,QJPC, , ; !
BYTE (4) , , , ,TEDQ, ,QJPC, , ; "
BYTE (4) , , , , , ,QJPC, , ; #
BYTE (4) , , , ,TEHX, ,QJPC, , ; $
BYTE (4) , , , ,TEPC, ,QJPC, , ; %
BYTE (4) , , ,EXAN, , ,QJPC, , ; &
BYTE (4) , , , ,TESQ, ,QJPC, , ; '
BYTE (4) , , , , , ,QJPC, , ; (
BYTE (4) , , , , , ,QJPC, , ; )
BYTE (4) , , ,EXMU, , ,QJPC, , ; *
BYTE (4) , , ,EXPL,TEPL, ,QJPC, , ; +
BYTE (4) , , , , , ,QJPC, , ; ,
BYTE (4) , , ,EXMI,TEMI, ,QJPC, , ; -
BYTE (4) , , , , , ,QJPC,.DOT, ; .
BYTE (4) , , ,EXDV, , ,QJPC, , ; /
BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 0
BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 1
BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 2
BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 3
BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 4
BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 5
BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 6
BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 7
BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 8
BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 9
BYTE (4) , , , , , ,QJPC, , ; :
BYTE (4) , , , , , ,QJPC, , ; ;
BYTE (4) , , , ,TEAB, ,QJPC, , ; <
BYTE (4) , , , , , ,QJPC, , ; =
BYTE (4) , , , , , ,QJPC, , ; >
BYTE (4) , , , , , ,QJPC, , ; ?
BYTE (4) , , , ,TEOC, ,QJPC, , ; @
BYTE (4) , , , , , ,QJPC,.ALP, ; A
BYTE (4) , , , , , ,QJPC,.ALP, ; B
BYTE (4) , , , , , ,QJPC,.ALP, ; C
BYTE (4) , , , , , ,QJPC,.ALP, ; D
BYTE (4) , , , , , ,QJPC,.ALP, ; E
BYTE (4) , , , , , ,QJPC,.ALP, ; F
BYTE (4) , , , , , ,QJPC,.ALP, ; G
BYTE (4) , , , , , ,QJPC,.ALP, ; H
BYTE (4) , , , , , ,QJPC,.ALP, ; I
BYTE (4) , , , , , ,QJPC,.ALP, ; J
BYTE (4) , , , , , ,QJPC,.ALP, ; K
BYTE (4) , , , , , ,QJPC,.ALP, ; L
BYTE (4) , , , , , ,QJPC,.ALP, ; M
BYTE (4) , , , , , ,QJPC,.ALP, ; N
BYTE (4) , , , , , ,QJPC,.ALP, ; O
BYTE (4) , , , , , ,QJPC,.ALP, ; P
BYTE (4) , , , , , ,QJPC,.ALP, ; Q
BYTE (4) , , , , , ,QJPC,.ALP, ; R
BYTE (4) , , , , , ,QJPC,.ALP, ; S
BYTE (4) , , , , , ,QJPC,.ALP, ; T
BYTE (4) , , , , , ,QJPC,.ALP, ; U
BYTE (4) , , , , , ,QJPC,.ALP, ; V
BYTE (4) , , , , , ,QJPC,.ALP, ; W
BYTE (4) , , , , , ,QJPC,.ALP, ; X
BYTE (4) , , , , , ,QJPC,.ALP, ; Y
BYTE (4) , , , , , ,QJPC,.ALP, ; Z
BYTE (4) , , , , , ,QJPC, , ; [
BYTE (4) , , , , , ,QJPC, , ; \
BYTE (4) , , , , , ,QJPC, , ; ]
BYTE (4) , , , ,TEUA, ,QJPC, , ; ^
BYTE (4) , , ,EXSH, , ,QJPC, , ; _
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , ,QJLC, , ;
BYTE (4) , , , , , ,QJLC, , ;
BYTE (4) , , , , , ,QJLC, , ;
BYTE (4) , , , , , ,QJLC, , ;
BYTE (4) , , , , , ,QJLC, , ;
BYTE (4) , , , , , ,QJLC, , ;
BYTE (4) , , , , , ,QJLC, , ;
BYTE (4) , , , , , ,QJLC, , ;
BYTE (4) , , , , , ,QJLC, , ;
BYTE (4) , , , , , ,QJLC, , ;
BYTE (4) , , , , , ,QJLC, , ;
BYTE (4) , , , , , ,QJLC, , ;
BYTE (4) , , , , , ,QJLC, , ;
BYTE (4) , , , , , ,QJLC, , ;
BYTE (4) , , , , , ,QJLC, , ;
BYTE (4) , , , , , ,QJLC, , ;
BYTE (4) , , , , , ,QJLC, , ;
BYTE (4) , , , , , ,QJLC, , ;
BYTE (4) , , , , , ,QJLC, , ;
BYTE (4) , , , , , ,QJLC, , ;
BYTE (4) , , , , , ,QJLC, , ;
BYTE (4) , , , , , ,QJLC, , ;
BYTE (4) , , , , , ,QJLC, , ;
BYTE (4) , , , , , ,QJLC, , ;
BYTE (4) , , , , , ,QJLC, , ;
BYTE (4) , , , , , ,QJLC, , ;
BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
ALTMOD:!BYTE (4) , , , , , , , , ;
BYTE (4) , , , , , , , , ;
RUBOUT:!BYTE (4) , , , , , ,QJNU, , ;
DEPHASE
SUBTTL IMPURE AREA AND DEBUG PATCH AREA
.LOC ;IMPURE STORAGE
EZCOR: ;END OF ZERO'D CORE
.RELOC ;BACK TO CODE SEGMENT
IFDEF DEBUG, <
ZZZ000: BLOCK 100 ;DEBUG PATCH AREA>
END START ;....CROSS