github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-05-01 14:06:28 +00:00
Code Issues Releases Wiki Activity
Files
f520cef6b9c426d37fd1384d1e8a842c0f5ac5db
PDP-10.its/src/rug/ar.632
Lars Brinkhoff e42a52c411 AR - RUG for Logo PDP-11/45.
2018-08-12 07:09:40 +02:00

6116 lines
110 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.
%ABSAD==1
%COMPA==0
;THIS IS THE WAY RUG LOOKS WHEN IT IS IN CORE (WHEN IT ISN'T CLOBBERED)
;THE SYMBOL TABLE EXTENDS DOWN TOWARDS CSTBL
;IT MEETS RUGS SYMBOLS AT RUGFNT (WHERE RUG BEGINS)
;AND CONTINUES TO O.BSYM
;RUGS STACK SITS ABOVE THAT FOLLOWED BY
;ITS COPY OF THE USERS REGISTERS AND
;THE BREAKPOINT TABLES
;NOW COMES THE BODY OF RUG
;THE CONSOLE PROGRAM AND ABSOLUTE LOADER ARE IN HERE SOMEWHERE
;AND LAST OF ALL THE RESIDENT PORTION OF RUG SITS AT THE VERY TOP
;DEFINE A BUNCH OF FLAGS
.IF1
.MACRO SETF TEXT,FLG
.PRINT "TEXT
FLG'="
.TTYMAC FLAG
FLG==FLAG
.ENDM
.ENDM
SETF ^\0=>GUY45, 1=>LOGO45, 2=>TV20, 3=>FREDKIN 11/40, 4=>OTHER\,COMPUTER
.IFZ COMPUTER
.TITLE RUG FOR GUY'S LOGO 11/45
TEN11==0
FMH==1
HCOR==160000
CSTBL==30000
F.HD==0
DM11==0
KL11==0
M.HD==1
FPTR==1
M1145==1
FPP==1
DCSPD==11
LINEAD==174000
M1140==0
M40FPU==0
.ENDC
.IFZ COMPUTER-1
.TITLE RUG FOR THE LOGO 11/45
TEN11==1
FMH==1
HCOR==160000
CSTBL==30000
F.HD==0
DM11==0
KL11==0
M.HD==1
FPTR==1
M1145==1
FPP==1
DCSPD==31
M1140==0
M40FPU==0
LINEAD==174000
.ENDC
.IFZ COMPUTER-2
.TITLE RUG FOR THE TV 11/20
TEN11==0
FMH==0
HCOR==60000
CSTBL==20000
F.HD==1
DM11==0
KL11==0
M.HD==0
FPTR==0
M1145==0
FPP==0
DCSPD==0
LINEAD==174000
M1140==0
M40FPU==0
.ENDC
.IFZ COMPUTER-3
.TITLE RUG FOR THE FREDKIN 11/40
TEN11==0
FMH==1
HCOR==160000
CSTBL==30000
F.HD==0
DM11==0
KL11==0
M.HD==1
FPTR==1
M1145==0
FPP==0
DCSPD==0
M1140==1
M40FPU==1
LINEAD==175610
.ENDC
.IFZ COMPUTER-4
.TITLE RUG FOR SOMETHING OR OTHER
SETF ^\1=>FIXED DISK, 0=>NONE\,F.HD
SETF ^\1=>DM11, 0=>NONE\,DM11
SETF ^\1=>USE FIRST KL11, 0=>USE CONSOLE TTY\,KL11
SETF ^\1=>MOVING DISK, 0=>NONE\,M.HD
SETF ^\1=>FAST READER, 0=>CONSOLE READER\,FPTR
SETF ^\1=>FLOATING POINT, 0=>NONE\,FPP
SETF ^\1=>11/45, 0=>11/20\,M1145
SETF ^\1=>11/40, O=>NOT\,M1145
SETF ^\1=>11/40 FLOATING POINT, 0=>NONE\,M40FPU
SETF ^\CORE SIZE IN BYTES\,HCOR
SETF ^\ADDRESS OF BOTTOM OF SYMBOL TABLE\,CSTBL
SETF ^\0=>TRACK DUMP 1=>FILE DUMP\,FMH
SETF ^\DC11 SPEED SET (0, 1, 11 , 21 OR 31)\,DCSPD
SETF ^\TEN/11 INTERFACE\,TEN11
SETF ^\LINE INTERFACE ADDRESS\,LINEAD
.ENDC
.MACRO PFLAG NAME,VAL
.PRINT /NAME'='VAL
/
.ENDM
PFLAG TEN11,\TEN11
PFLAG F.HD,\F.HD
PFLAG DM11,\DM11
PFLAG KL11,\KL11
PFLAG M.HD,\M.HD
PFLAG FPTR,\FPTR
PFLAG FPP,\FPP
PFLAG M1145,\M1145
PFLAG M1140,\M1140
PFLAG M40FPU,\M40FPU
PFLAG HCOR,\HCOR
PFLAG CSTBL,\CSTBL
PFLAG FILE DUMP,\FMH
PFLAG LINE ADDRESS,\LINEAD
PFLAG DC SPEED,\DCSPD
.ENDC
.IFZ M1145!M1140
RUGFNT=HCOR-22000
.IFF
RUGFNT=HCOR-40000
.ENDC
;RUG SYMBOLIC DEBUGGER
;RUG NEEDS THESE DISK BLOCKS RESERVED ON THE FIXED HEAD DISK
;THE SAME BLOCKS NEEDED ON THE MOVING HEAD DISK
;0,4-23, AND 54-217
.MACR MVAD AAX,BBX
BBX==<<<AAX/400>&377>/14>*20-<<<AAX/400&377>/14>*14>+<AAX/400>&377
.ENDM
.MACR MVADD AAX,BBX,CCX
.IFGE AAX&17+BBX&17-14
CCX==AAX+BBX+4
.IFF
CCX==AAX+BBX
.ENDC
.ENDM
.MACR MVBAD AAX,BBX ;CONVERT BLOCK NUMBER TO MOVING DISK ADDRESS
BBX==<<2*AAX>/14*20>+<2*AAX>-<<2*AAX>/14*14>
.ENDM
A=%0 ; REGISTER
B=%1 ; NAMING
C=%2 ; CONVENTIONS
D=%3
E=%4
F=%5
P=%6
SP=%6
PC=%7
PSW=177776 ;STATUS REGISTER
.XCREF A,B,C,D,E,F,P,SP,PC
O.BPT==10 ;NUMBER OF BREAKPOINTS
O.BKP==O.BPT+O.BPT-2 ;NUMBER OF BREAKPOINTS-1 MULT. BY 2
O.STM==340 ;PRIORITY MASK - STATUS REGISTER
O.TBT==20 ;T-BIT MASK - STATUS REGISTER
.IFZ KL11
O.RDB=177562 ;R DATA BUFFER
O.RCSR=177560 ;R C/SR
O.TDB=177566 ;T DATA BUFFER
O.TCSR=177564 ;T C/SR
.ENDC
TTP50=100060
.IFNZ KL11
O.RDB=176502
O.RCSR=176500
O.TDB=176506
O.TCSR=176504
.ENDC
DAE=177470
DAR=177466 ;DISC ADDRESS (WORDS)
CMA=177464 ;CURRENT MEMORY LOC-2
WC=177462 ;-WORDCOUNT (WORDS)
DCS=177460 ;DISC CNTL AND STATUS
L.SR=177570
L.DEV=DEVICE
;THESE ARE RUGS CRUMBLING DISK ADDRESSES
INVRG=4000 ;WHERE 'INVIOLATE COPY OF RUG STARTS ON DISC
INVRGL=<HCOR-RUGFNT>/2 ;LENTH OF INVIOLATE COPY OF RUG
.IFZ FMH
SPRG=INVRG+INVRGL ;WHERE SWAPPING PROGRAM STARTS
.IFF
SPRG=54000
.ENDC
SPRGL=<RUGST/2>&77777 ;LENTH OF SWAPPING PROGRAM ON DISC
SPRGLE=<HCOR/2>&77777 ;ROUNDED OFF LENTH JUST FOR NICENESS OF ADRESSES
SSTBL=SPRG+SPRGLE ;WHERE SWAPPING SYMBOL TABLE STARTS
SSTBLL=<<RUGST-CSTBL>/2>&77777 ;LENTH OF SWAPPING SYMBOL TABLE
;INCLUDES VOLATILE COPY OF RUG
SSTBUL=<RUGFNT-CSTBL>/2 ;THIS IS LENGTH OF USER'S SYMBOL TABLE
SSTBLE=<<HCOR-CSTBL>/2>&77777 ;LENTH OF SYMBOL TABLE IN ROUNDER NUMBERS
;SSTBLL IS FROM CSTBL TO
;END OF DEBUGGER SO EVERYTHING SWAPPED
TRKS=SSTBL+SSTBLE ;WHERE TRACKS ON FIXED HEAD DISC START
TRKL=SPRGLE+SSTBLE-INVRGL ;LENTH OF TRACKS
.IFNZ F.HD
DSKBSZ=40 ;DISK BLOCK SIZE
SSTBLB=SSTBL+<SSTBUL&<-DSKBSZ>>;LAST BLOCK OF
.ENDC ;SYMBOL TABLE
.IFZ F.HD
MVAD SPRGL,MSPRGL
MVAD SPRGLE,MSPGLE
MVAD SSTBLL,MSSTLL
MVAD SSTBLE,MSSTLE
MVAD INVRGL,MVIRGL
.IFZ FMH
LOWAD=250 ;LOWEST DAR OF MOVING HEAD DISK
MVADD LOWAD,MVIRGL,SPRG
MVADD SPRG,MSPGLE,SSTBL
MVADD SSTBL,MSSTLE,TRKS
.IFF
MVBAD 4,LOWAD
MVBAD 54,SPRG ;START OF CORE IMAGE
MVBAD 144,SSTBL ;START OF SYMBOLS
DSKBSZ=400 ;SIZE OF MOVING DISK SECTORS
MVAD <SSTBUL&<-DSKBSZ>>,SSTBLB ;LAST BLOCK OF SYMBOL TABLE
MVADD SSTBLB,SSTBL,SSTBLB
.ENDC
.ENDC
MVFO2=SSTBUL&<DSKBSZ-1> ;HOW FAR SYMBOL TABLE EXTENDS INTO LAST BLOCK
MVAD TRKL,MTRKL
.IFNZ M.HD
MTL=MTRKL
RKDS=177400
RKCS=177404
RKWC=177406
RKBA=177410
RKDA=177412
.ENDC
EOT==66
TTP50=100060
BUF3=1000
BUF3B=2000
DMCSR=175000
MASK=377
BMASK=777
DNTTYP==176 ;THE NULL CHAR
.IFNZ M1145
THHCOR=0 ;0, 1, 2 OR 3
LHHCOR=160000
STACKR=-4
SSR0=177572
SSR3=172516
XTCR=TRKS
;START OF EXTRA CORE ON DISK
.XTCR=<XTCR_-2>&37777 ;LOCATION ON DISK SHIFTED TO ADD IN 16 BIT QUANTITIES
COR=<<THHCOR_13.>&60000>+<<LHHCOR_-3>&17777>
.XTCRL=COR-<SPRGLE_-2>&67777 ;LENTH OF CORE MORE THAN 28K
THXTCL=<.XTCR_14.>&3 ;TOP HALF OF PROPERLY SHIFTER EXTRA CORE LENTH
LHXTCL=<.XTCR_2>
.TRKS=.XTCR+.XTCRL
THTRKS=<.TRKS_14.>&3
LHTRKS=.TRKS_-2
KIDR0=172300 ;CAN BE REMOVED BY REPLACING WHERE THEY ARE USED ***
SIDR0=172200
UIDR0=177600
KDDR0=172320
SDDR0=172220
UDDR0=177620
KIAR0=172340
SIAR0=172240
UIAR0=177640
KDAR0=172360
SDAR0=172260
UDAR0=177660
.ENDC
;TOP AND LOW HALF OF HIGHEST CORE LOC
KILCHR=23 ;OCTAL 23 IS ^S
;THESE MACROS ALLOW EASY CALLING OF MULTIPLY AND DIVIDE ROUTINES
;MLTPLY A,B,C DOES C_A*B, DIVIDE A,B,C,D DOES C_A/B AND D_REMAINDER
;MLTPLY SCRTCH,E,SCRTCH OR DIVIDE SCRTCH,E,SCRTCH,E ASSEMBLE NO OVERHEAD
.MACRO MLTPLY A,B,C
.IF DIF A,SCRTCH
MOV A,SCRTCH
.ENDC
.IF DIF B,E
MOV B,E
.ENDC
JSR PC,MULT
.IF DIF C,SCRTCH
MOV SCRTCH,C
.ENDC
.ENDM
.MACRO DIVIDE A,B,C,D
.IF DIF A,SCRTCH
MOV A,SCRTCH
.ENDC
.IF DIF B,E
MOV B,E
.ENDC
JSR PC,DIVD0
.IF DIF C,SCRTCH
MOV SCRTCH,C
.ENDC
.IF DIF D,E
MOV E,D
.ENDC
.ENDM
;THIS IS THE SYMBOL TABLE WHICH RUG SITS ON
.=RUGFNT ;RUG'S SYMBOLS REQUIRE 56 BYTES
BR RGO ;THIS SPECIAL "SYMBOL" MUST ALWAYS BE HERE!!
BR LOGO
0
.RAD50 /%%%/
.RAD50 /DUM/
0
.RAD50 /%%%/
.RAD50 /DUM/
0
.RAD50 /%%%/
.RAD50 /DUM/
0
.RAD50 /%%%/
.RAD50 /DUM/
0
.RAD50 /%%%/
.RAD50 /DUM/
0
.RAD50 /%%%/
.RAD50 /DUM/
0
.RAD50 /%%%/
.RAD50 /DUM/
0
.RAD50 /%%%/
.RAD50 /DUM/
0
.RAD50 /.GO/
0
ADRES: 1 ;USER STARTING ADDRESS, SHOULD BE ODD AT FIRST
.RAD50 /.B /
0
14
.RAD50 /.M /
0
11
.RAD50 /.P /
0
10
.RAD50 /.C /
0
14+O.BPT
.RAD50 /..B/
0
O.SYME: RUGFNT
.RAD50 /. /
0
DOT: 0
177777 ;HALF KILLED SYMBOL FLAG
DOTFLG: 74
O.BSYM==. ;BEGINNING OF SYMBOL TABLE (HIGHEST ADDRESS)
RGO: JMP O.ODT
LOGO: JMP STLOGO
BEGRUG: JMP STRT
.=.+400 ;THIS IS RUG'S STACK
O.UR0: 0 ;USER A
USERR0=O.UR0
0 ; B
0 ; C
0 ; D
0 ; E
0 ; F
USP: 0 ;USER SP
UPC: 0
O.PRI: 7 ;RUG PRIORITY
O.MSK: -1 ;MASK
0 ;LOW LIMIT
160000 ;HIGH LIMIT
;
; BREAK POINT LISTS, ADR1 = ADDRESS OF BREAKPOINT,CT = COUNT,
; UIN = CONTENTS
;
O.ADR1:
.=.+O.BKP+2
O.CT:
.=.+O.BKP+2
O.UIN:
.=.+O.BKP+2
.IFNZ M1145
O.BPM: ;DESREG VALUE WHEN BPTS SET
.=.+O.BKP+2
.ENDC
;THIS IS THE MIGHTY RUG
VERN: %FNAM2 ;RUG VERSION NUMBER
O.ODT:
MOVB #O.STM,PSW
MOV #O.UR0,SP
JMP O.DCD
STRT: MOV #O.UR0,SP
JSR PC,REINIT
CLR RESTFL
CLR INPFL
.IFNZ F.HD
JSR 5,FDISK
0 ;DAE
INVRG ;DAR
RUGFNT ;CMA
-INVRGL ;WC
3 ;DCS
.ENDC
.IFZ F.HD
JSR 5,MDISK
LOWAD
RUGFNT
-INVRGL
3
.ENDC
JSR PC,DSTBL
BR O.ODT
ADR1: 0 ;FIRST ADDRESS OF INSTRUCTION IN @DOT, OR DOT
ADR2: 0 ;SECOND, OR FIRST, OR DOT
ADR1F: .BYTE 0 ;0, OR 1 IF ADR1 IS A REGISTER
ADR2F: .BYTE 0 ;0, OR 1 IF ADR2 IS A REGISTER
OPENF: .BYTE 0 ;NONZERO IF LOCATION @DOT IS OPEN
.EVEN
REGFLG: 0 ;ONE IF DOT IS A REGISTER (OR .B, .C, .M, .P, ..B OR .)
BYTWRD: 1 ;ZERO IF EXAMINING IN BYTE MODE, 1 IF WORD
;PROCESS /, OPEN A LOCATION
SLASH: CLRB OPENF ;CLOSE LOC IF OPEN, BUT DON'T DEPOSIT ANY ARG
CLR REGFLG
TST C
BEQ SLASH3 ;NO ARGUMENT TYPED
TSTB REGINF
BEQ SLASH2 ;ARG NOT A REGISTER
CMP #43,E
BLT SLAERR ;INVALID REGISTER NUMBER
MOV E,DOT
INC REGFLG
SLASH1: JMP OPENW
SLAERR: JMP O.ERR
SLASH2: MOV E,DOT
BIT #1,E
BEQ SLASH1
JSR 5,TYPE
.BYTE '/,0 ;TYPE A BACKSLASH
JMP OPENB ;ODD LOCATION SO OPEN BYTE
SLASH3: JSR PC,SAVDOT ;STORE DOT IN RING BUFFER
CMP #GOINST,TEMPMD
BEQ SLASH4 ;TEMP MODE IS I, SO 2ND ADDRESS IS MEANINGFUL
CMP #GOINST,PERMMD
BNE TAB1 ;NOT IN I MODE, SO DO TAB
SLASH4: MOV ADR2,DOT ;OPEN SECOND ADDRESS
MOVB ADR2F,REGFLG ;LEFT BYTE ALWAYS ZERO
JMP TYOPEN
;PROCESS \, OPEN A BYTE
BACKSL: CLRB OPENF
TST C
BEQ TYOPEN ;NO ARGUMENT TYPED
CLR REGFLG
TSTB REGINF
BEQ BACKS1 ;NOT A REGISTER
CMP #43,E
BLT SLAERR ;INVALID REGISTER NUMBER
INC REGFLG
BACKS1: MOV E,DOT
JMP OPENB
;PROCESS CARRIAGE RETURN
CRETN: JSR PC,UPDATE
JSR PC,CLOSE
JMP O.DCD2
;PROCESS LINEFEED
LINEFD: JSR PC,CLOSE
TST BYTWRD
BEQ LINEF3
TST REGFLG
BNE LINEF3 ;A REGISTER OR .B, .C, ETC.
CMP #GOINST,TEMPMD
BNE LINEF2 ;NOT IN INSTRUCTION MODE
ADD LENGTH,DOT
LINEF2: INC DOT
LINEF3: INC DOT
TYOPEN: JSR PC,CRLF
MOV DOT,A ;NUMBER TO TYPE
JSR F,SYMBAD
TST BYTWRD
BEQ TYOPN1 ;IN BYTE MODE
TST REGFLG
BNE TYOPN2
BIT #1,DOT
BNE TYOPN1 ;DOT IS ODD
TYOPN2: JSR F,TYPE
.BYTE '/,0
JMP OPENW
TYOPN1: JSR F,TYPE
.BYTE '\,0
JMP OPENB
;PROCESS TAB
TAB: JSR PC,SAVD0 ;CLOSE, STORE DOT IN RING BUFFER
TAB1: MOV @WDINC,DOT
CLR REGFLG
BR TYOPEN
;PROCESS _ (BACKARROW)
BACKAR: JSR PC,SAVD0 ;CLOSE, STORE DOT IN RING BUFFER
MOV ADR1,DOT
MOVB ADR1F,REGFLG ;LEFT BYTE ALWAYS ZERO
BR TYOPEN
;PROCESS ^ (UPARROW)
UPARR: JSR PC,CLOSE
TST REGFLG
BEQ UPARR1 ;DOT IS NOT A REGISTER
TST DOT
BEQ UPARR3 ;DO NOT GO UP FROM A
BR UPARR2
UPARR1: SUB BYTWRD,DOT
UPARR2: DEC DOT
UPARR3: BR TYOPEN
;PROCESS <, RETURN TO OLD SEQUENCE OF LOCATIONS
OLDSEQ: JSR PC,UPDATE
JSR PC,CLOSE
MOV @RINGPT,DOT ;RESTORE DOT FROM RING BUFFER
CMP RINGPT,#RINGBF
BHI GETD1
MOV #RINGBF+20,RINGPT
GETD1: SUB #2,RINGPT
CLR REGFLG ;CLEARS C ALSO
ROLB RINGRF
ADC REGFLG
TST REGFLG
BEQ GETD2
INC RINGRF
GETD2: JMP TYOPEN
SAVD0: JSR PC,CLOSE
SAVDOT: CMP RINGPT,#RINGBF+20-2 ;SAVE DOT AND REGFLG IN RING BUFFER
BLO SAVD1
MOV #RINGBF-2,RINGPT
SAVD1: ADD #2,RINGPT
MOV DOT,@RINGPT
TST REGFLG ;CLEARS C
BEQ SAVD2
SEC ;DOT IS REGISTER, SO SET C
SAVD2: RORB RINGRF ;BIT 7 IS REGFLG FOR ENTRY @RINGPT
RTS PC
RINGBF: .REPT 8 ;RING BUFFER OF OPENED LOCATIONS FOR < COMMAND
0
.ENDR
RINGPT: RINGBF-2 ;RING BUFFER POINTER
RINGRF: 0 ;RIGHT BYTE IS REGISTER FLAGS FOR RING BUFFER
;CLOSE THE LOCATION @DOT
CLOSE: TSTB OPENF
BEQ CLOSE5 ;NO LOCATION OPEN
CLRB OPENF
TST C
BEQ CLOSE5 ;NO ARGUMENT TYPED
TST BYTWRD
BEQ CLOSEB ;CLOSE BYTE
MOV LENTYI,C
TST REGFLG
BEQ CLOSE2
CLR C ;REGISTERS ARE ONLY 1 WORD
CLOSE2: MOV C,LENGTH
ASR C
MOV #VAL,D
.IFZ M1145
MOV WDINC,A
CLOSE3: MOV (D)+,(A)+ ;DEPOSIT WORD
.ENDC
.IFNZ M1145
MOV #WDINC,A
CLOSE3: BIT #1,(A)
BNE OPENER ;TO GETERR, BECAUSE NXM OR SLE
MOV (D)+,@(A)+ ;DEPOSIT WORD
.ENDC
DEC C
BMI CLOSE4 ;DONE DEPOSITING
BR CLOSE3 ;DO ANOTHER WORD
CLOSEB: MOV DOT,C ;CLOSE A BYTE
BIC #177776,C ;GET LOW BIT
BIC REGFLG,C ;EXAMINE ONLY LOW BYTE OF REGISTERS
ADD WDINC,C
MOVB VAL,@C ;DEPOSIT THE BYTE
CLOSE4: TST REGFLG
BNE CLOSE5 ;DO NOT WRITE OUT REGISTERS
JSR PC,WRTWRD ;WRITE IT OUT
CLOSE5: RTS PC
;OPEN A BYTE OR WORD, AS DESCRIBED BY DOT AND REGFLG
;SET BYTWRD ACCORDING TO WHETHER OPENB OR OPENW WAS CALLED
OPENB: CLR BYTWRD
BR OPEN1
OPENW: MOV #1,BYTWRD
OPEN1: TST REGFLG
BEQ OPEN3 ;NOT A REGISTER
MOV DOT,E ;OPEN A REGISTER
ASL E
.IFNZ M1145
CMP E,#12 ;P AND R7 ARE KEPT SEPERATLY
BLE OPEN0
ADD #USERR0,E
BR OPEN.0
OPEN0: ADD WCHREG,E
OPEN.0:
.IFF
ADD #USERR0,E
.ENDC
MOV E,WDINC
;SECOND OR THIRD WORD OF REGISTERS ARE NEVER REFERENCED, SO NO NEED TO SET UP
BR OPEN4 ;HAVE WORDS READY
OPEN3: MOV DOT,A ;SET UP GETWRD CALL
MOV #NXMER,4
MOV #340,6
JSR PC,GETWRD
.IFNZ M1145
BIT #1,WDINC
BEQ OPEN4
OPENER: JMP GETERR ;NXM OR SLE
.ENDC
OPEN4: INCB OPENF
JSR PC,TYP3SP
MOV @WDINC,A ;PICK UP WORD
OPEN5: CLR LENGTH
TST BYTWRD
BNE OPEN7 ;NOT BYTE MODE
TST REGFLG
BNE OPEN6 ;CAN'T EXAMINE LEFT BYTE OF REGISTERS
BIT #1,DOT
BEQ OPEN6
SWAB A ;WANT LEFT BYTE
OPEN6: BIC #177400,A ;MASK OFF LEFT BYTE
OPEN7: MOV A,CURVAL
JMP @TEMPMD
GONUM: JSR 5,TYPNUM ;TYPE OUT NUMBER
BR GOSYM1
GOSYM: JSR 5,SYMBL2 ;PRINT AS SYMBOL EVEN IF IN $$A MODE
GOSYM1: JSR PC,TYP3SP
JMP O.DCD3 ;DONE
GOINST: TST REGFLG ;INSTRUCTION MODE TYPEOUT
BNE GONUM ;NO I MODE FOR REGISTERS
TST BYTWRD
BEQ GONUM ;NOR WITH BYTE MODE
MOV DOT,CURADR
MOV DOT,ADR1
MOV DOT,ADR2
CLR ADR1F ;CLEARS REG FLAG FOR ADR2 ALSO
JSR PC,EXINST
BR GOSYM1 ;OK
MOV CURVAL,A ;DID NOT FIND AN INSTRUCTION
BR GONUM
PERMAF: .BYTE 0 ;NONZERO = TYPE ADDRS ABSOLUTE, ZERO = RELATIVE
TEMPAF: .BYTE 0 ;TEMP COPY OF PERMAF
PERMDF: .BYTE 0 ;NONZERO = TYPE NUMBERS DECIMAL, ZERO = OCTAL
TEMPDF: .BYTE 0 ;TEMP COPY OF PERMDF
PERMMD: GOINST ;C, I, S, R50 OR ASCII TYPEOUT MODE
TEMPMD: GOINST ;TEMP COPY OF PERMMD
UPDATE: MOVB PERMAF,TEMPAF ;ABSOLUTE FLAG
MOVB PERMDF,TEMPDF ;DECIMAL FLAG
MOV PERMMD,TEMPMD ;TYPEOUT MODE
RTS PC
SETCMD: JSR PC,SETMOD ;SET CONSTANTS MODE
GONUM
SETIMD: JSR PC,SETMOD ;SET INSTRUCTION MODE
GOINST
SETSMD: JSR PC,SETMOD ;SET SYMBOLIC MODE
GOSYM
SETR51: MOV C,D ;SHIFT ARG SINCE NO ALT MODE
MOV E,F
SETR50: JSR PC,SETMOD ;SET RADIX-50 MODE
GOR50
SETASD: MOV C,D
MOV E,F
SETASC: JSR PC,SETMOD ;SET ASCII MODE
GOASC
SETMOD: CMP B,#2*<N1ALC+N0ALC>+O.LGDR
BLO SETMD1 ;ZERO OR ONE ALT MODE
MOV @(SP),PERMMD ;TWO ALT MODES, SET MODE PERMANENTLY
SETMD1: MOV @(SP)+,TEMPMD
SETMD2: TST D
BEQ SETMD3 ;NO ARGUMENT
MOV F,CURVAL ;TYPE ARG IN NEW MODE
BR SETMD4
SETMD3: TSTB OPENF
BEQ O.DCD2 ;NO LOCATION OPEN
SETMD4: JSR PC,TYP3SP
MOV CURVAL,A
BR OPEN7 ;RETYPE VALUE
S2ALTA: INCB PERMAF ;ABSOLUTE ADDRESSES
S1ALTA: INCB TEMPAF
BR SETMD2
S2ALTR: CLRB PERMAF ;RELATIVE ADDRESSES
S1ALTR: CLRB TEMPAF
BR SETMD2
S2ALTD: INCB PERMDF ;DECIMAL NUMBERS
S1ALTD: INCB TEMPDF
BR SETMD2
S2ALTO: CLRB PERMDF ;OCTAL NUMBERS
S1ALTO: CLRB TEMPDF
BR SETMD2
; <UNDEF SYM><:> DEFINE SYM AS CURRENT LOCATION
; <EXPR><ARITH OPR><UNDEF SYM><:> DEFINE SYM AS EXPR
; <EXPR> <,> <UNDEF SYM><:> DEFINE SYM AS EXPR
; <EXPR> <,> <DEFINED SYM><:> RE-DEFINE SYM AS EXPR
;EVAL GOT UNDEFINED SYMBOL
ECOLON: CMP #COLONE,(SP)+ ;RETRIEVE CALL TO EVAL
BEQ COLONE ;IT WAS COLON COMMAND, SO ALREADY HAVE VALUE
TST C
BNE COLON0
MOV DOT,E
MOV REGFLG,REGINF
COLON0: MOV E,DEFNV
MOV REGINF,-(SP)
BR COLONE
COLON: MOV E,DEFNV ;PROCESS COLON COMMAND
CMPB #',,@PARSEP
BNE DCDERR ;COMMA MUST SEPARATE VALUE FROM SYMBOL
MOV REGINF,-(SP)
INC PARSEP ;PASS OVER COMMA
JSR PC,EVAL ;GET THE SYMBOL
COLONE: CMP #':,A
BNE DCDERR ;COLON MUST TERMINATE SYMBOL
TST NOTNUM
BEQ DCDERR ;CANNOT DEFINE NULL OR A NUMBER
JSR PC,O.SYLL ;GET SYMBOL'S VALUE IN E
BNE DEFN2 ;FOUND
DEFN1: SUB #6,O.SYME ;USYMB TABLE 2WDS RAD50 PLUS ONE OF VALUE
MOV O.SYL,(B)
MOV O.SYL+2,2(B)
MOV O.FLGS,E
CMP #1,D ;SEE IF TIME FOR NEW FLAG WORD
BNE DEFN2 ;NO
CLR (E)
CLR -(E) ;YES, INITIALIZE IT
DEFN2: MOV O.FLGS,E
MOV #0,4(B)
DEFNV=.-4 ;VALUE DEFINED
TST (SP)+ ;CHECK REGISTER FLAG
BEQ DEFN3
BIS D,(E)
BR DEFN4
DEFN3: BIC D,(E)
DEFN4: BIC D,-(E)
JSR PC,TYP3SP
BR O.DCD3 ;HAVE TO CLRB IBUFF FOR NON-COMMA MODES
;PROCESS FOO^K, HALF KILLING DEFINED SYMBOL
HKILL: MOV O.FLGS,E
MOV O.BIT,D
BEQ DCDERR
XOR D,-(E)
BR O.DCD
RESART: MOVB #O.STM,PSW ;SET STATUS
MOV #O.UR0,SP ;INIT STACK
DECB RESTFL ;1=START RUG
BEQ O.DCD ;2=START TRACK 0 (LOGO)
CLRB RESTFL
JMP STLOGO ;START LOGO
;COMMAND DECODER, TOP LEVEL, MAY CLOBBER A - F
O.ERR==.
DCDERR: CLRB TBUFF
MOV #TBUFF,TNPNTR
MOV #O.UR0,SP ;RESET STACK
JSR 5,TYPE ;GET HERE FROM FATAL ERRORS
.ASCIZ /? /
.EVEN
BR O.DCD3
O.DCD: CLRB OPENF ;MAKE NO LOCATION OPEN
O.DCD2: JSR PC,CRLF ;TYPE CR, LF, STAR
JSR 5,TYPE
.ASCIZ /*/
.EVEN
O.DCD3: CLR SSFLAG ;SINGLE STEP MODE FLAG
JSR PC,INPUT ;GET A NEW COMMAND
MOV #IBUFF,PARSEP ;INITIALIZE PARSING POINTER
JSR PC,EVAL ;MAKE SOME SENSE OF INPUT
MOV #0,B
SALTF==.-2 ;SAVED ALTF FROM "INPUT", = 0, 1, 2
CMP #2,B
BLO DCDERR ;TOO MANY ALTMODES
ASL B
MOV ALTTAB(B),B
DEC SINPTR ;UNDO LAST INC
MOVB @#0,A ;PICK UP COMMAND CHAR
SINPTR==.-2 ;SAVED INPNTR
CLRB IBUFF
DCD3: TSTB (B) ;SEARCH FOR COMMAND
BEQ DCDERR ;UNKNOWN COMMAND
CMPB A,(B)+
BNE DCD3 ;KEEP LOOKING
SUB #ALT+1-<O.LGDR/2&77777>,B
ASL B
MOV C,D ;C SAVED IN D, E IN F FOR 2 ALTMODE ROUTINES
MOV E,F ;THIS SHOULD BE DISCARDED ***
JMP @(B)+ ;DISPATCH TO PROPER ROUTINE
ALTTAB: NOALT
ALT
TWOALT
;PROCESS =, TYPE ARG OR CURRENT VALUE
EQUAL: TST C
BEQ EQUAL1 ;NO ARG, USE CURVAL
MOV E,CURVAL ;ARG, SET CURVAL TO IT
TSTB REGINF
BEQ EQUAL1
JSR 5,TYPE
.ASCIZ /%/
.EVEN
EQUAL1: MOV CURVAL,A
JSR 5,TYPNUM
EQUAL2: JSR PC,TYP3SP
BR O.DCD3
;PROCESS ^V, TYPE VERSION NUMBER
VERS: JSR F,TYPE
.ASCIZ / RUG /
.EVEN
MOV VERN,A
JSR F,TYPDEC
.IFNZ M1145
MOV #43106,A ;ASCII F F
BIT #1,SVSSR0
BEQ VERS1
MOV #47040,A ;ASCII N SPACE
VERS1: MOV A,SONOFF
JSR 5,TYPE
MODE: .ASCII \P0 SEG O\
SONOFF: .ASCII \FF\
0
.ENDC
BR EQUAL2
ERROR: BR O.ERR
;PROCESS ], PRINT CURRENT VALUE AS RADIX-50
GOR50: MOV A,AINST
CLR AINST+2
JSR 5,TYPE
.BYTE '&
.BYTE '/
.BYTE 0
.EVEN
MOVB #40,BLANK
JSR F,TYP50A
GOR50A: JSR 5,TYPE
.BYTE '/
.BYTE 0
JMP GOSYM1
;PROCESS [, PRINT CURRENT VALUE AS ASCII
GOASC: BIS #100200,A ;SO DON'T HAVE ZEROS
MOV A,GOASCI
JSR 5,TYPE
.BYTE '"
.BYTE '/
GOASCI: 0
.BYTE 0
.EVEN
BR GOR50A
;SINGLE STEP MODE PROCESSOR
SSTP: TSTB O.P
BLT ERROR ;ILLEGAL TO PROCEED
MOV C,D
MOV E,F
CLR C
SSTEP: TST D
BGT SSTP1
MOV #1,F ;ASSUME SINGLE STEP
SSTP1: TST F
BEQ ERROR ;ZERO STEPS?
CLR D
MOVB O.P,#0
PP=.-2
MOV F,COUNT
INC SSFLAG
JMP PR1
;B HANDLER - SET AND REMOVE BREAKPOINTS
O.BKPT: MOV #-1,A
TST D
BEQ O.ERR1 ;FOR NOW THAT COMMAND IS MEANINGLESS
ASR F ;GET ONE BIT TO CARRY
BCS O.ERR1 ;BADNESS IF ODD ADDRESS
ASL F ;RESTORE ONE BIT
JSR PC,DELT1 ;D IS NOT 0
;THIS IS SO NO TWO BPTS ON SAME ADDRESS PROBABLY A LOSS
MOV #O.ADR1,E
O.SET: CMP A,(E)+ ;IS THIS CELL FREE?
BEQ O.SET1 ;JUMP IF YES
CMP E,#O.BKP+O.ADR1+2 ;ARE WE AT THE END OF OUR ROPE
BLO O.SET
O.SET1: MOV F,-(E) ;SET BREAKPOINT
.IFNZ M1145
MOV MODE,O.BPM-O.ADR1(E) ;SAVE MAP STATE
CMPB #'P,MODE
BEQ O.DCDB
MOVB #'I,O.BPM+1-O.ADR1(E) ;SET MAP TO I SPACE
.ENDC
O.DCDB: JMP O.DCD ;RETURN
;$$B HANDLER DELETE BKPT AT 1500 BY 1500$$B, $$B REMOVES ALL
DELT: CLR D
DELT1: MOV #-1,A
MOV #O.BKP+2,E
DBLOOP: TST D ;IF D ZERO, DELETE ALL
BEQ NOTST
CMP F,O.ADR1-2(E)
BNE DB1 ;ONLY REMOVE BKPT AT THAT ADDRESS
NOTST: MOV A,O.ADR1-2(E)
MOV #BPT,O.UIN-2(E) ;RESET CONTENTS OF TABLE
CLR O.CT-2(E) ;CLEAR COUNT
DB1: DEC E
.IFNZ M1145+M1140
SOB E,DBLOOP
.IFF
DEC E
BGT DBLOOP
.ENDC
DELDON: RTS PC
DELTB: JSR PC,DELT1
BR O.DCDB
O.ERR1: JMP O.ERR
; SEARCHES - $MSK HAS THE MASK
; $MSK+2 HAS THE FWA
; $MSK+4 HAS THE LWA
NOTWDS: MOV #-1,EFFSR
BR O.WDS
O.EFF: MOV #1,EFFSR
BR O.WDS
O.WSCH: CLR EFFSR ;SET WORD SEARCH
O.WDS: CLR REGFLG
TST D ;CHECK FOR OBJECT FOUND
BEQ O.ERR1 ;ERROR IF NO OBJECT
MOV #1,BYTWRD ;SET WORD MODE
MOV O.MSK+2,C ;SET ORIGIN
MOV C,DISP
BIC #CSTBL-1,DISP
SUB DISP,C
JSR PC,INP1
MOV O.MSK,E ;SET MASK
COM E
O.WDS2: CMP C,#CSTBL
BLO CS1
JSR PC,INP
CS1: MOV C,A
ADD DISP,A
CMP A,O.MSK+4 ;IS THE SEARCH ALL DONE?
BHI INSB ;YES
MOV @C,A ;GET OBJECT
TST EFFSR ;NO
BGT O.EFF1 ;BRANCH IF EFFECTIVE SEARCH
MOV A,-(SP)
MOV F,D ;EXCLUSIVE OR
BIC F,A ; IS DONE
BIC (SP)+,D ; IN A VERY
BIS A,D ; FANCY MANNER HERE
BIC E,D ;AND RESULT WITH MASK
BNE WRD1
TST EFFSR
BNE O.WDS4
BR O.WDS3
WRD1: TST EFFSR
BEQ O.WDS4
O.WDS3: MOV E,-(SP) ;REGISTERS C,E, AND F ARE SAFE
MOV C,-(SP)
JSR PC,CRLF
MOV C,A ;GET READY TO TYPE
ADD DISP,A
JSR 5,SYMBAD ; TYPE ADDRESS
JSR F,TYPE
.BYTE '/,0
JSR PC,TYP3SP
MOV (SP),C
MOV @C,A ;GET CONTENTS
JSR 5,TYPNUM ;TYPE CONTENTS
MOV (SP)+,C
MOV (SP)+,E ; RESTORE E
O.WDS4: TSTB O.RCSR
BMI O.ERR1
TST (C)+ ;INCREMENT TO NEXT CELL AND
BR O.WDS2 ; RETURN
O.EFF1: CMP A,F ; IS (X)=K?
BEQ O.WDS3 ;TYPE IF EQUAL
MOV A,D ;(X) TO D
ADD C,D ;(X)+X
INC D
INC D ;(X)+X+2
CMP D,F ;IS (X)+X+2=K?
BEQ O.WDS3 ;BRANCH IF EQUAL
TST A
BEQ O.WDS4 ;NOT A BRANCH INST
BIT #70000,A
BNE O.WDS4 ;ALSO NOT A BRANCH INST
MOVB A,A
INC A
ASL A
ADD C,A ;ADD PC
ADD DISP,A
CMP A,F ;IS THE RESULT A PROPER REL. BRANCH?
BNE O.WDS4
BR O.WDS3
INSB: JMP O.DCD
EFFSR: 0
DISP: 0
INP: CLR C
ADD #CSTBL,DISP
INP1: MOV DISP,A
CLC
ROR A
.IFZ F.HD
MOV A,MDSAV
JSR PC,MDCNVT
MOV #SPRG,MDSAV+2
JSR PC,MDADD
MOV MDSAV,INPDAR
.ENDC
.IFNZ F.HD
ADD #SPRG,A
MOV A,INPDAR
JSR 5,FDISK
0 ;DAE
.ENDC
.IFZ F.HD
JSR 5,MDISK
.ENDC
INPDAR: 0
0 ;CMA
-CSTBL/2 ;WC
5 ;DCS
RTS PC
NXMER:
.IFNZ M1145
BIT #1,SSR0
BEQ NXMER1
JSR PC,SEGRES ;RESTORE SEG REGISTERS IF SEG WAS ENABLED
.ENDC
NXMER1: MOV #O.UR0,P
JSR F,TYPE
.ASCIZ /NXM/
.EVEN
JMP O.ERR
; PROCESS G, START UP USER'S PROGRAM
O.GO: TST D ;WAS ARGUMENT TYPED?
BNE GO2
GO22: MOV ADRES,F
GO2: ASR F ;CHECK LOW ORDER BIT
BCS .ERR1 ;ERROR IF ODD NUMBER
ASL F ;RESTORE WORD
MOV F,UPC ;SET UP NEW PC
;NOW PUT THE BPT VECTOR INTO USER'S CORE
.IFNZ M1145
MOV MODE,#0
SAVMOD=.-2
MOV #"KI,A
JSR PC,CHMODE ;CHANGE TO KERNAL MODE
.ENDC
MOV #14,A ;BPT VECTOR LOCATION
JSR PC,GETWRD
.IFZ M1145
MOV WDINC,B
MOV #O.BRK,(B)+
MOV #O.STM,(B)
.IFF
MOV #WDINC,B
MOV #O.BRK,@(B)+
MOV #O.STM,@(B)+ ;+ 2ND TIME TO SAVE WORD IN ADRESS MODE
.ENDC
JSR PC,WRTWRD
.IFNZ M1145
MOV SAVMOD,A
JSR PC,CHMODE
.ENDC
GO1: BIC #O.TBT,O.UST ;BOTH T-BIT FLAGS
JSR 5,O.RSB ;RESTORE BREAKPOINTS
O.GO2: MOVB #-1,O.P ;CLEAR PROCEED
MOVB #O.STM,PSW ;SET HIGH PRIORITY
JSR 5,O.RSTT ;RESTORE TELETYPE
.IFNZ M1145
MOV MODE,#0
SAVMOD=.-2
MOV #"KI,A
JSR PC,CHMODE ;CHANGE TO KERNAL MODE
.ENDC
SUB #4,USP ;LIKE PUSHING TWO THINGS ON STACK
MOV USP,A
.IFNZ M1145
MOV A,SAVKR6
MOV #KIDR0+20,DESREG ;SO PUSH GOES INTO DATA SPACE
.ENDC
JSR PC,GETWRD
.IFZ M1145
MOV WDINC,B
MOV UPC,(B)+
MOV O.UST,(B)
.IFF
MOV #WDINC,B
MOV UPC,@(B)+
MOV O.UST,@(B)+
.ENDC
JSR PC,WRTWRD
;FALLS THROUGH
;FALLS IN
.IFNZ DM11
JSR PC,DM1LOS
.ENDC
MOV #O.UR0,SP
MOV (SP)+,SAVR0
MOV (SP)+,SAVR1
.IFNZ F.HD
MOV #DCS,B
.IFF
MOV #RKCS,B
.ENDC
MOV #SAVDCS,A
MOV (SP)+,C
MOV (SP)+,D
MOV (SP)+,E
MOV (SP)+,F
.IFNZ M1145
MOV #KIDR0,DESREG ;RESTORE TO KI
MOV SAVSR6,-(SP) ;RESTORE SUPERVISOR P
BIS #10000,PSW ;SET PREV MODE TO SUP
MTPI P
MOV SAVUR6,-(SP)
BIS #30000,PSW ;SET MODE TO USER
MTPI P
MOV #ALTR0,SP
BIS #4000,PSW ;CHANGE TO REGISTER SET 1
MOV (SP)+,A
MOV (SP)+,B
MOV (SP)+,C
MOV (SP)+,D
MOV (SP)+,E
MOV (SP)+,F
BIC #4000,PSW ;CHANGE BACK
MOV #USP,SP
.ENDC
JSR PC,DSTBL
.IFNZ F.HD
CLR CMA
CLR DAE
MOV #SPRG,DAR
MOV #-SPRGL,WC
.IFF
CLR RKBA
MOV #SPRG,RKDA
MOV #-SPRGL,RKWC
.ENDC
MOV (SP),SP
MOV #4,(B)
JMP GOGO
; PROCESS P - PROCEED (ONLY ALLOWED AFTER A BREAKPOINT)
.ERR1: JMP O.ERR
O.PROC: MOVB O.P,A
TSTB A ;CHECK LEGALITY OF PROCEED
BLT .ERR1 ;NOT LEGAL
TST D ;WAS COUNT SPECIFIED?
BNE PR.0 ;NO
MOV #1,F
PR.0: MOV F,O.CT(A) ;YES, PUT AWAY COUNT
PR0: INCB O.T ;SET RESTART TBIT
PR1: BIS #O.TBT,O.UST ;SET T-BIT
BR O.GO2
O.TBIT: DEC COUNT
BLE SSDN ;DONE SINGLE STEPPING
O.TBI1: BIT #4000,O.RCSR ;IS CHAR COMING IN?
BNE O.TBI1
TSTB O.RCSR ;TEST FOR KILCHR DURING MULTIPLE 
BPL PR1
CMPB #KILCHR,O.RDB
BNE PR1
SSDN: MOVB PP,O.P
MOV UPC,F
MOV F,DOT
MOV #"SS,BBMES
BR BB
; BREAKPOINT HANDLER
; A TRT BREAKPOINT CAUSES O.BRK TO BE ENTERED,
; WHICH SAVES VARIOUS ODDS AND ENDS, FINDS OUT
; IF THE BREAKPOINT WAS LEGAL, AND GIVES CONTROL
; TO THE COMMAND DECODER.
BREAK: MOVB #O.STM,PSW
MOV #UPC,SP
MOV O.UPC,(SP)
MOV O.USP,-(SP)
.IFNZ M1145
MOV (SP),SAVKR6 ;KERNEL MODE STACK POINTER
.ENDC
MOV F,-(SP)
MOV E,-(SP)
MOV D,-(SP)
MOV C,-(SP)
MOV SAVR1,-(SP)
MOV SAVR0,-(SP)
.IFNZ M1145
BIS #10000,PSW ;SET TO SUP MODE
MFPI P
MOV (SP)+,SAVSR6
BIS #30000,PSW ;PREVIOUS MODE USER MODE
MFPI P
MOV (SP)+,SAVUR6
MOV @R6AD,USP ;SET CORRECT P STACK VALUE
MOV #ALTR0,SP
BIS #4000,PSW ;SAVE REGISTER SET 1
MOV A,(SP)+
MOV B,(SP)+
MOV C,(SP)+
MOV D,(SP)+
MOV E,(SP)+
MOV F,(SP)+
BIC #4000,PSW
MOV #O.UR0,SP
.ENDC
JSR 5,O.SVTT ;SAVE TTY
.IFNZ M1145
MOV SAVMOD,A
JSR PC,CHMODE ;RESET MODE
.ENDC
TSTB RESTFL
BEQ BRK1
DECB RESTFL
BEQ BREK.1
CLRB RESTFL
JMP STLOGO ;START LOGO
BREK.1: CLRB O.T
CLRB SSFLAG
JSR F,O.REM
JMP O.DCD
BRK1: TSTB SSFLAG ;CHECK FOR T-BIT SET BY ^N
BNE O.TBIT ;JUMP IF SET
TSTB O.T ;CHECK FOR T-BIT SET BY $P
BEQ O.BK2
CLRB O.T
JMP GO1 ;CONTINUE USER PROGRAM
;RUG USED TO SWAP OUT HIGH CORE HERE
O.BK2: JSR 5,O.REM ;REMOVE BREAKPOINTS
O.BK3: MOV UPC,F ;GET PC, IT POINTS TO THE TRT
SUB #2,F ;CAN'T TST -(F) BECAUSE COULD BE RANDOM
MOV #O.BKP,E ;GET A COUNTER
O.B1: CMP F,O.ADR1(E) ;COMPARE WITH LIST
BEQ O.B2 ;JUMP IF FOUND
SUB #2,E ;CAN'T TEST. IT GETS NEG
BGE O.B1 ;RE-LOOP UNTIL FOUND
BADEN: MOV #"BE,BBMES
CLRB O.P ;TO ALLOW RESTART AFTER BAD ENTRY
BB: MOV F,A
BIC #O.TBT,O.UST ;CLEAR OUT ANY POSSIBLE FAKE T-BIT
JSR PC,CRLF
JSR 5,TYPE
BBMES: .ASCIZ /BE;/
.EVEN
BR O.B3 ; OR CONTINUE
O.B2:
.IFNZ M1145
MOV O.BPM(E),A ;RESTORE MODE OF BREAKPOINT
JSR PC,CHMODE
.ENDC
MOV F,UPC ;WANT DECREMENTED PC
MOVB E,O.P ;ALLOW PROCEED
DEC O.CT(E)
BLE O.B5
JMP PR0
O.B5: MOV #1,O.CT(E) ;RESET COUNT TO 1
MOVB E,A
ADD #140,A
ASR A
MOVB A,BPTNM
JSR PC,CRLF
JSR 5,TYPE
BPTNM==.+1
.ASCIZ /B ;/
.EVEN
MOV #1,BYTWRD ;SET WORD MODE
MOVB O.P,E
MOV O.ADR1(E),A ;GET ADDRESS OF BREAK
O.B3: MOV A,CURADR
JSR PC,GETWRD
MOV CURADR,A ;ARG FOR SYMBOL IN A
JSR 5,SYMBOL ;LOOK UP SYMBOL, TYPE IT AND ANY OFFSET
JSR 5,TYPE
.ASCIZ />/
.EVEN
CLR LENGTH
MOV @WDINC,A
JSR PC,EXINST
BR O.B4
JMP O.ERR ;NO INSTUCTION FOUND
O.B4: JMP O.DCD ;GO TO DECODER
.IFNZ DM11
DM1LOS: MOV #TTP50,O.SYL
CLR O.SYL+2
JSR PC,O.SYLL
BEQ DMLO.1
DMLOSS: MOV DMCSR+6,D
ADD #200,D
MOV E,A
JSR PC,GETWRD
MOV D,@WDINC
JSR PC,WRTWRD
DMLO.1: RTS PC
.ENDC
.IFZ M1145
;GET WORDS FROM DISK AROUND LOCATION IN A
GETWRD: CMP A,#RUGST ;READ WHAT IN CORE IF THAT HIGH
BLO GTWRD1
MOV #GWTBL,B ;THINGS IN THIS TABLE
GW2: TST (B) ;ARE STORED BY RUG
BEQ GW1
CMP A,(B)+
BNE GW2
ADD #GWTBL2-GWTBL-2,B ;POINT TO SAVE AREA AND B INCREMENTED EXTRA
MOV @B,A
GW1: MOV #BUF3,WDINC
MOV (A),BUF3 ;PUT THREE WORDS WHERE THE USER CAN GET THEM
CLR BUF3+2
CLR BUF3+4
MOV #1,IOREG ;SET SWITCH
MOV A,ADRSG
RTS PC
GTWRD1: CLR IOREG ;SET SWITCH
CLC
ROR A ;WORD ADDRESS
MOV B,-(SP)
MOV C,-(SP)
MOV A,B
BIC #MASK,B ;GET NEAREST BLOCK BOUNDARY
MOV A,C
SUB B,C ;OFFSET FROM BLOCK BOUNDARY
ASL C
ADD #BUF3,C ;IT SHOULD BE HERE SOON
MOV C,WDINC
ADD #3,A
CMP A,#HCOR/2-1 ;WILL THERE BE NXM IF 3 WDS?
BLO GTWRD2
MOV #HCOR/2-1,A
GTWRD2:
.IFNZ F.HD
MOV B,ADRSG
ADD #SPRG,ADRSG ;DISK ADDRESS TO START TRANSFER FROM
.ENDC
.IFZ F.HD
MOV B,MDSAV
JSR PC,MDCNVT
MOV #SPRG,MDSAV+2
JSR PC,MDADD
MOV MDSAV,ADRSG
.ENDC
SUB A,B ;NEGATIVE OFFSET FROM BLOCK BOUNDARY TO END
BIC #MASK,B ;OF 3 WORDS (UNROUNDED WC)
MOV B,WDCNT
MOV #5,GWFUN
MOV (SP)+,C
MOV (SP)+,B
GWDSK:
.IFNZ F.HD
JSR 5,FDISK
0 ;DAE
.ENDC
.IFZ F.HD
JSR 5,MDISK
.ENDC
ADRSG: 0 ;DAR
BUF3 ;CMA
WDCNT: 0 ;WC
GWFUN: 0 ;DCS
STH4: RTS PC
WDINC: 0 ;POINTER TO WORD IN CORE (11/45 NEEDS THREE SUCH)
WRTWRD: TST IOREG
BEQ WRTW1
CLR IOREG
MOV BUF3,@ADRSG
RTS PC
WRTW1: MOV #3,GWFUN
BR GWDSK
.ENDC
ZZERO: CLR 0
.IFNZ F.HD
JSR 5,FDISK
400 ;DAE
.ENDC
.IFZ F.HD
JSR 5,MDISK
.ENDC
SPRG ;DAR
0 ;CMA
-SPRGL ;WC
.IFNZ F.HD
3 ;DCS
.ENDC
.IFZ F.HD
4003 ;RKCS WITH INC INHIBIT ON
.ENDC
RTS PC
ZEROAL: MOV #RUGFNT,O.SYME
ZERO: JSR PC,ZZERO
JMP O.DCD
IOREG: 0
GWTBL: PSW ;TABLE OF I/O REGISTERS SAVED IN RUG
.IFNZ DM11
DMCSR
.ENDC
.IFNZ M1145
STACKR
SSR0
SSR3
.ENDC
.IFNZ F.HD
DCS
WC
CMA
DAR
DAE
.ENDC
.IFZ F.HD
RKCS
RKWC
RKBA
RKDA
.ENDC
0
GWTBL2: O.UST ;AND WHERE THEY'RE SAVED
.IFNZ DM11
SAVDM
.ENDC
.IFNZ M1145
SAVSLR
SVSSR0
SVSSR3
.ENDC
SAVDCS
SAVWC
SAVCMA
SAVDAR
.IFNZ F.HD
SAVDAE
.ENDC
.IFNZ M1145
;THIS ROUTINE GETS A VIRTUAL ADDRESS IN A AND RETURNS
;A PHSICAL ADDRESS IN C AND R3. B IS FLAG. <=0 IS OK IF NOT-NXM
CNVVP: CLR SEGLE
MOV A,-(SP)
MOV DESREG,D
BEQ PHYSMOD
BIT #1,SVSSR0 ;BIT IN SSR0 PREDOMINATES OVER NON-PHYS MODE SELECTION
BEQ SEGOFF
MOV A,B
ASH #-12.,B ;ASF*2
BIC #177761,B
ADD D,B ;NOW CHECK IF D SPACE IS DISABLED
BIT #20,D ;IS IT IN D SPACE?
BEQ CNVV.1
ASH #-6,D
INC D
BIC #177771,D
CMP D,#4
BLE CNVV.0
MOV #1,D ;D IS MASK TO TEST SRR3
CNVV.0: BIT D,SVSSR3 ;IS D SPACE DISABLED
BNE CNVV.1
SUB #20,B ;NOW B HAS PROPER DESCRIPTOR REG
CNVV.1: MOV 40(B),D ;D HAS SAR
CLR C
ASHC #6,C ;NOW SAF LINED UP WITH BLOCK NUMBER
;MAY NEED TO MASK OFF TOP BITS AFTER ASHC ***
BIC #160000,A ;TOP 3 BITS ONLY FOR WHICH SEGREG
ADD A,D
ADC C ;BLOCK # RIGHT JUSTIF. ADC CLEARS CARRY
ASH #-6,A
MOV (B),B ;HAS CONTENTS OF DESCRIPTOR REG
SWAB B
BIT #4000,B
BNE DWNBLK
BIC #177600,B
CMP A,B
BGT SLE
HAVPA: CLR B
CMP C,#3 ;IS IT AN I/O REG?
BNE HAVPA1 ;NO
CMP D,#160000 ;MAYBE
BHIS HAVPA2 ;YES
HAVPA1: TST C ;ARE WE IN RUG'S CORE
BNE HAVPAR ;NOPE
CMP D,#160000 ;ABOVE RUG?
BHIS HAVPAR
CMP D,#RUGST ;MAYBE
BLO HAVPAR ;NO, INDICATE THAT IT IS REAL CORE, NOT ON DISK
HAVPA2: COM B ;MEANING IO REG OR RESIDENT PORTION OF RUG
HAVPAR: MOV (SP)+,A
RTS PC
DWNBLK: BIC #177600,B
CMP A,B
BGE HAVPA
SLE: INC (PC)+
SEGLE: 0 ;NONZERO = SEG LENGTH ERROR
;FALL INTO NXM
NXM: INC B ;NOW B HAS TO BE POSITIVE
BR HAVPAR
PHYSMOD: MOV A,D
MOV THPHYM,C
BR HAVPA
SEGOFF: MOV A,D
CLR C ;WITH SEGMENTATION OFF, ALL ADDRESS ARE IN THE LOWER 28K
CMP D,#160000 ;UNLESS THEY ARE I/O REGISTERS
BLO HAVPA
MOV #3,C ;IN WHICH CASE THEY ARE IN THE TOP 4K
BR HAVPA
DESREG: 0 ;ADDRESS OF DESCRIPTOR REG 0 OF THAT MODE
;OR CONTAINS 0 IF IN PHYSICAL MODE
SVSTSG: MOV A,-(SP)
MOV #172300,A ;POINTER TO SEGMENTATION REGISTERS
MOV #SEGSAV,B ;PLACE TO SAVE THEM
MOV #40,E ;HOW MANY TO SAVE
SVSTS0: MOV (A)+,(B)+
SOB E,SVSTS0
MOV #172300,A ;NOW SET THEM UP
CLR B
MOV #10,E ;4 AT A TIME
SVSTS1: MOV B,60(A) ;PAR
MOV B,40(A) ;PAR
MOV #77606,20(A) ;PDR
MOV #77606,(A)+ ;PDR
ADD #200,B
SOB E,SVSTS1
MOV C,172342
MOV C,172362
MOV #7600,172356
MOV #7600,172376
BIS #1,SSR0 ;TURN ON SEGMENTATION
MOV (SP)+,A
RTS PC
SEGRES: MOV A,-(SP) ;RESTORE SEGMENTATION REGISTERS
BIC #1,SSR0 ;DISABLE SEGMENTATION
MOV #172300,A
MOV #SEGSAV,B
MOV #40,E
SEGRE1: MOV (B)+,(A)+
SOB E,SEGRE1
MOV (SP)+,A
RTS PC
SEGSAV: .BLKW 40
GHCOR: MOV D,-(SP)
ASHC #-6,C
MOV D,C
JSR PC,SVSTSG
MOV (SP)+,D
BIC #177700,D
ADD #20000,D
MOV C,IOREG
MOV D,GADAR
MOV #BUF3,C
MOV #3,B
MOV #WDINC,A
MOV 4,-(SP)
MOV #GHCRNX,4
GHCOR1: MOV C,(A)+
MOV (D)+,(C)+
SOB B,GHCOR1
MOV (SP)+,4
JSR PC,SEGRES
JMP GDONE2
GHCRNX: INC -2(A) ;MAKE IT ODD
WRHCNX: RTI ;AND IGNORE IT
GETWRD: BIC #1,A ;SET TO WORD BOUNDARY
MOV A,VADR ;VIRTUAL ADDRESS
CLR IOREG
CLR TWOFLG
MOV B,-(SP)
MOV D,-(SP)
MOV C,-(SP)
MOV E,-(SP)
JSR PC,CNVVP ;PHYSICAL ADDRESS IN C,D
TST B
BLT GETCOR ;ITS AN I/O REGISTER
BEQ GTDSK ;ITS LEGAL CORE
TST SEGLE
BEQ NX
JMP SLERR ;NOT ALLOWED TO HAVE ERRORS ON FIRST WORD
NX: JMP NXMER
GETCOR: INC IOREG ;IT'S AN I/O REGISTER
MOV #GWTBL,B
GW2: TST @B
BEQ GW1
CMP A,(B)+
BNE GW2
ADD #GWTBL2-GWTBL-2,B
MOV @B,D ;POINT TO SAVE AREA
GW1: MOV #WDINC,B
MOV #3,A
GW3: MOV D,(B)+
ADD #2,D
SOB A,GW3
BR GDONE2
;GET THREE WORDS FROM DISK OR WHEREEVER
GTDSK: TST C
BNE GHCOR ;JUST LOOK IN CORE
CMP D,#160000
BHIS GHCOR ;JUST LOOK AT CORE
MOV #3,B
JSR PC,GDSK ;TURN VADR INTO DISK ADDRESS
MOV ADAR,GADAR
.IFNZ F.HD
MOV ADAE,GADAE
.ENDC
MOV AWDCNT,GWDCNT ;SAVE THE COMPUTED DISK REGISTERS
MOV #BUF3,WDINC
ADD AWDINC,WDINC ;NOW POINTS INTO BUFFER
GDLOP: DEC B
BEQ NODIF ;ALL THREE WORDS IN ONE TRANSFER
JSR PC,GDSK ;DO VADR+2 OR VADR+4 (IF SECOND TIME THROUGH)
BLT NXMER2 ;VADR+2 OR VADR+4 IS NXM
CMP GADAR,ADAR
.IFZ F.HD
BEQ GDLOP ;SAME TRANSFER AS PREVIOUS
.ENDC
.IFNZ F.HD
BNE TWOGET ;TWO TRANSFERS NECESSARY
CMP GADAE,ADAE
BEQ GDLOP ;SAME AS PREVIOUS TRANSFER
.ENDC
TWOGET: INC TWOFLG
DEC B
BEQ LASTD ;ONLY ONE WORD TO GO
MOV #BUF3B,B ;TWO WORDS ON NEXT DISK SECTOR
ADD AWDINC,B
MOV B,WDINC+2 ;VADR+2 AND VADR+4 IN OTHER BUFFER
TST (B)+
BR LASTD2 ;NOW STORE THE DISK TRANSFER INFO
NODIF: MOV WDINC,B ;ALL 3 WORDS ARE TOGETHER
TST (B)+
MOV B,WDINC+2 ;POINTS TO SECOND WORD
TST (B)+
MOV B,WDINC+4 ;TO THIRD WORD
BR GDONE1 ;FIDDLE THE DISK
LASTD: MOV WDINC,B ;ONLY VADR+4 IN SECOND BUFFER
TST (B)+
MOV B,WDINC+2 ;VADR+2 IN FIRST BUFFER
MOV #BUF3B,B
ADD AWDINC,B ;VADR+4 IN SECOND BUFFER
LASTD2: MOV B,WDINC+4
MOV ADAR,GADAR2 ;INFO FOR SECOND TRANSFER
.IFNZ F.HD
MOV ADAE,GADAE2
.ENDC
MOV AWDCNT,GWDCN2
GDONE1: MOV #5,B
JSR PC,GDISK ;DO THE TRANSFER(S)
GDONE2: MOV (SP)+,E
MOV (SP)+,C
MOV (SP)+,D
MOV (SP)+,B
RTS PC
WRTWRD: MOV IOREG,C
BEQ WRTW1
CLR IOREG
CMP #1,C ;IS JUST AN I/O REGISTER?
BEQ WRTW2 ;YES, DONE
JSR PC,SVSTSG
MOV GADAR,D
MOV #BUF3,C
MOV 4,-(SP)
MOV #WRHCNX,4
MOV (C)+,(D)+
MOV (C)+,(D)+
MOV (C)+,(D)+
MOV (SP)+,4
JSR PC,SEGRES
WRTW2: RTS PC
WRTW1: MOV #3,B ;FALL INTO GDISK
GDISK: MOV B,GFUN
JSR PC,GDSK1
TST TWOFLG
BEQ GDSKD
MOV B,GFUN2
GDSK2:
.IFNZ F.HD
JSR 5,FDISK
GADAE2: 0
.ENDC
.IFZ F.HD
JSR 5,MDISK
.ENDC
GADAR2: 0
BUF3B
GWDCN2: 0
GFUN2: 0
GDSKD: RTS PC
GDSK1:
.IFNZ F.HD
JSR 5,FDISK
GADAE: 0
.ENDC
.IFZ F.HD
JSR 5,MDISK
.ENDC
GADAR: 0
BUF3 ;CMA
GWDCNT: 0
GFUN: 0
RTS PC
NXMER2: NEG B
ASL B
MOV #1,WDINC(B) ;INDICATE NXM
MOV #1,WDINC+2(B) ;CAN'T HAVE THIS EITHER
BR GDONE1
TWOFLG: 0
WDINC: 0 ;POINTER TO FIRST WORD
0 ;POINTER TO NEXT
0 ;THESE POINTERS ARE ODD IF NXMS OR SLES
0 ;FOR NXMER2 KLUDGE
;PHYSICAL ADDRESS IN A
;IN B IS 3 2 OR 1 DEPENDING ON WHICH TIME THROUGH LOOP
;ADDRESS IN D AND C
GDSK: MOV VADR,A ;VIRTUAL ADDRESS
MOV B,-(SP)
NEG B
ADD #3,B
ASL B
ADD B,A ;GET ACTUAL ADDRESS
JSR PC,CNVVP ;MAKE A PHYSICAL ADDRESS
TST B
BNE GDNXM ;NXM
TST C
BNE GDNXM
MOV D,B ;C SHOULD BE ZERO
BIC #BMASK,D
MOV B,A
SUB D,A ;OFFSET INTO DISK BLOCK
MOV A,AWDINC ;SAVE IT
CLC
ROR D ;MAKE IT A WORD ADDRESS
.IFNZ F.HD
ADD #SPRG,D ;OFFSET INTO SWAP TRACK
ADC C
MOV C,ADAE
MOV D,ADAR
.ENDC
.IFZ F.HD
MOV D,MDSAV
JSR PC,MDCNVT
MOV #SPRG,MDSAV+2
JSR PC,MDADD
MOV MDSAV,ADAR
.ENDC
MOV #-400,AWDCNT
MOV (SP)+,B
RTS PC
ADAR: 0
.IFNZ F.HD
ADAE: 0
.ENDC
AWDINC: 0
AWDCNT: 0
VADR: 0 ;VIRTUAL ADDRESS
GDNXM: MOV (SP)+,B
SUB #3,B ;SO WILL BE NEG AND NO INFO LOST
RTS PC
;CHANGE MODES. CHOICE OF P, KI, KD, SI, SD, UI OR UD
;FOR PHYSICAL MODE OR KERNEL INSTRUCTION, ETC.
;TYPE $$M THEN IT ASKS MODE? THEN TYPE ONE OF CHOICES ABOVE
;THIS SETS UP DESREG TO BE PROPER ADDRESS OF DESCRIPTOR REG
;FOR THAT MODE, DATAMF SIGNALS WHETHER IT'S DATA SPACE
CHNGMD: JSR 5,TYPE
.ASCIZ /ODE /
.EVEN
JSR PC,GET1UC
MOV A,-(SP)
JSR PC,GET1UC
SWAB A
BIS (SP)+,A
JSR PC,CHMODE
MODE.1: JMP O.DCD
CHMODE: MOV B,-(SP)
MOV #CHNGL,B ;CHANGE MODE TO (A)
CHNG1: CMP A,(B)+
BEQ CHNG2 ;GOT LEGAL NEW MODE
CMP #CHNGL+20.,B
BHI CHNG1
CMP A,#"R0
BNE CHMO.1
MOV #O.UR0,#O.UR0 ;CHANGE TO REGISTER SET 0
WCHREG=.-2
BR CHNG4
CHMO.1: CMP A,#"R1
BNE CHMO.2
MOV #ALTR0,WCHREG ;CHANGE TO REGISTER SET 0
BR CHNG4
CHMO.2: JMP O.ERR ;NOT A LEGAL MODE
CHNG2: MOV A,MODE
MOV CHDREG-CHNGL-2(B),DESREG
CLR B
MOVB A,B
SUB #121,B
BGT CHNG3
CLR B
CHNG3: ADD #SAVKR6,B
MOV USP,@R6AD
MOV B,R6AD
MOV (B),USP
SWAB A
MOV A,THPHYM
BIC #177774,THPHYM ;0-3 IN P MODE, ELSE IRRELEVANT
CHNG4: MOV (SP)+,B
RTS PC
KMODE: MOV #'K,B
BR MODE.2
UMODE: MOV #'U,B
MODE.2: JSR PC,GET1UC
SWAB A
BIS B,A ;MODE IS NOW IN A
JSR PC,CHMODE
BR MODE.1
CHNGL: .ASCII \P0\
.ASCII \P1\
.ASCII \P2\
.ASCII \P3\
.ASCII \KI\
.ASCII \KD\
.ASCII \SI\
.ASCII \SD\
.ASCII \UI\
.ASCII \UD\
SAVKR6: 0 ;SAVED KERNEL, SUP, USER P'S
SAVSR6: 0
SAVUR6: 0
R6AD: SAVKR6 ;POINTER TO CURRENT SAVED P
ALTR0: 0 ;SAVE ALTERNATE REGISTER SET HERE
ALTR1: 0
ALTR2: 0
ALTR3: 0
ALTR4: 0
ALTR5: 0
THPHYM: 0 ;BITS 17 & 16 OF PHYS MODE ADDRESS, = 0-3
CHDREG: 0 ;DESCRIPTOR REGISTER FOR EACH MODE
0
0
0
KIDR0
KIDR0+20
SIDR0
SIDR0+20
UIDR0
UIDR0+20
.ENDC
; RESTORE BREAKPOINTS 0-7
O.RSB: MOV #O.BKP,E ;RESTORE ALL BREAKPOINTS
O.RS1: MOV O.ADR1(E),A
CMP A,#-1
BEQ O.RS2
.IFNZ M1145
MOV A,B
MOV O.BPM(E),A
JSR PC,CHMODE
MOV B,A
.ENDC
JSR PC,GETWRD
MOV @WDINC,O.UIN(E)
MOV #3,@WDINC
JSR PC,WRTWRD
O.RS2: DEC E
DEC E
BGE O.RS1 ;RE-LOOP UNTIL DONE
RTS F ;THEN QUIT
;SAVE TELETYPE STATUS
O.SVTT: MOVB O.RCSR,O.CSR1 ;SAVE R C/SR
MOVB O.TCSR,O.CSR2 ;SAVE T C/SR
CLRB O.RCSR ;CLEAR ENABLE AND MAINTENANCE BITS
CLRB O.TCSR ;IN BOTH C/SR
RTS F
; RESTORE TELETYPE STATUS
O.RSTT: TST O.T
BNE RSTT
TST SSFLAG
BNE RSTT
JSR PC,CRLF
RSTT: TSTB O.TCSR ;WAIT READY
BPL RSTT ; ON PRINTER
BIT #4000,O.RCSR ;CHECK BUSY FLAG
BEQ O.RSE1 ;SKIP READY LOOP IF NOT BUSY
1$: TSTB O.RCSR ;WAIT READY
BPL 1$ ; ON READER
O.RSE1: MOVB O.CSR1,O.RCSR ;RESTORE
MOVB O.CSR2,O.TCSR ; THE STATUS REGISTERS
RTS F
;REMOVE BREAKPOINTS 0-7, IN THE OPPOSITE ORDER OF SETTING
O.REM: CLR E ;REMOVE ALL BREAKPOINTS
O.R1: MOV O.ADR1(E),A
CMP A,#-1
BEQ O.R2
.IFNZ M1145
MOV A,B
MOV O.BPM(E),A
JSR PC,CHMODE
MOV B,A
.ENDC
JSR PC,GETWRD
MOV O.UIN(E),@WDINC
JSR PC,WRTWRD
O.R2: TST (E)+
CMP E,#O.BKP
BLE O.R1 ;RE-LOOP UNTIL DONE
RTS F ;THEN QUIT
;TYPE OUT NUMBER IN A, OCTAL OR SIGNED DECIMAL AS PER TEMPDF
;PURELY OCTAL TYPEOUT CAN JSR TO TYPOCT, DECIMAL TO TYPDEC
TYPNUM: TSTB TEMPDF
BNE TYPDEC ;DECIMAL
TYPOCT: MOV #NUMBUF+7,D ;OCTAL
TYPOC1: MOV A,E
BIC #177770,E
ADD #'0,E ;GET CHARACTER
MOVB E,-(D) ;STORE IT
ASR A
ASR A
ASR A ;SHIFT IN NEXT OCTAL DIGIT
BIC #160000,A ;MASK OFF SIGN BITS
BNE TYPOC1
TYPOC2: MOV #DNTTYP,E
MOVB E,-(D) ;FILL IN REST OF BUFFER
TYPOC3: CMP #NUMBUF,D ;END TEST
BNE TYPOC2
JSR 5,TYPE
NUMBUF: 0 ;MAX IS 7 CHARACTERS (-XXXXX.)
0
0
0
RTS 5
TYPDEC: MOV #NUMBUF+7,D
MOVB #'.,-(D)
MOV A,-(SP)
BPL TYPDE1
NEG A
TYPDE1:
MOV A,SCRTCH ;DIVIDEND
TYPDE2: DIVIDE SCRTCH,#12,SCRTCH,E
ADD #'0,E ;ABS REMAINDER
MOVB E,-(D)
TST SCRTCH ;QUOTIENT
BNE TYPDE2
MOV (SP)+,A
BPL TYPOC3
MOVB #'-,-(D)
BR TYPOC3
;INSTRUCTION INPUT (IN...) AND OUTPUT (EX...) ROUTINES
; A UNKNOWN VALUE ARG TO EXINST; ALSO A SCRATCH REGISTER
; B FIRST SYMBOL WORD FROM INSN SYMBOL TABLE (RADIX-50)
; C SECOND SYMBOL WORD
; D INDEX TO MASKS AND SERVICE ROUTINES TABLES
; E INSN VALUE TABLE POINTER
; F INSN SYMBOL TABLE POINTER
;INPUT THE INSN WHOSE SYMBOL IS IN R50SYL+0,+2
ININST: CLR D ;INITIALIZE POINTERS
MOV #INVALS,E
MOV #INSYMS,F
CLR INBYTE
ININ1: JSR PC,INNEXT
BR ININ3 ;NO SUCH INSN
TST (E)+
CMP R50SYL,B
BNE ININ1 ;FIRST SYMBOL WORDS UNEQUAL
CMP R50SYL+2,C
BEQ ININ2 ;FOUND
TST #0
INBYTE=.-2 ;NONZERO IF THIS INSN HAS A BYTE MODE
BEQ ININ1
CMP R50SYL+2,#2*50*50 ;RADIX-50 B FOR BYTE MODE
BNE ININ1
BIS #100000,VAL ;INSN IS IN BYTE MODE
ININ2: ADD -(E),VAL ;PICK UP VALUE
CLR LENTYI
JMP @ININ4(D) ;DISPATCH TO SERVICE ROUTINE
ININ3: JMP EVALS3 ;NO SUCH INSN
ININ4: INHALT ;INSN INPUT DISPATCH TABLE
INRTS
.IIF NZ M1145,INEMT ;FOR SPL
INCL
.IIF NZ M1140+M1145,INEMT ;FOR MARK
INJMP
INBR
INEMT ;FOR EMT, TRAP
.IIF NZ FPP,INASH
.IIF NZ FPP,INSTF
.IIF NZ M1140+M1145,INSOB
INJSR
.IIF NZ M1140+M1145,INASH
INADD
;OUTPUT THE INSN WHOSE VALUE IS IN A
EXINST: MOV A,EXIN2
CLR D ;INITIALIZE POINTERS
MOV #INVALS,E
MOV #INSYMS,F
CLR INBYTE
EXIN1: JSR PC,INNEXT
BR EXIN4 ;NO SUCH INSN
MOV #0,A
EXIN2=.-2 ;SAVED ARGUMENT VALUE
BIC MASKS(D),A ;CLEAR NON-OP-CODE BITS
CMP (E)+,A
BEQ EXIN3 ;FOUND
TST INBYTE
BEQ EXIN1 ;NOT A BYTE MODE INSN
BIC #100000,A
CMP -2(E),A
BNE EXIN1 ;KEEP LOOKING
MOV #2*50*50,C ;RADIX-50 B FOR BYTE MODE
EXIN3: MOV D,-(SP) ;SAVE DISPATCH INDEX
MOV B,AINST
MOV C,AINST+2
JSR 5,TYPE50 ;TYPE INSN OP CODE
JSR PC,TYP3SP
MOV EXIN2,A ;RESTORE VALUE
MOV (SP)+,D ;RESTORE DISPATCH INDEX
JMP @EXIN5(D) ;DISPATCH TO SERVICE ROUTINE
EXIN4: ADD #2,(SP) ;NO SUCH INSN
RTS PC ;SKIP-RETURN
EXIN5: EXHALT ;INSN OUTPUT DISPATCH TABLE
EXRTS
.IIF NZ M1145,EXEMT ;FOR SPL
EXCL
.IIF NZ M1140+M1145,EXEMT ;FOR MARK
EXJMP
EXBR
EXEMT ;FOR EMT, TRAP
.IIF NZ FPP,EXASH
.IIF NZ FPP,EXSTF
.IIF NZ M1140+M1145,EXSOB
EXJSR
.IIF NZ M1140+M1145,EXASH
EXADD
;PICK UP NEXT INSN FROM INSN TABLES, FOR ININST OR EXINST
;THIS ROUTINE UPDATES D & F, BUT CALLING ROUTINE MUST DO E
INNEX0: ADD (F)+,PC ;GOES TO INNEX1, INNEX2 OR INNEX5
INNEX1: TST (D)+ ;UPDATE MASK AND DISPATCH INDEX
CLR INBYTE ;RESET BYTE MODE FLAG
BR INNEXT
INNEX2: INC INBYTE ;NEXT INSN(S) HAVE A BYTE MODE
INNEXT: TSTB 1(F) ;ENTRY POINT
BEQ INNEX0 ;UPDATE POINTERS, FLAGS
MOV (F)+,B ;FIRST SYMBOL WORD
CLR C
TST (F)
BPL INNEX4 ;BR IF SYMBOL IS ONLY 1 WORD LONG
MOV (F)+,C ;SECOND SYMBOL WORD
BIC #100000,C ;CLEAR SECOND-WORD FLAG
.IFNZ M40FPU+FPP
ROR C
BCC INNEX3
BIS #40000,C ;FDIV, STEXP & LDEXP NEED HIGH BIT ON
INNEX3: ASL C
.ENDC
INNEX4: ADD #2,(SP) ;SKIP-RETURN IF HAVE INSN
INNEX5: RTS PC ;NO SKIP IF AT END OF INSNS
;IN INSYMS TABLE,
;INNEX1-INNEX1 => UPDATE MASK & DISPATCH LOCATION INDEX
;INNEX2-INNEX1 => SET BYTE MODE FLAG FOR NEXT INSNS
;INNEX5-INNEX1 => END OF SYMBOL TABLE
MASKS: 0 ;ONES IN NON-OP-CODE BITS
7
.IIF NZ M1145,7
17
.IIF NZ M1140+M1145,77
77
377
377
.IIF NZ FPP,377
.IIF NZ FPP,377
.IIF NZ M1140+M1145,777
777
.IIF NZ M1140+M1145,777
7777
;INSN INPUT SERVICE ROUTINES
INRTS: JSR PC,REEVAL ;GET A GENERAL REGISTER
;REGINF NOT TESTED TO ALLOW SINGLE NUMERAL, LIKE RTS 5
BIT #177770,E
BNE ABORT3 ;INVALID REGISTER NUMBER
INRTS1: ADD E,VAL
INHALT: RTS PC
.IFNZ FPP+M1140+M1145
INASH: JSR PC,INSSDD ;GET SOURCE
CMPB #',,@PARSEP
BNE ABORT3 ;COMA MUST BE SEPERATOR
INC PARSEP
JSR PC,REEVAL ;GET REGISTER
TSTB REGINF
BEQ ABORT3 ;NOT A REGISTER
BITB #200,VAL+1
BEQ .INAS1 ;FPP INSTRUCTION REGS < 4
BIT #4,E
BNE ABORT3 ;ILLEGAL REGISTER
.INAS1: CMPB #162,VAL+1
BNE .INAOK ;IS IT A DIVIDE?
BIT #1,E
BNE ABORT3 ;REG MUST BE EVEN
.INAOK: SWAB E
ASR E ;PUT REGISTER IN PROPER FIELD
ASR E
ADD E,VAL
RTS PC
.ENDC
.IFNZ FPP
INSTF: JSR PC,INRTS
BIT #4,E
BNE ABORT3 ;INVALID FPP REGISTER NUMBER
BR INADD1
.ENDC
INJSR: JSR PC,INRTS
BR INADD1
INADD: JSR PC,INSSDD
INADD1: JSR PC,INSHOV
INJMP: JMP INSSDD ;WHICH DOES RTS FOR US
INSHOV: MOVB VAL,E ;SHOVE NEW FIELD IN VAL LEFT 6 BITS
CLRB VAL
SWAB E
ROR E
ROR E
ADD E,VAL
CMPB #',,@PARSEP ;COMMA MUST SEPARATE FIELDS
BNE ABORT3
INC PARSEP ;PASS OVER COMMA
RTS PC
.IFNZ M1140+M1145
INSOB: JSR PC,INRTS
JSR PC,INSHOV
JSR PC,REEVAL
TSTB REGINF
BNE ABORT3 ;NO SOB TO A REGISTER
NEG E
ADD CURADR,E
ASR E
INC E
BIT #177700,E
BEQ INRTS1 ;OK
BR ABORT3 ;OFFSET OUT OF RANGE
.ENDC
INBR: JSR PC,REEVAL
TSTB REGINF
BNE ABORT3 ;NO BR TO A REGISTER
BIT #1,E
BNE ABORT3 ;NO ODD ADDRESS
SUB CURADR,E
ASR E
ADD #200-1,E
BIT #177400,E
BNE ABORT3 ;OFFSET OUT OF RANGE
SUB #200,E
BIC #177400,E
BR INRTS1
INEMT: MOV MASKS(D),INEMT1
JSR PC,REEVAL
TSTB REGINF
BNE ABORT3 ;ARG CANNOT BE REGISTER QUANTITY
MOV #0,D
INEMT1=.-2 ;MASK OF NON-OP-CODE BITS
COM D
BIT D,E
BEQ INRTS1
ABORT3: JMP DCDERR ;ARG TOO LARGE FOR FIELD
INCL1: BISB INCL5-1(B),VAL
INCL2: INC PARSEP ;GO TO NEXT CHAR
INCL: CLR A
MOVB @PARSEP,A ;ENTRY POINT, PICK UP CHAR
CMP #40,A
BEQ INCL2 ;IGNORE SPACES
CLR B
INCL3: INC B
CMPB INCL4-1(B),A
BEQ INCL1 ;CHAR MATCHES
BIT #4,B
BEQ INCL3 ;KEEP LOOKING
RTS PC ;GOT TO TERMINATOR CHAR
INCL4: .BYTE 'C,'V,'Z,'N
INCL5: .BYTE 1,2,4,10
;INSN OUTPUT SERVICE ROUTINES
EXCL: CLR B
EXCL1: INC B
BITB INCL5-1(B),A
BEQ EXCL3
MOVB INCL4-1(B),EXCL2
JSR 5,TYPE
EXCL2: 0
EXCL3: BIT #4,B
BEQ EXCL1
RTS PC
EXRTS: BIC #177770,A
BISB #1,REGINF
EXRTS1: JSR 5,SYMBL0
EXHALT: RTS PC ;SAVE A WORD IF MAKE SYMBOL USE PC, NOT F ***
.IFNZ FPP+M1140+M1145
EXASH: JSR PC,EXSSDD ;PRINT SOURCE OPERAND
JSR 5,TYPE
',
MOV EXIN2,A ;GET INSTRUCTION
BIT #100000,A
BEQ EXAS1
BIC #400,A ;FPP INSTRUCTIONS HAVE SMALL REG NUMBERS
EXAS1: ROL A
ROL A
SWAB A ;GET THE DESTINATION REGISTER
BR EXRTS ;GO PRINT IT
.ENDC
.IFNZ FPP
EXSTF: BIC #400,A ;ONLY 2 BITS IN AC FIELD
.ENDC
EXJSR: ROL A
ROL A
SWAB A
JSR PC,EXRTS
BR EXADD1
EXADD: ROL A
ROL A
SWAB A
JSR PC,EXSSDD
EXADD1: JSR 5,TYPE
',
EXJMP: MOV EXIN2,A
JMP EXSSDD ;WHICH DOES RTS FOR US
.IFNZ M1140+M1145
EXSOB: ROL A
ROL A
SWAB A
JSR PC,EXRTS
JSR 5,TYPE
',
MOV EXIN2,B
BIC #177700,B
DEC B
ASL B
MOV CURADR,A
SUB B,A
BR EXBR1
.ENDC
EXBR: MOVB A,A ;EXTEND SIGN
INC A
ASL A
ADD CURADR,A
EXBR1: CLRB REGINF
BR EXRTS1
EXEMT: MOV MASKS(D),B
COM B
BIC B,A
JSR 5,TYPNUM
RTS PC ;SAVE A WORD IF MAKE TYPNUM USE PC, NOT F ***
;TYPE LOW 6 BITS OF A AS SOURCE OR DESTINATION FIELD
EXSSDD: MOV A,F
BIC #177707,A ;ADDRESSING MODE
BIC #177770,F ;REGISTER
ASR A
ASR A
CMP #7,F
BNE EXSD1
INC A ;REGISTER IS PC
EXSD1: MOVB EXSDM(A),-(SP) ;PICK UP BYTE OF CONTROL BITS
BIT #200,(SP)
BEQ EXSD2
JSR 5,TYPE
'@
EXSD2: BIT #100,(SP)
BEQ EXSD3
JSR 5,TYPE
'#
EXSD3: BIT #60,(SP)
BEQ EXSD7
ADD #2,LENGTH ;GET NEXT WORD OF INSTRUCTION
MOV LENGTH,A
.IFZ M1145
ADD WDINC,A
MOV (A),A
.ENDC
.IFNZ M1145
ADD #WDINC,A
BIT #1,@A
BNE GETERR ;BR IF WORD FLAGGED AS NOT ACCESSIBLE
MOV @(A),A
.ENDC
BIT #40,(SP)
BNE EXSD4
ADD CURADR,A
ADD LENGTH,A
ADD #2,A
EXSD4: MOV SYMTOL,EXSD6
BIT #20,(SP)
BNE EXSD5
CLR SYMTOL ;SYMBOL MUST MATCH EXACTLY
EXSD5: CLRB REGINF
JSR 5,SYMBL0
MOV #0,SYMTOL
EXSD6=.-4 ;SAVED SYMBOL TYPER'S OFFSET TOLERANCE
EXSD7: BIT #10,(SP)
BEQ EXSD8
JSR 5,TYPE
'-
EXSD8: BIT #4,(SP)
BEQ EXSD9
JSR 5,TYPE
'(
EXSD9: BIT #2,(SP)
BEQ EXSD10
MOV F,A ;REGISTER
BISB #1,REGINF
JSR 5,SYMBL0
EXSD10: BIT #4,(SP)
BEQ EXSD11
JSR 5,TYPE
')
EXSD11: BIT #1,(SP)+ ;FINALLY DONE WITH MAGIC BITS
BEQ EXSD12
JSR 5,TYPE
'+
EXSD12: RTS PC
.IFNZ M1145
GETERR: TSTB 1(A) ;DECODE ERROR AS SLE OR NXM
BEQ NXMRR
SLERR: JSR 5,TYPE
.ASCIZ /SLE/
.EVEN
JMP DCDERR
NXMRR: JMP NXMER
.ENDC
CURADR: 0 ;CURRENT ADDRESS FOR INSTRUCTION TO SEEM LOCATED AT
;( = DOT OR BPT LOCATION)
;SOURCE OR DESTINATION FIELD CONSISTS OF ...
; <@> <#> <X,N,A> <-> <(> <R> <)> <+>
;WHERE EACH FIELD MAY ALSO BE NULL
;FOLLOWING TABLE OF MAGIC BITS CODES OPTIONS FOR EACH ADDRESSING MODE
;200 BIT ON SAYS TYPE AN @, 100 BIT SAYS TYPE A #, ETC.
;BOTH ( AND ) ARE SPECIFIED BY 4 BIT, AND 60 BITS SAY ...
;00 => NULL
;01 => NEXT WORD + CURADR + LENGTH + 2
;10 => NEXT WORD, WITH OFFSET TOLERANCE = 0
;11 => NEXT WORD
EXSDM: .BYTE 002 ;0R R MODE
.BYTE 002 ;07=0R
.BYTE 006 ;1R (R)
.BYTE 006 ;17=1R
.BYTE 007 ;2R (R)+
.BYTE 160 ;27 #N
.BYTE 207 ;3R @(R)+
.BYTE 360 ;37 @#A
.BYTE 016 ;4R -(R)
.BYTE 016 ;47=4R
.BYTE 216 ;5R @-(R)
.BYTE 216 ;57=5R
.BYTE 046 ;6R X(R)
.BYTE 020 ;67 A
.BYTE 246 ;7R @X(R)
.BYTE 220 ;77 @A
;PARSE A TYPED-IN SOURCE OR DESTINATION FIELD, PUTTING RESULT IN
;LOW 6 BITS OF VAL, AND ANY MORE INSN WORDS IN VAL+2 OR +4
INSSDD: JSR PC,REEVAL
TST C
BNE INSD1 ;ARG BEFORE @ MUST BE NULL
CMP #'@,A
BNE INSD1 ;TERMINATOR NOT @
BIS #10,VAL ;@ SEEN, DEFERRED MODE
INC PARSEP
JSR PC,REEVAL
INSD1: TSTB REGINF
BNE MOD0 ;REGISTER MODE, RN, 0R
TST C
BNE INSD2 ;PARSED STRING IS NOT NULL
CMP #'(,A
BEQ INSD3 ;(RN) OR (RN)+
CMP #'#,A
BNE ABORT1 ;NO SUCH MODE
BIS #27,VAL ;IMMEDIATE MODE, #N, 27
INC PARSEP
JSR PC,REEVAL
TSTB REGINF
BNE ABORT1 ;NO #RN MODE
JSR PC,INCLEN
BR INSD2A
INSD2: CMP #'(,A
BEQ INSD4 ;X(RN) OR -(RN)
BIS #67,VAL ;ABSOLUTE MODE, A, 67
JSR PC,INCLEN
MOV LENTYI,B
TST (B)+
ADD DOT,B
SUB B,E
INSD2A: MOV E,(D)
RTS PC
INSD3: INC PARSEP
JSR PC,INREG
CMPB #'+,@PARSEP
BNE MOD1 ;(RN), WHICH SHOULD BE LIKE @RN
BIS #20,VAL ;AUTOINCREMENT MODE, (RN)+, 2R
BR INREGA ;INC PARSEP AND RTS
MOD1: BIT #10,VAL
BNE MOD7F ;@(RN), WHICH SHOULD BE LIKE @0(RN)
BIS #10,VAL
RTS PC
INSD4: CMP #1,C
BNE MOD6 ;INDEX MODE, X(RN), 6R
MOV PARSEP,C
CMPB #'-,-(C) ;IS THE ONE PARSED CHAR - ?
BNE MOD6 ;NO, THIS ALSO MEANS INDEX MODE
BIS #40,VAL ;AUTODECREMENT MODE, -(RN), 4R
BR MOD6A
MOD6: JSR PC,INCLEN
MOV E,(D)
BIS #60,VAL
MOD6A: INC PARSEP
INREG: JSR PC,REEVAL ;PARSE A REGISTER VALUE
TSTB REGINF
BEQ ABORT1 ;MUST BE REGISTER
CMP #'),A
BNE ABORT1 ;TERMINATOR MUST BE )
INREGA: INC PARSEP ;PASS OVER ) (OR + OF (RN)+ MODE)
MOD0: BIT #177770,E
BNE ABORT1 ;INVALID REGISTER NUMBER
BIS E,VAL ;DEPOSIT REGISTER NUMBER
RTS PC
MOD7F: BIS #70,VAL ;FUDGE @(RN) INTO @0(RN)
JSR PC,INCLEN
CLR (D)
RTS PC
INCLEN: ADD #2,LENTYI ;INSTRUCTION IS ANOTHER WORD LONG
MOV #VAL,D
ADD LENTYI,D ;MAKE D POINT TO CURRENT WORD
RTS PC
ABORT1: JMP O.ERR ;FATAL ERROR IN INSSDD
VAL: 0 ;TYPED-IN INSTRUCTION GETS ASSEMBLED HERE
0
0
LENTYI: 0 ;LENGTH OF INSTRUCTION IN VAL, -2 BYTES
;INSN SYMBOL TABLE -- 1ST WORD IS JUST RADIX-50
;2ND WORD, IF NOT NULL, IS RADIX-50 PLUS 100000,
;UNLESS IT IS V OR XP -- THEN IT IS RADIX-50 PLUS 1
;LEFT BYTE ZERO INDICATES CONTROL WORD, AS NOTED
INSYMS:
031064 ;\HAL\
176400 ;\T \+100000
107761 ;\WAI\ < 0 OK SINCE AFTER A 2-WD INSN
176400 ;\T \+100000
071651 ;\RTI\
007424 ;\BPT\
035254 ;\IOT\
070533 ;\RES\
121140 ;\ET \+100000
.IFNZ M1140+M1145
071664 ;\RTT\
.ENDC
054750 ;\NOP\
.IFNZ FPP
011663 ;\CFC\
111300 ;\C \+100000
073634 ;\SET\
122600 ;\F \+100000
073634 ;\SET\
134100 ;\I \+100000
073634 ;\SET\
114400 ;\D \+100000
073634 ;\SET\
145400 ;\L \+100000
.ENDC
0 ;CHANGE TO MASK = 7, RTS SERVICE ROUTINE
071663 ;\RTS\
.IFNZ M40FPU
022654 ;\FAD\
114400 ;\D \+100000
024215 ;\FSU\
106200 ;\B \+100000
023635 ;\FMU\
145400 ;\L \+100000
023051 ;\FDI\
104601 ;\V \+ ONLY 1 SINCE ALREADY NEGATIVE
.ENDC
.IFNZ M1145
0 ;KEEP MASK = 7, CHANGE TO EMT SERVICE ROUTINE
074514 ;\SPL\
.ENDC
0 ;CHANGE TO MASK = 17, CL SERVICE ROUTINE
012240 ;\CL \
073610 ;\SE \
0 ;CHANGE TO MASK = 77, EMT OR JMP SERVICE ROUTINE
.IFNZ M1140+M1145
050572 ;\MAR\
142300 ;\K \+100000
0 ;KEEP MASK = 77, CHANGE TO JMP SERVICE ROUTINE
051100 ;\MFP\
134100 ;\I \+100000
052160 ;\MTP\
134100 ;\I \+100000
075224 ;\SXT\
.ENDC
.IFNZ M1145
051100 ;\MFP\
114400 ;\D \+100000
052160 ;\MTP\
114400 ;\D \+100000
.ENDC
040230 ;\JMP\
075131 ;\SWA\
106200 ;\B \+100000
.IFNZ FPP
045646 ;\LDF\
163370 ;\PS \+100000
074746 ;\STF\
163370 ;\PS \+100000
074763 ;\STS\
176400 ;\T \+100000
012262 ;\CLR\
122600 ;\F \+100000
012262 ;\CLR\
114400 ;\D \+100000
100014 ;\TST\ < 0 OK SINCE AFTER A 2-WD INSN
122600 ;\F \+100000
100014 ;\TST\ < 0 OK SINCE AFTER A 2-WD INSN
114400 ;\D \+100000
003243 ;\ABS\
122600 ;\F \+100000
003243 ;\ABS\
114400 ;\D \+100000
054117 ;\NEG\
122600 ;\F \+100000
054117 ;\NEG\
114400 ;\D \+100000
.ENDC
INNEX2-INNEX1 ;SET BYTE MODE FLAG
100014 ;\TST\ FIRST SINCE THE WORD IS NEGATIVE
012262 ;\CLR\
012445 ;\COM\
035163 ;\INC\
014713 ;\DEC\
054117 ;\NEG\
003343 ;\ADC\
073423 ;\SBC\
071352 ;\ROR\
071344 ;\ROL\
004512 ;\ASR\
004504 ;\ASL\
0 ;CHANGE TO MASK = 377, BR SERVICE ROUTINE
007520 ;\BR \
007265 ;\BNE\
006531 ;\BEQ\
006635 ;\BGE\
007164 ;\BLT\
006654 ;\BGT\
007145 ;\BLE\
007414 ;\BPL\
007221 ;\BMI\
006711 ;\BHI\
007157 ;\BLO\
173300 ;\S \+100000
007763 ;\BVC\
010003 ;\BVS\
006373 ;\BCC\
006711 ;\BHI\
173300 ;\S \+100000
006413 ;\BCS\
007157 ;\BLO\
0 ;KEEP MASK = 377, CHANGE TO EMT SERVICE ROUTINE
020534 ;\EMT\
077721 ;\TRA\
162000 ;\P \+100000
.IFNZ FPP
0 ;KEEP MASK = 377, CHANGE TO ASH SERVICE ROUTINE
052224 ;\MUL\
122600 ;\F \+100000
052224 ;\MUL\
114400 ;\D \+100000
051634 ;\MOD\
122600 ;\F \+100000
051634 ;\MOD\
114400 ;\D \+100000
003344 ;\ADD\
122600 ;\F \+100000
003344 ;\ADD\
114400 ;\D \+100000
045646 ;\LDF\
045644 ;\LDD\
075012 ;\SUB\
122600 ;\F \+100000
075012 ;\SUB\
114400 ;\D \+100000
012330 ;\CMP\
122600 ;\F \+100000
012330 ;\CMP\
114400 ;\D \+100000
015176 ;\DIV\
122600 ;\F \+100000
015176 ;\DIV\
114400 ;\D \+100000
045645 ;\LDE\
114201 ;\XP \+ ONLY 1 SINCE ALREADY NEGATIVE
045643 ;\LDC\
134460 ;\IF \+100000
045643 ;\LDC\
134340 ;\ID \+100000
045643 ;\LDC\
145760 ;\LF \+100000
045643 ;\LDC\
145640 ;\LD \+100000
045643 ;\LDC\
114760 ;\DF \+100000
045643 ;\LDC\
123040 ;\FD \+100000
0 ;KEEP MASK 377, CHANGE TO STF SERVICE ROUTINE
074746 ;\STF\
074744 ;\STD\
074745 ;\STE\
114201 ;\XP \+ ONLY 1 SINCE ALREADY NEGATIVE
074743 ;\STC\
123350 ;\FI \+100000
074743 ;\STC\
123540 ;\FL \+100000
074743 ;\STC\
115150 ;\DI \+100000
074743 ;\STC\
115340 ;\DL \+100000
074743 ;\STC\
123040 ;\FD \+100000
074743 ;\STC\
114760 ;\DF \+100000
.ENDC
0 ;CHANGE TO MASK = 777, SOB OR JSR SERVICE ROUTINE
.IFNZ M1140+M1145
074432 ;\SOB\
0 ;KEEP MASK = 777, CHANGE TO JSR SERVICE ROUTINE
114152 ;\XOR\ OK SINCE AFTER 0
.ENDC
040612 ;\JSR\
.IFNZ M1140+M1145
0 ;KEEP MASK 777,CHANGE TO ASH SERVICE ROUTINE
052224 ;\MUL\
015176 ;\DIV\
004500 ;\ASH\
004500 ;\ASH\
111300 ;\C \+100000
.ENDC
0 ;CHANGE TO MASK = 7777, ADD SERVICE ROUTINE
003344 ;\ADD\
075012 ;\SUB\
INNEX2-INNEX1 ;SET BYTE MODE FLAG
051656 ;\MOV\
012330 ;\CMP\
006774 ;\BIT\
006753 ;\BIC\
006773 ;\BIS\
INNEX5-INNEX1 ;END OF SYMBOL TABLE
;INSN VALUE TABLE
INVALS: 0 ;HALT
1 ;WAIT
2 ;RTI
3 ;BPT
4 ;IOT
5 ;RESET
.IFNZ M1140+M1145
6 ;RTT
.ENDC
240 ;NOP
.IFNZ FPP
170000 ;CFCC
170001 ;SETF
170002 ;SETI
170011 ;SETD
170012 ;SETL
.ENDC
200 ;RTS
.IFNZ M40FPU
75000 ;FADD
75010 ;FSUB
75020 ;FMUL
75030 ;FDIV
.ENDC
.IFNZ M1145
230 ;SPL
.ENDC
240 ;CL
260 ;SE
.IFNZ M1140+M1145
6400 ;MARK
6500 ;MFPI
6600 ;MTPI
6700 ;SXT
.ENDC
.IFNZ M1145
106500 ;MFPD
106600 ;MTPD
.ENDC
100 ;JMP
300 ;SWAB
.IFNZ FPP
170100 ;LDFPS
170200 ;STFPS
170300 ;STST
170400 ;CLRF
170400 ;CLRD
170500 ;TSTF
170500 ;TSTD
170600 ;ABSF
170600 ;ABSD
170700 ;NEGF
170700 ;NEGD
.ENDC
5700 ;TST(B)
5000 ;CLR(B)
5100 ;COM(B)
5200 ;INC(B)
5300 ;DEC(B)
5400 ;NEG(B)
5500 ;ADC(B)
5600 ;SBC(B)
6000 ;ROR(B)
6100 ;ROL(B)
6200 ;ASR(B)
6300 ;ASL(B)
400 ;BR
1000 ;BNE
1400 ;BEQ
2000 ;BGE
2400 ;BLT
3000 ;BGT
3400 ;BLE
100000 ;BPL
100400 ;BMI
101000 ;BHI
101400 ;BLOS
102000 ;BVC
102400 ;BVS
103000 ;BCC
103000 ;BHIS
103400 ;BCS
103400 ;BLO
104000 ;EMT
104400 ;TRAP
.IFNZ FPP
171000 ;MULF
171000 ;MULD
171400 ;MODF
171400 ;MODD
172000 ;ADDF
172000 ;ADDD
172400 ;LDF
172400 ;LDD
173000 ;SUBF
173000 ;SUBD
173400 ;CMPF
173400 ;CMPD
174400 ;DIVF
174400 ;DIVD
176400 ;LDEXP
177000 ;LDCIF
177000 ;LDCID
177000 ;LDCLF
177000 ;LDCLD
177400 ;LDCDF
177400 ;LDCFD
174000 ;STF
174000 ;STD
175000 ;STEXP
175400 ;STCFI
175400 ;STCFL
175400 ;STCDI
175400 ;STCDL
176000 ;STCFD
176000 ;STCDF
.ENDC
.IFNZ M1140+M1145
77000 ;SOB
74000 ;XOR
.ENDC
4000 ;JSR
.IFNZ M1140+M1145
70000 ;MUL
71000 ;DIV
72000 ;ASH
73000 ;ASHC
.ENDC
60000 ;ADD
160000 ;SUB
10000 ;MOV(B)
20000 ;CMP(B)
30000 ;BIT(B)
40000 ;BIC(B)
50000 ;BIS(B)
SYMBAD: MOVB REGFLG,REGINF
JSR F,SYMBOL
CLRB REGINF
RTS F
;# IS IN A
SYMBL0: MOV A,ADR2 ;ENTRY FROM INSN DECODER, SO UPDATE ADDRESS
MOVB REGINF,ADR2F
SYMBOL: TSTB TEMPAF ;NORMAL ENTRY TO TYPE A SYMBOL
BNE SYMABS ;TYPE ADDRESSES AS ABSOLUTE
SYMBL2: MOV A,SAVSYM
CLR C
CLR AINST
MOV #O.BSYM,B
CLR D
SYMLOP: ASL D
BNE SYMBL1
TST -(B)
MOV B,E ;E CONTAINS ADDRSS
TST -(B)
INC D
SYMBL1: SUB #6,B
MOV #0,A ;GET BACK INITIAL ARG
SAVSYM=.-2
CMP B,O.SYME
BLO SYMLPE
SUB 4(B),A
BLO SYMLOP
CMP A,#200 ;SHOULD MAYBE BE 300 OR 400, AND INFINITE IF $S TYPED ***
SYMTOL=.-2 ;HOW CLOSE SYMBOL MUST MATCH TO GET TYPED SYM+OFFSET
BHI SYMLOP
CMP C,4(B) ;FINDING LARGEST SYMBOL NOT > #
BHI SYMLOP
BIT D,-2(E)
BNE SYMLOP ;HALF KILLED
TSTB REGINF ;SYMBOL'S REG FLAG MUST BE SAME AS VALUE'S
BNE SYMBL3
BIT D,(E)
BNE SYMLOP
BR SYMBL4
SYMBL3: BIT D,(E)
BEQ SYMLOP
SYMBL4: MOV 4(B),C ;REPLACE OLD LARGEST
MOV (B),AINST
MOV 2(B),AINST+2
BR SYMLOP
SYMLPE: SUB C,A ;WANT TO TYPE FOO + NUMBER
MOV A,-(SP) ;SAVE NUMBER
TST AINST ;IF ZERO NO SYMBOL FOUND
BEQ .SYMPE
JSR 5,TYPE50
TST (SP)
BNE SYP
TST (SP)+
RTS 5
SYP: JSR 5,TYPE
.ASCIZ /+/
.EVEN
SYMPE1: MOV (SP)+,A
JMP TYPNUM
SYMABS: MOV A,-(SP)
.SYMPE: TSTB REGINF
BEQ SYMPE1
JSR 5,TYPE
.ASCIZ /%/
.EVEN
BR SYMPE1
CRLF: JSR 5,TYPE
.BYTE 15
.BYTE 12
.BYTE 177
.BYTE 177
.BYTE 177
.IFNZ KL11
.BYTE 177
.BYTE 177
.BYTE 177 ;6 NULLS FOR TIMING
.ENDC
.BYTE 0
.EVEN
RTS PC
O.SYLL: BIC #1,DOTFLG ;MAKE DOTFLG AGREE WITH REGFLG
ADD REGFLG,DOTFLG
MOV #O.BSYM,B ;LOOK UP SYMBOL
CLR D
O.SLL2: ASL D
BNE O.SLL3
TST -(B)
MOV B,O.FLGS
TST -(B) ;SKIP OVER HALF KILLED FLAGS BY -2
INC D
O.SLL3: SUB #6,B
CMP B,O.SYME
BLO O.SLL1
CMP (B),O.SYL
BNE O.SLL2
CMP 2(B),O.SYL+2
BNE O.SLL2
MOV #1,C
MOV 4(B),E ;VALUE TO E
MOV D,O.BIT
RTS PC
O.SLL1: CLR O.BIT
RTS PC
SAVDEC: 0 ;DECIMAL NUMBER BEING ACCUMULATED
O.FLGS: 0
O.BIT: 0
;THIS ROUTINE TAKES CHAR FROM TTY AND STORES IT IN BUFFER. HANDLES
;RUBOUT, QUOTE CHARACTERS (&,",') AND SETS DONEF WHEN A COMMAND CHAR
;OR ANYTHING FOLLOWING ALTMODE(S) IS READ. CONVERTS LOWER CASE TO UPPER.
;IN MAY BE CALLED WHENEVER USER MIGHT BE TYPING AND RUG NOT LISTENING.
;ONLY NON-QUOTABLE CHARS: NULL (0), RUBOUT (177), AND ALTMODE (175) BECOMES ESCAPE (33)
INCHK: TSTB O.RCSR ;CHECK FOR TTY INPUT
BPL INCHKR
JSR PC,READCH ;ITS THERE SO GET IT
MOVB A,@TNPNTR ;PUT IT IN BUFFER
CMP TNPNTR,#TBUFFE-1
BHIS INCK2
INC TNPNTR
INCK2: CLRB @TNPNTR
INCHKR: RTS PC ;NO INPUT
IN: MOV B,-(SP)
MOV #QUOTFL,B
JSR PC,TYPCHS
TSTB A
BEQ INRET ;DON'T STORE NULLS
CMP #177,A
BEQ RUBOUT
CMP #175,A
BNE NOT175
MOV #33,A ;ALTMODE CONVERTED TO ESCAPE
NOT175: TST (B) ;QUOTE MODE?
BEQ NOTQT
SUB #401,(B) ;DECREMENT BOTH BYTES OF QUOTFL
TSTB (B) ;IS RIGHT BYTE ZERO YET (GOT ENOUGH CHARS?)
BNE STORE ;NO
CLR (B) ;FINISHED, CLEAR FLAG
BR STORE
NOTQT: MOV #QTBL,C ;TABLE OF CHARS CAUSING QUOTE MODE (&,",')
NOTQTL: TSTB (C)
BEQ NOTQ ;DONE SEARCHING TABLE
CMPB A,(C)+
BNE NOTQTL
ADD #177400-QTBL,C ;LOADS C WITH -1,,N, WHERE N =
;NUMBER OF CHARS TO FOLLOW
MOV C,(B) ;PLACE IT IN QUOTFL
NOTQ: CMP #140,A
BHIS CHKALT ;NOT LOWER CASE
CMP #172,A
BLO CHKALT ;TOO BIG FOR LETTER
SUB #40,A ;CONVERT TO UPPER CASE
CHKALT: CMP #33,A ;ALT NOT A COMMAND,
BEQ ESCAPE ;HANDLED ON THIS LEVEL INSTEAD
TSTB ALTF ;IS THIS A CHAR FOLLOWING ALTMODE(S)?
BEQ NOTALT
INCB DONEF ;DONE WHEN READ ANY CHAR FOLLOWING ALTMODES
NOTALT: MOV #NOALT,B
NTALTL: TSTB (B) ;SEARCH COMMAND TABLE FOR CHAR
BEQ STORE ;FELL OFF END OF TABLE
CMPB A,(B)+
BNE NTALTL
INCB DONEF ;GOT CHAR IN TABLE
BR STORE
ESCAPE: INCB ALTF
STORE: CMP INPNTR,#IBUFFE-1
BHIS INRET ;ALREADY AT END OF BUFFER
MOVB A,@INPNTR ;STORE CHAR
INC INPNTR
INRET: CLRB @INPNTR ;SO STRING ENDED WITH 0 BYTE
MOV (SP)+,B
RTS PC ;A CONTAINS CHAR TO BE ECHOED
RUBOUT: CMP INPNTR,#IBUFF ;RUBBING PAST BEGINNING?
BLOS INRET1 ;YES, IGNORE AND ECHO BELL
DEC INPNTR
MOVB @INPNTR,A
JSR PC,TYPCH ;ECHO RUBBED CAHR
TST (B)
BEQ RUB1
ADD #401,(B) ;INCREMENT BOTH BYTES OF QUOTFL
TSTB 1(B) ;IS LEFT BYTE ZERO YET?
BNE INRET
CLR (B) ;RUBBED PAST &, ", OR ' -- CLEAR QUOTFL
BR INRET
RUB1: CMP #33,A
BNE INRET
DECB ALTF ;RUBBED OUT AN ALTMODE
BR INRET
INRET1: JSR F,TYPE
.ASCIZ / ?/
.EVEN
BR INRET
QTBL: .BYTE '' ;TABLE OF QUOTING CHARS, TAKING 1, 2, 3 ARGS
.BYTE '"
.BYTE '&
.BYTE 0
QUOTFL: 0 ;WHEN SET, LEFT BYTE = -1, RIGHT BYTE = # OF
;QUOTED CHARS TO FOLLOW SO RUBOUT OR ENOUGH CHARS
;WILL EXIT FROM QUOTE MODE
ALTF: .BYTE 0 ;INC-ED WHEN ALTMODE READ
DONEF: .BYTE 0 ;INC-ED WHEN CHAR READ FOLLOWING ALTMODE(S),
;OR CHAR IN NOALT TABLE
READCH: TSTB O.RCSR
BPL READCH ;WAIT FOR TTY INPUT
READCI: MOVB O.RDB,A ;GET CHAR
CLRB O.RDB ;CLEAR FLAGS
BIC #177600,A
CMPB #KILCHR,A
BEQ READBK
RTS PC
READBK: MOV #O.UR0,SP
MOV #KILCHR,A
CLRB OPENF
JSR PC,TYPCH
JMP DCDERR
;TYPE A STRING F POINTS TO AND ENDED BY 0
TYPE: MOV A,-(SP)
TYPE1: MOVB (F)+,A
BEQ TYPR
JSR PC,TYPCH
JSR PC,INCHK
BR TYPE1
TYPR: TSTB (F)+ ;GET ON EVEN ADDRESS
BIC #1,F
MOV (SP)+,A
RTS F ;SINCE ARGUMENTS FOLLOW CALL, USE F, NOT PC
;THIS ROUTINE ECHOES ANYTHING TYPED WHILE RUG NOT REALLY
;LISTENING, THEN GETS REST OF COMMAND UNTIL COMMAND CHAR SEEN.
INPUT: MOV #TBUFF,B
MOV #IBUFF,INPNTR
CLR ALTF ;INITIALIZE IN
INPUT1: MOVB (B)+,A
BEQ INPUT3 ;END OF STRING MARKED WITH ZERO BYTE
JSR PC,IN ;PROCESS CHARS THAT HAVE BEEN STORED
TSTB DONEF
BEQ INPUT1 ;COMMAND NOT FOUND
MOV #TBUFF,A
INPUT2: MOVB (B)+,(A)+ ;PACK DOWN INPUT BUFFER
BNE INPUT2
DEC A
MOV A,TNPNTR
BR INPUTR
INPUT3: MOV #TBUFF,TNPNTR ;BUFFER IS NOW EMPTY
CLRB TBUFF
INPUT4: JSR PC,READCH
JSR PC,IN ;GET NEW CHAR
TSTB DONEF
BEQ INPUT4
INPUTR: MOV INPNTR,SINPTR ;SAVE RESULTS FOR COMMAND DECODER
MOVB ALTF,SALTF
RTS PC ;BUT DON'T CALL "IN" UNTIL IBUFF ALL PROCESSED
TNPNTR: TBUFF
INPNTR: IBUFF ;POINTER INTO IBUFF
IBUFF: .BLKW 30 ;BYTES ARE SUCCESSIVE CHARACTERS TYPED IN
IBUFFE==.
TBUFF: 0
.BLKW 30-1
TBUFFE==.
;TYPE CHAR IN A, MAKE CONTROL CHARS ^CHAR,
;ALTMODE BECOMES $, TABS ARE 3 SPACES
GET1UC: MOVB TBUFF,A ;SEE IF ANY IN BUFFER
BEQ GTUC2
MOV B,-(SP)
MOV #TBUFF-1,B ;SHIFT BUFFER DOWN
GTUC1: CMPB (B)+,(B)+
MOVB (B),-(B)
BNE GTUC1
MOV B,TNPNTR
MOV (SP)+,B
BR GTUC3
GTUC2: JSR PC,READCH
GTUC3: CMP #140,A
BGE TYPCHS
CMP A,#173
BGE TYPCHS
SUB #40,A
TYPCHS: CMP #12,A ;ENTRY HERE SUPPRESSES TYPING OF CR AND LF
BEQ TYPCH5
CMP #15,A
BEQ TYPCH5
TYPCH: MOV A,-(SP)
TYPCHW: TSTB O.TCSR ;WAIT FOR TTO
BPL TYPCHW
BIC #200,A ;TAKE OUT 200 BIT (PARITY)
CMPB #7,A
BEQ TYPCH3 ;BELL, DON'T CONVERT TO ^G
CMPB #12,A
BEQ TYPCH3 ;LF, DON'T CONVERT TO ^J
CMPB #15,A
BEQ TYPCH3 ;CR, DON'T CONVERT TO ^M
CMPB #DNTTYP,A
BEQ TYPCH4 ;CHAR CODE TO SUPPRESS
CMPB #11,A
BNE TYPCH1
JSR PC,TYP3SP ;TAB BECOMES 3 SPACES
BR TYPCH4
TYPCH1: CMPB #33,A
BEQ TYPCH2
CMPB #175,A
BNE TYPC2A ;ESCAPE BECOME ALTMOE ALSO
TYPCH2: MOV #'$,A ;ALTMODE BECOMES $
TYPC2A: CMPB #40,A
BLOS TYPCH3
MOV #'^,O.TDB ;CONTROL CHAR
BIS #100,A
JSR PC,TYPCH
BR TYPCH4
TYPCH3: MOV A,O.TDB
TYPCH4: MOV (SP)+,A
TYPCH5: RTS PC
TYP3SP: JSR 5,TYPE ;TYPE 3 SPACES
.ASCIZ / /
.EVEN
RTS PC
;RADDIX-50 CODE
;R-50 CHAR ASCII
;0 BLANK DNTTYP OR 40
;1-32 A-Z 101-132
;33 $ 44
;34 . 56
;35 % 45
;36-47 0-9 60-71
R50TAB:
BLANK: .BYTE DNTTYP ;SPACE OR DNTTYP
.BYTE 'A,'B,'C,'D,'E,'F,'G,'H,'I,'J,'K,'L,'M
.BYTE 'N,'O,'P,'Q,'R,'S,'T,'U,'V,'W,'X,'Y,'Z
.BYTE '$,'.,'%
.BYTE '0,'1,'2,'3,'4,'5,'6,'7,'8,'9
;CONVERT ASCII CHAR IN A TO RADIX-50
;CLOBBERS B BUT SETS N IF NOT RADIX-50
ASCR50: CLR B
ASCR51: INC B ;WON'T MATCH WITH BLANK
CMPB R50TAB(B),A
BEQ ASCR52 ;FOUND CHAR
CMP #47,B
BNE ASCR51 ;KEEP LOOKING
NEG B ;NOT RADIX-50, RETURN NEGATIVE VALUE
ASCR52: MOV B,A
RTS PC
;TYPES AINST AND AINST+2, WHICH ARE RADIX-50
TYPE50: MOVB #DNTTYP,BLANK ;ZEROS BECOME DNTTYP
TYP50A: MOV #BUFF,D
MOV AINST,B
JSR 5,UNPACK
MOV AINST+2,B
BEQ TYP50B
JSR 5,UNPACK
TYP50B: CLRB (D)+
INC D
BIC #1,D
MOV #205,(D) ;205 IS RTS F -- MAKE IT RTS PC? ***
JSR 5,TYPE
BUFF: 0 ;WHEN MAXIMALLY FULL, HAS 6 BYTES OF DATA,
0 ;ONE ZERO BYTE, ONE WASTED BYTE, AND
0 ;RTS 5
0
0
AINST: 0 ;ARG TO TYPE50, USUALLY RADIX-50 FOR DECODED INSN
0
;THIS ROUTINE CONVERTS RAD50 TO ASCII
;NUMB GIVEN AND RETURNED IN A
FIFASC: TST A ;BUM -- CAN USE R50TAB ***
BNE FIFNO
MOVB BLANK,A ;EITHER SPACE OR DNTTYP
BR NUTHNG
FIFNO: CMP #33,A
BLT NUMB
BEQ DOLR
ADD #56,A ;LETTER, 57+11+11=101
NUMB: ADD #11,A ;PERIOD AND NUMBERS ARE +22
DOLR: ADD #11,A ;DOLLAR SIGN (ALT MODE)
NUTHNG: RTS 5
;THIS ROUTINE TAKES THREE CHARS IN B
;RETURNS 3 ASCII, AND DEPOSITS WHERE D POINTS
UNPACK: MOV #3100,C
JSR 5,SUBLOP
MOVB A,(D)+
MOV #50,C
JSR 5,SUBLOP
MOVB A,(D)+
MOV B,A
JSR 5,FIFASC
MOVB A,(D)+
RTS 5
SUBLOP: CLR A
SUBLP1: CMP C,B
BHI FIFASC
SUB C,B
INC A
BR SUBLP1
REEVAL: MOV VAL,-(SP) ;RECURSIVE ENTRY POINT TO EVAL
JSR PC,EVAL0
MOV (SP)+,VAL
RTS PC
;EVAL EVALUATES A STRING POINTED TO BY PARSEP, INCLUDING
;NUMBERS, SYMBOLS, QUOTED CHARS, SPACE=+, -, * AND ! (DIVIDE).
;IT SETS LENTYI, REGINF, UNDEFS, RETURNS TERMINATOR IN A,
;ARG FLAG (0 IF NO ARG) IN C, AND VALUE IN BOTH E AND VAL+0,+2,+4.
;RADIX-50 OF AN UNDEFINED SYMBOL IS IN R50SYL+0,+2.
;EVAL EITHER RTS PC'S OR ABORTS TO RUG'S TOP LEVEL.
EVAL: CLR LENTYI
CLR NOINST
EVAL0: CLRB REGINF
CLRB UNDEFS ;UNDEFINED SYMBOL FLAG
CLR ARGFLG
CLR VAL1
CLR VAL2
MOV #'+*401,OPER1 ;SET OPER1 AND OPER2 TO +
;AT EVAL1, RUG HAS VAL1 OPER1 VAL2 OPER2 AND IS LOOKING FOR NEXT VALUE, VAL
EVAL1: CLR VAL
CLR DECIMF
CLR NOTNUM
CLR OCTVAL
CLR DECVAL
CLR R50SYL
CLR R50SYL+2
MOV #R50SYL-2,R50LOC
MOV #3100,R50NUM
MOV PARSEP,SPARSE
MOVB @PARSEP,A ;LOOK AT FIRST CHAR OF SYLLABLE
CMP #'',A
BEQ SQUOT ;SINGLE QUOTE
CMP #'",A
BEQ DQUOT ;DOUBLE QUOTE
CMP #'&,A
BEQ AMPER ;AMPERSAND
EVAL2: MOVB @PARSEP,A
JSR PC,ASCR50 ;CONVERT TO RADIX-50
BMI EVAL4 ;NOT RADIX-50, END OF SYLLABLE
CMP #35,A ;IS CHAR % IN RADIX-50?
BEQ PERCNT ;YES
JSR PC,INR50
MOVB @PARSEP,A ;PICK UP CHAR AGAIN
CMP #'.,A
BEQ DCMLPT ;PERIOD MAY BE A DECIMAL POINT
SUB #'0,A
BMI ALPHA ;$ IS SYMBOL CONSTITUENT, LIKE A-Z
CMP #9,A
BLO ALPHA ;A-Z
MOV #OCTVAL,B ;CHAR IS A DIGIT
ASL (B) ;MAYBE THIS AND CHKOP COULD USE C INSTEAD ***
ASL (B)
ASL (B)
ADD A,(B)+ ;+ IS LIKE MOV #DECVAL,B
ASL (B)
ADD (B),A
ASL (B)
ASL (B)
ADD A,(B)
EVAL3: INC PARSEP ;DONE WITH THIS CHAR
BR EVAL2 ;PICK UP NEXT CHAR
PERCNT: BISB #1,REGINF
BR EVAL3
DCMLPT: INC DECIMF
BR EVAL3
ALPHA: INC NOTNUM
BR EVAL3
OCTVAL: 0 ;ACCUMULATED OCTAL NUMBER
DECVAL: 0 ;DECIMAL, MUST BE AT OCTVAL+2
OPER1: .BYTE 0 ;FIRST ARITHMETIC OPERATOR
OPER2: .BYTE 0 ;SECOND
PARSEP: 0 ;PARSING POINTER INTO IBUFF
REGINF: .BYTE 0 ;0, OR 1 IF TYPED-IN STRING IS A REGISTER
;REGINF BISB-ED WHEN % READ OR IF O.FLGS SAYS TO,
;AND TURNED OFF WHEN EVAL EXITS IF INSN PARSED
UNDEFS: .BYTE 0 ;NONZERO IF UNDEFINED SYMBOL READ
VAL1: 0 ;TEMPORARY VALUES IN PARSING
VAL2: 0
;ACCUMULATE THE RADIX-50 SYMBOL
INR50: CMP #3100,R50NUM ;ABOUT TO DO FIRST CHAR IN WORD?
BNE INR50A ;NO
TST R50SYL+2 ;ALREADY HAVE 6 CHARS?
BNE INR50B ;YES, IGNORE EXTRA CHARS
ADD #2,R50LOC
INR50A: ADD #3100,@#R50SYL-2 ;ADD 3100, 50, OR 1 * CHAR INTO SYMBOL
R50NUM==.-4
R50LOC==.-2
DEC A
BNE INR50A
MOV R50NUM,A ;THIS MAGIC CYCLES THRU 3100, 50, 1, 3100, ...
ASR A
ADD R50NUM,A
ASR A
RORB A
MOVB A,A ;SIGN EXTEND IF R50NUM WAS 1
ASR A
BIC #174626,A ;LEAVE ONLY BITS IN 3100+50+1
MOV A,R50NUM
INR50B: RTS PC
R50SYL: 0 ;TWO WORDS OF RADIX-50 CHARACTERS READ BY EVAL
0 ;C1 C2 C3 C4 BECOMES C1*50*50+C2*50+C3 IN R50SYL,
;AND C4*50*50 IN R50SYL+2
O.SYL==R50SYL
DQUOT: INC PARSEP ;GO ON TO NEXT CHAR
MOVB @PARSEP,VAL
SWAB VAL
SQUOT: INC PARSEP
MOVB @PARSEP,VAL
SQUOT1: INC PARSEP
BR EVAL5 ;HAVE VALUE
AMPER: INC PARSEP
MOVB @PARSEP,A
JSR PC,ASCR50
BMI ABORT2 ;NOT RADIX-50
JSR PC,INR50
CMP #3100,R50NUM
BNE AMPER ;HAVEN'T GOT 3 CHARS YET
MOV R50SYL,VAL
BR SQUOT1
ABORT2: JMP DCDERR ;FATAL ERROR IN EVAL
EVAL4: CMP #34*50*50,R50SYL ;END OF SYLLABLE
BEQ EVALS ;SYLLABLE IS JUST .
TST #0
NOTNUM==.-2 ;NONZERO SAYS A-Z OR $ SEEN, SO SYLLABLE IS NOT A NUMBER
BNE EVALS ;DO SYMBOL LOOK-UP
MOV OCTVAL,VAL
TST #0
DECIMF==.-2 ;NONZERO SAYS . SEEN, SO NUMBER IS DECIMAL
BEQ EVAL5 ;HAVE VALUE
MOV DECVAL,VAL
EVAL5: SUB PARSEP,#0 ;HAVE VALUE OF NEW SYLLABLE
SPARSE==.-2 ;SAVED PARSEP AT START OF SYLLABLE
SUB SPARSE,ARGFLG ;INCREASE ARGFLG IF NON-NULL SYLLABLE
MOVB OPER2,A
JSR PC,CHKOP
JMP @EVAL5A(B)
EVAL5A: OP2PM ;OPER2 IS A SPACE
OP2PM ;+
OP2PM ;-
OP2T ;*
OP2D ;!
OP2T: MLTPLY VAL2,VAL,VAL2 ;VAL2 _ VAL2 * VAL
BR OP2PM2
OP2D: DIVIDE VAL2,VAL,VAL2,E ;VAL2 _ VAL2 / VAL
BR OP2PM2
OP2PM: CMPB #'-,OPER1 ;OPER2 IS + OR -, SO DO OPER1
BNE OP2PM1
NEG VAL2
OP2PM1: ADD VAL2,VAL1
MOV VAL,VAL2
MOVB A,OPER1
OP2PM2: MOVB @PARSEP,A
JSR PC,CHKOP
BMI EVAL6 ;NOT A KNOWN OPERATOR
BEQ OP2PM3 ;BR IF OP IS ONLY A SPACE
INC ARGFLG ;LEGAL OPERATOR IMPLIES AN ARG
OP2PM3: MOVB A,OPER2
INC PARSEP
JMP EVAL1 ;GO GET ANOTHER NEW SYLLABLE
EVAL6: MOVB OPER1,A ;CLEAN UP AND EXIT
JSR PC,CHKOP
JMP @EVAL6A(B)
EVAL6A: OP1P
OP1P
OP1M
;OPER1 CAN NEVER BE * OR !
OP1P: ADD VAL2,VAL1
BR OP1M1
OP1M: SUB VAL2,VAL1
OP1M1: MOV VAL1,VAL
;IF ININST IS MADE TO RETURN 1ST WORD IN E, AND 2ND AND 3RD IN VAL+2 AND VAL+4, THEN OTHER THINGS
;ARRIVING AT EVAL5 CAN EASILY HAVE VALUE IN E AND A FEW WORDS CAN BE BUMMED OUT ***
EVAL7: MOVB @PARSEP,A ;PICK UP TERMINATOR
MOV #0,C
ARGFLG==.-2 ;ZERO IF NO ARGUMENT
;ARGFLG IS # CHARS PARSED, BUT NOT SPACES OR CHARS IN UNDEFINED SYMBOL
MOV VAL,E
TSTB UNDEFS
BEQ CHKOP3 ;RTS
JMP ECOLON ;UNDEFINED SYMBOL, SO BETTER BE COLON COMMAND
;EVALUATE SYMBOL
EVALS: JSR PC,O.SYLL ;CAN JUST PUT O.SYLL HERE AFTER ITS CALL IN DEFN GOES AWAY ***
BEQ EVALS2 ;NOT FOUND, MAYBE AN INSTRUCTION
BIT D,@O.FLGS ;TEST FOR REGISTER
BEQ EVALS1
BISB #1,REGINF ;REGISTER
EVALS1: MOV E,VAL
BR EVAL5 ;HAVE VALUE
EVALS2: TST #0
NOINST==.-2 ;NONZERO IF WITHIN AN INSTRUCTION PARSE
BNE EVALS4 ;DON'T PARSE SYLLABLE AS INSTRUCTION
MOV DOT,CURADR
MOV REGINF,-(SP)
MOV VAL1,-(SP)
MOV VAL2,-(SP)
MOV OPER1,-(SP)
INC NOINST
JSR PC,ININST ;ONLY CALL
CLR NOINST
MOV (SP)+,OPER1
MOV (SP)+,VAL2
MOV (SP)+,VAL1
MOV (SP)+,REGINF
JMP EVAL5 ;HAVE VALUE
EVALS3: TST (SP)+ ;UNDO ININST CALL
MOV (SP)+,OPER1
MOV (SP)+,VAL2
MOV (SP)+,VAL1
MOV (SP)+,REGINF
EVALS4: INCB UNDEFS ;UNDEFINED
BR EVAL6
;CHECK ARITHMETIC OPERATOR IN A
CHKOP: CLR B
CHKOP1: CMPB CHKOPT(B),A
BEQ CHKOP2 ;FOUND IT
INC B
TSTB CHKOPT(B)
BNE CHKOP1 ;NOT FINISHED SEARCHING
NEG B ;NEGATIVE IF NOT A LEGAL OP,
CHKOP2: ASL B ;OTHERWISE A USEFUL INDEX QUANTITY
CHKOP3: RTS PC
CHKOPT: .BYTE 40,'+,'-,'*,'!,0
SCRTCH: 0
MULT: MOV A,-(SP) ;SCRTCH _ SCRTCH * E
MOV B,-(SP)
CLR A
MULT1: CLC
ROR E
BCC NOAD
ADD SCRTCH,A
NOAD: ASL SCRTCH
TST E
BEQ DIVD2
BR MULT1
SIGNF: 0
DIVD0: MOV A,-(SP) ;SCRTCH _ SCRTCH / E
MOV B,-(SP)
CLR SIGNF
MOV #1,B
CLR A
TST E
BEQ DIVD2 ;/0 YEILDS 0
BGT DIVD3
NEG E
COM SIGNF
DIVD3: TST SCRTCH
BGE DIVD4
NEG SCRTCH
COM SIGNF
DIVD4: ASL B
ASL E
BPL DIVD4
SHFTDN: CLC
ROR B
BEQ DIVD5
ROR E ;CARRY CAN'T BE 1 AT THIS PT.
CMP E,SCRTCH
BHI SHFTDN
ADD B,A
SUB E,SCRTCH
BR SHFTDN
DIVD5: MOV SCRTCH,E ;ABS VALUE OF REMAINDER
TST SIGNF
BGE DIVD2
NEG A
DIVD2: MOV A,SCRTCH
MOV (SP)+,B
MOV (SP)+,A
RTS PC
;ABOVE ARE CRETINOUS MULTIPLY AND DIVIDE ROUTINES FOR EAE-LESS LOSERS
;MAYBE EVENTUALLY I'LL REWRITE THEM
;DIVIDE NEEDS TO BE FAST FOR /13 IN DISK ADDRESS CALCULATIONS
DADRS=30000
CADRS=1000
;READ IN COMPLETE BLOCK WITH BEGINNING AND END
;POINTS FUDGED TO MAKE DAR AND WC HAPPY
;TRANSFER CORE TO CORE
;WRITE OUT COMPLETE BLOCK
;B=%1 DON'T CLOBBER IT
OUTBLK: MOV ADRSS,A
CLC
ROR A
MOV A,D
BIC #MASK,D
MOV D,OUTDAR
;D HAS DAR ADRESS
;A IS WHAT I WISH IT COULD BE
SUB A,D
MOV B,C
CLC
ROR C
SUB C,D
BIC #MASK,D
MOV D,OUTWC
.IFNZ F.HD
ADD #SPRG,OUTDAR
.ENDC
.IFZ F.HD
MOV OUTDAR,MDSAV
JSR PC,MDCNVT
MOV #SPRG,MDSAV+2
JSR PC,MDADD
MOV MDSAV,OUTDAR
.ENDC
MOV #5,OUTFN
JSR PC,OUTBD
MOV ADRSS,C
BIC #177000,C
MOV C,D
BIC #177776,C
ADD #CADRS,C
ADD #DADRS,D
TRASF: MOVB (C)+,(D)+
CMP C,B
BLT TRASF
MOV #3,OUTFN
;FALL INTO OUTBD
OUTBD:
.IFNZ F.HD
JSR 5,FDISK
0 ;DAE
OUTDAR: 0
DADRS
OUTWC: 0
OUTFN: 0
.ENDC
.IFZ F.HD
JSR 5,MDISK
OUTDAR: 0
DADRS
OUTWC: 0
OUTFN: 0
.ENDC
RTS PC
STBLK: MOV #4,C
SBLK: JSR PC,ACK
STBLK1: JSR PC,XREAD
DECB D
BNE STBLK1
GTONE: JSR PC,XREAD
MOV #5,C
CLR A
JSR PC,XGWORD
SUB C,WORD
CMP C,WORD
BEQ JMPBLK
MOV WORD,C
JSR PC,XGWORD
MOV WORD,ADRSS
MOV #CADRS,B
ROR WORD
ADC B ;SO WILL BE ODD IF ODD, ETC
LDDATA: JSR PC,XGWORD
TST C
BGT LDLP
BLT CHECKS
MOVB WORD,(B)+
CHECKS: INCB A
BNE BAD
RTS PC
LDLP: MOVB WORD,(B)+
MOVB WORD+1,(B)+
BR LDDATA
ADRSS: 0
JMPBLK: JSR PC,XGWORD
MOV WORD,B
JSR PC,XGWORD
INCB A
BNE BAD
JSR PC,ACKOK
INC A ;SO NONZERO
RTS PC
BAD: MOV #6,C ;TELL 10 NOT OK
BR SBLK
ACKOK: MOV #4,C
JMP ACK
PSTRT: MOV #L.READ,F
JSR PC,PBLOCK
TSTB A
BNE L.DUN
JSR PC,OUTBLK
BR PSTRT
PBLOCK: CLR A
JSR PC,L.READ
CMP D,#EOT
BNE PBLK2
HALT
PBLK2: DECB D ;CHECK FOR +1 (START OF BLOCK)
BNE PBLOCK
JSR PC,L.READ
JSR PC,L.GWRD
MOV E,C
SUB #4,C
CMP #2,C
BEQ PJUMP
JSR PC,L.GWRD
MOV E,ADRSS
MOV #CADRS,B
ROR E
ADC B
PLDATA: JSR PC,L.READ
BGE PLD1
TSTB A
BNE CKSMER
RTS PC
PLD1: MOVB D,(B)+
BR PLDATA
CKSMER: JSR 5,TYPE
.ASCIZ /C!/
.EVEN
HALT
BR PBLOCK
PJUMP: JSR PC,L.GWRD
JSR PC,L.READ
TSTB A
BNE CKSMER
INC A
MOV E,ADRES
RTS PC
L.DUN: JSR PC,REINIT
JSR PC,L.LD2
BR DUN4
TKS=O.RCSR
TKB=O.RDB
TPS=O.TCSR
TPB=O.TDB
RCSR=LINEAD
RBUF=LINEAD+2
TSCR=LINEAD+4
TBUF=LINEAD+6
;ROUTINES TO GET FILES FROM STRANGE PLACES
STARTZ: JSR PC,ZZERO
START: MOV #RUGFNT,RELOC
.IFNZ M1145
MOV #"KI,A ;CHANGE TO KERNAL I MODE
JSR PC,CHMODE
.ENDC
.IFNZ FMH
JSR PC,GETFN ;GET FILE NAME AND DEVICE
BEQ STAR.1
JMP LOADF ;GET FILE FROM DISK
STAR.1: CMPB #'P,DPODEV
BEQ PSTRT
.IIF NZ TEN11,CLR TEN11S
CMPB #'T,DPODEV
.IFF
JSR PC,GET1UC
CMP #'P,A
BEQ PSTRT
.IIF NZ TEN11,CLR TEN11S
CMP #'T,A
.ENDC
BEQ STARTT
.IFNZ TEN11
.IIF NZ FMH,CMPB #'M,DPODEV
.IIF Z FMH,CMP #'M,A
BEQ .+6
.ENDC
JMP O.ERR
.IFNZ TEN11
TENCNT==200
TENCHR==TENCNT+4
TENBUF==TENCHR+4
MOV #TENCNT,A
CLR (A)+
CLR (A)+
CLR (A)+
CLR (A)+
MOV #TENBUF,TENPNT
MOV PC,(PC)+
TEN11S: 0
.ENDC
STARTT: CLR A
JSR PC,LINEIN
MOV #ABUF,D
.IFNZ TEN11
MOVB #'N,NCHAR ;INITIALIZE IT
TST TEN11S ;LOADING THROUGH THE 10-11
BEQ 1$ ;SKIP IT
MOVB #'M,NCHAR ;CHANGE IT TO MLODER.
1$:
.ENDC
.IFNZ FMH
MOV D,E
STAT.1: TSTB (E)+
BNE STAT.1
CLRB (E)
MOVB #15,-(E)
.ENDC
JSR PC,SEND ;LOGIN TO PDP-10
JSR PC,CNSL.1 ;LET USER TYPE FILE NAME
SBLKAG: JSR PC,STBLK1 ;SO DON'T SEND EXTRA 4
SBLKG2: TSTB A
BNE DUN3 ;MEANS JUMP BLOCK AND FINISHED
JSR PC,OUTBLK ;WRITE OUT ON DISK
JSR PC,STBLK ;ACK WITH A 4, THEN READ ANOTHER BLOCK
BR SBLKG2
DUN3: MOV B,ADRES
CLR E
JSR F,ACN
5
CLR A
JSR PC,XSTBLK ;NOW LOAD SYMBOLS INTO CORE, WITH ACKNOWLEDGES
.IFNZ TEN11
TST TEN11S
BEQ DUN4
CLR TENCNT ;NO MORE CHAR
1$: TST TENCHR ;WAIT FOR TO TURN NEGATIVE
BPL 1$
.ENDC
DUN4: JSR PC,DSTBL
JSR PC,REINIT
JMP O.DCD
ABUF: .BYTE 32 ;^Z
.ASCII /:LOGIN PDP11<31>:/
NCHAR: .ASCII /NLODER<45>/
DPONAM: .ASCIZ /DAZZEL/ ;DEFAULT FILE NAME
.EVEN
.BLKW 6
SEND: JSR PC,OUT10 ;SEND CONTROL-Z
JSR PC,WAIT10 ;WAIT FOR SYSTEM TO RESPOND
JSR PC,WAIT10
SEND3: JSR PC,OUT10 ;SEND REST OF BUFFER
TSTB (D)
BNE SEND3
RTS PC
OUT10: MOV C,-(P)
MOVB (D)+,C
JSR PC,SENDTC
MOV (P)+,C
RTS PC
.IFNZ FPP
;QUICK HACK TO EXAMINE FPP AC CONTENTS -- SHOULD BE REWRITTEN OR REPLACED ***
FPPACS: TST C ;TYPE AN FPP AC
BEQ FPPERR ;NO ARG
CMP #6,F
BLE FPPERR ;BAD ARG
BIC #7,FPPAC
BIS F,FPPAC ;SET LDD TO GET FROM FPP REGISTER
STFPS @#FPPST
SETD ;SELECT DOUBLE PRECISION
STD 0,@#FPPSV0
FPPAC: LDD A,A ;THIS IS MODIFIED BY CODE ABOVE
STD 0,@#FPPVAL
LDD @#FPPSV0,0
LDFPS #0 ;RESTORE STATUS
FPPST==.-2
JSR PC,TYP3SP
MOV FPPVAL,A
JSR 5,TYPNUM
JSR PC,TYP3SP
MOV FPPVAL+2,A
JSR 5,TYPNUM
JSR PC,TYP3SP
MOV FPPVAL+4,A
JSR 5,TYPNUM
JSR PC,TYP3SP
MOV FPPVAL+6,A
JSR 5,TYPNUM
FPPACR: JMP EQUAL2
FPPERR: JMP DCDERR
FPPSTR: TST C ;PROCESS N$$F
BEQ FPPERR
CMP #6,F
BLE FPPERR
JSR PC,TYP3SP
BIC #7,FSTAC
BIS F,FSTAC
STFPS @#FPPST
SETD
STD 0,@#FPPSV0
CLRF FPPVAL
MOV #FPPVAL,D
.FST1: JSR PC,EVAL
TST C
BEQ .FST2
MOV E,(D)+
CMP D,#FPPVAL+10
BLT .FST1
.FST2: LDD FPPVAL,A
TSTB F
BEQ .FST3
FSTAC: STD A,A
LDD FPPSV0,A
.FST3: LDFPS @#FPPST
BR FPPACR
FPPSV0: .BLKW 4
FPPVAL: .BLKW 4
.ENDC
O.LGDR:
;FOLLOWING COMMANDS PRECEEDED BY ALT
O.GO ; G GO TO ADDRESS K
O.WSCH ; W SEARCH WORD
O.EFF ; E SEARCH EFFECTIVE ADDRESS
O.BKPT ; B BREAKPOINTS
O.PROC ; P PROCEED
SETCMD
SETSMD
SETIMD
SETR50
SETASC
S1ALTO
S1ALTD
NOTWDS
S1ALTA
S1ALTR
STARTZ ;ZERO CORE AND LOAD
START ;DON'T ZERO CORE BUT LOAD
.IIF NZ FMH, DUMPC ;DUMP IN ABSOLUTE LOADER FORMAT
ZERO ;ZEROS CORE
BEGRUG ;$^D DUMPS CURRRENT RUG ON INVIOLATE COPY
BOOT ;$^U GETS AN INVIOLATE COPY OF RUG
.IFNZ FPP
FPPACS
.ENDC
SSFLAG: 0 ;NEED IT ANYWAY AND HAVE TO KILL A LOCATION HERE
;FOLOWING COMMANDS DON'T NEED ALT
EQUAL ; = PRINTS CURRENT VALUE
COLON ; : DEFINES SYM
SLASH ; / OPEN WORD
BACKSL ; \ OPEN BYTE
BACKAR ; BACKARROW, OPEN FIRST ADDRESS
CRETN ; CARRIAGE RETURN CLOSE
LINEFD ; <LF> MODIFY, CLOSE, OPEN NEXT
OLDSEQ ; < RETURN TO OLD SEQUENCE AND OPEN
UPARR ; ^ OPEN PREVIOUS
SETR51 ; ] PRINT CURRENT VAL AS RAD50 CHARS
SETASD ; [ PRINT AS ASCII
HKILL ; ^K HALF KILL
.IIF Z FMH, DUMP ;N^D
.IIF Z FMH, UNSAVE ;N^U
.IIF NZ FMH, DELET ;^Q
SSTP ;^N SINGLE STEP
GOADR ;^A
TAB ;TAB
VERS ;TYPE OUT VERSION #
LENGTH: 0 ;JUST NEED SPACE THERE FOR NOW (!), LENGTH OF INSN IN DOT, -2 BYTES
SETCMD ;CHANGE TO CONSTANTS MODE
SETSMD ;CHANGE TO SYMBOL MODE
SETIMD ;INSTRUCTION MODE
SETR50 ;RADIX-50 MODE
SETASC ;ASCII MODE
S2ALTO ;OCTAL MODE
S2ALTD ;DECIMAL MODE
S2ALTA ;INHIBIT TYPING OUT ADDRESSES SYMBOLICALLY
S2ALTR ;REVERSE ACTION OF $$A
DELTB ;DELETE BREAKPOINT(S)
ZEROAL ;ZERO CORE AND SYMBOL TABLE
.IFNZ M1145
CHNGMD
KMODE
UMODE
.ENDC
.IFNZ FPP
FPPSTR
.ENDC
O.LGL=.-O.LGDR ;LGL MUST EQUAL 2X CHLGT ALWAYS
O.LGCH:
;FOLLOWING COMMANDS PRECEEDED BY ALT
ALT: .BYTE 'G ; G
.BYTE 'W ; W
.BYTE 'E ; E
.BYTE 'B ; B
.BYTE 'P ; P
.BYTE 'C
.BYTE 'S
.BYTE 'I
.BYTE ']
.BYTE '[
.BYTE 'O
.BYTE 'D
.BYTE 'N
.BYTE 'A
.BYTE 'R
.BYTE 'L ;LOAD
.BYTE 12. ; ^L DON'T ZERO CORE
.IIF NZ FMH, .BYTE 'Y ;DUMP
.BYTE 'Z ;ZERO CORE
.BYTE 4 ;^D SAVE RUG
.BYTE 21. ;^U
.IFNZ FPP
.BYTE 'F
.ENDC
.BYTE 0
N1ALC==.-O.LGCH ;NUMBER OF ONE-ALTMODE COMMANDS
NOALT: .BYTE '=; =
.BYTE ': ; :
.BYTE '/ ; /
.BYTE '\ ; \
.BYTE '_ ; BACKARROW
.BYTE 15 ; CARRIAGE RETURN
.BYTE 12 ; <LF>
.BYTE '< ; <
.BYTE '^ ; ^
.BYTE '] ; ]
.BYTE '[ ; [
.BYTE 13 ;^K
.IIF Z FMH, .BYTE 4 ;^D
.IIF Z FMH, .BYTE 25 ;^U
.IIF NZ FMH, .BYTE 17 ;^Q
.BYTE 16 ;^N
.BYTE 1 ;^A CHANGE GO ADRESS
.BYTE 11 ;TAB
.BYTE 26 ;^V
.BYTE 0
N0ALC==.-O.LGCH-N1ALC ;NUMBER OF ZERO-ALTMODE COMMANDS
TWOALT: .BYTE 'C
.BYTE 'S
.BYTE 'I
.BYTE ']
.BYTE '[
.BYTE 'O
.BYTE 'D
.BYTE 'A
.BYTE 'R
.BYTE 'B
.BYTE 'Z
.IFNZ M1145
.BYTE 'M
.BYTE 'K
.BYTE 'U
.ENDC
.IFNZ FPP
.BYTE 'F
.ENDC
.BYTE 0
O.CLGT=.-O.LGCH ;TABLE LENGTH
.EVEN
CURVAL: 0 ;CURRENT VALUE
COUNT: 0
O.T: .BYTE 0 ; T-BIT FLAG
O.P: .BYTE 0 ;-1 IF NO PROCEED ALLOWED
;0-7 IF PCEED ALLOWED
.EVEN
O.CSR1: .BYTE 0 ;SAVE CELL - R C/SR
O.CSR2: .BYTE 0 ;SAVE CELL - T C/SR
.EVEN
.IFNZ FMH
;THESE ARE THE RUG FILES HANDLEING ROUTINES
;THEY WORK (?) ON LOGO FILE STRUCTURES
;ROUTINE FOR $Y DUMPS CORE INTO FILE IN ABSOLUTE LODER FORMAT
BITAB=2000 ;BIT-TABLE GOES HERE
DIRIN=4000 ;READ DIRECTORY INTO HERE
DIROUT=6000 ;WRITE DIRECTORY FROM HERE
ABSBUF=12000 ;ABS FORMATER PUTS STUFF HERE (USES 110000 BYTES)
ABSEND=ABSBUF+102000 ;LEAVE ROOM FOR CKSUM
ROOTBK=46 ;BLOCK NUMBER OF ROOT DIRECTORY
DPNAM: .BLKW 10.
DUMPC: MOV O.SYME,A
MOV #CSTBL,C ;ZERO UNUSED PART FOR SMALLER DUMP
SUB C,A ;COMPUTE WORD COUNT
ASR A
DUMP.1: CLR (C)+
SOB A,DUMP.1
JSR PC,FNDFIL ;SEARCH DIRECTORY FOR FILE
BEQ DUMP.3 ;IT DOESN'T EXIST
JSR PC,DELETE ;GET RID OF IT
DUMP.3: JSR PC,WRITE ;WRITE IT
DUMP3A: BIS #200,DPNAM
JSR PC,FINDEN ;WRITE OUT REST OF DIR
JSR PC,WTDIR ;WRITE DIRECTORY
JSR PC,WTBITS ;WRITE BIT TABLE
DUMP.4: JSR PC,SYMINT
DUMP.5: MOV #O.UR0,SP
JSR PC,REINIT
JMP O.DCD
SYMINT: JSR F,SYSDSK ;RELOAD SYMBOL TABLE
.IIF NZ F.HD, 0
SSTBL
CSTBL
-SSTBUL
5
RTS PC
;SEARCH DIRECTORIES FOR FILE
FNDFIL: JSR PC,DSTBL ;DUMP SYMBOL TABLE
JSR PC,GETFN ;GET THE DRIVE AND FILE NAME
BNE FNDF.2
FNDF.3: JSR F,TYPE
.ASCIZ /BAD DEVICE/
.EVEN
BR DUMP.4
FNDF.2: JSR PC,RDBITS ;READ BIT-TABLE AND ROOT DIR (BLK 46)
MOV #'.,DPNAM ;NAME OF RUGS DIRECTORY
JSR PC,RDDIR
MOV A,-(SP)
MOV B,-(SP)
MOV #DPONAM,A
MOV #DPNAM,B
FNDF.1: MOVB (A)+,(B)+
BNE FNDF.1
MOV (SP)+,B
MOV (SP)+,A
JMP FIND.0 ;FIND IT
;GETS FILE NAME UP TO 10. CHARS INTO DPONAM
;ALSO SETS UP DRIVE INFO
;SEZ IF NOT DISK DEVICE
GETFN: JSR PC,TYP3SP
MOV #DPNAM,E
MOV #22,F
GETN.1: JSR PC,GET1UC
CMP #15,A ;CR-RTN IS END OF NAME
BEQ GETN.2
CMP #12,A
BEQ GETN.2
CMP #177,A
BEQ GETFN ;RUBOUT CHARACTER
CMPB #':,A ;DEVICE NAME?
BNE GETN.4
CMP #DPNAM+1,E
BNE GETFN
MOVB DPNAM,#'0 ;DEFAULT DEVICE
DPODEV==.-2
BR GETFN
GETN.4: MOVB A,(E)+ ;STORE CHAR
SOB F,GETN.1
GETN.2: JSR PC,CRLF
CLRB (E)
CMP E,#DPNAM
BEQ GETN.5 ;USE DEFAULT NAME
MOV #DPNAM,E
MOV #DPONAM,A
GETN.7: MOVB (E)+,(A)+
BNE GETN.7
GETN.5: MOV DPODEV,A
CMPB #'P,A
BEQ GETN.6
CMPB #'T,A
BEQ GETN.6
.IFNZ TEN11
CMPB #'M,A
BEQ GETN.6
.ENDC
.IIF Z F.HD, BR GTDR.3
CMPB #'F,A
BNE GTDR.3
MOV #FXWRT,WCHDSK
RTS PC
GTDR.3:
.IIF Z M.HD, BR FNDF.3
MOV #MVWRT,WCHDSK
BIC #177600,A
SUB #'0,A
BLT FNDF.3
CMP #3,A ;DISK 3 IS THE LAST VALID DISK NOW
BLT FNDF.3
ASH #13.,A
MOV A,WCHPLT
CLZ
GETN.6: RTS PC
;DELETES FILE BEING POINTED AT AFTER ASKING
DELETE: JSR F,TYPE
.ASCIZ /FILE EXISTS DELETE?/
.EVEN
DELE.3: JSR PC,GET1UC
CMPB A,#'Y
BEQ DELE.4 ;HE CHANGED HIS MIND AGAIN
DELE.2: JMP DUMP.4
DELE.4: JSR PC,CRLF
DELE.1: JSR PC,RDDISC
BEQ GETN.6 ;NO MORE DISCRIPTOR SO RETURN
MOV BLKINC,F ;TURN BLK# INTO BIT TO BE CLEARED
CLR E
DIV #20,E ;WORD NUMBER IN E
MOV #1,A ;BIT NUMBER IN F
ASH F,A
ASL E
BIC A,BITAB+2(E)
BR DELE.1
DELET: JSR PC,FNDFIL ;GET NAME
BEQ DELERR
JSR F,TYPE
.ASCIZ /SURE?/
.EVEN
JSR PC,DELE.3 ;DELETE IT
JMP DUMP3A
DELERR: JMP LODFER
;WRITES OUT FILE GIVEN TO IT A BLOCK AT A TIME BY SUBROUTINE
;WRITES DISCRIPTOR WHERE B POINTS
;CLOBERS REGS 2,3,4,5
WRIT.0: JSR F,TYPE
.ASCIZ /ENTRY TO LARGE/
.EVEN
BR DELE.2
WRITE: MOV A,-(SP)
CLRB (B)+
BIC #1,B ;GET TO WORD BOUNDARY
MOV B,-(SP) ;SAVE FOR LEGNTH CALCULATION
CLR (B)+ ;SPACE FOR LEGNTH AND FLAGS
TST NDIRSW
BEQ WRIT.4
MOV #-1,(B)+ ;VERSION NUMBER
CLR (B)+ ;EOF WORDS
CLR (B)+
MOV #-1,(B)+ ;DATE AND TIME
MOV #-1,(B)+
WRIT.4: MOV #DPNAM,D ;PUT NAME IN DISCRIPTOR
WRIT.1: MOVB (D)+,(B)+
BNE WRIT.1 ;LOAD NAME
DEC B
BISB #200,-1(B) ;LAST CHAR HAS 200 BIT SET
MOV #-1,BLKINC
MOV #-1,OLDINC ;INITIALIZE BLK POINTERS
CLR WTTYP ;FOR WTDISC
CLR #0
EOFPG=.-2
CLR #0
EOFBT=.-2
JSR PC,GETFIL ;GET BLOCKS OF FILE (A)
WRIT.2: JSR PC,@(SP)+ ;CO-ROUTINE
BEQ WRIT.3 ;NO MORE TO WRITE
JSR PC,WTDISC ;WRITE BLOCK (RO) POINTS AT
ADD #2000,A
BR WRIT.2
WRIT.3: CLRB (B) ;NEW DIRECTORIES HAVE ODD LEGNTHS
TST NDIRSW
BNE WRIT.5 ;NEW FILES HAVE DATE AND TIME ELSEWHERE
INC B
BIC #1,B ;GET WORD BOUNDARY
MOV #-1,(B)+
MOV #-1,(B)+ ;FILES END WITH 2 WORDS OF -1
WRIT.5: MOV B,D
MOV (SP)+,C ;BEGINNING OF ENTRY
MOV (SP)+,A
SUB C,D
TST NDIRSW
BNE WRIT.6
ASR D ;COMPUTED LEGNTH
BIT #177700,D
BNE WRIT.0 ;LEGNTH TOO LONG
ADD #200,D
MOVB D,(C) ;STORE LEGNTH AND TYPE
RTS PC
WRIT.6: BIT #177400,D
BNE WRIT.0
BIS #102000,D ;FILE ENTRY TYPE
MOV D,(C)
MOV EOFPG,4(C)
MOV EOFBT,6(C)
INC B ;LENGTH IS ODD, MAYBE
BIC #1,B ;BUT WORD BOUNDARY NEVER IS!
RTS PC
;GETFIL INITIALIZES ABSDMP AND GIVBLK AND SETS UP CO-ROUTINE LINKAGE
GETFIL: CLR FILEND ;FOR SHAKBF
MOV #SPRG,SHKDAR
MOV #ABSBUF+2000,SHKCMA
MOV #-40000,SHKWC
MOV #ABSBUF+2000,ABSDIS ;FOR ABSDMP
JSR PC,SHAKBF ;SET UP BUFFER
MOV (SP),-(SP) ;SET UP CO-ROUTINE LINKAGE
MOV #GETF.1,2(SP)
BR GIVBLK ;RETURN
GETF.1: ;COMES BACK TO HERE FOR MORE
.IFNZ F.HD
MOV #SPRG+40000,SHKDAR
.IFF
MVAD 40000,SPRGM ;CONVERT TO SPECIAL MOVING DAR
MVADD SPRG,SPRGM,SPRGM
MOV #SPRGM,SHKDAR
.ENDC
MOV #ABSEND-SPRGL-SPRGL+100000,SHKCMA
MOV #-SPRGL+40000,SHKWC
MOV #ABSEND-SPRGL-SPRGL,ABSDIS
JSR PC,SHAKBF
MOV ADRES,F
JSR PC,LSTFRM ;SET UP SPECIAL FRAME
MOV #GETF.2,2(SP)
BR GIVBLK ;RETURN
;COMES BACK HERE FOR MORE
GETF.2: MOV #SSTBL,SHKDAR ;DO SYMBOL TABLE NOW
MOV #ABSEND-SSTBUL-SSTBUL,SHKCMA
MOV #-SSTBUL,SHKWC
MOV #ABSEND-SSTBUL-SSTBUL-CSTBL,ABSDIS
JSR PC,SHAKBF
MOV O.SYME,F
JSR PC,LSTFRM
ADD #1777,FILEND ;MAKE SURE LAST BLOCK IS WRITTEN
MOV #GETF.3,2(SP)
BR GIVBLK
GETF.3: MOV (SP)+,(SP) ;DESTROY CO-ROUTINE LINKAGE
SEZ
RTS PC
;CO-ROUTINE PUTS POINTER TO BLOCK IN A
;WHEN IT RUNS OUT IT ASKS GETFIL FOR MORE
GIVB.0: MOV (SP)+,A
JSR PC,@(SP)+ ;RETURN TO WRITE
GIVBLK: MOV A,-(SP)
ADD #2000,A ;CHECK IF ANOTHER BLK IS IN BUFFER
CMP A,#0
FILEND=.-2
BLOS GIVB.0
MOV (SP)+,A
JMP @2(SP) ;GO TO GETFIL FOR MORE BLOCKS
;SETS UP BUFFER, MOVING LEFTOVERS TO BOTTOM AND CRUNCHING
;WHATEVER IS NECESSARY
SHAKBF: MOV B,-(SP)
MOV FILEND,D
BIC #1777,D
MOV #ABSBUF,C
SHAK.1: CMP D,FILEND ;GET LEFTOVERS
BHIS SHAK.2
MOVB (D)+,(C)+
BR SHAK.1
SHAK.2: JSR F,SYSDSK
.IIF NZ F.HD, 0
SHKDAR: 0
SHKCMA: 0
SHKWC: 0
5
MOV SHKCMA,B
JSR PC,ABSDMP ;CHANGE TO ABS LODER FORMAT
MOV C,FILEND ;SAVE END OF BUFFER
MOV #ABSBUF,A
MOV (SP)+,B
RTS PC
;TAKES CORE BETWEEN (B) AND (ABSEND)
;PACKES IT IN ABSOLUTE LODER FORMAT BEGINING AT (C)
;(ABSDIS) IS CROCK SINCE ROOM MUST BE LEFT FOR 6 BYTES BEFORE 1ST FRAME
;A IS CHECKSUM
;B IS POINTER IN CORE
;C IS POINTER IN PACKED CORE
;D IS BYTE COUNT (BEGINNING OF FRAME)
;E IS USED FOR SUMMING CHECKSUM
;F IS SCRATCH
ABSDMP: CLR E
CLR ABSEND ;ZERO MAKES SURE LODER WILL STOP
ABSD.1: CMP #ABSEND,B
BLOS ABSDUN ;DO LAST FRAME NOW
TSTB (B)+ ;FIND NON-ZERO BYTE
BEQ ABSD.1
DEC B
ABSD.2: MOV C,D ;SAVE ADDRESS OF FRAME FOR BC
MOV #1,A
MOVB A,(C)+
CLRB (C)+
CMPB (C)+,(C)+ ;SAVE SPACE FOR BC
MOV B,F ;COMPUTE AND STORE ADDRESS
SUB #0,F
ABSDIS=.-2
MOVB F,(C)+
ADD F,A
SWAB F
MOVB F,(C)+
ABSD.3: MOVB -1(C),E ;COMES HERE WHEN FINDS SOME BUT NOT
ADD E,A ;ENOUGH ZEROS
ABSD.4: MOVB (B)+,E
ADD E,A
MOVB E,(C)+ ;STORE BYTE AND UPDATE CKSUM
BNE ABSD.4
MOV #7,F ;FOUND ZERO CHECK FOR 7 MORE
ABSD.5: CMP #ABSEND,B
BLOS ABSD.6 ;END OF CORE
MOVB (B)+,(C)+
BNE ABSD.3 ;NOT ENOUGH 0'S CONTINUE FRAME
SOB F,ABSD.5
ABSD.6: TSTB -(C) ;BACK UP POINTER
BEQ ABSD.6
INC C ;IT NOW POINTS JUST PAST LAST BYTE
ABSD.7: MOV C,F ;COMPUTE AND STORE BYTE COUNT
SUB D,F
ADD F,A
CMPB (D)+,(D)+ ;D NOW HAS ADD. TO PUT BC
MOVB F,(D)+
SWAB F
ADD F,A
MOVB F,(D)
NEG A ;COMPUTE AND STORE CHECKSUM
MOVB A,(C)+
BR ABSD.1 ;GO DO MORE FRAMES
ABSDUN: RTS PC
;SETS UP LAST FRAME IN BUFFER
;F IS ADDRESS FOR FRAME
LSTFRM: MOVB #1,(C)+
CLRB (C)+
MOVB #6,(C)+
CLRB (C)+
MOV #7,E ;CHECKSUM
ADD F,E
MOVB F,(C)+
SWAB F
ADD F,E
MOVB F,(C)+
NEG E
MOVB E,(C)+
MOV C,FILEND ;UPDATE END OF BUFFER
RTS PC
;WRITES DISCRIPTOR AND SENDS BLK OFF TO DISK
;BLKINC AND OLDINC POINT TO DISK BLOCKS
;WTTYP AND WTCNT ARE BYTE FLAGS FOR WRITING THE DISCRIPTORS
;(B) IS WHERE DISCRIPTOR IS PLACED
;IT ALSO FINDS FREE BLOCK TO WRITE ON, CHANGING THE BIT TABLE
;CLOBBERS REGS 3,4,5
WDIS.0: JSR F,TYPE
.ASCIZ /DISK FULL?/
.EVEN
WDIS00: JMP DUMP.4
WTDISC: INC BLKINC
MOV BLKINC,F
CMP F,BITAB
BGE WDIS.0 ;THAT IS AN ILLEGAL BLOCK
CLR E
DIV #20,E ;FIND BIT IN TABLE
MOV #1,D
ASH F,D
ASL E
BIT D,BITAB+2(E) ;SEARCH TABLE FROM BEGINNING
BNE WTDISC
ADD #2000,EOFBT
CMP EOFBT,#20000
BLT WDIS.9
CLR EOFBT ;COMPUTE LEGNTH OF FILE
INC EOFPG
WDIS.9: BIS D,BITAB+2(E) ;SET WRITTEN ON BIT
MOV BLKINC,F
SUB OLDINC,F ;COMPUTE DISP FROM LAST BLOCK
TSTB #0
WTTYP=.-2
WTCNT=.-1
BEQ WDIS.1 ;START NEW DISCRIPTOR
DEC F
BNE WDIS.6 ;SKIPPED SOME BLOCKS
INCB WTCNT
BITB #0,WTCNT ;MASK IS 3 OR 6 BITS
WTMASK=.-4
BNE WDIS.2 ;START MULTIPLE GET DISCRIPTOR
INCB 0(B) ;CHANGE PREVIOUS DISCRIPTOR
WTBACK=.-2
BR WDIS.5
WDIS.1: DEC F ;# BLKS TO BE SKIPPED
BNE WDIS.6 ;DO A SKIP DISCRIPTOR
WDIS.2: MOV #100,WTTYP ;SET TYP AND CNT FLAGS
MOV #340,WTMASK ;HALF AS MUCH BECAUSE OF RON
WDIS.3: MOV #-1,WTBACK
WDIS.4: MOVB WTTYP,(B)+ ;WRITE DISCRIPTOR
WDIS.5: MOV BLKINC,#0 ;SAVE BLK #
OLDINC=.-2
WDISRT: JMP WTBLK ;WRITE IT AND RETURN
WDIS.6: CMP F,#7 ;LARGE OR SMALL SKIP
BGT WDIS.7
MOV #300,WTTYP ;SMALL SKIP
MOV #370,WTMASK
ASH #3,F
MOV #-1,WTBACK
ADD WTTYP,F
WDIS6A: MOVB F,(B)+ ;WRITE DISCRIPTOR
BR WDIS.5
WDIS.7: CMP F,#77 ;SKIP OR SET ADDRESS
BGT WDIS.8
CLR WTTYP ;SKIP AND GET 1
BR WDIS6A
WDIS.8: MOV #200,WTTYP ;THREE BYTE DISCRIPTOR
MOV #300,WTMASK
MOV #-3,WTBACK
MOVB WTTYP,(B)+ ;WRITE 1ST BYTE
MOVB BLKINC,(B)+ ;2ND BYTE
MOVB BLKINC+1,(B)+ ;LAST BYTE
BR WDIS.5
;READS DISC POINTED TO BY C
;LOOKS AT BLKNT FIRST FOR PREVIOUSLY READ DISC
;IF (D) =0 CHECKS FFLAG AND SEZ
RDDISC: INC BLKINC
TSTB BLKNT
BEQ RDIS.1
DECB BLKNT ;STILL BLOCKS LEFT FROM LAST DISCRIPTOR
BR RDSKIQ ;FOUND BLOCK
RDIS.1: TST D
BGT RDIS.3
TST FFLAG ;NO MORE LEFT
BLE RDIS.2 ;NOT A FILE
ADD #4,C
RDIS.2: MOV C,A ;FOR FINDEN
SEZ
RTS PC ;NO BLOCKS FOUND
RDIS.3: DEC D
MOVB (C)+,E
BEQ RDIS.1 ;NO-OP DISCRIPTOR
MOVB E,#0
BLKNT=.-2
BIC #177700,BLKNT ;GET 1ST FIELD
BIC #177477,E ;LEAVE ONLY TYPE FIELD
ASH #-5,E
ADD E,PC
BR RDSKIP
BR RDBNCH ;READ A BUNCH
BR RDSETA
MOV BLKNT,E ;SKIP N1 AND GET N2+1
BICB #70,BLKNT
ASH #-3,E
ADD E,BLKINC ;SKIP SOME
RTS PC
RDBNCH: BIT #40,BLKNT
BNE RDIS.1 ;HOLE IN FILE DISCRIPTOR
BR RDSKIQ ;GET A BUNCH DISCRIPTOR
RDSKIP: ADD BLKNT,BLKINC ;SKIP N1 AND GET 1
CLR BLKNT
RDSKIQ: CLZ
RTS PC
RDSETA: SUB #2,D
BLT RDSETB ;WHERE'S THE REST OF THIS DISCRIPTOR?
MOVB (C)+,BLKINC
MOVB (C)+,BLKINC+1 ;SET THE BLOCK #
BR RDSKIQ
RDSETB: JSR F,TYPE
.ASCIZ /BAD DISCRIPTOR?/
.EVEN
RDSETC: JMP WDIS00
;FIND ENTRY WITH NAME IN DPNAME ELSE FIND WHERE IT SHOULD GO
;WRITE FROM DIRIN TO DIROUT AS YOU GO
;FIND.0 ENTRY INITIALIZES A NEW DIR SEARCH AND SKIPS HEADER
;USES ENDBLK END OF DIRECTORY
; A START OF CURRENT ENTRY
; B POINTER IN OUTPUT
; C POINTER IN INPUT
; D LENGTH OF CURRENT ENTRY
;CLOBBERS E,F
FIND10: BIC #177400,D ;LEGNTH IN BYTES
INC D
ASR D
CLR FFLAG ;DATE AND TIME ARE NOW AT BEGINNING OF DISC
TST (C)+ ;SKIP VERSION NUMBER OR DIRID
ROL E
BCC 1$
ADD #10,C ;SKIP EOF DATE AND TIME
1$: BR FIND11
FINDEN: CLR BLKNT ;INIT RDDISC
MOV #-1,BLKINC
BR FIND.7 ;CHECK FOR END OF DIRECTORY
FIND.1: MOV A,C
MOV (C)+,D ;GET LENGTH IN WORDS
MOV D,E ;KLUGE TO FIND IF THIS IS A FILE
TST NDIRSW
BNE FIND10 ;NEW STYLE DIRECTORY
BIC #177700,D
BIC #177400,E
ASH #-7,E
SBC E ;ITS POSITIVE IF FILE ENTRY
MOV E,#0
FFLAG=.-2
FIND11: MOV #DPNAM,E
FIND.2: TSTB (E) ;ZERO MEANS IT ENDED
BMI FIND.6 ;IF 200 BIT SET SKIP ALL ENTRIES
BEQ FIND.5 ;ENTRY WOULD BE HERE
MOVB (C),F
BPL FIND.4 ;LAST CHAR IN NAME HAS BIT SET
BIC #200,F
CMPB (E)+,F
BLT FIND.5 ;ENTRY WOULD BE HERE
BGT FIND.6 ;WRITE OUT ENTRY AND CONTINUE SEARCH
TSTB (E) ;LOOK TO SEE IF DPNAM IS DONE ALSO
BNE FIND.6 ;NOPE SO WRITE ENTRY AND CONTINUE
TST FFLAG
BLE FIND3A
SUB #2,D ;FILES END WITH 2 WORDS OF -1
FIND3A: INC C ;NAMES MATCH
FIND.3: ASL D ;RDDISC WANTS BYTE COUNT
SUB C,D
ADD A,D ;NUMBER OF BYTES LEFT IN ENTRY
CLZ
RTS PC
FIND.4: CMPB (E)+,(C)+
BEQ FIND.2 ;CONTINUE COMPARE
BGT FIND.6 ;WRITE ENTRY AND CONTINUE
FIND.5: SEZ ;ENTRY WOULD BE HERE
RTS PC
FIND.0: TST NDIRSW
BNE FIND.8 ;NEW STYLE DIRECTORIES
MOV A,ENDBLK
SUB 1776(A),ENDBLK ;COMPUTE ADDRESS OF LAST WORD
ADD #2000,ENDBLK
MOV (A),D
BIC #177700,D ;GET THE HEADER LENGTH IN WORDS
FIND.9: CLR BLKNT ;NOW SKIP THE HEADER
MOV #-1,BLKINC
FIND.6: MOV (A)+,(B)+ ;WRITE ENTRY AND LOOK AT NEXT
SOB D,FIND.6
;FALLS THROUGH
;FALLS IN
FIND.7: CMP A,#0
ENDBLK=.-2
BLO FIND.1 ;CONTINUE
BR FIND.5 ;END OF DIR SO IT GOES HERE
FIND.8: MOV 6(A),ENDBLK
ADD A,ENDBLK ;MAKE IT ABSOLUTE
MOV (A),D ;LEGNTH OF SELF ENTRY
INC D
BIC #177401,D ;SKIP SELF AND PARENT ENTRIES
MOV A,E
ADD D,E
ADD (E),D ;LEGNTH OF PARENT ENTRY
INC D
BIC #177401,D
ASR D ;WORD COUNT
BR FIND.9 ;SKIP THEM BOTH
;SEARCHES OLD DIR TO FIND NEW AND PUTS IT IN DIRIN
;SETS UP ALL RELEVENT POINTERS
RDDIR: JSR PC,FIND.0 ;FIND ENTRY WITH THAT NAME (DPNAM)
BEQ RDIR.2 ;NOT FOUND
JSR PC,RDDISC
BEQ RDIR.2 ;NO DISCRIPTOR
RDIR.1: MOV #DIRIN,A
MOV #DIROUT,B
MOV BLKINC,#0 ;SAVE BLK #
DIRBLK=.-2
BR RDBLK
RDIR.2: JSR F,TYPE
.ASCIZ /DIRECTORY NOT FOUND/
.EVEN
RDIR.3: JMP RDSETC
;WRITES OUT DIR IN DIROUT
WTDIR: CLR (B) ;LOGO WANTS ZERO AT END
MOV DIRBLK,BLKINC
MOV #DIROUT,A
SUB A,B ;FIND LEGNTH
TST NDIRSW
BNE WDIR.3 ;NEW STYLE DIRECTORIES
CMP B,#1774
BGE WDIR.1
NEG B
ADD #2000,B
MOV B,1776(A) ;STORE BLK LEGNTH IN LAST WORD
BR WTBLK
WDIR.1: JSR F,TYPE
.ASCIZ /DIRECTORY FULL?/
.EVEN
WDIR.2: BR RDIR.3
WDIR.3: CMP B,#2000
BGE WDIR.1
MOV B,6(A)
BR WTBLK ;WRITE OUT BIT TABLE
WTBITS: MOV BITBLK,BLKINC
MOV #BITAB,A
BR WTBLK ;DOES RTS PC
;READS BIT-TABLE INTO BITAB AND THEN READS ROOT DIR
RDBITS: MOV #ROOTBK,BLKINC ;READ ROOT
JSR PC,RDIR.1
MOV DIRIN,#0
NDIRSW=.-2
BIC #173777,NDIRSW
MOV #DPNAM,E
MOV #"BI,(E)+
MOV #"TS,(E)+
CLR (E) ;LOOK FOR BITS IN ROOT DIR
JSR PC,FIND.0
BEQ RBIT.1 ;IT SHOULD BE THERE!?
JSR PC,RDDISC
BEQ RBIT.1 ;IT SHOULD HAVE A DISCRIPTOR!?
MOV #BITAB,A
MOV BLKINC,#0 ;SAVE BLK #
BITBLK=.-2
JSR PC,RDBLK ;GO GET IT
MOV #ROOTBK,BLKINC
BR RDIR.1
RBIT.1: JSR F,TYPE
.ASCIZ /BITS NOT FOUND?/
.EVEN
RBIT.2: BR WDIR.2
;READS/WRITES THE DISK BLOCK # (BLKINC) TO/FROM BUFFER ADDRESS IN A
;CLOBBERS NO REGS
RDBLK: MOV #5,FICS
BR WTBL.0
WTBLK: MOV #3,FICS
WTBL.0: MOV A,FIBA
MOV A,-(SP)
MOV B,-(SP)
CLR A
MOV #0,B ;COMPUTE DISK ADDRESS
BLKINC=.-2
CMP WCHDSK,#FXWRT ;USE DIFFERENT MAPS FROM BLK# TO DA
BEQ WTBL.2
ASL B
DIV #14,A
ASH #4,A
ADD A,B
ADD #20000,B ;WHICH PLATTER
WCHPLT=.-2
WTBL.1: MOV B,FIDA
JSR PC,@#MVWRT ;DO TRANSFER
WCHDSK=.-2
FIDA: 0
FIBA: 0
FIWC: -1000
FICS: 0
MOV (SP)+,B
MOV (SP)+,A
RTS PC
WTBL.2: ASHC #11,A ;2**10. BYTES PER BLOCK
MOV A,FIDE
BR WTBL.1
FIDE: 0 ;FIXED DAE
;DISK READ/WRITE ROUTINE SELECTS DISK AND LOADS REGS
FXWRT: MOV #400,DCS ;POWER CLEAR (IN CASE THIS IS A RETRY)
MOV #"FD,MVDS.2 ;R/W ON FIXED DISK
MOV #DAE,A
MOV FIDE,(A)
BR MVDS.0
MVWRT: MOV #1,RKCS ;CONTROL RESET IN CASE THIS IS A RETRY
MOV #RKDA+2,A ;R/W ON MOVING DISK
MOV #"MD,MVDS.2
MVDS.0: MOV (SP),B ;ADDRESS OF ARGUMENTS
MOV (B)+,-(A) ;DAR
MOV (B)+,-(A) ;CMA
MOV (B)+,-(A) ;WC
MOV (B)+,-(A) ;DCS
MVDS.1: TSTB (A)
BPL MVDS.1
TST (A)
BPL MVDS.3
JSR F,TYPE
MVDS.2: .ASCIZ /FD ERR? /
.EVEN
JMP @WCHDSK
MVDS.3: TST (SP)+ ;POP ARGUMENTS ADDRESS
JMP (B)
;THIS ROUTINE R/W ON THE SYSTEM DEVICE
;CALLED BY USE OF F AND CLOBBERS E
SYSDSK: MOV D,-(SP)
SYSD.3:
.IFNZ F.HD
MOV #DAE,D
MOV (F)+,(D) ;DAE
.IFF
MOV #RKDA+2,D
.ENDC
MOV (F)+,-(D) ;DAR
MOV (F)+,-(D) ;CMA
MOV (F)+,-(D) ;WC
MOV (F)+,-(D) ;DCS
SYSD.1: TSTB (D)
BPL SYSD.1
TST (D)
BMI SYSD.2
MOV (SP)+,D
RTS F
SYSD.2:
.IIF NZ F.HD, SUB #12,F
.IIF Z F.HD, SUB #10,F
MOV A,-(SP)
JSR F,TYPE
.ASCIZ /SD ERR? /
.EVEN
MOV (SP)+,A
.IIF NZ F.HD, MOV #400,DCS ;POWER CLEAR
.IIF Z F.HD, MOV #1,RKCS ;CONTROL RESET
BR SYSD.3
;LOADS A FILE AND SYMBOL TABLE IN ABSOLUTE LOADER FORMAT
;FROM DISK TO RUG SWAP AREA (RUG'S $L COMMAND)
LOADF: JSR PC,FNDF.2 ;$L COMMAND ENDS UP HERE
JSR PC,LODFIL
BR LODF.0
LODFIL: BNE LODF.1 ;ALSO CALLED BY LOGO BOOT
LODFER: JSR F,TYPE
.ASCIZ /FILE NOT FOUND?/
.EVEN
LODF.0: JMP DUMP.4
LODF.1: CLR 0 ;ZERO SWAP AREA ON DISK
MOV C,LODR2 ;SAVE FOR LODBLK AND RDDISC
MOV D,LODR3
JSR F,SYSDSK
.IIF NZ F.HD, 400 ;DISABLE AUTOINCREMENT
SPRG
0
-SPRGL
.IFNZ F.HD
3
.IFF
4003
.ENDC
MOV #RUGFNT,O.SYME
JSR F,SYSDSK ;ZERO SYMBOL TABLE
.IIF NZ F.HD, 400
SSTBL
0
-<SSTBUL&<-DSKBSZ>>
.IFNZ F.HD
3
.IFF
4003
.ENDC
.IFNZ MVFO2
JSR F,SYSDSK
.IIF NZ F.HD, 0
SSTBLB
DIROUT
-DSKBSZ
5
MOV #MVFO2,A ;ZERO THIS MANY WORDS
MOV #DIROUT,C
LODF.3: CLR (C)+
SOB A,LODF.3
JSR F,SYSDSK
.IIF NZ F.HD, 0
SSTBLB
DIROUT
-DSKBSZ
3
.ENDC
MOV #BITAB+2000,A ;SO LODBYT WILL GET A BLOCK
MOV #SPRG,SWAPST
JSR PC,ABSLOD ;LOAD THE PROGRMA
MOV E,ADRES
.IFNZ F.HD
MOV #SSTBL-<CSTBL/2>,SWAPST
.IFF
MVAD <CSTBL/2>,MVFOO
MVFO1==SSTBL-MVFOO
.IFL <SSTBL&17>-<MVFOO&17>
MVFO1=MVFO1-4
.ENDC
MOV #MVFO1,SWAPST ;ABSLOD WILL ADD CSTBL TO THIS TO GET THE DISK ADDRESS
.ENDC
JSR PC,ABSLOD ;GET THE SYMBOL TABLE
MOV E,O.SYME
RTS PC
;LOADS FRAMES INTO CORE
;A IS POINTER IN DISK BLOCK (0 - 2000)
;B IS POINTER IN CORE (ABSBUF - AS FAR AS NECESSARY)
;C IS SCRATCH
;D IS WHERE LODBYT AND LODWRD RETURN VALUES
;E IS BYTE COUNT
;F IS CHECKSUM
ABSLOD: JSR PC,LODBYT ;READ FRAMES UNTIL END FRAME IS FOUND
CMPB #1,D
BNE ABSLOD ;LOOK FOR BYTE = OO1
MOV D,F ;CHECKSUM
JSR PC,LODBYT ;SKIP BYTE OF ZERO
JSR PC,LODWRD ;GET BYTE COUNT
MOV D,E
JSR PC,LODWRD ;GET ADDRESS
SUB #6,E ;ALREADY HAVE 6 BYTES
BNE LOD.3
MOV D,E
JSR PC,LODBYT
TSTB F
BNE LODERR ;CHECKSUM ON LAST FRAME TOO BAD
RTS PC ;LAST FRAME HAS LENGTH 6
LOD.3: MOV #ABSBUF,B
MOV D,-(SP) ;SAVE START ADDRESS OF FRAME
CLC
ROR (SP) ;MAKE IT A WORD ADDRESS
.IFNZ F.HD ;COMPUTE DAR
CLR LOD.9-2 ;EXTENSION ADDRESS
ADD #SPRG,(SP)
SWAPST=.-2
ADC LOD.9-2
.IFF
BIC #377,(SP)
MOV (SP),MDSAV
JSR PC,MDCNVT
MOV #SPRG,MDSAV+2
SWAPST=.-4
JSR PC,MDADD
MOV MDSAV,(SP)
.ENDC
BIC #-<DSKBSZ*2>,D
.IFNZ F.HD
BIC #DSKBSZ-1,(SP) ;MAKE IT BLOCK ADDRESS
MOV LOD.9-2,LOD3A-2 ;EXTENSION ADDRESS
.ENDC
ADD D,B ;WHERE TO START PUTTING BYTES
MOV (SP),LOD3A ;DAR
JSR F,SYSDSK ;READ A BLOCK
.IIF NZ F.HD, 0
LOD3A: 0
ABSBUF
-DSKBSZ
5
LOD.4: JSR PC,LODBYT
MOVB D,(B)+ ;PUT BYTE IN BUFFER
SOB E,LOD.4
JSR PC,LODBYT ;GET THE CHECKSUM
TSTB F
BEQ LOD.5 ;IT CHECKS
LODERR: JSR F,TYPE
.ASCIZ /CHECKSUM ERROR?/
.EVEN
LOD.ER: JMP LODF.0 ;ABORT
LOD.5: MOV #-DSKBSZ,LOD10
.IIF NZ F.HD, MOV LOD3A-2,LOD.9-2
CMP #ABSBUF+<DSKBSZ*2>,B ;IS IT MORE THAN ONE BLOCK ORTH?
BHIS LOD.8 ;NO
MOV B,C ;THE FIRST BYTE NOT WRITTEN
SUB #ABSBUF,C ;CHANGE TO POSITIVE BYTE COUNT
CLC
ROR C ;NOW, POSITIVE WORD COUNT
BIC #DSKBSZ-1,C ;ROUNDED DOWN, GIVES OFFSET TO START OF LAST BLOCK
MOV C,D ;COPY TO FART AROUND WITH
ADD #DSKBSZ,D ;COUNT OF THE WHOLE ABSBUF, ROUNDED
MOV D,LOD10 ;TO RITE OUT ABSBUF
NEG LOD10
ASL D ;BYTE COUNT OF WHOLE BUFFER
ADD #ABSBUF,D ;POINTS PAST LAST REAL BYTE IN BUFFER
;NOTE THAT SOME OF THE BUFFER GETS FILLED IN BELOW
;SO FAR WE JUST HAVE FROM ABSBUF TO (B)-1 REAL BYTES
.IFNZ F.HD
MOV LOD.9-2,LOD.6-2
MOV (SP),F
ADD C,F ;READ BLOCK AT END FROM DISK
ADC LOD.6-2
.IFF
MOV C,MDSAV ;CONVERT WC TO DISC ADDRESS
JSR PC,MDCNVT
MOV (SP),MDSAV+2
JSR PC,MDADD
MOV MDSAV,F
.ENDC
MOV F,LOD.6
JSR F,SYSDSK ;GET END BLOCK
.IIF NZ F.HD, 0
LOD.6: 0
DIROUT
-DSKBSZ
5
MOV #DIROUT+<DSKBSZ*2>,C
LOD.7: MOVB -(C),-(D) ;FILL REST OF BLOCK
CMP B,D
BNE LOD.7
LOD.8: MOV (SP)+,LOD.9 ;DAR'S
JSR F,SYSDSK ;WRITE FRAME ON DISK
.IIF NZ F.HD, 0
LOD.9: 0
ABSBUF
LOD10: 0
3
JMP ABSLOD ;GET ANOTHER FRAME
;GETS BYTE INTO D FROM BLOCK POINTED AT BY A
;IF IT REACHES THE END OF THE BLOCK IT GETS ANOTHER
;IF NO MORE ARE AVAILABLE IT BARFS
LODBYT: CMP A,#BITAB+2000 ;END OF BLOCK?
BLO LDBY.1 ;NO WE DONT NEED ANY THANK YOU
MOV C,-(SP)
MOV D,-(SP)
MOV E,-(SP)
MOV LODR3,D
MOV LODR2,C ;POINTERS FOR RDDISC
MOV #BITAB,A
JSR PC,RDDISC
BNE LDBY.0
JSR F,TYPE
.ASCIZ /BAD FILE/
.EVEN
BR LOD.ER
LDBY.0: JSR PC,RDBLK
MOV C,#0
LODR2=.-2
MOV D,#0
LODR3=.-2
MOV (SP)+,E
MOV (SP)+,D
MOV (SP)+,C
LDBY.1: MOVB (A)+,D
ADD D,F ;CHECKSUM
RTS PC
;RETURNS WORD IN D ASSUMES THAT THERE ARE 2 BYTES LEFT IN FRAME
LODWRD: JSR PC,LODBYT
MOVB D,C
JSR PC,LODBYT
SWAB D
CLRB D
BISB C,D
RTS PC
.ENDC
;DISC ROUTINES
;4000-20000 ON DISC RESERVED FOR AN INVIOLATE COPY OF RUG
;RUG AUTOMATICALLY WRITES THERE WHEN LOADED
;$^U WILL READ IT BACK
;FOLLOWING ARE WORD ADDRESSES
;20000-110000 ARE RESERVED FOR SWAPPING PROGRAM
;110000-143400 ARE RESERVED FOR SWAPPING SYMBOL TABLE
;143400-157400 ARE FOR SWAPPING RUG
;ON MOVING HEAD DISK, BOTTOM 100 SECTORS FOR RON
;DUMP TRACKS 1-9, EACH 300 SECTORS LONG
;THIS CALCULATES TRACK ADDRESS START, LEAVING
;THAT IN A AND 3 IN D
;IF MOVING HEAD TRACK B=-1 AT END
;D AND E BOTH INITIALLY CONTAIN 3 FOR WRITE OR 5 FOR READ
.IFZ FMH
.IFNZ F.HD
DISC: MOV #TRKS-TRKL,A
.IFNZ M1145
MOV #THTRKS,B
.ENDC
.IFZ M1145
CLR B
.ENDC
CMP E,#11
BHI DSCER
.IFNZ M.HD
CMP E,#1
BGE DSCM
.ENDC
DSC1: ADD #TRKL,A
ADC B
DEC E
BGE DSC1
MHD: MOV #SPRG,C
MOV #3,D
MOV D,E
RTS PC
DSCER: TST (SP)+ ;FROM SBRTNE, SO POP STACK
DSCERR: JMP O.ERR
.ENDC
.IFZ F.HD
DISC: MOV #TRKS-MTL,A
CMP E,#5
BHI DSCER
DSC1: ADD #MTL,A
DEC E
BGE DSC1
MOV #SPRG,C
MOV #3,D
MOV D,E
BIS PMKDA,A
RTS PC
DSCER: TST (SP)+
DSCERR: JMP O.ERR
.ENDC
.IFNZ F.HD
.IFNZ M.HD
DSCM: DEC B
MOV #LOWAD-MTL,A
DEC E
MD1: ADD #MTL,A
DEC E
BGE MD1
BIS PMKDA,A
BR MHD
.ENDC
.ENDC
DUMP: ;N^D
.IFNZ M.HD
CLR PMKDA
.ENDC
DUMP1: JSR PC,DSTBL ;DO SYMBOL TABLE TRANSFER
JSR PC,DISC ;CONVERTS TO DISC ADDRESS, IN A (OVERFLOW IN B)
CMPB (E)+,(E)+ ;NOW E HAS 5 IN IT
MOV #DMP,FIRSTR
MOV #DMPT,SCNDR
JSR PC,DMPSUB
BR UNSV
UNSAVE: ;N^U
.IFNZ M.HD
CLR PMKDA
.ENDC
UNSV1: JSR PC,USAVE
UNSV: JMP O.DCD
USAVE: JSR PC,DISC ;READS FIRST 10000 TRACK 0 LOCS
CMPB (D)+,(D)+ ;NOW D HAS 5 IN IT
MOV #DMPT,FIRSTR
MOV #DMP,SCNDR
JSR PC,DMPSUB
JMP REINIT
FIRSTR: 0
SCNDR: 0 ;RTNES TO BE CALLED IN DUMPING
DMPSUB:
.IFNZ F.HD
TST B
BGE DMS1
MOV D,B ;SO RTNES KNOW WHICH DISK
.ENDC
DMS1: MOV #-<<TRKL-<<RUGFNT/2>&77777>>/2>,F ;SHOULD BE 22000 FOR HCOR=160000
JSR PC,CALLRS
JSR PC,CALLRS
MOV #-<<<RUGFNT+2>/2>&77777>,F
;FALL INTO CALLRS
CALLRS: JSR PC,@FIRSTR
JMP @SCNDR
DMP: ;FOR GETTING OR STORING INTO SWAP AREA
.IFNZ F.HD
MOV C,DMPDAR
CLR DMPDAE
MOV E,DMPDCS
SUB F,C
DMPP: MOV F,DMPWC
JSR 5,FDISK
DMPDAE: 0
DMPDAR: 0
0
DMPWC: 0
DMPDCS: 0
RTS PC
.ENDC
.IFZ F.HD
.IFNZ M.HD
MDMP: MOV C,SPMKDA
MOV E,SPMKCS
MOV F,SPMKWC
MOV F,MDSAV
NEG MDSAV
JSR PC,MDCNVT
JSR 5,MDISK
SPMKDA: 0
0 ;MEMORY ADDRESS
SPMKWC: 0
SPMKCS: 0
MOV C,MDSAV+2
JSR PC,MDADD
MOV MDSAV,C
RTS PC
.ENDC
.ENDC
DMPT: ;FOR GETTING OR WRITING INTO TRACK
.IFNZ F.HD
.IFNZ M.HD
CMP B,D
BEQ MDMPT
.ENDC
MOV A,DMPDAR
MOV B,DMPDAE
MOV D,DMPDCS
SUB F,A
SBC B
INC B ;CARRY IS OPPOSITE OF WHAT IT SHOULD BE
BR DMPP
.ENDC
.IFNZ M.HD
MDMPT: MOV A,PMKDA
MOV D,PMKCS
JSR PC,PMDSK
MOV A,MDSAV+2
JSR PC,MDADD
MOV MDSAV,A
RTS PC
PMDSK: MOV F,PMKWC
MOV F,MDSAV
NEG MDSAV
JSR PC,MDCNVT
PM1: JSR 5,MDISK
PMKDA: 0
0 ;RKBA
PMKWC: 0
PMKCS: 0
RTS PC
.ENDC
.ENDC
FDISK:
.IFNZ F.HD
MOV #10,-(SP) ;RETRY COUNT
.ENDC
FDISK1:
.IFNZ F.HD
MOV (F)+,DAE
MOV (F)+,DAR
MOV (F)+,CMA
MOV (F)+,WC
MOV (F)+,DCS
MOV #"FD,DERRTP
;FALL INTO SOOTH
SOOTH: TSTB DCS
BPL SOOTH
TST DCS ;WRITE ERROR?
BPL SOTH
DSER: INCB DCS+1 ;POWER CLEAR
.ENDC
DSERR: MOV A,-(SP)
JSR 5,TYPE
DERRTP==.
.ASCIZ /MDE? /
.EVEN
CLR A ;NOW WAIT FOR THE DISK TO SETTLE
1$: DEC A
BNE 1$
MOV (SP)+,A
DEC (SP) ;DECREMENT ERROR COUNT
BNE DSRTRY ;TRY AGAIN
HALT ;IT IS PROBABLY WRITE PROTECTED
MOV #10,(SP)
DSRTRY: SUB #10,F
CMP #"MD,DERRTP
BEQ MDISK1
TST -(F) ;FIXED DISK HAS AN EXTRA REGISTER
BR FDISK1<4B>
SOTH: TST (SP)+ ;POP ERROR COUNT
RTS F
MDISK:
.IFNZ M.HD
MOV #10,-(SP) ;RETRY COUNT
.ENDC
MDISK1:
.IFNZ M.HD
MOV (F)+,RKDA
MOV (F)+,RKBA
MOV (F)+,RKWC
MOV (F)+,RKCS
MOV #"MD,DERRTP
;FALL INTO MOOTH
MOOTH: TSTB RKCS
BPL MOOTH
TST RKCS
BPL SOTH
MSER: MOV #1,RKCS
BR DSERR
.ENDC
;PROCESS $^U
BOOT:
.IFNZ F.HD
JSR 5,FDISK
0
INVRG ;DAR
.ENDC
.IFZ F.HD
JSR 5,MDISK
LOWAD
.ENDC
RUGFNT ;CMA
-INVRGL ;WC
5 ;DCS
BOOT.1: JMP O.ODT
;PROCESS FOO^A, WHICH MAKES $G START AT FOO
GOADR: TST C
BEQ PGOADR
MOV E,ADRES
GOAD1: JMP O.DCD
PGOADR: JSR 5,TYPE
.BYTE 40
.BYTE 0
MOV ADRES,A
CLRB REGINF
JSR 5,SYMBOL
BR GOAD1
REINIT: MOVB #-1,O.P
CLR O.CSR1
CLR O.UST
MOV #USP,B
.IFNZ M1145
MOV #O.UST+2,SAVKR6
CMP R6AD,#SAVKR6
BNE NOTDUN
.ENDC
MOV #O.UST+2,(B)
NOTDUN: CLR -(B)
CMP B,#O.UR0
BNE NOTDUN
MOV #SAVDCS,B
NOTDN1: CLR (B)+
.IIF Z F.HD, CMP #SAVDAR+2,B
.IIF NZ F.HD, CMP #SAVDAE+2,B
BNE NOTDN1
.IFNZ M1145
CLR SAVSLR
CLR SVSSR3
CLR SVSSR0
.ENDC
CLR B
1$: DEC B
BNE 1$ ;WAIT ABOUT 1/3 SEC FOR I/O TO FINISH, ESP 11-TO-10
RESET
JMP DELT ;WILL RTS PC FOR US
DSTBL:
.IFNZ F.HD
JSR 5,FDISK
0
.ENDC
.IFZ F.HD
JSR 5,MDISK
.ENDC
SSTBL
CSTBL
-SSTBLL
3
RTS PC
.IFNZ M.HD
MDSAV: 0 ;ARG AND RESULT OF MDCNVT
0 ;OPTIONAL OFFSET ARGUMENT TO MDSAV
MDCNVT: MOV E,-(SP) ;LOOKS LIKE SAVING & RESTORING E IS UNNECESSARY, BUT UNCERTAIN ***
CLRB MDSAV
SWAB MDSAV
DIVIDE MDSAV,#14,SCRTCH,MDSAV
MLTPLY SCRTCH,#20,SCRTCH
ADD SCRTCH,MDSAV
MOV (SP)+,E
RTS PC
MDADD: MOV E,-(SP)
MOV MDSAV,E
BIC #177760,E
ADD MDSAV+2,MDSAV
BIC #177760,MDSAV+2
ADD MDSAV+2,E
CMP #14,E
BGT MDAD1
ADD #4,MDSAV
MDAD1: MOV (SP)+,E
RTS PC
.ENDC
.IFZ FMH
STLOGO: MOV #O.UR0,SP ;START TRACK 0 (LOGO)
CLR E
JSR PC,USAVE
JMP GO22
.IFNZ M.HD
BKUP: MOV #1,B
JSR PC,VERIF
MOV #5,E
MOV #3,F
BKUP1: MOV #20000,C ;COPY FROM DRIVE 1 TO 0
CLR D
BK: MOV #313*2,A
CLR B
BKLOOP: BIC D,B
BIS C,B
MOV E,BKCS
JSR PC,MBKE
BIC C,B
BIS D,B
MOV F,BKCS
JSR PC,MBKE
ADD #20,B
DEC A
BNE BKLOOP
JMP O.DCD
GBK: CLR B
JSR PC,VERIF
MOV #5,E
MOV #3,F
MOV #20000,D
CLR C
BR BK
MBKE: MOV B,BKDA
JSR 5,MDISK
BKDA: 0 ;RKDA
0 ;RKBA
-3072. ;RKWC
BKCS: 0 ;RKCS
VRFOK: RTS PC
WCHECK: MOV #5,E
MOV #7,F
BR BKUP1
VERIF:
.IFZ COMPUTER-1
;CHECK SWITCH ON LOGO MOVING HEAD DISK WHICH INVERTS LOW DRIVE SELECT BIT
;CALLED IN $$^U (COPY DRIVE 0 TO 1) AND $$^D (COPY DRIVE 1 TO 0)
CLR RKDA ;SELECT DRIVE 0
MOV #1,RKCS ;GATE DRIVE INTO RKDS
BIT #20000,RKCS ;IS IT REALLY DRIVE 0?
BEQ INVROK ;YES, NOT INVERTED
JSR 5,TYPE
.ASCIZ \WARNING, DISK INVERTED. OK?\
.EVEN
JSR PC,GET1UC
CMPB A,#'Y
BNE VRFERR
JSR PC,CRLF
INVROK:
.ENDC
ADD #60,B
MOVB B,DRVFRM
INC B ;CHEAP XOR #1,B
BIC #2,B
MOVB B,DRVTO
JSR 5,TYPE
.ASCII \COPY DRV \
DRVFRM=. ;DRIVE NUMBER OF "FROM" DRIVE
.ASCII \0 TO DRV \
DRVTO=. ;"TO" DRIVE
.BYTE '0,'?,0
.EVEN
JSR PC,GET1UC
CMPB A,#'Y
BEQ VRFOK
VRFERR: MOV #O.UR0,SP
JMP O.ERR
.ENDC
.IFF
STLOGO:
.IFNZ F.HD
MOV #FXWRT,WCHDSK
.IFF
MOV #MVWRT,WCHDSK
CLR WCHPLT
.ENDC
MOV #ROOTBK,BLKINC
JSR PC,RDIR.1
MOV #'.,DPNAM
JSR PC,RDDIR
MOV #"SI,DPNAM
MOV #"TS,DPNAM+2
CLR DPNAM+4
JSR PC,FIND.0
BNE 1$
JMP O.ODT
1$: JSR PC,LODFIL
JSR PC,SYMINT
JSR PC,REINIT
JMP GO22
.ENDC
;ABS LOADER
.IFNZ FPTR
DEVICE=177550
.ENDC
.IFZ FPTR
DEVICE=O.RCSR
.ENDC
L.LD2: MOV #L.READ,F
CLR A
JSR PC,@F
CMP D,#EOT
BNE L.LD2B
HALT
L.LD2B: DECB D
BNE L.LD2
JSR PC,@F
JSR PC,L.GWRD
MOV E,C
SUB #4,C
CMP #2,C
BEQ L.JMP
JSR PC,L.GWRD
MOV E,B
ADD RELOC,B
L.LD3: JSR PC,@F
BGE L.LD4
TSTB A
BEQ L.LD2
L.BAD: HALT
BR L.LD2
L.LD4: MOVB D,(B)+
BR L.LD3
L.READ: MOV #DEVICE,D
INCB @D
L.R1: TSTB @D
BPL L.R1
MOVB 2(D),D
ADD D,A
BIC #177400,D
DEC C
RTS PC
L.GWRD: MOV (SP)+,L.TMP
JSR PC,@F
MOV D,E
JSR PC,@F
SWAB D
BIS D,E
MOV L.TMP,PC
L.JMP: JSR PC,L.GWRD
JSR PC,@F
TSTB A
BNE L.BAD
ASR E
BCC L.JMP1
HALT
L.JMP1: RTS PC
L.TMP: .WORD 0
RELOC: 0
;CONSOLE PROGRAM FOR THE PDP11
WORD=.
XWORD: 0
CNSL.1: CLR TPS ;NO INTRPTS ON TTO
CLR TKS ;NO INTRPTS IN TTI
XHERE3: MOV #XBUFF,F
CLR (F)
MOV F,E
XHERE: TSTB RCSR
BMI XTENI ;CHAR ARRIVED FROM 10
XTHERE: TSTB TPS ;TTO READY?
BMI XTTOUT
XTHR: TSTB TKS
BPL XHERE ;NONE FROM TTY
XITTI: MOVB TKB,B
XITTI1: MOV C,-(P)
MOV B,C
JSR PC,SENDTC
MOV (P)+,C
BIC #177600,B
CMP B,#19. ;^S
BEQ XHERE3
BR XHERE
XTENI: MOVB RBUF,B ;GET CHAR
BIC #177600,B ;MASK JUNK
CMP B,#1 ;START OF BLOCK?
BEQ XRETN
BLT XOK ;BAD TO STRE ZERO IN BUFFER
TST A
BNE XOK2
CMP B,#2 ;LODER SENDS THAT AT IRST. THEN ECHO (IN RUG)
BNE XOK
INC A
XOK2: MOVB B,(F)+
CMP F,#XBUFF+200
BLE XOK
MOV #XBUFF,F
XOK: CLRB (F)
BR XTHERE
XTTOUT: TSTB (E)
BEQ XTHR
MOVB (E)+,TPB
CMP E,#XBUFF+200
BLE XTHR
MOV #XBUFF,E
BR XTHR
;LOAD A SYMBOL TABLE IN SPECIAL 11LOGO;LODER FORMAT
XSTBLK: JSR PC,XREAD ;LOADS SYMBOL TABLE FOR $LT ALSO
DECB D ;CHECK FOR +1 (START OF BLOCK)
BNE XSTBLK
JSR PC,XREAD ;READ ANOTHER CHAR (0 THIS TIME)
MOV #5,C ;WON'T SKIP IN XGWORD WHEN DEC & WILL =3 AFTER
CLR A
JSR PC,XGWORD ;GET TOTAL BYTE COUNT
SUB C,XWORD ;C=3
CMP C,XWORD ;DOES IT = 3?
BEQ XJMPBLK
MOV XWORD,C
JSR PC,XGWORD ;GET LOAD ADDRESS
MOV XWORD,B ;PUT ADDRESS IN PROPER PLACE
ADD RELOC,B
MOV B,O.SYME ;NEW BOTTOM OF SYMBOL TABLE
;READ IN REMAINDER OF DATA
XLDATA: JSR PC,XGWORD
TST C ;STILL DATA LEFT?
BGT XLDLP
BLT XCHECKS ;JUST CHECKSUM
MOVB XWORD,(B)+ ;ONE DATA, ONE CHECKSUM
XCHECKS: INCB A
BNE XBAD
JSR F,ACN
4
BR XSTBLK
XLDLP: MOVB XWORD,(B)+
MOVB XWORD+1,(B)+
BR XLDATA
TENPNT: 0
XREAD: .IFNZ TEN11
TST TEN11S
BEQ XREADL
1$: TST TENCNT
BEQ 1$
MOVB @TENPNT,D
DEC TENCNT
BNE 2$
MOV #TENBUF-1,TENPNT
2$: INC TENPNT
BR XREAD1
.ENDC
XREADL: TSTB RCSR ;CHAR SENT YET?
BPL XREAD ;NO
MOVB RBUF,D
XREAD1: BIC #177600,D ;MASK OFF PARITY ETC
SUB #40,D ;+40 AVOIDS CONTROL CHARATERS
XRETN: RTS PC
;INSTEAD OF 8 BIT FRAMES 6 BITS, THEN 4 THEN 6 WILL BE
;SENT THIS TOTALS 16 BITS
XGWORD: JSR PC,XREAD
MOV D,XWORD ;WANT TO ZERO TOP BYTE
JSR PC,XREAD
SWAB D
ASR D
ASR D
ADD D,XWORD
ADD XWORD,A
DEC C
BEQ XDONE
JSR PC,XREAD
SWAB D
ASL D
ASL D
ADD D,XWORD
MOVB XWORD+1,D
ADD D,A
XDONE: DEC C
RTS PC
XJMPBLK: JSR PC,XGWORD
MOV XWORD,B
JSR PC,XGWORD
INCB A
BNE XBAD
JSR F,ACN
4
RTS PC
XENDCNS: ASR B
BCC XJUMP
HALT
XBAD: JSR F,ACN
6
BR XSTBLK
XJUMP: JSR F,ACN
47 ;DON'T SEND SYMBOLS
ASL B
JMP (B)
ACN: .IFNZ TEN11
TST TEN11S
BEQ ACNL
1$: TST TENCHR
BNE 1$
MOV (F)+,TENCHR
RTS F
.ENDC
ACNL: MOV C,-(P)
MOV (F)+,C
JSR PC,ACK
MOV (P)+,C
RTS F
XBUFF: 0
.=.+200
RUGEND==.
;COMMUNICATION ROTUINES
;SEND C TO THE TEN, EITHER BY THE LINE OR BY THE TEN/11 INTERFACE
SENDC:
ACK: .IFNZ TEN11
TST TEN11S
BEQ SENDTC
ACKT: TST TENCHR
BNE ACKT
MOV C,TENCHR
RTS PC
.ENDC
;SEND C TO THE TEN, ALWAYS OVER THE LINE
SENDTC: TSTB TSCR
BPL SENDTC
MOV C,TBUF
RTS PC
;INITIALIZE THE LINE TO THE TEN
LINEIN: MOV #DCSPD,RCSR
MOV #DCSPD,TSCR ;INITIALIZE THE LINES
RTS PC
WAIT10: TSTB RCSR ;TIMING THING
BPL WAIT10
MOVB RBUF,B
RTS PC
.IFZ M1145
.=HCOR-700
.ENDC
.IFNZ M1145
.=HCOR-1000
.ENDC
RUGST: BR RUGS1 ;ENTRY TO START RUG=1
INCB RESTFL ;ENTRY TO START LOGO=2
RUGS1: INCB #0
RESTFL=.-2
TSTB #0
INPFL=.-2
BNE O.BRKS
JMP RESART
O.BRK: MOV (SP)+,O.UPC
MOV (SP)+,O.UST
O.BRKS: MOV SP,O.USP
.IFNZ M1145
MOV SSR0,SVSSR0 ;SAVE SEGMENTATION REGS
BIC #1,SSR0 ;DISABLE SEGMENTATION
MOV SSR3,SVSSR3
MOV STACKR,SAVSLR ;STACK LIMIT REGISTER
CLR STACKR
MOV #7,SSR3 ;ENABLE D SPACE
BIC #4000,PSW
.ENDC
MOV A,(PC)+
SAVR0: 0
MOV B,(PC)+
SAVR1: 0
.IFNZ DM11
MOV #DMCSR+2,B
DMWAIT: TST (B)
BNE DMWAIT ;USED TO BE BNE O.BRKS ***
MOV -(B),(PC)+
SAVDM: 0
CLR (B)
.ENDC
MOV #SAVDCS,A
.IFNZ F.HD
MOV #DCS,B
.ENDC
.IFZ F.HD
MOV #RKCS,B
.ENDC
GLOP1: TSTB (B)
BPL GLOP1
MOV (B)+,(A)+ ;SAVDCS
MOV (B)+,(A)+ ;SAVWC
MOV (B)+,(A)+ ;SAVCMA
MOV (B)+,(A)+ ;SAVDAR
.IFNZ F.HD
MOV (B),(A)+ ;SAVDAE
.ENDC
;FALLS THROUGH
;FALLS IN
LOZT: MOV #10,A ;COUNT
LOST:
.IFNZ F.HD
MOV #DAE,B ;IN CASE LOOP BACK HERE
CLR (B)
.ENDC
.IFZ F.HD
MOV #RKDA+2,B
.ENDC
MOV #SPRG,-(B)
CLR -(B) ;CMA
MOV #-SPRGL,-(B) ;WC
MOV #3,-(B)
GLOP2: TSTB (B)
BPL GLOP2
TST (B)
BPL GLOK
.IFNZ M1145+M1140
SOB A,LOST
.IFF
DEC A
BGT LOST
.ENDC
HALT ;IT'S HOPELESS
BR LOZT ;MAYBE IT NEEDS TIME
SHLOCK: MOVB #10,A
GLOK:
.IFNZ F.HD
MOV #DAE,B
CLR (B)
.ENDC
.IFZ F.HD
MOV #RKDA+2,B
.ENDC
MOV #SSTBL,-(B)
MOV #CSTBL,-(B)
MOV #-SSTBLL,-(B)
MOV #5,-(B)
GLOP3: TSTB (B)
BPL GLOP3
TST (B)
BPL GLOK3
.IFNZ M1145+M1140
SOB A,GLOK
.IFF
DEC A
BGT GLOK
.ENDC
HALT
BR SHLOCK ;YOU CERTAINLY ARE
GNOOK: HALT
GLOK3: CLRB INPFL ;NON ZERO WHEN SWAPED PROG IS IN CORE
JMP BREAK ;RESTORE A AND B THERE
;B CONTAINS #DCS
;A CONTAINS #SAVDCS
GOGO: INCB (B) ;READ IN USER
GOGO2: TSTB (B)
BPL GOGO2
TST (B)
BMI GNOOK
INCB INPFL
MOV (A)+,(B)+
MOV (A)+,(B)+ ;WC
MOV (A)+,(B)+ ;CMA
MOV (A)+,(B)+ ;DAR
.IFNZ F.HD
MOV (A)+,(B)+ ;DAE
.ENDC
.IFNZ DM11
MOV SAVDM,DMCSR
.ENDC
;ALREADY RESTORED OTHER THINGS
MOV SAVR0,A
MOV SAVR1,B
.IFZ M1145+M1140
RTI
.IFF
.IFNZ M1145
MOV #0,STACKR ;RESTORE STACK LIMIT REG
SAVSLR=.-4
MOV #0,SSR3 ;RESTORE SEGMENTATION STATUS REGS
SVSSR3=.-4
MOV #0,SSR0
SVSSR0=.-4
.ENDC
RTT
.ENDC
;LOCATIONS FOR RESIDENT PORTION TO RESTORE BEFORE STARTING UP USER
0
0
0 ;PIDDLE INITIALIZED TO HERE
0
0
0
O.UPC: 0 ;USER'S PC
O.UST: 0 ;USER'S STATUS
O.USP: 0 ;USER'S STACK POINTER (P)
SAVDCS: 0 ;SAVED DISK REGISTERS
SAVWC: 0
SAVCMA: 0
SAVDAR: 0
.IFNZ F.HD
SAVDAE: 0
.ENDC
.IIF P2, PFLAG RUGEND,\RUGEND
.END BEGRUG
Reference in New Issue View Git Blame Copy Permalink