Trailing-Edge
-
PDP-10 Archives
-
bb-bt99m-bb
-
ddt.p11
There are 4 other files named ddt.p11 in the archive. Click here to see a list.
; 16 OCT 79
;COPYRIGHT (C) 1978,1979,1980,1981,1984 BY DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
VRDDT=5
END$$=0
.IF NDF FT.DDT
FT.DDT=1
END$$=1
.ENDC
.IF NE FT.DDT
; THIS IS DDT: DYNAMIC DEBUGGING TECHNIQUE FOR A PDP-11.
; IT RESEMBLES DDT FOR A PDP-10 IN AS MANY WAYS AS POSSIBLE
; AND FALLS SHORT ONLY SLIGHTLY DUE TO THE VARIETY OF PDP-11
; CONFIGURATIONS AVAILABLE.
;
; AUTHOR: STEVEN M. RUBIN (SR12) AT CARNEGIE-MELLON UNIVERSITY
;MUNGED BY RIC WERME FOR INHOUSE DEBUGGING OF THE DN87S
;MUNGED SOME MORE BY RDH FOR SAME.
.=1000
.ENABL AMA,LC
; UN-COMMENT THE NEXT LINE IF DDT IS TO RUN ON AN LSI-11
;D.LSI = 1 ; DEFINED IF PROCESSOR IS AN LSI-11
; THE NEXT THREE DEFINES DESCRIBE THE MAIN OUTPUT DEVICE THAT
; DDT WILL USE. ONLY 1 MAY BE DEFINED AND THE REST MUST BE
; COMMENTED OUT.
;D.GDP = 1 ; TTY IS GRAPHICS DISPLAY PROCESSOR
D.KSR = 1 ; TTY IS KSR-33
;D.GT40 = 1 ; TTY IS DEC GT40
.IF DF,D.LSI
;.PRINT ; *****DDT for an LSI-11*****
.ENABLE NSF
.OPDEF MFPS,TST,106700
.OPDEF MTPS,TST,106400
.ENDC
D.OKTTY=-1
.IF DF,D.GDP
D.OKTTY=D.OKTTY+1
.TITLE D.GDP
;.PRINT ; *****DDT for a GDP*****
D.RDB = 165202 ; READER DATA BUFFER
D.RCSR = 165200 ; READER STATUS REGISTER
D.PRIO = 0 ; RUN AT PRIORITY ZERO
.ENDC
.IF DF,D.GT40
D.OKTTY=D.OKTTY+1
.TITLE D.GT40
;.PRINT ; *****DDT for a GT40*****
D.RCSR = 177560 ; READER STATUS REGISTER
D.RDB = 177562 ; READER DATA BUFFER
D.PRIO = 200 ; RUN AT PRIORITY FOUR
.ENDC
.IF DF,D.KSR
D.OKTTY=D.OKTTY+1
.TITLE D.KSR
.IF EQ <PASS-2>
;.PRINT ; *****DDT for a TTY*****
.ENDC
D.RCSR = 177560 ; READER STATUS REGISTER
D.RDB = 177562 ; READER DATA BUFFER
D.TCSR = 177564 ; PRINTER STATUS REGISTER
D.TDB = 177566 ; PRINTER DATA BUFFER
D.PRIO = 340 ; RUN AT PRIORITY SEVEN
.ENDC
.IIF NE,D.OKTTY,.ERROR ; INVALID OUTPUT DEVICE FOR DDT
D.BKP = 8. ; NUMBER OF BREAKPOINTS
D.SYML = 10. ; MAX NUMBER CHARS IN A SYMBOL
.IF NE END$$
R0 = %0
R1 = %1
R2 = %2
R3 = %3
R4 = %4
R5 = %5
SP = %6
PC = %7
PS = 177776 ; PROCESSOR STATUS
.ENDC
.IF NE,0
DDT/11 - Dynamic Debugging Technique on the PDP-11
Each command in DDT/11 is identical to the PDP-10 version whenever
possible. In some cases, DDT/10 commands have been omitted in the
interest of saving core and making good sense. The following is a
list of the DDT/11 commands:
n/ Open word n. Type contents in current mode
/ Open word pointed to by last typed value
n<CR> Modify currently open word to be n. Close word.
n<LF> Modify, close, open next word
n^ Modify, close, open previous word
n<TAB> Modify, close, open word pointed to by last typed address
n\ Modify, close, examine word n
\ Examine word pointed to by last typed value
$S Change current mode to instruction type out ($$S for permanence)
$A Addresses will be typed as absolute numbers ($$A for permanence)
$R Addresses will be typed relative to symbols ($$R for permanence)
$C Change current mode to numeric type out ($$C for permanence)
$nR Change current radix for $C to n (n read in decimal, $$nR for permanence)
$T Change current mode to ASCII text output ($$T for permanence)
$5T Change current mode to Radix-50 text output ($$5T for permanence)
$nO Change current mode to n bit byte typeout ($$nO for permanence)
$H Change to halfword (byte) mode ($$H for permanence; reset by $5T and $S)
n[ Open location n, type as a numeric
n] Open location n, type as instruction
n! Open location n, do not type value
; Retype currently open word
= Retype currently open word as number
n= Type value of n as a number
_ Retype currently open word as instruction
i$X Execute instruction i (don't execute branches)
n$G Start executing program at location n. Default is to
start executing at address in JOBSA (start of program)
v$nB Set breakpoint n at address v (n from 1 to 8 or can be omitted)
a,v$nB Same as above but open address a at breakpoint
If two altmodes are used, automatic proceding is enabled. The
breakpoint will cause the message to be typed and the program
resumed. If you type a character, the automatic proceding will stop.
0$nB Remove breakpoint n
$B Remove all breakpoints
$P Procede from breakpoint
n$P Procede from breakpoint n times (without halting)
If two altmodes are used, the breakpoint will be proceded from automatically
n$UW Set offset limit to n (used when typing addresses)
$1UT Turn on single stepping (break at each instruction)
a$1UT Turn on single stepping and open location a at each break
If two altmodes are used, the single stepping will be done automatically
$UT Turn off single stepping
a: Make current location have symbolic name a
v<a: Make symbolic name a have value v
a$$K Delete symbolic name a
a$K Delete symbolic name a from typeout only
$D Perform an $K on the last symbol coloned (:)
l<u$$Z Zero memory from l to u
n$M Set mask for searches (below) to n
l<u>s$W Search core from l to u for word s.
l<u>s$E Search core from l to u for effective address s.
l<u>s$N Search core from l to u for word not equal to s.
<CALL> Soft restart at address 1004 (Graphics DDT only)
Note that numbers can be as any combination of the following:
<Octal number>
<Decimal number> .
<Program symbol>
" <Delimeter> <Two ASCII Characters> <Delimeter>
"$ <Delimeter> <Three Radix-50 Characters> <Delimeter>
<Instruction>
The operators + (addition), - (subtraction), * (multiplication), and
' (division) are evaluated from left to right unless parenthesis are
included. The space is treated like a plus except after instructions
when it is merely a separator. All input is accepted in lower or
upper case and is folded (except for text.)
If you are not in DDT, you can re-enter with a Meta-BREAK on a
graphics or a restart at DDT (location typed out initially). In
addition to program symbols, the following are also defined for you:
R0-R5 are the user registers. R1/ would open register 1.
SP is the user's stack pointer
PC is the user's program counter
$I is the user status
$2I is the status of DDT
$M is the mask for searches
$Q is the value at the current address
$V is the value at the current address with the bytes switched
$nB is the address of breakpoint n
JOBSA is the starting address of your program.
. represents the current location. Thus .$1B puts
breakpoint 1 at the currently opened location.
When your program is executing, the following unexpected traps may
occur:
NXM! is caused when your program requests a non-existant memory or
does a word operation on an odd address.
ILG! is caused by an illegal instruction.
BPT! is caused by an entry to DDT that is unexpected (i.e.
executing the BPT instruction or setting the T-bit).
To get DDT, link your program with SYS:LINK11 and use the /D switch.
In order for DDT to know all of your program symbols, compile your
program with MACN11 and use the .ENABLE ISD switch to generate an
internal symbol dictionary.
.ENDC
; MAIN LOOP OF DDT
DDT: BR D.DDT3 ; HARD ENTRY ADDRESS TO DDT
.IIF NDF,D.LSI,MOV @#PS,D.USTA ; GET USER'S STATUS
.IIF DF,D.LSI,MFPS D.USTA ; GET USER'S STATUS
MOV (SP)+,D.UR7 ; SOFT ENTRY ASSUMES STACK HAS RETURN ADDRESS
JSR PC,D.SAVE ; SAVE REGISTERS
BR D.DDT2 ; FINISH INITIALIZATION
D.DDT3:
.IIF NDF,D.LSI,MOV @#PS,D.USTA ; SAVE USER'S STATUS
.IF DF,D.LSI
HALT ; HALT TO ALLOW TYPEOUT
MFPS D.USTA ; GET USER'S STATUS
.ENDC
CMP SP,#400 ;IS STACK REASONABLE?
BHI 10$ ;YES, SEE IF ITS ADDRESSABLE
MOV #D.STK,SP ;NOPE, USE OURS THEN
10$: MOV #D.NOSP,@#4 ; SET FOR INVALID STACK INTERRUPT
MOV #340,@#6 ; SET HIGH STATUS
MOV #D.ILGT,@#10 ; SET FOR ILLEGAL INSTRUCTIONS
MOV #340,@#12 ; SET HIGH STATUS
MOV SP,D.XXX ; SAVE HIS STACK
MOV #D.STK,SP ; USE OURS TEMPORARILY
TST @D.XXX ; DOES HIS STACK EXIST?
MOV D.XXX,SP ; GIVE HIM BACK HIS STACK
D.FIX: MOV #D.NXMT,@#4 ; RESTORE FOR EXTERNAL NXMS
MOV JOBSA,D.UR7 ; ASSUME HE CAME FROM STARTING ADDRESS
JSR PC,D.SAVE ; SAVE REGISTERS
.IF DF,D.GDP
MOV #DDT+2,R0 ; ADDRESS OF RESTART FOR MONITOR
TRAP 133 ; DDTCAL
.ENDC
CLRB D.NOTY ; ALLOW TYPEOUT
JSR PC,D.CRLF ; START OUT AT LEFT MARGIN
MOV #D.GRET,R4 ; TELL YOU ARE HERE
MOV #D.GRND,R3 ; END OF MESSAGE
JSR PC,D.STYP ; TYPE MESSAGE
; .IF NDF,D.GDP
; MOV #DDT,R0 ; ADDRESS OF RESTART
; JSR PC,D.TYPN ; TYPE RESTART ADDRESS
; .ENDC
D.DDT2: JSR PC,D.CRLF ; TYPE CARRIAGE RETURN-LINE FEED
CLR D.SD.T ; NOT IN SINGLE STEP OR TRACE
MOVB #-1,D.P ; DISALLOW PROCEDE
BR D.DCD0 ; GET INTO MAIN LOOP
D.ERR: MOV #' ,R0 ; TYPE A SPACE
JSR PC,D.TYPE
MOV #'?,R0 ; ? TO BE TYPED
D.ERRO: JSR PC,D.TYPE ; TYPE CHARACTER
D.DCD: JSR PC,D.TTAB ; TYPE TAB
D.DCD0: CLR D.COMA ; NO , PARAMETER. RETURN FROM <CR>HCTSAR>
CLRB D.FWAF ; NO < PARAMETER
.IIF NDF,D.LSI,MOV D.DSTA,@#PS ; SET DDT STATUS
.IIF DF,D.LSI,MTPS D.DSTA ; SET DDT STATUS
MOV #NOP,D.PARS ; FILL $X AREA WITH NOPS
MOV #NOP,D.PARS+2 ; IN CASE OF SHORT INSTRUCTIONS
CLR D.PARO ; NO OFFSET
CLR D.PARO+2 ; NO OFFSET
D.DCD2: CLR D.SVR2 ; RETURN FROM ,<
CLR D.SVR4 ; D.SVR4 IS A SAVE REGISTER FOR R4
CLR D.OFST ; TALLY
CLR R2 ; NUMBER TYPED FLAG
D.DCD3: CLRB D.ALTF ; RETURN FROM B"MVQI
D.DCD1: CLRB D.LEVL ; RETURN FROM $
CLRB D.INPA ; NOT IN INSTRUCTION TYPE-IN
MOV D.CAD,D.CADC ; KEEP A CURRENT COPY FOR INST TYPE-IN
MOV #D.STK,SP ; RESET STACK POINTER
JSR PC,D.EXPR ; GET EXPRESSION (R2,R4,R1)
TST R2 ; NEED OPERANDS FOR INSTRUCTION?
BPL D.DCD4 ; BRANCH IF NOT
JSR PC,D.GETI ; GET OPERANDS
D.DCD4: TST R2 ; ANY VALUE TYPED?
BEQ D.DCD5 ; BRANCH IF NOT
MOV R4,D.LASV ; STORE LAST TYPED VALUE
MOV R4,D.LASW ; STORE LAST TYPED WORD TOO
D.DCD5: ASL R1 ; MULTIPLY BY TWO
JSR PC,@D.LGDR(R1) ; GO TO PROPER ROUTINE
BR D.DCD ; GET NEXT COMMAND
D.NOSP: MOV #D.STK,SP ; SET OWN STACK PERMANENTLY FOR USER
BR D.FIX ; RETURN
; ROUTINE TO GET A PRIMARY INTO R1 (COMMAND DECODER)
D.PRIM: ; PRIMARY READING SUBROUTINE
CLR R4 ; R4 CONTAINS THE CONVERTED OCTAL
CLR D.DECN ; CLEAR DECIMAL NUMBER
CLRB D.USED ; CLEAR USE-DECIMAL NUMBER INDICATOR
JSR PC,D.CLSM ; CLEAR SYMBOL
D.PRI1: JSR PC,D.GET ; GET A CHAR, RETURN IN R0
CMP #'0,R0 ; COMPARE WITH ASCII 0
BHI D.PRI3 ; CHECK LEGALITY IF NON-NUMERIC
CMP #'9,R0 ; COMPARE WITH ASCII 9
BLO D.PRI3 ; CHECK LEGALITY IF NOT OCTAL
CMP D.POS,#D.SYM ; IN THE MIDDLE OF A SYMBOL?
BNE D.PRI6 ; YES, PUT DIGIT IN SYMBOL
SUB #'0,R0 ; CONVERT TO BCD
ASL R4 ; MAKE ROOM
ASL R4 ; IN
ASL R4 ; R4
ADD R0,R4 ; PACK THREE BITS IN R4
MOV D.DECN,R1 ; GET DECIMAL NUMBER
ASL R1 ; MULTIPLY BY 2
ADD R1,R0 ; ADD 2X
ASL R1 ; MULTIPLY BY 4
ASL R1 ; MULTIPLY BY 8
ADD R0,R1 ; ADD IN NEW DIGIT
MOV R1,D.DECN ; STORE IN DECIMAL NUMBER
INC R2 ; R2 HAS NUMERIC FLAG
BR D.PRI1 ; AND TRY AGAIN
D.PRI2: MOV #'U,R0 ; UNDEFINED MESSAGE
BR D.ERRO ; ERROR OUTPUT
D.PRI3: CMPB R0,#'. ; DOT FOUND?
BEQ D.PRI7 ; BRANCH IF SO
CLR R1 ; BASE OF CHARACTER TABLE
D.PRI4: CMPB D.LGCH(R1),R0 ; MATCH?
BEQ D.PRI5 ; YES
INC R1 ; NEXT CHARACTER
CMP R1,#D.CLGT ; ANY MORE?
BLT D.PRI4 ; LOOP IF SO
D.PRI6: TST R4 ; NUMBER ALREADY?
BNE D.ERR ; ERROR TO START SYMBOL
JSR PC,D.PTSM ; PUT SYMBOL IN D.SYM
BR D.PRI1 ; DECODE MORE CHARACTERS
D.PRI7: TST R2 ; NUMBER BEING TYPED?
BEQ D.PRI6 ; BRANCH IF NOT
INCB D.USED ; IT IS, MAKE IT DECIMAL
BR D.PRI1 ; CONTINUE SCANNING
D.PRI5: TSTB D.ALTF ; ALTMODE FOUND?
BNE D.PRI8 ; YES, DO IT
CMP R1,#D.LETR ; IS IT A LETTER?
BGE D.PRI6 ; YES
D.PRI8: CMPB #' ,D.SYM ; ANY SYMBOL?
BEQ D.PRIB ; NO, RETURN
CMP #". ,D.SYM ; IS SYMBOL A DOT?
BNE D.PRI9 ; BRANCH IF NOT
MOV D.DOT,R4 ; USE VALUE OF D.DOT
INC R2 ; NOTE THAT IT IS A NUMBER
BR D.PRIB ; DO THE REST
D.PRI9: MOV #D.SYM,R0 ; ADDRESS OF SYMBOL
JSR PC,D.GTAD ; GET ADDRESS
CMP R1,#D.COLO ; COLON?
BEQ D.PRIC ; RETURN IF SO
TST R0 ; CHECK SYMBOL ADDRESS
BEQ D.PRID ; BRANCH IF NOT AN ADDRESS
MOV (R0),R4 ; GET SYMBOL VALUE
D.PRIA: INC R2 ; MARK R2 AS A NUMBER
D.PRIB: TSTB D.USED ; USE DECIMAL NUMBER?
BEQ D.PRIC ; BRANCH IF NOT
MOV D.DECN,R4 ; USE DECIMAL NUMBER
D.PRIC: RTS PC ; RETURN
D.PRID: MOV #D.COUS,R0 ; ADDRESS OF OFFSET TABLE
D.PRIE: CMP R0,#D.ECNT ; END OF LIST?
BHIS D.PRI2 ; YES, LOSE
MOV #D.SYM,R5 ; SCAN THE SYMBOL
MOV (R0)+,R3 ; GET OFFSET OF CHARACTERS
BIC #177400,R3 ; TURN OFF EXTRA CRUFT
CMPB R3,(R0) ; NULL STRING?
BEQ D.PRIE ; YES, IGNORE IT
D.PRIF: CMPB D.STRS(R3),(R5)+; IS IT A CHARACTER MATCH?
BNE D.PRIE ; BRANCH IF NOT
INC R3 ; NEXT CHARACTER
CMPB R3,(R0) ; END OF STRING?
BNE D.PRIF ; BRANCH IF NOT
MOV D.TOPS-D.COUS-2(R0),R4 ;GET THE INSTRUCTION-1
MOVB -1(R0),R3 ; GET LEGALITY BYTE
CMPB R3,#10 ; IS IT A CONDITION CODE SET/CLEAR?
BEQ D.PRIK ; MAY BE
INC R4 ; FIX INSTRUCTION
D.PRIG: CMPB #' ,(R5) ; BLANK AT END OF SYMBOL?
BNE D.PRII ; NO, HOW ABOUT "B"?
BIC #177774,R3 ; STRIP TO MACHINE TYPE
CMPB R3,D.MACH ; VALID ON THIS MACHINE?
BGT D.PRI2 ; UNDEFINED SYMBOL
D.PRIH: MOVB -(R0),R3 ; RE-FETCH LEGALITY BYTE
CMP R1,#D.SPAC ; IS INSTRUCTION TERMINATED WITH SPACE?
BNE D.PRIA ; DON'T GET OPERANDS IF NOT
MOV #-2,R2 ; MARK INSTRUCTION
BR D.PRIA ; ALL DONE
D.PRII: CMPB #'B,(R5)+ ; BYTE INSTRUCTION MUST TERMINATE WITH "B"
BNE D.PRIE ; NOT AN INSTRUCTION
TSTB R3 ; TEST LEGALITY BYTE
BPL D.PRIE ; NO
ADD #100000,R4 ; ADD IN BYTE OFFSET
BCC D.PRIG ; AND CONTINUE, UNLESS THAT WAS A SECOND "B"
BR D.PRIE ; IN WHICH CASE WE LOSE
D.PRIJ: BITB (SP),R4 ; BIT ALREADY ON?
BNE D.PRIN ; YES, LOSE
BISB (SP),R4 ; SET IT
CMPB (SP)+,(R5)+ ; BUMP SP BY 2, R5 BY 1
CMPB #' ,(R5) ; SPACE YET?
BEQ D.PRIH ; YES, ALL DONE.
D.PRIK: MOVB #10,-(SP) ; SET UP MAGIC BIT
MOV #D.NZVC+4,R3 ; CHARACTER POINTER
D.PRIL: CMPB (R5),-(R3) ; MATCH?
BEQ D.PRIJ ; BRANCH IF SO
ASRB (SP) ; MOVE BIT
BNE D.PRIL ; AND LOOP
D.PRIN: TSTB (SP)+
BR D.PRIE ; ELSE NOT THE RIGHT INSTRUCTION
; ROUTINES TO HANDLE THE SYMBOL TABLE
D.GTAD: MOV R0,-(SP) ; SAVE CHARACTER ADDRESS
JSR PC,D.RD50 ; CONVERT FIRST 3 TO RAD50
MOV R0,D.RAD1 ; SAVE VALUE
MOV (SP)+,R0 ; GET CHARACTER ADDRESS
ADD #3,R0 ; POINT TO LAST 3 CHARACTERS
JSR PC,D.RD50 ; CONVERT TO RAD50
MOV R0,D.RAD2 ; STORE IT AWAY
D.GTAC: MOV #D.SYMA-2,R0 ; ADDRESS OF SYMBOL TABLE
D.GTA2: TST (R0)+ ; BUMP R0 BY 2
CMP (R0)+,(R0) ; BUMP R0 BY 2 MORE, CHECK IF END OF TABLE
BNE D.GTA6
TST (R0) ; WERE BOTH SYMBOL HALVES 0?
BNE D.GTA6 ; NO, KEEP LOOKING
CLR R0 ; NOT FOUND...MARK RETURN REGISTER
RTS PC ; RETURN
D.GTA6: CMP D.RAD2,(R0)+ ; DO SECOND THREE CHARACTERS MATCH?
BNE D.GTA2 ; NO, GO TO NEXT SYMBOL
CMP -4(R0),D.RAD1 ; YES, HOW ABOUT THE FIRST THREE?
BNE D.GTA2 ; NO, GO TO NEXT SYMBOL
RTS PC ; RETURN
D.GTSM: CLR -(SP) ; SPACE FOR TEMPORARIES
MOV D.FENC,R2 ; FIND CLOSEST SYMBOL <= R0
MOV D.RFNL,R1 ; WHICH IS ALSO >= R0-D.RFNL
D.GTS1: CMP (R2)+,(R2)+ ; SKIP OVER THE NAME
BEQ D.GTS3
D.GTS2: MOV R0,R3 ; SET A TEMPORARY
SUB (R2)+,R3 ; OBTAIN DIFERENCE
BLO D.GTS1 ; IF SYMBOL HIGHER THAN R0, NO GO
SUB R1,R3 ; ARE WE CLOSER THAN BEFORE?
BHI D.GTS1 ; NO, FURTHER
MOV R2,(SP) ; SAVE POINTER TO SYMBOL
ADD R3,R1 ; SAVE DIFFERENCE
BR D.GTS1 ; AND LOOK FOR ONE CLOSER
D.GTS3: TST -2(R2) ; AT END OF TABLE?
BNE D.GTS2 ; NO, KEEP GOING
MOV (SP)+,R1 ; GET SYMBOL PTR
BEQ D.GTS4 ; BRANCH IF NOT FOUND.
CMP -(R1),#400 ; IGNORE SMALL SYMBOLS
BLO D.GTS4
SUB (R1),R0 ; RECOMPUTE DIFFERENCE
MOV R0,-(SP) ; SAVE DIFFERENCE
MOV -(R1),-(SP) ; GET LAST THREE CHARACTERS
MOV -(R1),R0 ; GET FIRST THREE
MOV #D.SYM,R1 ; ADDRESS TO PUT CHARACTERS
JSR PC,D.CHAR ; CONVERT TO ASCII
MOV (SP)+,R0 ; GET FIRST RAD50 WORD
JSR PC,D.CHAR ; CONVERT TO ASCII
MOV (SP)+,R0 ; RESTORE DIFFERENCE
MOV #D.SYM,R1 ; POINT TO CHARACTERS
RTS PC ; RETURN
D.GTS4: CLR R1 ; NOT FOUND...MARK IT SO
RTS PC ; RETURN
; ROUTINE TO GET AN EXPRESSION (VALUE IN R4, FLAG IN R2, TERMINATOR IN R1)
D.CEXP: INCB D.INPA ; NOT IN INSTRUCTION
CLR D.OFST ; START OUT FRESH
D.EXPR: MOV #D.ADD,D.OPER ; INITIAL FUNCTION
D.EXP7: JSR PC,D.PRIM ; GET PRIMARY EXPRESSION
TST R2 ; INSTRUCTION?
BMI D.EXP1 ; EXIT IF SO
CMP R1,#D.OPAR ; OPEN PARENTHESIS OR OPERATOR?
BLT D.EXP1 ; BRANCH IF NEITHER
BEQ D.EXP2 ; BRANCH IF OPEN PARENTHESIS
CMP R1,#D.CPAR ; CLOSE PARENTHESIS OR OPERATOR?
BLT D.EXP3 ; BRANCH IF OPERATOR
BEQ D.EXP4 ; BRANCH IF CLOSE PARENTHESIS
D.EXP1: TSTB D.LEVL ; TERMINATOR FOUND...AT UPPER LEVEL?
BEQ D.EXP5 ; BRANCH IF SO
BR D.ERRD ; ERROR
D.EXP2: TSTB D.INPA ; IN AN INSTRUCTION TYPE-IN?
BNE D.EXP5 ; BRANCH IF SO (INSTRUCTION FORMAT)
INCB D.LEVL ; GO DOWN TO NEXT PARENTHESIS LEVEL
MOV D.OFST,-(SP) ; SAVE TALLY
MOV D.OPER,-(SP) ; SAVE OPERATION
CLR D.OFST ; CLEAR TALLY
JSR PC,D.EXPR ; RECURSION!
MOV (SP)+,D.OPER ; RESTORE OPERATION
MOV (SP)+,D.OFST ; RESTORE TALLY
JSR PC,@D.OPER ; COMBINE THEM
BR D.EXPR ; LOOP
D.EXP4: DECB D.LEVL ; UP TO HIGHER PARENTHESIS LEVEL
BMI D.ERRD ; ERROR IF NONE HIGHER
D.EXP5: JSR PC,@D.OPER ; DO OPERATION
MOV D.OFST,R4 ; GET TALLY AS RETURN PARAMETER
RTS PC ; RETURN (POSSIBLY TO SELF)
D.EXP3: JSR PC,@D.OPER ; DO OPERATION
ASL R1 ; AND GET
MOV D.LGDR(R1),D.OPER ; THE NEXT
BR D.EXP7 ; LOOP
; ROUTINE TO HANDLE PARAMETERS FOR INSTRUCTION TYPE-IN
D.GETI: ASR R3 ; PARAMETER CODE
BIC #177741,R3 ; MASK OUT OTHER BITS
MOV R4,-(SP) ; SAVE OPERATION MASK
JSR PC,@D.PARG(R3) ; GET PARAMETERS
BIS (SP)+,R4 ; PUT OPERATION MASK INTO OPERANDS
MOV #1,R2 ; MARK A GOOD NUMBER
RTS PC ; RETURN
D.GR: JSR PC,D.PRIM ; GET PRIMARY
D.REDR: SUB #D.UR0,R4 ; GET REGISTER ADDRESS
ASR R4 ; MAKE INTEGER FROM ADDRESS
BIT #177770,R4 ; ANY HIGH BITS ON?
BNE D.ERRD ; ERROR IF NOT A REGISTER
D.NONE: RTS PC ; RETURN
D.GGET: MOV R0,-(SP) ; SAVE WHAT MUST BE READ
D.GGE2: JSR PC,D.GET ; GET LETTER
CMP R0,(SP) ; EQUAL?
BEQ D.GGE1 ; YES, RETURN
D.ERRD: JMP D.ERR ; ERROR
D.GGE1: TST (SP)+ ; FIX STACK
RTS PC ; RETURN
D.PSAV: MOV (SP),-(SP) ; PUSH RETURN ADDRESS DOWN
SWAB R4 ; MOVE
ASR R4 ; TO
ASR R4 ; HIGH POSITION
MOV R4,2(SP) ; PUT PARAMETERS IN
CMP R1,#D.COMM ; COMMA IN-BETWEEN?
BNE D.ERRD ; ERROR IF NOT
RTS PC ; RETURN
D.DISP: JSR PC,D.CEXP ; GET EXPRESSION
SUB D.DOT,R4 ; COMPUTE OFFSET
ASR R4 ; SHIFT
DEC R4 ; POINTS TO PROPER WORD
BIC #177400,R4 ; CLEAR HIGH BITS
RTS PC ; RETURN
D.GRNN: JSR PC,D.GR ; GET REGISTER
JSR PC,D.PSAV ; SAVE PARAMETERS
JSR PC,D.DISP ; GET ADDRESS
MOVB R4,R4 ;MAKE IT A FULLWORD
NEG R4 ;NEGATE IT
BIT #^C77,R4 ;POSITIVE & 6 BITS?
BNE D.ERRD ;BR IF OUT OF RANGE
D.GGE3: BIS (SP)+,R4 ; ADD IN REGISTER
RTS PC ; RETURN
D.GSD: JSR PC,D.GDD ; GET 6-BIT OPERAND
D.GGE4: JSR PC,D.PSAV ; SAVE PARAMETER
JSR PC,D.GDD ; GET OTHER PARAMETER
BR D.GGE3 ; DO THE REST
D.GRSS: JSR PC,D.GR ; GET REGISTER
BR D.GGE4 ; DO THE REST
D.GDDR: JSR PC,D.GDD ; GET 6-BIT-OPERAND
MOV R4,-(SP) ; SAVE OPERAND
JSR PC,D.GR ; GET REGISTER
SWAB R4 ; SHIFT
ASR R4 ; INTO
ASR R4 ; HIGH PLACE
BR D.GGE3 ; DO THE REST
D.NEXP: MOV D.CADC,R0 ; GET CAD COPY
TST (R0)+ ; BUMP TO NEXT
MOV R0,D.CADC ; RESTORE NEW VALUE
TST (R0)+ ; INCREMENT AGAIN
RTS PC ; RETURN
D.GDD: CLR R2 ; NO PARAMETERS YET
JSR PC,D.CEXP ; GET EXPRESSION
CMP R1,#D.OPAR ; OPEN PARENTHESIS?
BEQ D.G02 ; BRANCH IF SO
CMP R1,#D.HASH ; HASH MARK?
BEQ D.G05 ; BRANCH IF SO
BLO D.G03 ; BRANCH IF AT-SIGN
CMP R4,#D.UR0 ; REGISTER?
BLO D.NOTR ; BRANCH IF NOT
CMP R4,#D.UR7 ; REGISTER?
BHI D.NOTR ; BRANCH IF NOT
SUB #D.UR0,R4 ; NORMALIZE
ASR R4
RTS PC ; RETURN
D.NOTR: JSR PC,D.NEXP ; POINT TO NEXT PARAMETER
MOV R0,-(SP) ; SAVE RELOCATION
SUB D.CAD,R0 ; GET PARAMETER OFFSET
MOV (SP)+,D.PARO-4(R0) ; PUT IN OFFSET
MOV R4,D.PARS-4(R0) ; PUT VALUE IN
MOV #67,R4 ; RELATIVE PC ADDRESSING
RTS PC ; DONE
D.G05: JSR PC,D.CEXP ; GET EXPRESSION
D.G014: JSR PC,D.NEXP ; NEXT PARAMETER
SUB D.CAD,R0 ; GET PARAMETER OFFSET
CLR D.PARO-4(R0) ; NO RELOCATION
MOV R4,D.PARS-4(R0) ; PUT VALUE IN
MOV #27,R4 ; IMMEDIATE ADDRESSING
RTS PC ; RETURN
D.G02: TST R2 ; "(" FOUND, ANY OFFSET?
BNE D.G013 ; BRANCH IF SO (INDEX ADDRESSING)
CMP D.OPER,#D.SUBT ; "-(R)" ?
BNE D.G016 ; BRANCH IF NOT
JSR PC,D.GR ; GET REGISTER
ADD #40,R4 ; ADD IN AUTO-DECR OFFSET
BR D.G09 ; SKIP TO COMMAND AND RETURN
D.G016: JSR PC,D.GR ; GET REGISTER..."(R)" OR "(R)+"
JSR PC,D.G09 ; SKIP TO NEXT PARAMETER
CMP R1,#D.ADDS ; PLUS SIGN?
BNE D.G012 ; BRANCH IF NOT
ADD #20,R4 ; ADD IN AUTO-INCR OFFSET
BR D.G09 ; SKIP TO COMMAND AND RETURN
D.G013: JSR PC,D.G014 ; PUT PARAMETER IN
JSR PC,D.GR ; GET REGISTER
ADD #60,R4 ; ADD IN INDEX OFFSET
BR D.G09 ; SKIP TO COMMAND AND RETURN
D.G03: CLR R2 ; "@" FOUND, MARK NO NUMBER FOUND YET
JSR PC,D.CEXP ; AN "@" WAS FOUND, LOOK TO NEXT
CMP R1,#D.HASH ; "@#" MEANS ABSOLUTE ADDRESSING
BEQ D.G06 ; BRANCH IF SO
CMP R1,#D.OPAR ; COULD BE "@(" OR "@X("
BEQ D.G07 ; BRANCH IF EITHER
CMP R4,#D.UR0 ; IS IT @R?
BLO D.G08 ; BRANCH IF NOT
CMP R4,#D.UR7 ; TEST UPPER RANGE
BHI D.G08 ; BRANCH IF NOT
JSR PC,D.REDR ; REDUCE TO REGISTER NUMBER
D.G012: ADD #10,R4 ; ADD IN REG-DEFERRED OFFSET
RTS PC ; THATS ALL...RETURN
D.G08: JSR PC,D.NOTR ; PERFORM NORMAL RELOCATION
MOV #77,R4 ; MARK RELATIVE DEFERRED ADDRESSING
RTS PC ; RETURN
D.G07: TST R2 ; ANY NUMBER THERE?
BEQ D.G010 ; BRANCH IF "@("
JSR PC,D.G014 ; GET OFFSET INTO PARAMETER
JSR PC,D.GR ; NOW GET REGISTER
ADD #70,R4 ; ADD IN INDEX DEFERRED OFFSET
D.G09: MOV R4,-(SP) ; SAVE VALUE
JSR PC,D.PRIM ; SKIP TO NEXT COMMAND
MOV (SP)+,R4 ; RESTORE VALUE
RTS PC ; RETURN
D.G010: CMP D.OPER,#D.SUBT ; "@-(" ?
BNE D.G015 ; BRANCH IF NOT
JSR PC,D.GR ; GET REGISTER
ADD #50,R4 ; ADD IN AUTO-DECR DEFERRED OFFSET
BR D.G09 ; SKIP TO COMMAND AND RETURN
D.G015: JSR PC,D.GR ; GET REGISTER
MOV #'+,R0 ; FORM IS "@(R)+"
JSR PC,D.GGET ; GET THE PLUS
ADD #30,R4 ; ADD IN AUTO-INCR DEFERRED OFFSET
BR D.G09 ; SKIP TO COMMAND AND RETURN
D.G06: JSR PC,D.G05 ; GET ABSOLUTE ADDRESS
MOV #37,R4 ; MARK ABSOLUTE MODE
RTS PC ; DONE
D.GNUM: JMP D.PRIM ; GET NUMBER AND RETURN
; SYMBOL MANIPULATION SUBROUTINES
D.PTSM: MOV D.POS,R1 ; GET POSITION ADDRESS
CMP R1,#D.SYM+D.SYML; NO MORE ROOM?
BHIS D.PTS1 ; EXIT IF SO
MOVB R0,(R1)+ ; PUT CHARACTER IN
MOV R1,D.POS ; RESTORE POINTER
D.PTS1: RTS PC ; RETURN
D.CLSM: MOV #D.SYM+D.SYML,R0
D.CLS3: MOVB #' ,-(R0)
CMP R0,#D.SYM
BHI D.CLS3
MOV R0,D.POS
RTS PC ; RETURN
; ADDITION, SUBTRACTION, MULTIPLICATION, DIVISION FOR DECODER
D.ADD: ADD R4,D.OFST ; ADD OPERANDS
RTS PC ; RETURN
D.SUBT: SUB R4,D.OFST ; SUBTRACT OPERANDS
RTS PC ; RETURN
D.MULT: CLR R0 ; MULTIPLY THEM
MOV #16.,-(SP) ; LOOPER
D.MUL1: ASR R4 ; GET BOTTOM BIT
BCC D.MUL2 ; SKIP IF OFF
ADD D.OFST,R0 ; ADD IN OPERAND
D.MUL2: ASL D.OFST ; SHIFT OPERAND
DEC (SP) ; MORE TO LOOP?
BGT D.MUL1 ; LOOP IF SO
MOV R0,D.OFST ; RESULT IN D.OFST
TST (SP)+ ; FIX STACK
RTS PC ; RETURN
D.DIV: MOV R1,-(SP) ; SAVE R1
MOV D.OFST,R0 ; GET OPERAND
MOV R4,R2 ; GET OTHER OPERAND
JSR PC,D.DIVD ; DIVIDE THEM
MOV R0,D.OFST ; GET RESULT
MOV (SP)+,R1 ; RESTORE R1
RTS PC ; RETURN
; MANIPULATION OF THE SYMBOL TABLE
D.SWAP: MOV #3,R2 ; COUNTER
D.SWA1: MOV -(R1),-(SP) ; GET WORD
MOV (R0),(R1) ; PUT OTHER WORD IN
MOV (SP)+,(R0) ; AND FINISH SWAP
TST -(R0) ; MOVE WORD
DEC R2 ; LOOPER
BGT D.SWA1 ; LOOP IF MORE
RTS PC ; RETURN
; PROCESS : - DEFINE SYMBOL
D.COLN: CMPB D.SYM,#' ; NULL SYMBOL?
BEQ D.ERRB ; ERROR IF SO
MOV D.DOT,R4 ; ASSUME DOT ADDRESS
TSTB D.FWAF ; REAL VALUE GIVEN?
BEQ D.COL1 ; BRANCH IF NOT
MOV D.FWA,R4 ; GET REAL VALUE
D.COL1: TST R0 ; IN SYMBOL TABLE?
BNE D.COL2 ; BRANCH IF SO
MOV D.RAD1,-(SP) ; SAVE RAD50 OF NAME
MOV D.RAD2,-(SP) ; BOTH HALVES
MOV #-1,D.RAD1 ; ASSUME NULL RAD50 LABEL
MOV #-1,D.RAD2 ; IN BOTH HALVES
JSR PC,D.GTAC ; LOOK IT UP
TST R0 ; FOUND?
BEQ D.ERRB ; ERROR IF NOT
MOV (SP)+,-(R0) ; FILL LABEL IN
MOV (SP)+,-(R0) ; BY SETTING BOTH WORDS
CMP (R0)+,(R0)+ ; NOW FIX POSITION
D.COL2: MOV R4,(R0) ; AND SET VALUE
MOV R0,D.LASC ; SET LAST COLONED WORD
MOV D.FENC,R1 ; GET FENCE
CMP R0,R1 ; BEHIND FENCE?
BHI D.COL5 ; DONE IF NOT
JSR PC,D.SWAP ; SWAP SYMBOLS
MOV R1,D.FENC ; STORE IN FENCE
D.COL5: RTS PC ; RETURN
D.ERRB: JMP D.ERR ; ERROR
; PROCESS D - DELETE LAST COLONED SYMBOL
D.DELE: MOV D.LASC,R0 ; GET LAST COLONED SYMBOL
BEQ D.ERRB ; ERROR IF NONE
CLR D.LASC ; LAST TIME TO COLON IT
BR D.KIL3 ; NOW KILL IT
; PROCESS K - KILL SYMBOL
D.KILL: JSR PC,D.GTAC ; GET ADDRESS OF SYMBOL
TST R0 ; ANY SYMBOL?
BEQ D.ERRB ; ERROR IF NOT
CMPB D.ALTF,#1 ; HOW MANY ALTMODES?
BGT D.KIL1 ; BRANCH IF 2
D.KIL3: MOV D.FENC,R1 ; GET FENCE
CMP R0,R1 ; SYMBOL BEHIND FENCE?
BLO D.KIL4 ; BRANCH IF ALREADY KILLED
ADD #6,R1 ; PUSH UP FENCE
MOV R1,D.FENC ; AND STORE IT
JMP D.SWAP ; SWAP SYMBOLS AND RETURN
D.KIL1: CLR (R0) ; CLEAR ADDRESS
MOV #-1,-(R0) ; PUT IN NULL SYMBOL
MOV #-1,-(R0) ; IN BOTH WORDS
D.KIL4: RTS PC ; RETURN
; PROCESS ALTMODE
D.ALTM: TSTB D.ALTF ; ALREADY AN ALTMODE TYPED?
BNE D.ALT1 ; BRANCH IF SO
MOV R2,D.SVR2 ; AN ALTMODE HAS BEEN RECEIVED
MOV R4,D.SVR4 ; NUMERIC FLAG TO D.SVR2, CONTENTS TO D.SVR4
D.ALT1: CLR R2 ; NO ARGS TYPED YET
CLR D.OFST ; CLEAR OFFSET
INCB D.ALTF ; COUNT NUMBER OF ALTMODES
JMP D.DCD1 ; RETURN
; PROCESS / - OPEN WORD
D.WRD: MOV D.CURM,D.OMOD ; TEMP COPY OF ROUTINE ADDRESS
D.WRD1: TST R2 ; NUMBER THERE?
BNE D.WRD3 ; BRANCH IF SO
D.WRD4: MOV D.LASV,D.CAD ; SET LAST ADDRESS
BR D.SEMI ; DO IT
D.WRD3: MOV R4,D.DOT ; SET DOT
D.WRD5: MOV D.DOT,D.CAD ; SET CURRENT ADDRESS
; PROCESS ; - RETYPE WORD
D.SEMI: JMP @D.OMOD ; TYPE WORD AND RETURN
; PROCESS <TAB> - OPEN INDIRECT
D.ORAB: JSR PC,D.CLSE ; CLOSE WORD
MOV D.LASV,D.DOT ; INDIRECT REFERENCE
BR D.OP2 ; OPEN IT AND RETURN
; PROCESS ! - OPEN WORD SILENTLY
D.EXCL: MOV #D.RTS,D.OMOD ; NULL ROUTINE FOR TYPING
BR D.WRD1 ; OPEN WORD
; PROCESS \ - OPEN LAST REFERENCED WORD
D.BKSL: TST R2 ; ANY PARAMETER?
BEQ D.WRD4 ; BRANCH IF NOT
JSR PC,D.CLSE ; CLOSE WORD
BR D.WRD4 ; OPEN INDIRECT
; PROCESS <LF> - OPEN NEXT WORD
D.OP1: JSR PC,D.CLSE ; CLOSE WORD
ADD D.BW,D.DOT ; ADD IN BYTE/WORD INCREMENT
ADD D.LFIN,D.DOT ; ADD IN LINE-FEED INCREMENT
D.OP2: JSR PC,D.CRLF ; TYPE CRLF
D.OP3: MOV D.DOT,R0 ; GET WORD
JSR PC,D.RFND ; TYPE ADDRESS
MOV #'/,R0 ; SLASH
JSR PC,D.TYPE ; TYPE IT
BR D.WRD5 ; TYPE CONTENTS
; PROCESS [ - OPEN WORD AS NUMERIC
D.OPBR: MOV #D.CADV,D.OMOD ; NUMBER ROUTINE
BR D.WRD1 ; DO ROUTINE
; PROCESS ] - OPEN WORD AS INSTRUCTION
D.CLBR: MOV #D.INST,D.OMOD ; INSTRUCTION ROUTINE
BR D.WRD1 ; DO IT
; PROCESS ^ - OPEN PREVIOUS WORD
D.BACK: JSR PC,D.CLSE ; CLOSE WORD
SUB D.BW,D.DOT ; SUBTRACT BYTE/WORD INCREMENT
BR D.OP2 ; OPEN WORD
; PROCESS _ - TYPE WORD SYMBOLICALLY
D.ORPC: MOV D.LASW,R0 ; GET LAST TYPED WORD
CLR D.LFIN ; NO LINE-FEED INCREMENT
TSTB D.ALTF ; IS IT AN $_ ?
BEQ D.ORP1 ; BRANCH IF NOT
JMP D.RFND ; TYPE SYMBOLICALLY AND RETURN
D.ORP1: JMP D.INST ; TYPE INSTRUCTION AND RETURN
; PROCESS = - TYPE WORD AS NUMBER
D.EQAL: MOV D.LASW,R0 ; GET LAST TYPED WORD
CLR D.LFIN ; NO LINE-FEED INCREMENT
JMP D.TYPN ; TYPE AS A NUMBER
; PROCESS , - COMMA PARAMETER
D.DCOM: TST R2 ; ANY PARAMETER?
BEQ D.FWA1 ; BRANCH IF NOT
MOV R4,D.COMA ; PUT IN PARAMETER AREA
BR D.FWA1 ; RETURN
; PROCESS < - STORE FIRST WORD ADDRESS FOR SEARCH
D.FWAS: MOV R4,D.FWA ; SET FIRST WORD
INCB D.FWAF ; MARK FIRST WORD FOUND
D.FWA1: JMP D.DCD2 ; RETURN
; PROCESS Z - ZERO CORE
D.ZERO: MOV D.FWA,R0 ; FIRST WORD
D.ZER1: CMP R0,D.SVR4 ; AT LAST WORD?
BHI D.ONE1 ; DONE IF SO
CLR (R0)+ ; CLEAR WORD
BR D.ZER1 ; LOOP
; PROCESS U - SECOND SET OF INSTRUCTIONS
D.SNGL: CLR R5 ; OFFSET
JSR PC,D.GET ; GET CHARACTER
D.SNG2: CMPB D.UTAB(R5),R0 ; MATCH?
BNE D.SNG1 ; NO
ASL R5 ; MULTIPLY BY 2
JMP @D.UADD(R5) ; DO THIS ROUTINE
D.SNG1: INC R5 ; NEXT CHARACTER
CMP R5,#D.ENUT ; END OF LIST?
BLT D.SNG2 ; LOOP IF NOT
D.ERRE: JMP D.ERR ; RETURN
; PROCESS UT - SET SINGLE INSTRUCTION
D.ONES: MOVB R4,D.S ; SET INDICATOR
CLR D.CT ; SET FOR AUTOMATIC PROCEDE
CMPB D.ALTF,#1 ; TWO ALTMODES?
BGT D.ONE2 ; FINISH UP IF SO
INC D.CT ; SET NORMAL PROCEDE
D.ONE2: MOV D.SVR4,D.OPEN ; SET ADDRESS TO OPEN AT BREAK
D.ONE1: RTS PC ; RETURN
; PROCESS UW - SET RFND LIMIT
D.WULF: MOV D.SVR4,D.RFNL ; SET LIMIT
RTS PC ; RETURN
; PROCESS UG - RETURN USER DISPLAY
.IF DF,D.GDP
D.GRAP: TRAP 144
MOV #104544,D.SAV9 ; UG! SELF MODIFYING-CODE
RTS PC
.ENDC
; PROCESS E, N AND W - SEARCHES
D.EFF: MOV #1,R1 ; SET EFFECTIVE SEARCH
BR D.WDS ; DO SEARCH
D.NSCH: MOV #-1,R1 ; SET NON-SEARCH
BR D.WDS ; DO SEARCH
D.WSCH: CLR R1 ; SET WORD SEARCH
D.WDS: TST D.SVR2 ; NUMBER TO SEARCH FOR?
BEQ D.ERRE ; ERROR IF NOT
MOV D.CAD,-(SP) ; THIS IS "MOST RECENT VALUE" OF D.CAD
MOV D.FWA,R2 ; SET ORIGIN
D.WDS2: .IF NDF,D.KSR
TSTB @#D.RCSR ; CHARACTER TYPED?
BMI D.WDS6 ; BRANCH IF SO
.ENDC
.IF DF,D.KSR
JSR PC,D.POLL ; CHECK FOR TYPED CHARACTER
CMP D.INPU,D.OUTP ; ANY CHARACTERS IN BUFFER?
BNE D.WDS6
.ENDC
CMP R2,D.LWA ; IS THE SEARCH ALL DONE?
BHI D.WDS6 ; YES
MOV D.SVR4,R5 ; GET NUMBER TO SEARCH FOR
MOV D.MASK,R4 ; GET MASK
COM R4 ; COMPLEMENT IT
MOV (R2),R0 ; GET OBJECT
MOV R2,D.CAD ; THIS IS CURRENT ADDRESS
BIC R4,R0 ; TURN OFF BITS NOT BEING SEARCHED FOR
BIC R4,R5 ; TURN OFF BITS NOT BEING SEARCHED FOR
MOV R1,-(SP) ; STORE AND TEST
BMI D.WDS5 ; BRANCH IF NON-SEARCH
BGT D.WDS7 ; BRANCH IF EFFECTIVE SEARCH
CMP R0,R5 ; EQUALITY?
BNE D.WDS4 ; RE-LOOP IF NO MATCH
D.WDS1: JSR PC,D.CRLF ; TYPE CRLF
MOV D.CAD,R0 ; GET READY TO TYPE
MOV R0,2(SP) ; SET MOST RECENT VALUE OF D.CAD
JSR PC,D.RFND ; RELOCATE
MOV #'/,R0 ; SLASH TO R0
JSR PC,D.TYPE ; TYPE IT
JSR PC,@D.CURM ; TYPE CONTENTS
D.WDS4: MOV (SP)+,R1 ; RESTORE R1
MOV D.CAD,R2 ; RESTORE R2
TST (R2)+ ; INCREMENT TO NEXT CELL AND
BR D.WDS2 ; RETURN
D.WDS7: MOV #1,D.BOTH ; MARK NOTHING FOUND AND DON'T TYPE INSTRUCTION
JSR PC,D.INST ; "TYPE" THE INSTRUCTION
DEC D.BOTH ; ALLOW TYPEOUT AND TEST FOUND INDICATOR
D.WDS9: BEQ D.WDS4 ; BRANCH IF NOT FOUND
BR D.WDS1 ; BRANCH IF FOUND
D.WDS5: CMP R0,R5 ; EQUALITY?
BR D.WDS9 ; BRANCH TO DECIDE
D.WDS6: MOV (SP)+,D.CAD ; RESTORE MOST RECENT VALUE OF D.CAD
RTS PC ; RETURN
; PROCESS H - HALF WORD TYPEOUT
D.INHA: MOV #1,D.BW ; SET HALF WORD MODE
; PROCESS C - SET NUMERIC TYPEOUT
D.INNM: MOV #D.CADV,D.CURM ; SET NUMERIC MODE
D.INN3: MOV D.CURM,D.OMOD ; SET LF AND ^ TYPEOUT MODE
D.INN2: CMPB D.ALTF,#2 ; TWO ALTMODES TYPED?
BLT D.CRE1 ; RETURN IF NOT
MOV #D.CURM,R0 ; ADDRESS OF TEMPORARY TABLE
MOV #D.PERM,R1 ; ADDRESS OF PERMANENT TABLE
D.SWAM: MOV #4,R2 ; SWAP MODES: WORD COUNTER IN R2
D.SWA2: MOV (R0)+,(R1)+ ; MOVE A WORD
DEC R2 ; DECREMENT COUNTER
BGT D.SWA2 ; LOOP TILL DONE
RTS PC ; RETURN
; PROCESS T - TEXT TYPEOUT
D.INTX: MOV #D.ASCI,D.CURM ; DEFAULT TO ASCII
CMP R4,#5 ; RAD50?
BNE D.INN3 ; RETURN IF NOT
MOV #D.RADC,D.CURM ; RAD50
BR D.INM1 ; RETURN
; PROCESS O - BYTE TYPEOUT
D.BYTE: MOV #D.PART,D.CURM ; IN BYTE TYPEOUT MODE
MOV D.DECN,D.SIZE ; SET BYTE SIZE
BR D.INM1 ; RETURN
; PROCESS S - INSTRUCTION TYPEOUT
D.INMD: MOV #D.INST,D.CURM ; IN INSTRUCTION MODE
D.INM1: MOV #2,D.BW ; MUST BE FULLWORD MODE
BR D.INN3 ; RETURN
; PROCESS A - ABSOLUTE ADDRESS TYPEOUT
D.ABS: MOV #1,D.IFMT ; SET ABSOLUTE ADDRESSING
BR D.INN2 ; RETURN
; PROCESS R - SET RADIX
D.INRD: TST R2 ; RADIX SPECIFIED?
BEQ D.INR1 ; BRANCH IF NOT
CMP D.DECN,#2 ; MUST BE GREATER THAN 1
BLT D.ERRC ; BRANCH IF NOT
MOV D.DECN,D.DVTB ; ALWAYS DECIMAL RADIX
BR D.INN2 ; RETURN
D.INR1: CLR D.IFMT ; TURN ON RELATIVE ADDRESSING
BR D.INN2 ; RETURN
; PROCESS <CR> - CLOSE WORD AND RESET PERMANENT MODES
D.CRET: JSR PC,D.CLSE ; CLOSE LOCATION
MOV #D.PERM,R0 ; ADDRESS OF PERMANENT TABLE
MOV #D.CURM,R1 ; ADDRESS OF TEMPORARY TABLE
JSR PC,D.SWAM ; SWAP MODES
MOV D.CURM,D.OMOD ; SET LF AND ^ TYPEOUT MODE
D.CRE1: JMP D.DCD0 ; RETURN
; PROCESS > - STORE LAST WORD ADDRESS FOR SEARCH
D.LWAS: MOV R4,D.LWA ; SET LAST WORD
TST R2 ; ANY WORD THERE?
BNE D.CRE1 ; BRANCH IF NOT
MOV #DDT-2,D.LWA ; SET HIGH LAST WORD
BR D.CRE1 ; RETURN
; PROCESS B - SET AND REMOVE BREAKPOINTS
D.BKPT: TST D.SVR2 ; DID HE GIVE A FIRST ARG?
BEQ D.BKP9
ASL R4 ; MULTIPLY NUMBER BY TWO
MOV D.SVR4,R5 ; GET FIRST NUMBER
BEQ D.BKP4 ; REMOVE BREAK IF FIRST ARG 0
TST (R5) ; VALID ADDRESS? NXM IF NOT
TST R4 ; SPECIFIC CELL REQUESTED?
BNE D.BKP1 ; JUMP IF SO
MOV #2,R4
D.BKP3: MOV D.BKTB-2(R4),R0 ; IS THIS CELL FREE?
BEQ D.BKP2 ; JUMP IF YES
CMP R0,R5 ; IS BREAK ALREADY SET FOR THIS ADDRESS?
BEQ D.BKP2 ; BRANCH IF YES
TST (R4)+ ; INCREMENT BY TWO
CMP R4,#D.BKP*2 ; ARE WE AT THE END OF OUR ROPE?
BLOS D.BKP3 ; NO, KEEP LOOKING
D.BKP1: CMP R4,#D.BKP*2 ; REQUESTED NUMBER TOO LARGE?
BHI D.ERRC ; ERROR IF TOO LARGE
D.BKP2: MOV R5,D.BKTB-2(R4) ; SET BREAKPOINT
MOV D.COMA,D.OPEN(R4) ; SET WORD TO OPEN AT BREAKPOINT
CLR D.CT(R4) ; SET CONTINUE COUNT
CMPB D.ALTF,#1 ; TWO ALTMODES?
BGT D.BKP8 ; BRANCH IF NOT
INC D.CT(R4) ; DO NOT SET AUTOMATIC PROCEDE
D.BKP8: RTS PC ; RETURN
D.BKP4: TST R2 ; IF NO NUMBER WAS TYPED...
BEQ D.BKP6 ; GO REMOVE ALL
CMP R4,#D.BKP*2 ; WAS THE TYPED NUMBER VALID?
BHI D.ERRC ; JUMP IF NOT
CLR D.BKTB-2(R4) ; CLEAR BREAKPOINT
RTS PC ; RETURN
D.BKP5: ASL R4
D.BKP6: MOV #D.BKTB+<D.BKP*2>,R4
D.BKP7: CLR -(R4)
CMP R4,#D.BKTB
BHI D.BKP7
RTS PC ; RETURN
D.BKP9: TST R2
BEQ D.BKP5
DEC R4
CMP R4,#D.BKP ; WAS THE TYPED NUMBER VALID?
BHIS D.ERRC ; JUMP IF NOT
ADD #D.BKTB-2+1,R4
BR D.MAS2
D.ERRC: JMP D.ERR ; INTERMEDIATE HELP
; PROCESS M - TYPE AND SET MASK
D.MAST: MOV #D.MASK,-(SP) ; GET MASK
TST D.SVR2 ; NUMBER THERE?
BNE D.MAS3 ; BRANCH IF SO
D.MAS1: MOV (SP)+,R4 ; ADDRESS TO OPEN
D.MAS2: JSR PC,@D.OPER ; COMBINE VALUE WITH CURRENT EXPRESSION
INC R2 ; MARK A TYPED NUMBER
JMP D.DCD3 ; CONTINUE SCANNING
D.MAS3: MOV D.SVR4,@(SP)+ ; SET MASK
RTS PC ; RETURN
; PROCESS V - GET CONTENTS OF D.DOT SWABBED
D.ALTV: MOV @D.DOT,R4 ; CONTENTS OF WORD
SWAB R4 ; SWAB IT
BR D.MAS2 ; RETURN
; PROCESS Q - GET CONTENTS OF D.DOT
D.ALTQ: MOV @D.DOT,R4 ; CONTENTS OF WORD
BR D.MAS2 ; RETURN
; PROCESS I - GET ADDRESS OF USER STATUS
D.ALTI: MOV #D.USTA,R4 ; ADDRESS OF STATUS
BR D.MAS2 ; RETURN
; PROCESS " - GET TEXT
D.TEXT: JSR PC,D.GET ; GET NEXT CHARACTER
CLR R2 ; RAD50/ASCII INDICATOR
CMP R0,#33 ; ALTMODE?
BNE D.TEX1 ; BRANCH IF NOT
INC R2 ; SET INDICATOR
JSR PC,D.GET ; GET NEXT CHARACTER
D.TEX1: MOV R1,R5 ; DELIMETER (EXACT CHARACTER)
D.TEX2: JSR PC,D.GET ; GET CHARACTER
CMP R1,R5 ; DELEMETER?
BEQ D.TEX3 ; BRANCH IF SO
MOV R1,R0 ; PUT IN ARGUMENT PLACE
JSR PC,D.PTSM ; PUT IN SYMBOL
BR D.TEX2 ; LOOP
D.TEX3: TST R2 ; ASCII?
BNE D.TEX4 ; BRANCH IF NOT
MOV D.SYM,R4 ; GET ASCII CHARACTERS
BR D.MAS2 ; RETURN
D.TEX4: MOV #D.SYM,R0 ; ADDRESS OF FIRST THREE CHARACTERS
JSR PC,D.RD50 ; CONVERT TO RAD50
MOV R0,R4 ; NOW CURRENT VALUE
BR D.MAS2 ; RETURN
; PROCESS <CALL> - SOFT RESTART
.IF DF,D.GDP
D.SOFT: MOV #1004,R5 ; ADDRESS OF SOFT RESTART
BR D.GO3 ; GO THERE
.ENDC
; PROCESS G - GO
D.GO: MOV D.SVR4,R5 ; GET STARTING ADDRESS
TST D.SVR2 ; STARTING ADDRESS SPECIFIED?
BNE D.GO3 ; IF NOT, USE USER SA
MOV JOBSA,R5 ; GET STARTING ADDRESS
D.GO3: TST (R5) ; VALID ADDRESS? NXM IF NOT
JSR PC,D.CRLF
D.GO5: TST D.SD.T ; SHOULD THE T-BIT BE ON?
BEQ D.GO2 ; BRANCH IF NO
D.GO4: BIS #20,D.USTA ; SET T-BIT
D.GO2: MOV R5,D.UR7
JSR PC,D.REST ; RESTORE REGISTERS
MOV D.USTA,-(SP) ; AND STATUS
MOV D.UR7,-(SP) ; AND PC
D.GO1: RTI ; THIS IS "RTT" IF 11/40...
; PROCESS P - PROCEED
D.PROC: TST R2 ; CHECK FOR ILLEGAL COUNT
BNE D.ERRA ; JUMP IF ILLEGAL
MOV D.UR7,R5 ; GET PC
TST (R5) ; VALID ADDRESS? NXM IF NOT
MOVB D.P,R0 ; DID WE ENTER VIA A BREAK?
BLT D.PRO3 ; NO, RETURN TO CALLER
MOV D.SVR4,R4 ; GET COUNT
TST D.SVR2 ; WAS COUNT SPECIFIED?
BNE D.PRO1 ; NO
MOV #1,R4 ; SET COUNT OF 1
D.PRO1: CMPB D.ALTF,#1 ; AUTOMATIC PROCEDE?
BLE D.PRO6 ; BRANCH IF NOT
NEG R4 ; SET TO AUTOMATIC
D.PRO6: MOV R4,D.CT(R0) ; PUT AWAY COUNT
D.PRO7: JSR PC,D.CRLF ; CARRIAGE RETURN LINE FEED
D.PRO2: INCB D.T ; SET SPECIAL BIT TO 1
MOV R5,D.TPC ; SAVE PC FOR 11/40 KLUDGE
BR D.GO5
D.PRO3: TST D.SVR2 ; COUNT SPECIFIED?
BEQ D.GO3 ; NO, OK, RETURN TO CALLER OF DDT
D.ERRA: JMP D.ERR ; ELSE ERROR
D.PRO4: TSTB D.MACH ; 11/40,45?
BEQ D.PRO5 ; NO, DON'T NEED TO KLUDGE
CMP R5,D.TPC ; DID WE NOT EXECUTE THE BROKEN INSTRUCTION?
BEQ D.GO4 ; YES, TRY IT AGAIN
D.PRO5: CLRB D.T ; WE CAN CONTINUE NORMALLY
TSTB D.S ; UNLESS WE ARE SINGLE STEPPING
BEQ D.GO5
BR D.BRK2 ; IN WHICH CASE WE BREAK IMMEDIATELY
; PROCESS X - EXECUTE INSTRUCTION
D.EXEC: TST D.SVR2 ; ANY INSTRUCTION?
BEQ D.ERRA ; ERROR IF NOT
MOV #D.SVR4,R5 ; INSTRUCTION STARTING ADDRESS
TST D.PARO ; RELOCATE FIRST WORD?
BEQ D.EXE1 ; BRANCH IF NOT
SUB #D.PARS+2,D.PARS; RELOCATE FIRST WORD
D.EXE1: TST D.PARO+2 ; RELOCATE SECOOND WORD?
BEQ D.EXE3 ; BRANCH IF NOT
SUB #D.PARS+4,D.PARS+2 ; RELOCATE SECOND WORD
D.EXE3: MOV D.UR7,D.SVR7 ; SAVE PC
BR D.GO5 ; EXECUTE INSTRUCTION
D.EXE2:
.IIF NDF,D.LSI,MOV @#PS,D.USTA ; GET PS
.IIF DF,D.LSI,MFPS D.USTA ; GET PS
MOV D.SVR7,D.UR7 ; RESTORE CORRECT PC
JSR PC,D.SAVE ; SAVE ALL REGISTERS
BR D.BRK8 ; RETURN
; ERROR TRAPS
D.NXMT: MOV #D.NM,D.ERF ; NXM TRAP SERVICE
BR D.BRK ; HANDLE BREAKPOINT
D.ILGT: MOV #D.IM,D.ERF ; ILLEGAL INSTRUCTION
; BREAKPOINT HANDLER
D.BRK: MOV (SP)+,D.UR7 ; SAVE PC AND STATUS
BIC #20,(SP) ; TURN OFF T-BIT
MOV (SP)+,D.USTA ; SAVE PS
JSR PC,D.SAVE ; SAVE VARIOUS REGISTERS
MOV D.UR7,R5 ; GET PC, IT POINTS TO THE INSTRUCTION
TST D.ERF ; TEST ADDRESS OF ERROR MESSAGE
BNE D.BRK7 ; BRANCH IF ERROR
TSTB D.T ; WERE WE PROCEEDING AFTER A BREAK?
BGT D.PRO4 ; YES, FIX IT UP
D.BRK2: MOV #D.BKP*2,R4 ; GET A COUNTER
TSTB D.S ; DID WE ENTER VIA BPT?
BNE D.BRK3
TST -(R5) ; YES, BACK UP A WORD
D.BRK3: CMP R5,D.BKTB-2(R4) ; IS THIS THE BPT?
BEQ D.BRK4 ; BRANCH IF YES
SUB #2,R4
BHI D.BRK3 ; LOOP, UNLESS DONE
TSTB D.S ; SINGLE STEP MODE?
BEQ D.BRK6 ; NO, WE SHOULDN'T HAVE BEEN CALLED.
D.BRK4: MOV R5,D.UR7 ; UPDATE THE PC, IF WE DECREMENTED IT
MOVB R4,D.P ; AND SET THE BREAKPOINT FLAG
TST D.CT(R4) ; AUTOMATIC PROCEDE?
BMI D.BRK9 ; BRANCH IF GETTING THERE
BEQ D.BRKA ; BRANCH IF AUTOMATIC PROCEDE
DEC D.CT(R4) ; TEST REPEAT COUNT
BLE D.BRKC ; BRANCH IF NO REPEAT
D.BRKD: BR D.PRO2 ; PROCEDE
D.BRKC: MOV #1,D.CT(R4) ; RESET COUNT TO 1
D.BRKA: MOV D.CT(R4),-(SP) ; SAVE COUNT
ASR R4 ; FIX IT
ADD #'0,R4 ; MAKE IT ASCII
MOVB R4,D.BMES+1 ; PUT IN STRING
MOV #D.BMES,R4 ; REST OF MESSAGE
MOV #D.BMES+6,R3 ; END OF MESSAGE
JSR PC,D.STYP ; TYPE IT
MOV R5,R0 ; GET ADDRESS OF BREAK
MOV R5,-(SP) ; AND SAVE IN CASE OF AUTO REPEAT
JSR PC,D.RFND ; RELOCATE
MOVB D.P,R4 ; PROCEED ALLOWED?
BMI D.BRK8 ; NO
MOV D.OPEN(R4),R0 ; ANY WORD TO OPEN AT BREAKPOINT?
BEQ D.BRKB ; BRANCH IF NOT
MOV R0,D.DOT ; PUT IN CURRENT WORD
JSR PC,D.TTAB ; TYPE A TAB
JSR PC,D.OP3 ; OPEN IT
D.BRKB: MOV (SP)+,R5 ; RESTORE R5
TST (SP)+ ; AUTOMATIC PROCEDE?
BNE D.BRK8 ; RETURN IF NOT
TSTB @#D.RCSR ; CHARACTER TYPED?
BMI D.BRK8 ; EXIT IF SO
JMP D.PRO7 ; CONTINUE BREAKPOINT
D.BRK9: INC D.CT(R4) ; COUNT 'EM OFF
BMI D.BRKD ; PROCEDE IF STILL NEGATIVE
BR D.BRKA ; DO THE BREAK
D.BRK6: MOV #D.BE,D.ERF ; ERROR: UNEXPECTED BREAK
D.BRK7: MOV D.UR7,R0 ; GET ADDRESS OF BREAK
JSR PC,D.RFND ; RELOCATE
MOV D.ERF,R3 ; GET CODE
MOV R3,R4 ; OBTAIN END
ADD #4,R3 ; BY ADDING 4 TO BEGIN
JSR PC,D.STYP ; TYPE MESSAGE
CLR D.ERF ; REMOVE TRACES OF THIS ENTRY
MOVB #-1,D.P ; DISALLOW PROCEED
CLRB D.T ; TURN OFF BIT
D.BRK8: JMP D.DCD ; RETURN
; CONVERT 3 ASCII CHARACTERS AT (R0) TO RAD50 WORD IN R0
D.RD50: MOV R2,-(SP) ; SAVE R2
MOV R1,-(SP) ; SAVE R1 ALSO
MOV #-3,-(SP) ; CHARACTER LOOPER
CLR R2 ; NOW CLEAR IT
D.RD51: CLR R1 ; OFFSET OF CHARACTERS
D.RD52: CMPB D.RDTB(R1),(R0) ; CHARACTER MATCH?
BEQ D.RD53 ; BRANCH IF SO
INC R1 ; NEXT CHARACTER
CMP R1,#D.ENTB ; AT END OF TABLE
BLT D.RD52 ; BRANCH IF NOT
D.ERRF: JMP D.ERR ; BAD CHARACTERS
D.RD53: ASL R2 ; MULTIPLY BY 2
ASL R2 ; MULTIPLY BY 4
ASL R2 ; MULTIPLY BY 8
MOV R2,-(SP) ; STORE AWAY
ASL R2 ; MULTIPLY BY 16
ASL R2 ; MULTIPLY BY 32
ADD (SP)+,R2 ; ADD 8X TO MAKE IT 40X
ADD R1,R2 ; PUT IN NEW CHARACTER
INC R0 ; POINT TO NEXT CHARACTER
INC (SP) ; INCREMENT LOOPER
BMI D.RD51 ; BRANCH IF MORE
TST (SP)+ ; RESET STACK
MOV R2,R0 ; RESULT IN R0
MOV (SP)+,R1 ; RESTORE R1
MOV (SP)+,R2 ; RESTORE R2
RTS PC ; RETURN
; CONVERT RAD50 WORD IN R0 TO THREE ASCII CHARACTERS AT (R1)
D.CHAR: MOV R1,R3 ; INDEX HERE SINCE D.DIVD WILL USE R1
MOV #1600.,R2 ; OTHER OPERAND
JSR PC,D.DIVD ; DIVIDE THEM
MOVB D.RDTB(R0),(R3)+; MOVE A CHARACTER IN
MOV #40.,R2 ; OPERAND
MOV R1,R0 ; GET NEW NUMERATOR
JSR PC,D.DIVD ; DIVIDE THEM
MOVB D.RDTB(R0),(R3)+; MOVE ANOTHER CHARACTER IN
MOVB D.RDTB(R1),(R3)+; MOVE LAST CHARACTER IN
MOV R3,R1 ; RESTORE FOR THE USER
RTS PC ; RETURN
; SAVE THE WORLD
D.SAVE: MOV (SP)+,D.XXX ; PICK UP RETURN ADDRESS FROM STACK
MOV SP,D.UR6 ; SAVE USER STACK ADDRESS
MOV #D.UR6,SP ; SET TO INTERNAL STACK
MOV R5,-(SP) ; SAVE
MOV R4,-(SP) ; REGISTERS
MOV R3,-(SP) ; 0
MOV R2,-(SP) ; THRU
MOV R1,-(SP) ; 5
MOV R0,-(SP) ; HERE
.IF DF,D.GDP
TRAP 72 ; USECLR
D.SAV9: NOP ; MAY HAVE USERET
TRAP 107 ; SCRUNB
.ENDC
TST D.SD.T ; TEST D.S AND D.T
BNE D.SAV3 ; SKIP BREAKPOINTS IF SO
CLR R4 ; REMOVE ALL BREAKPOINTS
D.SAV1: MOV D.BKTB(R4),R5 ; GET ADDRESS OF BREAKPOINT
BEQ D.SAV2 ; BRANCH IF NOT FILLED
MOV D.UIN(R4),(R5) ; RESTORE USER'S INSTRUCTION
D.SAV2: TST (R4)+ ; LOOP
CMP R4,#D.BKP*2 ; AT END?
BLT D.SAV1 ; RE-LOOP UNTIL DONE
D.SAV3: MOV #340,R1 ; PS
MOV #4,R0 ; START FILLING AT WORD 4
MOV (R0),-(SP) ; 4
MOV #D.SAV5,(R0)+ ; INTERNAL NXMS
MOV (R0),-(SP) ; 6
MOV R1,(R0)+ ; SET VECTOR PS
MOV (R0),-(SP) ; 10
MOV #D.SAV5,(R0)+ ; INTERRUPT FOR ILLEGAL INSTRUCTION
MOV (R0),-(SP) ; 12
MOV R1,(R0)+ ; SET VECTOR PS
MOV #D.BRK,(R0)+ ; BPT VECTOR
MOV R1,(R0) ; SET VECTOR PS
MOV @#D.RCSR,-(SP) ; SAVE KEYBOARD STATUS
CLR @#D.RCSR ; TURN OFF ALL INTERRUPTS
.IF DF,D.KSR
MOV @#D.TCSR,-(SP) ; SAVE PRINTER STATUS
CLR @#D.TCSR ; REMOVE ALL ENABLES
.ENDC
MOVB #2,D.MACH ; SET MACHINE TO 11/45
SXT R1 ; 11/40,45 INSTRUCTION
CMPB D.MACH,#1 ; 11/15?
BEQ D.SAV4 ; BRANCH IF NOT
MOV #RTT,D.GO1 ; USE RTT INSTRUCTION
D.SAV4: TST @#177772 ; WORD ONLY EXISTS ON 11/45
MOV #D.ERR,@#4 ; RESET NXM ADDRESS
MOV #D.ILGT,@#10 ; ILLEGAL INSTRUCTION
JMP @D.XXX ; RETURN
D.SAV5: DECB D.MACH ; IT FAILED, DIFFERENT MACHINE
RTI ; RETURN
; RESTORE THE WORLD AS WE FOUND IT
D.REST: MOV (SP)+,D.XXX ; GET RETURN ADDRESS FROM STACK
TST D.SD.T ; TEST D.S AND D.T
BNE D.RES3 ; SKIP BREAKPOINTS IF SO
MOV #<D.BKP*2>-2,R4 ; RESTORE ALL BREAKPOINTS
D.RES1: MOV D.BKTB(R4),R5 ; GET ADDRESS OF BREAKPOINT
BEQ D.RES2 ; BRANCH IF NO BREAKPOINT
MOV (R5),D.UIN(R4) ; SAVE CONTENTS OF USER LOCATION
MOV #BPT,(R5) ; PUT BREAKPOINT THERE
D.RES2: SUB #2,R4 ; DECREMENT
BGE D.RES1 ; RE-LOOP UNTIL DONE
D.RES3: MOV #D.STK,SP ; SET STACK POINTER TO BASE
.IIF DF,D.KSR,MOV (SP)+,@#D.TCSR; PUT TELETYPE STATUS BACK
MOV (SP)+,@#D.RCSR ; PUT KEYBOARD STATUS BACK
MOV #12,R0 ; RESTORE HIS VECTORS
MOV (SP)+,(R0) ; 12
MOV (SP)+,-(R0) ; 10
MOV (SP)+,-(R0) ; 6
MOV (SP)+,-(R0) ; 4
.IIF DF,D.GDP,TRAP 144 ; USERET
MOV (SP)+,R0 ; RESTORE
MOV (SP)+,R1 ; USER
MOV (SP)+,R2 ; REGISTERS
MOV (SP)+,R3 ; 0
MOV (SP)+,R4 ; THRU
MOV (SP)+,R5 ; 5
MOV (SP),SP ; RESTORE USER STACK
JMP @D.XXX ; AND RETURN
; TYPE R0 IN ADDRESS FORM
D.RFND: MOV R1,-(SP) ; SAVE R1
MOV R0,-(SP) ; SAVE ADDRESS FOR LATER
CMP R0,D.SVR4 ; IS IT THE ADDRESS WE ARE LOOKING FOR?
BNE D.RFN2 ; BRANCH IF NOT
INCB D.FIND ; MARK IT FOUND
D.RFN2: TST D.IFMT ; ABSOLUTE ADDRESSING?
BNE D.RFN7 ; BRANCH IF SO
JSR PC,D.GTSM ; GET SYMBOL (IF ANY)
TST R1 ; ANY SYMBOL?
BEQ D.RFN7 ; BRANCH IF NOT
MOV R0,-(SP) ; SAVE OFFSET VALUE
MOV #6,-(SP) ; REPEAT COUNT
D.RFN5: MOVB (R1)+,R0 ; GET CHARACTER
CMPB R0,#40 ; IS IT A BLANK?
BEQ D.RFN6 ; DONE IF SO
JSR PC,D.TYPE ; TYPE IT
DEC (SP) ; DECREMENT COUNT
BGT D.RFN5 ; LOOP IF MORE
D.RFN6: TST (SP)+ ; RESET STACK
MOV (SP)+,R1 ; GET OFFSET
BEQ D.RFN1 ; BRANCH IF NONE
MOV #'+,R0 ; MAKE A PLUS
JSR PC,D.TYPE ; TYPE IT
MOV R1,R0 ; GET OFFSET
D.RFN7: JSR PC,D.TYPN ; TYPE THE NUMBER
D.RFN1: MOV (SP),D.LASW ; LAST TYPED WORD
MOV (SP)+,D.LASV ; LAST TYPED ADDRESS
MOV (SP)+,R1 ; RESTORE R1
RTS PC ; RETURN
; CLOSE WORD OR BYTE
D.CLSE: TST R2 ; IF NO NUMBER WAS TYPED THERE IS
BEQ D.CLS1 ; NOTHING TO CLOSE
CMP D.CAD,#177776 ; ANY OPEN WORD?
BEQ D.CLS1 ; BRANCH IF NOT
CLR D.LFIN ; NO LINE FEED INCREMENT
CMP #1,D.BW ; BYTE MODE?
BEQ D.CLS2 ; JUMP IF BYTE MODE
MOV D.CAD,R2 ; WORD ADDRESS
MOV R4,(R2)+ ; STORE VALUE
MOV R2,R4 ; PUT INTO R4 FOR COMPUTATION
SUB D.CADC,R4 ; SUBTRACT COPY
BGT D.CLS1 ; BRANCH IF NO MORE
MOV #2,D.LFIN ; LINE FEED INCREMENT
MOV D.PARS,(R2) ; MOVE ANOTHER WORD (2 OR 3 WORD INST)
SUB D.PARO,(R2)+ ; RELOCATE WORD
TST R4 ; THIRD PARAMETER?
BEQ D.CLS1 ; BRANCH IF NOT
MOV #4,D.LFIN ; LINE FEED INCREMENT
MOV D.PARS+2,(R2) ; PUT THIRD WORD IN
SUB D.PARO+2,(R2) ; RELOCATE WORD
BR D.CLS1 ; FINISH UP
D.CLS2: MOVB R4,@D.CAD ; STORE BYTE
D.CLS1: MOV #177776,D.CAD ; CLOSE WORD
RTS PC ; RETURN
; SUBROUTINE TO TYPE @D.CAD IN NUMBER FORM
D.CADV: CMP #1,D.BW ; BYTE MODE?
BEQ D.CAD1 ; BRANCH IF SO
MOV @D.CAD,R0 ; GET OPERAND
JSR PC,D.RFND ; TYPE NUMBER
BR D.ASC2 ; RETURN
D.CAD1: MOVB @D.CAD,R0 ; GET OPERAND
BIC #177400,R0 ; CLEAR HIGH BITS
JSR PC,D.TYPN ; TYPE IT
BR D.ASC2 ; RETURN
; SUBROUTINE TO TYPE @D.CAD IN ASCII FORM
D.ASCI: MOV D.CAD,R5 ; GET ADDRESS
MOVB (R5)+,R0 ; GET FIRST CHARACTER
BIC #177400,R0 ; CLEAR HIGH BITS
MOV R0,D.LASV ; LAST TYPED DATA
MOV R0,D.LASW ; LAST TYPED WORD TOO
JSR PC,D.TYPE ; TYPE IT
MOVB (R5),R0 ; GET NEXT CHARACTER
ROR R5 ; EXAMINE LOW BIT
BCC D.ASC2 ; BRANCH IF CLEAR
JSR PC,D.TYPE ; TYPE IT
D.ASC3: MOV @D.CAD,D.LASV ; LAST TYPED DATA
MOV @D.CAD,D.LASW ; LAST TYPED WORD TOO
D.ASC2: CLR D.LFIN ; TURN OFF LINE-FEED SKIPPING
D.RTS: RTS PC ; RETURN
; SUBROUTINE TO TYPE @D.CAD IN MULTI-BYTE FORM
D.PART: MOV @D.CAD,R5 ; GET WORD
MOV #16.,-(SP) ; BIT COUNT
D.PAR5: MOV R5,R0 ; ACCUMULATOR FOR BYTE
MOV #177777,R3 ; MASK FOR BYTE
MOV D.SIZE,R2 ; BYTE SIZE
D.PAR1: ASR R5 ; REMOVE ONE BIT
ASL R3 ; ONE MORE BIT IN MASK
DEC (SP) ; ONE LESS BIT IN WORD
BLE D.PAR2 ; EXIT IF DONE
DEC R2 ; ONE LESS BIT IN BYTE
BGT D.PAR1 ; LOOP IF NOT DONE
D.PAR2: BIC R3,R0 ; MASK WORD
JSR PC,D.TYPN ; TYPE BYTE
TST (SP) ; ALL DONE?
BLE D.PAR4 ; BRANCH IF SO
MOV #',,R0 ; COMMA
JSR PC,D.TYPE ; TYPE IT
BR D.PAR5 ; GET NEXT BYTE
D.PAR4: TST (SP)+ ; FIX STACK
BR D.ASC3 ; RETURN
; SUBROUTINE TO TYPE @D.CAD IN RAD50 FORM
D.RADC: MOV @D.CAD,R0 ; PUT VALUE IN R0
MOV #D.SYM,R1 ; ADDRESS FOR RESULT
JSR PC,D.CHAR ; MAKE CHARACTERS OF IT
MOV #D.SYM,R4 ; ADDRESS OF FIRST CHARACTER
MOV #D.SYM+2,R3 ; ADDRESS OF LAST CHARACTER
JSR PC,D.STYP ; TYPE THEM
BR D.ASC3 ; DONE
; SUBROUTINE TO TYPE @D.CAD IN INSTRUCTION FORMAT
D.INST: MOV D.CAD,R5 ; PUT CURRENT ADDRESS INTO DECODE
JSR PC,D.TTAB ; TYPE TAB
JSR PC,D.DC49 ; DECODE IT
SUB D.CAD,R5 ; GET INSTRUCTION LENGTH
TST -(R5) ; DECREMENT TO BE OFFSET OF INSTR
CMP D.DOT,D.CAD ; ARE WE AT THE DOT?
BNE D.INS2 ; DON'T SET INCREMENT IF NOT
MOV R5,D.LFIN ; PUT IN LINE-FEED INCREMENT
D.INS2:
; ASR R5 ; DIVIDE BY TWO
; BEQ D.INS4 ; BRANCH IF NOT ZERO
; ADD #'1,R5 ; ASCIIZE
; MOVB R5,D.WAMS+1 ; FILL IN NUMBER OF WORDS
; MOV #D.WAMS,R4 ; BEGIN WARNING MESSAGE
; MOV #D.WAMS+7,R3 ; END WARNING MESSAGE
; JSR PC,D.TTAB ; TYPE A TAB
; JSR PC,D.STYP ; TYPE IT
D.INS4: MOV @D.CAD,D.LASW ; LAST TYPED WORD
RTS PC ; RETURN
; GET A CHARACTER INTO R0
D.GET: .IF NDF,D.KSR
TSTB @#D.RCSR ; CHARACTER TYPED?
BPL D.GET ; LOOP UNTIL FOUND
MOVB @#D.RDB,R0 ; GET A CHARACTER
.ENDC
.IF DF,D.KSR
JSR PC,D.POLL ; CHECK FOR CHARACTERS IN I/O BUFFER
CMP D.INPU,D.OUTP ; ANY CHARACTERS TYPED?
BEQ D.GET ; LOOP IF BUFFER EMPTY
MOVB @D.OUTP,R0 ; GET CHARACTER FROM BUFFER
INC D.OUTP ; POINT TO NEXT CHARACTER
CMP D.OUTP,#D.ENDB ; AT END OF BUFFER?
BNE D.GET9 ; BRANCH IF NOT
MOV #D.BUFR,D.OUTP ; WRAP-AROUND
D.GET9: .ENDC
.IIF DF,D.GDP,TRAP 64 ; KEYASC
BIC #177600,R0 ; CLEAR META, CNTL AND SHIFT STUFF
MOV R0,R1 ; EXACT (UNFOLDED COPY IN R1)
BEQ D.GET ; IGNORE NULLS
CMPB R0,#15 ; SEE IF A <CR>
BNE D.GET2 ; BRANCH IF NOT
MOV #12,R0 ; LINE FEED
JSR PC,D.TYPE ; TYPE IT
MOV #15,R0 ; RESET TO CR
D.GET2: CMPB R0,#177 ; IS IT A BACKSPACE
BEQ D.GET5 ; GUARANTEED TO GET A ?
CMP R0,#12 ; IS IT A LINE FEED?
BEQ D.GET1 ; IF SO, SAVE THE PAPER
CMPB R0,#33 ; IS IT AN ESCAPE?
BEQ D.GET4 ; TYPE DOLLAR SIGN IF SO
.IF DF,D.KSR
CMPB R0,#175 ; IS IT AN ALTMODE?
BGE D.GET4 ; TYPE DOLLAR SIGN IF SO
.ENDC
JSR PC,D.TYPE ; ECHO CHARACTER
CMPB #'a,R0 ; FOLD TO UPPER CASE
BGT D.GET1 ; BRANCH IF NOT A LETTER
CMPB #'z,R0 ; IS IT IN ALPHABET?
BLT D.GET1 ; BRANCH IF STILL NOT
SUB #'a-'A,R0 ; FOLD DOWN
D.GET1: RTS PC ; RETURN
D.GET4: MOV #'$,R0 ; DOLLAR SIGN
JSR PC,D.TYPE ; TYPE IT
MOV #33,R0 ; RESTORE R0
RTS PC ; RETURN
D.GET5: MOV #'X,R0 ; TYPE "XXX"
JSR PC,D.TYPE ; TYPE FIRST
JSR PC,D.TYPE ; TYPE SECOND
JMP D.ERRO ; JUMP TO LAST
.IF DF,D.KSR
D.POLL: TSTB @#D.RCSR ; ANY CHARACTER TYPED?
BPL D.POL1 ; BRANCH IF NOT
MOVB @#D.RDB,@D.INPU ; PUT CHARACTER IN BUFFER
INC D.INPU ; NEXT
CMP D.INPU,#D.ENDB ; AT END OF BUFFER?
BNE D.POL1 ; BRANCH IF NOT
MOV #D.BUFR,D.INPU ; WRAP-AROUND
D.POL1: RTS PC ; RETURN
.ENDC
; TYPE A TAB
D.TTAB:
.IIF NDF,D.KSR,MOV #11,R0 ; TAB
.IF DF,D.KSR
TSTB D.NOTY ; IN NON-TYPEOUT MODE?
BNE D.TYP8 ; EXIT IF SO
MOV #40,R0 ; SPACE
JSR PC,D.TYPE ; TYPE IT
JSR PC,D.TYPE ; AND TYPE IT AGAIN
; JMP D.TYPE ; AND A THIRD SPACE (LIKE DDT-10)
.ENDC
; TYPE THE CHARACTER IN R0
D.TYPE: TSTB D.NOTY ; SHOULD WE TYPE?
BNE D.TYP8 ; BRANCH IF NOT
.IIF DF,D.GDP,TRAP 120 ; SCRRTN
.IIF DF,D.GT40,EMT 0
.IF DF,D.KSR
JSR PC,D.TYP3 ; TYPE CHARACTER
CMPB R0,#15 ; CARRIAGE RETURN?
BEQ D.TYP2 ; ZERO POSITION COUNTER IF SO
BITB #140,R0 ; CONTROL CHARACTER?
BEQ D.TYP1 ; RETURN IF SO
DECB D.CPOS ; INCREMENT CHARACTER POSITION
BPL D.TYP1 ; RETURN IF NOT
MOV R0,-(SP) ; SAVE CHARACTER
MOV #15,R0 ; YES, GENERATE CARRIAGE RETURN
JSR PC,D.TYP3 ; TYPE IT
MOV #12,R0 ; AND A LINE FEED
JSR PC,D.TYP3 ; TYPE IT
MOV (SP)+,R0 ; RESTORE CHARACTER
D.TYP2: MOVB #71.,D.CPOS ; CLEAR CHARACTER POSITION
D.TYP1: RTS PC ; RETURN
D.TYP3: TSTB @#D.TCSR ; PRINTER READY FOR CHARACTER?
BPL D.TYP3 ; LOOP IF NOT
MOVB R0,@#D.TDB ; PUT OUT CHARACTER
JSR PC,D.POLL ; CHECK FOR TYPED-IN CHARACTERS
.ENDC
D.TYP8: RTS PC ; RETURN
; TYPE CARRIAGE RETURN LINE FEED
D.CRLF: MOV #D.CR+1,R3 ; LWA <CR,LF>
MOV #D.CR,R4 ; FWA
; TYPE A STRING STARTING AT R4 AND ENDING AT R3
D.STYP: CMP R3,R4 ; CHECK FOR COMPLETION
BLO D.GET1 ; EXIT WHEN DONE
MOVB (R4)+,R0 ; GET A CHARACTER
JSR PC,D.TYPE ; TYPE ONE CHARACTER
BR D.STYP ; LOOP UNTIL DONE
; SUBROUTINE TO TYPE R0 IN CURRENT RADIX
D.TYPN: MOV R0,D.LASV ; MARK LAST NUMBER TYPED
MOV R0,D.LASW ; LAST TYPED WORD TOO
MOV D.DVTB,R2 ; GET RADIX
CMP R2,#10. ; DECIMAL?
BEQ D.TYP4 ; YES
D.TYP5: JSR PC,D.DIVD ; DIVIDE IT.
ADD #60,R1 ; CONVERT REMAINDER TO ASCII
MOV R1,-(SP) ; AND SAVE IT.
TST R0 ; DONE?
BEQ D.TYP7 ; YES, TYPE THE DIGIT AND RETURN
D.TYP6: JSR PC,D.TYP5 ; CALL OURSELF RECURSIVELY
D.TYP7: MOV (SP)+,R0 ; RESTORE THE DIGIT
BR D.TYPE ; PRINT IT, AND RETURN
D.TYP4: MOV #'.,-(SP) ; PUT A . AT THE END OF THE NUMBER
MOV R0,R3 ; GET THE NUMBER
BPL D.TYP6 ; AND TYPE IF POSITIVE
MOV #'-,R0 ; ELSE PRINT A -
JSR PC,D.TYPE
MOV R3,R0 ; RESTORE NUMBER
NEG R0 ; BUT TAKE ABSOLUTE VALUE
BR D.TYP6
; DIVISION ROUTINE - R1 (HIGH) AND R0 (LOW)/R2=R0 REMAINDER R1
D.DIVD: MOV #16.,-(SP) ; SHIFT COUNT
CLR R1 ; ASSUME NO HIGH PART
D.DIV1: ASL R0 ; DOUBLE PRECISON SHIFT
ROL R1
CMP R2,R1 ; WILL DIVISOR GO IN?
BHI D.DIV2
SUB R2,R1
INC R0
D.DIV2: DEC (SP)
BGT D.DIV1 ; SOB?
TST (SP)+
RTS PC
; TYPE WORD(S) AT R5 IN INSTRUCTION FORMAT
D.DC49: MOV (R5)+,R0 ; GET INSTRUCTION INTO R0
MOV #D.TOPS+2,R1 ; POINT TO ARRAY OF INSTRUCTION VALUES
MOV R0,R4 ; SAVE INSTRUCTION
CLR R3 ; DON'T TYPE A "B"
BIC #100000,R0 ; START OUT LOOKING FOR INS. WITHOUT "B"
D.LOOP: CMP R0,(R1)+ ; DOES INSTRUCTION FALL IN HERE?
BHI D.LOOP ; NO, LOOP
CMP R4,R0 ; DID WE GET REAL INSTRUCTION MATCH?
BEQ D.FOUN ; YES
MOV R4,R0 ; NO, BUT DO SO NEXT TIME
TSTB D.LEGS-D.TOPS-4(R1) ; BYTE INSTRUCTION?
BPL D.LOOP ; NO!
DEC R3 ; PRINT A "B"
D.FOUN: MOVB D.LEGS-D.TOPS-4(R1),R2 ; GET LEGAL CONSIDERATION BYTE
BIC #177774,R2 ; CLEAR HIGH BITS
CMPB R2,D.MACH ; MACHINE TYPE RIGHT?
BGT D.N16 ; TYPE NUMBER IF BAD
ADD #D.COUS-D.TOPS-4,R1 ; ADD IN ADDRESS OF STRING
MOV (R1)+,R2 ; GET OFFSET OF CHARACTERS
BIC #177400,R2 ; TURN OFF EXTRA CRUFT
D.DC6: CMPB R2,(R1) ; AT END?
BEQ D.DC3 ; BRANCH IF SO
MOVB D.STRS(R2),R0 ; GET A CHARACTER
JSR PC,D.TYPE ; TYPE IT
INC R2 ; NEXT CHARACTER
BR D.DC6 ; LOOP
D.DC3: TST R3 ; BYTE INSTRUCTION?
BEQ D.DONE ; BRANCH IF NOT
MOV #'B,R0 ; BYTE INSTRUCTION: TYPE "B"
JSR PC,D.TYPE ; TYPE IT
D.DONE: MOVB -(R1),R3 ; RE-GET LEGALITY BYTE
BIC #177703,R3 ; GET LEGAL CONSIDERATION
CMP R3,#10 ; TYPE A SPACE AFTER OP-CODE?
BLE D.NOBL ; BRANCH IF NOT
MOV #' ,R0 ; SPACE
JSR PC,D.TYPE ; TYPE IT
D.NOBL: MOV R4,R0 ; GET INSTRUCTION BACK
ASL R4 ; GET OPERAND THAT STARTS AT BIT 6
ASL R4 ; WITH TWO SHIFTS AND...
SWAB R4 ; A SWAB
ASR R3
JMP @D.PARM(R3) ; TYPE PARAMETERS
D.DC7: MOV R0,R1 ; GET R1 FOR D.DC5
ADD #D.MOD7,R1 ; DISPLACEMENT OF OPENING CHARACTERS
MOVB (R1),R2 ; GET OFFSET OF CHARACTERS
CMPB D.FIRS(R2),#'? ; IS IT LEGAL?
BEQ D.DC50 ; BRANCH IF NOT
JSR PC,D.DC5 ; TYPE THEM
CMP R0,#6 ; RELATIVE ADDRESSING?
MOV (R5)+,R0 ; NOTE THAT THIS LEAVES CARRY ALONE
BCS D.N16 ; BRANCH IF IMMEDIATE
D.N17: ADD R5,R0 ; FUDGE FOR RELATIVE.
D.N16: JMP D.RFND ; TYPE IN CURRENT ADDRESSING MODE
D.SSDD: MOV R0,-(SP) ; SAVE SECOND PARAMETER
MOV R4,R0 ; GET FIRST ONE
JSR PC,D.DD ; TYPE IT
BR D.SS ; DO THE REST
D.CZVN: MOV #D.NZVC,R1 ; LOOP ON BITS OF CODE
MOV R0,R2 ; SAVE OPERATION IN R2
JSR PC,(PC) ; DO WHAT FOLLOWS TWICE
JSR PC,(PC) ; NO, I MEAN 4 TIMES
MOVB (R1)+,R0 ; GET CHARACTER
ROR R2 ; TEST A BIT
BCC D.RTS2 ; BRANCH IF NOT ON
JMP D.TYPE ; TYPE IT AND RETURN
D.N3: BIC #177770,R0 ; MASK OUT ALL BUT LOW 3 BITS
D.N6: BIC #177700,R0 ; MASK OUT ALL BUT LOW 6 BITS
D.N8: BIC #177400,R0 ; MASK OUT ALL BUT LOW 8 BITS
JMP D.TYPN ; TYPE THE NUMBER
D.RN6: MOV R0,-(SP) ; SAVE R0
MOV R4,R0 ; GET FIRST PARAMETER
JSR PC,D.R ; TYPE AS REGISTER
MOV #',,R0 ; INSERT COMMA BETWEEN PARAMETERS
JSR PC,D.TYPE ; TYPE IT
MOV (SP)+,R0 ; GET SECOND PARAMETER
BIC #^C77,R0 ;MASK ALL BUT OFFSET
NEG R0 ;NEGATE IT
D.X8: MOVB R0,R0 ; SIGN EXTEND
ASL R0 ; MULTIPLY BY 2
BR D.N17 ; DO THE REST AND RETURN
D.RDD: MOV R0,-(SP) ; SAVE SECOND PARAMETER
MOV R4,R0 ; GET FIRST ONE
JSR PC,D.R ; TYPE AS A REGISTER
D.SS: MOV #',,R0 ; PUT COMMA...
JSR PC,D.TYPE ; ... INBETWEEN PARAMETERS
MOV (SP)+,R0 ; GET SECOND PARAMETER
D.DD: ; THIS ROUTINE TYPES A MODE/REGISTER OPERAND IN R0
MOV R0,R3 ; LOW 6 BITS OF R0 HAVE MODE/REG
BIC #177770,R3 ; R3 HAS REGISTER
ASR R0 ; GET MODE
ASR R0 ; BY SHIFTING
ASR R0 ; INTO LOW BITS
BIC #177770,R0 ; R0 HAS MODE
CMP R3,#7 ; PC ADDRESSING?
BEQ D.DC7 ; BRANCH IF SO
D.DC50: MOV R0,-(SP) ; MAKE THIS SAVED DATA
MOV R0,R1 ; PUT IN R1 FOR D.DC5
ADD #D.OPCH,R1 ; ADD IN DISPLACEMENT OF SPECIAL CHARACTERS
JSR PC,D.DC5 ; TYPE PRECEDING CHARACTERS
MOV R3,-(SP) ; SAVE R3
CMP R0,#6 ; IS THERE AN INDEX?
BLT D.DC8 ; BRANCH IF NOT
MOV (R5)+,R0 ; PUT ADDRESS IN R0
JSR PC,D.RFND ; TYPE ADDRESS AND OFFSET
MOV #'(,R0 ; PUT "(" IN OUTPUT
JSR PC,D.TYPE ; TYPE IT
D.DC8: MOV (SP)+,R0 ; GET REGISTER
JSR PC,D.R ; TYPE REGISTER NUMBER
MOV (SP)+,R1 ; RESTORE MODE
ADD #D.CLOS,R1 ; ADD IN CLOSING CHARACTERS
D.DC5: ; THIS ROUTINE TYPES A STRING INDEXED BY R1
MOV R0,-(SP) ; SAVE R0
MOVB (R1)+,R2 ; GET OFFSET OF CHARACTERS
D.DC62: MOVB D.FIRS(R2),R0 ; GET CHARACTER
BEQ D.DC4 ; SKIP IF NULL CHARACTER
JSR PC,D.TYPE ; TYPE IT
D.DC4: INC R2 ; NEXT CHARACTER
CMPB R2,(R1) ; AT END?
BLO D.DC62 ; BRANCH IF NOT
MOV (SP)+,R0 ; RETURN R0
D.RTS2: RTS PC ; RETURN
D.DDR: MOV R4,-(SP) ; SAVE FIRST PARAMETER
JSR PC,D.DD ; TYPE SECOND PARAMETER
MOV #',,R0 ; COMMA
JSR PC,D.TYPE ; TYPE IT
MOV (SP)+,R0 ; RESTORE REGISTER
D.R: ; THIS ROUTINE TYPES A REGISTER
BIC #177770,R0 ; CLEAR HIGH BITS
CMP R0,#6 ; R5 OR LOWER?
BLO D.DC9 ; BRANCH IF SO
BHI D.DC19 ; BRANCH IF PC
MOV #D.SP,R1 ; "SP"
BR D.DC5 ; TYPE IT AND RETURN
D.DC19: MOV #D.SP+1,R1 ; "PC"
BR D.DC5 ; TYPE IT AND RETURN
D.DC9: MOV R0,-(SP) ; SAVE R0
MOV #'R,R0 ; "R"
JSR PC,D.TYPE ; TYPE IT
MOV (SP)+,R0 ; RESTORE R0
ADD #60,R0 ; ASCIIZE IT
JMP D.TYPE ; TYPE IT AND RETURN
; INSTRUCTION DECODE/ENCODE TABLE
.MACRO INSTRS
; THE FIVE PARAMETERS TO THE CODE OP-CODE DESCRIBE AN INSTRUCTION:
; THE FIRST PARAMETER IS THE LOWER LIMIT OF VALUES THAT WILL FALL
; INTO THAT OP-CODE (THE TABLE MUST BE SCANNED SEQUENTIALLY)
; THE SECOND PARAMETER IS THE OP-CODE TEXT
; THE THIRD PARAMETER TELLS THE MACHINE SUITABILITY
; 0 MEANS ANY MACHINE HAS THIS INSTRUCTION. 1 MEANS
; 11/40 AND UP ONLY, 2 MEANS 11/45 ONLY.
; THE FOURTH PARAMETER TELLS HOW TO DECODE THE PARAMETERS:
; 0 MEANS NO PARAMETERS
; 1 MEANS "NNNNNN" (16 BIT NUMBER)
; 2 MEANS DECODE CONDITION CODE BITS (NZVC)
; 3 MEANS "N" (3 BIT NUMBER)
; 4 MEANS "XXX" (8 BIT DISPLACEMENT)
; 5 MEANS "R,DD"
; 6 MEANS "NN" (6 BIT NUMBER)
; 7 MEANS "SS,DD" (OR "DD,SS")
; 10 MEANS "R"
; 11 MEANS "R,NN" (6 BIT DISPLACEMENT)
; 12 MEANS "NNN" (8 BIT NUMBER)
; 13 MEANS "DD" (OR "SS")
; 14 MEANS "SS,R"
; THE FIFTH PARAMETER IS 1 IF THIS INSTRUCTION IS LEGAL IN BYTE MODE
CODE 0,HALT,0,0,0
CODE 1,WAIT,0,0,0
CODE 2,RTI,0,0,0
CODE 3,BPT,0,0,0
CODE 4,IOT,0,0,0
CODE 5,RESET,0,0,0
CODE 6,RTT,1,0,0
CODE 7,,0,1,0
CODE 100,JMP,0,13,0
CODE 200,RTS,0,10,0
CODE 210,,0,1,0
CODE 230,SPL,2,3,0
CODE 240,NOP,0,0,0
CODE 241,CL,0,2,0
CODE 257,CCC,0,0,0
CODE 260,,0,1,0
CODE 261,SE,0,2,0
CODE 277,SCC,0,0,0
CODE 300,SWAB,0,13,0
CODE 400,BR,0,4,0
CODE 1000,BNE,0,4,0
CODE 1400,BEQ,0,4,0
CODE 2000,BGE,0,4,0
CODE 2400,BLT,0,4,0
CODE 3000,BGT,0,4,0
CODE 3400,BLE,0,4,0
CODE 4000,JSR,0,5,0
CODE 5000,CLR,0,13,1
CODE 5100,COM,0,13,1
CODE 5200,INC,0,13,1
CODE 5300,DEC,0,13,1
CODE 5400,NEG,0,13,1
CODE 5500,ADC,0,13,1
CODE 5600,SBC,0,13,1
CODE 5700,TST,0,13,1
CODE 6000,ROR,0,13,1
CODE 6100,ROL,0,13,1
CODE 6200,ASR,0,13,1
CODE 6300,ASL,0,13,1
CODE 6400,MARK,1,6,0
CODE 6500,MFPI,1,13,0
CODE 6600,MTPI,1,13,0
CODE 6700,SXT,1,13,0
CODE 7000,,0,1,0
CODE 10000,MOV,0,7,1
CODE 20000,CMP,0,7,1
CODE 30000,BIT,0,7,1
CODE 40000,BIC,0,7,1
CODE 50000,BIS,0,7,1
CODE 60000,ADD,0,7,0
CODE 70000,MUL,1,14,0
CODE 71000,DIV,1,14,0
CODE 72000,ASH,1,14,0
CODE 73000,ASHC,1,14,0
CODE 74000,XOR,1,5,0
CODE 75000,FADD,1,10,0
CODE 75010,FSUB,1,10,0
CODE 75020,FMUL,1,10,0
CODE 75030,FDIV,1,10,0
CODE 75040,,0,1,0
CODE 77000,SOB,1,11,0
CODE 100000,BPL,0,4,0
CODE 100400,BMI,0,4,0
CODE 101000,BHI,0,4,0
CODE 101400,BLOS,0,4,0
CODE 102000,BVC,0,4,0
CODE 102400,BVS,0,4,0
CODE 103000,BCC,0,4,0
CODE 103000,BHIS,0,4,0
CODE 103400,BCS,0,4,0
CODE 103400,BLO,0,4,0
CODE 104000,EMT,0,12,0
CODE 104400,TRAP,0,12,0
CODE 105000,,0,1,0
.IIF DF,D.LSI,CODE 106400,MTPS,1,13,0
CODE 106500,MFPD,2,13,0
CODE 106600,MTPD,2,13,0
.IIF NDF,D.LSI,CODE 106700,,0,1,0
.IF DF,D.LSI
CODE 106700,MFPS,1,13,0
CODE 107000,,0,1,0
.ENDC
CODE 160000,SUB,0,7,0
CODE 170000,,0,1,0
CODE 177777,,0,1,0
.ENDM
; WORD ALIGNED CONSTANTS
D.UADD: D.WULF ; UW WULF COMMAND
D.ONES ; UT SINGLE STEP MODE
.IIF DF,D.GDP,D.GRAP ; UG RETURN USER DISPLAY
D.LGDR: ; COMMAND DISPATCH TABLE
D.ERR ; @ ERROR
D.ERR ; # ERROR
D.ERR ; ( ERROR
D.ADD ; +
D.ADD ; <SP>
D.MULT ; * MULTIPLICATION
D.DIV ; ' DIVISION
D.SUBT ; - SUBTS SIGN
D.ERR ; ) ERROR
D.TEXT ; " MAKE ASCII
D.LWAS ; >
D.FWAS ; < SET FIRST WORD OF SEARCH
D.EQAL ; =
D.ALTM ; $ ALTMODE
D.COLN ; : DEFINES SYMBOL
D.SEMI ; ; RE-TYPE WORD
D.WRD ; / OPEN WORD
D.BKSL ; \ STORE AND REFERENCE
D.DCOM ; , COMMA PARAMETER
D.CRET ; <CR> CLOSE
D.OP1 ; <LF> MODIFY, CLOSE, OPEN NEXT
D.ORPC ; _ TYPE WORD AS INSTRUCTION
D.BACK ; ^ OPEN PREVIOUS
.IIF DF,D.GDP,D.SOFT ; <CALL> SOFT RESTART AT 1004
D.ORAB ; <TAB> OPEN RELATED, ABSOLUTE
D.OPBR ; [ OPEN WORD AS NUMERIC
D.CLBR ; ] OPEN WORD AS INSTRUCTION
D.EXCL ; ! OPEN WORD SILENTLY
D.ERR ; <SP> SECOND SPACE (ERROR)
D.ABS ; A ABSOLUTE ADDRESSES
D.BKPT ; B BREAKPOINTS
D.INNM ; C IN NUMERICS
D.DELE ; D KILL LAST SYMBOL
D.EFF ; E SEARCH EFFECTIVE ADDRESS
D.ERR ; F ERROR
D.GO ; G GO TO ADDRESS K
D.INHA ; H IN HALF WORDS
D.ALTI ; I STATUS ADDRESS
D.ERR ; J ERROR
D.KILL ; K SYMBOL TABLE DELETION
D.ERR ; L ERROR
D.MAST ; M SET MASK
D.NSCH ; N NON-SEARCH
D.BYTE ; O TYPEOUT IN BYTES
D.PROC ; P PROCEED
D.ALTQ ; Q CURRENT WORD
D.INRD ; R SET RADIX
D.INMD ; S IN INSTRUCTION MODE
D.INTX ; T IN TEXT
D.SNGL ; U SECOND SET OF ROUTINES
D.ALTV ; V SWAB OF CURRENT WORD
D.WSCH ; W SEARCH WORD
D.EXEC ; X EXECUTE INSTRUCTION
D.ERR ; Y ERROR
D.ZERO ; Z ZERO CORE
D.PARM: D.RTS
D.N16
D.CZVN
D.N3
D.X8
D.RDD
D.N6
D.SSDD
D.R
D.RN6
D.N8
D.DD
D.DDR
D.PARG: D.NONE ; NO PARAMETERS
D.NONE ; 16-BIT NUMBER NOT AN INSTRUCTION
D.NONE ; CONDITION CODE ALREADY DECODED
D.NONE ; 3 BIT OPERAND ADDED IN AUTOMATICALLY
D.DISP ; GET 8-BIT DISPLACEMENT
D.GRSS ; GET "R,SS"
D.GNUM ; GET 6-BIT NUMBER (MARK OPERAND)
D.GSD ; GET "SS,DD"
D.GR ; GET "R"
D.GRNN ; GET "R,NN"
D.GNUM ; GET 8-BIT OPERAND
D.GDD ; GET "DD" (OR "SS")
D.GDDR ; GET "DD,R"
.MACRO CODE TOP,STR,LEG,PARM,BYT
.WORD TOP-1
.ENDM
D.TOPS: INSTRS
.WORD -1
.MACRO CODE TOP,STR,LEG,PARM,BYT
.BYTE <BYT*200>+<PARM*4>+LEG
.NCHR D.LEN,STR
D.ADDR=D.ADDR+D.LEN
.BYTE D.ADDR
.ENDM
D.ADDR=0
D.COUS: .BYTE D.ADDR
D.LEGS: INSTRS
D.ECNT=.-1
.MACRO CODE TOP,STR,LEG,PARM,BYT
.ASCII "STR"
.ENDM
D.STRS: INSTRS
; BYTE ALIGNED CONSTANTS
D.FIRS: .ASCII <0> "((@(-(@-(" <0> "@" <0> "))+)+))))??#@#??" <0> "@SPPC"
D.NZVC: .ASCII "CVZN"
D.OPCH: .BYTE 0,1,2,3,5,7,12,13
D.CLOS: .BYTE 14,15,16,20,22,23,24,25
D.MOD7: .BYTE 26,27,30,31,33,34,35,36
D.SP: .BYTE 37,41,43
;D.GRET: .ASCII "DDT EXECUTION"
;.IIF NDF,D.GDP,.ASCII "; MANUAL RESTART = "
D.GRET: .ASCII "DDT-11"
D.GRND =.-1
D.BE: .ASCII ";BPT!"
D.NM: .ASCII ";NXM!"
D.IM: .ASCII ";ILG!"
D.UTAB: .BYTE 'W ; W
.BYTE 'T ; T
.IIF DF,D.GDP,.BYTE 'G ; G
D.ENUT =.-D.UTAB
D.LGCH: ; FIRST CHARACTERS MUST BE "@#(+ *'-)"
.BYTE '@ ; @
D.HASH =.-D.LGCH
.BYTE '# ; #
D.OPAR =.-D.LGCH
.BYTE '( ; (
D.ADDS =.-D.LGCH
.BYTE '+ ; +
D.SPAC =.-D.LGCH
.BYTE ' ; <SP>
.BYTE '* ; *
.BYTE '' ; '
D.DASH =.-D.LGCH
.BYTE '- ; -
D.CPAR =.-D.LGCH
.BYTE ') ; )
.BYTE '" ; "
.BYTE '> ; >
.BYTE '< ; <
.BYTE '= ; =
.BYTE 33 ; <ALT>
D.COLO =.-D.LGCH
.BYTE ': ; :
.BYTE '; ; ;
.BYTE '/ ; /
.BYTE '\ ; \
D.COMM =.-D.LGCH
.BYTE ', ; ,
D.CR: .BYTE 15 ; <CR>
.BYTE 12 ; <LF>
.BYTE '_ ; _
.BYTE '^ ; ^
.IIF DF,D.GDP,.BYTE 3 ; <CALL>
.BYTE 11 ; <TAB>
.BYTE '[ ; [
.BYTE '] ; ]
.BYTE '! ; !
D.LETR =.-D.LGCH
D.RDTB: .ASCII " ABCDEFGHIJKLMNOPQRSTUVWXYZ"
D.CLGT =.-D.LGCH ; COMMAND TABLE END
.ASCII "$.*0123456789"
D.ENTB =.-D.RDTB
; BYTE ALIGNED VARIABLES
.IF DF,D.KSR
D.CPOS: .BYTE 71. ; CHARACTER POSITION FOR TTY
D.BUFR: .BLKB 25. ; 25 CHARACTER INPUT BUFFER
D.ENDB:
.ENDC
D.USED: .BYTE 0 ; IF ZERO, USE OCTAL NUMBER
D.MACH: .BYTE 1 ; 0=11/15 1=11/40 2=11/45
D.LEVL: .BYTE 0 ; PARENTHESIS LEVEL
D.FWAF: .BYTE 0 ; MARKER OF < PARAMETER
D.INPA: .BYTE 0 ; NON-ZERO IF IN AN INSTRUCTION TYPE-IN
D.P: .BYTE -1 ; PROCEED FLAG = <1-8>*2 IF NORMAL BREAK
; 0 IF SINGLE STEP BREAK
; -1 IF NOT ENTERED BY BREAK
D.ALTF: .BYTE 0 ; ALTMODE FOUND
D.WAMS: .ASCII "; WORDS"
D.BMES: .ASCII "$ B >> "
; WORD ALIGNED VARIABLES
.EVEN
.IF DF,D.KSR
D.INPU: D.BUFR ; INPUT BUFFER POINTER
D.OUTP: D.BUFR ; OUTPUT BUFFER POINTER
.ENDC
D.SYM: .BLKW <D.SYML+1>/2 ; HOLDS SYMBOL TYPED
D.SD.T: ; WORD ADDRESS OF D.S AND D.T
D.S: .BYTE 0 ; SINGLE STEP FLAG
D.T: .BYTE 0 ; T-BIT FLAG
D.BOTH: ; WORD ADDRESS OF D.NOTY AND D.FIND
D.NOTY: .BYTE 0 ; DON'T TYPE OUT IF EQUALS 1
D.FIND: .BYTE 0 ; ADDRESS FOUND (EFF SEARCH) IF EQUALS 1
D.TPC: 0 ; PC OF LAST BPT WE PROCEEDED
D.LFIN: 0 ; LINE FEED INCREMENT
; THE NEXT 4 WORDS FORM THE TEMPORARY MODE TABLE AND MUST BE IN ORDER********
D.CURM: D.INST ; TYPEOUT MODE ADDRESS *****
D.DVTB: 8. ; CURRENT RADIX *****
D.BW: 2 ; BYTE-WORD INDICATOR (1=BYTE, 2=WORD) *****
D.IFMT: 0 ; (1=ABSOLUTE, 0=RELATIVE) *****
; END OF CRITICAL ORDERING***************************************************
; THE NEXT 4 WORDS FORM THE PERMANENT MODE TABLE AND MUST BE IN ORDER********
D.PERM: D.INST ; PERMANENT TYPEOUT MODE *****
D.PERN: 8. ; PERMANENT RADIX *****
D.PEBW: 2 ; PERMANENT BYTE-WORD INDICATOR *****
D.PEFM: 0 ; PERMANENT ADDRESS TYPEOUT INDICATOR *****
; END OF CRITICAL ORDERING***************************************************
D.OMOD: D.INST ; MODE TO OPEN WORDS IN
D.OPER: 0 ; OPERATION
D.DECN: 0 ; DECIMAL NUMBER
D.SVR2: 0 ; SAVE FOR R2
; THE NEXT THREE LINES MUST BE IN THAT ORDER FOR $X INST.********************
D.SVR4: 0 ; SAVE FOR R4 *****
D.PARS: 0,0 ; PARAMETERS FOR INSTR. TYPE-IN *****
JMP D.EXE2 ; RETURN IN CASE INSTRUCTION FINISHES *****
; END OF CRITICAL ORDERING***************************************************
D.SVR7: 0 ; SAVE FOR PC DURING $X
D.PARO: 0,0 ; RELOCATIOON FOR D.PARS
D.OFST: 0 ; OFFSET FROM COMMA
D.RFNL: 127. ; RFND OFFSET
D.LASV: 0 ; LAST TYPED NUMBER
D.LASW: 0 ; LAST TYPED WORD
D.DOT: 0 ; CURRENT LOCATION
D.CADC: 0 ; COPY OF D.CAD FOR TYPE-IN
D.ERF: 0 ; ADDRESS OF ERROR MESSAGE
D.CAD: 0 ; CURRENT ADDRESS
D.XXX: 0 ; TEMPORARY STORAGE
D.COMA: 0 ; ADDRESS BEFORE COMMA
D.SIZE: 0 ; BYTE SIZE FOR "O" TYPEOUT
D.RAD1: 0 ; FIRST WORD OF RAD50 SYMBOL
D.RAD2: 0 ; SECOND WORD OF RAD50 SYMBOL
D.LASC: 0 ; LAST COLONED WORD
D.FENC: D.SYMA ; ADDRESS OF FENCE SYMBOL TABLE
D.POS: D.SYM ; ADDRESS OF CHARACTER IN D.SYM
D.FWA: 0 ; LOW LIMIT
D.LWA: DDT-2 ; HIGH LIMIT
D.MASK: 177777 ; MASK
D.BKTB: .REPT D.BKP
0 ; ADDRESS OF BREAKPOINTS
.ENDR
D.CT: .BLKW D.BKP+1 ; EXTRA LOCATION FOR SINGLE STEP
D.UIN: .BLKW D.BKP
D.OPEN: .BLKW D.BKP+1 ; EXTRA LOCATION FOR SINGLE STEP
; THE DDT STACK, INCLUDING SOME VARIABLES AT ITS BASE (HIGH ADDRESSES)
; WHICH DESCRIBE THE USER'S PROGRAM STATE:
; THE FOLLOWING VARIABLES ARE CRITICALLY ORDERED FOR VARIOUS REASONS.********
.BLKW 40. ; ACTIVE STACK AREA *****
D.STK: ; BASE OF ACTIVE DDT STACK *****
.IIF DF,D.KSR, 0 ; SAVE CELL - R C/SR *****
0 ; SAVE CELL - T C/SR *****
0,0,0,0 ; USER LOCATION 12,10,6,4 *****
D.UR0: 0 ; USER REGISTER 0 *****
D.UR1: 0 ; USER REGISTER 1 *****
D.UR2: 0 ; USER REGISTER 2 *****
D.UR3: 0 ; USER REGISTER 3 *****
D.UR4: 0 ; USER REGISTER 4 *****
D.UR5: 0 ; USER REGISTER 5 *****
D.UR6: 0 ; USER SP *****
D.UR7: 0 ; USER PC *****
JOBSA: 0 ; USER START ADDRESS *****
; END OF CRITICALLY ORDERED VARIABLES****************************************
D.USTA: 0 ; USER STATUS
D.DSTA: D.PRIO ; DDT'S STATUS
D.SYMA: .RAD50 /R0 / ; THIS SYMBOL TABLE MUST APPEAR
D.UR0 ; AT THE END OF DDT SINCE IT IS
.RAD50 /R1 / ; EXTENDED MAGICALLY BY THE LINKER
D.UR1 ; STARTING AT ADDRESS D.SYMT
.RAD50 /R2 /
D.UR2
.RAD50 /R3 /
D.UR3
.RAD50 /R4 /
D.UR4
.RAD50 /R5 /
D.UR5
.RAD50 /SP /
D.UR6
.RAD50 /PC /
D.UR7
D.SYMT: 0,0 ; TABLE TERMINATED BY NULL SYMBOL NAME
.ENDC
.IIF NE END$$, .END