github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-24 11:22:36 +00:00
Code Issues Releases Wiki Activity
PDP-10.its/src/system/ddt.70
Eric Swenson 90ed513cef Added support for RP06 disks with RH10 disk controller. Moved RP04 
disk parameters to separate file (system;rp04 >) from system;rh10 >.
Made build default to RP04 when RH10 is specified, but switches
can select RP06 for relevant components.  Resolves #1648.
2019-07-29 12:36:29 -07:00

2861 lines
47 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;-*-MIDAS-*-
;;; Copyright (c) 1999 Massachusetts Institute of Technology
;;; See the COPYING file at the top-level directory of this project.
subttl ddt conditional assembly
define setf text,flg
ifdef flg,.stop
.tag foobar
printc "text
flg="
.ttymac flag
.ttyflg==.ttyflg+1
printx/flag
/
.ttyflg==.ttyflg-1
ifse flag,YES,flg==1
ifse flag,NO,flg==0
ifse flag,Y,flg==1
ifse flag,N,flg==0
ifndef flg,flg==flag
termin
ifndef flg,.go foobar
termin
setf [CPU (0 KA, 1 KI, 2 KL, 3 KS, 4 TS)]cpusw ;KI not supported
define ka
ife cpusw!termin
define ki
ife cpusw-1!termin
define kl
ife cpusw-2!termin
define ks
ife cpusw-3!termin
define ts
ife cpusw-4!termin
define nts
ifn cpusw-4!termin
define tks
ife <cpusw-3>*<cpusw-4>!termin
dpysw==:0 ; Obsolete
setf 340?,dpysw ;0 no display
;1 340 display
define nodpy
ife dpysw!termin
define dpy340
ife dpysw-1!termin
TKS, ndsk==:0 ? dsksw==:0 ; No disk code for TS or KS version
setf Number of disks? (0 no swapping and file system goodies),ndsk
define swap
ifn ndsk!termin
define noswap
ife ndsk!termin
swap,lowlen==2200 ;disk routines take a little extra room
setf [Type of disk? (0 none, 1 Systems Concepts, 2 RP-10, 3 RH-10)]dsksw
define nodsk
ife dsksw!termin
define scdsk
ife dsksw-1!termin
define rp10
ife dsksw-2!termin
define rh10
ife dsksw-3!termin
ifdef rh10,[
setf [Disk model? (0 RP04, 1 RP06)]dsktp
define RP04P
ife dsktp!termin
define RP06P
ife dsktp-1!termin
]
ifndef moby, moby==740000 ;256k ddt (memsiz-40000)
ifndef lowlen, lowlen==1000 ;size of low code
lptp==:0 ; Obsolete
setf Old Type Data Products Line Printer?,lptp
MCDMPF==:0 ; Obsolete
setf [Assemble for MACDMP? (If no, DSKDMP)]mcdmpf
TKS, SETF New One Proceed? (Using 1-proceed microcode),KS1PR
IFNDEF KS1PR, KS1PR==:0
IFN KS1PR, 1PRSW==:0 ; Only one kind of one proceed please
setf Old One Proceed?,1PRSW
subttl assignments and definitions
TITLE DDT
LOC 34000+MOBY
DDT:
MEMSIZ=40000+MOBY ;INITIAL $I-2
NLEVS==7 ;LENGTH OF RING BUFFER OF .
F=0 ;FLAGS
P=1 ;PUSH DOWN
R=2 ;POINTERS TO TABLES, CORE, ETC.
S=3
W=4 ;CONTAINS DISPATCH ADDRESS IN WORD ASSEMBLER
T=5 ;TRANSFER DATA
W1=6
W2=7
I=10 ;SWAP TYPEOUT VARIABLES BETWEEN DISPLAY AND TTY
A=R
B=S
C=W
D=T
NBP==10 ;NUMBER OF BREAK POINTS
PRS==4
LPDL==50 ;MAX LENGTH PUSH DOWN LIST
TS, CHTTYI==:1 ? CHTTYO==:2
TKS, .INSRT DSK:SYSTEM;KSDEFS >
;GET DEFINITIONS OF DTE20 LOCATIONS IN LOW CORE
KL, .INSRT SYSTEM; EPT >
KL, SWPUA=701540,, ;SWEEP-CACHE INSTRUCTION
IF2 LOC LOW
SQUOZE 0,DDT ;initial symbols are for program name "DDT"
-NSYMS,,1
NUMSYM==1
IRP A,,[CLEAR,CLEARI,CLEARM
CLEARB,CONSZ,CONSO,DATAI,DATAO,BLKI,BLKO,CONI,CONO]
SQUOZE 4,A
A
NUMSYM==NUMSYM+1
TERMIN
MTC==340 ;magtape control
MTS==344 ;magtape status
PI==004
ka,[
DC0==610 ;THIS STUFF REALLY WANTS TO CONDITONALIZED ON DISK CONTROL
DC1==614
DPK==604
DPC==250
PTP==100 ;paper tape punch
PTR==104 ;paper tape reader
TTY==120 ;console terminal
LPT==124 ;line printer
DIS==130 ;340 display
DC==200 ;deselection device?
UTC==210 ;dectape control
UTS==214 ;dectape status
IRP A,,[PI,PTP,PTR,TTY,LPT,DIS,DC,UTC,UTS,DC0,DC1,DPK,MTC,MTS,DPC]
SQUOZE 4,A
<BLKI A,>-BLKI
NUMSYM==NUMSYM+1
TERMIN
];ka
kl,[
PAG==10 ;"PAGER"
CCA==14 ;"CACHE SWEEPER"
TIM==20 ;"TIMER"
MTR==24 ;"METER"
DSK==270 ;RH10
IRP A,,[PI,PAG,CCA,TIM,MTR,MTC,MTS,DSK]
SQUOZE 4,A
<BLKI A,>-BLKI
NUMSYM==NUMSYM+1
TERMIN
];kl
TKS,[
PAG==10 ; Paging
.RD.==20 ; Read various kludges
.WR.==24 ; Write various kludges
IRP A,,[PI,PAG,.RD.,.WR.]
SQUOZE 4,A
<BLKI A,>-BLKI
NUMSYM==NUMSYM+1
TERMIN
];TKS
SWAP,[ SQUOZE 4,$QACT ;DDT'S DISK-ACTIVE FLAG WORDS
QACT
NUMSYM==NUMSYM+1
]
DEFINE BUST A
SQUOZE 4,$!A!B
B1ADR+A*3-3
NUMSYM==NUMSYM+1
TERMIN
SQUOZE 4,..START
STARTA
SQUOZE 4,$M
MSK
SQUOZE 4,$I
SAVPI
SQUOZE 4,DDT
DDT
NUMSYM==NUMSYM+4
RADIX 10.
REPEAT NBP+1,BUST \.RPCNT
RADIX 8
DEFINE INFORM A,B
IF1,[ PRINTX /A = B
/]
TERMIN
INFORM [INITIAL SYMS]\NUMSYM*2
LOC DDT-LOWLEN
LOWCOD: INFORM [LOWCODE]\.
SWAP,[
.insrt ddtdsk >
]
subttl display routines
dpy340,[
NREGS=10.
NUMREG=11.
;INITIALIZE DISPLAY (CALLED UNCONDITIONALLY WHEN DDT FIRST STARTED UP)
DISINI: PUSH P,R
SKIPN DISON ;SKIP IF DISPLAY ON
SKIPA R,CJLP1 ;JRST LLUP1
MOVSI R,(TRNA)
MOVEM R,LLUPI1
JUMPGE R,DISIN1 ;JUMP IF <JRST LLUP1> JUST MUNGED INTO LLUPI1
;FOLLOWING CIDING SKIPPED IF DISPLAY OFF
HRRZ T,ESTUT
SUBI T,NUMREG*<NREGS*2+1>+3
HRRM T,DISWD
MOVE R,[REPEAT 6,[35]]
MOVEM R,(T)
HRLI R,(T)
HRRI R,1(T)
BLT R,NUMREG*<2*NREGS+1>-1+1(T)
MOVNI R,NREGS+1
MOVEM R,DISCNT
PUSHJ P,RECYC
MOVEI T,DISBEG
MOVEM T,DISPDL
SETCM T,.-1
MOVNM T,DISACS+P
DISIN1: POP P,R
POPJ P,
DISDON: 0
DISPTR: 0 ;BLKO POINTER FOR DISPLAY
DISCC: 0
DISPNR: 0
DISON: -1 ;DISPLAY FEATURE INITIALLY ON
DISWD: -NUMREG*<2*NREGS+1>,,
DTOC: IDIVI T,8 ;CANT CALL TOC OR TOUT. SCREWS DISPLAY.
HRLM W1,(P)
SKIPE T
PUSHJ P,DTOC
HLRZ T,(P)
ADDI T,"0
DISAD: PUSH P,T
ANDI T,177
CAIL T,40
CAILE T,132
JRST DISAD2
DISAD0: IDPB T,DISPNR
AOS DISCC
HRRI T,-10.
SKIPGE T
MOVEM T,DISCC
JRST POPTJ
DISAD2: PUSH P,W1
CAIL T,40
CAILE T,140
JRST DISAD5
MOVEI W1,36
IDPB W1,DISPNR
MOVE W1,BLOBS-133(T)
IDPB W1,DISPNR
MOVEI T,35
POP P,W1
JRST DISAD0
DISAD3: MOVEI T,34
PUSH P,T
JRST DISAD0
DISAD7: PUSHJ P,DISAD3
DISAD4: MOVNI T,-33
PUSH P,T
JRST DISAD0
DISAD6: MOVEI T,35
PUSH P,T
JRST DISAD0
BLOBS: 53
52
54
46
51
50
DISAD5: PUSHJ P,DIS69
PUSHJ P,DTOC
PUSHJ P,DIS69
POP P,W1
JRST POPTJ
DIS69: IRP X,,[36,50,35]
MOVEI W1,X
IDPB W1,DISPNR
TERMIN
POPJ P,
DISLP: AOS T,DISCNT
CAILE T,NREGS
DISBEG: MOVNI T,NREGS
MOVEM T,DISCNT
ADDI T,NREGS
IMULI T,NUMREG
ADD T,DISWD
HRLI T,600
MOVEM T,DISPNR
MOVEM T,DISPN1
MOVE R,DISCNT
PUSHJ P,DISAD7
JUMPE R,.+2
SOJN R,.+2
PUSHJ P,DISAD4
MOVE T,DISCNT
ADD T,LLOC
PUSH P,T
PUSHJ P,PAD
XCT "/,CRF
XCT CRF
SKIPG DISCC
JRST .-2
POP P,R
PUSHJ P,FETCH
JRST DISL1
PUSHJ P,CONSYM
DISL2: PUSHJ P,DISAD6
MOVE T,DISPNR
TLNE T,770000
JRST DISL2
SUB T,DISPN1
HRREI T,-NUMREG(T)
JUMPL T,DISL2
PUSHJ P,CHECK
AOSE DISDON
JRST .-2
JRST DISLP
DISL1: XCT "-,CRF
JRST DISL2
DISCFT: SOS (P)
SOS (P)
SKIPN DISON
POPJ P,
DPYSWP: PUSH P,LLUP1
MOVEI 17,ACSTG(I)
BLT 17,ACSTG+7(I)
XCT DISSW(I)
TLC T,(CONSO#CONSZ)
MOVEM T,LLUPI1
XORI I,DIS2-DIS1
MOVSI 17,ACSTG(I)
BLT 17,7
POP P,LLUP1
POPJ P,
CHECK: CONSO DIS,200
JRST CHECK1
BLKO DIS,DISPTR
PUSHJ P,RECYC
CHECK1: XCT LLUPI1 ;JRST LLUP1 (IF OFF) OR TRNA (ALWAYS SKIP, VALUE OF WORD NEGATIVE)
JRST DPYSWP
POPJ P,
RECYC: MOVEM T,DISPTR
MOVEI T,40
SOJG T,.
CONO DIS,100
DATAO DIS,[20157,,261777]
MOVE T,DISWD
EXCH T,DISPTR
SETOM DISDON
POPJ P,
];dpy340
subttl ddt low code
IIN: PUSHJ P,IN
CAIE T,177
POPJ P,
JRST ERR
LCT: PUSHJ P,TSPC
PUSHJ P,TSPC
TSPC: MOVEI T,40 ;SPACE
JRST TOUT
TYOI: 0
MOVE T,TYOI
LDB T,[270600+T,,-1]
PUSH P,TYOI
JRST TOUT
LISTEN:
TS,[
SKIPE INSW
POPJ P,
.LISTEN T,
JUMPE T,CPOPJ
PUSHJ P,TYI
.LOSE
];TS
NTS,[
SKIPN INSW
PUSHJ P,TYI
POPJ P,
];NTS
CAIE T,^B
CAIN T,^E
JRST TYO2
CAIE T,^V
CAIN T,^W
JRST TYO2
JRST CPOPJ1
IN: SKIPE INSW
JRST @INSW ;ANOTHER IO ROUTINE PROVIDED, USE IT. (IT SHOULD POPJ 1,)
ILDB T,MACCR
JUMPN T,IN2
SETZM MACCR
dpy340,[
CONSO TTY,40
PUSHJ P,DISCFT
PUSHJ P,TYI
JFCL
];dpy340
nodpy,[
PUSHJ P,TYI
JRST .-1
];nodpy
IN2: CAIE T,175
CAIN T,176
MOVEI T,33
SKIPE OUTSW(I)
JRST @OUTSW(I)
CAIL T,^I
CAILE T,^M
JRST IN3
SKIPE TTYFLG
POPJ P,
PUSH P,T
MOVEI T,15
PUSHJ P,TYO2
MOVEI T,12
PUSHJ P,TYO2
POPTJ: POP P,T
POPJ P,
IN3: PUSHJ P,TYO2
LPTR: SKIPN LPTFLG
POPJ P,
IFN LPTP,[
CAIE T,15
JRST .+3
CONO LPT,10
POPJ P,
PUSH P,T
CAIN T,12
MOVEI T,440
CAIN T,14
MOVEI T,441
CAIN T,33
MOVEI T,"$
SUBI T,40
dpy340,[
CONSZ LPT,10
PUSHJ P,DISCFT
];dpy340
nodpy,[
CONSZ LPT,10
JRST .-1
];nodpy
DATAO LPT,T
POP P,T
]
POPJ P,
TOUT:
dpy340,[
SKIPE DISON ;IF DISPLAY ON,
PUSHJ P,CHECK
];dpy340
TOUT2: SKIPE OUTSW(I)
JRST @OUTSW(I)
PUSHJ P,LPTR
TYO: SKIPN TTYFLG
POPJ P,
TYO2: CAIL T," ;SPACE
JRST TYO3
CAIN T,177
POPJ P,
CAIL T,^I
CAILE T,^M
CAIN T,^G
JRST TYO3
PUSH P,T
CAIE T,33
MOVEI T,"^
CAIN T,33
MOVEI T,"$
PUSHJ P,TYO3
POP P,T
CAIN T,33
POPJ P,
TRO T,100
PUSHJ P,TYO3
TRZ T,100
POPJ P,
TYO3:
TS, .IOT CHTTYO,T
ka,[
CONSZ TTY,20
dpy340, PUSHJ P,DISCFT
nodpy, JRST .-1
DATAO TTY,T
];ka
kl,[
PUSH P,T
ANDI T,177
PUSHJ P,XDTCM
POP P,T
];kl
KS,[ PUSH P,T
ANDI T,177
TRO T,400 ;Set CTY-char-pending
MOVEM T,8CTYOT ;Store in comm area
CONI T ;Read 8080
TRO T,80INT ;Hey you! Get this!
CONO (T) ;Interrupt 8080
SKIPE 8CTYOT ;Wait for completion
JRST .-1
POP P,T
];KS
POPJ P,
TYI:
TS, .IOT CHTTYI,T
ka,[
CONSO TTY,40
POPJ P,
DATAI TTY,T
];ka
kl,[
MOVEI T,3400 ;DDT MODE INPUT REQ
PUSHJ P,XDTCM
JUMPE T,CPOPJ ;NOTHING AVAILABLE
];kl
KS,[ SKIPN T,8CTYIN ;Chars stored here by 8080.
POPJ P,
SETZM 8CTYIN ;Remember to clear it.
];KS
ANDI T,177
CAIGE T,175
CAIG T,137
SKIPA
SUBI T,40 ;UPPERCASIFY
CAIE T,^B
JRST LPTON1
SETOM LPTFLG
IFN LPTP, CONO LPT,10
LPTON1: CAIN T,^E
SETZM LPTFLG
CAIN T,^V
SETOM TTYFLG
CAIN T,^W
SETZM TTYFLG
JRST CPOPJ1
kl,[
XDTCM: SETZM DTEFLG ;SEND ARG IN T TO 11, GET RESPONSE IN T
MOVEM T,DTECMD
CONO DTE,%DBL11
SKIPN DTEFLG
JRST .-1
MOVE T,DTEF11
SETZM DTEFLG
POPJ P,
];kl
RESTORE:SETOM TEM3
RESTR1: HRRM T,SAVE
CLEARM SARS
MOVE T,SAVPI
HLLM T,SAVE
ANDI T,177 ;CHANNELS THAT WERE ON
IORI T,2000 ;TURN ON CHANNELS
MOVEM T,SAVPI
RES1: HRLZI 17,AC0
BLT 17,17
SKIPL TEM3
CPUSHP: PUSH BCOM
NTS, CONO PRS,@SAVPI
JRST 2,@SAVE
CRF: JSR 15,TYOI
LF: MOVEI T,12 ;LINE FEED
JRST TOUT
;FLOATING POINT OUTPUT
TFLOT: MOVE A,T
JUMPG A,TFL1
JUMPE A,FP1A
MOVNS A
XCT "-,CRF
TLZE A,400000
JRST FP1A
TFL1: TLNN A,400
XCT "#,CRF ;NOT NORMALIZED
FP1: MOVEI B,0
CAMGE A,FT01
JRST,FP4
CAML A,FT8
AOJA B,FP4
FP1A: MOVEI C,0
FP3: MULI A,400
ASHC B,-243(A)
MOVE A,B
CLEARM,TEM1(I)
PUSHJ P,FP7
XCT ".,CRF
MOVNI A,10
ADD A,TEM1(I)
MOVE W1,C
FP3A: MOVE T,W1
MULI T,12
PUSHJ P,FP7B
SKIPE,W1
AOJL A,FP3A
POPJ P,
FP4: MOVNI C,6
MOVEI W2,0
FP4A: ADDI W2,1(W2)
XCT,FCP(B)
SOSA W2
FMPR A,@FCP+1(B)
FP4B: AOJN C,FP4A
MOVNI B,-2(B)
PUSH P,B
PUSHJ P,FP3
MOVEI T,105
PUSHJ P,TOUT
POP P,T
DPB T,[300200,,.+1]
XCT "+,CRF
MOVE A,W2
FP7: JUMPE A,FP7A1
IDIVI A,12
AOS,TEM1(I)
FP7A: HRLM B,(P)
JUMPE A,FP7A1
PUSHJ P,FP7
FP7A1: HLRZ T,(P)
FP7B: ADDI T,260
JRST,TOUT
1.0^32.
1.0^16.
FT8: 1.0^8
1.0^4
1.0^2
1.0^1
FT: 1.0^0
1.0^-32.
1.0^-16.
1.0^-8
1.0^-4
1.0^-2
FT01: 1.0^-1
FT0=FT01+1
FCP: CAMLE A, FT0(C)
CAMGE A, FT(C)
0, FT0(C)
PS: BLOCK LPDL
dpy340,DISPDL: BLOCK LPDL
INFORM [END OF LOWCODE]\.-1
subttl communication with DSKDMP and ITS
IF1, IFG .-LOWCOD+6-LOWLEN,.ERR LOW CODE DOESN'T FIT, MAKE LOWLEN BIGGER
LOC DDT-6
ALTPC ;-6 PLACE WHERE PC TO PROCEED THROUGH IS STORED
-20,,AC0 ;-5 PNTR TO SAVED LOW CORE (ESPECIALLY ACS)
STARTA: 0 ;-4 START ADDRESS
KILC: -NSYMS,,LOW ;-3 INITIAL SYMBOLS PNTR
-NSYMS,,LOW ;-2 ALL SYMBOLS PNTR
JOBSYM: .-1 ;-1 BIT 4.9=1 => SYMBOL TABLE CLOBBERED
;+0 DDT STARTS HERE
NSYMS==NUMSYM*2
LOW=LOWCOD-NSYMS-2
IFN MCDMPF, MACDMP=37400+MOBY
.ELSE [
noswap, MACDMP=37700+MOBY ;FOR DSKDMP
swap, IF2 MACDMP==ERR ;if neither dskdmp nor magdmp
]
MACCR=37777+MOBY
subttl flag register assignments
;LEFT HALF FLAGS
TIF==100000 ;TRUNCATE TO 18 BITS - SET BY SPACE OR COMMA
PTF==100 ; +, -, OR * HAS BEEN TYPED
COMF==200000 ;COMMA FLAG
CTF==400
SF==4 ;SYLLABLE FLAG
QF==1 ;QUANTITY TYPED IN TO WORD ASSEMBLER
CF==40 ;ALTMODE TYPED
CCF==400000 ;2 ALTMODES TYPED
MF==2 ;MINUS SIGN TYPED IN
LTF==20 ;LETTER TYPED IN TO CURRENT SYLLABLE
ROF==10 ;REGISTER OPEN FLAG
STF==4000 ;! MODE
FAF==1000 ; < TYPED
SAF==2000 ; > TYPED
FPF==20000 ; . TYPED IN
FEF==10000 ; E FLAG
MLF==200 ;*FLAG
DVF==40000 ;DIVIDE FLAG
;RIGHT HALF FLAGS
1RF==10
OUTPUT==4 ;OPDECODER FLAGS
CF1==400 ;OUTPUT 1 REGISTER AS CONSTANT
LF1==2000 ;OUTPUT 1 REGISTER AS FORCED SYMBOLIC OR CONSTANT
Q2F==1 ;NUMBER TYPED AFTER 
SBF==20
NAF==200 ;NEGATIVE ADDRESSES PERMISSABLE
POWF==4000 ;ARGUMENT FOR EXPONENT COMING
SLL==10000 ;STOP LOOKING FOR LOCALS
GLOBAL==040000 ;GLOBAL SYMBOL
LOCAL==100000
PNAME==740000 ;PROGRAM NAME
DELI==200000 ;DELETE INPUT
DELO==400000 ;DELETE OUTPUT
subttl ddt starts here
INFORM DDT,\.
DDT: CLEARM INSW ;IF C(INSW) .NE. 0 THEN INPUT ROUTINE JRST'S @INSW
CLEARM OUTSW
TS,[
.OPEN CHTTYO,[.UAO,,'TTY ? SETZ ? SETZ]
.LOSE
.OPEN CHTTYI,[.UII,,'TTY ? SETZ ? SETZ]
.LOSE
];TS
JSR SAVE ;SAVE PROCESSOR CONDITION
PUSHJ P,BRKRET ;DIDN'T SKIP, PI STATUS AND AC'S WERE SAVED
SKIPGE JOBSYM ;IF SYMTAB MUNGED,
JRST IFIX ;THEN GO FIX IT
DD1A:
dpy340,[
PUSHJ P,DISINI ;INITIALIZE DISPLAY
]
DD1: TLZ F,ROF ;INDICATE NO REGISTER OPEN
PUSHJ P,CRF ;TYPE CRLF (AND RUN SCOPE IF ON)
MOVE T,[SCHM,,SCH]
BLT T,ODF
DD2: MOVEI P,PS
CLEARM PRNC ;PARENTHESES COUNT
LIS: MOVE T,ESTU
MOVEM T,ESTUT
LISA: TDZ F,[(,-1-ROF-STF)LF1+CF1+SBF+2] ;LEAVE REGISTER OPENED,TYPEOUT SUPPRESSED
LISB: TDZ F,[(,-1-ROF-STF-FAF-SAF)NAF]
CLEARM,WRD
LIS1: CLEARM,FRASE
LIS2: MOVEI T,1
MOVEM T,FRASE1
TLZ F,MLF+DVF
L1: TLZ F,CF+CCF+SF+FPF ;TURN OFF CONTROL, SYL, PERIOD FLAG
CLEARM,SYL
L1RPR: CLEARM,SYM
MOVSI T,(50*50*50*50*50*50)
MOVEM T,TEM(I) ;INIT SYMBOL COUNTER
CLEARM,DEN
CLEARM,WRD2
L2: PUSHJ P,IN ;PICK UP CHARACTER
TLNE F,CF ;CONTROL FLAG
JRST,L21
CAIG T,"Z ;Z
CAIGE T,"A ;A
JRST,.+2
JRST,LET
L21: MOVE R,T
CAIN T,177
JRST WRONG
CAILE T,"_
JRST ERR
IDIVI R,3
LDB W,BDISP(R+1)
CAIGE W,MULT-DDT ;LOCATIONS BEFORE MULT DON'T HAVE ARG EVALUATED
JRST DDT(W)
L211: MOVE T,SYL
TLZN F,LTF
JRST POWER
L4A: PUSHJ P,EVAL
JRST,UND1
L4: TLZE F,MF
MOVN T,T
TLNN F,SF
CAIE W,LPRN-DDT
JRST,.+2
JRST,LPRN
EXCH T,FRASE1
TLNN F,DVF
IMULB T,FRASE1
TLZE F,DVF
IDIVB T,FRASE1
CAIGE W,ASSEM-DDT
JRST DDT(W) ;MULTIPLY OR DIVIDE
ADDB T,FRASE
CAIGE W,SPACE-DDT
JRST DDT(W) ; + - @ ,
ADD T,WRD
TLNE F,TIF ;TRUNCATE INDICATOR FLAG
HLL T,WRD ;TRUNCATE
MOVEM T,WRD
TLNN F,QF
MOVE T,LWT(I)
CLEARM,R
MOVE W1,ESTUT
CAMN W1,ESTU
JRST L5
CAILE W,CARR-DDT
JRST ERR
L5: CAIG W,RPRN-DDT
JRST DDT(W)
PUSH P,KILRET
SKIPN PRNC
JRST DDT(W)
UNDEF: MOVEI T,"U ;U
JRST WRONG1
ERR:
WRONG: MOVEI T,"?
WRONG1: MOVEI P,PS
PUSHJ P,TOUT
RET: MOVEI P,PS
PUSHJ P,LCT ;COMMON RETURN FOR TAB;,JRST,LIS
JRST DD2
UND1: MOVE R,ESTUT ;UNDEFINED SYM ASSEMBLER
PUSHJ P,EVAL2
CAIN W,ASSEM-DDT
TLNN F,ROF
JRST OPLOOK
LDB T,[(100)PRNC]
JUMPN T,UNDEF
CAIE W,ASSEM-DDT
XCT "#,CRF
MOVN R,[(2)2]
ADDB R,ESTUT
dpy340, PUSHJ P,DISINI
MOVE T,SYM
TLO T,GLOBAL
MOVEM T,(R)
HRRZ T,LLOCO
TLNE F,MF
TLO T,400000
MOVEM T,1(R)
SETZI T,
JRST L4
QUESTN: PUSHJ P,CRF ;LIST UNDEFINED SYMBOLS
MOVE R,ESTU
QUEST1: JUMPGE R,DD1
MOVE T, (R)
SKIPA W1,ESTU
QUEST2: ADD W1,[(2)2]
CAME T,(W1)
JRST QUEST2
QUEST3: CAME R,W1
JRST QUEST4
PUSHJ P,SPT
PUSHJ P,CRF
QUEST4: ADD R,[(2)2]
JRST QUEST1
OPLOOK: MOVE T,OPLK1
MOVEI W1,SYM
MOVE R,[(440700)TXT]
PUSHJ P,SPT+1
OPLK1: IDPB T,R
;OPDECODER
OPEVAL: MOVEM P,SAVPDL
TRZA F,OUTPUT
OPTYPE: TRO F,OUTPUT
LSH T,-27.
MOVEM T,INST(I)
MOVE T,[(440700)TXT]
MOVEM T,CHP
DEC: TRZ F,1RF
CLEARB R,W1
MOVE W2,BTAB
OPDC1: ILDB T,W2
CAILE T,40
CAIL T,73
SOJGE R,OPDC1
JUMPG R,OPDC1
SUBI T,40
JUMPE T,DECX
JUMPG T,DC2
DPB T,[(340500)PNTR]
TRZ T,-4
AOS T
DPB T,[(300600)PNTR]
TRNN F,OUTPUT
JRST DC6
LDB R,PNTR
JRST OPDC1
DC2: HRREI T,-33(T)
JUMPL T,DECT
MOVE W1,T
IDIVI W1,3
MOVE W2,BTAB(W2)
ADDI W2,(W1)
JRST OPDC1
DECT: TRNE F,OUTPUT
JRST O1CZ
ILDB W1,CHP
CAIE W1,133(T)
JRST LOSE
JRST OPDC1
DECX: TRNE F,OUTPUT
POPJ P,
ILDB W1,CHP
JUMPE W1,DC7
LOSE: POP P,R
POP P,W2
POP P,PNTR
POP P,CHP
LOSE1: AOS R
DPB R,PNTR
LDB R,PNTR
JUMPN R,DC6AA
CAME P,SAVPDL
JRST LOSE
MOVSI T,DELO ;LOOK FOR HALF-KILLED AND DIFFERENT PROGRAMS' LOCALS
IORM T,SYM ;NOTE SETTING DELO HACKS EVAL3+2 TO IGNORE PROGRAM NAMES
PUSHJ P,EVAL
JRST UNDEF ;NOT DEFINED AT ALL
PUSH P,R
PUSHJ P,EVAL1 ;LOOK FOR DUPLICATE INSTANCES
XCT "',CRF ;DIFFERENT PROGRAM SELECTED
CAME R,PRGM
XCT "",CRF ;MULTIPLY DEFINED
POP P,R
LOSE2: MOVEM R,PRGM ;BACK UP TO PRECEDING PROGRAM NAME+2
SUB R,[2,,2]
MOVE W1,(R)
TLNE W1,PNAME
JRST LOSE2
JRST L4A ;SELECT APPROPRIATE PROGRAM
DC6: MOVEI R,0
DPB R,PNTR
DC6AA: CAMN P,SAVPDL
JRST DC6BB
LDB T,-2(P)
CAME T,(P)
JRST LOSE1
DC6BB: PUSH P,CHP
PUSH P,PNTR
PUSH P,W2
PUSH P,R
JRST OPDC1
DC7: MOVE P,SAVPDL
MOVE T,INST(I)
LSH T,27.
JRST L4
O1CZ: TRO F,1RF
MOVEI T,133(T)
PUSHJ P,TOUT
JRST OPDC1
PNTR: INST(I)
CHP: 0
TXT: BLOCK 2
SAVPDL: 0
BTAB: FOO=44
REPEAT 3,[(FOO_12.+1400)TBL
FOO=FOO-14
]
DEFINE BARF A
AWRD=AWRD+<A>_CC
CC=CC-12.
IFL CC,[AWRD
AWRD=0
CC=24.
]
CLOC=CLOC+1
TERMIN
DEFINE HACK A
IRPS B,D,[A]
Z="D
IFE Z-">,Y!B==CLOC
IF1 IFE Z-"/, BARF 1
IF2 IFE Z-"/, BARF Y!B+73
IFE Z-"^,BARF <B&70>_-1+B&7-1
IFE <Z-40>*<Z-15>,[
IRPC Q,,B
Z="Q
IFE Z-".,Z=100
BARF Z-40
TERMIN
]
TERMIN
TERMIN
subttl opcode dispatch table
TBL: AWRD=0
CLOC=0
CC=24.
KA,[
;INITIAL DISPATCH
HACK [63^. FLO/ HAK/ ACCP/ BOOLE/ H HWT/ T ACBM/ . ]
;BYTE AND FLOATING INST
HACK [FLO> 33^ ... BYTE/ FAD A/ FSB A/ FMP A/ FDV A>
21^ LMB/ R IMB/ LMB> 02^ . L>L. M>M. B>B. BYTE> 03^ ..
FS C/ IB P> P. I LD/ LD> LD B/ I DP/ DP> DP B/]
];KA
KL,[
;INITIAL DISPATCH
HACK [63^. FLO/ HAK/ ACCP/ BOOLE/ H HWT/ T ACBM/ . ]
;BYTE AND FLOATING INST
HACK [FLO> 33^ ADJ/ D DBL/ KI/ BYTE/ FAD A/ FSB A/ FMP A/ FDV A>
21^ LMB/ R IMB/ LMB> 02^ . L>L. M>M. B>B. BYTE> 03^ UFA. DFN.
FS C/ IB P> P. I LD/ LD> LD B/ I DP/ DP> DP B/
ADJ> 03^ . . . . . ADJSP. . .]
;DOUBLE PRECISION
HACK [DBL> 03^ FAD . FSB . FMP . FDV . ADD . SUB . MUL . DIV .]
;MISC KI/KL INSTRS
HACK [KI> 12^ DMV/ FIXEX/ DMV/ F 01^ IX R/ LT R> R .
DMV> DMOV 01^ E DMV2/ N DMV2> 21^ . M/
FIXEX> 01^ FIX . EXTEND .]
];KL
TKS,[
;INITIAL DISPATCH
HACK [63^ . FLO/ HAK/ ACCP/ BOOLE/ H HWT/ T ACBM/ IO/ ]
;BYTE AND FLOATING INST
HACK [FLO> 33^ XCAD/ D DBL/ KI/ BYTE/ FAD A/ FSB A/ FMP A/ FDV A>
21^ LMB/ R IMB/ LMB> 02^ . L>L. M>M. B>B. BYTE> 03^ UFA. DFN.
FS C/ IB P> P. I LD/ LD> LD B/ I DP/ DP> DP B/
XCAD> 03^ . . XCTR/ XCTR/ . ADJSP. . .
XCTR> XCTR 01^ I. .]
;DOUBLE PRECISION
HACK [DBL> 03^ FAD . FSB . FMP . FDV . ADD . SUB . MUL . DIV .]
;MISC KI/KL INSTRS
HACK [KI> 12^ DMV/ FIXEX/ DMV/ F 01^ IX R/ LT R> R .
DMV> DMOV 01^ E DMV2/ N DMV2> 21^ . M/
FIXEX> 01^ FIX . EXTEND .]
;ITS KS IO INSTRUCTIONS
HACK [IO> 33^ IO0/ IO1/ IO2/ . . . . .
IO0> 12^ . . UMV/ .
UMV> UMOVE 01^ . M/
IO1> IO2> 12^ IORD/ IOXX/ IOWR/ BLTX/
IOXX> 01^ IORD/ IOWR> IOWR IOBY/
IORD> IORD IOBY> 41^ IOIQ/ B IOIQ> 02^ I/ Q. . .
BLTX> 41^ BLTXX/ . BLTXX> BLT 01^ BU. UB.]
;DEC KS IO INSTRUCTIONS
; HACK [IO> 33^ IO0/ IO1/ IO2/ . . . . .
; IO0> 12^ . . UMV/ .
; UMV> UMOVE 01^ . M/
; IO1> IO2> 03^ TIO/ TIO/ RD IOB/ WR IOB/ BS IOB/ BC IOB/ . .
; TIO> TIO 01^ E IOBP/ N IOBP/
; IOB> IO IOBP> 41^ . B/ ]
];TKS
;FWT, FIXED POINT ARITH, MISC.
HACK [HAK> 33^ MV/ MV> MOV MO/ ML/ DV/ SH/ H1/ JP/
21^ ADD IMB/ SU BIMB> B IMB> 02^ . I>I. M/ B/ MO> 22^
EIMS> E IMS/ S IMS/ N IMS/ M IMS> 02^ . I/ M/ S> S.
ML> 21^ I ML1/ ML1> MUL IMB/ DV> 21^ I DV1/ DV1>
DI DV2> V IMB/ H1> 03^ EXC S3/ BL T> T. AO/ AO> AOBJ
AOB/ JRS T/ JFC L/ XC T/ . AOB> 01^ P/ N/
JP> 03^ PU/ PU> PUSH PUS/ PO/ PO> POP POP/ JSR.
JS P/ JS PA> A. JR PA/ PUS> 01^ J> J.. POP>
01^ . J/ SH> 02^ A S2/ ROT S1/ L S2> S S3> H S1/ 21^ JFFO. CIR C/
S1> 21^ . C> C. ]
;ARITH COMP, SKIP, JUMP
HACK [ACCP> 42^ CA CA1/ SJ/ A JS/ S JS> O 31^
J COMP/ S COMP/ CA1> 31^ I COMP/ M COMP/
SJ> 31^ JUM PSJ/ SKI PSJ> P COMP>
03^ . L/ E> E. L E/ PA/ G E/ N> N. G. ]
;BOOLEAN
HACK [BOOLE> 24^ ST/ AN> AND B2/ AN/ ST/ AN/ ST/
X OR> OR B2/ I OR/ AN/ EQ DV2/ ST/ OR/ ST/ OR/ OR/
ST> SET B2> 24^ Z IMB/ IMB/ CA> C TA/ TM> M IMB/
CM> C TM/ TA> A IMB/ IMB/ IMB/ CB> C BIMB/ IMB/ CA/
CA/ CM/ CM/ CB/ O IMB/ ]
;HALF WORDS
HACK [HWT> 51^ HW1/ 21^ R HW2/ L HW2> R HW3/ HW1>
21^ L HW4/ R HW4> L HW3> 32^ IMS/ Z IMS/ O IMS/
EIMS/ ]
;TEST INST
HACK [ACBM> 31^ AC1/ 01^ D AC2/ S AC2/ AC1> 01^ R AC2/ L
AC2> 42^ N EAN/ Z EAN/ C EAN/ O EAN> 12^ . E/ PA/ N/ ]
IFN AWRD,AWRD
subttl command action routines
NUM: ANDI T,17 ;T HOLDS CHARACTER
TLNE F,CF+FPF
JRST NM1
MOVEI W,10
IMULM W,SYL
ADDM T,SYL
MOVEI W,10. ;ALSO MAINTAIN DECIMAL WORD
IMULM W,DEN
ADDM T,DEN
LE1: AOJA T,LE1A ;FOR SQUOZE SYM
DOLLAR:
PERC: MOVEI T,47+101-13-45(T) ;PERCENT SIGN
LET: TLC F,SF+FPF ;EXPONENT IFF LTF'*FEF'*(T=105)*SF*FPF=1
TLZN F,LTF+FEF+SF+FPF
CAIE T,"E
TLOA F,LTF
TLOA F,FEF
JRST LET1
TLZN F,MF
SKIPA W1,SYL
MOVN W1,SYL
MOVEM W1,FSV
CLEARM DEN
LET1: SUBI T,101-13 ;FORM RADIX 50 SYMBOL
LE1A: TLO F,SF+QF
LE2: MOVEI W,50
EXCH W,TEM(I)
IDIVM W,TEM(I)
IMUL T,TEM(I)
ADDM T,SYM
JRST L2
NUM1: EXCH T,WRD2 ;FORM NUMBER AFTER DOLLAR SIGN
IMULI T,10.
ADDM T,WRD2
TRO F,Q2F
JRST,L2
NM1: TLNE F,CF
JRST NUM1
MOVEI W1,6 ;FORM FLOATING POINT NUMBER
AOS NM1A
NM1A: MOVEI W2,0
MOVSI R,201400
NM1A1: TRZE W2,1
FMPR R,FT(W1)
JUMPE W2,NM1B
LSH W2,-1
SOJG W1,NM1A1
NM1B: MOVSI W1,211000(T)
FMPR R,W1 ;COMPUTE VALUE OF NEW DIGIT
FADRB R,FH ;ADD VALUE INTO FLOATING NO.
REPEAT 0,[ ;I THINK THIS HAIRY ROUNDING IS UNNEC. ALSO KL HAS NO "FMPL".
FMPL R,W1
SKIPN FH
JRST NM1C
LDB W2,[(331000)R]
LDB W1,[(331000)FH]
TLZ R,377000
SUB W2,W1
ASHC R,(W2)
ADD S,FL
TLZE S,400000
AOS R
MOVE W2,FH
TLZ W2,377000
ADD R,W2
TLNN R,1000
SOSA W1
ASHC R,-1
FSC R,1(W1)
NM1C: MOVEM R,FH
MOVEM S,FL
JUMPE R,NM1D
TLNE S,200000
AOS R ; ROUND
TLO R,400 ; NORMALIZE
NM1D:
] ;END REPEAT 0
MOVEM R,SYL
AOJA T,LE1A
POWER: TLNN F,FEF
JRST L4 ;NO EXPONENT
CAIE W,PLUS-DDT
CAIN W,MINUS-DDT
TROE F,POWF
TRZA F,POWF
JRST DDT(W) ; E+-
MOVE W2,DEN
MOVEI W1,FT-1
TLZE F,MF
MOVEI W1,FT01
SKIPA T,FSV
POW2: LSH W2,-1
TRZE W2,1
FMPR T,(W1)
JUMPE W2,L4
SOJA W1,POW2
GETPC: SKIPN T,ALTPC
JRST [HRRZ T,BCOM ? SOS T ? JRST .+1]
AOS (P)
POPJ P,
PERIOD: TLNE F,CF
PUSHJ P,GETPC
MOVE T,LLOC
TLNE F,SF ;SYLLABLE STARTED
MOVE T,DEN
MOVEM T,SYL
TLON F,FPF+SF+QF
MOVEI T,0
IDIVI T,400
SKIPE T
TLC T,243000
TLC W1,233000
FSC T,0 ;NORMALIZE
FSC W1,0
FADR T,W1
REPEAT 0,[ ;I THINK THIS DOUBLE PRECISION IS UNNEC. ALSO KL HAS NO "FADL"
FADL T,W1
MOVEM W1,FL
] ;END REPEAT 0
MOVEM T,FH
HLLZS NM1A
MOVEI T,45 ;RADIX 50 PERIOD
JRST LE2
QUAN: SKIPA T,LWT(I) ;LAST QUANTITY TYPED
PILOC: MOVEI T, SAVPI
QUAN1: MOVEM T,SYL
QUAN2: TLO F,SF+QF ;WRD,SYL STARTED
TLZ F,CF+CCF
JRST,L2
CONTROL: TLOE F,CF
TLO F,CCF
JRST,L2
EVAL: MOVE R,PRGM ;LOOK UP SYMBOL
EVAL0: HRLOI W1,37777+DELI ;W1 BITS MUST BE OFF
JRST EVAL3
EVAL1: ADD R,[(2)2] ;NEXT SYMBOL
EVAL2: SKIPL R
MOVE R,@JOBSYM ;WRAP AROUND
CAMN R,PRGM ;SKIP UNLESS SCANNED ENTIRE SYMBOL TABLE
POPJ P, ;NO SYMBOL FOUND
EVAL3: MOVE T,(R)
XOR T,SYM
TLNN T,PNAME ;SKIP UNLESS SYMBOL IS PROGRAM NAME
TLOA W1,LOCAL ;PROGRAM NAME, FROM NOW ON IGNORE LOCALS
TDNE T,W1
JRST EVAL1 ;PROGRAM NAME OR NO MATCH, TRY NEXT
TLNN T,340000
JRST EVAL1 ;PROGRAM NAME, SKIP IT (CAN HAPPEN IF GOT HERE FROM LOSE1)
MOVE T,1(R) ;GOT IT, RETURN VALUE IN T, SYMBOL TABLE PNTR IN R.
CPOPJ1: AOS (P) ;FOUND SYMBOL, SKIP
CPOPJ: POPJ P,
;BIT 40 - DELETE OUTPUT
; 20 - DELETE INPUT
; 10 - LOCAL
; 04 -GLOBAL
; NO BITS - PROGRAM NAME
KILL: TLNN F,LTF ;DELETE SYMBOLS
JRST,KILLA
PUSHJ P,EVAL
JRST KILL1
MOVEI T,DELO_-16. ;DELETE OUTPUT
TLNE F,CCF
MOVEI T,DELI_-16. ;NO INPUT OR OUTPUT
DPB T,[(420200+R)]
KILRET: JRST,RET
KILLA: TLNN F,QF
TLNN F,CCF
JRST ERR
MOVE R,KILC
MOVEM R,@JOBSYM ;RESTORE INIT SYMS
HRRZM R,ESTU
MOVEM R,PRGM
HRLZI T,DELO+DELI
ANDCAM T,(R) ;GET RID OF DELETE BITS IN INITIAL TABLE
AOBJN R,.+1
AOBJN R,.-2
JRST,DD1
KILL1: MOVE R,ESTU ;REMOVE UNDEFINED SYMS
JUMPGE R,UNDEF
KILL2: PUSHJ P,EVAL0
JRST RET
PUSHJ P,REMUN
JRST KILL2
REMUN: MOVE S,[(2)2] ;REMOVE ONE UNDEFINED SYM
ADDB S,ESTU
MOVE W,-2(S)
MOVEM W,(R)
MOVE W,-1(S)
MOVEM W,1(R)
POPJ P,
DS: MOVE R,DSSAV(I)
MOVEI T,DELO_-16.
DPB T,[(420200+R)]
MOVE T,1(R)
PUSHJ P,LOOK
JRST RET
JRST RET
TAG: TLNE F,CF ;DEFINE SYMBOL AS OPEN REGISTER
JRST SETNAM
MOVE W,LLOCO
HRRZM W,DEFV
TLOE F,FAF
JRST ERR
DEFIN: TLNE F,FAF
TLNN F,LTF
JRST ERR
ADEFIN: PUSHJ P,EVAL
JRST DEF1
CAMGE R,KILC
JRST DEF2 ;REDEFINE
MOVEI T,DELI_-16.
DPB T,[(420200+R)]
DEF1: MOVN R,[(2)2]
ADDB R,@JOBSYM
HRRZ T,ESTU
SUBI T,2
HRL T,ESTU
HRRM T,ESTU
SKIPGE ESTU
BLT T,-1(R)
dpy340, PUSHJ P,DISINI
DEF2: MOVE T,DEFV
MOVEM T,1(R)
MOVSI T,GLOBAL
IORB T,SYM
MOVEM T,(R)
MOVE R,ESTU
DEF3: JUMPGE R,RET ;PATCH IN UNDEFINED SYM
MOVE T,SYM
CAME T,(R)
JRST DEF4
MOVE S,DEFV
SKIPGE 1(R)
MOVNS S
PUSH P,R
MOVE R,1(R)
PUSHJ P,FETCH
JRST ERR
ADD S,T
HRRM S,T
PUSHJ P,DEP
POP P,R
PUSHJ P,REMUN
DEF4: ADD R,[(2)2]
JRST DEF3
;DISK COMMANDS HERE SO NO EVAL ARG
SWAP,[
LISTF0: JRST LISTF
LOAD0: JRST LOAD
DUMP0: JRST DUMP
];SWAP
NOSWAP,[
LISTF0==ERR
LOAD0==ERR
DUMP0==ERR
];NOSWAP
SETNAM: MOVE R,@JOBSYM
SET2: JUMPGE R,UNDEF
MOVE T,(R)
ADD R,[(2)2]
CAME T,SYM
JRST SET2
MOVEM R,PRGM
JRST RET
MULT: TLOA F,PTF+MLF ;*
DIVD: TLO F,DVF+PTF ;SINGLE QUOTE
JRST L1
ASSEM: JRST PLUS ;#
MINUS: TLO F,MF
PLUS: TLO F,PTF
JRST LIS2
LPRN: CAML P,[(LPDL-32)]
JRST,ERR
PUSH P,F ;RECURSE FOR OPEN PAREN
PUSH P,WRD
PUSH P,FRASE
PUSH P,FRASE1
AOS,PRNC
JRST,LISA
INDIRECT: MOVSI W,(@)
IORB W,WRD
TLO F,QF
JRST,LIS2
ACCF: TLNN F,COMF
HRRM T,COMWD ;COMMA
MOVE R,T
HLLZS T
LDB W1,[(331100)WRD] ; Get top 9 bits of opcode
LSH R,27 ; Shift into AC field
CAIN W1,700 ; Old-style IO instruction?
LSH R,1 ; Yes: Shift into device field
;Used to be:
; LDB W1,[(410300)WRD]
; IDIVI W1,7
; LSH R,27(W1)
ADD T,R
ADD T,WRD
TLOE F,COMF
COMWD: HRLI T,.
MOVEM T,WRD
JRST SPACE+1
SPACE: TLNE F,QF
TLO F,TIF
SPAC1: TLZ F,MF+PTF
JRST,LIS1
RPRN: MOVS T,WRD ;)
SOSGE,PRNC
JRST,ERR
POP P,FRASE1
POP P,FRASE
POP P,WRD
POP P,F
TLO F,QF
TLNE F,PTF
TLOE F,SF
JRST,RPRN1
MOVEM T,SYL
JRST,L1RPR
RPRN1: ADDB T,WRD
JRST,L1RPR-1
VARRW: SOSA LLOC ;^
TAB: PUSHJ P,PLOC
LI1B: SOS LLOC
LINEF: PUSHJ P,DEPRA ;NEXT REGISTER
TLZN F,CF
JRST LI0
LI1A: MOVE R,PLCR ;MOVE BACK IN RING BUFFER
MOVE T,LOCBF(R)
SOSGE R
MOVEI R,NLEVS-1
MOVEM R,PLCR
HRRZM T,LLOC
JRST DDT(W)
LI0: PUSHJ P,CRF
AOS T,LLOC
LI1: HRRZM T,LLOC
HRRZM T,LLOCO
PUSHJ P,PAD
MOVEI T,"/ ;SLASH
TLNE F,STF
MOVEI T,"! ;EXCLAMATION MARK
PUSHJ P,TOUT
LI2: TLZ F,ROF
PUSHJ P,LCT
MOVE R,LLOCO
PUSHJ P,FETCH
JRST ERR
TLO F,ROF
TLNE F,STF
JRST DD2
JRST CONSYM
CARR: PUSHJ P,DEPRA
MOVEI W,LI1B-DDT
TLZE F,CF
JRST LI1A
JRST DD1
OCON: TROA F,LF1+CF1 ;OPEN AS CONSTANT
OSYM: TRZ F,CF1 ;OPEN SYMBOLICALLY
TROA F,LF1
SLASH: TLZ F,STF ;TYPE OUT REGISTER
TLZE F,CF ;ALTMODE SLASH SUPPRESSES TYPEOUT
TLO F,STF
TLNE F,QF
PUSHJ P,PLOC ;QUANTITY TYPED
SLAS1: HRRZM T,LLOCO
JRST LI2
ICON: TLZE F,CF
JRST IKON
PUSHJ P,DEPRA ;\
JRST SLAS1
PLOC: CAMN T,LLOC
POPJ P,
AOS R,PLCR ;ADVANCE RING POINTER
CAIL R,NLEVS
CLEARB R,PLCR
EXCH T,LLOC
MOVEM T,LOCBF(R)
MOVE T,LLOC
HRRZS LLOC
POPJ P,
ASLASH: TLNN F,QF
JRST QUESTN
PUSH P,T
MOVEI T,"/
PUSHJ P,TOUT
POP P,T
JRST SLASH
IKON: MOVEM T,LWT(I)
PUSHJ P,EFFEC0
JRST ERR
MOVE R,T
PUSHJ P,FETCH
JRST ERR
JRST OVRD2
DEPRA: TLNE F,ROF ;IF REGISTER IS BEING CHANGED
TLNN F,QF ;REMOVE ALL PREVIOUS UNDEFINED
JRST DEPRS ;SYMBOL REFERENCES TO IT
MOVE R,ESTU
MOVEM W1,ESTU
DEPRA2: JUMPGE R,DEPRS
HRRZ W,1(R)
CAMN W,LLOCO
PUSHJ P,REMUN
ADD R,[(2)2]
JRST DEPRA2
EQUAL: TROA F,LF1+CF1 ;=
PSYM: TRZ F,CF1 ;@
TRO F,LF1
JRST CONSYM
R50PNT: MOVEM T,LWT(I) ;AMPERSANT
LSH T,-36
TRZ T,3
PUSHJ P,TOC
PUSHJ P,TSPC
MOVEI W1,LWT(I)
JRST SPT
HWRDS: MOVEI R,HLFW-TFLOT ;H
SFLOT: ADDI R,TFLOT-SATP ;F
RATP: ADDI R,SATP-IASCO ;T
ASCSET: ADDI R,IASCO-ISIXO ;"
SIXSET: ADDI R,ISIXO-PIN ;'
SYMBOL: ADDI R,PIN-FTOC ;S
CON: ADDI R,FTOC ;C
JSP W,SET
RELA: TLZE F,QF ;R
JRST,BASECH
MOVEI R,PADSO-TOC
ABSA: ADDI R,TOC ;A
JSP W,SET
BASECH: SOJLE T,ERR ;CHANGE RADIX
MOVEI R,1-10.(T)
SDEC: ADDI R,2 ;D
SOCT: ADDI R,10 ;O
JSP W,SET
SET: MOVEI W,-RELA(W)
IDIVI W,5
HRRZM R,SCH(W)
JUMPGE F,LIS1
HRRZM R,SCHM(W)
JRST RET
GO: HRLI T,(JRST)
TLC F,QF+CCF
TLCN F,QF+CCF
MOVEM T,STARTA
TLOE F,QF
JRST XEC0
SKIPE T,STARTA
XEC: TLNN F,QF ;X
JRST ,ERR
XEC0: MOVEM T,TEM
SETZM ALTPC
PUSHJ P,CRF
PUSHJ P,TTYLEV
PUSHJ P,INSRTB
TKS,[ ;Compensate for DEC brain death: XCT of JRST 2, gets wrong flags
MOVE T,TEM
LSH T,-33
CAIE T,JRST_-33
JRST XECKS
JSP T,RESTORE
JRST TEM
XECKS:
];TKS
JSP T,RESTORE
XCT TEM
XEC1: JRST DDT ;USED BY BCOM
JSR SAVE
PUSHJ P,BRKRET
PUSHJ P,CRF
JRST DD1
DQUOTE: TLNE F,CF ;IF ALTMODE TYPED,
JRST DQOT2 ;THEN SET TYPEOUT MODE
MOVEM T,LWT(I) ;DOUBLE QUOTE
;DISPATCH ENTRY FOR IN DOUBLEQUOTE MODE
IASCO: SETZM TEM2
MOVE W1,T
TDNE W1,[-200] ;SKIP IF ONLY ONE CHARACTER IN WORD
JRST TEXO1
LSH W1,1 ;THEN ASSUME IT'S RIGHT JUSTIFIED
TEXO1: MOVEI T,0
TEXO10: JUMPE W1,CPOPJ
TEXO11: LSHC T,7
TEXO12: SKIPN TEM2
JUMPE T,TEXO1
SETOM TEM2
PUSHJ P,TOUT
JRST TEXO1
SQUOTE: TLNE F,CF ;IF ALTMODE TYPED
JRST SQOT2 ;THEN SET TYPEOUT MODE
MOVEM T,LWT(I) ;SINGLE QUOTE
;DISPATCH ENTRY FOR IN SINGLEQUOTE MODE
ISIXO: MOVE W1,T
SIXO1: MOVEI T,0
JUMPE W1,CPOPJ
LSHC T,6
JUMPE T,SIXO1
ADDI T,40
PUSHJ P,TOUT
JRST SIXO1
;ENTRY FROM ALTMODE DOUBLEQUOTE
DQOT2: TRZN F,Q2F ;IF NUMBER NOT TYPED AFTER ALTMODE,
JRST ASCSET ;THEN SET TYPEOUT MODE
MOVSI W1,440700 ;OTHERWISE, DO ASCII TYPEIN
HLLZS SASEM
JRST ISTRING
;ENTRY FROM ALTMODE SINGLEQUOTE
SQOT2: TRZN F,Q2F ;IF NUMBER NOT TYPED AFTER ALTMODE
JRST SIXSET ;THEN SET TYPEOUT MODE
MOVEI W1,40 ;OTHERWISE, DO ASCII TYPEIN
HRRM W1,SASEM
MOVSI W1,440600
ISTRING:
MOVE T,WRD2 ;SO 1" DOES RIGHT THING
MOVEM T,TEM
ISTR1: PUSHJ P,IIN
CAIN T,33
JRST ISTR2
CAIN T,^Q
PUSHJ P,IN
PUSHJ P,SASEM
JRST ISTR1
ISTR2: MOVE T,TEM
SETZM WRD2
JRST MASK2
SASEM: SUBI T,0 ;CLOBBERED TO 0 OR 40
SASME: HRRI W1,TEM
IDPB T,W1
POPJ P,
;ALTMODE V
DISF:
dpy340,[
SETCMM DISON ;COMPLEMENT STATUS FLAG
JRST DISINI ;INITIALIZE DISPLAY AND RETURN
];dpy340
nodpy, POPJ P,
BP0: REPEAT NBP+1,[
0
JSA T, BCOM
0
]
IFN 1PRSW,[
TBP1: 0 ? JSA T,BCOM ? 0 ;TEMPORARY BREAK 1
TBP2: 0 ? JSA T,BCOM ? 0 ;TEMPORARY BREAK 2
];1PRSW
BP1=BP0+3
B1INS=BP1+2
BPN=.-3
;BREAKPOINT 0 LIKE OTHERS EXCEPT DOESN'T GET CHECKED ON LOC$B OR CLEARED BY $B
BCOM: 0
HRRM T,LEAV
MOVEI T,B1SKP-B1INS(T)
HRRM T,BCOM3 ;CONDITIONAL BREAK SETUP
MOVEI T,B1CNT-B1SKP(T)
HRRM T,BCOM2 ;PROCEDE COUNTER SETUP
MOVE T,BP1-B1CNT(T)
HLLM T,LEAV1 ;SAVE FLAGS FOR RESTORING
EXCH T,BCOM ;RESTORE FORMER CONTENTS OF ACCUMULATOR
BCOM3: SKIPE B1SKP ;ADDRESS MODIFIED, POINTS TO CONDITIONAL BPT INSTRUCTION
XCT @.-1
BCOM2: SOSG B1CNT ;ADDRESS MODIFIED, POINTS TO COUNT OF CURRENT BPT
JRST BREAK
MOVEM T,AC0+T
LDB T,[(331100)@LEAV]
CAIL T,264 ;JSR
CAILE T,266 ;JSA,JSP
TRNN T,700 ;UUO
JRST PROC1
CAIE T,260 ;PUSHJ
CAIN T,256 ;XCT
JRST PROC1
MOVE T,AC0+T
JRST 2,@LEAV1 ;RESTORE FLAGS AND JUMP TO .+1
LEAV: XCT B1INS ;ADDRESS MODIFIED
JRST @BCOM
AOS BCOM
JRST @BCOM
LEAV1: LEAV
BREAK: JSR SAVE
PUSHJ P,BRKRET
SOS T,BCOM3
HRRZS T
IFN 1PRSW, CAIGE T,TB1ADR
PUSHJ P,PADSO
MOVEI T,">
PUSHJ P,TOUT
SKIPG @BCOM2
PUSHJ P,TOUT ;TYPE OUT SECOND ">" IF COUNT EXHAUSTED
MOVE T,BCOM
HLLM T, SAVPI
MOVEI T,-1(T)
PUSHJ P,PAD
HRRZ T,@BCOM3
HRRM T,PROC0
HLRZ T,@BCOM3
JUMPE T,BREAK1
PUSHJ P,LCT
HLRZ T,@BCOM3
PUSHJ P,PLOC
PUSHJ P,LI1
BREAK1: HRRZ R,BCOM3
SUBI R,B1ADR
IDIVI R,3
MOVEI S,1
LSH S,1(R)
TDNN S,AUTOPI
JRST RET
PUSHJ P,LISTEN
JRST PROCD1
JRST RET
PROCEDE:
SKIPN R,ALTPC ;TURN INTO <ALT>G?
JRST PROCD0
MOVEM R,ALTPC1 ;YES
MOVE T,[JRST 2,@ALTPC1]
JRST XEC0
PROCD0: TLNN F,QF
MOVEI T,1 ;NO COUNT SPECIFIED, USE 1
MOVEM T,@BCOM2 ;MOVE TO COUNT OF SPECIFIED BPT
HRRZ R,BCOM3
PUSHJ P,AUTOP
PROCD1: PUSHJ P,CRF
PUSHJ P,TTYLEV
PROC0: HRRZI R,XEC1 ;ADDRESS MODIFIED
PUSHJ P,FETCH
JRST ERR
MOVEM T,WRD
PUSHJ P,INSRTB
MOVE T,WRD ;BREAKPOINTED INSTRUCTION TO XCT
JRST PROC2
PROC1: MOVE T,AC0+T
JSR SAVE
MOVE T,@LEAV
PROC2: MOVE R,BCOM
MOVEI W,100
MOVEM W,TEM1
JRST IXCT5
IXCT4: MOVEM R,40
MOVEI R,41
IXCT: SOSL TEM1
PUSHJ P,FETCH
JRST BPLUP
IXCT5: MOVEM T,TEM
LSH T,-33
CAIN T,254
JRST IXCT6
HRLZI 17,AC0
BLT 17,17
MOVEI T,@TEM
DPB T,[(2700)TEM]
LDB W1,[(270400)TEM]
LDB T,[(331100)TEM]
MOVEI P,PS
CAIN T,260
JRST, IPUSHJ
CAIN T,264
JRST,IJSR
CAIN T,265
JRST,IJSP
CAIN T,266
JRST,IJSA
MOVE R,TEM
KL, CAIGE T,74 ;LPMR,SPM,XCTR,XCTRI
.ELSE, CAIGE T,100
JRST,IXCT4
CAIN T,256
JRST,IXCT
IXCT6: MOVEI T,TEM
HRRM T,LEAV
MOVEI T,LEAV
JRST,RESTORE
BPLUP: PUSHJ P,BRKRET
JSR SAVE ;ALWAYS SKIPS
INC1: JSR BP0 ;USED AS "CONSTANT" IN SETTING UP FOR INSERTING BREAKPOINTS
JRST ERR
IPUSHJ: DPB W1,[(270400)CPUSHP]
CLEARM,TEM3
MOVE T,TEM
JRST,RESTR1
IJSA: MOVE T,BCOM
HRL T,TEM
EXCH T,AC0(W1)
JRST,IJSR2
IJSR: MOVE T,BCOM
HLL T,SAVPI
IJSR2: MOVE R,TEM
PUSHJ P,DEP
AOS,TEM
IJSR3: MOVE T,TEM
JRST,RESTORE
IJSP: MOVE W,BCOM
HLL W,SAVPI
MOVEM W,AC0(W1)
JRST,IJSR3
;INSERT BREAKPOINTS
INSRTB: MOVE S,INC1
INSRT1: SKIPE R,B1ADR-BP1(S) ;GET C(B<N>ADR) IN R
PUSHJ P,FETCH ;GET CONTENTS OF LOC ADDRESSED BY R INTO T
JRST INSRT3 ;LOCATION OUTSIDE OF MEMORY OR BREAKPOINT EMPTY
MOVEM T,B1INS-BP1(S) ;PUT CONTENTS IN B<N>INS
MOVE T,S ;JSR BP<N>
PUSHJ P,DEP ;DEPOSIT T IN LOCATION SPECIFIED BY R
INSRT3: ADDI S,3
CAMG S,[JSR BPN]
JRST INSRT1
IFN KS1PR,[
MOVEI T,1PRTRP
SKIPE R,1POADR ; If one-proceeding going on,
EXCH T,UPT1PN-UPT1PO(R) ; then usurp UPT1PN.
MOVEM T,1PNSV
];KS1PR
POPJ P,
;REMOVE BREAKPOINTS
REMOVB: MOVEI S,BNADR ;POINTER TO B<N>ADR
REMOV1: MOVE T,B1INS-B1ADR(S) ;INSTRUCTION AT BREAKPOINT <N>
SKIPE R,(S) ;IF THERE'S REALLY A BREAKPOINT THERE,
PUSHJ P,DEP ;THEN DEPOSIT INSTRUCTION IN USER'S CORE (SPECIFIED BY R)
REMOV3: SUBI S,3
CAIL S,B0ADR
JRST REMOV1
IFN KS1PR,[
MOVE T,1PNSV
SKIPE R,1POADR ; If UPT1PN usurped,
MOVEM T,UPT1PN-UPT1PO(R) ; then put it back now.
];KS1PR
POPJ P,
;ALTMODE B
BPS: TLZE F,QF
JRST BPS1 ;LOCATION SPECIFIED
TRZE F,Q2F
JRST BPS2 ;REMOVE SPECIFIED BREAKPOINT
MOVE T,[(B1ADR)B1ADR+1] ;REMOVE ALL BREAKPOINTS
CLEARM B1ADR
BLT T,BNADR+2
JRST DD1
;LOC$B, LOC$NB
BPS1: TRZN F,Q2F
JRST,BPS3 ;NUMBER NOT TYPED AFTER ALTMODE
MOVE R,T
TRO F,2 ;USED LATER
;GET HERE WHEN NUMBER TYPED AFTER ALTMODE
BPS2: SKIPL T,WRD2 ;BPT # NOT LEGAL...
CAILE T,10 ;IF NOT BETWEEN 0 AND 8 INCLUSIVE
JRST,ERR
IMULI T,3 ;AMOUNT OF STG PER BREAKPOINT
ADDI T,B1ADR-3 ;MAKE T POINT TO STG AREA OF SPECIFIED BREAKPOINT
TRZN F,2
JRST MASK2 ;LOCATION NOT SPECIFIED, TREAT AS SYM
EXCH R,T ;R NOW IS POINTER TO BP STG AREA, T SPECIFIED LOCATION
JRST BPS5
;LOC$B
BPS3: MOVEI R,B1ADR
BPS4: HRRZ W,(R) ;GET BPN LOCATION
CAIE W,(T) ;IF SPECIFIED LOCATION,
SKIPN (R) ;OR IF ZERO,
JRST,BPS5 ;THEN USE IT,
ADDI R,3 ;OTHERWISE INCREMENT R TO POINT TO STG OF NEXT BPT
CAIG R,BNADR ;SKIP IF TOO MANY
JRST,BPS4 ;GO LOOK AT NEXT ONE
JRST,ERR ;ALL FULL
BPS5: MOVEM T,(R) ;SET BP TO SPECIFIED LOCATION (0 MEANS NOT IN USE)
CLEARM,1(R)
CLEARM,2(R)
AUTOP: SUBI R,B1ADR ;NOW MUNG R,
IDIVI R,3 ;INTO BP NUMBER
MOVEI S,1
LSH S,1(R) ;C(S):=1_<1+BP#>
ANDCAM S,AUTOPI
TLNE F,CCF
IORM S,AUTOPI ;ALTMODE ALTMODE TYPED MEANS BPT ENCOUNTER => TYPE MESSAGE
;BUT CONTINUE (UNTIL CHARACTER TYPED AT TTY)
POPJ P,
IFN KS1PR,[
OIPBIT==:1000
1PRCNT: 0 ; If > 0, one-proceeding is going on
1POADR: 0 ; 0 or address of usurped UPT1PO
1PNSV: 0 ; Saved contents of usurped UPT1PN
CTLN: TLNE F,CF\CCF
JRST ERR ; No  or  support
TLNN F,QF
MOVEI T,1 ; Argument defaults to 1
JUMPLE T,ERR
MOVEM T,1PRCNT
NTS,[
RDUBR R
MOVEI R,UPT1PO(R)
];NTS
TS, MOVEI R,44 ; Just a kludge for debugging under TS
MOVEM R,1POADR ; Commence usurpation
SKIPN T,ALTPC
SOS T,BCOM
TLO T,OIPBIT
MOVEM T,ALTPC1
SETZM ALTPC
PUSHJ P,CRF
PUSHJ P,TTYLEV
PUSHJ P,INSRTB ; First, insert all breakpoints
MOVE R,ALTPC1
PUSHJ P,FETCH ; Then take a look at the next instruction
JRST CTLN1 ; (oh well, just punt)
CAML T,[JSR BP0] ; Is it a breakpoint of some sort?
CAMLE T,[JSR BPN]
JRST CTLN1 ; Nope, get going
MOVE T,B1INS-BP1(T) ; Yeah, clobber it back again
PUSHJ P,DEP
CTLN1: JSP T,RESTORE
1PRTR1: MOVE T,AC0+T ; (redundant if you fall in)
JRST 2,@ALTPC1
1PRTRP: SOSG 1PRCNT
JRST 1PRBRK
MOVEM T,AC0+T
MOVE T,@1POADR
TLO T,OIPBIT
MOVEM T,ALTPC1
MOVE T,AC0+T ; In case executing in ACs!
MOVE T,@ALTPC1 ; Peek at the next instruction
CAML T,[JSR BP0] ; Is it a breakpoint of some sort?
CAMLE T,[JSR BPN]
JRST 1PRTR1 ; Nope, get going
MOVE T,AC0+T ; Yup, abandon stepping
1PRBRK: JSR SAVE
PUSHJ P,BRKRET
MOVE T,@1POADR
SETZM 1POADR ; Cease usurpation
MOVEM T,ALTPC
HLLM T,SAVPI
SKIPLE 1PRCNT ; Abandoned because of breakpoint?
JRST PROCED ; Yes, proceed into breakpoint
MOVEI T,"> ; No, go tell user where we stopped
PUSHJ P,TOUT
PUSHJ P,TOUT
.ERR Shouldn't leave location open after 1-proceed
HRRZ T,ALTPC
PUSHJ P,PLOC
PUSHJ P,LI1
JRST RET
];KS1PR
IFN 1PRSW,[
;CONTROL-N
CTLN: TLZN F,CF
JRST ONEPRO
MOVE T,BCOM
HRLI T,1(T)
TLZE F,QF
MOVE T,WRD ;T HAS TB2ADR,,TB1ADR
HRRZM T,TB1ADR
HLRZM T,TB2ADR
JRST PROCEDE
ONEPRO: JRST ERR ;NOT HACKED YET
];1PRSW
IFNDEF CTLN, CTLN==:ERR
DEPRS: MOVEM T,LWT(I)
DEPR: MOVE R,LLOCO ;QUAN TYPED IN REGIS EXAM
TLZE F,ROF
TLNN F,QF
POPJ P,0
DEP: TRNN R,777760
JRST DEP1 ;BPT LOCATION IS AN ACCUMULATOR
MOVEM T,0(R)
POPJ P,0
DEP1: MOVEM T,AC0(R)
POPJ P,0
FETCH: MOVE T,HIGH
CAIGE T,(R)
POPJ P,
MOVE T,(R)
TRNN R,777760
MOVE T,AC0(R)
JRST CPOPJ1
FIRARG: MOVEM T,DEFV
TLO F,FAF
JRST,ULIM1
ULIM: TLO F,SAF
HRRZM T,ULIMIT
ULIM1: TLNE F,CF
JRST OVRD
TLNN F,QF
JRST,ERR
JRST,LISB
LOOK: SETZB W1,S
MOVSI W1,DELI+DELO
MOVE R,PRGM
MOVEM R,PRGM(I)
MOVSI W2,PNAME
SKIPGE T
MOVSI S,400000
MOVE W,[444400,,ENDT]
MOVEM W,TEM(I)
LEND1A: ILDB W,TEM(I)
MOVEM W,LLUP1
JRST LLUP1
ENDT: TDNN W2,(R)
TLO W1,LOCAL
SKIPL R
MOVE R,@JOBSYM
CAMN R,PRGM(I)
TLZA W1,-1
LLUP: ADD R,[2,,2]
LLUPI1: JRST LLUP1 ;OR TRNA
dpy340,[
PUSHJ P,DPYSWP
CONSZ DIS,200
JRST LLUPD
];dpy340
LLUP1: 0
JRST LEND1
CAML T,1(R)
CAML S,1(R)
JRST LLUP
HLRZ W,W1
TSNN W,(R)
TDNN W2,(R)
JRST LLUP
HRR W1,R
CAMN T,1(R)
JRST SPT
MOVE S,1(R)
JRST LLUP
dpy340,[
LLUPD: BLKO DIS,DISPTR
PUSHJ P,RECYC
CJLP1: JRST LLUP1
];dpy340
LEND1: AOS W,TEM(I)
XCT (W)
JRST LEND1A
LOOK1: MOVEM T,TEM(I)
TRNE W1,-1
SUB T,S
JRST CPOPJ1
CONSYM: MOVEM T,LWT(I)
CONSM: TRNN F,LF1
CONS1: JRST @SCH
TRNE F,CF1
JRST, FTOC
PIN: TRZ F,NAF
PUSHJ P,OPTYPE ; Look it up in the opcode table first
TRNE F,1RF ; Anything typed?
JRST PI3.1 ; Yes: proceed
MOVE T,LWT(I)
TLNN T,777000 ; Opcode 0?
JRST PI3+1 ; Yes: skip this stuff
TLC T,700000
TLCN T,700000 ; Traditional IO instruction?
JRST INOUT ; Yes: Go do it that way
PUSHJ P,LOOK ; No: look it up
;Used to be:
; TLC T,700000
; TLCN T,700000
; JRST,INOUT
; PUSHJ P,OPTYPE
; MOVSI T,777000
; AND T,LWT(I)
; JUMPE T,PI3+1
; TRNN F,1RF
; PUSHJ P,LOOK
PI3.1: TROA F,NAF
JRST HLFW
PI3: PUSHJ P,TSPC
LDB T,[(270400)LWT(I)] ;AC
JUMPE T,PI4
PUSHJ P,PAD
PI3A: XCT ",,CRF
PI4: MOVE W1,LWT(I)
MOVEI T,"@ ;AT SIGN
TLNE W1,20 ;CHECK FOR INDIRECT BIT
PUSHJ P,TOUT
PI5: HRRZ T,LWT(I)
LDB W1,[(331100)LWT(I)]
CAIL W1,240
CAILE W1,247
PUSHJ P,SPAD
PUSHJ P,PADS3A
PI7: TRZ F,NAF
LDB R,[(220400)LWT(I)] ;INDEX REGISTER CHECK
JUMPE R,PADS1 ;EXIT
PI7.1: XCT "(,CRF
MOVE T,R
PUSHJ P,PAD
MOVEI T,")
JRST,TOUT ;EXIT
HLFW: TRO F,NAF
HLRZ T,LWT(I)
PUSHJ P,PAD
XCT ",,CRF
XCT ",,CRF
SKIPA T,LWT(I)
SPAD: AOS (P)
PAD: ANDI T,777777 ;PRINT ADDRESS
JRST @AR ;PADSO OR PAD1
PADSO: JUMPE T,TOC2+1
PUSHJ P,LOOK
PADS1: POPJ P,0
MOVE W2,1(W1)
CAIGE T,100
CAIGE W2,60
JRST,PADS3
MOVEM T,TEM(I)
JUMPE W1,PAD1
PUSHJ P,SPT
XCT "+,CRF
PADS2: HRRZ T,TEM(I)
PAD1: JRST,TOC ;EXIT
PADS3: MOVE T,TEM(I)
PADS3A: TRNE F,NAF
CAIGE T,776000
JRST TOC
PADS3B: MOVNM T,TEM(I)
PADS4: XCT "-,CRF
JRST,PADS2
INOUT: TDC T,[(,-1)400000]
TDCN T,[(,-1)400000]
JRST PADS3B
HLRZ R,T
CAILE R,(CONO 774,@)
JRST HLFW
AND T,[(700340)]
PUSHJ P,LOOK
JRST,.+2
JRST,HLFW
PUSHJ P,TSPC
MOVE T,LWT(I)
AND T,[(77400)]
INOUT1: JUMPE T,PI4 ;USED BY "WORD"
PUSHJ P,LOOK ;LOOK FOR DEVICE NUMBER
JRST,PI3A
MOVE T,TEM(I)
LSH T,-30
PUSHJ P,TOC
JRST,PI3A
MASK: TLNE F,QF
JRST,MASK1
MOVEI T,MSK
;$NB ENTRY (WHERE N SPECIFIED, LOCATION NOT)
MASK2: MOVEI W,1
MOVEM W,FRASE1
JRST QUAN1
MASK1: MOVEM T,MSK
JRST,RET
OVRD: MOVSI B,-5
OVRD1: MOVE R,MSKTB(B)
AND R,LWT(I)
TDNN T,MSKTB(B)
IOR T,R
AOBJN B,OVRD1
OVRD2: CLEARM FRASE
TLZ F,TIF
CLEARM WRD
JRST MASK2
MSKTB: 777000,,
0 17,0
@
(17)
,-1
EFFEC: TLO F,LTF
HRRZ T,T
AWORD: SKIPA W,INOUT1 ;JUMPE T,
NWORD: MOVSI W,(JUMPN T,)
HLLM W,SEAR2
SEARC: TLZN F,QF
JRST,ERR
SETCAM T,WRD
MOVE T,[EQV T,WRD]
TLNE F,LTF
MOVE T,[JRST SEAR2B]
MOVEM T,SEARMD
MOVSI T,-5
SETCMM FRASE(T) ;PREVENT TYPEOUT
AOBJN T,.-1
MOVE T,ULIMIT
TLNE F,SAF
TLO F,QF
PUSHJ P,SETUP1
PUSHJ P,CRF
SEAR1: TRNN R,777760 ; Looking at ACs?
JRST SEAR1A ; Yes: Be slow
MOVE T,(R) ; No: Be fast
SEAR1B:
SEARMD: EQV T,WRD
AND T,MSK
SEAR2: JUMPE T,SEAR3 ;OR JUMPN T
SEAR2A: TRNN R,77 ; LISTEN every 100 times
JRST SEAR2D
SEAR2E: AOBJN R,SEAR1 ; Loop until LH positive...
TLNE R,-1 ; And just how did that happen?
JRST SEAR1 ; It was already positive
SEAR2C: SETCMM LWT(I) ; Counted up to 0: Done
JRST,DD1
SEAR2D: PUSHJ P,LISTEN
JRST SEAR2E
JRST SEAR2C
SEAR1A: PUSHJ P,FETCH
JRST SEAR2A
JRST SEAR1B
SEAR2B: PUSHJ P,EFFEC0
JRST SEAR2A
EQV T,WRD
ANDI T,777777
JRST SEAR2
SEAR3: PUSHJ P,FETCH
JRST ERR
MOVEM T,LWT(I)
MOVEM R,TEM2
MOVEM R,T
HRRZM R,LLOCO
PUSHJ P,PLOC
PUSHJ P,PAD
XCT "/,CRF ;SLASH
PUSHJ P,LCT
MOVE T,LWT(I)
PUSHJ P,CONSYM
PUSHJ P,CRF
SETCMM LWT(I)
SETCMM TEM(I)
SEAR4: MOVE R,TEM2
JRST, SEAR2D
EFFEC0: MOVEM R,TEM2 ;CALLED BY SEARCH AND $\
MOVEI W,100
MOVEM W,TEM(I)
EFFEC1: MOVE W,T
LDB R,[(220400)T]
JUMPE R,EFFEC2
HRRZ T,AC0(R)
ADD T,W
EFFEC2: HRR R,T
TLNN W,20 ;INDIRECT BIT CHECK
JRST EFFEC3
SOSE TEM(I)
PUSHJ P,FETCH
JRST EFFEC4
JRST EFFEC1
EFFEC3: AOS (P)
EFFEC4: MOVE R,TEM2
POPJ P,
SETUP: TLO F,LTF ;ZERO
SETUP1: MOVEI T,1(T)
TLNN F,QF
SETUP2: HRRZ T,ESTU
HRRM T,ULIMIT
HRRZ R,DEFV
TLNN F,FAF
MOVEI R,0
CAML R,ULIMIT
JRST ERR
MOVEM R,DEFV
MOVE W,R
SUB W,ULIMIT
HRLM W,R
POPJ P,0
ZERO: JUMPGE F,ERR
PUSHJ P,SETUP
ZERO1: TRNE R,777740 ;R AOBJN PNTR TO CORE TO CLEAR
JRST,ZERO2 ;T UPPER LIMIT (LAST LOC TO CLEAR+1)
TRNN R,20 ;DONT Z 20-37
CLEARM,AC0(R)
AOBJN R,ZERO1
TLNE R,-1
JRST ZERO1
JRST,DD1A
ZERO2: HRRZ S,@JOBSYM ;ONLY CLEAR CORE BELOW SYMBOL TABLE
CAILE T,(S) ;(JUST ASSUME IT'S A MOBY DDT)
MOVEI T,(S)
SETZM (R)
HRLS R
AOS R
BLT R,-1(T)
; HRRZ S,T
; HRRZ W,@JOBSYM
; CAIL S,(W)
; MOVEI S,(W)
; CAILE S,(R)
; JSP W,ZEROR
; HRRZ R,R
; CAIG R, PS
; MOVEI R, PS
; HRRZ S,T
; CAMLE S, R
; JSP W,ZEROR
JRST,DD1A
;ZEROR: HRL R,R
; CLEARM,(R)
; ADDI R, 1
; BLT R, -1(S)
; JRST,(W)
FTOC:
TOC: HRRZ W1,ODF
CAIN W1,12
JRST, TOC4
TOCA: LSHC T,-43
LSH W1,-1 ;W1=T+1
TOC1: DIVI T,@ODF
HRLM W1,0(P)
TOC3: JUMPE T,TOC2
PUSHJ P,TOCA
TOC2: HLRZ T,0(P)
ADDI T,"0
CJTOUT: JRST,TOUT ;DOES POPJ TO TOC2 OR EXIT
TOC4: MOVM W1,T
JUMPGE T,TOC5
XCT "-,CRF
TOC5: MOVEI T,0
PUSHJ P,TOC1
TPER: MOVEI T,".
JRST TOUT
SPT: MOVE T,CJTOUT
MOVEM T,SPTS(I)
MOVE T,0(W1) ;SYMBOL PRINT
MOVEM W1,DSSAV(I)
TLZ T,740000
SPT1: IDIV T,[50*50*50*50*50]
PUSHJ P,SPT2
MOVE T,W1
IMULI T,50
JUMPN T,SPT1
POPJ P,
SPT2: ADDI T,260-1
CAILE T,271
ADDI T,301-272
CAILE T,332
SUBI T,334-244
CAIN T,243
MOVEI T,256
XCT SPTS(I)
POPJ P,
BRKRET: PUSHJ P,REMOVB
TTYRET:
dpy340,[
CONI DIS,T
DPB T,[600,,DRESET]
];dpy340
IFN LPTP,[
CONI LPT,T
DPB T,[300,,LPTRST]
SKIPE LPTFLG
CONO LPT,10
]
TTYRT: MOVEI T,10
dpy340, MOVSM T,DISDON
ka,[
CONI TTY,SAVTTY
CONO TTY,400000(T)
];ka
dpy340, PUSHJ P,DISINI
XCT TTYRT
TTY1:
ka,[
MOVEI W2,40000 ;WAIT FOR LAST CHR TO BE TYPED (SO LOSERS PRGM DOESNT
CONSZ TTY,120 ;GET AN INTERRUPT..
SOJG W2,.-1
CONI TTY,W2
XOR W2,SAVTTY
ANDI W2,10 ;ATTEMPT TO RESTORE STATE OF OUTPUT DONE FLAG
XORM W2,SAVTTY
DATAI TTY,W2
HRLM W2,SAVTTY
CONO TTY,3400(T)
; CONO TTY,400000(T) ;MORE PDP6 TK KLUDGE WINNAGE
];ka
POPJ P,
TTYLEV:
dpy340,[
MOVS T,DISDON
CAIN T,@TTYRT
JRST .+3
DRESET: CONO DIS,100
DATAO DIS,[3000]
];dpy340
IFN LPTP,[
SKIPE T,LPTRST
CONO LPT,10(T)
]
ka,[
MOVE T,SAVTTY
ANDI T,17
TRNN T,10
TRO T,200
];ka
JRST TTY1
subttl variable area
WRD: 0
WRD2: 0
PRNC: 0
FRASE: 0
SYL: 0
DEN: 0
ZLWT: 0
TEM2: 0
LPTRST: 0
LPTFLG: 0
TTYFLG: -1
ESTU: LOW
ESTUT: LOW
FSV: 0
FRACT: 0
FPWR: 0
FTERM: 0
FH: 0
;FL: 0
SYM: 0
DEFV: 0
ULIMIT: 0
LLOC: 112 ;CURRENT LOCATION
LLOCO: 0
PLCR: 0
LOCBF: BLOCK NLEVS
DIS1:
ACSTG: BLOCK 10
INST: 0
LWT: 0
TEM: 0
TEM1: 0
PRGM: -NSYMS+2,,LOW+2
DSSAV: SYM
OUTSW: 0
SPTS: JRST TOUT
ALTPC: 0 ;NON-ZERO MEANS ALT-P JUMPS THERE
ALTPC1: 0
dpy340,[
DISSW: MOVE T,@-1(P)
];dpy340
SATPP: .+1
SATPT: 0
dpy340,[
DIS2:
DISACS: BLOCK DIS2-DIS1-6
SYM
DISAD
JRST TOUT
MOVSI T,(TRNA#CONSZ#CONSO)
.+1
0
];dpy340
HIGH: MEMSIZ-1
SAVPI: 0
1177
SAVTTY: 0
MSK: -1 ;INITIAL MASK FOR WORD SEARCHES
B0ADR: REPEAT 3,0 ;FOR $0B, MUST BE SPECIFIED TO BE USED (NOT SET BY
; LOC$B, NOT CLEARED BY $B)
B1ADR: 0
B1SKP: 0
B1CNT: 0 ;ONE MORE THEN # TIMES TO IGNORE ENCOUNTER OF THIS BPT
REPEAT NBP*3-3, 0
IFN 1PRSW,[
TB1ADR: 0 ? 0 ? 0
TB2ADR: 0 ? 0 ? 0
];1PRSW
BNADR=.-3
AUTOPI: 0 ;1_N ON IF LOC$$B TYPED, ON MEANS PRECEED AFTER
; TYPING BPT MSG, UNTIL CHAR. TYPED AT TTY
INFORM SAVED ACS AREA,\. ;FOR CRASH XFILE
AC0: BLOCK 17
AC17: 0
SWAP,TWENTY: BLOCK LOWFIX-20 ;DON'T MOVE FROM HERE
SCH: 0
AR: 0
ODF: 0
SCHM: PIN ;THESE 3 LOCATIONS BLT'D INTO PRECEDING 3 LOCATIONS DURING SAVE
ARM: PADSO
ODFM: 10
SARS: 0 ;NON-ZERO IF STUFF SAVED (USED BY SAVE)
FRASE1:
TEM3: 0
INSW: 0
dpy340,[
DISCNT: 0
DISPN1: 0
];dpy340
subttl save
SAVE: 0
SKIPN SARS ;IF CRUD NOT ALREADY SAVED,
JRST SAV1 ;THEN GO SAVE IT,
AOS SAVE ;OTHERWISE AOS RETURN POINT,
JRST SAV5 ;AND SAVE MINIMALLY
SAV1:
NTS,[
CONI PRS,SAVPI
CONO PRS,@SAVPI+1
];NTS
MOVEM 17,AC17
HRRZI 17,AC0
BLT 17,AC0+16
MOVE T,SAVE
HLLM T,SAVPI
SAV5: SETOM SARS ;INDICATE CRUD SAVED
MOVEI P,PS ;INITIALIZE PDL POINTER
MOVE F,[SCHM,,SCH]
BLT F,ODF
CLEARB F,I ;CLEAR FLAGS AND I
JRST @SAVE
;SEE LOW CODE FOR RESTORE
TATP: TLZE F,QF
SKIPN T
JRST ERR
MOVEI W,36.
DPB T,[300600,,SATPP]
dpy340, DPB T,[300600,,SATPP+DIS2-DIS1]
IDIV W,T
MOVEM W,SATPC
JRST RATP
SATP: MOVEI W,44
DPB W,[360600,,SATPP(I)]
MOVE W,SATPC
MOVEM T,SATPT(I)
SATPL: ILDB T,SATPP(I)
PUSHJ P,TOC
PUSHJ P,TSPC
SOJG W,SATPL
POPJ P,
SATPC: 0
subttl command dispatch table
BDISP: (301400+R)DISP
(141400+R)DISP
(1400+R)DISP
DISP: .BYTE 12.
DEFINE ZD A,B,C
A-DDT
B-DDT
-DDT+C
TERMIN
ZD ERR,ERR,L2 ;
ZD DS,ERR,L2 ;^C,,
ZD LISTF0,ERR,ERR ;,,
ZD TAB,LINEF,ERR ;TAB,LF,
ZD ERR,CARR,CTLN ;FORMF,CR,
ZD ERR,ERR,ERR ;,,
ZD ERR,ERR,ERR ;,,
ZD ERR,L2,L2 ;,,
ZD ERR,ERR,ERR ;,,
ZD CONTROL,ERR,ERR ;,^\,^]
ZD ERR,ERR,SPACE ;^^,^_,SP
ZD DIVD,DQUOTE,ASSEM ;!,",#
ZD DOLLAR,PERC,R50PNT ;$,%,&
ZD SQUOTE,LPRN,RPRN ;',(,)
ZD MULT,PLUS,ACCF ;*,+,,
ZD MINUS,PERIOD,SLASH ;-,.,/
ZD NUM,NUM,NUM ;0,1,2
ZD NUM,NUM,NUM ;3,4,5
ZD NUM,NUM,NUM ;6,7,8
ZD NUM,TAG,DEFIN ;9,:,;
ZD FIRARG,EQUAL,ULIM ;<,=,>
ZD ASLASH,INDIRECT,ABSA ;?,@,A
ZD BPS,CON,SDEC ;B,C,D
ZD EFFEC,SFLOT,GO ;E,F,G
ZD HWRDS,PILOC,ERR ;H,I,J
ZD KILL,LOAD0,MASK ;K,L,M
ZD NWORD,SOCT,PROCEDE ;N,O,P
ZD QUAN,RELA,SYMBOL ;Q,R,S
ZD TATP,DECDMP,DISF ;T,U,V
ZD AWORD,XEC,DUMP0 ;W,X,Y
ZD ZERO,OCON,ICON ;Z,[,\
ZD OSYM,VARRW,PSYM ;],^,_
.BYTE
DECDMP:
ka,[
CONSZ TTY,20 ;ALLOW LAST CHAR TYPED TO APPEAR ON PAPER SO CANT BE CLOBBERED
dpy340, PUSHJ P,DISCFT ;BY IO RESET
nodpy, JRST .-1
];ka
KL,[ CONSO PAG,600000 ;FLUSH CACHE IF NECC.
JRST MACDMP
SWPUA
CONSZ 200000
JRST .-1
CONO PAG,0
]
JRST MACDMP
IFIX: SKIPLE T,JOBSYM ;IF JOBSYM POSITIVE,
JRST DDT ;THEN CONTROL SHOULDN'T HAVE COME TO HERE TO BEGIN WITH
MOVE R,(T) ;GET POINTER TO SYMS
JUMPN T,IFIX1 ;JUMP IF SYMS ADDED
MOVE R,KILC ;INITIAL SYMS POINTER
MOVEM R,DDT-2 ;SET UP SYM POINTER
MOVEI T,DDT-2
IFIX1: HRRZM T,JOBSYM ;INDICATE LOCATION OF SYMS POINTER
HRRZM R,ESTU
HRRZM R,ESTUT
MOVSI T,PNAME
TDNN T,(R)
ADD R,[(2)2]
MOVEM R,PRGM
; CONI TTY,T ;THIS HACK IS FOR THE KNIGHT MULTIPLE TTY KLUDGE ON THE PDP6!!
; ANDI T,170000 ;MAY IT REST IN PEACE
; IORI T,10
; HRRM T,TTYRT ;CONO TO TTY
JRST DDT
CONSTANTS
DDTEND:
INFORM [HIGHEST USED]\.-1
END DDT
Reference in New Issue View Git Blame Copy Permalink