github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-05-24 14:20:34 +00:00
Code Issues Releases Wiki Activity
Files
lars/netime
PDP-10.its/src/kldcp/11ddt.33
Lars Brinkhoff c40ea830fa 11DDT - PDP-11 debugger.
2018-06-13 21:01:39 +02:00

4332 lines
87 KiB
Plaintext
Executable File
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
; 11DDT - SYMBOLIC DEBUGGER FOR THE PDP11
VERSIO==%FNAM2
.LIF P1
.TITLE DDT FOR THE PDP-11
.SBTTL ASSEMBLY PARAMETERS
.IF P1
.MACR RDSW SW,TXT
.IF NDF SW
.PRINT \TXT - SW=\
.TTYMA SWW
%TTYFLG==%TTYFLG+1 ;FOR ERR FILE
.PRINT \SWW
\
%TTYFLG==%TTYFLG-1
SW==SWW
.ENDM
.ENDC
.ENDM
RDSW PDP11,PDP11 model no.
.IIF EQ PDP11-70, PDP11==45 ; FOR NOW AT LEAST
.IIF EQ PDP11-20, PDP11==10
.IF EQ PDP11-45
P45SW==1
P40SW==1
EISSW==1
.ENDC
.IF EQ PDP11-40
P45SW==0
P40SW==1
FPPSW==0
.ENDC
.IF EQ PDP11-34
P45SW==0
P40SW==1
EISSW==1
MAPSW==1
.ENDC
.IF EQ PDP11-10
P45SW==0
P40SW==0
FPPSW==0
EISSW==0
MAPSW==0
.ENDC
.IF EQ PDP11-03
P45SW==0
P40SW==1
FPPSW==0
MAPSW==0
.ENDC
RDSW EISSW,MUL/DIV/ASH instructions
RDSW FPPSW,Floating point processor ;11/45 style
RDSW P40SW,SOB/XOR/RTT instructions
RDSW MAPSW,Memory mapping ;11/45 style
RDSW HCOR,Size of core
RDSW TT10SW,TTY simulated through 10/11 interface
RDSW VT05SW,VT05 terminal
RDSW DEBSW,Trying to debug DDT?
;EXPUNGE INSTRUCTIONS THAT AREN'T SUPPOSED TO BE USED
.MACRO .EXPUNGE ZZ
.IRP ZZZ,<ZZ>
ZZZ===0 ;CAUSE CONSECUTIVE TERMS ERROR MESSAGE, AND EXPUNGE FROM DDT SYM TAB
.ENDM
.ENDM
.LIF Z EISSW
.EXPUNGE <MUL,DIV,ASH,ASHC>
.LIF Z FPPSW
.EXPUNGE <LDD,STD,STCDI,LDCID,ADDD,SUBD,MULD,DIVD,MODD,TSTD,LDFPS,STFPS>
.LIF Z MAPSW
.EXPUNGE <MFPI,MTPI,MFPD,MTPD>
.ENDC ;IF P1
.SBTTL DEFINITIONS
R0=%0
R1=%1
R2=%2
R3=%3
R4=%4
R5=%5
SP=%6
PC=%7
.XCREF R0,R1,R2,R3,R4,R5,SP,PC
.IF NE FPPSW
AC0==%0
AC1==%1
AC2==%2
AC3==%3
AC4==%4
AC5==%5
.ENDC
.LIF NE PDP11-03
PS=177776 ; PROCESSOR STATUS WORD
PR7==340 ; PROCESSOR PRIORITY DEFINITIONS
.MACRO .IREPT N,BOD
.REPT N
BOD
.ENDR
.ENDM
.SBTTL INSTRUCTION MACROS
.IF NE PDP11-03
.IF NE PDP11-34
; MTPS AND MFPS MACROS SIMULATE PS INTRUCTIONS ON 11/03 (LSI)
; AND 11/34 PROCESSORS.
.MACRO MTPS SRC
MOVB SRC,@#PS
.ENDM
.MACRO MFPS DST
MOVB @#PS,DST
.ENDM
.ENDC
.ENDC
.IF EQ P45SW
; SPL MACRO CHANGES THE THE PRIORITY TO ITS ARGUMENT. IT
; (UNFORTUNATELY) DOES THIS WITH A MOV, THUS CLOBBERING
; THE CONDITION CODES AND SUCH.
.MACRO SPL N
.IIF NE N, MTPS #N*40
.ELSE
.IIF EQ PDP11-03, MTPS #0
.IELSE CLRB @#PS
.ENDC
.ENDM
.ENDC
.IF EQ P40SW
; SOB MACRO EXPANDS INTO CODE WHICH PERFORMS IDENTICALLY TO
; THE SOB INSTRUCTION FOUND ON MORE POWERFULL 11 PROCESSORS
.MACRO SOB R,ADDR
DEC R
BNE ADDR
.ENDM
; XOR MACRO SIMULATES XOR INSTRUCTION ON 11/45.
; CAUTION: THIS MACRO IS NOT INTENDED TO WORK WITH
; (RN)+, -(RN) OR (SP) DESTINATIONS.
.MACRO XOR R,D
MOV R,-(SP)
BIC D,(SP)
BIC R,D
BIS (SP)+,D
.ENDM
RTT==RTI
.ENDC ; .IF EQ P40SW
.LIF Z DEBSW
DDTST=HCOR-12 ;LOCATION WHICH HAS STATUS TO USE WHEN DDT RUNNING
RCSR==177560
RDB==177562
TCSR==177564
TDB==177566
.IFNZ TT10SW
RCSR10==HCOR-4
RDB10==HCOR-4
TCSR10==HCOR-2
TDB10==HCOR-2
TT10FL==HCOR-6
.ENDC
.IIF NE P45SW, STLIMR==177774
NXMVEC==4
.IFZ DEBSW
BPTVEC==14 ;BREAKPOINT LOCATION
BPTOP==3 ;INSTRUCTION TO USE AS BREAKPOINT
.IFF
BPTVEC==20 ;USE IOT TRAP FOR BREAKPOINT LOCATION IF DEBUGGING
BPTOP==4 ;USE IOT INSTEAD OF BPT
.ENDC
LPDL==100
NBPTS==7
;ASSEMBLE BREAKPOINT VECTOR. IF WE WORK BY LOADING A PDP11 WITH A DDT
;AND A PROGRAM THAT CONTAINS BPT INSTRUCTIONS, THEN STARTING THAT PROGRAM
;WITHOUT EVER STARTING DDT, THIS ENSURES THAT THE BPTS WIN.
.=BPTVEC
.WORD BPTTRP,PR7
.SBTTL SYMBOL MACROS
;TYPEIT, DEFSYM, INISYM, ENDSYM, DEFOP, OPBLK
.MACR TYPEIT STR
JSR R5,TYPE
.IRPC X,STR
.BYTE ''X
.ENDM
.BYTE 0
.EVEN
.ENDM
.MACR INISYM
HKWORD==0
RGWORD==0
SYMBIT==1
.ENDM
.MACR DEFSYM S1,S2,VAL,REG,HKILL
.=.-6
.RAD50 /S1/
.RAD50 /S2/
VAL
.=.-6
.IIF NB REG, RGWORD==RGWORD+SYMBIT
.IIF NB HKILL, HKWORD==HKWORD+SYMBIT
SYMBIT=2*SYMBIT
.IFZ SYMBIT
.=LSTBEG-4
HKWORD
RGWORD
INISYM
LSTBEG==LSTBEG-<2*<2+<20*3>>>
.=LSTBEG-4
.ENDC
.ENDM
.MACR ENDSYM
.IFNZ SYMBIT-1
LSTSY==.
.=LSTBEG-4
HKWORD
RGWORD
.ENDC
.IFZ SYMBIT-1
LSTSY==.+4
.ENDC
.ENDM
.MACR DEFOP NAME,VALUE
.RAD50 /NAME/
.LIF LE .LENGTH NAME,-3
0
VALUE
.ENDM
.MACR OPBLK TYPIN,TYPOUT,MASK
0
TYPIN
TYPOUT
MASK
.ENDM
.SBTTL DDT
.IFZ DEBSW
.IIF NZ FPPSW, .=HCOR-30000
.IELSE .=HCOR-22000 ;IF NO FL PT, SAVE SOME SPACE
USRBEG==BPTVEC+4
.IFF
.=1000
.ENDC ;DEBSW
DDT: .LIF NE MAPSW
MOV @#PS,UST
.LELSE
MFPS UST
TSTB DDTINI
BNE DDT2 ;HAVE BEEN HERE BEFORE
SPL 7
MOV #PR7,UST
MOV #PR7,DDTST
INCB DDTINI
DDT2: MOV #DDT1,SAVRET
JMP SAVEST ;LIKE JSR BUT WITHOUT STACK
DDT1: CLRB PROCF ;CAN'T PROCEED FROM HERE
CLRB A2PF ;CLEAR $$P FLAG
CMD: JSR PC,CRLFS ;TYPE <CR><LF>*
CMD1: CLR VALP
CLR VALRF
CMD3: MOV #PDL,SP
JSR PC,EVAL
CMD2: TYPEIT < >
BR CMD1
QERR: TYPEIT <? >
BR CMD1
NXMTRP: TYPEIT < ?NXM? >
BR CMD1
;SAVEST, RESTST
SAVRET: 0
SAVEST: TSTB PROGF
BNE SAVES1 ;HAVE ALREADY SAVED THE STATE
MOV SP,KSP ;WE'RE IN KERNEL MODE NOW
MOV #PDL,SP
.IF NE P45SW
MOV @#STLIMR,USTLIM
MOV #<<PDL-LPDL>&177400-1>,@#STLIMR ;LET'S HEAR IT FOR DEC
MOVB #20,@#PS+1 ;PREVIOUS MODE SUPERVISOR
MFPD SP ;PUSH SUPERVISOR SP
MOV (SP)+,SSP ;POP SUPERVISOR SP
BIS #030000,@#PS ;PREVIOUS MODE USER
MFPD SP ;PUSH USER SP
MOV (SP)+,USP ;POP USER SP
MOVB #10,@#PS+1 ;KERNEL MODE, REGISTER SET 1.
JSR R0,SAVGR ;SAVE THOSE REGISTERS
UR10
BIC #004000,@#PS ;SAVE REGISTER SET 0
.ENDC ;P45SW
JSR R0,SAVGR
UR0
MOV @#NXMVEC,UNXMA
MOV @#NXMVEC+2,UNXMS
.IFNZ FPPSW
STFPS UFPST
LDFPS #040200 ;FLOATING DOUBLE, ROUND, SHORT INTEGERS
MOV #FAC0,R0
STD AC0,(R0)+
STD AC1,(R0)+
STD AC2,(R0)+
STD AC3,(R0)+
LDD AC4,AC0
STD AC0,(R0)+
LDD AC5,AC0
STD AC0,(R0)+
.ENDC ;FPPSW
MOV #NXMTRP,NXMVEC
MOV DDTST,NXMVEC+2
JSR PC,BPTRST ;PUT INSTRUCTIONS BACK AT BREAKPOINTS
INCB PROGF ;INDICATE WE'VE SAVED THE WORLD
SAVES1: MOV #BPTTRP,BPTVEC
MOV DDTST,BPTVEC+2
MFPS DDTST
MOV #PDL,SP
.IIF NE FPPSW, LDFPS #040200 ;FLOATING DOUBLE, ROUND, SHORT INTEGERS
MOV #2,LFINC
JSR PC,RSTMD ;COPY PERMANENT MODES TO TEMPORARY
JMP @SAVRET
SAVGR: MOV (SP)+,@(R0)+ ;SAVE CURRENT REGISTER SET STARTING
MOV R0,-(SP) ;AT ADDRESS FOLLOWING THE CALL.
MOV -2(R0),R0
TST (R0)+
MOV R1,(R0)+
MOV R2,(R0)+
MOV R3,(R0)+
MOV R4,(R0)+
MOV R5,(R0)+
RTS PC
RSTRET: 0
RESTST:
.IFNZ FPPSW
LDFPS #040200 ;FLOATING DOUBLE, ROUND, SHORT INTEGERS
MOV #FAC0+60,R0
LDD -(R0),AC0
STD AC0,AC5
LDD -(R0),AC0
STD AC0,AC4
LDD -(R0),AC3
LDD -(R0),AC2
LDD -(R0),AC1
LDD -(R0),AC0
LDFPS UFPST
.ENDC ;FPPSW
MOV UNXMS,NXMVEC+2
MOV UNXMA,NXMVEC
.IFNZ P45SW
BIS #004000,@#PS ;RESTORE REGISTER SET 1
MOV #UR10+14,R0
JSR PC,RSTGR
BIC #004000,@#PS ;RESTORE REGISTER SET 0
.ENDC ;P45SW
MOV #UR0+14,R0
JSR PC,RSTGR
.IFNZ P45SW
CMP USP,SYMEND ;IS THIS STACK REASONABLE?
BHIS RSTBS1 ;NO
MOV USP,-(SP) ;PUSH USER MODE R6
RSTBS2: BIS #030000,@#PS ;PREVIOUS MODE USER
MTPD SP ;POP USER R6
CMP SSP,SYMEND ;IS THIS STACK REASONABLE?
BHIS RSTBS3 ;NO
MOV SSP,-(SP) ;PUSH SUPERVISOR R6
RSTBS4: BIC #020000,@#PS ;PREVIOUS MODE SUPERVISOR
MTPD SP ;POP SUPERVISOR R6
.ENDC ;P45SW
CMP KSP,#160000 ;IS THIS STACK REASONABLE
BHI RSTBS5 ;NO, IT'S IN THE I/O PAGE
CMP KSP,#HCOR
BHI 1$ ;YES, IN CORE ABOVE DDT (E.G. "KLDCP")
CMP KSP,SYMEND
BHI RSTBS5 ;NO, IT POINTS INTO DDT OR SYMBOL TABLE
1$: MOV KSP,SP
BEQ RSTBS5 ;NO, IT'S ZERO
RSTBS6: CLRB PROGF
.IIF NE P45SW, MOV USTLIM,@#STLIMR
JMP @RSTRET
.IFNZ P45SW
RSTBS1: MOV #GARBST,-(SP) ;POINT USER STACK POINTER AT SAFE GARBAGE STACK
BR RSTBS2
RSTBS3: MOV #GARBST,-(SP) ;POINT SUP STACK POINTER AT SAFE GARBAGE STACK
BR RSTBS4
.ENDC ;P45SW
RSTBS5: MOV #GARBST,SP ;POINT KER STACK POINTER AT SAFE GARBAGE STACK
BR RSTBS6
RSTGR: MOV -(R0),R5 ;RESTORE CURRENT REGISTER SET FROM
MOV -(R0),R4 ;LOCATION IN R0.
MOV -(R0),R3
MOV -(R0),R2
MOV -(R0),R1
MOV -(R0),R0
RTS PC
;EVAL, EVALI
EVALI: JSR PC,EVALI1
TSTB EVINLF ;IF READING STUFF IN PARENS
BNE EVALIX ;THEN WE'VE GOT IT ALL NOW
MOV R0,-(SP)
JSR PC,EVPOP
MOV (SP)+,R0
EVALIX: RTS PC
;VALUE STACK HAS EITHER FLOATING POINT VALUES OR INTEGER VALUES
;ACCORDING TO EVSIZE BEING NON-ZERO OR ZERO RESPECTIVELY. THE
;OP STACK CONTAINS ONE WORD PER VALUE, THE HIGH BYTE HAS THE
;OPERATOR NUMBER AND THE LOW BYTE HAS THE PRECEDENCE.
;OPERATOR OPERATOR NUMBER PRECEDENCE
; ( 1 1
; + 2 2
; - 3 2
; * 4 3
; ! 5 3
; - 6 4 (UNARY MINUS)
; ,, 7 0 (BYTE SEPARATOR)
;DURING EVALUATION R4 POINTS TO THE VALUE STACK R5 POINT TO THE
;OP STACK, R2 CONTAINS THE OP NUMBER AND R3 THE PRECEDENCE
EVAL: CLRB EVINSF
CLRB EVINLF
EVALI1: MOV #OPPDL,R5 ;SET UP OP PDL
MOV #VALPDL,R4 ;SET UP VAL PDL
CLR -(R5) ;PUSH INITIAL OP OF 0 WITH 0 PRECEDENCE
CLR EVSIZE
CLRB POPF
CLRB EVREGF
CLRB EVNOVF
CLRB BRKFL
EVALLP: MOV R4,-(SP)
MOV R5,-(SP)
JSR PC,EXPR ;READ VALUE AND SEPARATOR
MOV (SP)+,R5
MOV (SP)+,R4
EVALCE: TSTB EXSYMF
BEQ EVALNS
JSR PC,INSTIN
EVALNS: MOV R0,-(SP)
TSTB POPTB(R0)
BEQ EVALNP ;NO EVPOP NOW
JSR PC,EVPOP
EVALNP: MOV (SP)+,R0
TSTB EVINSF
BEQ EVALNI
TSTB INLTB(R0)
BGT EVALSD ;SEPARATOR DURING INSTRUCTION
BMI EVERR ;ILLEGAL IN INSTRUCTION
EVALNI: ASL R0
JMP @CMDTB(R0) ;DISPATCH ON SEPARATOR
ASP:
APLUS: JSR PC,EVSYM ;EVALUATE SYMBOL IF IT EXISTS
JSR PC,ANOVAL ;CHECK ON VALUE
TSTB EXNUMF ;SEE IF THERE IS A VALUE
BEQ EVALLP ;IGNORE UNARY PLUS
TSTB EVNOVF ;SEE IF EXPECTING NO VALUE
BNE EVERR ;YES
MOV #2*2,R2 ;PLUS IS OPERATOR NUMBER 2
APLUS1: MOV #2,R3 ;WITH PRECEDENCE 2
EVALOP: CMPB R3,(R5)
BLE EVALEV ;NEW PRECEDENCE IS LE OLD - EVALUATE NOW
TSTB EVSIZE+1 ;SEE IF EVSIZE IS DEFINED YET
BNE EVALP1 ;IT IS
INCB EVSIZE+1
TSTB FLTF ;SEE IF FLOATING
BEQ EVALP1 ;NO
INCB EVSIZE ;YES
EVALP1: TSTB FLTF
BNE EVALP2 ;NEW VALUE IS FLOATING
TSTB EVSIZE ;VALUE IS INTEGER, CHECK TO SEE WE'RE DOING INTEGER CALC
BNE EVERR ;MIXED MODE
ACOMME: MOV R1,-(R4) ;PUT INTEGER VALUE ON VAL PDL
BR EVALP3 ;GO PUSH OP NOW
.IFNZ FPPSW
EVALP2: TSTB EVSIZE ;CHECK TO SEE THAT WE ARE IN FLOATING MODE
BEQ EVERR ;MIXED MODE
LDD FLT1,AC0
STD AC0,-(R4) ;PUT DOUBLE FLOATING VALUE ON VAL PDL
.ENDC ;FPPSW
EVALP3: MOV R3,-(R5) ;PUSH NEW PRECEDENCE
MOVB R2,1(R5) ;AND OPERATOR NUMBER
BR EVALLP
AMINUS: JSR PC,EVSYM ;EVALUATE SYMBOL IF IT EXISTS
JSR PC,ANOVAL
TSTB EXNUMF ;SEE IF THERE IS A VALUE
BEQ UMINUS ;UNARY MINUS
MOV #3*2,R2 ;BINARY MINUS IS OPERATOR NUMBER 3
BR APLUS1 ;WITH SAME PRECEDENCE AS BINARY PLUS
AQUOT: MOV #2,R2
BR ASTAR1
ASTAR: CLR R2
ASTAR1: JSR PC,EVSYM ;EVALUATE SYMBOL IF IT EXISTS
JSR PC,ANOVAL
TSTB EXNUMF ;SEE IF THERE IS A VALUE
BEQ EVERR ;NO SUCH THING AS UNARY STAR
ADD #4*2,R2 ;STAR IS OPERATOR NUMBER 4, ! IS 5
MOV #3,R3 ;WITH PRECEDENCE 2
BR EVALOP
.IIF Z FPPSW,EVALP2:: ;IF NO FL PT HDWR, ANY USE OF FL PT IS ERROR
EVERR: JMP QERR
UMINUS: MOV #6004,-(R5) ;OP 6, PRECEDENCE 4 TO OP STACK
BR EVALLP
EVALEV: MOV (R5)+,R0 ;POP OFF TOP OF OP STACK INTO R0
BEQ EVALPP ;OVER POPPED OP STACK
SWAB R0 ;GET OPERATOR NUMBER INTO LOW BYTE
BIC #177400,R0 ;FLUSH PRECEDENCE
CMP R0,#6*2 ;IS IT UNARY MINUS?
BEQ EUMIN ;YES
CMP R0,#1*2 ;IS IT LEFT PAREN
BEQ ELPAR ;YES
.IFNZ FPPSW
TSTB EVSIZE
BEQ EVALV1 ;INTEGER MODE
TSTB FLTF
BEQ EVERR ;MIXED MODE
LDD (R4)+,AC0 ;TOP OF VALUE STACK
EVALV2: JMP @EVLTB-4(R0) ;EVALUATE THE OPERATOR
EVALV1: TSTB FLTF
BNE EVERR ;MIXED MODE
MOV (R4)+,TVAL ;TOP OF VALUE STACK
BR EVALV2
.IFF ;INTEGERS ONLY ON THIS MACHINE
MOV (R4)+,TVAL ;TOP OF VALUE STACK
JMP @EVLTB-4(R0)
.ENDC ;FPPSW
EVALSD: MOV R0,-(SP)
JSR PC,EVPOP ;DO EVPOP ON INSTRUCTION SEP REGARDLESS OF POPTB
MOV (SP)+,R0
TSTB EVSIZE+1
BEQ EVERR ;NO VALUE GIVEN
EVLSD1: TSTB EVSIZE
BNE EVERR ;FLOATING VALUE GIVEN
RTS PC
;EVLTB OPERATOR EVALUATION DISPATCH TABLE
EVLTB: EPLUS
EMINUS
ESTAR
EQUOT
0
ECOMMA
.IFNZ FPPSW
EPLUS: TSTB FLTF
BEQ EPLUS1 ;DO PLUS FOR INTEGER
ADDD FLT1,AC0
EPLUS3: STD AC0,FLT1
EPLUS2: BR EVALOP
EPLUS1: ADD TVAL,R1
BR EVALOP
EMINUS: TSTB FLTF
BEQ EMIN1 ;DO SUBTRACT FOR INTEGER
SUBD FLT1,AC0
BR EPLUS3
EMIN1: NEG R1
BR EPLUS1
ESTAR: TSTB FLTF
BEQ ESTAR1 ;DO MULTIPLY FOR INTEGER
MULD FLT1,AC0
BR EPLUS3
ESTAR1: MUL TVAL,R1
BR EPLUS2
EQUOT: TSTB FLTF
BEQ EQUOT1 ;DO DIVIDE FOR INTEGER
TSTD FLT1
CFCC ;COPY CONDITION CODES
BEQ EVERR ;DON'T DIVIDE BY ZERO
DIVD FLT1,AC0
BR EPLUS3
EQUOT1: TST TVAL
BEQ EVERR ;DON'T DIVIDE BY ZERO
MOV R0,-(SP) ;SAVE R0
CLR R0
MOV R1,-(SP)
MOV TVAL,R1
DIV (SP),R0 ;DO THE DIVISION. QUOTIENT IN R0
TST (SP)+
MOV R0,R1 ;QUOTIENT TO R1
MOV (SP)+,R0 ;POP R0
BR EPLUS2
EUMIN: TSTB FLTF
BEQ EUMIN1
NEGD FLT1
BR EPLUS2
EUMIN1: NEG R1
BR EPLUS2
.ENDC ;FPPSW
.IFZ FPPSW ;SMALLER ROUTINES FOR INTEGERS ONLY
EMINUS: NEG R1
EPLUS: ADD TVAL,R1
EPLUS2: BR EVALOP
ESTAR: MOV #EVALOP,-(SP) ;PUSH NORMAL RETURN
MOV R0,-(SP) ;IF NO FPP, PROBABLY NO EAE EITHER
CLR R0 ; SO DO IT BY HAND
TST R1
BEQ ESTARX
BPL ESTAR3
NEG R1
MOV #EUMIN,2(SP) ;RESULT WILL NEED TO BE NEGATED
ESTAR3: ADD TVAL,R0 ;WHO CARES HOW SLOW IT IS?
SOB R1,ESTAR3
ESTARX: MOV R0,R1
MOV (SP)+,R0
RTS PC
EQUOT: CLR -(SP) ;SIGN CONTROL
MOV R0,-(SP)
MOV R2,-(SP)
MOV TVAL,R2 ;DIVIDE R1 BY TVAL
BEQ EVERR
BPL EQUOT2
COM 4(SP)
NEG R2
EQUOT2: TST R1
BPL EQUOT3
COM 4(SP)
NEG R1
EQUOT3:
.IIF NZ EISSW, DIV R2,R1
.IIF Z EISSW, JSR PC,DIVIDE
MOV (SP)+,R2
MOV (SP)+,R0
TST (SP)+ ;CHECK SIGNS OF DIVIDEND AND DIVISOR
BEQ EPLUS2 ;DROP THROUGH IF QUOTIENT SHOULD BE NEGATIVE
EUMIN: NEG R1 ;UNARY MINUS
BR EPLUS2
.ENDC ;FPPSW
ELPAR: TSTB POPF
BNE ARPAR3 ;FINISHING OFF OP STACK. LIKE ANOTHER R PAREN
TSTB EVINLF
BEQ ELPAR9
TST (R5) ;ARE WE AT THE BOTTOM OF THE OP STACK?
BEQ EVLSD1 ;READ (XXX) FOR INSTRUCTION TYPEIN
ELPAR9:
.IFNZ FPPSW
TSTB EVSIZE
BEQ ELPAR1
LDD FLT1,AC0
STD AC0,-(R4)
JMP EVALLP
.ENDC ;FPPSW
ELPAR1: MOV R1,-(R4)
JMP EVALLP
ECOMMA: MOVB R1,TVAL+1
MOV TVAL,R1
SWAB R1
BR EPLUS2
;ALPAR, ARPAR, EVPOP, EVALPP, ANOVAL
EVALPP: TSTB POPF
BEQ ALPERR ;ERROR IF NOT INTENTIONAL
TSTB EVREGF
BNE EVLPP1 ;BRANCH IF REGISTER VALUE
EVLPP2: TSTB EVSIZE+1
BEQ EVLPP3 ;NO NEW VALUE, COPY LAST TO CURRENT
MOVB EVREGF,LVREGF ;SAVE REGISTER FLAG
MOVB EVSIZE,LVFLTF ;AND FLOATING VALUE FLAG
MOV R1,LVAL ;AND INTEGER VALUE
.IFNZ FPPSW
LDD FLT1,AC0
STD AC0,LFVAL ;AND FLOATING VALUE
.ENDC ;FPPSW
RTS PC ;RETURN TO WHOEVER CALLED EVPOP
EVLPP3: MOVB LVREGF,EVREGF
MOVB LVFLTF,EVSIZE
MOV LVAL,R1
.IFNZ FPPSW
LDD LFVAL,AC0
STD AC0,FLT1
.ENDC ;FPPSW
EVPOPX: RTS PC
EVLPP1: TSTB EVSIZE
BNE ALPERR ;FLOATING REGISTER VALUE LOSES
TST R1
BMI ALPERR ;NEGATIVE REGISTER VALUE LOSES
CMP R1,#7
BLE EVLPP2 ;REGISTER VALUE BETWEEN 0 AND 7 OK
ALPERR: JMP QERR
ALPAR1: TSTB EVINSF
BEQ ALPERR
JSR PC,EVPOP ;GOT VAL( WHILE READING INSTRUCTION. GET VAL AND RET
MOV #'(,R0
RTS PC
ALPAR: TSTB EXSYMF
BNE ALPAR1 ;NOT EXPECTING VALUE AT THIS TIME
TSTB EXNUMF
BNE ALPAR1 ;DON'T WANT VALUE
TSTB EVNOVF
BNE ALPAR1
MOV #1001,-(R5) ;PUSH OPERATOR 1 PRECEDENCE 1 ON THE OP STACK
JMP EVALLP
EVPOP1: TSTB EXNUMF
BEQ EVALPP ;NO VALUES ANYWHERE, RETURN
INCB EVSIZE+1
TSTB FLTF
BEQ EVPOP3
INCB EVSIZE
BR EVPOP3
EVPOP: TSTB POPF
BNE EVPOPX ;WE'VE BEEN HERE BEFORE
INCB POPF
ARPAR: JSR PC,EVSYM ;EVALUATE SYMBOL IF IT EXISTS
TSTB EVSIZE+1
BEQ EVPOP1 ;DON'T HAVE ANY VALUE YET
TSTB EXNUMF
BEQ ARPAR1 ;THERE IS NO VALUE, USE TOP TWO ON THE STACK
EVPOP3: TSTB EVNOVF ;SEE IF NO VALUE EXPECTED
BNE ALPERR ;YES
ARPAR3: INCB EVNOVF ;SAY EXPECTING NO VALUE
CLR R3 ;RIGHT PAREN IS PRECEDENCE 0
JMP EVALEV ;DO EVALUATION NOW, DOWN TO MATCHING LEFT PAREN
ARPAR1: TSTB EVNOVF ;THERE IS NO VALUE, SEE IF EXPECTING NO VALUE
BEQ ARPAR4 ;NO VALUE WAS UNEXPECTED. USE ZERO OR ONE AS APPROP
.IFNZ FPPSW
TSTB EVSIZE ;NO VALUE WAS EXPECTED. USE TOP OF VAL STACK
BEQ ARPAR2 ;INTEGER
LDD (R4)+,AC0
STD AC0,FLT1
INCB FLTF ;USE TOP OF VAL STACK AS FLOATING POINT VALUE
BR ARPAR3
.ENDC ;FPPSW
ARPAR2: MOV (R4)+,R1 ;USE TOP OF VAL STACK AS INTEGER VALUE
BR ARPAR3
ARPAR4: CMPB (R5),#2 ;INVENT A VALUE. SEE WHAT THE OPERATOR IS
BEQ ARPAR5 ;+ OR -
CMPB (R5),#3
BEQ ARPAR6 ;MULT OR DIVIDE
CMPB 1(R5),#7*2
BEQ ARPAR5 ;,,
CMPB (R5),#4
BR ALPERR
ARPAR5: CLR R1 ;UNARY MINUS OR + OR -
.IIF NE FPPSW, CLRD FLT1 ;INVENT SOME ZEROS
ARPAR7: MOVB EVSIZE,FLTF ;SET FLTF IF DOING FLOATING POINT CALCULATION
BR ARPAR3
ARPAR6: MOV #1,R1 ;INVENT SOME ONES
.IIF NE FPPSW, LDD D1,AC0
.IIF NE FPPSW, STD AC0,FLT1
BR ARPAR7 ;AND SET FLTF IF WE'RE DOING FLOATING CALCULATION
ANOVAL: TSTB EXNUMF
BEQ ANOVA1 ;THERE WAS NO VALUE
TSTB EVNOVF
BNE ALPERR ;WAS VALUE AND EXPECTING NO VALUE. LOSE
ANOVAX: RTS PC
ANOVA1: TSTB EVNOVF
BEQ ANOVAX ;WAS NO VALUE AND NOT EXPECTING NO VALUE
INCB EXNUMF ;USE TOP OF STACK AS VALUE. I.E. WE HAVE A VALUE NOW
CLRB EVNOVF
.IFNZ FPPSW
TSTB EVSIZE
BEQ ANOVA2 ;INTEGER
LDD (R4)+,AC0 ;POP TOP OF VALUE STACK
STD AC0,FLT1 ;AND USE AS FLOATING POINT VALUE
INCB FLTF ;INDICATE FLOATING POINT VALUE
RTS PC
.ENDC ;FPPSW
ANOVA2: MOV (R4)+,R1 ;POP TOP OF VALUE STACK AND USE AS INTEGER VALUE
RTS PC
;INSTIN, GETSD, CGTRIN, GETRIN, CGETSD, GETREG, GETADD
INSTIN: MOV #OPCTB,R2 ;START OF OPCODE TABLE
INSTI1: TST (R2)
BNE INSTI2 ;NOT CHANGING BLOCKS NOW
TST (R2)+ ;SKIP OVER INITIAL ZERO
MOV (R2)+,R3 ;SAVE TYPIN ADDRESS, SKIP TO TYPEOUT ADDRESS
BEQ INSTNF ;IF TYPIN IS ZERO THE LIST IS DONE
CMP (R2)+,(R2)+ ;SKIP TYPEOUT ADDRESS AND MASK
INSTI2: CMP SYM,(R2)
BNE INSTI3
CMP SYM1,2(R2)
BEQ INSTIF ;MATCH
INSTI3: ADD #6,R2
BR INSTI1
INSTNF: RTS PC ;NOT AN INSTRUCTION
INSTIF: TSTB EVINSF
BNE INSTIE ;ERROR IF INSTRUCTION ALREADY STARTED
MOV #PDL-2,SP ;DON'T RETURN TO EVAL
INCB EVSIZE+1 ;IN CASE OF SINGLE SYMBOL INSTRUCTIONS
INCB EVINSF
CLR INREL
MOV #INREL,INRELP
MOVB #1,EVINSC ;START OFF INSTRUCTION COUNT AT 1 WORD
MOV 4(R2),INS1 ;SAVE INSTRUCTION VALUE
MOV #INS2,INSP
JMP (R3) ;GO TO TYPIN ADDRESS
INSTIE: JMP QERR
;READ SOURCE OR DESTINATION FIELD. RETURN 6 BITS OF ADDRESS MODE AND REGISTER
;IN R2, STORES VALUE IF ANY IN @INSP AND UPDATES INREL AND INSP AND INRELP
;AND EVINSC, RETURNS SEPARATOR IN R0
GETSD: CLRB INSSDD
GETSD1: JSR PC,TYI
CMP R0,#40
BEQ GETSD1
CMP R0,#11
BEQ GETSD1
CMP R0,#'@
BEQ GTSDAT
GETSD2: CMP R0,#'#
BEQ GTSDNB
CMP R0,#'-
BEQ GTSDMI
CMP R0,#'(
BEQ GTSDLP
MOVB R0,SNEAK1 ;PUT CHARACTER BACK WHERE TYI CAN READ IT
GETSD4: JSR PC,EVALI ;GET NEXT VALUE
CMP R0,#'(
BEQ GTSDID ;VALUE FOLLWED BY REG IN PARENS
TSTB EVREGF
BNE GETSDR
BISB #67,INSSDD ;INDEX BY PC
SUB INSP,R1 ;SUBTRACT APPROPRIATE PC FROM VALUE
ADD #INS2-4,R1
MOV R1,@INSP
INCB @INRELP ;INDICATE @INSP NEEDS TO BE RELOCATED
GETSD3: ADD #2,INSP
INCB EVINSC
INC INRELP
GETSDX: MOVB INSSDD,R2 ;SIGN BIT WON'T EVER BE ON IN INSSDD BYTE
RTS PC
GETSDR: BISB R1,INSSDD ;PUT REGISTER NUMBER IN INSSDD
BR GETSDX ;RETURN WITHOUT ADVANCING POINTERS (DIDN'T USE MEM)
GTSDAT: BIS #10,INSSDD ;INDICATE DEFERRED MODE
BR GETSD1
GTSDNB: BISB #27,INSSDD
JSR PC,EVALI
TSTB EVREGF
BNE GETERR ;#%X LOSES
MOV R1,@INSP
BR GETSD3 ;BUMP BOTH INSP AND INRELP AND RETURN
GTSDMI: JSR PC,TYI
CMP R0,#'(
BNE GTSDM1
MOVB R0,SNEAK1 ;PUT BACK LEFT PAREN
BISB #40,INSSDD ;INDICATE AUTO DEC
JSR PC,EVALI ;GET REGISTER NUMBER IN PARENS
TSTB EVREGF
BEQ GETERR ;DIDN'T GET A REGISTER VALUE
BR GETSDR
GTSDM1: MOVB R0,SNEAK2 ;PUT BACK CHAR THAT WASN'T LEFT PAREN
MOVB #'-,SNEAK1 ;AND MINUS AND READ IT ALL AS AN EXPRESSION
BR GETSD4
GTSDLS: MOVB R0,SNEAK1 ;PUT BACK LEFT PAREN
INCB EVINLF ;CAUSE EVALI TO RETURN AFTER CLOSED PAREN
JSR PC,EVALI ;READ EXPRESSION IN PARENS
CLRB EVINLF ;CLEAR THE FLAG FOR FURTHER CALLS ON EVALI
TSTB EVREGF
BEQ GETERR ;HE TRIED TO FOOL US WITH (NOTREG)
JMP TYI ;GOT (REG)
GTSDLP: JSR PC,GTSDLS
CMP R0,#'+
BNE GTSDL2
JSR PC,TYI
BISB #20,R1 ;AUTO INCREMENT
GTSDL3: BISB R1,INSSDD
BR GETSDX
GTSDL2: BISB #10,R1
MOV R1,R2
RTS PC
GTSDID: MOV R1,@INSP ;STORE INDEX
ADD #2,INSP
INCB EVINSC
INC INRELP ;UNRELOCATED
JSR PC,GTSDLS ;READ WHAT'S IN PARENS
BIS #60,R1
BR GTSDL3
CGTRIN: JSR PC,GETRIN
CGTRI1: CMP R0,#',
BNE GETERR
RTS PC
CGTFAI: JSR PC,GETFAI
BR CGTRI1
GETRIN: JSR PC,GETREG
GETRI1:
.IFNZ EISSW
ASH #6,R2
.IFF
SWAB R2
ASR R2
ASR R2
.ENDC ;EISSW
BIS R2,INS1
RTS PC
GETFAI: JSR PC,GETREG
CMP R2,#4
BGE GETERR
BR GETRI1
GETREG: JSR PC,GETSD
CMP R2,#7
BGT GETERR ;MUST BE A REGISTER
RTS PC
CGETSD: JSR PC,GETSD
CMP R0,#',
BNE GETERR
RTS PC
GETADD: JSR PC,GETSD
CMP R2,#67
BNE GETERR
DECB EVINSC
CLR INREL
ADD #4,INS2 ;UNRELOCATE
RTS PC
GETERR: JMP QERR
;NOVCHK, AEQUL, ASQUO, ADQUO, AAMPR, ACOLN, NUMCHK, GETNXS
NOVCHK: TSTB EXSYMF
BNE NOVERR
TSTB EXNUMF
BNE NOVERR
TSTB EVNOVF
BNE NOVERR
RTS PC
NOVERR: JMP QERR
;AEQUL DOESN'T CHECK FOR A VALUE HAVING BEEN GIVEN SINCE IF ONE ISN'T GIVEN
;EVAL SETS UP EVREGF, R1, EVSIZE AND FLT1 FROM THE LAST VALUE
AEQUL: TSTB EVREGF
BEQ AEQUL1 ;NOT REGISTER VALUE
MOV #'%,R0
JSR PC,TYO
AEQUL1:
.IIF EQ FPPSW, JMP NTYPE ;MUST BE INTEGER IN R1 IF NO FPP
.ELSE
TSTB EVSIZE
BNE AEQUL2 ;FLOATING VALUE
JMP NTYPE ;TYPE NUMBER IN R1
AEQUL2: LDD FLT1,AC0
JMP FTYPE
.ENDC ;FPPSW
ASQUO: JSR PC,NOVCHK ;COMPLAIN IF THERE IS A VALUE
JSR PC,TYI
MOV R0,R1 ;USE ASCII AS VALUE
ASQUO1: JSR PC,GETNXS ;READ UNTIL NEXT SEPARATOR
ASQUO2: INCB EXNUMF
TSTB EVINSF
BNE ASQUO3 ;READING INSTRUCTION
JMP EVALCE
ASQUO3: TSTB INLTB(R0)
BGT ASQUOX ;INSTRUCTION SEPARATOR
BMI NOVERR ;ILLEGAL IN INSTRUCTION
JMP EVALCE ;ARITH OP, KEEP GOING IN EVAL
ADQUO: JSR PC,NOVCHK
JSR PC,TYI
MOV R0,R1 ;SAVE LOW BYTE VALUE
JSR PC,TYI
SWAB R0
BIS R0,R1
BR ASQUO1
GETNXS: MOV R4,-(SP)
MOV R5,-(SP)
INCB FLUSHF
JSR PC,GETKS
MOV (SP)+,R5
MOV (SP)+,R4
ASQUOX: RTS PC
AAMPR: JSR PC,NOVCHK
MOV #3,R2
CLR R1
MOV R5,-(SP)
AAMPR1: JSR PC,TYI
MOV R0,R5
JSR PC,GETR ;TRY TO CONVERT TO RADIX 50
BR AAMPR2 ;NOT RADIX 50
.IFNZ EISSW
MUL #50,R1
.IFF
ASL R1
ASL R1
ASL R1
MOV R1,-(SP) ;SAVE 10*R1
ASL R1
ASL R1 ;DEVELOP 40*R1
ADD (SP)+,R1
.ENDC ;EISSW
ADD R5,R1
SOB R2,AAMPR1
MOV (SP)+,R5
BR ASQUO1
AAMPR2:
.IFNZ EISSW
MUL #50,R1
.IFF
ASL R1
ASL R1
ASL R1
MOV R1,-(SP) ;SAVE 10*R1
ASL R1
ASL R1 ;DEVELOP 40*R1
ADD (SP)+,R1
.ENDC ;EISSW
SOB R2,AAMPR2
MOV (SP)+,R5
BR ASQUO2
;ACOLN'S ENTRY IN POPTB IS ZERO SO THAT SYMBOLS WON'T BE LOOKED UP
;THEREFORE, ACOLN MUST CHECK THE SYMBOL FLAG ITSELF
ACOLN: TSTB EXSYMF
BEQ ACOLNR
TSTB EVSIZE+1
BNE ACOLNR
JSR PC,SYMLK ;SEE IF SYMBOL ALREADY EXISTS
BR ACOLN1 ;NO, ADD IT AT THE END
CMP (R1)+,(R1)+ ;YES, JUST CHANGE ITS VALUE
BR ACOLN4
ACOLN1: CMP R3,#1
BNE ACOLN2
CLR 6(R1) ;INVENTING NEW GROUP OF 16, CLEAR HKILL
CLR 10(R1) ;AND REGISTER FLAG WORDS
ACOLN2: MOV R1,SYMEND
MOV SYM,(R1)+
MOV SYM1,(R1)+
ACOLN4: TST VALP
BEQ ACLN4A
MOV VAL1,(R1) ;STORE NEW VALUE GIVEN
MOV VALRF,R0
BIC #177775,R0 ;KEEP REGISTER FLAG BIT FOR VAL1
BR ACLN4B
ACLN4A: MOV DOTVAL,(R1) ;STORE NEW VALUE FROM .
MOV DOTRGW,R0
BIC #177776,R0 ;KEEP REGISTER FLAG BIT FOR .
ACLN4B: MOV REGWAD,R2 ;ADDRESS OF REGISTER WORD
BIC R3,@R2 ;CLEAR REGISTER FLAG
TST R0
BEQ ACOLN3 ;VALUE ISN'T A REGISTER
BIS R3,@R2 ;SET THE REGISTER FLAG
ACOLN3: BIC R3,-2(R2) ;CLEAR THE HALF KILLED FLAG
RTS PC
ACOLNR: JMP QERR
;RETURN ONLY IF THERE IS AN INTEGER VALUE
NUMCHK: TSTB EVSIZE+1
BEQ ACOLNR ;NO VALUE
TSTB EVSIZE
BNE ACOLNR ;FLOATING VALUE
TSTB EVREGF
BNE ACOLNR ;REGISTER VALUE
TSTB EVINSF
BNE ACOLNR ;INSTRUCTION VALUE
RTS PC
;ABACK, ASLASH, ATAB
ABACK4: INCB OPLORF
JSR PC,MAPREG
MOVB UR0(R0),R1
BR ABACK5
ABACK: CLR R4
BR ASLAS0
ABACK1: TST R4 ;IF USER TYPED SLASH ON AN ODD ADDRESS
BEQ ABACK2
ABACK0: MOV #'\,R0 ;THEN TYPE A \ TO REMIND HIM THAT HE IS
JSR PC,TYO ;SEEING JUST ONE BYTE
ABACK2: TYPEIT < >
MOV #1,LFINC ;LF WILL INC BY 1
MOVB #1,OPENWD ;INDICATE BYTE OPEN
MOV DOTVAL,R0
MOV R0,OPLOC ;CURRENTLY OPEN LOCATION
CLRB OPLORF
BIT #1,DOTRGW ;SEE IF TYPING A REGISTER
BNE ABACK4 ;YES
JSR PC,GETBYT ;GET CONTENTS OF BYTE
ABACK5: MOV R1,LVAL
MOV LSTADR,PLSTAD
MOVB LSTADG,PLSADG
MOV R1,LSTADR
CLRB LSTADG
CLRB LVREGF
CLRB LVFLTF
TSTB TXTMD
BNE ABACKT
ALBRKX: JMP NTYPE
ABACKT: MOV #'',R0
JSR PC,TYO
MOV R1,R0
JMP TYO
ASLASE: JMP QERR
ABCK2: BR ABACK2
ASLASH: MOV #1,R4
ASLAS0: TSTB EVSIZE+1 ;SEE IF A VALUE WAS TYPED
BEQ ASLASA ;NO VALUE TYPED
TSTB EVSIZE
BNE ASLASE ;SORRY, CAN'T OPEN FLOATING POINT LOCATION
ASLSA1: MOV R1,DOTVAL ;CHANGE VALUE OF DOT
MOV #1,R0
BIC R0,DOTRGW ;CLEAR BIT SAYING . IS A REGISTER
TSTB EVREGF
BNE ASLAS3 ;NEW VALUE IS A REGISTER
BIT R0,DOTVAL ;SEE IF DOT IS NOW ODD
BNE ABACK1 ;TYPE AS BYTE
ASLAS1: TSTB BYTEMD
BNE ABACK1
SOB R4,ABCK2 ;FORK HERE IF BYTE TYPEOUT
ASLAS9: TYPEIT < >
MOVB #2,OPENWD
MOV DOTVAL,R0
MOV R0,OPLOC ;CURRENTLY OPEN LOCATION
CLRB OPLORF
BIT #1,DOTRGW
BNE ASLAS4 ;DOT IS A REGISTER
JSR PC,GETWRD
ASLAS5: MOV R1,LVAL
CLRB LVREGF
CLRB LVFLTF
MOV #2,LFINC
TSTB BRKFL
BNE ASLAS2
BIT #1,DOTRGW
BNE ASLAS2 ;DON'T TYPE REGISTER AS AN INSTRUCTION OR FLOATING
TSTB INSTMD
BNE ASLASI ;TRY TO TYPE AS AN INSTRUCTION
TSTB FLTYMD
BNE ASLASF ;TYPE AS FLOATING POINT
ASLAS2: MOV LSTADR,PLSTAD
MOVB LSTADG,PLSADG
MOV R1,LSTADR
CLRB LSTADG
TSTB BRKFL
BNE ALBRKX ;[ TYPE AS UNSIGNED NUMBER IN CURRENT RADIX
TSTB HALFMD
BNE ASLASL ;TYPE AS BYTE,BYTE
TSTB SYMBMD
BNE ASLASS ;TRY TO TYPE AS A SYMBOL PLUS OFFSET
TSTB TXTMD
BNE ASLTXT ;TYPE AS 2 ASCII CHARS
TSTB TXT5MD
BNE ASL5TX ;TYPE AS RADIX 50
JMP SNTYPE ;TYPE AS SIGNED NUMBER
ASLASS: JMP SYTYPE ;TRY TO TYPE R1 AS SYMBOL PLUS OFFSET
ASLAS3: BIS R0,DOTRGW ;INDICATE DOT IS A REGISTER
BR ASLAS1
ATAB: JSR PC,CLOSE ;DEPOSIT VALUE IN OPEN LOCATION IF ANY
JSR PC,CRLF
MOV OPLOC,R0
CLRB EVREGF
TSTB OPLORF
BNE ATABRG ;OPEN LOCATION WAS A REGISTER
BIC #1,R0
JSR PC,GETWRD
ATAB9: MOV R1,-(SP)
TSTB EVREGF
BNE ATAB8
JSR PC,SYTYPE
ATAB7: MOV (SP)+,R1
MOV #'/,R0
JSR PC,TYO
MOV #1,R4
ASLSA9: BR ASLSA1
ASLASA: JSR PC,CRLF
MOV LSTADR,R1
MOV R4,-(SP)
TSTB LSTADG
BNE ASLSAR ;OPEN REGISTER
JSR PC,SYTYPE
ASLSR1: MOV (SP)+,R4
MOV #'/,R0
JSR PC,TYO
MOV LSTADR,R1
MOVB LSTADG,EVREGF
BR ASLSA9
ASLAS4: INCB OPLORF ;OPLOC IS A REGISTER
JSR PC,MAPREG
MOV UR0(R0),R1
BR ASLAS5
ASLSAR: JSR PC,RSYTYP
BR ASLSR1
ATAB8: JSR PC,RSYTYP
BR ATAB7
ASLASL: MOV R1,-(SP) ;SAVE LOW BYTE
SWAB R1
BIC #177400,R1
JSR PC,NTYPE ;TYPE THE HIGH BYTE
JSR R5,TYPE
.BYTE ',
.BYTE ',
.BYTE 0
.EVEN
MOVB (SP)+,R1 ;GET BACK THE LOW BYTE
BIC #177400,R1
JMP NTYPE
ASLASI: MOV OPLOC,INSLOC
MOV R1,INSVAL
JSR PC,INSTTY
MOV SSDDPC,LFINC
RTS PC
.IFNZ FPPSW
ASLASF: MOV #4,R2
TSTB DBLFMD ;DOUBLE FLOATING MODE?
BNE ASLSF1 ;YES
CLRD FTEMP
MOV #2,R2
ASLSF1: MOV R2,LFINC
ASL LFINC ;SET UP LINE FEED INCREMENT
MOV #FTEMP,R3 ;TO ADDRESS
JSR PC,GETBLK ;COPY 2 OR 4 WORDS FROM @OPLOC TO FTEMP
LDD FTEMP,AC0
JMP FTYPE
.ENDC ;FPPSW
.IELSE ASLASF==ASLASE
ASLTXT: TYPEIT "
MOV R1,R0
JSR PC,TYO
SWAB R1
MOV R1,R0
JMP TYO
ASL5TX: TYPEIT &
JMP SYMOU1
ATABRG: JSR PC,MAPREG
MOV UR0(R0),R1
BR ATAB9
;AUARR, ALBRK, ALARR, AAT
AUARR: JSR PC,CLOSE ;DEPOSIT VALUE IF ANY
JSR PC,CRLF
MOV DOTVAL,R1
BIT #1,DOTRGW
BNE AUARR1 ;DOT IS A REGISTER
CLRB EVREGF
CMP LFINC,#1
BGT AUARR0
DEC DOTVAL ;Subtract 1 if byte mode,
JMP ALF2
AUARR0: TST -(R1) ;otherwise subtract 2
AUARR2: JMP ATAB9
AUARR1: DEC R1
BIC #177770,R1
INCB EVREGF
BR AUARR2
ALBRK: INCB BRKFL
JMP ASLASH
ALARR: MOV PLSTAD,R1
MOVB PLSADG,EVREGF
BR AUARR2
AAT: JSR PC,CLOSE ;DEPOSIT VALUE IF ANY
MOV UPC,R1
CLRB EVREGF
BR AUARR2
;INSTTY, INNMTY
;TYPE OUT VALUE AS AN INSTRUCTION
;VALUE IS IN R1 AND INSVAL AND THE ADDRESS IS IN INSLOC
INSTTY: MOV #OPCTB,R2 ;START OF OPCODE TABLE
INSRCH: TST (R2)
BNE INSRC1 ;NOT CHANGING BLOCKS NOW
CMP (R2)+,(R2)+ ;SKIP OVER 0 AND TYPIN ADDRESS
BEQ INSRNF ;IF TYPIN IS ZERO THE LIST IS DONE
MOV (R2)+,R5 ;SAVE TYPEOUT ADDRESS
MOV (R2)+,R4 ;LOAD UP THE NEW BIC MASK
INSRC1: MOV R1,R3 ;COPY OF VALUE
BIC R4,R3 ;MASKED
CMP R3,4(R2) ;COMPARE VALUES
BEQ INSRCF ;MATCH
ADD #6,R2
BR INSRCH
INSRNF: JMP ASLAS2 ;CAN'T TYPE AS INSTRUCTION, TYPE AS SIGNED NUMBER
INSRCF: CMP R3,#170000
BHIS INSRFF ;FLOATING POINT INSTRUCTION
JSR PC,INNMTY ;TYPE INSTRUCTION NAME
INSRCG: MOV INSLOC,SSDDPC
ADD #2,SSDDPC
JSR PC,(R5)
SUB INSLOC,SSDDPC ;NUMBER OF BYTES TAKEN BY INSTRUCTION
RTS PC
INSRFF: TSTB FLTIMD
BNE INSRCG ;TYPE FLOATING POINT INSTRUCTIONS
BR INSRNF ;TYPE AS SIGNED NUMBER
;TYPE OUT INSTRUCTION NAME FOLLOWED BY A SPACE
INNMTY: MOV R2,SYTYAD
JSR PC,SYMOUT ;TYPE THE INSTRUCTION NAME
MOV #40,R0
JMP TYO
;SSORDD
;SSDDPC HAS ADDRESS OF WORD AFTER LAST WORD LOOKED AT, INITIALLY
;POINTS AT WORD AFTER ADDRESS OF INSTRUCTION
;R5 HAS SIX BITS OF SOURCE OR DESTINATION
SSORDD:
.IFNZ EISSW
CLR R4
BIC #177700,R5
DIV #10,R4 ;R4_MODE, R5_REGISTER
.IFF
MOV R5,R4
.REPT 3
ASR R4
.ENDR
BIC #177770,R4
BIC #177770,R5
.ENDC ;EISSW
CMP R5,#7
BEQ PCREG ;PC ADDRESSING
NPCREG: MOVB LSTADG,PLSADG
MOV LSTADR,PLSTAD
INCB LSTADG
MOV R5,LSTADR
TST R4
BEQ REGMD ;REGISTER MODE
CMP R4,#2
BLT REGDMD ;REGISTER DEFERRED MODE
BEQ AINCMD ;AUTOINCREMENT MODE
CMP R4,#4
BLT AINDMD ;AUTOINCREMENT DEFERRED MODE
BEQ ADECMD ;AUTODECREMENT MODE
CMP R4,#6
BLT ADEDMD ;AUTODECREMENT DEFERRED MODE
BGT INDDMD ;INDEX DEFERRED MODE
INDXMD: MOV SSDDPC,R0
ADD #2,SSDDPC
JSR PC,GETWRD ;GET INDEX IN R1
MOV R5,-(SP) ;SAVE REGISTER NUMBER
JSR PC,SYTYPE ;TRY TO TYPE AS A SYMBOL
MOV (SP)+,R1 ;GET REGISTER NUMBER BACK
PARREG: MOV #'(,R0
JSR PC,TYO
JSR PC,RSYTYP ;TYPE REGISTER AS SYMBOL IF POSSIBLE
MOV #'),R0
JMP TYO
INDDMD: MOV #'@,R0
JSR PC,TYO
BR INDXMD
REGDMD: MOV R5,R1
BR PARREG
REGMD: MOV R5,R1
JMP RSYTYP
AINDMD: MOV #'@,R0
JSR PC,TYO
AINCMD: MOV R5,R1
JSR PC,PARREG
MOV #'+,R0
JMP TYO
ADEDMD: MOV #'@,R0
JSR PC,TYO
ADECMD: MOV #'-,R0
JSR PC,TYO
MOV R5,R1
BR PARREG
PCREG: CMP R4,#1
BLE NPCREG
CMP R4,#3
BLT IMMED
BEQ ABSOL
CMP R4,#5
BLE NPCREG
CMP R4,#7
BLT RELAT
MOV #'@,R0 ;RELATIVE DEFERRED MODE
JSR PC,TYO
RELAT: MOV SSDDPC,R0
JSR PC,GETWRD ;GET THE INDEX IN R1
TST (R0)+ ;BUMP ADDRESS BY 2
MOV R0,SSDDPC
ADD R0,R1 ;THIS IS THE ACTUAL ADDRESS
RELAT2: MOV LSTADR,PLSTAD
MOVB LSTADG,PLSADG
MOV R1,LSTADR
CLRB LSTADG
RELAT1: JMP SYTYPE ;TRY TO TYPE AS A SYMBOL
ABSOL: MOV #'@,R0
JSR PC,TYO
IMMED: MOV #'#,R0
JSR PC,TYO
MOV SSDDPC,R0
JSR PC,GETWRD
ADD #2,SSDDPC
CMP R4,#3
BNE RELAT1 ;NOT ABSOLUTE MODE
BR RELAT2 ;ABSOLUTE ADDRESS
;SOPOUT,DOPOUT,BROUT,RDOUT,RSOUT,SOBOUT,MS2OUT,RTSOUT,SPLOUT,MRKOUT,CCOUT
DOPOUT: MOV INSVAL,R5
.IFNZ EISSW
ASH #-6,R5 ;LINE UP SS IN BOTTOM SIX BITS
.IFF
ASL R5
ASL R5
SWAB R5 ;SS IN BOTTOM 6 BITS, GARBAGE IN OTHER BITS IS OK
.ENDC ;EISSW
JSR PC,SSORDD
MOV #',,R0
JSR PC,TYO
;VALUE IN INSVAL, ADDRESS IN INSLOC
SOPOUT: MOV INSVAL,R5
JMP SSORDD
BROUT: MOVB INSVAL,R1 ;OFFSET (SIGN EXTENDED)
BROUT1: ASL R1 ;OFFSET*2
ADD INSLOC,R1
ADD #2,R1 ;PC+OFFSET*2
MOV LSTADR,PLSTAD
MOVB LSTADG,PLSADG
MOV R1,LSTADR
CLRB LSTADG
JMP SYTYPE
RROUT: MOV INSVAL,R1
.IFNZ EISSW
ASH #-6,R1 ;GET REGISTER NUMBER IN R1
.IFF
ASL R1
ASL R1
SWAB R1
.ENDC ;EISSW
BIC #177770,R1
JMP RSYTYP
RDOUT: JSR PC,RROUT
MOV #',,R0
JSR PC,TYO
BR SOPOUT ;DO A DD
RSOUT: JSR PC,SOPOUT ;ALMOST THE SAME AS A SINGLE OP INSTRUCTION
MOV #',,R0
JSR PC,TYO
JMP RROUT
SOBOUT: JSR PC,RROUT ;TYPE OUT REGISTER
MOV #',,R0
JSR PC,TYO
MOV INSVAL,R1
BIC #177700,R1 ;SIX BIT WORD OFFSET
NEG R1
BR BROUT1
MS2OUT: MOV INSVAL,R1
BIC #177400,R1
JMP OTYPE ;TYPE UNSIGNED LOW BYTE
RTSOUT: MOV INSVAL,R1
BIC #177770,R1 ;GET REGISTER
JMP RSYTYP
SPLOUT: MOV INSVAL,R1
BIC #177770,R1 ;GET PRIORITY LEVEL
JMP OTYPE ;AND TYPE IN OCTAL
MRKOUT: MOV INSVAL,R1
BIC #177700,R1
JMP OTYPE
CCOUT: MOV INSVAL,R1
ASR R1
BCC CCOUT1
MOV #'C,R0
JSR PC,TYO
CCOUT1: ASR R1
BCC CCOUT2
MOV #'V,R0
JSR PC,TYO
CCOUT2: ASR R1
BCC CCOUT3
MOV #'Z,R0
JSR PC,TYO
CCOUT3: ASR R1
BCC INRET
MOV #'N,R0
JMP TYO
INRET: RTS PC
;FMOUT, FSOOUT, FSAOUT, SRAOUT, AFDOUT, ADSOUT
.IFNZ FPPSW
FMOUT: JMP INNMTY ;TYPE INSTRUCTION NAME
FSOOUT: CMP INSVAL,#170400
BLO FSOOU1 ;LDFPS, STFPS OR STST
TSTB UFPST ;BIT 7 IS FLOATING DOUBLE MODE
BPL FSOOU1 ;USER IS IN FLOATING MODE, TYPE F VERSION
ADD #6,R2 ;MOVE TO D VERSION OF INSTRUCTION
FSOOU1: JSR PC,INNMTY
FSOOU2: MOV INSVAL,R5
JMP SSORDD
FSAOUT: TSTB UFPST
BPL FSAOU1 ;USER IS IN FLOATING MODE, TYPE F VERSION
ADD #6,R2
FSAOU1: JSR PC,INNMTY
MOV INSVAL,R5
JSR PC,SSORDD
MOV #',,R0
JSR PC,TYO
MOV INSVAL,R1
ASH #-6,R1
BIC #177774,R1 ;2 BIT AC NUMBER
JMP RSYTYP
SRAOUT: CMP INSVAL,#177000
BLO FSAOU1 ;TYPE LDEXP DIRECTLY
TSTB UFPST
BPL SRAOU2 ;FLOATING
ADD #6,R2 ;DOUBLE
SRAOU2: BIT #100,UFPST
BEQ FSAOU1 ;INTEGER
ADD #14,R2 ;LONG
BR FSAOU1
AFDOUT: TSTB UFPST
BPL AFDOU1
ADD #6,R2
AFDOU1: JSR PC,INNMTY
MOV INSVAL,R1
ASH #-6,R1
BIC #177774,R1
JSR PC,RSYTYP
MOV #',,R0
JSR PC,TYO
BR FSOOU2
ADSOUT: CMP INSVAL,#175400
BLO AFDOU1
TSTB UFPST
BPL ADSOU1
ADD #6,R2
ADSOU1: BIT #100,UFPST
BEQ AFDOU1
ADD #14,R2
BR AFDOU1
.ENDC ;FPPSW
;DOPIN,SOPIN,BRIN,RDIN,SOBIN,RSIN,MSCIN,SOEX,MS2IN,RTSIN,SPLIN,MRKIN
DOPIN: JSR PC,CGETSD ;READ SS OR DD
.IFNZ EISSW
ASH #6,R2
.IFF
SWAB R2
ASR R2
ASR R2
.ENDC ;EISSW
BIS R2,INS1
SOPIN: JSR PC,GETSD ;READ SS OR DD
SOPEX1: BIS R2,INS1 ;STORE DD IN INSTRUCTION
SOPEX: CLRB LVREGF
CLRB LVFLTF
MOV INS1,R1
MOV R1,LVAL
CMP R0,#40
BEQ SOPEX2
TSTB INLTB(R0)
BLE OPINER ;NOT AN INSTRUCTION SEPARATOR
INCB POPF ;SO FURTHER CALLS ON EVPOP ARE NO-OPS
JMP EVALNI ;DISPATCH ON R0 THROUGH CMDTB
SOPEX2: JSR PC,TYI
BR SOPEX
SOBIN: JSR PC,CGTRIN ;GET R
BRIN: JSR PC,GETADD
DECB INREL ;INDICATE SPECIAL BRANCH RELOCATION
BR SOPEX
RDIN: JSR PC,CGTRIN ;GET R
BR SOPIN ;GET DD
RSIN: JSR PC,CGETSD ;GET SS
BIS R2,INS1
JSR PC,GETRIN ;GET R
BR SOPEX
MSCIN: INCB POPF ;SO THAT FUTURE CALLS ON EVPOP WILL BE NOPS
BR SOPEX
MS2IN: JSR PC,GETADD ;GET NUMBER
MS2IN2: BISB INS2,INS1
BR SOPEX
RTSIN: JSR PC,GETREG ;GET R
BR SOPEX1
SPLIN: JSR PC,GETADD ;GET PRIORITY LEVEL
BIC #177770,INS2
BR MS2IN2
MRKIN: JSR PC,GETADD ;GET NN
BIC #177700,INS2
BR MS2IN2
OPINER: JMP QERR
;CCIN, FSAIN, AFDIN
CCIN: JSR PC,TYI
MOV #3,R1
CCIN2: CMPB R0,CCINTB(R1)
BEQ CCIN1
DEC R1
BGE CCIN2
INCB POPF ;SO THAT FUTURE CALLS ON EVPOP WILL BE NOPS
BR SOPEX
CCIN1: MOV #1,R0
.IFNZ EISSW
ASH R1,R0
.IFF
TST R1
BEQ CCIN1B
CCIN1A: ASL R0
SOB R1,CCIN1A
CCIN1B:
.ENDC ;EISSW
BIS R0,INS1
BR CCIN
CCINTB: .BYTE 'C,'V,'Z,'N
FSAIN: JSR PC,CGETSD ;GET SS,
BIS R2,INS1
JSR PC,GETFAI
BR SOPEX
AFDIN: JSR PC,CGTFAI ;GET AC,
BR SOPIN
;ALESS, AGREAT, A1ZERO, A2ZERO, A1MASK, A1EFF, A1NOT, A1WORD
AGREAT:
ALESS: TSTB EVREGF
BNE ALESS2 ;REGISTER IS OK
JSR PC,NUMCHK ;MUST HAVE INTEGER IN R1
ALESS2: MOV VALP,R2
MOV R1,VAL1(R2)
ADD #2,R2
TSTB EVREGF
BEQ ALESS3
BIS R2,VALRF
ALESS3: CMP R2,#4
BLE ALESS1
TST -(R2)
ALESS1: MOV R2,VALP
JMP CMD3 ;RETURN TO MAIN LOOP WITHOUT RESETTING VALP
A2ZERO: JSR PC,BOUNDS
A1ZERO: JSR PC,EVPOP
TSTB EVSIZE+1
BEQ A1ZER1 ;NO VALUE, USE ZERO
JSR PC,NUMCHK ;MAKE SURE VALUE IS AN INTEGER
A1ZER2: MOV VALP,R2
CMP R2,#4
BNE A1ZERR ;MUST HAVE EXACTLY 2 VALUES
MOV VAL1,R0
MOV VAL2,R2
CMP R0,R2
BHI A1ZERR ;MUST HAVE R0R2
BIT #1,R0
BNE A1ZERD ;ODD ADDRESSING ERROR
A1ZERL: JSR PC,WRTWRD
TST (R0)+
CMP R0,R2
BLOS A1ZERL
JMP CMD
A1ZER1: CLR R1
BR A1ZER2
A1ZERR: JMP QERR
A1ZERD: JMP A1GOOD
BOUNDS: TST VALP
BNE BOUNDX ;LIMITS WERE GIVEN ANYWAY
MOV #VAL1,R3
MOV #USRBEG,(R3)+
.IFZ DEBSW
MOV SYMEND,R4
TST -(R4) ;TILL END OF SYMBOLS (BEGINNING?)
MOV R4,(R3)+
.ENDC
.IFNZ DEBSW
MOV #HCOR-2,(R3)+
.ENDC
MOV #4,VALP
BOUNDX: CMP VAL1,VAL2
BHI A1ZERR
TST VALRF
BNE A1ZERR ;REGISTER VALUES NOT LEGAL IN BOUNDS
RTS PC
A1MASK: JSR PC,EVSYM
TSTB EXNUMF
BEQ A1MSK1 ;NO VALUE GIVEN
JSR PC,EVPOP
JSR PC,NUMCHK
MOV R1,MASK
RTS PC
A1MSK1: CLRB EVREGF
CLRB FLTF
MOV #MASK,R1
JMP A1Q3
A1EFF: MOVB #1,SRCHTY
BR SRCH
A1NOT: MOVB #-1,SRCHTY
BR SRCH
A1WORD: CLRB SRCHTY
SRCH: JSR PC,EVPOP
JSR PC,NUMCHK
MOV R1,TARGET ;THIS IS WHAT WE ARE LOOKING FOR
JSR PC,BOUNDS
MOV VAL1,R0 ;LOWER SEARCH BOUND
BIT #1,R0
BNE A1ZERD
MOV MASK,CMASK
COM CMASK
SRCHLP: JSR PC,GETWRD
MOV TARGET,R2
TSTB SRCHTY
BGT SRCHEF ;DO EFF SEARCH
XOR R1,R2
BIC CMASK,R2
BEQ SRCHEQ ;THEY ARE EQUAL
TSTB SRCHTY ;UNEQUAL. IS IT "NOT WORD" SEARCH
BEQ SRCHNX ;NO, GO ON TO NEXT
SRCHY: MOV R0,-(SP) ;SAVE ADDRESS
JSR PC,CRLF
MOV (SP),R1
CLRB EVREGF
JSR PC,ATAB9
MOV (SP)+,R0
SRCHNX: TST (R0)+
CMP R0,VAL2
BHI SRCHD ;DONE
JSR PC,INTST ;SKIP IF ANY TTY INPUT
BR SRCHLP ;NO, KEEP GOING
SRCHD: JMP CMD ;YES, GIVE UP NOW
SRCHEQ: TSTB SRCHTY ;EQUAL. IS IT "WORD" SEARCH
BEQ SRCHY ;YES, TYPE IT OUT
BR SRCHNX ;NO, GO ON TO NEXT
SRCHEF: CMP R1,R2
BEQ SRCHY ;EXACT MATCH IS A WIN
MOV R1,R3
ADD R0,R3
ADD #2,R3
CMP R3,R2
BEQ SRCHY ;PC RELATIVE ADDRESS IS A WIN
SWAB R1
TSTB R1
BEQ SRCHNX ;NOT A BRANCH
BITB #170,R1
BEQ SRCHBR ;IT'S A BRANCH
BICB #1,R1
CMPB R1,#077+077 ;SOB?
BNE SRCHNX ;NO
.IFNZ EISSW
ASH #-7,R1
.IFF
SWAB R1
ASL R1
.ENDC ;EISSW
BIC #177601,R1
NEG R1
SRCHB1: ADD R0,R1
TST (R1)+ ;PC+2-2*OFFSET
CMP R1,R2
BEQ SRCHY
BR SRCHNX
SRCHBR:
.IFNZ EISSW
ASH #-7,R1
BIC #1,R1
.IFF
SWAB R1 ;GET OFFSET BYTE
MOVB R1,R1 ;SIGN-EXTEND
ASL R1 ;CHANGE WORDSBYTES
.ENDC ;EISSW
BR SRCHB1
;GETWRD, GETBYT, WRTBLK, WRTWRD, WRTBYT, GETBLK, MAPREG
;ADDRESS IN R0, RETURNS VALUE IN R1
GETWRD: CMP R0,#160000 ;HERE'S WHERE THE I/O REGISTERS LIVE
BLO GETWR1 ;SMALL, JUST READ CORE
MOV R2,-(SP)
JSR PC,RWSRCH
BR GETWR3 ;NOT FOUND IN TABLE
MOV @IORGSV-IORGTB-2(R2),R1
MOV (SP)+,R2
RTS PC
GETWR3: MOV (SP)+,R2
GETWR1:
.IFZ MAPSW
MOV @R0,R1 ;GET STUFF FROM PHYS ADDR
.IFF ;OR FROM VIRTUAL ADDR IF MAPSW ON
MOV UST,R1 ;GET USER'S PS
BIC #147777,R1 ;KEEP ONLY THE "PREVIOUS MODE" FIELD
BIC #30000,@#PS ;CLEAR PREVIOUS IN REAL PS
BIS R1,@#PS ;SET PREVIOUS
TSTB DASPMD ;INSTRUCTION SPACE (DASPMD=0) OR DATA SPACE?
BNE GETWR4 ;
MFPI (R0) ; INSTRUCTION
BR GETWR5 ;
GETWR4: MFPD (R0) ; DATA
GETWR5: MOV (SP)+,R1
.ENDC ;MAPSW
RTS PC
;GET BYTE AT R0 INTO R1
GETBYT: MOV R0,-(SP)
BIC #1,R0
JSR PC,GETWRD
MOV (SP)+,R0
BIT #1,R0
BEQ GETBY1
SWAB R1
GETBY1: BIC #177400,R1
RTS PC
;SEARCH FOR ADDRESS IN R0 IN IORGTB, SKIP IF FOUND, RETURNING 2 PAST ADDRESS
;IN R2
RWSRCH: MOV #IORGTB,R2 ;TABLE OF WHERE IO REGISTERS HAVE BEEN SAVED
RWSRC2: TST (R2)
BEQ RWSRC3 ;OUT OF SPECIAL IO REGS, JUST RETURN
CMP R0,(R2)+
BNE RWSRC2
ADD #2,(SP) ;FOUND IT, SKIP RETURN
RWSRC3: RTS PC
IORGTB: PS
.IIF NZ P45SW, STLIMR
0
IORGSV: UST
.IIF NZ P45SW, USTLIM
;R0 HAS TO ADDRESS, R3 HAS FROM ADDRESS, R2 HAS COUNT
WRTBLK: MOV (R3)+,R1
JSR PC,WRTWRD
TST (R0)+
SOB R2,WRTBLK
RTS PC
;R0 HAS FROM ADDRESS, R3 HAS TO ADDRESS, R2 HAS COUNT
GETBLK: JSR PC,GETWRD
MOV R1,(R3)+
TST (R0)+
SOB R2,GETBLK
RTS PC
;WRITE BYTE IN R1 AT ADDRESS IN R0
WRTBYT: MOV R1,-(SP) ;SAVE BYTE TO BE WRITTEN
MOV R0,-(SP) ;SAVE ADDRESS TO WRITE IT AT
BIC #1,R0 ;MAKE INTO A WORD ADDRESS
JSR PC,GETWRD ;GET WORD INTO R1
MOV R1,-(SP) ;AND PUSH IT WHERE IT WON'T GET SIGN EXTENDED
BIT #1,2(SP) ;LOOK AT LOW BIT OF ADDRESS TO WRITE AT (OLD R0)
BNE WRTBY1 ;WRITE AT ODD BYTE
MOVB 4(SP),(SP) ;WRITE THE BYTE (OLD R1)
BR WRTBY2
WRTBY1: MOVB 4(SP),1(SP) ;WRITE THE BYTE AT THE ODD LOCATION
WRTBY2: MOV (SP)+,R1 ;THE WORD TO WRITE BACK
JSR PC,WRTWRD
MOV (SP)+,R0
MOV (SP)+,R1
RTS PC
;R0 HAS ADDRESS, R1 HAS DATA
WRTWRD: MOV R2,-(SP)
JSR PC,MAPWRD
.IFNZ MAPSW
MOV R1,-(SP) ;PUSH THE WORD TO WRITE (FOR MTPI/MTPD)
MOV UST,R1 ;GET USER'S PS
BIC #147777,R1 ;KEEP ONLY THE "PREVIOUS MODE" FIELD
BIC #30000,@#PS ;CLEAR PREVIOUS IN REAL PS
BIS R1,@#PS ;SET PREVIOUS
TSTB DASPMD ;INSTRUCTION SPACE (DASPMD=0) OR DATA SPACE?
BNE WRTWR3 ;
MTPI @R2 ; INSTRUCTION
BR WRTWR4
WRTWR3: MTPD @R2 ; DATA
WRTWR4:
.IFF
MOV R1,@R2
.ENDC ;MAPSW
CMP R2,#DDTST
BNE WRTWR2
BIC #177437,DDTST ;Only the priority part of DDTST may be set.
MTPS DDTST
WRTWR2: MOV (SP)+,R2
RTS PC
;R0 HAS ADDRESS, RETURNS MAPPED ADDRESS IN R2
MAPWRD: CMP R0,#160000
BLO MAPWR1 ;JUST WRITE AT R0
JSR PC,RWSRCH
BR MAPWR1 ;NOT FOUND, JUST WRITE AT R0
MOV IORGSV-IORGTB-2(R2),R2
RTS PC
MAPWR1: MOV R0,R2
RTS PC
; Converts the register number in R0 to the appropriate
; index depending on the user's PSW.
MAPREG: ASL R0 ;Convert to word index.
MAPR0:
.IFNZ P45SW ;Only 11/45 has two register sets
CMP R0,#14 ;Which register?
BEQ MAPR2 ;SP
BHI MAPR1 ;PC - take as is
BIT #004000,UST ;R0:R5 - which register set?
BEQ MAPR1 ;Set 0
ADD #UR10-UR0,R0 ;Set 1.
MAPR1: RTS PC
MAPR2: BIT #140000,UST ;SP. What is the current state?
BEQ MAPR1 ;Kernel. No change.
MOV #SSP-UR0,R0 ;Other - offset to Sup SP.
BIT #100000,UST ;Supervisor state?
BEQ MAPR1 ;Yes.
TST (R0)+ ;User. Offset one more time.
.ENDC ;P45SW
RTS PC
;CLOSE
CLOSE: TSTB EVSIZE+1
BEQ CLOSE1 ;NO VALUE SPECIFIED
MOV OPLOC,R0
CMPB OPENWD,#1
BEQ CLOSEB ;BYTE WAS OPEN
BLT CLOSEX ;NOTHING WAS OPEN
TSTB OPLORF
BNE CLOSR1 ;REGISTER WAS OPEN IN WORD MODE
.IFNZ FPPSW
TSTB EVSIZE
BNE CLOSEF ;FLOATING VALUE GIVEN
.ENDC ;FPPSW
TSTB EVINSF
BNE CLOSEI ;STORE INSTRUCTION
JSR PC,WRTWRD ;WRITE VALUE FROM EVAL (IN R1) AT R0
BR CLOSE1
;BYTE WAS OPEN
CLOSEB: TSTB EVSIZE
BNE CLOSER ;FLOATING VALUE CAN'T BE STORED IN BYTE MODE
TSTB EVINSF
BNE CLOSER ;INSTRUCTION CAN'T BE STORED IN A BYTE
TSTB OPLORF
BNE CLOSRB ;REGISTER WAS OPEN IN BYTE MODE
JSR PC,WRTBYT ;WRITE VALUE IN R1 IN BYTE AT OPLOC
BR CLOSE1
.IFNZ FPPSW
;WORD WAS OPEN AND VALUE WAS FLOATING
CLOSEF: LDD LFVAL,AC0
STD AC0,FTEMP
MOV #4,R2 ;SET UP R2 AS WORD COUNT FOR WRTBLK
TSTB DBLFMD
BNE CLOSF1 ;DOUBLE FLOATING TYPEIN
STCDF AC0,FTEMP ;SINGLE PRECISION MODE - CLOBBER 2 WORDS ONLY
MOV #2,R2
CLOSF1: MOV #FTEMP,R3 ;ADDRESS TO COPY FROM
.ENDC ;FPPSW
CLOSI1: JSR PC,WRTBLK ;WRITE R2 MANY WORDS FROM @R3 INTO @R0
CLOSE1: CLRB OPENWD
CLOSEX: RTS PC
CLOSEI: TSTB INREL ;RELOCATE INS2?
BEQ CLOSI2 ;NO
BMI CLOSI4 ;RELOCATE FOR A BRANCH. ADDRESS IS IN INS2
SUB R0,INS2 ;YES
CLOSI2: TSTB INREL+1 ;RELOCATE INS3?
BEQ CLOSI3 ;NO
SUB R0,INS3 ;YES
CLOSI3: MOV #INS1,R3
MOVB EVINSC,R2 ;INSTRUCTION WORD COUNT FROM EVAL
MOV R2,LFINC ;SO LF WILL INCREMENT BY THE RIGHT AMOUNT
ASL LFINC
BR CLOSI1
CLOSI4: MOV INS2,R1 ;ADDRESS TO BRANCH TO
BIT #070000,INS1 ;IS IT AN SOB
BNE CLOSI5 ;FIX THE SOB
SUB R0,R1
ASR R1
DEC R1
CMP R1,#-200
BLT CLOSER ;BRANCH OUT OF RANGE
CMP R1,#177
BGT CLOSER ;BRANCH OUT OF RANGE
MOVB R1,INS1 ;STORE CORRECT OFFSET
BR CLOSI3
CLOSI5: CMP R0,R1
BLO CLOSER ;CAN'T BRANCH FORWARD WITH SOB
NEG R1
ADD R0,R1
ASR R1
INC R1
BIT #177700,R1
BNE CLOSER ;CAN'T JUMP THAT FAR BACK
BIS R1,INS1
BR CLOSI3
CLOSER: JMP QERR
;REGISTER WAS OPEN IN WORD MODE
CLOSR1: TSTB EVSIZE
BNE CLOSER ;CAN'T TYPE FLOATING VALUE INTO A REGISTER
TSTB EVINSF
BNE CLOSER ;CAN'T TYPE INSTRUCTION INTO A REGISTER
JSR PC,MAPREG
MOV R1,UR0(R0) ;STORE REGISTER
RTS PC
;REGISTER WAS OPEN IN BYTE MODE
CLOSRB: JSR PC,MAPREG
MOVB R1,UR0(R0) ;STORE LOW BYTE IN REGISTER
RTS PC
;ACR, ALF, RSTMD
ACR: JSR PC,CLOSE
JSR PC,RSTMD
JMP CMD
RSTMD: MOV PBYTEM,BYTEMD ;RESET TEMPORARY TYPEOUT MODES
MOV PINSTM,INSTMD
MOV PFLTYM,FLTYMD
MOV PABSMD,ABSMD
MOV PTXT5M,TXT5MD
RTS PC
ALF: JSR PC,CLOSE
JSR PC,CRLF
BIT #1,DOTRGW
BNE ALF1 ;DOT IS A REGISTER, BUMP BY 1
ADD LFINC,DOTVAL
ALF2: MOV DOTVAL,R1 ;NEW ADDRESS TO OPEN
CLRB SYTYRF ;ASSUME NOT REGISTER
BIT #1,DOTRGW
BEQ ALF3
INCB SYTYRF ;REALLY IS REGISTER
ALF3: JSR PC,ADSYTY ;TYPE R1 AS SYMBOL PLUS OFFSET
CMP LFINC,#1
BEQ ALF4 ;OPEN AS BYTE
MOV #'/,R0
JSR PC,TYO
JMP ASLAS9
ALF1: INC DOTVAL
CMP DOTVAL,#7
BLE ALF2
CLR DOTVAL
BR ALF2
ALF4: JMP ABACK0
;AALT
AALTR: JMP QERR
AALT: CLRB ALTVF
CLRB ALTPVF
CLR R3 ;TWO ALTS FLAG
AALT1: JSR PC,TYI ;GOBBLE CHARACTER AFTER ALT MODE
CMP R0,#'(
BEQ AALTLP
CMP R0,#33
BEQ AALTAL ;SECOND ALT MODE
CMP R0,#'0
BLT AALTR
CMP R0,#'7
BLE AALTN ;GOT A NUMBER
CMP R0,#'A
BLT AALTR
CMP R0,#'Z
BGT AALTR
ASL R0
ADD R3,R0
JMP @ALTTB-'A-'A(R0) ;DISPATCH ON LETTER
AALTN: SUB #'0,R0
MOVB R0,SALTNM ;SAVE VALUE AFTER ALT MODE
INCB ALTVF ;INDICATE THERE IS A VALUE IN SALTNM
BR AALT1
AALTAL: MOV #ALT2TB-ALTTB,R3 ;INDICATE HAVING RECEIVED SECOND ALT MODE
BR AALT1
AALTLP: JSR PC,EVPOP
JSR PC,NUMCHK ;MAKE SURE WE HAVE INTEGER VALUE
MOV R1,-(SP) ;SAVE VALUE
MOVB #'(,SNEAK1 ;PUT BACK LEFT PAREN
INCB EVINLF ;CAUSE EVALI TO RETURN AFTER CLOSED PAREN
CLRB EVINSF
JSR PC,EVALI ;READ EXPRESSION IN PARENS
CLRB EVINLF ;CLEAR THE FLAG FOR FURTHER CALLS ON EVALI
INCB ALTPVF ;INDICATE VALUE IN PARENS GIVEN AFTER ALT
INCB POPF ;IN CASE WE TRY TO EVPOP AGAIN
MOVB EVREGF,ALPVRF ;SAVE INFO OF VALUE IN PARENS BEING A REG
MOV R1,ALTPV ;SAVE VALUE
MOV (SP)+,R1 ;GET VALUE BEFORE () BACK
MOV #400,EVSIZE
CLRB EVREGF
CLRB EVINSF
BR AALT1
;A1ABS,A1CNST,A1DEC,A1HALF,A1INST,A1OCT,A1REL,A1SYMB,A1BYTE,A1FLT,A1DBL,A1FLTI,A1TXT
A1ABS: INCB ABSMD ;$A
BR A1RET
A1REL: CLRB ABSMD ;$R
BR A1RET
A1DEC: INCB DECMD ;$D
BR A1RET
A1OCT: CLRB DECMD ;$O
BR A1RET
A1CLRM: CLRB SYMBMD
CLRB INSTMD
CLRB HALFMD
CLRB BYTEMD
CLRB FLTYMD
CLRB TXTMD
CLRB TXT5MD
RTS PC
A1CNST: JSR PC,A1CLRM ;$C
BR A1RET
A1HALF: JSR PC,A1CLRM ;$H
INCB HALFMD
BR A1RET
A1INST: JSR PC,A1CLRM ;$I
INCB INSTMD
BR A1RET
A1SYMB: JSR PC,A1CLRM ;$S
INCB SYMBMD
BR A1RET
A1BYTE: JSR PC,A1CLRM ;$Y
INCB BYTEMD
BR A1RET
A1TXT: JSR PC,A1CLRM ;$T OR $7T OR $5T
TSTB ALTVF
BEQ A1TXT1 ;$T
CMPB SALTNM,#5
BEQ A1TXT2
CMPB SALTNM,#7
BNE A1TXTR
A1TXT1: INCB TXTMD
BR A1RET
A1TXT2: INCB TXT5MD ;$5T
BR A1RET
A1TXTR: JMP QERR
A1FLT: JSR PC,A1CLRM ;$F
INCB FLTYMD
A1RET: TST R3
BEQ A1RET2 ;ONE ALT RETURN
A2RET2: JMP CMD2 ;RETURN FOR 2 ALTS
A1RET2: TSTB EXSYMF
BNE A1RET1 ;THERE WAS SOMETHING BEFORE THE ALT
TSTB EXNUMF
BNE A1RET1 ;THERE WAS SOMETHING BEFORE THE ALT
JMP EVALLP ;NOTHING BEFORE ALT. GET ANOTHER TOKEN - SEP PAIR
A1RET1: JSR PC,TYI ;GET NEXT CHAR. MUST BE SEPARATOR
JMP EVALCE ;AND LOOK LIKE WE JUST RETURNED FROM EXPR
A1DBL: INCB DBLFMD ;$L
BR A2RET2
A1FLTI: INCB FLTIMD ;$V
BR A2RET2
.IFNZ MAPSW
A1DASP: INCB DASPMD ;$U
BR A2RET2
.ENDC ;MAPSW
;A2ABS,A2REL,A2DEC,A2OCT,A2CNST,A2HALF,A2INST,A2SYMB,A2BYTE,A2FLT,A2DBL,A2FLTI,A2TXT,A2INSP
A2RET: JMP @ALTTB+<ALTTB-ALT2TB>-'A-'A(R0) ;DISPATCH TO FIRST ALT TABLE
A2ABS: INCB PABSMD ;$$A
BR A2RET
A2REL: CLRB PABSMD ;$$R
BR A2RET
A2DEC: INCB PDECMD ;$$D
BR A2RET
A2OCT: CLRB PDECMD ;$$O
BR A2RET
A2CLRM: CLRB PSYMBM
CLRB PINSTM
CLRB PHALFM
CLRB PBYTEM
CLRB PFLTYM
CLRB PTXTMD
CLRB PTXT5M
RTS PC
A2CNST: JSR PC,A2CLRM ;$$C
BR A2RET
A2HALF: JSR PC,A2CLRM ;$$H
INCB PHALFM
BR A2RET
A2INST: JSR PC,A2CLRM ;$$I
INCB PINSTM
BR A2RET
A2SYMB: JSR PC,A2CLRM ;$$S
INCB PSYMBM
BR A2RET
A2TXT: JSR PC,A2CLRM ;$$T OR $$7T OR $$5T
TSTB ALTVF
BEQ A2TXT1 ;$$T
CMPB SALTNM,#5
BEQ A2TXT2
CMPB SALTNM,#7
BNE A1TXTR
A2TXT1: INCB PTXTMD
BR A2RET
A2TXT2: INCB PTXT5M ;$$5T
BR A2RET
A2BYTE: JSR PC,A2CLRM ;$$Y
INCB PBYTEM
BR A2RET
A2FLT: JSR PC,A2CLRM ;$$F
INCB PFLTYM
BR A2RET
A2DBL: CLRB DBLFMD ;$$L
JMP CMD2
A2FLTI: CLRB FLTIMD ;$$V
JMP CMD2
.IFNZ MAPSW
A2DASP: CLRB DASPMD ;$$U
JMP CMD2
.ENDC ;MAPSW
;A1Q, ACOMMA, A1HK, A2SYKL
A1Q: TSTB ALTVF ;WAS THERE A VALUE AFTER THE ALT?
BEQ A1Q1 ;NO
TSTB LVFLTF
BNE A1QERR ;LAST VALUE WAS FLOATING
TSTB LVREGF
BNE A1QERR ;LAST VALUE WAS REGISTER
MOV LVAL,R1
BITB #1,SALTNM
BEQ A1Q2
SWAB R1
A1Q2: BIC #177400,R1 ;GET APPROPRIATE BYTE
CLRB EVREGF
CLRB FLTF
BR A1Q3
A1Q1: BISB LVREGF,EVREGF ;COPY REGISTER FLAG
MOVB LVFLTF,FLTF ;AND FLOATING VALUE FLAG
MOV LVAL,R1 ;AND INTEGER VALUE
.IIF NZ FPPSW, LDD LFVAL,AC0
.IIF NZ FPPSW, STD AC0,FLT1 ;AND FLOATING VALUE
A1Q3: INCB EXNUMF
CLRB EXSYMF
JSR PC,TYI
JMP EVALCE
A1QERR: JMP QERR
ACOMMA: JSR PC,TYI
CMP R0,#',
BNE A1QERR
TSTB EVSIZE+1
BNE ACOMM1
INCB EVSIZE+1 ;NO VALUE GIVEN, INVENT ZERO
CLR R1
ACOMM1: TSTB EVSIZE
BNE A1QERR ;FLOATING,, IS ILLEGAL
TSTB EVINSF
BNE A1QERR ;INSTRUCTION,, IS ILLEGAL
TSTB EVREGF
BNE A1QERR ;REGISTER,, IS ILLEGAL
CLRB POPF
CLRB EVNOVF
MOV #OPPDL,R5 ;SET UP OP PDL
MOV #VALPDL,R4 ;SET UP VAL PDL
CLR -(R5) ;PUSH INITIAL ZERO
CLR R3 ;PRECEDENCE ZERO
MOV #7*2,R2 ;OPERATOR NUMBER 7
JMP ACOMME ;PUT OP AND VALUE ON THE STACK
A1HK: TSTB EXSYMF
BEQ A1QERR ;NO SYMBOL GIVEN
JSR PC,SYMLK ;LOOK FOR THE SYMBOL
BR A1HKUN ;NO SUCH SYMBOL
MOV REGWAD,R2 ;ADDRESS OF THE REGISTER WORD FOR THIS SYMBOL
BIS R3,-2(R2) ;SET THE HALF KILL BIT IN THE HALF KILL WORD
RTS PC
A1HKUN: JMP EVSYM2 ;GIVE ?U? ERROR
A2SYKL: MOV #LSTSY,SYMEND
JMP CMD2
;A1XCT, ASSTEP
A1XCT: JSR PC,EVPOP
TSTB EVSIZE+1
BEQ A1XCTR ;NO VALUE GIVEN
TSTB EVINSF
BEQ A1XCTR ;NO INSTRUCTION GIVEN
MOV #INS1,R1
TSTB INREL ;RELOCATE INS2?
BEQ A1XCT2 ;NO
BMI A1XCT4 ;RELOCATE FOR A BRANCH. ADDRESS IS IN INS2
SUB R1,INS2 ;YES
A1XCT2: TSTB INREL+1 ;RELOCATE INS3?
BEQ A1XCT3 ;NO
SUB R1,INS3 ;YES
A1XCT3: MOV #240,R0
A1XCT7: CMPB EVINSC,#3
BGE A1XCT6
MOV R0,@INSP
ADD #2,INSP
INCB EVINSC
BR A1XCT7
A1XCT4: BIT #070000,INS1 ;IS IT AN SOB
BNE A1XCT5 ;FIX THE SOB
A1XCT1: MOV #000137,INS1 ;TURN INSTRUCTION INTO A JMP FOO
INCB EVINSC ;RESTORE INSTRUCTION WORD COUNT TO TWO
BR A1XCT3
A1XCT5: MOV @R1,R0
.IFNZ EISSW
ASH #-5,R0
.IFF
.REPT 5
ASR R0
.ENDR
.ENDC ;EISSW
BIC #177761,R0
JSR PC,MAPR0
DEC UR0(R0) ;DO THE DECREMENT
BNE A1XCT1 ;HAVE TO BRANCH
MOV #240,@R1 ;EXECUTE A NOP INSTEAD (MAYBE WILL INT)
MOV #1,EVINSC
BR A1XCT3
A1XCT6: MOV UPC,SVUPC ;SAVE UPC IN CASE WE COME BACK
MOV #INS1,R1
JMP XCTGO
A1XCTR: JMP QERR
ASSTEP: TSTB PROCF
BEQ A1XCTR ;HAVE TO BE PROCEEDABLE FIRST
JSR PC,CRLF
JSR PC,EVPOP ;Test for <expr>^S.
TSTB EVSIZE+1
BEQ ASSTP0 ;No <expr>. Use current PC.
JSR PC,NUMCHK
MOV R1,UPC ;Set PC_<expr>
ASSTP0: MOV UPC,R0
BIT #1,R0 ;Look out for odd address.
BNE ASSTP2
.IFNZ P45SW ;ONLY 11/45 HAS SPL
JSR PC,GETWRD ;Now for a horrendous hack...
MOV R1,R2
BIC #7,R2
CMP R2,#230 ;Is the instruction being one-stepped
BNE ASSTP1 ;a SPL?
BIC #177770,R1 ;It is. We have to simulate it because
ASH #5,R1 ;SPL inhibits trace trapping.
BIC #340,UST
BIS R1,UST
MOV UPC,R1
TST (R1)+ ;Update the user's PC.
MOV R1,UPC
JMP BPTSS ;Pretend we got a trace trap.
.ENDC ;P45SW
ASSTP1: JMP SSTEP
ASSTP2: JMP A1GOOD
;EVSYM, SYMLK, RSYTYP, SYTYPE, ADSYTY, RSYTYP, SYMOU1
;CHECK EXSYMF AND IF SET TRY TO LOOK UP THE SYMBOL. DOESN'T CLOBBER
;ANY REGISTERS. CLEARS FLTF AND RETURNS THE VALUE IN R1 AND
;EVREGF AND SETS EXNUMF
EVSYM: TSTB EXSYMF
BNE EVSYM1 ;YES, THERE IS A SYMBOL
RTS PC ;NO SYMBOL
EVSYM1: MOV R3,-(SP)
JSR PC,SYMLK
BR EVSYM2 ;SYMBOL UNDEFINED
MOV 4(R1),R1 ;GET VALUE
BIT R3,@REGWAD
BEQ EVSYM3 ;NOT A REGISTER VALUE
INCB EVREGF
EVSYM3: CLRB FLTF
INCB EXNUMF ;INDICATE RETURNING A VALUE
MOV (SP)+,R3
RTS PC
EVSYM2: TYPEIT < ?U? >
JMP CMD1
;SYMLK SEARCHES THE SYMBOL TABLE FOR THE SYMBOL IN SYM AND SYM1.
;IT SKIP RETURNS IF IT FINDS IT RETURNING THE ADDRESS OF THE SYMBOL
;IN R1, THE ADDRESS OF THE CORRESPONDING REGISTER FLAG WORD IN REGWAD
;AND THE CORRESPONDING BIT IN R3
SYMLK: MOV #SYMBEG,R1 ;WORD AFTER HKILL AND REG WORDS
CLR R3
SYMLK2: ASL R3
BNE SYMLK3 ;STILL MORE TO DO IN THIS BLOCK OF 16
TST -(R1) ;POINT AT REG WORD
MOV R1,REGWAD
TST -(R1) ;POINT AT HKILL WORD
INC R3 ;START AT FIRST SYMBOL (RIGHTMOST BIT)
SYMLK3: SUB #6,R1 ;POINT AT FIRST WORD OF RADIX 50 OF NEXT SYMBOL
CMP R1,SYMEND
BLO SYMLK4 ;OUT OF SYMBOLS, NOT FOUND
CMP (R1),SYM
BNE SYMLK2
CMP 2(R1),SYM1
BNE SYMLK2
ADD #2,(SP) ;SKIP RETURN ON SYMBOL FOUND
SYMLK4: RTS PC
SYSNTY: TSTB SYTYRF
BEQ SYSNT1 ;NOT A REGISTER VALUE
MOV #'%,R0
JSR PC,TYO
SYSNT1: TSTB SYMADF
BEQ SYSNT2 ;NOT TYPING ADDRESS, TYPE AS SIGNED NUMBER
JMP OTYPE ;TYPING ADDRESS, TYPE AS OCTAL
SYSNT2: JMP SNTYPE
;TYPE R1 AS SYMBOL PLUS OFFSET TYPING UNSIGNED IF NO SYMBOL
ADSYTY: INCB SYMADF
BR SYTYP0
;TYPE R1 AS A REGISTER SYMBOL
RSYTYP: INCB SYTYRF
BR SYTYP0
;TYPE R1 AS SYMBOL PLUS OFFSET
SYTYPE: CLRB SYMADF
CLRB SYTYRF
SYTYP0: TSTB ABSMD
BNE SYSNTY ;ABSOLUTE MODE, TYPE AS SIGNED NUMBER
CLR SYTYAD
MOV #SYMBEG,R0 ;WORD AFTER HKILL AND REG WORDS
CLR R2 ;BEST SYMBOL'S VALUE SO FAR
CLR R3
SYTYP1: ASL R3
BNE SYTYP2
TST -(R0) ;POINT AT REG WORD
MOV R0,R4 ;SAVE ADDRESS OF REGISTER VALUE WORD
TST -(R0) ;POINT AT HALF KILL WORD
INC R3
SYTYP2: SUB #6,R0 ;POINT AT FIRST WORD OF SYMBOL
CMP R0,SYMEND
BLO SYTYPX ;OUT OF SYMBOLS
BIT R3,-2(R4) ;HALF KILLED?
BNE SYTYP1 ;YES
MOV R1,R5
SUB 4(R0),R5 ;SUBTRACT VALUE OF THIS SYMBOL FROM TARGET
BLO SYTYP1 ;SYMBOL VALUE IS BIGGER THAN UNSIGNED TARGET
CMP R5,MXOFF
BHIS SYTYP1 ;SYMBOL IS  100 BELOW TARGET
CMP R2,4(R0) ;FIND LARGEST SYMBOL BELOW ACTUAL RETAIL R1
BHI SYTYP1 ;OLD VALUE (R2) WAS BIGGER (BETTER!)
TSTB SYTYRF
BNE SYTYP3 ;NEED TO TYPE REGISTER VALUE
BIT R3,(R4) ;TYPE NON-REGISTER VALUE, CHECK THIS SYMBOL
BNE SYTYP1 ;SYMBOL IS REGISTER VALUE BUT VALUE ISN'T
BR SYTYP4 ;BOTH NON REGISTER VALUE
SYTYP3: BIT R3,(R4)
BEQ SYTYP1 ;VALUE IS REGISTER VALUE BUT SYMBOL ISN'T
SYTYP4: MOV 4(R0),R2 ;NEW BEST VALUE
MOV R0,SYTYAD
BR SYTYP1
SYTYPX: TST SYTYAD
BEQ SYTYPW ;NO SYMBOL FOUND, JUST TYPE NUMBER
TSTB SYTYRF
BNE SYTYW3 ;TYPING A REGISTER
SYTYW4: SUB R2,R1 ;GET OFFSET IN R1
MOV R1,-(SP) ;SAVE OFFSET
JSR PC,SYMOUT ;TYPE SYMBOL POINTED TO BY SYTYAD
MOV (SP)+,R1 ;GET OFFSET BACK
BEQ SYTYPZ ;NO OFFSET, JUST EXIT
MOV #'+,R0
JSR PC,TYO
JMP SNTYPE
SYTYW3: CMP R1,R2
BEQ SYTYW4 ;OK IF OFFSET IS ZERO
SYTYPW: TSTB SYTYRF ;TYPE NUMBER, CHECK TO SEE IF IT'S A REGISTER
BEQ SYTYW1 ;NO, TYPE AS UNSIGNED NUMBER
MOV #'%,R0
JSR PC,TYO
MOV R1,R0
JMP NTYO
SYTYW1: JMP NTYPE
SYTYPZ: RTS PC
;TYPE SYMBOL POINTED TO BY SYTYAD
SYMOUT: MOV @SYTYAD,R1
JSR PC,SYMOU1
MOV SYTYAD,R0
MOV 2(R0),R1
SYMOU1:
.IFNZ EISSW
CLR R0 ;DIVIDE R1 BY 50, QUOTIENTR0, REMAINDERR1.
DIV #50,R0
BEQ SYMOU2
MOV R1,-(SP)
MOV R0,R1
JSR PC,SYMOU1
MOV (SP)+,R1
SYMOU2: TST R1
BEQ SYTYPZ ;FLUSH BLANK
CMP R1,#33
BLT SYMOLT ;LETTER
BEQ SYMODL ;DOLLAR
CMP R1,#35
BEQ SYMOPR ;PERCENT
ADD #22,R1 ;POINT OR NUMBER
SYMOU3: MOV R1,R0
JMP TYO
SYMOLT: ADD #100,R1
BR SYMOU3
SYMODL: MOV #'$,R0
JMP TYO
SYMOPR: MOV #'%,R0
JMP TYO
.IFF
MOV R2,-(SP)
MOV #50,R2
JSR PC,DIVIDE ;DIVIDE R1 BY 50, QUOTIENTR1, REMAINDERR0
MOV (SP)+,R2
TST R1
BEQ SYMOU2
MOV R0,-(SP)
JSR PC,SYMOU1
MOV (SP)+,R0
SYMOU2: TST R0
BEQ SYTYPZ ;FLUSH BLANK
CMP R0,#33
BLT SYMOLT ;LETTER
BEQ SYMODL ;DOLLAR
CMP R0,#35
BEQ SYMOPR ;PERCENT
ADD #22,R0 ;POINT OR NUMBER
SYMOU3: JMP TYO
SYMOLT: ADD #100,R0
BR SYMOU3
SYMODL: MOV #'$,R0
BR SYMOU3
SYMOPR: MOV #'%,R0
BR SYMOU3
.ENDC ;EISSW
;EXPR
;TRY TO READ AN EXPRESSION
EXPR: CLRB FLTF
CLR EXSYMF ;CLEARS EXNUMF TOO
CLRB NUMOM ;CLEAR NUMBERS ONLY MODE
CLR POWER
JSR PC,GETTOK ;GET NEXT TOKEN
EXPR1: MOV SYMF,EXSYMF ;COPIES NUMF TOO
TSTB NUMF
BEQ EXPRX ;NOT A NUMBER
CMP R0,#'.
BNE EXPRX ;NUMBER IN R1, WORK ON EXPRESSION
.IIF NZ FPPSW, STD AC0,FLT1 ;SAVE ACCUMULATED DECIMAL
.IIF Z FPPSW, MOV R3,EXPRT1 ;SAVE ACCUMULATED DECIMAL
INCB NUMOM ;SET NUMBERS ONLY MODE
JSR PC,GETTOK ;NUMBER FOLLOWED BY . GET SOME MORE
TSTB NUMF
BNE EXPRFL ;NUMBER, . , NUMBER
EXPRL2:
.IFNZ FPPSW
CMPB R0,#'E
BEQ EXPRF1
.ENDC ;FPPSW
MOVB R0,SNEAK1 ;PUT CHARACTER BACK FOR GETTOK TO READ
INCB FLUSHF ;SET FLUSHF FOR GETTOK (GETKS)
JSR PC,GETKS ;MAKE SPECIAL ENTRY INTO GETTOK
TSTB SYMF
BNE EXPRQE ;DECIMAL OR FLOATING THEN SYM (NOT E) GIVE ?
.IFNZ FPPSW
TSTB FLTF ;MUST HAVE BEEN LONE SEPARATOR TO GET HERE
BNE EXPRFX ;DO POWER STUFF IF FLOATING
LDD FLT1,AC0 ;GET DECIMAL BACK
STCDI AC0,R1 ;INTO R1
.IFF
MOV EXPRT1,R1
.ENDC ;FPPSW
EXPRX: RTS PC
EXPRQE: JMP QERR ;NUMBER FOLLOWED BY LETTER. SAY ?
.IFNZ FPPSW
EXPRFL: INCB FLTF
MOVB DIGITS,POWER ;SAVE NUMBER OF PLACES AFTER DECIMAL POINT
MOVB DIGITS,R3
LDD FLT1,AC1
ASH #3,R3
MULD DTENTB(R3),AC1
ADDD AC1,AC0
STD AC0,FLT1 ;FLT1 GETS NEW COMBINED VALUE
BR EXPRL2
;HAVE DOUBLE PRECISION FLOATING NUMBER IN FLT1, WITH POWER SET UP
;SUCH THAT THE REAL VALUE IS FLT1*10^-POWER. WE HAVE JUST SEEN AN
;E FOLLOWING THE NUMBER, BUT WE DON'T KNOW WHAT'S AFTER THE E
EXPRF1: INCB FLTF
CLRB NEGEXF
JSR PC,TYI ;GET NEXT CHAR
CMP R0,#'+
BEQ EXPRF2
CMP R0,#'-
BEQ EXPRF3
EXPRF0: CMP R0,#'0
BLT EXPRFZ ;NOT +, - OR NUMBER
CMP R0,#'9
BGT EXPRFZ ;NOT +, - OR NUMBER
MOVB R0,SNEAK1 ;PUT THE NUMBER BACK
INCB NUMOM ;AND READ THE NUMBER WITH GETTOK
JSR PC,GETTOK ;IN NUMBERS ONLY MODE
TSTB NUMF
BEQ EXPRFZ ;NO EXPONENT GIVEN
STCDI AC0,R1 ;GET DECIMAL OF POWER
LDD FLT1,AC0
TSTB NEGEXF
BEQ EXPRF5
NEG R1
EXPRF5: SUB POWER,R1 ;VALUE IS FLT1*10^R1
CMP R1,#-38.
BGE EXPRX1 ;POWER IS -38
ADD #38.,R1 ;MULTIPLY BY WHAT'S LEFT LATER
MULD DM38,AC0 ;MULTIPLY BY 10^-38 NOW
EXPRX1: ASH #3,R1
MULD DTENTB(R1),AC0
STD AC0,FLT1
RTS PC
EXPRF3: INCB NEGEXF ;SET NEGATE EXPONENT FLAG
EXPRF2: JSR PC,TYI
BR EXPRF0
EXPRFZ: MOVB R0,SNEAK1
INCB FLUSHF
JSR PC,GETKS ;FLUSH UNTIL A SEPARATOR
JMP QERR ;GIVE ?
EXPRFX: CLR R1
BR EXPRF5
.ENDC ;FPPSW
.IELSE EXPRFL==EXPRQE ;IF NO FL PT, FLOATING TYPEIN GIVES ?
;GETTOK GET A TOKEN (SYMBOL, NUMBER, SEPARATOR)
GETTOK: CLR R1 ;ACCUMULATE OCTAL IN R1
.IIF NZ FPPSW, CLRD AC0 ;ACCUMULATE DECIMAL IN AC0 IF FPP
.IIF Z FPPSW, CLR R3 ;ACCUMULATE DECIMAL IN R3 IF NO FPP
CLRB NUMF
CLRB DIGITS
CLRB FLUSHF
GETKS: CLRB SYMF
CLR SYM
CLR SYM1 ;ACCUMULATE RADIX50 SYMBOL
MOV #SYM,R2 ;POINTER FOR STORING RADIX 50
GETOKM: MOV #3,R4 ;COUNT FOR SYM
GETNTK: JSR PC,TYI ;GET NEXT CHARACTER IN R0
MOV R0,R5
JSR PC,GETR
BR GETKX1 ;SEPARATOR
TSTB SYMF
BNE GETOKT ;NEXT CHAR FOR SYMBOL
TSTB FLUSHF
BNE GETOKT ;GOBBLE CHARACTERS UNTIL A SEPARATOR
CMP R0,#'0
BLT GETOK2 ;NOT NUMBER
CMP R0,#'9
BGT GETOK2 ;NOT NUMBER
INCB NUMF ;HAVE SEEN A NUMBER
INCB DIGITS ;COUNT OF DIGITS (NOT SAME AS NUMF!!)
SUB #'0,R0
.IFNZ EISSW
ASH #3,R1
.IFF
ASL R1
ASL R1
ASL R1
.ENDC ;EISSW
ADD R0,R1 ;ACCUMULATE OCTAL
.IFNZ FPPSW
MULD D10,AC0
LDCID R0,AC1 ;CONVERT R0 TO DOUBLE PRECISION FLOATING
ADDD AC1,AC0 ;ACCUMULATE DECIMAL
.IFF
ASL R3 ;ACCUMULATE DECIMAL
MOV R3,-(SP)
ASL R3
ASL R3
ADD (SP)+,R3
ADD R0,R3
.ENDC ;FPPSW
BR GETNTK
;NON-NUMERIC AND HAVEN'T SEEN NON-NUMERIC BEFORE
GETOK2: TSTB NUMOM
BNE GETOKX ;NUMBERS ONLY MODE AND NON-NUMERIC - EXIT
CMP R0,#'.
BEQ GETOKP
TSTB NUMF
BNE GETTKR ;NUMBER FOLLOWED BY LETTER IS ERROR
GETOKT: INCB SYMF ;HAVE SEEN SYMBOL CONSTITUENT
MOV @R2,R1
.IFNZ EISSW
MUL #50,R1
.IFF
ASL R1
ASL R1
ASL R1
MOV R1,-(SP)
ASL R1
ASL R1
ADD (SP)+,R1
.ENDC ;EISSW
ADD R5,R1
MOV R1,@R2
SOB R4,GETNTK ;DEC COUNT OF REMAINING RADIX50 SLOTS THIS WORD
TST (R2)+ ;SYM FILLED UP, MOVE ON TO SYM1
CMP R2,#SYM2
BLE GETOKM ;RESET COUNT IN R4 AND GET NEXT CHAR
TST -(R2) ;ASSEMBLE OVERFLOW CRUD IN SYM2
BR GETOKM
GETKX1: TSTB SYMF
BEQ GETOKX
MOV @R2,R5
GETKX2:
.IFNZ EISSW
MUL #50,R5 ;LEFT ADJUST THE RADIX 50 SYMBOL
.IFF
ASL R5
ASL R5
ASL R5
MOV R5,-(SP)
ASL R5
ASL R5
ADD (SP)+,R5
.ENDC ;EISSW
SOB R4,GETKX2
MOV R5,@R2
GETOKX: CLRB NUMOM
CLRB FLUSHF
RTS PC
;GOT INITIAL . MAYBE
GETOKP: TSTB NUMF
BNE GETOKX ;. AFTER NUMBER - EXIT
JSR PC,STYI ;INITIAL . GET NEXT TO FIGURE OUT WHAT TO DO
CMP R0,#'0
BLT GETKP1 ;NOT NUMBER, TREAT . AS SYMBOL CONSTITUENT
CMP R0,#'9
BGT GETKP1 ;NOT NUMBER, TREAT . AS SYMBOL CONSTITUENT
INCB NUMF ;. THEN NUMBER, TREAT AS 0.
MOV #'.,R0 ;PUT BACK .
BR GETOKX ;EXIT
GETKP1: MOV #34,R5 ;RADIX 50 FOR .
BR GETOKT ;TREAT . AS PART OF SYMBOL
GETTKR: JMP QERR
;GETR CONVERT ASCII CHAR IN R5 TO RADIX 50 AND SKIP UNLESS NOT RADIX 50 CHAR
GETR: CMPB R5,#'.
BEQ GETRP
CMPB R5,#'%
BEQ GETRC
CMPB R5,#'$
BEQ GETRD
CMPB R5,#'0
BLT GETRX
CMPB R5,#'9
BLE GETRN
CMPB R5,#'A
BLT GETRX
CMPB R5,#'Z
BGT GETRX
SUB #'A-1,R5
GETROX: ADD #2,(SP)
GETRX: RTS PC
GETRN: SUB #'0-36,R5
BR GETROX
GETRP: MOV #34,R5
BR GETROX
GETRC: MOV #35,R5
BR GETROX
GETRD: MOV #33,R5
BR GETROX
;TTITST, INTST, STYI, TYI, TYO, TYPE
;TEST FOR TTY INPUT, SKIP IF YES.
TTITST:
.IFNZ TT10SW
TST TT10FL
BNE TTITS1
TSTB RCSR10
BNE TTITS2
RTS R5
TTITS1:
.ENDC; TT10SW
TSTB RCSR
BPL TTITS3
TTITS2: TST (R5)+
TTITS3: RTS R5
;SKIP IF THERE IS ANY TTY INPUT PRESENT (DOES TYI IN THAT CASE)
INTST: JSR R5,TTITST
BR INTSTR
ADD #2,(SP)
BR TYI
;LIKE TYI, EXCEPT PUTS RESULTING CHARACTER IN SNEAK1
STYI: JSR PC,TYI
MOVB R0,SNEAK1
INTSTR: RTS PC
TYISN1: MOVB SNEAK1,R0
CLRB SNEAK1
RTS PC
TYISN2: MOVB SNEAK2,R0
CLRB SNEAK2
RTS PC
BTYI: MOVB @TIOP,R0 ;INPUT FROM THE BUFFER
INC TIOP
RTS PC
TYIRUB: CMP TIIP,#TYIB ;RUBOUT HANDLER
BLOS GETTKR ;ERROR IF NOTHING TO RUB OUT
DEC TIIP ;TAKE BACK ONE CHAR
MOVB @TIIP,R0
.IFZ VT05SW
JSR PC,TYO00 ;ECHO CHAR BEING RUBBED OUT
.IFF
.IRP CH,<10,40,10> ;OR, ON VT05, ERASE OFF SCREEN
MOV #CH,R0
JSR PC,TYO00
.ENDC
MOV #TYIB,TIOP ;SET TO RE-READ INPUT BUFFER
JMP CMD1 ;CRAP OUT AND RE-DO
;READ CHARACTER INTO R0
TYI: TSTB SNEAK1
BNE TYISN1 ;READ CHAR FROM SNEAK1
TSTB SNEAK2
BNE TYISN2 ;READ CHAR FROM SNEAK2
CMP TIOP,TIIP
BLO BTYI ;READ FROM BUFFER
JSR R5,TTITST
BR .-4
.IFNZ TT10SW
TST TT10FL
BNE TYI00
MOVB RDB10,R0
CLRB RDB10
BR TYI01
TYI00:
.ENDC; TT10SW
MOVB RDB,R0
TYI01: BIC #177600,R0
BEQ TYORET ;IGNORE NULLS
CMP R0,#177
BEQ TYIRUB ;BRANCH IF RUBOUT
CMPB R0,#'a ;UPPER CASEIFY
BLO TYI2
CMPB R0,#'z
BHI TYI2
SUB #'a-'A,R0
TYI2: MOVB R0,@TIIP ;STICK INTO BUFFER
CMP TIIP,#TYIBE
BHIS TYI02
INC TIIP
TYI02: MOV TIIP,TIOP
CMPB R0,#175
BNE TYI1
MOV #33,R0
TYI1: CMP R0,#15
BEQ TYORET ;DON'T TYPE CR NOW
CMP R0,#12
BEQ TYORET ;DON'T TYPE LF NOW
BR TYO00
;TYPE CHARACTER IN R0. IGNORE 1S
TYO: MOV #TYIB,TIIP ;TYPEOUT => INPUT HAS BEEN GOBBLED
MOV #TYIB,TIOP
TYO00: BIC #177600,R0 ;FLUSH PARITY BIT
.IFZ VT05SW
BEQ TYORET ;TYPE NULLS (PADDING) IF VT05
.ENDC
CMPB R0,#40
BHIS TYOTYP ;TYPE BIGGER THAN 40 AS IS
; CMPB R0,#1
; BEQ TYORET ;FLUSH 1S
CMPB R0,#11
BEQ TYOTYP ;TYPE TABS
CMPB R0,#33
BEQ TYOALT ;TYPE $ FOR ALT MODE
CMP R0,#12
BEQ TYOTYP
CMP R0,#15
BEQ TYOTYP
MOV R0,-(SP)
MOV #'^,R0
JSR PC,TYOTYP
MOV (SP)+,R0
BIS #100,R0
JSR PC,TYOTYP
BIC #100,R0
BR TYORET
TYOTYP:
.IFNZ TT10SW
TST TT10FL
BNE TYO1
TSTB TCSR10
BNE .-4
MOVB R0,TDB10
BR TYORET
TYO1:
.ENDC; TT10SW
TSTB TCSR
BPL .-4
MOVB R0,TDB
.IFNZ VT05SW
CMPB R0,#12
BNE TYORET
CLR R0
JSR PC,TYOTYP
JSR PC,TYOTYP
JSR PC,TYOTYP
JSR PC,TYOTYP
MOV #12,R0
.ENDC; VT05SW
TYORET: RTS PC
TYOALT: MOV #'$,R0
JSR PC,TYOTYP
MOV #33,R0
RTS PC
;CALL WITH JSR R5,TYPE FOLLOWED BY BYTES OF ASCII TO BE TYPED FOLLOWED BY ZERO BYTE
TYPE0: JSR PC,TYO
TYPE: MOVB (R5)+,R0
BNE TYPE0
INC R5 ;INCREMENT TO NEXT EVEN ADDRESS
BIC #1,R5
RTS R5
;CRLF, CRLFS, DTYPE, OTYPE, NTYPE, SNTYPE
CRLF: JSR R5,TYPE
.BYTE 15
.BYTE 12
.BYTE 0
.EVEN
RTS PC
CRLFS: JSR PC,CRLF
MOV #'*,R0
BR TYO
;TYPE DECIMAL INTEGER IN R1
DTYPE: MOV R2,-(SP)
MOV #10.,R2
JSR PC,RTYPE
DTYPEX: MOV (SP)+,R2
RTS PC
.IFNZ EISSW ;TYPE NUMBER, RADIX (8 OR 10) IN R2, NUMBER IN R1
RTYPE: CLR R0
DIV R2,R0
BEQ RTYPE1
MOV R1,-(SP)
MOV R0,R1
JSR PC,RTYPE
MOV (SP)+,R1
RTYPE1: MOV R1,R0
JMP NTYO
.IFF ;TYPE NUMBER WITHOUT USING DIVIDE HARDWARE
RTYPE: JSR PC,DIVIDE
TST R1
BEQ RTYPE1
MOV R0,-(SP)
JSR PC,RTYPE
MOV (SP)+,R0
RTYPE1: JMP NTYO
.ENDC ;EISSW
;TYPE R1 IN OCTAL
OTYPE: MOV R2,-(SP)
MOV #10,R2
JSR PC,RTYPE
BR DTYPEX
;TYPE R1 AS SIGNED 16 BIT NUMBER
SNTYPE: TST R1
BPL NTYPE
MOV #'-,R0
JSR PC,TYO
NEG R1
NTYPE: TSTB DECMD
BEQ OTYPE
JSR PC,DTYPE
MOV #'.,R0
JMP TYO
;DIVISION SUBROUTINE
;DIVIDES C(R1) BY C(R2), QUOTIENT TO R1, REMAINDER TO R0
.IFZ EISSW
DIVIDE: MOV R3,-(SP)
MOV #16.,R3
CLR R0
1$: ASL R1
ROL R0
CMP R0,R2
BLO 2$
SUB R2,R0
INC R1
2$: SOB R3,1$
MOV (SP)+,R3
RTS PC
.ENDC ;EISSW
;FTYPE TYPE AC0 AS FLOATING POINT
.IFNZ FPPSW
;TYPE FLOATING VALUE IN AC0 IN APPROPRIATE PRECISION
FTYPE: MOVB #16.,FDIGCT ;DIGIT COUNTER
TSTB DBLFMD
BNE FTYPDP
MOVB #8,FDIGCT ;SINGLE PRECISION
FTYPDP: CLR POWER
TSTD AC0
CFCC
BEQ FTYP1A ;TYPE 0.0
BPL FTYPE1
MOV #'-,R0
JSR PC,TYO
ABSD AC0
FTYPE1: CMPD DTENTH,AC0
CFCC
BGT FTYPE2 ;BRANCH IF NUMBER IS LT 0.1
LDD DBIG16,AC1
CMPB FDIGCT,#8
BNE .+6
LDD DBIG8,AC1
CMPD AC1,AC0
CFCC
BLE FTYPE3 ;BRANCH IF NUMBER IS  10^16
FTYPE5: MODD D1,AC0 ;AC1_INTEGER PART, AC0_DECIMAL PART
TSTD AC1
CFCC
BEQ FTYP1A ;ZERO INTEGER PART
LDD AC1,AC2
JSR PC,FTYPDC ;TYPE AC2 AS DECIMAL
FTYDPT: MOV #'.,R0
JSR PC,TYO
TSTB FDIGCT
BEQ FTYDP1 ;OUT OF DIGITS, TYPE A 0 FOR THE DECIMAL PART
FTYPE4: MODD D10,AC0 ;TYPE DECIMAL PART FROM AC0
STCDI AC1,R0
JSR PC,NTYO ;TYPE THE DIGIT
TSTD AC0
CFCC
BEQ FTYPEX ;ZERO DECIMAL PART
DECB FDIGCT
BNE FTYPE4
BR FTYPEX
FTYDP1: JSR PC,TYO0
FTYPEX: TSTB POWER
BEQ FTYRET ;NO EXPONENT TO TYPE
TSTB POWER+1
BNE FTYPX1
TYPEIT E-
BR FTYPX2
FTYPX1: TYPEIT E+
FTYPX2: MOVB POWER,R1
BPL FTYPX3
NEG R1
FTYPX3: JMP DTYPE ;TYPE THE EXPONENT
FTYRET: RTS PC
FTYP1A: JSR PC,TYO0 ;TYPE A ZERO
BR FTYDPT
FTYPDC: LDD AC2,AC1
MODD DTENTH,AC2 ;AC3_INTEGER PART/10
LDD AC3,AC2 ;VALUE FOR NEXT CALL ON FTYPDC
CFCC
BEQ FTYPD1
MULD D10,AC3
SUBD AC3,AC1 ;LEAST SIGNIFICANT DIGIT
STCDI AC1,-(SP) ;PUSH DIGIT
JSR PC,FTYPDC
MOV (SP)+,R0 ;GET DIGIT BACK
FTYPD2: DECB FDIGCT
.IFTF ;NTYO ROUTINE NEEDED EVEN IF NO FLOATING POINT
NTYO: ADD #'0,R0
JMP TYO
.IFT
FTYPD1: STCDI AC1,R0
BR FTYPD2
TYO0: CLR R0
BR NTYO
;TYPE AS EITHER 0.XXXE-NN OR X.XXXXE+NN
FTYPE3: INCB POWER+1 ;INDICATE 10^8 OR 10^16
FTYPE2: STD AC0,FTEMP
MOV FTEMP,R0
MUL #154.,R0 ;154/512 = .301
SUB #38.,R0 ;THIS IS APPROXIMATELY THE POWER OF TEN
MOVB R0,POWER
ASH #3,R0
NEG R0
MULD DTENTB(R0),AC0 ;TRY TO SCALE TO 10^0
FTYP2C: STD AC0,AC2
MODD D1,AC2
STCDI AC3,R0 ;INTEGER PART
CMP R0,#9
BGT FTYP2D ;TOO BIG
TST R0
BEQ FTYP2E ;DECIMAL PART IS ZERO
TSTB POWER+1
BNE FTYPE5 ;TYPE THE NUMBER NOW
FTYP2D: MULD DTENTH,AC0
INCB POWER
BR FTYP2C
FTYP2E: TSTB POWER+1
BEQ FTYP2F
FTYP2G: MULD D10,AC0
DECB POWER
BR FTYP2C
FTYP2F: CMPD DTENTH,AC0
CFCC
BGT FTYP2G
BR FTYPE5 ;TYPE THE NUMBER NOW
.ENDC ;FPPSW
;A1BRK, A2BRK, BRKPRO
A1BRK: JSR PC,EVPOP
JSR PC,NUMCHK ;MAKE SURE WE HAVE AN INTEGER VALUE
TST R1
BEQ A1BRK2 ;FLUSH NUMBERED BREAKPOINT
JSR PC,BPTSRC ;SEE IF THERE IS ALREADY A BPT AT THIS ADDRESS
BR A1BRK2 ;NO
CLR BPTADR-2(R0) ;YES, FLUSH OLD
A1BRK2: TSTB ALTVF
BNE A1BRK6 ;NUMBER WAS TYPED AFTER ALT
MOV #2,R0 ;SEARCH FOR A FREE BREAKPOINT SLOT
A1BRK4: TST BPTADR-2(R0)
BEQ A1BRK5 ;FOUND ONE
TST (R0)+
CMP R0,#NBPTS*2
BLE A1BRK4
TYPEIT < ?TMB? > ;TOO MANY BREAKPOINTS
JMP CMD1
A1BRKR: JMP QERR
A1BRK6: MOVB SALTNM,R0
BEQ A1BRKR ;NO BREAKPOINT ZERO
ASL R0 ;MAKE INTO AN INDEX
A1BRK5: MOV R1,BPTADR-2(R0) ;STORE ADDRESS OF THE BREAKPOINT
CLR BPTCNT-2(R0) ;SET COUNT TO ZERO
CLRB BPTRGF-2(R0) ;NO LOCATION TO TYPE
TSTB ALTPVF
BNE A1BRK7 ;LOCATION TO TYPE OUT
A1BRKX: JMP CMD2
A1BRK7: MOV ALTPV,BPTLOC-2(R0)
INCB BPTRGF-2(R0)
TSTB ALPVRF
BEQ A1BRKX ;NOT A REGISTER
MOVB #-1,BPTRGF-2(R0)
BR A1BRKX
A2BRK0: MOV #NBPTS*2+2,R0
A2BRKL: CLR BPTADR-2(R0)
DEC R0
SOB R0,A2BRKL
BR A1BRKX
A2BRK: JSR PC,EVPOP ;$$B -- Was an expression typed?
TSTB EVSIZE+1
BEQ A2BRK0 ;No. Clear all breakpoints.
JSR PC,NUMCHK ;Yes. Make sure it's an integer.
JSR PC,BPTSRC ;Is there a breakpoint here?
BR A1BRKX ;No. Screw it.
CLR BPTADR-2(R0) ;Yes. Get rid of it.
BR A1BRKX
BRKPR1: MOV DOTVAL,R1
BR BRKPR2
BRKPRO: JSR PC,EVPOP ;^P -- check for an expression
TSTB EVSIZE+1
BEQ BRKPR1 ;No expr defaults to .
JSR PC,NUMCHK
BRKPR2: JSR PC,BPTSRC ;If there is already a breakpoint here,
BR BRKPR3
CLR BPTADR-2(R0) ;get rid of it.
BRKPR3: MOV #NBPTS*2+2,R0 ;Set breakpoint no. to 8.
MOV R1,BPTADR-2(R0) ;Plant the breakpoint,
BR A1PRO1 ;and proceed.
;A1GO, A2GO, A1PRO, A2PRO, PROCED, SSTEP
A1GO1: MOV SADDR,R1
BR A1GO4
A1GO: JSR PC,EVPOP
TSTB EVSIZE+1
BEQ A1GO1 ;JUST $G. START AT STARTING ADDRESS
JSR PC,NUMCHK ;VALUE GIVEN, MAKE SURE IT'S AN INTEGER
A1GO4: CLRB PROCF
CLRB LBPTN
BIT #1,R1
BNE A1GOOD ;ODD STARTING ADDRESS
XCTGO: JSR PC,CRLF
MOV R1,UPC
JSR PC,BPTINC
A1GO2: MOV #A1GO3,RSTRET
JMP RESTST ;RESTORE THE WORLD
A1GO3: MOV UST,-(SP) ;PUSH THE PS
MOV UPC,-(SP) ;AND THE PC
RTT ;AND AWAY WE GO
A1GOOD: TYPEIT < ?ODD? >
JMP CMD1
A2GO: JSR PC,EVPOP
TSTB EVSIZE+1
BEQ A1GO1 ;$$G SAME AS $G
JSR PC,NUMCHK ;INTEGER VALUES ONLY, PLEASE
MOV R1,SADDR ;SET STARTING ADDRESS
BR A1GO4
A1PRO1: MOV #1,R1
BR A1PRO2
A2PROQ: DECB A2PF ;^P is like $$P but does not type out
BR A1PRO ;at breakpoints.
A2PRO: INCB A2PF ;LIKE $P BUT DOES AUTOMATIC $P UPON BREAKING
A1PRO: JSR PC,EVPOP
TSTB EVSIZE+1
BEQ A1PRO1 ;NO VALUE IS LIKE 1$P
JSR PC,NUMCHK
A1PRO2: TSTB PROCF
BEQ A1PRER ;PROCEED NOT ALLOWED NOW
JSR PC,CRLF
BIT #1,UPC
BNE A1GOOD
MOVB PROCF,R0
MOV R1,BPTCNT-2(R0) ;STORE PROCEED COUNT
PROCED: BIC #20,UST
JSR PC,PROCE1
BR A1GO2
SSTEP: BIS #20,UST
JSR PC,PROCE1
CLRB LBPTN
BR A1GO2
PROCE1: MOV UPC,R1
JSR PC,BPTSRC
BR PROCE2
MOV R1,BPPROL
PROCE2: MOVB R0,LBPTN
BEQ BPTINC
BIS #20,UST
BR BPTINC
A1PRER: JMP QERR
;BPTRST, BPTINC, BPTTRP, BPTSRC
;PUT INSTRUCTIONS BACK WHERE THE BREAKPOINTS ARE
BPTRST: MOV #NBPTS*2+2,R0
BPTRS2: TST BPTADR-2(R0)
BEQ BPTRS1 ;NO BREAKPOINT HERE
MOV R0,-(SP)
MOV R1,-(SP)
MOV BPTINS-2(R0),R1
MOV BPTADR-2(R0),R0
JSR PC,WRTWRD
MOV (SP)+,R1
MOV (SP)+,R0
BPTRS1: DEC R0
SOB R0,BPTRS2
RTS PC
;PUT BPTS IN CORE EXCEPT FOR THE ONE AT BREAKPOINT # LBPTN
BPTINC: MOV #NBPTS*2+2,R2
MOVB LBPTN,R3
BPTIN1: MOV BPTADR-2(R2),R0 ;ADDRESS OF THIS BPT
BEQ BPTIN2 ;NO BREAKPOINT HERE
JSR PC,GETWRD
MOV R1,BPTINS-2(R2) ;GET COPY OF WHAT'S THERE NOW
CMP R2,R3
BEQ BPTIN2
MOV #BPTOP,R1
JSR PC,WRTWRD
BPTIN2: DEC R2
SOB R2,BPTIN1
RTS PC
;SEARCH FOR BREAKPOINT AT ADDRESS R1. RETURN INDEX INTO BREAKPOINT TABLES
;IN R0 AND SKIP RETURN IF FOUND
BPTSRC: MOV #NBPTS*2+2,R0
BPTSR2: CMP BPTADR-2(R0),R1
BEQ BPTSR3 ;FOUND THE ENTRY FOR THIS BREAKPOINT
DEC R0
SOB R0,BPTSR2
RTS PC
BPTSR3: ADD #2,(SP)
RTS PC
BPTAXR: MOV SVUPC,UPC
JMP CMD
;PROCEEDING FROM A BREAKPOINT
BPTPRO: MOV R0,-(SP) ;Set the BPT in core.
MOV R1,-(SP)
MOV (PC)+,R0
BPPROL: 0
MOV #BPTOP,R1
JSR PC,WRTWRD
MOV (SP)+,R1
MOV (SP)+,R0
CLRB LBPTN
BIC #20,2(SP) ;Proceed at full speed.
RTI
;BREAKPOINT OR TRACE TRAP
BPTTRP: BIT #20,2(SP) ;One-stepping?
BEQ BPTTR1
TSTB LBPTN ;Yes. Are we proceeding from a breakpont?
BNE BPTPRO ;Yes. Get out of here.
BPTTR1: MOV #BPTTR2,SAVRET
JMP SAVEST ;Save the world.
BPTTR2: MOV KSP,R0
MOV (R0)+,R1 ;Get the user's PC and PSW.
MOV (R0)+,UST
MOV R0,KSP ;Correct the user's SP.
CMP R1,#XCTBPL+2 ;Return from $X?
BEQ BPTAXR ;Yes.
MOV R1,UPC ;Save the user's PC.
TST -(R1) ;Back it up to where a BPT might be.
JSR PC,BPTSRC ;Do we have a breakpoint set here?
BR BPTTR3 ;No.
BIT #20,UST ;Yes. If the T bit is on, we just
BNE BPTTR3 ;stepped that instruction.
JSR PC,BPTMP
MOV R1,UPC ;We didn't. Save the corrected PC.
DEC BPTCNT-2(R0) ;Time to break here?
BGT BPTRT3
BPTR2A: CLR BPTCNT-2(R0) ;Yes.
TSTB A2PF
BPL BPTTR4 ;Are we ^Q'ing?
MOVB R0,LBPTN
JSR PC,INTST ;Yes. Anything typed?
BR BPTRET ;No. Proceed.
JSR PC,CRLF ;Yes. Break.
CLRB A2PF
MOVB LBPTN,R0
BR BPTTR4
BPTTR3: TST (R1)+ ;We didn't hit a breakpoint. Are we
BPTSS: JSR PC,BPTSRC ;about to step into one?
BR BPTTR5 ;No.
JSR PC,BPTMP
BPTTR4: MOVB R0,PROCF ;Either we ran into a breakpoint or
MOVB R0,LBPTN ;we're about to step into one.
MOV R0,R2
ASR R2
ADD #'0,R2
MOVB R2,BPTANM
JSR R5,TYPE ;Type out the breakpoint number.
.BYTE '$
BPTANM: .BYTE '0
.ASCIZ /B; /
.EVEN
BR BPTTYP
BPTRT3: JSR PC,INTST
BR BPTRET
MOVB LBPTN,R0
BR BPTR2A
BPTTR5: BIT #20,UST ;Not at a breakpoint. If T bit is off,
BNE BPTTR6
SUB #2,UPC ;back up PC to the BPT instruction
MOVB #-1,LBPTN ;and flag that this is 'BE'
JSR R5,TYPE ;we just entered DDT.
.ASCIZ /
BE; /
.EVEN
BR BPTTR7
BPTTR6: JSR R5,TYPE ;Otherwise, we're just steppin' along.
.ASCIZ /SS; /
.EVEN
CLRB LBPTN ;Remember that we're not at a breakpoint.
BPTTR7: CLRB A2PF
MOVB #8*2,PROCF
BPTTYP: BIC #20,UST ;Done with the trace bit for now...
MOV UPC,R1
JSR PC,SYTYPE ;Type the location of the instruction.
MOV #'>,R0
JSR PC,TYO
JSR PC,TYO
MOV UPC,R0
MOV R0,INSLOC
JSR PC,GETWRD ;Get the instruction
MOV R1,INSVAL
JSR PC,INSTTY ;and type it.
MOVB LBPTN,R0 ;Are we at a breakpoint?
BMI BPTTY5
BEQ BPTTY2
MOV BPTLOC-2(R0),R1 ;Yes. Get the location associated
CLRB EVREGF ;with the breakpoint.
TSTB BPTRGF-2(R0)
BEQ BPTTY2 ;Are we supposed to type it out?
BPL BPTTY1 ;Yes.
INCB EVREGF
BPTTY1: CLRB LBPTN
TYPEIT < >
JSR PC,ATAB9 ;Do it.
BPTTY2: TSTB A2PF ;Doing a $$P?
BNE BPTTY3
JMP CMD2 ;No. Go listen to the user.
BPTTY3: JSR PC,INTST ;Yes. Did he type something?
BR BPTRT2 ;No. Proceed.
CLRB A2PF ;He did. Stop $$P-ing.
BPTTY4: JMP CMD
BPTRT2: JSR PC,CRLF
BPTRET: JMP PROCED
BPTMP: CMP R0,#NBPTS*2+2 ;At a breakpoint. Is it no. 8?
BNE BPTMP1
CLR BPTADR-2(R0) ;Yes. Clear the breakpoint,
CLRB A2PF ;stop $$P'ing.
BPTMP1: RTS PC
BPTTY5: ADD #2,UPC ;Adjust PC so can proceed from 'BE'
BR BPTTY2
;CMDTB, POPTB, ALTTB
;DEFINE LIST OF SEPARATOR CHARACTERS. THE ARGUMENTS TO X
;ARE THE DISPATCH ADDRESS, FLAG FOR POPPING OP STACK, FLAG
;FOR LEGAL IN INSTRUCTION TYPEIN
.MACR CMDS
.REPT 9
X QERR,,INILL ;0-10
.ENDR
X ATAB,POP,INSEP ;11 TAB
X ALF,POP,INSEP ;12 LINE FEED
X QERR,,INILL ;13 ^K
X QERR,,INILL ;14 ^L
X ACR,POP,INSEP ;15 CARRIAGE RETURN
X ASSTEP,POP,INILL ;16 ^N
X QERR,,INILL ;17 ^O
X BRKPRO,POP,INILL ;20 ^P
X A2PROQ,POP,INILL ;21 ^Q
X QERR,,INILL ;22 ^R
X ASSTEP,POP,INILL ;23 ^S
.REPT 4
X QERR,,INILL ;24-27 ^T-^W
.ENDR
X ASSTEP,POP,INILL ;30 ^X
.REPT 2
X QERR,,INILL ;31-32 ^Y-^Z
.ENDR
X AALT,,INSEP ;33 ALT MODE
.REPT 4
X QERR,,INILL ;34-37
.ENDR
X ASP,,INOK ;40 SPACE
X AQUOT,,INOK ;41 !
X ADQUO,,INOK ;42 "
X QERR,POP,INILL ;43 #
X QERR,,INILL ;44 $
X QERR,,INILL ;45 %
X AAMPR,,INOK ;46 &
X ASQUO,,INOK ;47 '
X ALPAR,,INOK ;50 (
X ARPAR,,INOK ;51 )
X ASTAR,,INOK ;52 *
X APLUS,,INOK ;53 +
X ACOMMA,POP,INSEP ;54 ,
X AMINUS,,INOK ;55 -
X QERR,,INILL ;56 .
X ASLASH,POP,INILL ;57 /
.REPT 10.
X QERR,,INILL ;60-71 0-9
.ENDR
X ACOLN,,INILL ;72 :
X QERR,POP,INILL ;73 ;
X ALESS,POP,INILL ;74 <
X AEQUL,POP,INSEP ;75 =
X AGREAT,POP,INILL ;76 >
X QERR,,INILL ;77 ?
X AAT,POP,INSEP ;100 @
.REPT 26.
X QERR,,INILL ;101-132 A-Z
.ENDR
X ALBRK,POP,INSEP ;133 [
X ABACK,POP,INSEP ;134 \
X QERR,,INSEP ;135 ]
X AUARR,POP,INSEP ;136 ^
X ALARR,POP,INSEP ;137 _
.REPT 40
X QERR,,INILL ;140-177
.ENDR
.ENDM
.MACR X A,B,C
A
.ENDM
CMDTB: CMDS
.MACR X A,B,C
.IFNB B
.BYTE 1
.ENDC
.IFB B
.BYTE 0
.ENDC
.ENDM
POPTB: CMDS
.EVEN
.MACR X A,B,C
.IF IDN C,INSEP
.BYTE 1
.ENDC
.IF IDN C,INILL
.BYTE -1
.ENDC
.IF IDN C,INOK
.BYTE 0
.ENDC
.ENDM
INLTB: CMDS
.EVEN
.MACR ALTS
X A1ABS,A2ABS ;A
X A1BRK,A2BRK ;B
X A1CNST,A2CNST ;C
X A1DEC,A2DEC ;D
X A1EFF,A1EFF ;E
X A1FLT,A2FLT ;F
X A1GO,A2GO ;G
X A1HALF,A2HALF ;H
X A1INST,A2INST ;I
X QERR,QERR ;J
X A1HK,A2SYKL ;K
X A1DBL,A2DBL ;L
X A1MASK,A1MASK ;M
X A1NOT,A1NOT ;N
X A1OCT,A2OCT ;O
X A1PRO,A2PRO ;P
X A1Q,A1Q ;Q
X A1REL,A2REL ;R
X A1SYMB,A2SYMB ;S
X A1TXT,A2TXT ;T
.IFNZ MAPSW
X A1DASP,A2DASP ;U
.IFF
X QERR,QERR
.ENDC ;MAPSW
X A1FLTI,A2FLTI ;V
X A1WORD,A1WORD ;W
X A1XCT,A1XCT ;X
X A1BYTE,A2BYTE ;Y
X A1ZERO,A2ZERO ;Z
.ENDM
.MACR X A,B
A
.ENDM
ALTTB: ALTS
.MACR X A,B
B
.ENDM
ALT2TB: ALTS
;VARIABLES, FLAGS AND CONSTANTS
UR0: .BLKW 6 ;USER R0-R5, REGISTER SET 0
KSP: 0 ;KERNEL R6
UPC: 0 ;USER PC
.IFNZ P45SW
UR10: .BLKW 6 ;R0-R5, REGISTER SET 1
SSP: 0 ;SUPERVISOR R6
USP: 0 ;USER R6
USTLIM: 0 ;USER'S SAVED STLIMR
.ENDC ;P45SW
UST: PR7 ;USER'S SAVED PS
UNXMA: 0 ;USER'S NXM TRAP ADDRESS SAVED HERE
UNXMS: 0 ;USER'S NXM TRAP STATUS SAVED HERE
.IFNZ FPPSW
UFPST: 0 ;USER'S SAVED FLOATING POINT PROCESSOR STATUS
FAC0: .BLKW 4*6 ;FLOATING POINT PROCESSOR ACS
.ENDC ;FPPSW
.BLKW 20
GARBST: ;USER STACKS SET TO HERE IF THEY ARE LOSERS TO BEGIN WITH
.LIF NZ DEBSW
DDTST: PR7
SVUPC: 0 ;UPC SAVED HERE ON $X
MASK: -1 ;THIS IS $M
CMASK: 0 ;COMPLEMENT OF MASK
TARGET: 0 ;COPY OF THING TO SEARCH FOR AT SRCH
POWER: 0 ;POWER OF 10 TO MULTIPLY BY
EVSIZE: 0 ;HIGH BYTE NONZERO MEANS LOW BYTE VALID
;LOW BYTE 0 FOR INTEGER, NONZERO FOR FLOATING
REGWAD: 0 ;ADDRESS IN SYM TABLE OF RELEVANT REGISTER WORD
SYTYAD: 0 ;ADDRESS OF BEST SYMBOL FOUND IN SYTYPE
MXOFF: 100 ;MAXIMUM OFFSET TO USE IN SYMBOLIC TYPEOUT
LFINC: 0 ;AMOUNT TO INCREMENT . BY ON A LF
INS1: 0 ;INSTRUCTION STORED HERE ON TYPEIN FROM EVAL
INS2: 0 ;IT IS ASSEMBLED AS IF THE ADDRESS OF THE FIRST
INS3: 0 ;WORD OF THE INSTRUCTION WAS ZERO
XCTBPL: BPTOP ;MUST FOLLOW INS1-3
INSP: INS2 ;POINTER TO INS2 AND 3
INREL: 0 ;RELOCATION INFO FOR INS2-3. LOW BYTERELOCATE INS2
;HIGH BYTERELOCATE INS3
INRELP: 0 ;POINTER TO INREL OR INREL+1
SSDDPC: 0 ;PC FOR SSORDD
ALTPV: 0 ;VALUE IN PARENS AFTER ALT
EXPRT1::
FTEMP: .BLKW 4 ;TEMPORARY DURING FLOATING POINT TYPEOUT
T1: 0 ;VERY TEMPORARY
T2: 0 ;VERY TEMPORARY
SYM: 0 ;ACCUMULATE 2 WORDS OF RADIX 50
SYM1: 0
SYM2: 0 ;FOR OVERFLOW FROM SYM1
FLT1: 0 ;TEMPORARY FOR STORING DOUBLE FLOATING RESULTS
0
0
0
TVAL: 0
VAL1: 0
VAL2: 0
VAL3: 0
VALP: VAL1
VALRF: 0
LVAL: 0 ;VALUE STORED HERE BY EVAL, SEE LVREGF, LVFLTF
LFVAL: .BLKW 4 ;FLOATING VALUE STORED HERE, "
OPLOC: 0 ;CURRENTLY OPEN LOCATION
INSLOC: 0 ;ADDRESS OF INSTRUCTION BEING TYPED OUT
INSVAL: 0 ;FIRST WORD OF INSTRUCTION BEING TYPED
LSTADR: 0 ;LAST ADDRESS TYPED OUT
PLSTAD: 0 ;PREVIOUS LSTADR
BPTADR: .IREPT NBPTS,0 ;ADDRESS OF BREAKPOINT. ZERO IS NO BREAKPOINT
SSADR: 0
BPTCNT: .IREPT NBPTS,0 ;BREAKS WHEN COUNTED NON-POSITIVE
SSCNT: 0
BPTINS: .IREPT NBPTS,0 ;INSTRUCTIONS WHERE BREAKPOINTS LIVE
SSINS: 0
BPTLOC: .IREPT NBPTS,0 ;LOCATION TO TYPE UPON HITTING BREAKPOINT (IF BPTREG~0)
SSLOC: 0
BPTRGF: .IREPT NBPTS,0 ;REGISTER (LT 0) AND BPTLOC VALID (~ 0) FLAGS
SSRGF: 0
.=.+100
OPPDL:
.LIF NZ FPPSW
.=.+300
.LIF Z FPPSW
.=.+100 ;SMALLER VALUE PDL IF NO FLOATING POINT
VALPDL:
.=.+LPDL
PDL:
PATCH:
PAT: .BLKW 40
;THE FOLLOWING TWO BYTES MUST BE IN THE SAME WORD
SYMF: .BYTE 0 ;NON-NUMERIC RESULT FROM GETTOK
NUMF: .BYTE 0 ;NUMBER HAS BEEN SEEN IN GETTOK
;THE FOLLOWING TWO BYTES MUST BE IN THE SAME WORD
EXSYMF: .BYTE 0 ;SYMBOL FLAG FROM EXPR
EXNUMF: .BYTE 0 ;NUMERIC FLAG FROM EXPR
NUMOM: .BYTE 0 ;NUMBERS ONLY MODE IN GETTOK
DIGITS: .BYTE 0 ;COUNT OF DIGITS IN GETTOK
FLTF: .BYTE 0 ;FLOATING VALUE IN FLT1 FTL2
FLUSHF: .BYTE 0 ;FLUSH ALL NON-SEPARATORS
NEGEXF: .BYTE 0 ;SET WHEN E- SEEN
EVNOVF: .BYTE 0 ;INDICATES EVAL DOESN'T WANT A VALUE NEXT
POPF: .BYTE 0 ;INDICATE UNWINDING OP STACK
EVREGF: .BYTE 0 ;VALUE IN EVAL IS A REGISTER VALUE
EVINSF: .BYTE 0 ;VALUE IN EVAL IS AN INSTRUCTION (IN INS1 - INS3)
EVINSC: .BYTE 0 ;NUMBER OF WORDS IN INSTRUCTION IF EVINSF SET
EVINLF: .BYTE 0 ;LEFT PAREN IN INSTRUCTION TYPEIN FLAG
FDIGCT: .BYTE 0 ;DIGIT COUNTER IN FTYPE
SYTYRF: .BYTE 0 ;NONZERO IF SYTYPE TO TYPE REGISTER VALUE
SYMADF: .BYTE 0 ;NONZERO IF TYPING ADDRESS AT SYTYPE
INSSDD: .BYTE 0 ;GETSD ASSEMBLES THE ADDRESSING MODE AND REGISTER HERE
SALTNM: .BYTE 0 ;VALUE AFTER ALT SAVED HERE
ALTVF: .BYTE 0 ;SET IF A VALUE AFTER ALT SAVED I SALTNM
ALTPVF: .BYTE 0 ;SET IF VALUE IN PARENS GIVEN AFTER ALT
ALPVRF: .BYTE 0 ;VALUE IN PARENS AFTER ALT IS REG VALUE
T1B: .BYTE 0 ;VERY TEMPORARY
T2B: .BYTE 0 ;VERY TEMPORARY
PROGF: .BYTE 0 ;SET IF WE DON'T NEED TO RESTORE THE STATE OF THE MACHINE
.EVEN
;THE ORDER OF THE TEMPORARY AND PERMANENT TYPEOUT MODES MUST NOT BE CHANGED
;TYPEOUT MODES - TEMPORARY
BYTEMD: .BYTE 0
HALFMD: .BYTE 0 ;TWO BYTES SEPARATED BY COMMAS
INSTMD: .BYTE 1 ;INSTRUCTION MODE
SYMBMD: .BYTE 0 ;TYPE SYMBOLS
FLTYMD: .BYTE 0 ;TYPE FLOATING POINT NUMBERS
TXTMD: .BYTE 0 ;TYPE AS 2 CHAR ASCII
TXT5MD: .BYTE 0 ;TYPE AS 3 CHAR RADIX 50
DECMD: .BYTE 0 ;NUMBERS TYPED IN DECIMAL
ABSMD: .BYTE 0 ;ABSOLUTE MODE (AS OPPOSED TO RELATIVE)
.EVEN
;TYPEOUT MODES - PERMANENT
PBYTEM: .BYTE 0
PHALFM: .BYTE 0 ;TWO BYTES SEPARATED BY COMMAS
PINSTM: .BYTE 1 ;INSTRUCTION MODE
PSYMBM: .BYTE 0 ;TYPE SYMBOLS
PFLTYM: .BYTE 0 ;TYPE FLOATING POINT NUMBERS
PTXTMD: .BYTE 0 ;TYPE AS 2 CHAR ASCII
PTXT5M: .BYTE 0 ;TYPE AS 3 CHAR RADIX 50
PDECMD: .BYTE 0 ;NUMBERS TYPED IN DECIMAL
PABSMD: .BYTE 0 ;ABSOLUTE MODE (AS OPPOSED TO RELATIVE)
.EVEN
;THE NEXT THREE ARE PERMANENT ALWAYS
FLTIMD: .BYTE 1 ;FLOATING POINT INSTRUCTION TYPEOUT
DBLFMD: .BYTE 0 ;DOUBLE PRECISION FLOATING POINT
.LIF NZ MAPSW
DASPMD: .BYTE 1 ;INSTRUCTION SPACE (VS DATA SPACE)
SNEAK1: .BYTE 0 ;STYI PUTS BYTE HERE FOR TYI TO READ
SNEAK2: .BYTE 0 ;TYI CHECKS HERE AFTER CHECKING SNEAK1
LVREGF: .BYTE 0 ;LAST VALUE'S REGISTER FLAG
LVFLTF: .BYTE 0 ;LAST VALUE WAS FLOATING
OPENWD: .BYTE 0 ;0NOT OPEN, 1BYTE OPEN, 2WORD OPEN
OPLORF: .BYTE 0 ;OPLOC IS A REGISTER
LSTADG: .BYTE 0 ;LSTADR IS A REGISTER
PLSADG: .BYTE 0 ;PLSTAD IS A REGISTER
PROCF: .BYTE 0 ;NON-ZERO  OK TO PROCEED (INDEX OF LAST BPT)
LBPTN: .BYTE 0 ;LAST BPT INDEX
A2PF: .BYTE 0 ;$$P FLAG
DDTINI: .BYTE 0 ;NON-ZERO AFTER DDT HAS RUN THE FIRST TIME
BRKFL: .BYTE 0 ;SET BY LEFT BRACKET CLEARED AT EVAL
SRCHTY: .BYTE 0 ;1EFF ADDR, -1NOT WORD, 0WORD SEARCH
.EVEN
;RUBOUT HANDLER VARIABLES
TYIB: .BLKB 100 ;TYPE-IN BUFFER
TYIBE::
TIIP: TYIB ;-> NEXT CHAR IN
TIOP: TYIB ;-> NEXT CHAR OUT
;DTENTB POWERS OF TEN
.IFNZ FPPSW
DM38: .WORD 531,143734,166523,143440 ;10^-38
.WORD 1410,16352,12124,56164
.WORD 2252,22044,114551,71621
.WORD 3124,126455,137703,150166
.WORD 4004,166074,113732,61112
.WORD 4646,23513,136720,175334
.WORD 5517,130436,126505,34623
.WORD 6401,147263,26113,41774
.WORD 7242,41137,173536,12373
.WORD 10112,151367,172465,115072
.WORD 10775,103665,171203,312
.WORD 11636,72321,133621,160176
.WORD 12506,11006,22566,54236
.WORD 13367,113207,127323,167305
.WORD 14232,137024,146504,72474
.WORD 15101,66632,225,111212
.WORD 15761,144400,100272,173455
.WORD 16627,16640,50164,155174
.WORD 17474,162410,62222,10433
.WORD 20354,17112,76666,112542
.WORD 21223,111356,107222,16535
.WORD 22070,73652,31066,122265
.WORD 22746,112624,137304,46742
.WORD 23620,16574,173472,130255
.WORD 24464,22334,32411,56330
.WORD 25341,27023,41113,132016
.WORD 26214,136314,4557,50211
.WORD 27057,165777,5713,22253
.WORD 27733,163376,147275,166726
.WORD 30611,70137,40466,132246
.WORD 31453,146167,10604,60717
.WORD 32326,137624,152745,75103
.WORD 33206,33675,2657,66152
.WORD 34047,142654,43433,43604
.WORD 34721,133427,54342,14545
.WORD 35603,11156,113615,47737
.WORD 36443,153412,36560,121727
DTENTH: .WORD 37314,146314,146314,146315
D1:
DTENTB: .WORD 40200,0,0,0
D10: .WORD 41040,0,0,0
.WORD 41710,0,0,0
.WORD 42572,0,0,0
.WORD 43434,40000,0,0
.WORD 44303,50000,0,0
.WORD 45164,22000,0,0
.WORD 46030,113200,0,0
DBIG8: .WORD 46676,136040,0,0
.WORD 47556,65450,0,0
.WORD 50425,1371,0,0
.WORD 51272,41667,40000,0
.WORD 52150,152245,10000,0
.WORD 53021,102347,25000,0
.WORD 53665,163040,172200,0
.WORD 54543,57651,30640,0
DBIG16: .WORD 55416,15711,137404,0 ;10^16
.WORD 56261,121274,27305,0
.WORD 57136,5553,35166,40000
.WORD 60012,143443,2211,164000
.WORD 60655,74353,142654,61000
.WORD 61530,153446,133427,75200
.WORD 62407,103170,31156,126220
.WORD 63251,64026,37412,53664
.WORD 64123,141033,147314,166641
.WORD 65004,54521,60500,12205
.WORD 65645,67645,134620,14646
.WORD 66516,145617,23764,20020
.WORD 67401,37471,74370,112012
.WORD 70241,107407,153466,134415
.WORD 71111,171311,146404,63520
.WORD 71774,67574,40105,100444
.WORD 72635,142655,124053,70267
.WORD 73505,33431,11066,46345
.WORD 74366,102337,53303,160036
.WORD 75232,11413,113072,66023
.WORD 76100,113716,75711,3430
.WORD 76760,136702,15273,44336
.WORD 77626,73231,50265,6613 ;10^38
.ENDC ;FPPSW
;OPCTB OP CODES
OPCTB:
;SINGLE OPERAND INSTRUCTIONS nnnnDD or nnnnSS
OPBLK SOPIN,SOPOUT,000077
DEFOP JMP,000100
DEFOP SWAB,000300
DEFOP CLR,005000
DEFOP COM,005100
DEFOP INC,005200
DEFOP DEC,005300
DEFOP NEG,005400
DEFOP ADC,005500
DEFOP SBC,005600
DEFOP TST,005700
DEFOP ROR,006000
DEFOP ROL,006100
DEFOP ASR,006200
DEFOP ASL,006300
.IFNZ MAPSW
DEFOP MFPI,006500
DEFOP MTPI,006600
.ENDC ;MAPSW
DEFOP SXT,006700
DEFOP CLRB,105000
DEFOP COMB,105100
DEFOP INCB,105200
DEFOP DECB,105300
DEFOP NEGB,105400
DEFOP ADCB,105500
DEFOP SBCB,105600
DEFOP TSTB,105700
DEFOP RORB,106000
DEFOP ROLB,106100
DEFOP ASRB,106200
DEFOP ASLB,106300
.IFNZ MAPSW
DEFOP MFPD,106500
DEFOP MTPD,106600
.ENDC ;MAPSW
;DOUBLE OPERAND INSTRUCTIONS nnSSDD
OPBLK DOPIN,DOPOUT,007777
DEFOP MOV,010000
DEFOP CMP,020000
DEFOP BIT,030000
DEFOP BIC,040000
DEFOP BIS,050000
DEFOP ADD,060000
DEFOP MOVB,110000
DEFOP CMPB,120000
DEFOP BITB,130000
DEFOP BICB,140000
DEFOP BISB,150000
DEFOP SUB,160000
;BRANCHES n nnn nnn nxx xxx xxx
OPBLK BRIN,BROUT,000377
DEFOP BR,000400
DEFOP BNE,001000
DEFOP BEQ,001400
DEFOP BGE,002000
DEFOP BLT,002400
DEFOP BGT,003000
DEFOP BLE,003400
DEFOP BPL,100000
DEFOP BMI,100400
DEFOP BHI,101000
DEFOP BLOS,101400
DEFOP BVC,102000
DEFOP BVS,102400
DEFOP BCC,103000
DEFOP BHIS,103000
DEFOP BCS,103400
DEFOP BLO,103400
;REGISTER - DESTINATION nnnrDD
OPBLK RDIN,RDOUT,000777
DEFOP JSR,004000
DEFOP XOR,074000
;REGISTER - SOURCE nnnrSS
OPBLK RSIN,RSOUT,000777
DEFOP MUL,070000
DEFOP DIV,071000
DEFOP ASH,072000
DEFOP ASHC,073000
;SOB 077rnn
OPBLK SOBIN,SOBOUT,000777
DEFOP SOB,077000
;MISCELLANEOUS - NO OPERAND
OPBLK MSCIN,INRET,000000
DEFOP HALT,0
DEFOP WAIT,1
DEFOP RTI,2
DEFOP BPT,3
DEFOP IOT,4
DEFOP RESET,5
DEFOP RTT,6
;MISCELLANEOUS - NO OPERAND n nnn nxx xxx xxx
OPBLK MS2IN,MS2OUT,000377
DEFOP EMT,104000
DEFOP TRAP,104400
;RTS 00020r
OPBLK RTSIN,RTSOUT,000007
DEFOP RTS,000200
;SPL 00023n
OPBLK SPLIN,SPLOUT,000007
DEFOP SPL,000230
;MARK 0064nn
OPBLK MRKIN,MRKOUT,000077
DEFOP MARK,006400
;CONDITION CODE 0002 1sn zvc
OPBLK CCIN,CCOUT,000017
DEFOP CL,000240
DEFOP SE,000260
.IFNZ FPPSW
;FLOATING POINT INSTRUCTIONS
;MISCELLANEOUS
OPBLK SOPEX,FMOUT,000000
DEFOP CFCC,170000
DEFOP SETF,170001
DEFOP SETI,170002
DEFOP SETD,170011
DEFOP SETL,170012
;ONE OPERAND nnnnSS or nnnnDD
OPBLK SOPIN,FSOOUT,000077
DEFOP LDFPS,170100
DEFOP STFPS,170200
DEFOP STST,170300
DEFOP CLRF,170400
DEFOP CLRD,170400
DEFOP TSTF,170500
DEFOP TSTD,170500
DEFOP ABSF,170600
DEFOP ABSD,170600
DEFOP NEGF,170700
DEFOP NEGD,170700
;FSRC - AC n nnn nnn naa SS
OPBLK FSAIN,FSAOUT,000377
DEFOP MULF,171000
DEFOP MULD,171000
DEFOP MODF,171400
DEFOP MODD,171400
DEFOP ADDF,172000
DEFOP ADDD,172000
DEFOP LDF,172400
DEFOP LDD,172400
DEFOP SUBF,173000
DEFOP SUBD,173000
DEFOP CMPF,173400
DEFOP CMPD,173400
DEFOP DIVF,174400
DEFOP DIVD,174400
DEFOP LDCFD,177400
DEFOP LDCDF,177400
;SRC - AC n nnn nnn naa SS
OPBLK FSAIN,SRAOUT,000377
DEFOP LDEXP,176400
DEFOP LDCIF,177000
DEFOP LDCID,177000
DEFOP LDCLF,177000
DEFOP LDCLD,177000
;AC - FDST n nnn nnn naa DD
OPBLK AFDIN,AFDOUT,000377
DEFOP STF,174000
DEFOP STD,174000
DEFOP STCFD,176000
DEFOP STCDF,176000
;AC - DST n nnn nnn naa DD
OPBLK AFDIN,ADSOUT,000377
DEFOP STEXP,175000
DEFOP STCFI,175400
DEFOP STCDI,175400
DEFOP STCFL,175400
DEFOP STCDL,175400
.ENDC ;FPPSW
0 ;NEW BLOCK
0 ;END OF LIST
;INITIAL SYMBOL TABLE
;INCLUDING %0-%7
.MACR TELL A
.PRINT /A
/
.ENDM
.IF P2
.PRINT /LAST ADDRESS = /
TELL \.
.ENDC
.IFNZ DEBSW
.=.+2000
USRBEG==.
.ENDC
.IFZ DEBSW
.=DDT-4
.ENDC
SADDR: 1 ;STARTING ADDRESS, INITIALLY ODD
SYMEND: LSTSY ;ADDRESS OF FIRST WORD OF LAST SYMBOL
.=SADDR
INISYM
SYMBEG:
LSTBEG==SYMBEG
.=.-4
DEFSYM .,,0,,HKILL
DOTVAL=.+4
DOTRGW=DOTVAL+4 ;WORD CONTAINING REGISTER BIT (LOW ORDER) FOR DOT
DEFSYM %0,,0,REG,HKILL
DEFSYM %1,,1,REG,HKILL
DEFSYM %2,,2,REG,HKILL
DEFSYM %3,,3,REG,HKILL
DEFSYM %4,,4,REG,HKILL
DEFSYM %5,,5,REG,HKILL
DEFSYM %6,,6,REG,HKILL
DEFSYM %7,,7,REG,HKILL
DEFSYM %PS,,177776,,HKILL
DEFSYM %DD,TS,DDTST,,HKILL
.IFNZ FPPSW,
DEFSYM %AC,0,FAC0,,
DEFSYM %AC,1,FAC0+10,,
DEFSYM %AC,2,FAC0+20,,
DEFSYM %AC,3,FAC0+30,,
DEFSYM %AC,4,FAC0+40,,
DEFSYM %AC,5,FAC0+50,,
DEFSYM %FP,S,UFPST,,HKILL
.ENDC ;FPPSW
.LIF NZ TT10SW
DEFSYM %TT,10,TT10FL,,HKILL
DEFSYM %MX,OFF,MXOFF,,HKILL
.LIF NZ MAPSW
DEFSYM %SP,ACE,DASPMD,,HKILL
ENDSYM
.IFZ DEBSW
.=DDTST
PR7
.ENDC ;DEBSW
.END DDT
Reference in New Issue View Git Blame Copy Permalink