Google
 

Trailing-Edge - PDP-10 Archives - dec-10-omona-u-mc9 - dtboot.mac
There are no other files named dtboot.mac in the archive.
TITLE DTBOOT - V004 - DECTAPE BOOTSTRAP (BIG TENDMP)	-
SUBTTL R. CLEMENTS /RCC/JEF

;(C) COPYRIGHT DIGITAL EQUIPMENT CORPORATION, MAYNARD MASS 1971, 1974

;"THESE BOOTS WERE MADE FOR WALKIN'." - N.S.

REPEAT 0,<

	IN ORDER TO TEST MOST OF THE DTBOOT CODE UNDER TIME-SHARING,
SET DEBUG==1 AND LOAD AS FOLLOWS:

	.R LINK
	*/LOCALS DTBOOT,SYS:DDT/G

	THIS GIVES A 10 K "PSEUDO-MACHINE" INTO WHICH SMALL PROGRAMS
CAN BE LOADED.  IT IS SUFFICIENT FOR A SIMPLE LEVEL OF TESTING.
>

;AC'S

F=0	;FLAGS
A=1	;GENERAL AC'S
B=2	; ..
C=3	; ..
X=4	;MEMORY ADDRESS COUNTER
W=5	;WORD RETURNED BY RWORD OR SIXBRD
NAME=6	;NAME OF FILE BEING SEARCHED FOR
EXT=7	;EXTENSION OF FILE BEING SEARCHED FOR
Q=10	;COUNTER TO STEP THROUGH BUFFER OF 200 DATA WORDS
SW=11	;SWITCH FROM COMMAND STRING
N=12	;NUMBER ASSEMBLER IN TYPEIN, COUNTER IN SEARCH,RDBLK,WRBLK
M=13	;MEMORY AOBJN POINTER FOR READING THE DATA TO CORE
FN=14	;FILE NUMBER, 1 TO NFILES
BP=15	;POINTER TO CURRENT DIR BYTE (ALSO SIXBIT INPUT)
LBN=16	;TAPE BLOCK NUMBER TO READ
P=17	;STACK POINTER
;CORE ALLOCATION
IFNDEF DEBUG,<DEBUG==0>		;DEBUGGING CONDITIONAL FEATURES
IFN DEBUG,<
	REL==0			;DEBUG WITH ABSOLUTE ADDRESSES
	CORE==24000		;IN 10 K
>
IFNDEF REL,<REL=0>		;REL=1 CAUSES A RELOCATABLE ASSEMBLY
IFG REL,<BASE: CORE=BASE+1000>
IFNDEF CORE,<CORE=200000>	;ASSUME 64K

ZZ=CORE-2000+140		;SET ABOVE JOB DATA AREA OF TOP K

CLRTOP=ZZ-1			;WHEN CLEARING CORE, CLEAR TO HERE

DEFINE U(Z)<
	UU(Z,1)>		;ONE WORD ALLOCATION
DEFINE UU(Z,N)<	Z=ZZ
ZZ=ZZ+N
IFGE <ZZ-CORE+1000>,<
PRINTX ALLOCATION ERROR
>>

OPDEF PJRST [JRST]
IFE REL,<
	LOC CORE-1000		;ABSOLUTE ASSEMBLY
IFE DEBUG, <RIM10B>		;PAPER TAPE FORMAT
>

U(DEVICE)			;DEVICE NAME FROM COMMAND
U(FNAME)			;FILE NAME FROM COMMAND
U(FEXT)				;FILE EXTENSION FROM COMMAND
U(TAPEID)			;TAPE NAME FOR Z COMMAND
U(PRVLBN)			;LBN SOUGHT ON PREVIOUS SEARCH
U(FBN)				;FIRST BLOCK NUMBER, FOR LINK

UU(HBUF,200)			;DIRECTORY OF DTA
UU(DBUF,200)			;DATA BUFFER
FIRSTW==20			;FIRST LOCATION CONSIDERED ON WRITE
PDLL==20			;STACK LENGTH

;I/O DEVICE PARAMETERS

DTC==320			;DEVICE CODE FOR DTA CONTROL
DTS==324			;DEVICE CODE FOR DTA STATUS
O.NOP==0			;OPCODES FOR THE DTA CONTROL CONO
O.SRCH==200			;SEARCH
O.READ==300			;READ
O.WRIT==700			;WRITE
C.STOP==400000			;CONO BITS
C.FWD==200000			;GO FORWARD
C.REV==100000			;GO REVERSE
C.NDEL==040000			;NO DELAY AFTER CONO
C.SEL==020000			;SELECT A UNIT
C.DSEL==010000			;DESELECT CURRENT UNIT
S.DAT==1			;DATA DONE FLAG
S.INT==2			;INT REQ FLAG
S.END==020000			;END ZONE HIT
S.JOBD==100000			;JOB DONE FLAG
S.ERR==653300			;ERRORS TO GIVE UP ON.
;FLAGS, LEFT HALF OF F

L.DOT=1				;DOT SEEN IN FILE SPEC
L.UPA==2			;UPARROW (TAPE ID)
L.SLA==10			;SLASH SEEN IN FILE SPEC
L.ALL==13			;ABOVE FLAGS TOGETHER.
L.UPA2==20			;UPARROW AGAIN FOR READING AT ZERO ROUTINE
L.REV==400000			;TAPE MOVING IN REVERSE. SIGN BIT REQ?
L.REVA==40			;ALLOCATION PASS IS GOING IN REVERSE
L.TURN==100			;ALLOCATION PASS HAD TO TURN AROUND

;FLAGS, RIGHT HALF OF F

R.MRG==1			;MERGE, NOT LOAD.
R.WEOF==2			;ON WHILE WRITING JRST WORD(S) IN LAST BLK
R.DIRI==4			;DIRECTORY IN CORE IS VALID
R.STRT==10			;ON IF LOAD AND GO. OFF IF JUST LOAD

;SYSTEM PARAMETERS WHICH MUST AGREE WITH TIMESHARING SYSTEM

DIRBLK==144			;WHERE DIRECTORY IS ON TAPE
D.BYT==0			;WORD OF BYTES IN DIRECTORY
D.NAM==123			;FIRST NAME IN DIRECTORY
D.EXT==151			;START OF EXTENSIONS IN DIR
NFILES==26			;HOW MANY FILES FIT IN DIR
MAXBLK==1101			;LAST BLOCK ON THE TAPE
BLKFAC==2			;BLOCKING FACTOR - WRITE ONE OF N BLKS

;SPECIAL DEBUGGING SYMBOLS

IFN DEBUG,<
DTA==1				;CHANNEL FOR DECTAPE
DTREAD==0			;INDICATE A READ COMMAND
DTWRIT==1			;INDICATE A WRITE COMMAND
>
;START HERE

GO:
IFE DEBUG,<
	CONO 200000		;I/O BUS RESET
	CONO 4,10400		;CLEAR PI SYSTEM
>
IFN DEBUG,<
	RESET			;RESET THE WORLD
>
	SETZB	F,DEVICE	;CLEAR FLAGS AND DEVICE NAME
REGO:	MOVE P,PDP		;INITIAL STACK POINTER
	ANDI F,R.DIRI	;CLEAR OUT RANDOM FLAGS
	SETZM FNAME		;CLEAR REQUESTED FILE NAME
	SETZB	SW,FEXT		;CLEAR COMMAND SWITCH AND FILE EXT
	PUSHJ P,CRLF		;SAY HELLO
GOL:	MOVE BP,SIXPTR		;POINTER TO THE WORD.
	SETZB N,W		;CLEAR ANSWERS.
SIXBRL:
IFE DEBUG,<
	CONSO TTY,40		;WAIT FOR A KEY TO BE ST(R)UCK
	JRST .-1		; ..
	DATAI TTY,C		;GET THE CHAR
	PUSHJ P,TYO		;ECHO IT
>
IFN DEBUG,<
	INCHRW	C		;GET A CHARACTER
>
	ANDI C,177		;ONLY 7 BITS
	CAIN C,177		;RUBOUT?
	JRST REGO		;YES. QUIT.
	CAIG C,172		;CHECK FOR LOWER CASE
	CAIGE C,140		; ..
	SKIPA			;NOT L.C.
	TRZ C,40		;L.C., MAKE U.C.
	CAIG C,"Z"		;LETTER?
	CAIGE C,"A"		; ..
	SKIPA			;NOT A LETTER.
	JRST SIXLTR		;LETTER.
	CAIG C,"9"		;NUMBER?
	CAIGE C,"0"		; ..
	JRST GO0		;NO. RETURN WITH BREAK CHAR.
	LSH N,3			;BUILD OCTAL NUMBER
	ADDI N,-60(C)		;ADD IN THIS DIGIT
SIXLTR:	TRC C,40		;MAKE SIXBIT
	TLNE BP,770000		;ONLY 6 CHARS
	IDPB C,BP		;STORE CHAR IN W
	JRST SIXBRL		;LOOP FOR MORE.
GO0:	CAIE C,":"		;UNIT DELIMITER?
	JRST GO1		;NO.
	TRZ F,R.DIRI		;DIRECTORY NO GOOD, SELECTING A TAPE
	ANDI N,7		;JUST THREE BITS OF UNIT NUMBER
	MOVEM N,DEVICE		;YES. SAVE NUMBER OF DEVICE
	JRST GOL		;GO READ MORE.
GO1:	TLNN F,L.ALL		;ANY SYNTAX REQUESTS?
	JRST GO6		;NO. SEE IF FILE NAME.
	TLZE F,L.DOT		;WAS THERE A DOT?
	HLLOM W,FEXT		;YES. STORE EXT. RH IS FLAG IF BLANK.
	TLZE F,L.UPA		;UPARROW?
	MOVEM W,TAPEID		;YES. SAVE TAPE NAME.
	TLZE F,L.SLA		;SLASH SWITCH?
	MOVEM W,SW		;YES. SAVE SWITCH WORD
GO7:
IFN DEBUG,<
	CAIN	C,15		;UNDER TIME-SHARING, SWALLOW CARRIAGE-
	INCHRW	C		;RETURN BUT DIGEST LINE-FEED.
>
	CAIGE C,175		;ALTMODE?
	CAIG C,40		;SPACE OR CONTROL CHAR?
	JRST DO			;YES. GO PROCESS COMMAND
	CAIE C,"."		;FILE EXTENSION REQUEST?
	JRST GO3		;NO.
	TLO F,L.DOT		;YES. REMEMBER THAT
	JRST GOL		;AND READ ON.

GO3:	CAIE C,"/"		;SLASH?
	JRST GO5		;NO.
	TLO F,L.SLA		;YES. MARK SWITCH COMING
	JRST GOL		;RETURN TO SCAN
GO5:	CAIN C,"^"		;UPARROW?
	TLO F,L.UPA+L.UPA2	;YES. NOTE IT.
	JRST GOL		;LOOP FOR MORE.
GO6:	SKIPE W			;NO PUNCTUATION. NAME TYPED?
	MOVEM W,FNAME		;YES. STORE NAME
	JRST GO7		;GO CHECK PUNCTUATION
;HERE WHEN COMMAND STRING SUCCESSFULLY READ. DO THE JOB.

DO:	PUSHJ P,CRLF		;SIGNAL STARTING I/O
	LSH	SW,-^D30	;GET ONLY FIRST CHAR OF SWITCHES
	CAIN SW,"Z"-40		;ZERO COMMAND?
	JRST ZERO		;YES.
	CAIN SW,"G"-40		;GO COMMAND?
PROGSA:	JRST GO			;YES. *** RH MODIFIED ***
	CAIL SW,"0"-40		;NUMERIC?
	CAILE SW,"7"-40		; OCTAL, THAT IS,
	SKIPA			;NO.
	JRST SETSA		;YES. GO SET STARTING ADDRESS
	PUSHJ P,RDDIR		;REST OF COMMANDS NEED DIRECTORY
	CAIN SW,"M"-40		;MERGE?
	TROA F,R.MRG		;YES. SKIP INTO LOAD, FLAGGING MERGE ONLY
	CAIN SW,"L"-40		;LOAD COMMAND?
	JRST LOAD		;YES.
	CAIN SW,"D"-40		;DUMP COMMAND?
	JRST DUMP
	CAIN SW,"F"-40		;FILE DIRECTORY?
	JRST FILDIR		;YES.
	CAIN SW,"K"-40		;KILL A FILE (DELETE)?
	JRST KILL		;YES.
	JUMPE SW,RUN		;IF NO SWITCH, ASSUME LOAD AND RUN
	PUSHJ P,ERROR		;NO OTHERS IMPLEMENTED

SETSA:	HRRM N,PROGSA		;STORE PROGRAM STARTING ADDR
	JRST REGO		;AND WAIT FOR ANOTHER COMMAND

FILDIR:	MOVSI N,-NFILES		;LIST A QUICK DIRECTORY
FILDL:	SKIPN B,HBUF+D.NAM(N)	;GET A NAME, IF ANY IN THIS SLOT
	JRST FILDN		;NONE HERE
	PUSHJ P,SIXOUT		;TYPE C(B) IN SIXBIT
	HLLZ B,HBUF+D.EXT(N)	;GET EXTENSION
	JUMPE B,FILD1		;IF NOT BLANK,
	MOVEI C,"."		;DOT
	PUSHJ P,TYO		;TYPE DOT
	PUSHJ P,SIXOUT		;TYPE EXT
FILD1:	PUSHJ P,CRLF		;A CARRIAGE RETURN
FILDN:	AOBJN N,FILDL		;LOOP FOR ALL NAMES
	JRST REGO1		;STOP TAPE AND GO FOR NEXT COMMAND
;LOAD AND RUN COMMANDS

RUN:	TRO F,R.STRT		;LOAD AND START PROGRAM
LOAD:	MOVSI FN,-NFILES	;SEARCH TO SEE IF ONLY ONE SAV FILE ON DT
	MOVEI A,0		;WHERE NAME WILL GO IF FOUND
RUN5:	HLRZ EXT,HBUF+D.EXT(FN)	;CHECK AN EXTENSION
	CAIN EXT,(SIXBIT /SAV/)	;IS IT A SAV FILE?
	JRST RUN2		;YES. GO NOTE IT
RUN4:	AOBJN FN,RUN5		;LOOP THRU COUNTING ALL FILES
	SKIPN A			;WAS ONE AND ONLY ONE FOUND?
RUN3:	MOVE A,SYSTEM		;DEFAULT READ-FILE NAME
	SKIPN FNAME		;NAME SUPPLIED?
	MOVEM A,FNAME		;NO. PLUG IN DEFAULT.
	PUSHJ P,LOOK		;TRY TO FIND FILE
	  PUSHJ P,ERROR		;NOT THERE. FAIL.
	MOVEI LBN,1		;HAVE TO FIND A BLOCK OF FILE
	MOVE BP,BYTPTR		;LOOK THRU DIRECTORY
RUNL:	ILDB N,BP		;GET A BYTE
	CAIN N,0(FN)		;BELONG TO THIS FILE?
	JRST RUN1		;YES.
	CAIL LBN,MAXBLK		;LOOKED TOO FAR?
	 PUSHJ P,ERROR		;YES. NO BLKS IN FILE!
	AOJA LBN,RUNL		;LOOK FURTHER
RUN1:	PUSHJ P,RDDAT1		;READ THE DATA BLOCK TO FIND FBN
	LDB A,[POINT 10,DBUF+0,27]	;FIRST BLOCK OF FILE
	HRLM A,DBUF+0		;PUT IT IN LINK SLOT TO BE READ NEXT
RFILE:	SETZB Q,40		;CLEAR CORE BEFORE READING FILE
				;AND INITIALLY NO WORDS IN DATA BUFFER
	MOVE A,BLTXWD		; ..
	TRNN F,R.MRG		;UNLESS MERGE ONLY,
	BLT A,CLRTOP		;CLEAR UP TO BASE OF THIS PROGRAM
RFILL1:	PUSHJ P,RWORD		;READ A POINTER OR JRST WORD
	SKIPL M,W		;WHICH IS IT?
	JRST STARTQ		;TRANSFER WORD
RFILL2:	PUSHJ P,RWORD		;READ A WORD OF DATA
	MOVEM W,1(M)		;STORE IT IN CORE
	AOBJN M,RFILL2		;COUNT THE CORE POINTER.
	JRST RFILL1		;IT RAN OUT. GET ANOTHER.

RUN2:	JUMPN A,RUN3		;IF ALREADY ONE, THIS IS 2. QUIT.
	MOVE A,HBUF+D.NAM(FN)	;FIRST SAV FILE. GET ITS NAME.
	JRST RUN4		;AND SEE IF ANY MORE.
STARTQ:	HRRM W,PROGSA		;SAVE THE STARTING ADDRESS
REGO1:
IFE DEBUG,<
	CONO DTC,C.STOP		;STOP THE TAPE
>
	TRNE F,R.STRT		;LOAD OR START?
	JRST 0(W)		;START
	JRST REGO		;JUST LOAD. GO GET ANOTHER COMMAND

;SUBROUTINE TO READ A DATA WORD FROM THE FILE.

RWORD1:	MOVE Q,DBUFP		;PREPARE TO COUNT DATA WORDS
RWORD:	JUMPGE Q,RWNXTB		;NEED ANOTHER BLOCK?
	MOVE W,0(Q)		;NO. GET A WORD.
	AOBJN Q,.+1		;COUNT IT.
	POPJ P,0		;RETURN FROM RWORD
RWNXTB:	PUSHJ P,RDDATA		;NO. READ NEXT DATA BLOCK, IF ANY
	JRST RWORD1		;READ FROM THIS BLOCK

DUMP:	MOVE A,CRASH		;DEFAULT FILE NAME
	SKIPN FNAME		;NAME ALREADY SET?
	MOVEM A,FNAME		;NO. USE DEFAULT
	PUSHJ P,ENTR		;TRY TO FIND THE FILE.
	 PUSHJ P,ERROR		;NO FREE SLOTS (OR MAYBE NO BLKS LEFT)
	MOVEM LBN,FBN		;SAVE AS FIRST BLOCK NUMBER
	MOVEI Q,0		;INITIALIZE DATA BLOCK COUNTER
	MOVEI M,FIRSTW-1	;AND CORE ADDRESS COUNTER
DUMPL2:	HRRZS X,M		;START OF A BLOCK
DUMPL1:	SKIPN 1(X)		;THIS WORD ZERO IN CORE?
	JRST DUMP1		;YES. SEE IF END OF A BLOCK.
	CAIGE X,CLRTOP		;LOOKED AT ALL OF CORE?
	AOJA X,DUMPL1		;NO. COUNT PART OF THIS BLOCK, LOOK ON.
DUMP1:	MOVEI W,0(M)		;END OF BLOCK. IS BLOCK EMPTY?
	SUBI W,0(X)		;START MINUS END OF BLK
	JUMPE W,DUMP2		;JUMP IF BLOCK EMPTY
	HRL M,W			;MAKE -COUNT,,START-1 FOR COUNTER
	MOVE W,M		;AND FOR DATA IN FILE
	PUSHJ P,WWORD		;WRITE IT OUT AS DATA
DUMPL3:	MOVE W,1(M)		;GET THE WORD FROM CORE
	PUSHJ P,WWORD		;OUTPUT TO FILE
	AOBJN M,DUMPL3		;OUTPUT ALL OF BLOCK
DUMP2:	CAIGE X,CLRTOP		;CONSIDERED ALL OF CORE?
	AOJA M,DUMPL2		;NO. MOVE ON.
	TRO F,R.WEOF		;FLAG WRITING LAST BLK, SO NO ALLOC
	MOVE W,PROGSA		;YES. APPEND STARTING ADDRESS
	PUSHJ P,WWORD		;WRITE OUT THIS WORD
	JUMPL Q,.-1		;IF MORE TO GO IN BLOCK, WRITE AGAIN
	JRST CLS		;WRITE OUT THE DIRECTORY
				;AND RESTART PROGRAM FOR NEXT COMMAND
;SUBROUTINE TO WRITE A WORD INTO THE FILE

WWORD:	SKIPL Q			;NEED A NEW POINTER?
	MOVE Q,DBUFP		;YES.
	MOVEM W,0(Q)		;PUT WORD INTO BUFFER
	AOBJN Q,CPOPJ		;COUNT POINTER. DONE?
	MOVE A,FBN		;GET FIRST BLOCK NUMBER
	LSH A,10		;PUT IN RIGHT PLACE
	TRO A,177		;DECLARE 127 WORDS IN BLOCK USED
	HRRZM A,DBUF+0		;PUT IN LINK WORD
	TRNE F,R.WEOF		;WRITING LAST BLK?
	JRST WWORD1		;YES. DONT ALLOCATE ANOTHER
	PUSH P,LBN		;SAVE BLOCK ABOUT TO WRITE
	PUSHJ P,ALLOC		;GET NEXT BLOCK OF FILE
	 PUSHJ P,ERROR		;NONE AVAILABLE
	HRLM LBN,DBUF+0		;PUT IN LINK WORD
	POP P,LBN		;RESTORE BLOCK FOR WRITING NOW
WWORD1:	PUSHJ P,WRDATA		;OUTPUT BLOCK, IF POSSIBLE
	HLRZ LBN,DBUF+0		;GET LINK TO NEXT BLOCK IN LBN
	POPJ P,0		;OK. RETURN.

;SUBROUTINE TO LOOK FOR FILE

LOOK:	MOVE NAME,FNAME		;GET DESIRED FILENAME
	MOVSI EXT,(SIXBIT /SAV/)	;DEFAULT EXTENSION
	SKIPE FEXT		;ANY SUPPLIED?
	HLLZ EXT,FEXT		;YES. USE IT.
SRCHFD:	MOVSI FN,-NFILES	;MAKE AOBJN COUNTER
SCHL2:	MOVE B,HBUF+D.NAM(FN)	;GET A FILE NAME
	CAME B,NAME		;IS NAME RIGHT?
	JRST SCHN2		;NO. MOVE ON.
	HLLZ B,HBUF+D.EXT(FN)	;CHECK THE EXTENSION
	CAMN B,EXT		;IS IT RIGHT TOO?
	AOJA FN,CPOPJ1		;YES. GOOD RETURN, ANSWER IS FILE NUMBER IN FN
SCHN2:	AOBJN FN,SCHL2		;COUNT FILE, EXT. CHECK NEXT FILE IN FD
	POPJ P,0		;FAIL RETURN, NOT FOUND.
;SUBROUTINE TO READ NEXT BLOCK OF DATA INTO DBUF

RDDATA:	HLRZ LBN,DBUF+0		;LINK
	JUMPE LBN,ERROR		;JUMP IF END OF FILE
RDDAT1:	MOVEI A,DBUF		;SELECT DATA BUFFER
RDBLK:	PUSHJ P,PROCBK		;PROCESS A BLOCK
IFE DEBUG,<
	 CONO DTC,O.READ	;ARGS TO PROCBK
	 DATAI DTC,0(A)		; TO CAUSE IT TO READ THE BLOCK
>
IFN DEBUG,<
	EXP	DTREAD		;MARK TO READ
>
	POPJ P,0		;SUCCESS. RETURN

RDDIR:	TRNE F,R.DIRI		;IS THE DIRECTORY IN CORE OK?
	POPJ P,0		;YES. DONT READ IT AGAIN
	MOVEI A,HBUF		;MUST READ. WHERE TO PUT IT.
	MOVEI LBN,DIRBLK	;BLOCK ON TAPE TO READ
	PUSHJ P,RDBLK		;READ IT
IFE DEBUG,<
	CONO DTC,C.STOP		;STOP TAPE IN CASE OF /F COMMAND
>
	TRO F,R.DIRI		;HAVE A GOOD DIRECTORY IN CORE NOW
	POPJ P,0		;RETURN FROM RDDIR

ZERO:	MOVE A,TAPEID		;COPY TAPE NAME IF ANY
	MOVEM A,HBUF+177	; ..
	TLZN F,L.UPA2		;WAS ONE THERE?
	PUSHJ P,RDDIR		;NO. GET THE ONE ON TAPE
	SETZM HBUF		;CLEAR OUT REST OF DIR
	MOVE A,[XWD HBUF,HBUF+1] ; ..
	BLT A,HBUF+176		; ..
	MOVSI A,(<36B4+36B9>)	;ALLOCATE BLOCKS 1 AND 2
	MOVEM A,HBUF+D.BYT+0	; ..
	MOVSI A,(36B9)		;AND BLOCK 144
	MOVEM A,HBUF+D.BYT+16	; ..
	HRLOI A,7		;AND THE NONEXISTENT ONES
	MOVEM A,HBUF+D.BYT+122	; ..
CLS:	PUSHJ P,WRDIR		;WRITE OUT THE DIRECTORY
	JRST REGO1		;STOP TAPE AND RETURN TO COMMAND SCANNER

WRDIR:	MOVEI LBN,DIRBLK	;BLOCK TO WRITE
	MOVEI A,HBUF		;DATA TO WRITE
	PJRST WRBLK		;WRITE IT

WRDATA:	MOVEI A,DBUF		;WRITE FROM DATA BUFFER
WRBLK:	PUSHJ P,PROCBK		;PROCESS THE BLOCK
IFE DEBUG,<
	 CONO DTC,O.WRIT	;ARGS TO PROCBK TO CAUSE IT
	 DATAO DTC,0(A)		;TO WRITE THE BLOCK ONTO TAPE
>
IFN DEBUG,<
	EXP	DTWRITE		;MARK TO WRITE
>
	POPJ P,0		;RETURN FROM WRBLK
IFE DEBUG,<
PROCBK:	PUSHJ P,SEARCH		;ROUTINE TO READ OR WRITE A BLOCK OF TAPE
				; FIRST FIND THE BLOCK (EITHER DIRECTION)
	MOVEI N,200		;NUMBER OF WORDS IN A BLOCK
	TLNE F,L.REV		;WHICH WAY WE GOING?
	ADDI A,177		;BACKWARDS. WRITE FROM TOP OF CORE DOWN
	XCT @0(P)		;CONO WRITE OR READ
	AOS 0(P)		;COUNT ON TO DATAI OR DATAO
PROCLP:	CONSZ DTS,S.ERR!S.END	;TROUBLE?
	PUSHJ P,ERROR		;YES. QUIT
	CONSO DTS,S.DAT		;WANT DATA MOVED YET?
	JRST PROCLP		;NO. WAIT SOME MORE.
	XCT @0(P)		;YES. DATAI OR DATAO TO/FROM BUFFER
	ADDI A,1		;COUNT BUFFER POINTER
	TLNE F,L.REV		;GOING BACKWARDS?
	SUBI A,2		;YES. THEN COUNT POINTER BACKWARDS TOO
	SOJG N,PROCLP		;TRANSFERRED WHOLE BLOCK?
	CONO DTS,1		;YES. TELL IT TO DO CHECKSUMMING AND QUIT
	CONSO DTS,S.JOBD	;DONE?
	JRST .-1		;NOT YET. WAIT.
	JRST CPOPJ1		;YES. RETURN AFTER THE DATAI/O ARGUMENT

SEARCH:	MOVE C,DEVICE		;GET DRIVE NUMBER
	LSH C,11		;PUT IN UNIT DIGIT FOR CONO
	CONSZ DTC,C.FWD!C.REV	;TAPE GOING AT THE MOMENT?
	JRST SRCHC		;YES.
	TRO C,C.FWD!C.DSEL	;NO. MAKE IT GO FORWARD
	TLZ F,L.REV		;AND GET THE FLAG TO SAY THAT
SRCHC:	CONO DTC,O.SRCH!C.SEL(C) ;MAKE IT SEARCH
SRCHW:	CONSZ DTS,S.END		;AT END ZONE?
	JRST SRCHTA		;YES. TURN AROUND.
	CONSZ DTS,S.ERR		;ANY ERRORS?
	 PUSHJ P,ERROR		;YES. QUIT.
	CONSO DTS,S.DAT		;BLOCK NUMBER FOUND?
	JRST SRCHW		;NO. WAIT FOR IT
	DATAI DTC,N		;YES. SEE WHAT BLOCK WE ARE AT
	ANDI N,7777		;JUST FOR SAFETY, MASK JUNK OUT
	SUBI N,0(LBN)		;GET THE DISTANCE TO GO
	JUMPE N,CPOPJ		;IF FOUND, RETURN WITH TAPE ROLLING INTO DESIRED BLK
	TLNE F,L.REV		;NOT THERE. WHICH WAY WE GOING?
	MOVNS N			;BACKWARDS. NEGATE.
	JUMPL N,SEARCH		;IF SHOULD KEEP GOING, ITS MINUS.
SRCHTA:	CONO DTC,C.FWD!C.REV	;MUST TURN AROUND (END ZONE OR PASSED)
	TLC F,L.REV		;COMPLEMENT DIRECTION FLAG
	JRST SEARCH		;SEARCH SOME MORE
>
;VERSION OF PROCBK FOR USE IN DEBUGGING UNDER TIME-SHARING
;KEEP AS SIMILAR TO NON-TS VERSION AS POSSIBLE (ROUTINES KEPT SEPARATE
;FOR THE SAKE OF READABILITY).

IFN DEBUG,<
PROCBK:	PUSHJ P,SEARCH		;ROUTINE TO READ OR WRITE A BLOCK OF TAPE
				; FIRST FIND THE BLOCK (EITHER DIRECTION)
	MOVEI N,200		;NUMBER OF WORDS IN A BLOCK
	SUBI	A,1		;SET UP IOWD WORD
	HRLI	A,-200		;IN AC A
	MOVEM	A,CMDLST	;STORE IN THE COMMAND LIST
	TLZ	A,-1		;RESTORE A TO ORIGINAL VALUE
	ADDI	A,1		;
	SKIPE	@(P)		;A WRITE REQUEST?
	OUTPUT	DTA,CMDLST	;YES, DO IT
	SKIPN	@(P)		;A READ REQUEST?
	INPUT	DTA,CMDLST	;YES, DO IT
	STATZ	DTA,740000	;ANY ERRORS?
	PUSHJ	P,ERROR		;YES
	JRST	CPOPJ1		;NO, RETURN SKIPPING OVER STACK ARG.

SEARCH:	MOVE C,DEVICE		;GET DRIVE NUMBER
	ADDI	C,20		;CONVERT TO SIXBIT
	DPB	C,[POINT 6,OBLK+1,23]	;STORE IN OPEN BLOCK
	OPEN	DTA,OBLK	;INITIALIZE THE DRIVE
	HALT			;ERROR?
	TLZ F,L.REV		;SAY WE GO FORWARD
	STATZ	DTA,740000	;ANY ERRORS
	PUSHJ	P,ERROR		;YES
	SKIPE	@-1(P)		;A WRITE REQUEST?
	USETO	DTA,0(LBN)	;YES, SET BLOCK FOR OUTPUT
	SKIPN	@-1(P)		;A READ REQUEST?
	USETI	DTA,0(LBN)	;YES
	SETZ	N,		;CLEAR AC N
	POPJ	P,		;RETURN
>
DELETE:	PUSHJ P,LOOK		;SEE IF FILE EXISTS ALREADY
	 POPJ P,0		;NO. FAIL RETURN
	SETZB B,HBUF+D.NAM-1(FN)	;FOUND IT. CLEAR NAME
	SETZM HBUF+D.EXT-1(FN)	;AND EXT IN DIRECTORY
	MOVEI	N,1		;ALSO, CLEAR HIGH-ORDER PART OF DATE
	ANDCAM	N,HBUF-1(FN)
	ANDCAM	N,HBUF+^D21(FN)
	ANDCAM	N,HBUF+^D43(FN)
	MOVE BP,BYTPTR		;INITIAL BYTE POINTER TO DIRECTORY BYTES
	MOVEI N,MAXBLK		;SEARCH ALL BYTES FOR THIS FILE
	ILDB A,BP		;GET A DIRECTORY BYTE
	CAIN A,0(FN)		;BELONG TO THIS FILE?
	DPB B,BP		;YES. CLEAR IT OUT, ITS FREE NOW
	SOJG N,.-3		;LOOP FOR WHOLE DIRECTORY
CPOPJ1:	AOS 0(P)		;SUCCESSFUL RETURN
CPOPJ:	POPJ P,0		;RETURN.

KILL:	PUSHJ P,DELETE		;REMOVE FILE FROM DIRECTORY
	 PUSHJ P,ERROR		;NOT THERE, GIVE A BELL
	JRST CLS		;WRITE DIRECTORY AND RETURN TO CMD SCAN

ENTR:	PUSHJ P,DELETE		;FIRST REMOVE OLD FILE BY THIS NAME
	 JFCL			;MAY NOT HAVE BEEN ONE, THATS OK
	MOVSI FN,-NFILES	;SEARCH FOR A FREE SLOT
	SKIPN HBUF+D.NAM(FN)	;SLOT FREE?
	AOJA FN,ENTR1		;YES. CONVERT RH TO FILE NUMBER, GO USE.
	AOBJN FN,.-2		;LOOK FOR ANOTHER
	POPJ P,0		;NONE FREE. WE LOSE.
ENTR1:	MOVEM NAME,HBUF+D.NAM-1(FN)	;STORE THE FILE NAME IN FREE SLOT
	HLLZM EXT,HBUF+D.EXT-1(FN)	;AND THE EXTENSION
ALLOCI:	SETZM PRVLBN		;INITIALIZE POINTERS FOR ALLOCATOR
	MOVE BP,BYTPTR		;START HAVING CHECKED BLK 0.
	TLZ F,L.REVA		;NOT REVERSE ALLOCATING
ALLOC:	TLZ F,L.TURN		;ALLOCATOR HASNT TURNED AROUND
	MOVE LBN,PRVLBN		;RESTORE PREVIOUS LBN
ALLOCP:	TLNE F,L.REVA		;WHICH WAY WE LOOKING?
	JRST ALCN2		;NEXT BACK
	JRST ALCN1		;NEXT FORWARD
ALCL1:	ILDB N,BP		;GET A BLOCK BYTE
	JUMPE N,ALLOC1		;IF ITS FREE, MAY USE IT
ALCN1:	CAIGE LBN,MAXBLK	;LOOKED ALL THRU FORWARD?
	AOJA LBN,ALCL1		;NO. TRY ANOTHER
ALLOCT:	TLOE F,L.TURN		;TURN SEARCH AROUND. BETTER NOT BE SECOND TURN
	 POPJ P,0		;LOOKED THRU AND DIDNT FIND ANYTHING. QUIT.
	TLC F,L.REVA		;LOOK THE OTHER WAY
	JRST ALLOCP		;GO SEE WHICH WAY NOW

ALCL2:	ADD BP,[XWD 050000,0]	;MOVE LEFT A BYTE
	SKIPGE BP		;OFF THE END OF THE WORD?
	SUB BP,[XWD 430000,1]	;YES. BACK A WORD, RIGHT 35 BITS
	LDB N,BP		;GET THIS BYTE
	JUMPE N,ALLOC1		;IF ITS FREE MAY USE IT.
ALCN2:	CAILE LBN,1		;GONE ALL THE WAY TO THE FRONT?
	SOJA LBN,ALCL2		;NO, LOOK FURTHER
	JRST ALLOCT		;YES. MUST TURN ALLOCATOR AROUND

ALLOC1:	MOVE N,PRVLBN		;HAVE A FREE ONE. WANT IT?
	SUBI N,0(LBN)		;FIND DISTANCE FROM LAST ONE
	MOVMS N			;WHICHEVER DIRECTION
	CAIGE N,BLKFAC		;IS IT FAR ENOUGH AWAY?
	TLNE F,L.TURN		;OR ARE WE TURNING ALLOCATOR AROUND?
	JRST ALLOCY		;YES. USE THIS ONE.
	JRST ALLOCP		;NO. PROCEED TO ANOTHER BLOCK

ALLOCY:	DPB FN,BP		;PUT THIS FILE NUMBER IN THE BLOCK'S BYTE
	MOVEM LBN,PRVLBN	;SAVE AS PREVIOUS BLOCK ALLOCATED
	JRST CPOPJ1		;AND RETURN WITH LBN SET UP
;TTY I/O SUBRS

ERROR:	MOVEI C,207		;MAKE A BELL, EVEN PARITY
	PUSHJ P,TYO		;TYPE IT OUT
	JRST GO			;AND RESTART.

CRLF:	MOVEI C,215		;CR, EVEN
	PUSHJ P,TYO		;TYPE IT.
	MOVEI C,12		;LF, EVEN
TYO:
IFE DEBUG,<
	DATAO TTY,C		;SEND OUT CHAR
	CONSZ TTY,20		;WAIT FOR IDLE
	JRST .-1		; ..
>
IFN DEBUG,<
	OUTCHR	C		;OUTPUT THE CHAR
>
	POPJ P,0		;DONE.

SIXOUT:	MOVEI C,0		;SO DONT SHIFT IN JUNK
	ROTC B,6		;GET A SIXBIT CHAR IN C
	ADDI C,40		;MAKE IT ASCII
	PUSHJ P,TYO		;TYPE IT
	JUMPN B,SIXOUT		;IF ANY MORE, TYPE THEM
	POPJ P,0		;AND RETURN
;CONSTANTS AND TEMPS.

SYSTEM:	SIXBIT /SYSTEM/		;DEFAULT FILENAME
CRASH:	SIXBIT /CRASH/		;DEFAULT DUMP NAME
DBUFP:	XWD -177,DBUF+1		;POINTER TO DATA BLOCK
BLTXWD:	XWD 40,41		;FOR CORE-CLEARING
SIXPTR:	XWD 440600,W		;POINTER FOR SIXBIT NAME
BYTPTR:	POINT 5,HBUF+D.BYT	;POINTER TO BYTES IN DIRECTORY

LIT

IFN DEBUG,<
OBLK:	EXP	1B29+17
	SIXBIT/DTA/
	Z
CMDLST:	.-.
	Z
>
UU(PDL,PDLL)			;STACK
PDP:	XWD -PDLL,PDL-1		;STACK POINTER

UU(ZZMAX,0)

SLOP==576-<.-GO>		;MUST BE POSITIVE IF WANT
				;THIS TO FIT IN BLKS 0,1,2 OF DTA
				;THREE BLOCKS INCLUDING HRI BLKI WD AND JRST WD
	END GO