Google
 

Trailing-Edge - PDP-10 Archives - bb-x130a-sb - dtcopy.mac
There are 6 other files named dtcopy.mac in the archive. Click here to see a list.
TITLE DTCOPY	V007	17-AUG-73




;COPYRIGHT (C) 1968,1978,1979 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

	VDTCOPY==7
	VUPDATE==0
	VEDIT==101
	VCUSTOM==0

REPEAT 0,<


	DTCOPY WILL RUN IN ANY AMOUNT OF CORE, HOWEVER, EFFICIENCY 
INCREASES WITH CORE SIZE.  SWITCHES ARE PRECEDED BY A SLASH OR
ENCLOSED IN PARENTHESES AND MAY APPEAR ANYWHERE IN THE COMMAND
STRING.  THE GENERAL COMMAND STRING FORMAT IS:
	(OUTPUT DECTAPE):_(INPUT DECTAPE):/C

	/C	COPY ALL BLOCKS FROM THE INPUT DECTAPE ONTO
		THE OUTPUT DECTAPE.
	/Z	ZERO ALL BLOCKS OF THE OUTPUT DECTAPE, CLEAR
		THE DIRECTORY.
	/V	PERFORM A WORD BY WORD COMPARISION BETWEEN
		EVERY WORD OF THE INPUT AND OUTPUT DECTAPES.
	/L	LOAD A BOOTSTRAP LOADER INTO A CORE BUFFER.
		DTCOPY LOOKS FOR "BSLDR.REL" ON LOGICAL DEVICE
		"PTR". NOTE DTCOPY MUST BE "SAVED" IF THE LOADER
		IS TO BE PRESERVED WITH THE DTCOPY CORE IMAGE.
	/T	CAUSES A BOOTSTRAP LOADER TO BE WRITTEN ONTO
		BLOCKS 0,1 AND 2 OF THE OUTPUT TAPE. DTCOPY TYPES
		"TYPE CORE BANK OR OFFSET FOR BSLDR."
		OFFSET = OCTAL NUMBER 1000 TO 777600.
		CORE-BANK = NNNK = 16K TO 256K,
		EX:	NNNK=64K
		THEN	OFFSET=177000 (TOP OF COPE - 1000)
	/N	DON'T OUTPUT A DIRECTORY.
	/6	LOOK FOR A DIRECTORY IN BLOCK ONE, NOT BLOCK 144.
	/G	DON'T RESTART THE PROGRAM AFTER A PARITY ERROR
		(BIT20), OUTPUT AN ERROR MESSAGE AND CONTINUE.
    NO SW'S	SET C AND V SWITCHES (DEFAULT CONDITION).

    NOTE........AT COMPLETION THE OUTPUT DECTAPE SHOULD BE REASSIGNED
		TO ENSURE THAT THE DIRECTORY IN CORE IS UP TO DATE.

THE FOLLOWING MESSAGES MAY BE OUTPUT TO THE USER'S TELETYPE.

	?WRITE LOCK ERROR
	?INPUT (OR OUTPUT) DEVICE ERROR
	?INPUT (OR OUTPUT) CHECKSUM OR PARITY ERROR
	?INPUT (OR OUTPUT) BLOCK TOO LARGE
	?INPUT (OR OUTPUT) PREMATURE END OF FILE
	000000 VERIFICATION ERRORS
	?COMMAND ERROR
	?SWITCH ERROR
	?DEVICE INIT FAILURE
	?DEVICE MUST BE A DECTAPE
	?INPUT AND OUTPUT DECTAPES MAY NOT BE THE SAME DEVICE.

THE FOLLOWING MAY BE OUTPUT WHILE PROESSING "/L".
	?PTR INIT FAILURE
	?LOOKUP FAILED, "BSLDR.REL"
	?DATA ERROR ON DEVICE PTR
	?ILLEGAL BLOCKTYPE
	?CANNOT PROCESS EXTERNAL SYMBOLS
	?CANNOT PROCESS HIGH SEG'S
	?NO END BLOCK ENCOUNTERED
	?BOOTSTRAP LOADER WILL NOT FIT IN 3 BLOCKS

THE FOLLOWING MAY BE OUTPUT WHILE PROCESSING "/T".
	TYPE CORE BANK OR OFFSET FOR DTBOOT
	?OFFSET = 1000 TO 777600 (OCTAL)
	?EXPECTED FORMAT IS "NNNK" = 16K T0 256K
	?BOOTSTRAP LOADER IS NOT IN DTCOPY; TRY "/L".
>
FLP=400000		;NOT SW MODE			**FLAGS ARE IN LH OF F**
FLC=200000		;COPY
FLZ=100000		;ZERO
FLV= 40000		;VERIFY
FLT= 20000		;TENDMP
FLG= 10000		;IGNORE PARITY ERRORS
FLL=  4000		;LIST DIR
FLK=  2000		;COLON
FLA=  1000		;LEFT ARROW
FLI=   400		;INPUT DEVICE
FL2=   200		;CHANEL TWO
HSW=   100		;HELP
LSW=	20		;REQ TO LOAD A BSLDR
LFL=	10		;A BOOTSTRAP LOADER IS IN "DTCOPY"
NSW=     4		;NO DIRECTORY
FL6=     2		;6 FORMATTED
FPT=     1		;A PDP-10
ANYSW=FLC+FLZ+FLV+FLT	;ANYSW=0 IMPLIES FLC+FLV
.JBVER=137

AC0=0
AC1=1
AC2=2
AC3=3
AC4=4
AC5=5
AC6=6
V1=1	;VERIFY CMDLST
VZ1=2	;CMDLST TERMINATOR
V2=3	;VERIFY CMDLST
VZ2=4	;CMDLST TERM
BP=5	;BYTE POINTER
C=6	;CURRENT CHARACTER
LOC=7	;BLOCK NUMBER
T=10	;TEMP
U=T+1	;TEMP
F=12	;FLAGS
UNSD2=14	;UNUSED
UNSD3=15	;UNUSED
IOS=16	;IO STATUS
P=17	;PUSH DOWN LIST
	EXTERN	.JBFF,.JBREL,.JBSA,.JBREN
	LOC	.JBVER
	<VCUSTO>B2!<VDTCOP>B11!<VUPDATE>B17!<VEDIT>
	RELOC
ST:	CALLI	0
	MOVE	P,[IOWD 20,TTYIN+23]	;PUSH DOWN LIST
	INIT	17,1			;ASCII LINE
	SIXBIT	/TTY/
	XWD	TOUT,TIN
	HALT	.			;INIT ERROR
	PUSH	P,.JBFF
	MOVEI	T,TTYIN
	MOVEM	T,.JBFF
	INBUF	17,1			;SET THE BUFFER ADR TO TTYIN
	MOVEI	T,TTYOUT
	MOVEM	T,.JBFF
	OUTBUF	17,1			;SET THE BUFFER ADR TO TTYOUT
	OUTPUT	17,			;DUMMY
	SETZB	F,IDEV
	SETZB	T,ODEV
	POP	P,.JBFF

	MOVE	T,.JBREL
	SUB	T,.JBFF			;T=NO. OF FREE LOC
	MOVE	C,.JBFF		;
	MOVEI	AC0,3777(C)	;
	CAIGE	T,3777		;TRY FOR AT LEAST 2K OF BUFFER AREA
	CALLI	AC0,11		;CORE UUO
	JFCL			;O WELL
	SUBI	C,1		;IOWD FORMAT "ADR-1"
	ANDI	T,-200		;T=NO. OF FREE WORDS
	MOVNM	T,U		;IOWD FORMAT "-N"
	LSH	T,-7		;T=NO. OF BLOCKS PER COPY INPUT
	MOVEM	T,INC		;COPY INCREMENT
	LSH	T,-1		;T=NO. OF BLOCKS PER VERIFY INPUT
	MOVEM	T,INCV		;VERIFY INCREMENT
	HRLM	U,C		;ASSEMBLE
	MOVEM	C,LISTC		;COPY IOWD
	ASH	U,-1		;HALVE THE "-N" FOR VERIFY
	TRNE	U,100		;"-N" MUST AGREE WITH THE INCREMENT
	ADDI	U,100		;ADJUST
	HRL	C,U		;ASSEMBLE
	MOVEM	C,LISTV1	;VERIFY IOWD #1
	MOVMM	U,U		;
	ADD	C,U		;ASSEMBLE
	MOVEM	C,LISTV2	;VERIFY IOWD #2

	MOVEI	C,"*"
	PUSHJ	P,TYPC			;OUTPUT CHAR
	INPUT	17,
	MOVE	F,FSAVE			;INITIAL FLAGS
	SKIPA	BP,[POINT 6,ODEV]	;ASSUME AN OUTPUT DEV
COIDEV:	MOVE	BP,[POINT 6,IDEV]	;INPUT IF LEFT-ARROW + COLON WERE SEEN	
COTGET:	PUSHJ	P,TYPGET		;RETURN A CHAR TO C
	CAIN	C,"/"
	JRST	COSLSH			;SLASH
	CAIN	C,"("
	JRST	COLPRN			;LEFT PAREN
	CAIN	C,":"
	JRST	COCOLN			;COLON
	CAIE	C,12
	CAIN	C,15
	JRST	COCRET			;CR OR LF
	CAIE	C,175			;ALTMODE?
	CAIN	C,33			;ALTMODE?
	JRST	COCRET			;YES
	CAIN	C,176			;ALTMODE?
	JRST	COCRET			;YES
	CAIE	C,"="			;==_
	CAIN	C,"_"
	JRST	COLARO			;LEFT ARROW
	CAIGE	C,"0"			;
	JRST	ERRCMD			;
	CAILE	C,"9"			;ILLEGAL CHAR?
	CAIL	C,"A"			;
	CAILE	C,"Z"			;
	JRST	ERRCMD			;
	SUBI	C,40			;6 BITIZE IT
	TLNE	BP,770000		;ACCEPY 6 CHARS ONLY
	IDPB	C,BP			;ASSEMBLE AN I/O DEV NAME
	JRST	COTGET			;
COLPRN:	TLZA	F,FLP			;ENTER PAREN MODE
COEXIT:	JUMPL	F,COTGET		;NORMAL EXIT
COSLSH:	PUSHJ	P,TYPGET		;SLASH - RETURN SW IN C
	MOVSI	U,-LEN			;U=-SWTAB LEN,0
COSWLP:	MOVE	T,SWTAB(U)		;T=FLAG,CHAR
	CAIN	C,(T)			;C=0,CHAR
	TDOA	F,T			;F=FLAGS,CHARS ANDED
	AOBJN	U,COSWLP		;MORE SW'S? LOOP
	JUMPL	U,COEXIT		;MATCH OR MORE SW? LOOP
	JRST	ERRSW			;NOT A SWITCH

COLARO:	TLZE	F,FLK			;CLEAR COLON FLAG
	TLOE	F,FLA			;SET LEFT ARROW FLAG
	JRST	ERRCMD			;TOO MANY ARROWS,NOT ENOUGH KOLONS
	JRST	COIDEV			;NEXT DEVICE MUST BE INPUT

COCOLN:	TLZ	BP,770000		;ACCEPT NO MORE CHARS.
	TLON	F,FLK			;SET KOLON FLAG
	JUMPGE	BP,COTGET		;NORMAL EXIT
	JRST	ERRCMD			;NULL NAME, TOO MANY COLONS

COCRET:	TLZE	F,HSW		;HELP?
	JRST	HELP		;
	TLZE	F,LSW		;LOADING A LOADER?
	JRST	BSLDR		;YES
	TLNE	F,FLA			;LEFT ARO ?
	JRST	COSTRT			;_,SO OK
	SKIPE	ODEV			;
	JRST	ERRCMD			;NO_,SOME ODEV
	TLNN	F,ANYSW			;
	JRST	ST			;NO_,NO ODEV,NO SW =*
	JRST	ERRCMD		;NO_,NO ODEV, NO SW

COSTRT:	TLNN	F,ANYSW		;ANY SW=SKIP
	TLO	F,FLC+FLV	;DEFAULT=COPY+VERIFY
	TLNE	F,FLC		;IF COPY
	TLZ	F,FLZ		;DONT ZERO
	TLNE	F,FLZ		;IF ZERO
	TLZ	F,FLV		;DONT VERIFY
	SKIPN	T,IDEV
	TLNE	F,FLC+FLV
	JUMPE	T,ERRCMD	;AN INDEVICE IS REQUIRED
	TLNN	F,FLT		;IS 10DMP WANTED?
	JRST	CINIT		;NO, PROCEED

	;HERE TO ACCEPT THE BOOTSTRAP LOADER OFFSET (/T)

CTENDM:	TLNN	F,LFL		;IS A BOOTSTRAP LOADER LOADED?
	JRST	ERRTNH		;NO, COMPLAIN
CTEN1:	SETZB	AC1,OFFSET	;
	TTCALL	3,[ASCIZ /
TYPE CORE BANK OR OFFSET FOR /]
	MOVEI	BP,PNAME
	PUSHJ	P,TYPEIT	;BSLDR'S NAME
	INPUT	17,
CTEN0:	PUSH	P,TIN+1		;SAVE PTR FOR RESCAN
	MOVEI	AC0,6		;MAX CHARS TO ACCEPT
	PUSHJ	P,TYPGET	;
	CAIN	C,"K"		;
	JRST	CTEN10		;K, MUST BE A CORE-BANK
	SOJG	AC0,.-3
	POP	P,TIN+1		;
	MOVEI	AC0,6		;ACCEPT 6 NUMBERS
CTEN2:	PUSHJ	P,TYPGET	;GET A CHAR
	CAIL	C,"0"		;
	CAILE	C,"7"		;
	JRST	CTEN7		;NOT A OCTAL NUMBER, TERM?
	LSH	AC1,3		;MAKE ROOM
	TRZ	C,777770	;CLEAR HI-ORDER BITS
	ADD	AC1,C		;  FOR THIS CHAR
	SOJG	AC0,CTEN2	;LOOK FOR 6 CHARS
CTEN3:	CAIL	AC1,1000		;LOWER LIMIT
	CAILE	AC1,777600	;UPPER LIMIT
	JRST	CTEN8		;COMPLAIN
CTEN4:	HRLI	AC1,W		;SO [HRRI W,@OFFSET] WILL WORK
	MOVEM	AC1,OFFSET	;SAVIT
	JRST	CINIT		;

CTEN7:	CAIL	C,12		;"LF"
	CAILE	C,15		;"CR"
	CAIN	C,33		;ALTMODE
	JRST	CTEN3		;A TERMINATOR
CTEN8:	TTCALL	3,[ASCIZ /
?OFFSET = 1000 TO 777600 (OCTAL)/]
	JRST	CTEN1		;

	;LOOK FOR A CORE BANK, 16K-256K
CTEN10:	POP	P,TIN+1		;RESCAN TTYBUF
	MOVEI	AC0,3		;ONLY 3 CHARS MAX IS "256"
CTEN11:	PUSHJ	P,TYPGET	;
	CAIL	C,"0"		;
	CAILE	C,"9"		;
	JRST	CTEN17		;
	IMULI	AC1,^D10	;MAKE ROOM FOR NEXT CHAR... DEC TO OCT
	ANDI	C,17		;EXTRACT DECIMAL NUMBER
	ADD	AC1,C		;
	SOJG	AC0,CTEN11	;

CTEN12:	TRNE	AC1,17		;CHECK FOR MODULO 16
	JRST	CTEN18			;ILL
	JUMPE	AC1,CTEN18		;ILL
	LSH	AC1,-4		;PUSH OFF ZEROES
	CAILE	AC1,20		;MAX IS 256
	JRST	CTEN18	;ILL
	IMULI	AC1,40000	;TURN IT INTO AN OFFSET
	SUBI	AC1,1		;
	TRZ	AC1,777		;1K BELOW TOP OF THIS BANK
	JRST	CTEN4		;
CTEN17:	CAIN	C,"K"		;SKIP IF TERM
	JRST	CTEN12		;

CTEN18:	TTCALL	3,[ASCIZ /
?EXPECTED FORMAT IS "NNNK" = 16K TO 256K.
/]
	JRST	CTEN1
CINIT:	MOVEI	T,134		;BUFRD MODE
	PUSHJ	P,INIT		;FIRST INIT
	TLNE	F,FLC!FLZ	;BEGIN HERE  ___******
	PUSHJ	P,COPZRO	;ZERO OR COPY
	TLNE	F,FLC!FLZ	;IF C OR Z-
	PUSHJ	P,LALA			;THEN REWIND
	TLNN	F,FLZ		;WASIT /Z ?
	JRST	CNOZRO		;NO
	SETSTS	2,16		;YES
	CALLI	2,13		;CLEAR DIR IN CORE
	RELEAS	2,		;AND ON TAPE
	MOVEI	T,14		;AND
	PUSHJ	P,INIT		;REINIT
CNOZRO:	TLNE	F,FLV		;VERIFY ?
	PUSHJ	P,VERZRO	;YES
	TLNE	F,FLV		;IF VERIFY-
	PUSHJ	P,LALA	;THEN REWIND
	TLNE	F,FLT		;TEN DUMP ?
	PUSHJ	P,TENINT	;YES
	JRST	ST		;GO AGAIN ******

LALA:	MTAPE	2,1		;
	SKIPE	C,IDEV		;
	MTAPE	1,1		;
	JFCL	1,.+1		;PROCESSOR TEST
	JRST	.+1		;
	JFCL	1,.+3		;6-JUMP
	TLO	F,FPT		;PDP-10 FLAG
	JRST	LSTEST		;10-JUMP
	JUMPE	C,LSTES0	;JUMP IF NO INPUT DEV
	USETI	1,1
	INPUT	1,REWIND	;IOWD 1,DATA
LSTES0:	USETI	2,1
	INPUT	2,REWIND
LSTEST:	TLZE	F,FLL		;LIST A DIR?
	JRST	DLST		;YES
	MOVEI	C,^D15		;SECONDS
GDNITE:	TLNE	F,FPT		;6-SKIP
	CALLI	C,31		;TO SLEEP
	POPJ	P,		;

SWTAB:	XWD	FLP,")"		;XIT
	XWD	FLC,"C"		;COPY
	XWD	FLZ,"Z"		;ZERO
	XWD	FLV,"V"		;VERIFY
	XWD	FLT,"T"		;TENDMP
	XWD	FLG,"G"		;IGNORE
	XWD	HSW,"H"		;HELP
	XWD	LSW,"L"		;LOAD BSLDR
	XWD	NSW,"N"		;NO DIR
	XWD	FL6,"6"		;PDP6 DIR
	LEN=.-SWTAB
DSAV:	TLON	F,FLL		;ENTER THIS CODE ONCE ONLY
	TLNE	F,FL6		;SKIP IF ITS NOT 6FMT
	POPJ	P,		;2ND PASS OR 6FMT-EXIT.
	MOVEI	1,-144(LOC)	;FIRST BLK OF NEXT OUTPUT
	SUB	1,INC		;FIND A
	IMULI	1,-200		;     DIRECTORY,
	ADD	1,LISTC		;GRAB
	HRLI	1,1(1)		;    A
	HRRI	1,DIRECT	;     DIRECTORY.
	BLT	1,DIRECT+177	;SAVE IT.
	POPJ	P,		;RETURN

DATE:	LDB	AC5,DATEP	;GET LOW PART OF DATE
	MOVEI	AC2,1		;SETUP TO GET HIGH-PART
	TDNE	AC2,DIRECT(AC1)	;IF BIT SET IN DIRECTORY
	TRO	AC5,1B23		;THEN SET CORRESPONDING BIT
	TDNE	AC2,DIRECT+^D22(AC1)	;DO THE SAME FOR REST OF
	TRO	AC5,1B22		;  HIGH-PART
	TDNE	AC2,DIRECT+^D44(AC1)
	TRO	AC5,1B21
	SETZ	AC2,
	IDIVI	AC5,^D31	;PICK OFF THE DAY
	ADDI	AC6,1		;MAKE IT RIGHT
	PUSHJ	P,DATE1		;RETURNS TWO SIXBIT NUMBERS
	DPB	AC6,DAY		;XXDDXX
	IDIVI	AC5,^D12	;PICK OFF THE MONTH
	MOVE	AC6,MONPH(AC6)	;CONVERT TO ALPHA
	DPB	AC6,MONTH	;MMDDXX
	MOVEI	AC6,^D64	;GET THE BASE YEAR
	ADD	AC6,AC5		;PLUS YEARS SINCE THEN
	CAIL	AC6,^D100	;NEXT CENTURY?
	SUBI	AC6,^D100	;YES, ADJUST DATE
	PUSHJ	P,DATE1		;SIXBIT
	DPB	AC6,YEAR	;YYMMDD-DATE FINISHED
	POPJ	P,		;

DATE1:	IDIVI	AC6,^D10	;DIVIDE OUT A DECIMAL NUMBER
	LSH	AC6,6		;MAKE ROOM FOR THE REMIANDER
	ADDI	AC6,152020(LOC)	;CONVERT TO SIXBIT
	POPJ	P,		;RETURN

DAY:	POINT	12,AC2,11
MONTH:	POINT	24,AC2,35
YEAR:	POINT	18,AC3,17
DATEP:	POINT	12,DNAM+^D22(AC1),35
FREE:	SIXBIT	/FREE:  +/
BLKS:	SIXBIT	/-BLKS  +/
FILES:	SIXBIT	/-FILES#/
MONPH:	SIXBIT	/  -JAN/
	SIXBIT	/  -FEB/
	SIXBIT	/  -MAR/
	SIXBIT	/  -APR/
	SIXBIT	/  -MAY/
	SIXBIT	/  -JUN/
	SIXBIT	/  -JUL/
	SIXBIT	/  -AUG/
	SIXBIT	/  -SEP/
	SIXBIT	/  -OCT/
	SIXBIT	/  -NOV/
	SIXBIT	/  -DEC/

		;STANDARD OCTAL TO ASCII ROUTINE
DECMAL:	IDIVI	C,^D10		;
	HRLM	C+1,(P)		;
	SKIPE	C		;
	PUSHJ	P,DECMAL	;
	HLRZ	C,(P)		;
	ADDI	C,60		;
	JRST	TYPC		;

DLST:	TLNE	F,NSW		;DIRECTORY WANTED?
	JRST	DXIT		;NO
	TLNE	F,FL6		;6FMT?
	JRST	D6LST		;YES.
DLST1:	SETZM	TOTAL		;TOTAL FREE BLOCKS
	MOVE	3,[XWD TOTAL,TOTAL+1]	;CLEAR THE ^D23
	BLT	3,TOTAL+^D22		;    WORD TABLE
	MOVE	2,[POINT 5,DIRECT,4]	;POINT TO FIRST BLK SLOT
	MOVEI	1,<7*^D83>-3		;1102 SLOTS
DLST2:	ILDB	3,2			;PICK UP A FILE NUMBER
	CAIG	3,^D22			;SKIP IF BLK IS SPECIAL
	AOS	TOTAL(3)		;COUNT BLKS/FILE
	SOJG	1,DLST2			;LOOP
	MOVEI	BP,FREE		;FREE:
	PUSHJ	P,TYPEIT		;
	MOVE	C,TOTAL		;NUMBER OF FREE BLOCKS
	PUSHJ	P,DECMAL		;
	MOVEI	BP,BLKS		;-BLKS
	PUSHJ	P,TYPEIT		;
	MOVEI	C,^D22		;26 FILES MAX
	HRLZI	AC1,-^D22		;
DLST7:	SKIPE	DNAM(AC1)	;
	SOS	C		;DECREMENT MAX NO. OF BLKS
	AOBJN	AC1,DLST7	;
	PUSHJ	P,DECMAL	;
	MOVEI	BP,FILES	;
	PUSHJ	P,TYPEIT	;
	HRLZI	1,-^D22			;LOOP 26 TIMES

DLST3:	HRLZI	3,161300		;TERMINATOR
	SKIPN	2,DNAM(1)		;FILE NAME
	JRST	DLST5			;
	MOVEI	BP,2			;
	PUSHJ	P,TYPEIT		;
	HLLZ	2,DNAM+^D22(1)		;EXTENSION
	HRRI	2,13			;
	MOVEI	BP,2			;
	PUSHJ	P,TYPEIT		;
	MOVE	C,TOTAL+1(1)		;NUMBER OF BLKS
	PUSHJ	P,DECMAL		;
	MOVEI	C,"	"			;SPACE
	PUSHJ	P,TYPC			;
	PUSHJ	P,DATE			;CREATION DATE
	MOVEI	BP,2			;
	HRRI	3,30000			;"#"
	PUSHJ	P,TYPEIT		;
DLST5:	AOBJN	1,DLST3			;LOOP
DXIT:	MOVEI	C,^D15		;15 SECONDS
	JRST	GDNITE		;TO SLEEP.

D6LST:	MOVEI	0,36		;MAX NO. OF ENTRIES
	HRRZ	1,DIRECT	;LOC OF FIRST DIR BLK
D6BEG:	HRLI	3,130000	;"-" TERMINATOR
	MOVEI	BP,2		;
	SKIPN	2,DIRECT(1)	;IS THERE A FILENAME?
	JRST	DXIT		;NORMAL EXIT
	PUSHJ	P,TYPEIT	;FILENAME
	HLLZ	2,DIRECT+1(1)	;EXTENSION
	SKIPN	2		;IF NULL,
	JRST	D6FIN		;JUMP
	MOVEI	C,"	"	;OTHERWISE
	PUSHJ	P,TYPC		;TAB
	HRRI	2,130000	;"-"
	MOVEI	BP,2		;TERM.
	PUSHJ	P,TYPEIT	;
D6FIN:	PUSHJ	P,TYPCL		;CR-LF
	ADDI	1,4		;
	SOJG	0,D6BEG		;IN CASE
	JRST	DXIT		;DIR WAS FULL
TYPEIT:	HRLI	BP,440600		;BP=MESSAGE ADR
TYPLOP:	ILDB	C,BP			;
	CAIN	C,13			;PLUS?
	POPJ	P,			;GET THE WHOLE MESSASE
	CAIN	C,3			;#?
	JRST	TYPCL			;APPEND CR LF AND TYPE
	ADDI	C,40			;ASCIZE IT
	IDPB	C,TOUT+1		;TO THE BUFFER
	JRST	TYPLOP			;+LOOP

TYPGET:	ILDB	C,TIN+1			;GET CHAR
	CAIE	C," "			;SPACE?
	CAIN	C,"	"		;TAB?
	JRST	TYPGET			;FORGET IT
	CAIGE	C,141			;LC "A"
	POPJ	P,
	CAIG	C,172			;LC "Z"
	SUBI	C,40			;LC TO UC
	POPJ	P,

TYPCCL:	IDPB	C,TOUT+1		;TYPE CHAR,CRLF
TYPCL:	MOVEI	C,15			;TYPE CRLF
	IDPB	C,TOUT+1
	MOVEI	C,12
TYPC:	IDPB	C,TOUT+1		;TYPE CHAR
TYPBUF:	OUTPUT	17,			;DO IT
	POPJ	P,

HELP:	TTCALL	3,.+2
	JRST	COCRET
ASCIZ %
/C COPY 
/V VERIFY
/Z ZERO ALL BLOCKS
/L LOAD A BOOTSTRAP LOADER FROM PTR:BSLDR.REL
/T "TYPE CORE BANK OR OFFSET FOR BSLDR"
	CORE-BANK = NNNK (16K TO 256K)
	OFFSET = <OCTAL 1000 TO 777600>
   WRITE A BSLDR ONTO BLOCKS 0,1 AND 2
/N DONT TYPE A DIRECTORY
/6 PDP6 DIR
/G IGNORE ERRORS
NO SW'S IMPLY /C/V
%
ERRT1I:	TLOA	F,FLI			;INPUT ERROR
ERRT1O:	TLZ	F,FLI			;OUTPUT ERROR
	STATUS	1,IOS			;STATUS TO IOS
	TRNE	IOS,360000		;ALL THE ERRORS
	JRST	ERRCHK			;FOUND AN ERROR
	POPJ	P,

ERRT2I:	TLOA	F,FLI			;INPUT ERROR
ERRT2O:	TLZ	F,FLI			;OUTPUT ERROR
	STATUS	2,IOS			;FLAGS TO IOS
	TRNN	IOS,760000		;PLUS WRITE LOCK
	POPJ	P,			;NO ERRORS
	TLO	F,FL2			;IT'S A CHANNEL 2 ERROR

ERRCHK:	TRNE	IOS,400000
	PUSHJ	P,ERR400		;WRITE LOCK
	TRNE	IOS,200000
	PUSHJ	P,ERR200		;DEVICE ERROR
	TRNE	IOS,100000
	PUSHJ	P,ERR100		;CKSUM/PARITY
	TRNE	IOS,040000
	PUSHJ	P,ERR040		;BLOCK TOO LARGE
	TRNE	IOS,020000		;PREMATURE EOF,PDP9-DTA?
	PUSHJ	P,ERR020		;
	TRNN	IOS,600000		;THESE BITS IMPLY RESTART
	TLNN	F,FLG			;/G+PARITY ERR = CONTINUE
	JRST	ST			;RESTART
	TRZ	IOS,740000		;ZERO IN
	TLNN	F,FL2
	SETSTS	1,(IOS)			;TURN OFF
	TLZE	F,FL2
	SETSTS	2,(IOS)			;AND
	POPJ	P,			;POP OUT
ERR400:	MOVEI	BP,MES400
	JRST	TYPEIT
MES400:	SIXBIT	/?WRITE LOCK ERROR#/
ERR200:	PUSHJ	P,ERRCOM
	MOVEI	BP,MES200
	JRST	TYPEIT
MES200:	SIXBIT	/ DEVICE ERROR#/
ERR100:	PUSHJ	P,ERRCOM
	MOVEI	BP,MES100
	JRST	TYPEIT
MES100:	SIXBIT	/ CHECKSUM OR PARITY ERROR#/
ERR040:	PUSHJ	P,ERRCOM
	MOVEI	BP,MES040
	JRST	TYPEIT
MES040:	SIXBIT	/ BLOCK TOO LARGE#/
ERR020:	PUSHJ	P,ERRCOM
	MOVEI	BP,MES020
	JRST	TYPEIT
MES020:	SIXBIT	/ PREMATURE END OF FILE#/
ERRCOM:	MOVEI	BP,SXBINP
	TLNN	F,FLI
	MOVEI	BP,SXBOUT
	JRST	TYPEIT
SXBINP:	SIXBIT	/?INPUT+/
SXBOUT:	SIXBIT	/?OUTPUT+/
ERRVER:	MOVE	T,[POINT 6,MESVER]
	MOVE	BP,[POINT 3,U,17]
ERRVE1:	ILDB	C,BP		;LOAD AN OCTAL NUMBER
	ADDI	C,20		;6BITIZE IT
	IDPB	C,T		;INSERT IN MESS
	TLNE	T,770000	;ONE WORD ONLY
	JRST	ERRVE1		;LOOP 6 TIMES
	MOVEI	BP,MESVER
	JRST	TYPEIT
MESVER:	SIXBIT	/000000 VERIFICATION ERRORS#/
ERRCMD:	MOVEI	BP,MESCMD
	PUSHJ	P,TYPEIT
	JRST	ST
MESCMD:	SIXBIT	/?COMMAND ERROR#/
ERRSW:	MOVEI	BP,MESSW
	PUSHJ	P,TYPEIT
	JRST	ST
MESSW:	SIXBIT	/?SWITCH ERROR#/
ERRIN1:	SKIPA	T,IDEV
ERRIN2:	MOVE	T,ODEV
	TTCALL	3,[ASCIZ /?/]
	MOVEM	T,MESINI
	MOVEI	BP,MESINI
	PUSHJ	P,TYPEIT
	JRST	ST
MESINI:	SIXBIT	/       INIT FAILURE#/
ERRDT1:	SKIPA	T,IDEV
ERRDT2:	MOVE	T,ODEV
	TTCALL	3,[ASCIZ /?/]
	MOVEM	T,MESDTA
	MOVEI	BP,MESDTA
	PUSHJ	P,TYPEIT
	JRST ST
MESDTA:	SIXBIT	/       MUST BE A DECTAPE#/
ERRTNH:	MOVEI	BP,MESTNH
	PUSHJ	P,TYPEIT
	JRST	ST
MESTNH:	SIXBIT	%?BOOTSTRAP LOADER IS NOT IN DTCOPY. TRY "/L".#%
PTERR1:	TTCALL	3,[ASCIZ /?PTR INIT FAILURE
/]
	JRST 	ST

PTERR2:	TTCALL	3,[ASCIZ /?LOOKUP FAILED, "BSLDR.REL"
/]
	JRST	ST
	;WRITE A BOOOTSTRAP LOADER IN BLOCKS 0,1 AND 2
TENINT:	PUSH	P,.JBFF
	SETSTS	2,134		;SO I CAN WRITE IN BLK 0
	USETO	2,0
	OUTBUF	2,1
	OUTPUT	2,		;DUMMY!

	MOVE	AC0,[POINT 36,BSBUF]
	MOVEM	AC0,BSPTR	;WHERE THE LOADER IS KEPT
	HRRZ	AC0,.JBFF	;
	HRLI	AC0,(POINT 36,)
	MOVEM	AC0,FFPTR	;WHERE ITS WRITTEN FROM

	ILDB	W,BSPTR		;IOWD
	MOVE	CNT,OFFSET	;
	HRRI	W,-1(CNT)	;FINISH THE IOWD
	IDPB	W,FFPTR		;

TEN1:	PUSHJ	P,NBLK		;GET THE NEXT BLOCK, SKIPE XIT IS NORMAL
	 JRST	RELDA5		;TERMINATE THE BSLDR
	TRNN	CNT,-1		;EMPTY?
	JRST	TEN1		;YES
	ILDB	OS,BSPTR	;OFFSET FOR THIS BLK
	LSH	RB,2		;OS'S RELBITS
	AOBJN	CNT,.+1		;ACCOUNT FOR IT
RELDAT:	TRNN	CNT,-1	;ANY MORE DATA?
	JRST	TEN1		;NO
	ILDB	W,BSPTR		;PROGRAM WORD
	JUMPGE	RB,RELDA1	;CHECK LEFT HALF
	HRLZ	I,OFFSET		;
	ADD	W,I		;RELOCATE IT

RELDA1:	TLNE	RB,200000	;CHECK RIGHT HALF
	HRRI	W,@OFFSET	;RELOCATE IT
	IDPB	W,FFPTR		;
	LSH	RB,2		;NEXT RELOCATION BITS
	AOBJN	CNT,RELDAT	;NEXT WORD
	TRNE	CNT,-1		;
	PUSHJ	P,NSEC		;NEXT SECTION OF BLOCK
	JRST	RELDAT		;

NBLK:	ILDB	CNT,BSPTR	;GET THE BLOCK WRD CNT
	SKIPL	CNT		;
	AOS	(P)		;SKIP EXIT IS NORMAL
	MOVN	CNT,CNT		;
NSEC:	ILDB	RB,BSPTR	;RELOCATION BITS
	HRLI	CNT,-22		;WRDS/SECTION
	POPJ	P,

RELDA5:	MOVE	W,SASAV		;THIS JRST IS EXECUTED
	HRR	W,OFFSET(W)	;RELOCATE THE SA ADR
	IDPB	W,FFPTR		;THE LAST WORD
	HRLZ	BP,.JBFF	;BEG OF BSLDR
	HRR	BP,OUT2+1	;BLT PTR
	MOVEM	BP,C		;SAVE IT
	BLT	BP,177(C)	;ZAP 1
	OUTPUT	2,		;BLK 0
	ADD	C,[XWD 200,0]
	MOVEM	C,BP		;2ND PTR SAVED
	BLT	BP,177(C)	;ZAP 2
	USETO	2,1
	OUTPUT	2,		;BLK 1
	ADD	C,[XWD 200,0]
	MOVEM	C,BP
	BLT	BP,177(C)
	USETO	2,2
	OUTPUT	2,
	PUSHJ	P,ERRT2O	;ERRORS?
	POP	P,.JBFF
	POPJ	P,
COPZRO:	PUSH	P,.JBFF		;SAVE .JBFF
	TLNE	F,FLC		;SKIP IO TO UNASSIGNED CHAN.
	SETSTS	1,134		;
	SETSTS	2,134		;
	OUTBUF	2,1		;WITH ONE BUFFER MODE-134
	USETO	2,0		;FOR BLOCK ZERO
	OUTPUT	2,		;DUMMY
	TLNN	F,FLC		;COPY
	JRST	COPBKZ		;NO, MUST BE ZERO
	INBUF	1,1		;ONE BUFFER MODE-134
	USETI	1,0		;BLOCK ZERO
	INPUT	1,		;GET IT
	PUSHJ	P,ERRT1I	;OK?
	MOVEI	T,177		;LOOP LENGTH
	LDB	C,IN1+1		;FIRST WORD
	DPB	C,OUT2+1	;TO THE BUFFER
COPLPZ:	ILDB	C,IN1+1		;OTHER WORDS
	IDPB	C,OUT2+1	;TO THE BUFFER
	SOJG	T,COPLPZ	;TO LOOP
	SETSTS	1,136		;INPUT DEVICE
	USETI	1,1		;SIX FORMATTED DIRECTORY
	INPUT	1,DIRWRD	;GET IT
COPBKZ:	OUTPUT	2,		;DUMP THE BUFFER
	POP	P,.JBFF		;FOR VERIFY?
	PUSHJ	P,ERRT2O		;OK?
	SETSTS	2,136		;DUMP MODE
	MOVE	U,.JBREL		;UPPER LIMIT
	MOVE	T,BLTWRD	;FROM,TO
	SETZM	@ZROWRD		;START
	BLT	T, (U)		;ZAP
	MOVEI	LOC,1		;START AT BLOCK ONE
COPSET:	TLNE	F,FLC		;SKIP
	USETI	1,(LOC)		;IO 2 UNASGND CH
	USETO	2,(LOC)		;SET THE BLOCK NO.
	ADD	LOC,INC		;ADD THE INCREMENT
	CAILE	LOC,1102	;WILL IT FIT?
	JRST	COPFIN		;NO
	PUSHJ	P,COPYIT	;ONE BUFFER
	JRST	COPSET		;AND LOOP
COPFIN:	MOVEI	T,-1102(LOC)	;N BLOCKS WON'T FIT
	IMULI	T,200		;N WORDS WON'T FIT
	MOVSS	T		;GET ORGANIZED
	ADDM	T,LISTC		;SUB N WORDS FROM LIST
	SKIPL	LISTC		;IF LH OF IOWD = 0,
	POPJ	P,		;EXIT
COPYIT:	TLNN	F,FLC		;COPY?
	JRST	COPOUT		;ZERO!
	INPUT	1,LISTC		;COPY!
	PUSHJ	P,ERRT1I	;OK?
	CAILE	LOC,144		;SKIP IF NO CHANCE
	PUSHJ	P,DSAV		;TRY FOR A DIRECTORY
COPOUT:	OUTPUT	2,LISTC		;COPY AND ZERO
	JRST	ERRT2O		;OK?
VERZRO:	PUSH	P,.JBFF
	SETZB	VZ1,VZ2		;CMDLST TERMINATOR
	SETSTS	1,134		;SET
	SETSTS	2,134		;IB MODE
	USETI	1,0		;AND
	USETI	2,0		;BLOCK 0
	INBUF	1,1		;WITH
	INBUF	2,1		;ONE BUFFER EA
	INPUT	1,		;GET A BLOCK
	PUSHJ	P,ERRT1I	;OK
	INPUT	2,		;GET ANOTHER
	PUSHJ	P,ERRT2I	;OK
	HRRZ	V1,IN1		;DUMMY
	HRRZ	V2,IN2		;IOWD
	HRLI	V1,-200		;FOR VERIFY LOOP
	POP	P,.JBFF		;RECLAIM BUFFERS
	PUSHJ	P,VERIFY		;VERIFY AND EXIT THIS PAGE
VERONE:	SETSTS	1,136		;SET
	SETSTS	2,136		;DUMP MODE
	MOVEI	LOC,1		;START AT BLOCK 1
VERSET:	MOVE	V1,LISTV1	;IOWDS
	MOVE	V2,LISTV2	;TO ACS
	USETI	1,(LOC)		;MASTER
	USETI	2,(LOC)		;AND COPY
	ADD	LOC,INCV	;ADD IN THE INCREMENT
	CAILE	LOC,1102	;AM I ASKING TOO MUCH?
	JRST	VERFIN		;YEP
	PUSHJ	P,VERIN		;COUPLE OF INPUTS AND VERIFY
	JRST	VERSET

VERFIN:	SUBI	LOC,1102	;HOW MUCH TOO MUCH?
	IMULI	LOC,200		;IN WORDS PLEASE
	MOVSS	LOC		;BACKWARDS
	ADD	V1,LOC		;SUB WORDS FROM LIST
	ADD	V2,LOC		;I.E. ASK FOR LESS
	SKIPL	V1		;IF LH OF IOWD = 0,
	POPJ	P,		;EXIT

VERIN:	INPUT	1,V1		;ONE FOR THE MASTER
	PUSHJ	P,ERRT1I	;OK?
	INPUT	2,V2		;ONE FOR THE COPY
	PUSHJ	P,ERRT2I	;OK?

VERIFY:	SETZ	U,		;CLR THE ERROR CNT
	MOVE	T,1(V1)		;MASTER WORD
	CAME	T,1(V2)		;SAME AS COPY WORD?
	AOS	U		;NO, COUNT THE ERRORS
	AOS	V2		;PLUS ONE
	AOBJN	V1,VERIFY+1	;BOTH HALVES AND LOOP
	JUMPN	U,ERRVER	;ERROR MESS IF APPROPIATE
	POPJ	P,		;UNLESS V1 IS POSITIVE
INIT:	INIT	2,(T)
ODEV:	Z
	XWD	OUT2,IN2
	JRST	ERRIN2
	MOVE	BP,ODEV		;MAKE SURE ITS A DTA.
	CALLI	BP,4
	TLNN	BP,100
	JRST	ERRDT2		;ERROR, ITS NOT A DTA
	SKIPN	BP,IDEV		;IF NULL
	POPJ	P,		;NO INPUT DEV REQUIRED
	CAMN	BP,ODEV		;SAME DEVICES?
	JRST	INITER		;YEPER
	INIT	1,(T)
IDEV:	Z
	XWD	0,IN1
	JRST	ERRIN1
	MOVE	BP,IDEV		;MAKE SURE ITS A DTA
	CALLI	BP,4
	TLNN	BP,100
	JRST	ERRDT1		;ERROR
	POPJ	P,

INITER:	TTCALL	3,[ASCIZ /INPUT AND OUTPUT DEC-TAPES MAY NOT BE THE SAME DEVICE.
/]
	JRST	ST
;	LOAD A BOOTSTRAP LOADER, 

I=1	;PTR TO BSBUF
W=2	;WORD OF TENDMP.REL
CNT=3	;# OF WORDS IN CURRENT BLOCK
TYPE=4	;TYPE OF BLOCK
OS=4	;OFFSET
RB=5	;RELOCATION BITS

FFPTR:	BLOCK	1	;BYTEPTR TO RELOCATED BSLDR
BSPTR:	BLOCK	1	;BYTPTR TO UNRLCTD BSLDR
OFFSET:	BLOCK	1	;THE OFFSET
RELBTS:	BLOCK	1	;RELOCATION BITS
SASAV:	BLOCK	1	;STARTING ADDRESS
PNAME:	BLOCK	1	;PROGRAM NAME
	SIXBIT	/#/	;# = "CRLF"


BSLDR:	MOVE	AC0,[SIXBIT /BSLDR/]	;LOOKUP BLOCK
	HRLZI	AC1,(SIXBIT /REL/)
	SETZB	AC2,AC3		;
	INIT	16,13		;IMAGE-BINARY
	SIXBIT	/PTR/		;
	EXP	PTRBUF		;
	JRST	PTERR1		;INIT FAILURE ERROR
	INBUF	16,1		;ONE BUFFER
	LOOKUP	16,		;BSLDR.REL
	JRST	PTERR2		;LOOKUP FAILURE
	MOVEI	I,BSBUF		;PP PTR FOR BOOTSTRAP-LOADER-BUF

NEWBLK:	PUSHJ	P,GETWRD	;GET ONE WORD FROM PTR FILE
	HLRZM	W,TYPE		;SAVE BLOCK-TYPE
	HRRZM	W,CNT		;SAVE WRD-COUNT FOR THIS BLK
	CAIN	TYPE,1		;
	PUSH	I,W		;SAVE BLOCK HDR-WRD
	PUSHJ	P,GETWRD	;
	MOVEM	W,RELBTS	;SAVE RELOCATION-BITS
	CAIN	TYPE,1		;BLKTYP=1?
	PUSH	I,W		;YEP, SAVE THE BITS
	CAIG	TYPE,7		;ILL-BLK-TYP?
	JRST	@TYPTAB(TYPE)	;NO, OFF TO BLOCK HANDLER

TTCALL	3,[ASCIZ /?ILLEGAL BLOCK TYPE
/]
	JRST	ST		;

TYPTAB:	Z	BLK0
	Z	BLK1
	Z	BLK2
	Z	BLK3
	Z	BLK4
	Z	BLK5
	Z	BLK6
	Z	BLK7

GETWRD:	SOSG	PTRBUF+2	;EMPTY BUF?
	PUSHJ	P,GETBUF	;GET A BUFFER
	ILDB	W,PTRBUF+1	;
	POPJ	P,

GETBUF:	IN	16,		;GET BUFFER
	POPJ	P,
	STATZ	16,20000	;EOF?
	TTCALL	3,[ASCIZ /?NO END BLOCK ENCOUNTERED
/]
	STATZ	16,74000	;ERRORS?
	TTCALL	3,[ASCIZ /?DATA ERROR ON DEVICE PTR
/]
	JRST	ST
	;THIS IS NOT A BLOCK, IGNORE IT
BLK0:	JUMPE	CNT,NEWBLK	;
	PUSHJ	P,GETWRD	;PASS A WRD
	SOJA	CNT,BLK0	;

	;THIS IS THE PROGRAM
BLK1:	MOVN	CNT,CNT		;TOTAL NUMBER OF WRDS THIS BLK
BLK1A:	HRLI	CNT,-22		;MAX NUMBER PER SECTION
BLK1B:	TRNN	CNT,-1		;ANY MORE WRDS?
	JRST	NEWBLK		;NO
	PUSHJ	P,GETWRD	;
	PUSH	I,W		;SAVE IN BSBUF
	AOBJN	CNT,BLK1B	;ANY MORE WRDS THIS SECTION?
	TRNN	CNT,-1		;NO, ...THIS BLK?
	JRST	NEWBLK		;NO
	PUSHJ	P,GETWRD	;GET THE REL-BITS FOR NXT SECT
	PUSH	I,W		;SAVEM
	JRST	BLK1A		;

	;THIS IS THE SYMBOL TABLE
BLK2:	MOVN	CNT,CNT		;
BLK2A:	HRLI	CNT,-22		;
BLK2B:	TRNN	CNT,-1		;
	JRST	NEWBLK		;
	PUSHJ	P,GETWRD	;
	TLNE	W,200000	;
	JUMPL	W,BLK2ER	;ERROR - ITSA EXTERNAL SYMBOL
	AOBJN	CNT,.+1		;IGNORE THE VALUE
	PUSHJ	P,GETWRD	;
	AOBJN	CNT,BLK2B	;
	TRNN	CNT,-1		;
	JRST	NEWBLK		;
	JRST	BLK2A
BLK2ER:	TTCALL	3,[ASCIZ /?CANNOT PROCESS EXTERNAL SYMBOLS
/]
	JRST	ST

	;HIGHSEG FLAG, GIVE ERROR EXIT
BLK3:	TTCALL	3,[ASCIZ /?CANNOT PROCESS HIGH-SEG'S
/]
	JRST	ST

	;ENTRY BLOCK, IGNORE THIS BLOCK
BLK4:	MOVN	CNT,CNT	;
BLK4A:	HRLI	CNT,-22		;
	TRNN	CNT,-1		;
	JRST	NEWBLK		;
	PUSHJ	P,GETWRD	;
	AOBJN	CNT,.-1		;PASS/IGNORE 
	TRNN	CNT,-1		;
	JRST	NEWBLK		;
	PUSHJ	P,GETWRD	;
	JRST	BLK4A		;

	;THIS IS LAST BLK, MUST BE SEEN, ALSO IS PROG-BREAK
BLK5:	PUSHJ	P,GETWRD	;
	MOVNI	AC0,1(W)		;
	HRLM	AC0,BSBUF	;START THE IOWD
	CAILE	W,600		;MUST FIT IN LESS-THAN 4 BLKS
	JRST	BLK5ER		;ERROR IF'E CAN'T
	TLO	W,400000	;NOTE THE END
	PUSH	I,W		;
	HRLZI	LFL		;NOTE BSLDR IS IN "DTCOPY"
	IORM	FSAVE		;SAVE IT
	TLO	F,LFL		;
	CLOSE	16,		;
	JRST	COCRET		;THE ONLY WAY OUT
BLK5ER:	TTCALL	3,[ASCIZ /?BOOTSTRAP LOADER WILL NOT FIT IN 3 BLOCKS
/]
	JRST	ST

	;PROG-NAME IN RADIX50
BLK6:	PUSHJ	P,GETWRD	;
	PUSHJ	P,UNWIND	;CONVRT RX50 TO 6BIT PROG-NAME
	SOJA	CNT,BLK4	;I.E. IGNORE REST OF THIS BLK

UNWIND:	MOVE	AC4,[POINT 6,PNAME]
	SETZM	PNAME
	MOVEM	W,AC5		;
	HRROI	AC0,-6		;6 CHARS
	TLZ	W,740000	;CLEAR THE CODE BITS
UNW1:	IDIVI	AC5,50		;
	HRLM	AC6,(P)	;SAVE REMAINDER
	AOJGE	AC0,UNW2	;LOOP
	PUSHJ	P,UNW1		;LOOP
UNW2:	HLRZ	AC6,(P)		;PICK OFF THE REMAINDER + DECODE IT
	JUMPE	AC6,UNW3	;DONE
	ADDI	AC6,20-1
	CAILE	AC6,31
	ADDI	AC6,41-32
	CAILE	AC6,72
	SUBI	AC6,74-4
	CAIN	AC6,3
	MOVEI	AC6,16

	IDPB	AC6,AC4
UNW3:	POPJ	P,

	;STARTING ADR.
BLK7:	PUSHJ	P,GETWRD	;
	HRLI	W,(JRST)	;JUMP TO THE STARTING ADDRESS
	MOVEM	W,SASAV		;SAVE STARTING ADDRESS
	SOJA	CNT,BLK4	;IGNORE REST OF BLK

BLTWRD:	XWD	END.,END.+1	;ZRO FROM,TO
ZROWRD:	EXP	END.		;START
FSAVE:	XWD	FLP,0	;MODIFIED WHEN BSLDR IS LOADED
LISTC:	IOWD	0,END.
	Z
LISTV1:	IOWD	0,END.
LISTV2:	IOWD	0,END.
INC:	BLOCK	1
INCV:	BLOCK	1
DIRECT:	BLOCK	123
DNAM:	BLOCK	55
TOTAL:	BLOCK	26	;BLOCK TABLE
DIRWRD:	IOWD	200,DIRECT
	Z
REWIND:	IOWD	1,PTRBUF
	Z
TTYIN:	BLOCK	23+20
TTYOUT:	BLOCK	23
IN1:	BLOCK	3
IN2:	BLOCK	3
OUT2:	BLOCK	3
TIN:	BLOCK	3
TOUT:	BLOCK	3
PTRBUF:	BLOCK	3
BSBUF:	BLOCK	720	;ENUF FOR 3BLOCKS PLUS HDR WRDS
	VAR
	LIT
END.:	END	ST	;;22-JUN