Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

title	D2D - disk to disk copy; Richard Denney UTAustin; 1981
	subttl	Definitions and accumulator assignments

	search	uuosym
	sall		;No expansion of macro definitions.
	nosym		;No symbol table listing.

;	Accumulator assignments
	t1=1		;Temporary.
	t2=2	
	t3=3
	t4=4
	t5=5
	t6=6
	t7=7
	t8=10
	t9=11
;	Note: Be careful eliminating or reordering assignment of registers.
;	IDIVs are done in this program which deposits the remainder in the
;	register following the one upon which the division was done.
;	Eg. a IDIV on T9 would be disastorous since MAPIDX follows it.
	mapidx=12	;First word of current MAP entry being processed.
	maplst=13	;First word of last entry in MAP.
	maptmp=14	;Temporary pointer to move about MAP.
	oldidx=15	;Monitors progress of MAPIDX for security.
	wrtblk=16	;Block address for writing to new disk.
	p=17		;Jump stack.

;	Definitions
	pdlen==100	;Length of push down stack.
	mapsiz==7	;Number of words per entry in MAP.
	inchnl==1	;Input channel for reading UFDs, etc.
	dmpchn==2	;Dump channel for dumping SATs and MAP.
	outchn==3	;Output channel for writing to new disk.
	blksiz==200	;Words in a block.

;	Following are indexes to data items that compose each entry of MAP.
	name==0		;Index to FileName within a MAP entry.
	ext==1		;Index to FileExtension within a MAP entry.
	oldcfp==2	;Index to old CFP within a MAP entry.
	newcfp==3	;Index to new CFP within a MAP entry.
	newufd==4	;Index to new CFP of UFD pointing to file.
	nxtnod==5	;Index to address of next node in MAP chain.
	blkuse==6	;Number of blocks used.
;	End of MAP entry indexes.

	define die(error) <
		xlist
		jrst [outstr [asciz/error/]
		      exit]
		list
>

	define savreg <
		xlist
		push	p,t1
		push	p,t2
		push	p,t3
		push	p,t4
		push	p,t5
		push	p,t6
		push	p,t7
		push	p,t8
		list
>

	define resreg <
		xlist
		pop	p,t8
		pop	p,t7
		pop	p,t6
		pop	p,t5
		pop	p,t4
		pop	p,t3
		pop	p,t2
		pop	p,t1
		list
>

;	NOTE: making the PJRST definition more than one line of code
;	will cause problems since skip type instructions are used 
;	in places to skip over the PJRST. The skip instructions
;	skip only a single instruction.
	define	pjrst(x) <
		xlist
		jrst	x
		list
>

	subttl	HOME Block Definitions

;	Note: D2D computes logical block addresses by multiplying
;	Compressed File Pointers (CFP), by Blocks Per Cluster, which
;	is word HOMPBC in the HOME block. This procedure is satifactory
;	as long as Super Clusters = Clusters and a disk structure consists
;	of only one physical unit, eg. DSKH = rpa0.

	HOMNAM==0	; "HOM" in SIXBIT
	HOMHID==1	; SIXBIT unit id
	HOMPHY==2	; Physical address of this block,,other home block
	HOMSRC==3	; Position of this STR in SYS search list
	HOMSNM==4	; SIXBIT structure name
	HOMNXT==5	; ID of next unit in file structure
	HOMPRV==6	; ID of previous unit in file structure
	HOMLOG==7	; SIXBIT logical unit # within file structure
	HOMLUN==10	; Logical unit in STR
	HOMPPN==11	; Proj-prog # which refreshed STR
	HOMHOM==12	; LH==Logical block # within unit of Home block
			; RH==Log. block # within unit for extra Home block
	HOMGRP==13	; # of blocks per group to try for
	HOMBSC==14	; # blocks per supercluster on this unit
	HOMSCU==15	; # of superclusters per unit
	HOMCNP==16	; Byte ptr for cluster count in RIBS
	HOMCKP==17	; Byte ptr for checksum in RIB
	HOMCLP==20	; Byte ptr for cluster address in RIB
	HOMBPC==21	; # blocks per cluster for this STR
	HOMK4S==22	; # K words for swapping on this unit
	HOMREF==23	; Non-zero if file must be refreshed
	HOMSIC==24	; # SAT blocks in core
	HOMSID==25	; Unit ID of next unit in active swapping list
	HOMSUN==26	; Logical unit # in active swapping list
	HOMSLB==27	; First log. block # for swapping on this unit
	HOMCFS==30	; Swapping class
	HOMSPU==31	; # SAT blocks per unit
	HOMOVR==32	; Overdrawn limit per user on this STR
	HOMGAR==33	; Upper bound on total reserved blocks
	HOMSAT==34		; SAT.SYS	(Log. block within STR of first RIB)
	HOMHMS==35		; HOME.SYS
	HOMSWP==36		; SWAP.SYS
	HOMMNT==37		; MAINT.SYS
	HOMBAD==40		; BADBLK.SYS
	HOMCRS==41		; CRASH.SAV
	HOMSNP==42		; SNAP.SAV
	HOMRCV==43		; RECOV.SYS
	HOMSUF==44		; SYS UFD	[1,4] UFD
	HOMPUF==45		; Printer UFD	[3,3]
	HOMMFD==46		; MFD		[1,1]
	HOMPT1==47	; First retrieval ptr for MFD
	HOMUN1==50	; Logical unit # where MFD starts
	HOMLEN==51	; Table of lengths of files created by refresh - 6 words
	HOMEND==56	; Last word kept in UDB copy of Home block

	HOMUTP==57	; Unit type on which HOM block was written
	HOMRIP==60	; Used by RIPOFF (That's not us)
	HOMKLB==61	; First of 20 words used by PDP-11 in KL10 systems
	HOMKLE==104	; Last of the 20 words
	HOMK4C==105	; K for CRASH.EXE file
	HOMBTS==106	; Bits in the HOM block
	  HOMPVS==1B35	; Unit contained in a private STR
	HOMVID==165	; Volume ID (3 words, 12 PDP-11 bytes)
	HOMOWN==170	; Owner name (3 words, 12 PDP-11 bytes)
	HOMVSY==173	; System type (3 words, 12 PDP-11 bytes)
	HOMCOD==176	; Contains XWD 0 ,, 707070 (unlikely code)
	  CODHOM==707070	; Unlikely code for HOMCOD
	HOMSLF==177	; This block # within unit

	subttl	RIB Definitions

	RIBFIR==0	; XWD  -Nr. of retrieval ptrs ,, First pointer adress
	RIBPPN==1	; XWD Project ,, Programmer number
	RIBNAM==2	; SIXBIT file name
	RIBEXT==3	; SIXBIT file extension ,, Access date
	RIBSIZ==5	; File length in words
	RIBVER==6	; Prog # making last change ,, octal version #
	RIBSPL==7	; Spooled device
	RIBEST==10	; Estimated length of file in blocks
	RIBALC==11	; # of blocks allocated for file
	RIBPOS==12	; Log block # in STR of last group
	RIBFT1==13	; Reserved for future use by DEC
	RIBNCA==14	; Word for customer to define
	RIBMTA==15	; Tape label if file on magtape
	RIBDEV==16	; Name of STR containing file
	RIBSTS==17	; Status bits
	RIBELB==20	; Log block # where bad region begins
	RIBEUN==21	; Err unit # in STR ,, Nr bad blocks in region
	RIBQTF==22	; FCFS quota for this PPN in this STR (UFD only)
	RIBQTO==23	; Logged out quota  (UFD only)
	RIBQTR==24	; Reserved quota (UFD only)
	RIBUSD==25	; Nr blocks used when job was last logged out (UFD only)
	RIBAUT==26	; Author - PPN writing the file
	RIBNXT==27	; Next STR for this file (unused level D)
	RIBPRD==30	; Previous STR for file  (unused level D)
	RIBPCA==31	; Privileged arg for customer definition
	RIBUFD==32	; Block # in STR of UFD data block with ptr to this RIB
	RIBFLR==33	; First logical block in file pointed to by this RIB
		;  (zero if first RIB)
	RIBXRA==34	; Extended rib address
	RIBTIM==35	; Time,,Date word in universal standard
	RIBLAD==36	; Last accounting date (UFD)
	RIBDED==37	; Directory expiration date (UFD)
	RIBACT==40	; AOBJN pointer to account string
	RIBENT==RIBACT	; Last arg or value on extended lookup/enter/rename
	RIBCOD==176	; Contains 777777 (unlikely code)
	RIBSLF==177	; This logical block number in STR

	Subttl	BRKPTx - Routine to break info out of RIB retrieval pointers.

;	For RIB Retrieval Pointers on OLD pack.
;	Call with (t2)=retrieval pointer.
;	PUSHJ P,BRKPTO
;	Return here with (t2)=address (t3)=blocks in file.
;	(t4)=checksum.

brkpto:	movem	t2,o.ribp		;Move pointer to word that byte
					;pointers look at.
	ldb	t2,o.ptra		;Get CFP of first cluster.
	ldb	t3,o.ptrc		;Get count of clusters.
	ldb	t4,o.ptrs		;Check Sum.
	imul	t2,o.home+hombpc	;Change CFP into blocks.
	imul	t3,o.home+hombpc	;Change clusters into blocks.
					;HOMBPC is blocks per cluster.
	popj	p,			;And return.

;	For RIB Retrieval Pointers on NEW pack.
;	Call with (t2)=retrieval pointer.
;	PUSHJ P,BRKPTN
;	Return here with (t2)=address (t3)=blocks in file.

brkptn:	movem	t2,n.ribp		;Move pointer to word that byte
					;pointers look at.
	ldb	t2,n.ptra		;Get CFP of first cluster.
	ldb	t3,n.ptrc		;Get count of clusters.
	ldb	t4,n.ptrs		;Get checksum.
	imul	t2,n.home+hombpc	;Change CFP into blocks.
	imul	t3,n.home+hombpc	;Change clusters into blocks.
					;HOMBPC is blocks per cluster.
	popj	p,			;And return.

	subttl	UPDRIB - Update RIB of file with new disk information.

;	Call with file's RIB in O.RIB, MAPIDX pointing to file's MAP entry.
;	Updates RIBUFD, Retrieval Pointers, and RIBSLF.
;	Updated RIB is kept in N.RIB.
;	Consider all registers used.

;	Make copy of O.RIB in N.RIB.
updrib:	hrli	t1,o.rib		;Prepare to BLT O.RIB into N.RIB.
	hrri	t1,n.rib
	movei	t2,n.rib+ribslf		;Last word of a RIB.
	blt	t1,@t2			;Do it.
	move	t1,o.rib+ribslf		;Confirm BLT worked.
	came	t1,n.rib+ribslf		;Did it?
	  die(?UPDRIB: BLT failed making copy of old RIB.)

;	RIBXRA.
	setzm	n.rib+ribxra		;Rib will not be extended.

;	RIBUFD.
	move	t1,newufd(mapidx)	;New disk block address of UFD
	movem	t1,n.rib+ribufd		;that points to me.

;	RIBSLF.
	move	t2,newcfp(mapidx)	;New disk block address of file itself.
	movem	t2,n.rib+ribslf

;	RIBALC.
	move	t1,blkuse(mapidx)	;Blocks allocated to file.
	movem	t1,n.rib+ribalc		;Computed in DONTRY.

;	Build Retrieval Pointers.
;	setzm	n.ribp			;Where we will build the pointer.

;	CHECKSUM.
	pushj	p,chksum		;Called with word to be checksummed
					;in N.CHKS, which is set by routine
					;calling UPDRIB.
	move	t1,n.chks		;Checksum returned in N.CHKS.
	dpb	t1,n.ptrs		;Deposit into pointer.

;	CLUSTER COUNT.
	move	t1,blkuse(mapidx)	;Blocks allocated to file.
	idiv	t1,n.home+hombpc	;Convert to clusters.
	skipe	t2			;Remainder? Shouldn't be.
	  die(?UPDRIB: Blocks allocated not factor of Blocks Per Cluster.)
	dpb	t1,n.ptrc		;Deposit cluster count.

;	CFP - Compressed File Pointer of Block Address.
	move	t1,newcfp(mapidx)	;New disk address.
	idiv	t1,n.home+hombpc	;Compute CFP.
	skipe	t2			;Remainder? Shouldn't be.
	  die(?UPDRIB: CFP calculation bad.)
	dpb	t1,n.ptra		;Deposit in pointer.

;	Put pointer in N.RIB.
	move	t2,n.ribp		;Get the built Retrieval Pointer.
	hrrz	t1,n.rib+ribfir		;Relative location of Retrieval Pointer
	aoj	t1,			;in n.rib.
	movem	t2,n.rib(t1)		;Put pointer in.

;	Clear remaining Retrieval Pointers since this RIB isnt extended.
;	T1 should be set as was after having put rib pointer in N.RIB.
updri3:	aoj	t1,
	cail	t1,ribcod		;Done?
	jrst	updri4			;Yes.
	setzm	n.rib(t1)		;Clear it.
	jrst	updri3

;	Here with pointer still in T2.
updri4:	skipe	mufd			;Working with [1,1].UFD RIB?
	movem	t2,n.home+hompt1	;Yes. Put in HOME block of new disk.
	setzm	mufd			;Clear MFD flag.
	popj	p,			;Return.

	subttl	CHKSUM - Routine to compute checksum.

;	Call with word to be checksummed in N.CHKS.
;	Return with checksum in N.CHKS.

chksum:	move	t1,n.chks
	move	t2,n.chks
	move	t4,n.home+homckp	;Checksum pointer.
	hrri	t4,t2			;Make it point to T2.
	ldb	t3,[point 6,t4,11]	;Get size field of checksum ptr.
	movns	t3			;Make negative for upcoming LSH.
	tlza	t4,770000		;Set to bit 35.
chksu1:	add	t2,t1			;Add byte to rest of word.
	ldb	t1,t4			;Get a byte of checksum size.
	lsh	t2,(t3)			;Throw away the byte.
	jumpn	t2,chksu1		;Finished when no more of original
					;word is left.
	movem	t1,n.chks
	popj	p,			;Done. Return.

	subttl	CORGET - routine to get more core for MAP.

;	CORGET is called before adding entries to bottom of MAP.
;	It checks to see that an entry of MAPSIZ can be added without
;	exceeding .JBREL, if not it gets more core.
;	Call	PUSHJ P,CORGET
;	Return	c(maplst)=address where next entry is to start,
;		c(.JBFF)=c(old .JBFF)+MAPSIZ
;	Uses	t1,t2

corget:	move	t1,.jbff	;First free word at end of MAP.
	addi	t1,mapsiz	;Size of one MAP entry.
	camg	t1,.jbrel	;Are we going to exceed our space?
	jrst	corgot		;No. Update parameters and return.

;	Here if we need to have more core allocated.
	move	t2,t1
	core	t2,		;Request more core up to address specified.
	  die(?Insufficient core to build MAP. Set CORMAX up and retry.)

corgot:	move	maplst,.jbff	;Indicate where the start of our free core is.
	movem	t1,.jbff	;Update.
	popj	p,		;Normal return.

	subttl	DMPMAP - debugging routine to dump MAP to DSK:MAP.FIL

dmpmap:	movei	t1,.ioimg	;Open a channel for writing.
	move	t2,[sixbit/dsk/]
	hrlzi	t3,dmphdr	;Buffer control block address.
	open	dmpchn,t1
	  die(?MAP output open failed.)
	enter	dmpchn,entblk
	  die(?MAP enter failed)
	outbuf	dmpchn,0

;	Start writing of entries with the top of MAP.
	move	t1,map
;	Write entry pointed to t1.
dmpma2:	movei	t2,mapsiz	;Number of words in entry.
	move	t4,t1		;Address of entry to write.
	pushj	p,dmpit		;Dump (t2) words starting at address (t4).

;	Write out all entries pointed to by this entry.
	skipn	nxtnod(t1)	;Are there any?
	jrst	dmpma3		;No. Got to end of this loop.
	move	t4,nxtnod(t1)	;Get start of entries this entry points to.
	hrrz	t2,ext(t1)	;Get the number of entries involved.
	imuli	t2,mapsiz	;Multiply time words per entry.
	pushj	p,dmpit		;Dump (t2) words starts at address (t4).
dmpma3:	addi	t1,mapsiz	;Incriment and loop back.
	camg	t1,maplst	;Have we done all entries in MAP?
	jrst	dmpma2		;No. Loop for next.
	close	dmpchn,		;Yes.
	popj	p,

;	Routine to write (t2) words starting at (t4). Uses t3.
dmpit:	move	t3,(t4)		;Get a word.
	pushj	p,dmpbyt	;Dump the word to MAP.FIL.
	sosle	t2		;Written all the entries?
	aoja	t4,dmpit	;No. Loop for next word.
	popj	p,		;Yes. Done.

;	Here to write the word in T3 to MAP.FIL.
dmpbyt:	sosge	dmpcnt			;Output buffer full?
	  jrst	dmpby2			;Yes. Write out what we have.
	idpb	t3,dmpptr		;Put character in output buffer.
	popj	p,			;Return to caller.
dmpby2:	out	dmpchn,			;Write out buffer.
	jrst	dmpbyt			;;Start new buffer.

entblk:	sixbit/map/
	sixbit/fil/
	z
	z

dmphdr:	z
dmpptr:	z
dmpcnt:	z

	subttl	DMPSAT - Debugging routine to dump in-core SAT to disk.

dmpsat:	movei	t1,.iodmp		;Specify dump mode.
	move	t2,[sixbit/dsk/]	
	setz	t3,			;No inbuf/outbuf in dump mode.

;	Open a channel.
	open	dmpchn,t1
	  die(? Error trying to open channel for SAT block dump.)

;	Enter a file.
	enter	dmpchn,entbl2
	  die(? Enter failure for SAT dump.)

;	Prepare IOWD for dump.
	movn	t1,n.home+homspu	;Number of SATs on new disk,
	imul	t1,n.satw		;times words in block = words to dump.
	hrls	t1,t1			;To left half.
	move	t2,n.sat		;Address to dump from.
	soj	t2,			;Address minus one.
	hrr	t1,t2			;Finish the IOWD.
	setz	t2,			;Termination word.
	out	dmpchn,t1		;Dump it.
	skipa				;Good dump.
	  die(? Error while dumping in-core SAT.)
	close	dmpchn,
	popj	p,

entbl2:	sixbit/sat/
	sixbit/fil/
	z
	z

	subttl	READ - Read in dump mode from old disk.

;	Assumes INCHNL has been OPENed in dump mode (.IODMP) on
;	the original disk of which we are making a map.
;	Call with,
;	t1=block number on disk from which to read.
;	t2=buffer address in core to which the data is to be dumped.
;	t3=number of words to transfer.
;	PUSHJ P,READ
;	Return here. If errors occur it will process error and die.
;	Uses t4.

;	Use SUSET. to position to block.
read:	hrlzi	t4,inchnl		;Channel for SUSET.
	lsh	t4,5			;Shift to proper place in word.
	ior	t4,t1			;And the block to be read.
	SUSET.	t4,			;Position to block.
	  die(?READ: Error doing SUSET. UUO.)

;	Build an I/O command list in registers to assure it will be low seg.
	movns	t3,t3			;Negative number of words to read.
	movs	t4,t3
	subi	t2,1			;Location of buffer minus 1.
	hrr	t4,t2
	setz	t5,			;A zero word to terminate IO command.
	in	inchnl,t4		;Do it.
	popj	p,			;The read was good. Return.
	  die(?READ: Error doing IN.)

	subttl	bfread - buffer read in dump mode from disk.

;	Similar to routine READ but buffers input.
;	Assumes INCHNL has been OPENed in dump mode (.IODMP) on
;	the original disk of which we are making a map.
;	Call with,
;	t1=block number on disk from which to bfread.
;	t2=buffer address in core to which the data is to be dumped.
;	t3=number of words to transfer.
;	PUSHJ P,bfread
;	Return here. If errors occur it will process error and die.

bfread:	skipge	inaddr			;Is Input buffer empty? (Never used).
	jrst	bfrea3			;Yes. Go fill buffer.

;	Here when buffer has data already in it.
;	Is the data we need part of what is albfready there?
bfrea2:	move	t4,t1			;Make copy.
	sub	t4,inaddr		;Determine relative block difference.
	skipge	t4			;Equal or greater than 1st block addr?
	jrst	bfrea3			;No. Buffer doesn't have block we need.
	cail	t4,inblks		;Less than number of blks in buffer?
	jrst	bfrea3			;No. Buffer doesn't have block we need.

;	Here if Input Buffer does have the block needed.
;	T4 is set as index of needed block in the buffer.
	imuli	t4,blksiz		;From blocks to words.
	addi	t4,inbuf		;From index to absolute core location.
	movs	t4,t4			;Prepare for BLT.
	hrr	t4,t2
	add	t2,t3			;Compute last word of BLT transfer.
	soj	t2,
	blt	t4,@t2			;Transfer data to specified core area.
	popj	p,			;Done.

;	Here if buffer is empty (never been used) or if block needed is
;	not in current contents of buffer.
;	Use SUSET. to position to block.
bfrea3:	hrlzi	t4,inchnl		;Channel for SUSET.
	lsh	t4,5			;Shift to proper place in word.
	ior	t4,t1			;And the block to be bfread.
	SUSET.	t4,			;Position to block.
	  die(?bfread: Error doing SUSET. UUO.)

;	Build an I/O command list in registers to assure it will be low seg.
	movei	t4,inblks		;Number of blks in Input Buffer.
	imuli	t4,-blksiz		;Make it negative # of words.
	movs	t4,t4			;Swapped it to left half of word.
	hrri	t4,inbuf		;Address to bfread into,
	soj	t4,			;minus one.
	setz	t5,			;A zero word to terminate IO command.
	in	inchnl,t4		;Do it.
	skipa				;Read was good.
	  die(?BFREAD: Error doing IN.)
	movem	t1,inaddr		;Reset block address of first 
					;block in INBUF.
	jrst	bfrea2			;Loop.

	subttl	WRITE - Write out in dump mode to new disk.

;	Assumes OUTCHN has been OPENed in dump mode (.IODMP) to
;	disk to which we are copying.
;	WRITE buffers output to free core starting at the address 
;	pointed to by OUTBUF. As long as free core is available and
;	the data being written is contiguous with that already in 
;	OUTBUF, the data will be kept in core.
;	When core is exhausted or data not contiguous to contents of
;	OUTBUF is to be written, OUTBUF is dumped to disk and the 
;	data then placed at the top of OUTBUF.
;	Call with,
;	t1=block number at which to begin writing.
;	t2=buffer address in core of data to be written.
;	t3=number of words to write.
;	PUSHJ P,WRITE
;	Return here. If errors occur it will process error and die.

;	Compute new disk address of last block in OUTBUF.
write:	move	t5,.jbff		;First word after OUTBUF data.
	sub	t5,outbuf		;number of words used in OUTBUF.
	skipge	t5			;Check for legal value.
	  die(?WRITE: .JBFF out of range.)
	skipg	t5			;Buffer empty?
	jrst	write2			;Yes.
;	Here if buffer not empty.
	idivi	t5,blksiz		;number of words per block.
	add	t5,topblk		;Next contiguous block address.
	came	t1,t5			;Is our data to be written contiguous?
	pjrst	write3			;No.

;	Here if data is contiguous to current contents of OUTBUF,
;	or if buffer is empty.
write2:	move	t4,.jbff		;Determine core required to add data.
	add	t4,t3
	camg	t4,.jbrel		;More than we currently have?
	pjrst	wriadd			;No. We are doing fine. Add the data.

;	Here to get more core.
	core	t4,200000		;Accept physical core only.
	skipa				;No more core.
	pjrst	wriadd			;Got it. Add data to OUTBUF.

;	Here if can't get anymore core.
	pushj	p,wridmp		;Dump contents of OUTBUF to 
	jrst	write2			;disk then try again.

;	Here if data to be written is NOT contiguous with current
;	contents of OUTBUF.
write3:	pushj	p,wridmp		;Dump contents of OUTBUF to disk.
	pjrst	wriadd			;Now add data to emptied OUTBUF.

;	Here to add data to OUTBUF.
wriadd:	move	t7,.jbff		;First free word in outbuf buffer area.
	camge	t7,outbuf
	  die(?WRITE: .JBFF out of range.)
	camg	t7,outbuf		;Is buffer empty?
	movem	t1,topblk		;Yes. Keep new disk address of the
					;data we are adding.
	hrl	t7,t2			;Current location of data.
	move	t8,.jbff		;Determine last word data will use.
	add	t8,t3
	soj	t8,
	blt	t7,@t8			;Add it to buffer.
	movem	t8,.jbff		;Compute new first free.
	aos	.jbff
	popj	p,			;Return.

;	Here to dump contents of OUTBUF to new disk.
;	Use SUSET. to position to block.
wridmp:	hrlzi	t4,outchn		;Channel for SUSET.
	lsh	t4,5			;Shift to proper place in word.
	ior	t4,topblk		;And the block to write.
	SUSET.	t4,			;Position to block.
	  die(?WRITE: Error doing SUSET. UUO.)

;	Build an I/O command list in registers to assure it will be low seg.
	move	t5,.jbff		;Determine number of words to write.
	sub	t5,outbuf
	movns	t5,t5			;Negative number of words to write.
	movs	t4,t5
	move	t5,outbuf		;Location of buffer,
	soj	t5,			;minus one.
	hrr	t4,t5
	setz	t5,			;A zero word to terminate IO command.
	out	outchn,t4		;do it.
	skipa				;Write was good.
	  die(?WRITE: Error doing OUT.)

;	Set variables to reflect state of buffer.
	move	t4,outbuf		;Set first free word back to top.
	movem	t4,.jbff
	setom	topblk			;Clear this out.
	popj	p,			;Return.

	subttl	ALLOC - allocate disk space on new pack using in-core SAT.

;	Searchs for a contiguos number of blocks and returns the disk
;	address where they start. Leaves the clusters marked in SATs.
;	Call with number of blocks needed in T1.
;	PUSHJ	P,ALLOC
;	Return here with T1=0 if couldn't grant request,
;	         or with T1=address if found.

alloc:	idiv	t1,n.home+hombpc	;Convert blocks to clusters.
	skipe	t2			;Was there a remainder?
	  die(?ALLOC: Blocks allocated is not a factor of Blocks Per Cluster.)

	move	t2,n.satt		;Get word in SAT with which we began
					;our search last time.
alloc2:	camle	t2,n.sate		;Have we passed the end of SAT?
	  jrst	[setz t1,		;No more space in SAT.
	         popj p,]
	move	t3,(t2)			;Get that top word of SAT.
	aosn	t3			;Any free clusters? -1 indicates this.
	aoja	t2,alloc2		;No. Get next word.
	movem	t2,n.satt		;Yes. Make a new n.satt for next time.
	hll	t2,n.satp		;Build a pointer to this location.
	movem	t2,n.fwdp		;Start our search for contiguous
					;clusters here.
	setzm	n.bckp			;Indicate starting out.

;	Here to look for a free cluster.
alloc3:	ildb	t3,n.fwdp		;Get a cluster.
	hrrz	t4,n.fwdp		;Get theword address.
	camle	t4,n.sate		;Have we passed last word in SAT?
	pushj	p,[ movei t3,1		;Yes. Fake a marked cluster.
		    move  t2,t1		;Fake clusters found = clusters needed.
		    popj  p,]
	jumpe	t3,alloc4		;Is the cluster free?
	setzm	n.bckp			;No. Indicate we haven't found the 
					;start of our contiguos blocks yet.
	jrst	alloc5

;	Here if cluster was free.
alloc4:	skipe	n.bckp			;Is this the first cluster found?
	aoja	t2,alloc5		;No. Count another contiguos one.
	move	t2,n.fwdp		;Yes. Mark this as start of contigous
					;clusters.
	movem	t2,n.bckp
	movei	t2,1			;Set count of clusters found to one.

;	Here to see if we have all the clusters needed.
alloc5:	camge	t2,t1			;Is clusters found >or= to needed?
	jrst	alloc3			;No. Look for another.

;	Here when we have either found the number of contiguous clusters
;	needed, or have failed to do so.
	skipn	n.bckp			;Did we fail?
	jrst	[setz t1,		;Yes. Indicate this and return.
		 popj p,]

;	Here if we found the number of contiguous clusters needed.
;	Calculate logical block address of disk area allocated.
;	First determine logical block address of SAT block from which
;	the space was allocated. 
	hrrz	t1,n.bckp		;Address of word in in-core SAT.
	sub	t1,n.sat		;Make relative to top of SAT.
	idiv	t1,n.satw		;Divide by words in each SAT to get
					;number of SATs preceding current one.
					;We will use the remainder in T2 soon.
	imul	t1,n.satb		;finally, number of blocks per sat
					;times number of SATs preceding gives
					;the block address of first block of
					;SAT we are allocating space from.

;	After the above division, T2 will be the number of words in this block
;	that precede the word we point to.
	imuli	t2,^d36			;Each word represents 36 clusters,
	imul	t2,n.home+hombpc	;and each cluster has x number blocks.

;	Finally...
	hlrz	t4,n.bckp		;What bit within word was pointed to?
					;Calculate bits to the left of it.
	lsh	t4,^d-12		;This leaves "P" portion of pointer,
	movei	t3,^d36			;Bits in a word.
	sub	t3,t4			;Gives bits to left plus 1.
	sos	t3			;Minus 1 gives us bits to left of 
					;one pointed to.
	imul	t3,n.home+hombpc	;Each cluster(1 bit) has x no. blocks.

;	The block address of contiguos blocks allocated is then...
	add	t1,t2			;Block address of first block,
	add	t1,t3			;plus total blocks into the area.

;	Here to mark all clusters used in SATs.
	movei	t2,1
	move	t3,n.bckp		;Will point to first cluster.
	skipa
alloc6:	ibp	t3			;Incriment pointer to next cluster.
	dpb	t2,t3			;Mark cluster as used.
	came	t3,n.fwdp		;Done?
	jrst	alloc6			;No. Go mark next cluster.
	popj	p,			;Yes. Return to calling routine.

	subttl	Initializations

d2d:	jfcl		;In case of CCL entry.
	reset		;Clear channels etc..
	move	p,[iowd pdlen,pdlist]	;Set up stack.

;	Get disk copying from and I.D. and name of disk copying to.
getdsk:	setzm	frompk		;Clear words where pack names are
	setzm	topk		;to be built.
	setzm	topkid
	setzm	name
	clrbfi

;	Get name of disk from which we are copying.
	move	t1,[point 6,frompk]
	outstr	[asciz/Copy from:/]
Getds1:	inchwl	t2		;Get a character.
	caig	t2,40		;Break character?
	jrst	Getds2		;Yes. Proceed with check.
	caig	t2,140		;Is char lowercase?
	addi	t2,40		;No. Convert to lowercase.
	idpb	t2,t1		;Add character to name being built.
	jrst	Getds1		;Get another character.
getds2:

;	Get name of disk to which we are copying.
	move	t1,[point 6,topk]
	outstr	[asciz/Copy to  :/]
	clrbfi
	setzm	name
Getds3:	inchwl	t2		;Get a character.
	caig	t2,40		;Break character?
	jrst	Getds4		;Yes. Proceed with check.
	caig	t2,140		;Is char lowercase?
	addi	t2,40		;No. Convert to lowercase.
	idpb	t2,t1		;Add character to name being built.
	jrst	Getds3		;Get another character.
getds4:

;	Get I.D. of pack to which we are copying.
	move	t1,[point 6,topkid]
	outstr	[asciz/I.D. of pack copying to:/]
	clrbfi
	setzm	name
Getds5:	inchwl	t2		;Get a character.
	caig	t2,40		;Break character?
	jrst	Getds6		;Yes. Proceed with check.
	caig	t2,140		;Is char lowercase?
	addi	t2,40		;No. Convert to lowercase.
	idpb	t2,t1		;Add character to name being built.
	jrst	Getds5		;Get another character.
getds6:

;	Get characteristics of disk from which we are copying.
	move	t1,frompk		;Sixbit name of pack copying from.
	movem	t1,dsktab		;Put it in disk table.
	move	t1,[xwd TabLen,DskTab]
	dskchr	t1,		;Put disk info in dsktab.
	  jrst	error2		;Give a message and die.

;	Get characteristics of disk to which we are copying.
	move	t1,topk		;Sixbit name of pack copying to.
	movem	t1,dsktab	;Put it in disk table.
	move	t1,[xwd TabLen,DskTab]
	dskchr	t1,		;Put disk info in dsktab.
	  jrst	error3		;Give a message and die.

;	Check to see that proper disk is mounted on drive to which we
;	will be copying.
	move	t1,ToPkId		;Correct disk?
	came	t1,DskTab+.dcuid	;I.D.s must match.
	  jrst	error1			;No. Give a message and die.
	jrst	satget			;Yes. Proceed.

;	Here on errors.
Error1:	outstr	[asciz/?Pack I.D. given does not match that
of Pack you are copying to.
Try again.
/]
	jrst	getdsk

Error2:	outstr	[asciz/?Disk you are copying from does not exist.
Try again.
/]
	jrst	getdsk

Error3:	outstr	[asciz/?Disk you are copying to does not exist.
Try again.
/]
	jrst	getdsk

DskTab:	z			;Physical device being checked.
	block	23		;Room for rest of table.
	TabLen=.-DskTab		;TabLen is lenght of table DskTab.

	subttl	Build target pack's SATs in core.

;	SATGET reads all SAT blocks on the target pack, building
;	an in core Storage Allocation Table.
;	How many words of each SAT block are actually used is dependant
;	on number of blocks on the pack, cluster size, and number of SAT
;	blocks. These calculations are done in this routine.

satget:	movei	t1,.iodmp		;Specify dump mode.
	move	t2,topk			;Target pack.
	setz	t3,			;No inbuf/outbuf in dump mode.

;	Open a channel.
	open	inchnl,t1
	  die(?SATGET: Error trying to open channel for HOME block read-in.)

;	Read the home block of target pack.
	movei	t1,1			;Home block is block 1.
	movei	t2,n.home		;Where to put it in core.
	movei	t3,blksiz		;The number of words to read.
	pushj	p,read			;Get it.
	move	t1,n.home+homnam	;Check to see if it is a HOME block.
	came	t1,[sixbit/HOM/]
	  die(?SATGET: Logical block 1 is not a HOME block.)

;	Read SAT.SYS RIB from target pack.
	move	t1,n.home+homsat	;Address of SAT RIB on target pack.
	movei	t2,n.satr		;Buffer in which to place SAT's RIB.
	movei	t3,blksiz		;Size of a RIB.
	pushj	p,read			;Read the RIB.

;	Build byte pointer for RIB retrieval pointers on target pack.
	move	t1,n.home+homcnp	;Pointer for Cluster Count.
	hllm	t1,n.ptrc		;Where we will keep the pointer.
	move	t1,n.home+homclp	;Pointer for Adress of first cluster.
	hllm	t1,n.ptra		;Where we will keep the pointer.
	move	t1,n.home+homckp		;Pointer for checksum.
	hllm	t1,n.ptrs		;Where we will keep the pointer.

;	Set up area for reading in target packs SATs.
	move	t1,.jbff
	movem	t1,n.sat		;Address of 1st word in SAT buffer.
					;N.SAT permanently points to this.
	movem	t1,n.satt		;N.SATT is initialized to this address.
					;It may move as space is allocated.
	movem	t1,n.sate		;Address of last word.
	sos	n.sate			;Start the end at top-1.

;	Calculate number of words actually used in each SAT block.
	move	t1,n.home+hombsc	;Blocks per supercluster.
	imul	t1,n.home+homscu	;Times superclusters on pack equals
					;blocks on pack.
	idiv	t1,n.home+hombpc	;Divided by blocks per cluster equals
					;clusters on pack.
	skipe	t2
	  die(?SATGET: Calculation of clusters on pack was bad.)
	idiv	t1,n.home+homspu	;Divided by SATs on pack equals
	skipe	t2			;Cluster per SAT.
	  aoj	t1,			;Round up if a remainder.
	movem	t1,n.satb		;Save for later use.
	idivi	t1,^d36			;Divided by 36(bits per word) equals
	skipe	t2			;number of words actually used.
	aoj	t1,			;Round up if there is a remainder.
	movem	t1,n.satw		;Save it.

;	Finally, get the core needed for the SAT buffer.
	imul	t1,n.home+homspu	;Words per SAT block times SATs on pack
					;equals total words needed for buffer.
	addb	t1,.jbff		;Calculate address to expand core to.
					;Update .JBFF to relect core we took.
	camg	t1,.jbrel		;Are we exceeding our core limit?
	jrst	satge1			;No.
	core	t1,			;Yes. Request more.
	  die(?insufficient core to build SATs. Set CORMAX up and retry.)

;	Also calculate number of blocks per sat.
	move	t1,n.home+hombpc	
	imulm	t1,n.satb		;Blocks per SAT.

;	For each pointer in SAT's RIB to a SAT block, read the block and
;	use the number of words actually used(just calculated) to place 
;	only the used portion of each SAT block into buffer.
;	T1,T5 and T6 once set by this routine are dedicated until MAPINI.
satge1:	move	t6,n.home+homspu	;Number of SAT blocks on target pack.
	hrrz	t5,n.satr+ribfir	;RIB index to 1st retrieval pointer.
	addi	t5,2			;1st pointer is for RIB itself. Skip.
					;2nd pointer is for 1st real SAT block.
satge2:	move	t2,n.satr(t5)		;Get a pointer.
	pushj	p,brkptn		;Break info out of pointer. Returns
					;t2=block where SAT starts t3=# blocks,
					;t4=checksum.

;	Read the SAT block into the in-core SAT area.
	move	t1,t2			;Logical block address of SAT block.
	move	t2,n.sate		;Last used word of in-core SAT area.
	aoj	t2,			;First word after SATEnd.
	move	t3,n.satw		;Read this many words.
	savreg
	pushj	p,read			;Read it.
	resreg
	addm	t3,n.sate		;New SAT block end.

;	Remember the address at which this SAT block is located on new disk.
	move	t2,n.home+homspu	;SATs per unit,
	sub	t2,t6			;minus SATs unread,
	movem	t1,n.dska(t2)		;is the SAT currently being read.

	sosle	t6			;Have we done all SATs on unit?
	aoja	t5,satge2		;No. Go read next SAT on unit.

;	Fall through to SUFINI.
;	Leave INCHNL open for SUFINI.

	subttl	SUFINI - routine to initialize [1,4].UFD

;	The System UFD is treated seperately because of certain files 
;	there which are set up during the new disk's initialization, 
;	which we do not want to copy over from the old disk.
;	Eg. SAT.SYS, HOME.SYS, SWAP.SYS.
;	These files are to retain there same physical location on the
;	new disk although the [1,4].UFD which lists them may be moved.
;	Their physical location on the disk is gotten from the HOME 
;	block, logical block 1 on disk.
;	The [1,4].UFD is built in a buffer N.SUFD and written out seperatly
;	later on. This routine initialized N.SUFD with the special files
;	from the new disks [1,4] area.
;	Will use the channel initialzed in SATINI, INCHNL.

sufini:	move	t1,n.home+homsuf		;Location of SYS.UFD RIB.
	aoj	t1,				;Add one to get UFD block.
	movei	t2,n.sufd			;Where to put it.
	movei	t3,blksiz			;Number of words to read.
	pushj	p,read

;	Here to find the first file entry NOT amoung our special ones.
;	The special ones will be grouped at top. When we have found a file
;	that is not a special one, we can clear N.SUFD from there on.
	movni	t1,2				;Index for N.SUFD.
sufin2:	addi	t1,2				;Next entry.
	cail	t1,blksiz-2			;Check for in bounds.
	  die(?SUFINI: New disk SYS.UFD has suspicious number of entries.)
	move	t2,n.sufd(t1)			;Get a file name.
	skipn	t2				;Zero means SYS.UFD is already
						;just as we wish it.
	jrst	sufin3				;Done.
	camn	t2,[sixbit/SAT/]
	jrst	sufin2				;One of our special files.
	camn	t2,[sixbit/HOME/]
	jrst	sufin2				;One of our special files.
	camn	t2,[sixbit/SWAP/]
	jrst	sufin2				;One of our special files.
	camn	t2,[sixbit/MAINT/]
	jrst	sufin2				;One of our special files.
	camn	t2,[sixbit/BADBLK/]
	jrst	sufin2				;One of our special files.
	camn	t2,[sixbit/CRASH/]
	jrst	sufin2				;One of our special files.
	camn	t2,[sixbit/SNAP/]
	jrst	sufin2				;One of our special files.
	camn	t2,[sixbit/RECOV/]
	jrst	sufin2				;One of our special files.

;	Here when we have found the first non-special file.
;	Clear N.SUFD from here down. This keeps only our special files.
	movei	t1,n.sufd(t1)
	setzm	@t1
	hrls	t1,t1				;Prepare for BLT.
	aoj	t1,
	blt	t1,n.sufe			;Clear through last word.

;	Done with Channel.
sufin3:	close	inchnl,
;	Fall through to INIINI.

	subttl	Initialize MAP.

;	Set up the MAP area.
mapini:	move	t1,.jbff	;Get address of first free core.
	movem	t1,map		;Nothing should be written after the map
				;for the balance of map building section
				;since it will expand to an undetermined size.
				;.JBFF will be last word in MAP, plus one.

;	Start the MAP out with the [1,1] UFD entry.
	pushj	p,corget	;Return with first available address in maplst.
	move	t1,[xwd 1,1]
	movem	t1,name(maplst)	;Moves 1,1 to FileName position of MAP.
	move	t1,[sixbit/ufd/]
	movem	t1,ext(maplst)	;Moves UFD to FileExtension position of MAP.

;	To get the location of [1,1] UFD on old disk we must read HOME block.
;	First prepare the open block.
	movei	t1,.iodmp		;Specify dump mode.
	move	t2,frompk		;Specify pack copying from.
	setz	t3,			;No inbuf/outbuf in dump mode.

;	Open a channel for now and future input from old disk.
	open	inchnl,t1
	  die(? Error trying to open channel for HOME block read-in.)

;	Read the home block.
	movei	t1,1			;Home block is block 1.
	movei	t2,o.home		;Where to put it in core.
	movei	t3,blksiz		;The number of words to read.
	pushj	p,read			;Get it.
	move	t1,o.home+homnam	;Make sure it's a HOME block.
	came	t1,[sixbit/HOM/]
	  die(?MAPINI: Logical block 1 is not a HOME block.)

	move	t1,o.home+hommfd	;Get location of [1,1] UFD on old disk.
	movem	t1,oldcfp(maplst)	;Finish our MAP entry.

;	Build byte pointer for RIB retrieval pointers.
	move	t1,o.home+homcnp	;Pointer for Cluster Count.
	hllm	t1,o.ptrc		;Where we will keep the pointer.
	move	t1,o.home+homclp	;Pointer for Adress of first cluster.
	hllm	t1,o.ptra		;Where we will keep the pointer.
	move	t1,o.home+homckp	;Pointer for Checksum.
	hllm	t1,o.ptrs		;Where we will keep the pointer.

	subttl	MISC Initializations.

;	D2D uses a single RIB Retrieval Pointer when constructing the
;	RIBs of files copied to the new disk. Consequently, the size
;	of the Cluster Count field in the pointers limits the size of
;	files that can be copied. Determine what that size is.
	move	t1,n.home+homcnp	;The pointer for Cluster Count in
					;RIB Retrieval Pointers.
	hrri	t1,[-1]			;Point it to a word = 777777,777777
	ldb	t2,t1			;T2 now has max cluster count that
					;a single Retrieval Ptr can hold.
	imul	t2,n.home+hombpc	;Convert to blocks.
	movem	t2,maxfil		;Keep this value.

	subttl	Top level to build in core map of disk to be copied.

;	Here to add to MAP everyone our initial [1,1].ufd entry points to.
bldmap:	outstr	[asciz/Building Map...
/]
	move	mapidx,map		;MAPIDX will serve as our index
					;to processing entries in MAP.
	move	oldidx,mapidx		;Security check on MAPIDX value.
	pushj	p,dontry		;Start off processing [1,1].ufd.
	came	oldidx,mapidx		;Confirm its value.
	  die(?BLDMAP: MAPIDX modified in DONTRY.)

;	[1,1].UFD's first entry is to itself. Rather than repeat the
;	DONTRY process, make a copy of [1,1].ufd immediately following
;	the one we just placed in MAP.
	hrl	t1,mapidx		;Prepare for BLT.
	addi	mapidx,mapsiz
	hrr	t1,mapidx
	blt	t1,blkuse(mapidx)
	addi	mapidx,mapsiz		;Now set MAPIDX to skip over the
					;second [1,1].UFD entry.

;	Here to finish building MAP.
bldma2:	camle	mapidx,maplst		;More entries to be processed?
	jrst	bldend			;No. Map is built.

;	Here to process next entry in MAP.
	move	oldidx,mapidx		;Security check on MAPIDX value.
	pushj	p,dontry		;Process entry pointed to by MAPIDX.
	came	oldidx,mapidx		;Confirm its value.
	  die(?BLDMAP: MAPIDX modified in DONTRY.)
	addi	mapidx,mapsiz		;Point to next entry.
	jrst	bldma2			;Loop back.

bldend:	jrst	wrtmap			;Here when map is built.

	subttl	DONTRY - a subprocess of BLDMAP

;	Process the entry pointed to by MAPIDX.
;	Read the RIB of file the entry represents, determine number of
;	of blocks it requires on new disk, allocate space, and if the 
;	file is a directory add an entry to MAP for each file the UFD
;	points to.

dontry:	move	t1,oldcfp(mapidx)	;Address of RIB on old disk.
	movei	t2,o.rib		;Buffer in which to place RIB.
	movei	t3,blksiz		;Size of a RIB.
	pushj	p,bfread		;Read the RIB.
	move	t1,o.rib+ribnam		;Do security check on name.
	came	t1,name(mapidx)		;RIBNAM match that in MAP?
	  die(?DONTRY: RIBNAM does not match that in MAP.)

;	Determine how many blocks this file will need.
	move	t1,o.rib+ribsiz		;Size of file in words.
	idivi	t1,blksiz		;Convert to words.
	skipe	t2			;Remainder?
	aoj	t1,			;Yes. Round up block count.
	addi	t1,2			;Plus two RIBs.
	idiv	t1,n.home+hombpc	;Convert to clusters.
	skipe	t2			;Remainder?
	aoj	t1,			;Yes. Round up cluster count.
	imul	t1,n.home+hombpc	;And back to blocks.
					;Note that if the Blks Per Cluster on
					;new disk is different from old, the
					;blocks allocated will be different.
	movem	t1,blkuse(mapidx)	;Keep blocks used in MAP entry.

;	Check that file size is such that we can copy the file.
	camle	t1,maxfil		;A file our RIB Retrieval Pointer
					;cluster counts can handle?
	  die(?DONTRY: File too large for current RIB Ret. Ptr. cluster count.)

;	Allocate space on new disk, updating SATS.
	pushj	p,alloc			;T1 contains number of blocks needed.
	movem	t1,newcfp(mapidx)	;Update entry.
	skipn	t1			;Space allocated?
	  die(?DONTRY: Could not allocate space for file in SAT.)
	skipg	t1			;Value in bounds?
	  die(?DONTRY: Value returned for logical disk address is bad.)

;	Are we a directory? If so make entries for all files we point to.
	move	t1,ext(mapidx)		;Get file extension.
	camn	t1,[sixbit/UFD/]	;an UFD?
	pjrst(dontr2)			;Yes.
	camn	t1,[sixbit/SFD/]	;an SFD?
	pjrst(dontr2)			;Yes.
;	Here if not a directory.
	setzm	nxtnod(mapidx)		;Indicate not a directory.
	popj	p,			;Done. Return.

;	Here if a directory. Make MAP entries for each file in directory.
dontr2:	move	t1,o.rib+ribnam		;Check for the three special UFDs.
	setzm	sufd			;Assume not [1,4].
	came	t1,[xwd 1,1]		; [1,1].ufd?
	jrst	dontr3			;No.

;	Here for [1,1].ufd.
	move	t2,newcfp(mapidx)	;Update new disk HOME block to reflect
	movem	t2,n.home+hommfd	;new location of MFD.
	movem	t2,newufd(mapidx)	;Also, [1,1].ufd is the UFD which
					;points to itself.
	jrst	dontr5

dontr3:	came	t1,[xwd 1,4]		; [1,4].ufd?
	jrst	dontr4			;No.
;	Here for [1,4].ufd.
	setom	sufd			;Set flag for later routines.
	move	t2,newcfp(mapidx)	;Update new disk HOME block to reflect
	movem	t2,n.home+homsuf	;new location of SYS UFD.
	jrst	dontr5

dontr4:	came	t1,[xwd 3,3]		; [3,3].ufd?
	jrst	dontr5			;No.
;	Here for [3,3].ufd.
	move	t2,newcfp(mapidx)	;Update new disk HOME block to reflect
	movem	t2,n.home+hompuf	;new location of Printer UFD.

dontr5:	move	t1,.jbff		;First word after end of MAP.
	movem	t1,nxtnod(mapidx)	;All entries from this directory will
					;begin at end of MAP. Point to them.
	pushj	p,addmap		;Add entries to map for files.
	move	t1,.jbff		;Get address of end of MAP now.
	sub	t1,nxtnod(mapidx)	;Get difference in old .JBFF and now.
	idivi	t1,mapsiz		;Compute number of entries UFD has.
	skipge	t1			;Check for strange value.
	  die(? .JBFF was reset in DONTR2. MAP has been lost.)
	skipn	t1			;Has anything been added to MAP?
	setzm	nxtnod(mapidx)		;No. Indicate an empty UFD.
	hrrm	t1,ext(mapidx)		;Put in right half of file extension.
	popj	p,

subttl	ADDMAP - add entries to MAP for files in a directory.

;	ADDMAP is used by DONTRY, a subprocess of BLDMAP, to make MAP
;	entries for all files pointed to by the directory being processed
;	by DONTRY.
;	It is possible that directory RIBs are not compressed, ie. they
;	have RIB pointers that really aren't in use. Because of this 
;	we must use a RIBSIZ decrement counter to avoid processing such
;	RIB pointers.
;	Call with:
;	MAPIDX pointing to MAP entry of UFD being processed by DONTRY.
;	O.RIB has rib of UFD.
;	Uses t1,t2,t3.
;	Updates MAPEND and .JBFF as a consequence of adding to the MAP.

addmap:	move	t1,o.rib+ribnam		;Security check,
	came	t1,name(mapidx)		;RIBNAM match that in MAP?
	  die(?ADDMAP: RIBNAM doesn't match name in MAP.)
;	Initialize RIBSIZ decrement counter.
	move	t1,o.rib+ribsiz		;Words written in UFD.
	idivi	t1,blksiz		;Make into blocks.
	skipe	t2			;If a remainder,
	  die(?ADDMAP: RIBSIZ is not an even factor of block size.)
	movem	t1,totblk		;Keep the decremental counter here.
addma1:	hrrz	t1,o.rib+ribfir		;RIB index to 1st retrieval pointer.
	addi	t1,1			;You just have to do this.
	move	t2,o.rib(t1)		;And get the first pointer.
	pushj	p,brkpto		;Break info out of pointer. Returns
					;t2=block where UFD starts t3=# blocks.
	aoj	t2,			;The first pointer points to itself,
					;so the UFD we want follows. Add 1.
	soj	t3,			;Which also means one less block of
					;directory information for processing.
	savreg
	pushj	p,addma3		;Process it.
	resreg
addma2:	addi	t1,1			;Move to next retrieval pointer.
	cain	t1,ribcod		;Out of pointers?
	jrst	addmax			;Yes. Check if extended RIB.
	move	t2,o.rib(t1)		;Get next pointer.
	skipn	t2			;Is it empty?
	jrst	addmax			;Yes. Check if extended RIB.
	pushj	p,brkpto		;No. Get info and process it.
					;Returns t2=UFD address t3=# blocks.
	savreg
	pushj	p,addma3
	resreg
	jrst	addma2			;Loop for next.

;	Here to check for extended RIBs.
addmax:	skipn	t1,o.rib+ribxra		;Extended?
	popj	p,			;No. Return.
	move	t4,o.rib+ribnam		;For security check later.
	movei	t2,o.rib		;Yes. Prepare to read it.
	movei	t3,blksiz
	savreg
	pushj	p,bfread		;Read the extended RIB.
	resreg
	came	t4,o.rib+ribnam		;Do RIBNAMs match?
	  die(?ADDMAX: Extended RIBNAM doesn't match RIBNAM in prime RIB.)
	jrst	addma1			;And loop to process it.

;	ADDMA3 is a subprocess of ADDMAP.
;	It is called once for each of the UFD's rib retrieval pointers.
;	Called with t2=logical block number from rib retrieval pointer,
;	and t3=number of blocks from the rib retrieval pointer.
;	It makes an entry in MAP for each file entry in the UFD.

ADDMA3:	skipg	totblk			;Check RIBSIZ decrement counter.
	popj	p,			;We have already read as many blocks
					;in this UFD as are actually used.
					;The RIB retrieval pointer we have
					;been asked to process must be the
					;result of an Uncompressed RIB, and
					;hence is not really in use. Skip it.

;	Here if we haven't read all the blocks in the UFD yet.
	move	t1,t2			;Logical block of start of data.
	move	t4,t2			;Compute last block allocated+1.
	add	t4,t3
	movei	t2,o.ufd		;Where to read UFD block into.
	movei	t3,blksiz		;How many words.

;	Here to read one block of UFD.
addma4:	caml	t1,t4			;Processed the last blk of this ptr?
	popj	p,			; Yes. Return to get next retrieval ptr.
	sosge	totblk			;Decrement blocks used counter by one.
	popj	p,			; We have read all the used blocks in
					; in the UFD. Return.
	savreg				;No. Continue.
	movem	t1,ribtst		;Save for RIBSLF check later.
	pushj	p,bfread
	resreg

;	Here to process the block of the UFD just read.
	setz	t5,			;Index to entries in UFD.
addma5:	caile	t5,blksiz-2		;Finished this block?2 words/entry.
	aoja	t1,addma4		;Yes. Get next block.
	move	t6,o.ufd(t5)		;Get sixbit filename from UFD entry.
	skipn	t6			;Zero, meaning no more data in block?
	aoja	t1,addma4		;Yes. Go get another block.

;	Are we dealing with [1,4].ufd?
	skipn	sufd			;Processing [1,4].UFD?
	jrst	addma7			;No.

;	Here if dealing with [1,4].ufd.
;	There are certain files we will not want to copy from old to new disk,
;	for example BADBLK.SYS, HOME.SYS, etc..
	move	t8,t5			;T5 is index to entries in UFD block.
	aoj	t8,			;Was pointing to filename, now to ext.
	hllz	t7,o.ufd(t8)		;Get the extension.

;	Is the entry of UFD block being looked at one we don't want to copy?
addhom:	came	t6,[sixbit/home/]
	skipa
	came	t7,[sixbit/sys/]
	skipa
	jrst	addma6			
					
	came	t6,[sixbit/sat/]
	skipa
	came	t7,[sixbit/sys/]
	skipa
	jrst	addma6			
					
	came	t6,[sixbit/swap/]
	skipa
	came	t7,[sixbit/sys/]
	skipa
	jrst	addma6			
					
	came	t6,[sixbit/maint/]
	skipa
	came	t7,[sixbit/sys/]
	skipa
	jrst	addma6			
					
	came	t6,[sixbit/badblk/]
	skipa
	came	t7,[sixbit/sys/]
	skipa
	jrst	addma6			
					
	came	t6,[sixbit/crash/]
	skipa
	came	t7,[sixbit/exe/]
	skipa
	jrst	addma6			
					
	came	t6,[sixbit/snap/]
	skipa
	came	t7,[sixbit/exe/]
	skipa
	jrst	addma6			
					
	came	t6,[sixbit/recov/]
	jrst	addma7
	came	t7,[sixbit/sys/]
	jrst	addma7
	jrst	addma6			
					

;	Here to exclude certain [1,4].ufd files from MAP.
;	These are files created by TWICE when the NEW disk is initialized.
addma6:	addi	t5,2			;Bump index for UFD block from old 
					;disk being being processed.
	jrst	addma5			;Go to next entry.

;	Here to add entry to MAP.
addma7:	savreg
	pushj	p,corget		;Grab core to add to MAP.
	resreg				;Returns with MAPLST=next available.
	movem	t6,name(maplst)		;Put in MAP.
	aoj	t5,			;Incriment O.UFD index.
	hrrz	t6,o.ufd(t5)		;Get the CFP.
	imul	t6,o.home+hombpc	;Convert CFP to logical block address.
	movem	t6,oldcfp(maplst)	;Put in MAP.
	hllz	t6,o.ufd(t5)		;Get the sixbit file extension.
	movem	t6,ext(maplst)		;Put in MAP.
	move	t6,newcfp(mapidx)	;Get new CFP of UFD pointing to me.
	movem	t6,newufd(maplst)	;Put in MAP.
	setzm	nxtnod(maplst)		;Clear pointer.
	aoja	t5,addma5		;Incriment O.UFD index. Go do next.

	subttl	Top level to write entries listed in MAP to new disk.

;	WARNING: The remainder of free core will be now be used for
;	buffering output to the target pack.
wrtmap:	outstr	[asciz/Copy Beginning...
/]
	move	t1,.jbff		;Where free core begins. This is
	movem	t1,outbuf		;the first word after MAP.

;	Now prepare the open block.
	movei	t1,.iodmp		;Specify dump mode.
	move	t2,topk			;Specify pack copying to.
	setz	t3,			;No inbuf/outbuf in dump mode.

;	Open output channel.
	open	outchn,t1
	  die(?WRTMAP: Error trying to OPEN channel for output to new disk.)

;	Here to write out [1,1].ufd.
	move	mapidx,map		;MAPIDX will serve as our index
					;to processing entries in MAP.
	move	oldidx,mapidx		;Security check on MAPIDX value.
	pushj	p,writit		;Start off processing [1,1].ufd.
	came	oldidx,mapidx		;Confirm its value.
	  die(?WRTMAP: MAPIDX was modified in WRITIT.)
	addi	mapidx,mapsiz*2		;Since the first entry in [1,1].ufd
					;is a [1,1] entry pointing to itself, 
					;we now have two consectutive [1,1]
					;entries in MAP. Set MAPIDX to skip
					;over the second.

;	Here to write all other files.
wrtma2:	camle	mapidx,maplst		;More entries to be processed?
wrtend:	jrst	updhom			;No. All files copied.
					;Go finish up.

;	Here to process next entry in MAP.
	move	oldidx,mapidx		;Security check on MAPIDX value.
	pushj	p,writit		;Process entry pointed to by MAPIDX.
	came	oldidx,mapidx		;Confirm its value.
	  die(?WRTMAP: MAPIDX was modified in WRITIT.)
	addi	mapidx,mapsiz		;Point to next entry.
	jrst	wrtma2			;Loop back.

;	Here to write out HOME blocks to new disk.
;	First, update new disk's HOME block words HOMSNM and HOMLOG.
updhom:	move	t1,o.home+homsnm	;SIXBIT structure name.
	movem	t1,n.home+homsnm
	move	t1,o.home+homlog	;SIXBIT logical unit name.
	movem	t1,n.home+homlog

;	Prepare to write the HOME blocks on new pack.
	movei	t1,1
	movei	t2,n.home
	movei	t3,blksiz
	savreg
	pushj	p,write
	resreg
	movei	t1,12
	savreg
	pushj	p,write
	resreg

;	Here to write out SAT blocks to new disk.
	move	t4,n.home+homspu	;Number of SAT blocks on new disk.
updsat:	sosge	t4			;Written them all?
	jrst	updsuf			;Yes.

;	Prepare for write.
	move	t1,n.dska(t4)		;Where to write.
	move	t5,n.satw
	imul	t5,t4
	move	t2,n.sat		;Start of 1st SAT block in core.
	add	t2,t5
	move	t3,n.satw
	savreg
	pushj	p,write
	resreg
	jrst	updsat

;	Here to update RIBS of special files in SYS UFD.
;	Update consists of putting new disk address of SYS UFD 
;	into the RIBUFD word of these files.
updsuf:	close	inchnl,
	movei	t1,.iodmp		;Specify dump mode.
	move	t2,topk			;Pack copying to.
	setz	t3,			;No inbuf/outbuf in dump mode.

;	Open a channel.
	open	inchnl,t1
	  die(? updsuf: Error trying to open channel.)
	move	t1,n.home+homsat	;SAT.SYS
	pushj	p,updsu2
	move	t1,n.home+homhms	;HOME.SYS
	pushj	p,updsu2
	move	t1,n.home+homswp	;SWAP.SYS
	pushj	p,updsu2
	move	t1,n.home+hommnt	;MAINT.SYS
	pushj	p,updsu2
	move	t1,n.home+hombad	;BADBLK.SYS
	pushj	p,updsu2
	move	t1,n.home+homcrs	;CRASH.EXE
	pushj	p,updsu2
	move	t1,n.home+homrcv	;RECOV.SYS
	pushj	p,updsu2
	pushj	p,wridmp		;Flush output buffers.
	pushj	p,dmpmap		;dump the map into MAP.FIL.
	pushj	p,dmpsat		;dump the sat into SAT.FIL.
	outstr	[asciz/Copy complete.
/]
	exit				;PROGRAM ENDS HERE.

updsu2:	skipn	t1			;Address zero?
	popj	p,			;Yes. Skip it.
	hlrz	t2,t1			;Check for junk word.
	skipe	t2			;Was there junk in left half of word?
	popj	p,			;Yes. Skip it.

;	Here to do the update.
	movei	t2,n.rib		;Where to read the RIB into.
	movei	t3,blksiz		;Size of RIB.
	savreg
	pushj	p,read
	resreg
	move	t4,n.home+homsuf	;New address of SYS UFD.
	movem	t4,n.rib+ribufd
	savreg
	pushj	p,write			;Put it back.
	resreg
	add	t1,n.home+hombpc	;Address of 2nd RIB.
	pushj	p,write			;Write it also.
	popj	p,

	subttl	WRITIT - subprocess of WRTMAP

;	Top level to write single entry pointed to by MAPIDX to new disk.
;	Read RIB of file. Branch to seperate code for directories and 
;	non-directories.

writit:	move	t1,oldcfp(mapidx)	;Address of RIB on old disk.
	movei	t2,o.rib		;Buffer in which to place RIB.
	movei	t3,blksiz		;Size of a RIB.
	pushj	p,bfread			;Read the RIB.

;	Do some security checks to confirm that the MAP is pointing to
;	the correct file on the old disk.
	move	t1,o.rib+ribnam		;Filename in RIB.
	came	t1,name(mapidx)		;Does it match name in MAP entry.
	   die(?WRITIT: Filename in RIB doesn't match that in MAP entry.)
	move	t1,o.rib+ribcod		;Get what should be the RIB code.
	came	t1,[xwd 0,777777]	;Is it?
	   die(?WRITIT: File pointed to by MAP entry is not a RIB.)

;	Is it a directory?
	hllz	t1,ext(mapidx)		;Get file extension.
	camn	t1,[sixbit/UFD/]	;an UFD?
	pjrst(doufd)			;Yes.
	camn	t1,[sixbit/SFD/]	;an SFD?
	pjrst(doufd)			;Yes.
;	Fall through if not a directory.

subttl	DOFILE - a subprocess of WRITIT. Processes Files.

;	Call with:
;	MAPIDX pointing to MAP entry of File being processed by WRITIT.
;	O.RIB has rib of File.
;	Consider all registers used.

;	Update and write the first RIB.
;	Need to get 1st word of 1st block for RIB Retrieval Pointer Checksum.
dofile:	move	t1,oldcfp(mapidx)	;Address of first RIB on old disk.
	aoj	t1,			;Address of first data block.
	movei	t2,o.file
	movei	t3,blksiz
	movem	t1,ribtst		;Save for RIBSLF check later.
	pushj	p,bfread
	move	t1,o.file		;Get 1st word for checksumming.
	movem	t1,n.chks		;Keep it here for routine CHKSUM.

;	If this file has no data, only RIBs, then the block just read
;	for checksumming will be a RIB. In this instance we want a 
;	checksum of zero. The following checks for this.
	move	t1,o.file+ribcod	;The word where a RIB's RIBCOD is.
	move	t2,o.file+ribslf	;The word where a RIB's RIBSLF is.
	camn	t1,[xwd 0,777777]	;Is it a RIBCOD?
	came	t2,ribtst		;And is it a RIBSLF?
	skipa				;Here if NOT a RIB.
	setzm	n.chks			;Yes. Zero the Checksum word.

;	Update RIB.
	pushj	p,updrib		;Called with RIB in O.RIB and MAPIDX
					;pointing to file's entry in MAP.
					;Updated RIB will be in N.RIB.
;	Write RIB.
	move	t1,newcfp(mapidx)	;Prepare to write the first RIB.
	movei	t2,n.rib
	movei	t3,blksiz
	pushj	p,write

;	Process file.
	move	wrtblk,newcfp(mapidx)	;Incrimental keeper of the block
					;address to which we last wrote a
					;block of this file. Initialize to
					;block address of RIB on new disk.
dofil0:	hrrz	t1,o.rib+ribfir		;RIB index to 1st retrieval pointer.
	addi	t1,1			;You just have to do this.
	move	t2,o.rib(t1)		;And get the first pointer.
	pushj	p,brkpto		;Break info out of pointer. Returns
					;t2=block where File starts t3=#blocks,
					;t4=checksum.
	came	t2,o.rib+ribslf		;Confirm that it points to itself.
	  die(?DOFILE: Address from RIB retrieval pointer is bad.)

	aoj	t2,			;The first pointer points to itself,
					;so the File we want follows. Add 1.
	soj	t3,			;Which also means one less block of
					;data for copying.
	savreg
	pushj	p,dofil3		;Process it.
					;First call to DOFIL3 will Update
					;and write the first RIB.
					;Updated RIB will be in N.RIB.
	resreg
dofil1:	addi	t1,1			;Move to next retrieval pointer.
	caile	t1,ribcod		;Check to see it's in bounds.
	  die(?DOFILE: RIB retrieval pointer index out of bounds.)
	cail	t1,ribcod		;Out of pointers?
	jrst	dofilx			;Yes. Check if extended RIB.
	move	t2,o.rib(t1)		;Get next pointer.
	jumpe	t2,dofilx		;Is the retrieval pointer zero?
					;If so, check if RIB is extended.
	pushj	p,brkpto		;No. Get info and process it.
					;Returns t2=File address t3=# blocks.
	savreg
	pushj	p,dofil3		;Process it.
	resreg
	jrst	dofil1			;Loop for next.

;	Here to check for extended RIBs.
dofilx:	skipn	t1,o.rib+ribxra		;Extended?
	jrst	dofil2			;No. Go finish up.
	move	t4,o.rib+ribnam		;Yes. For security check later.
	movei	t2,o.rib		;Prepare to read it.
	movei	t3,blksiz
	savreg
	pushj	p,bfread		;Read the extended RIB.
	resreg
	came	t4,o.rib+ribnam		;Do RIBNAMs match?
	  die(?DOFILX: Extended RIBNAM doesn't match RIBNAM in prime RIB.)
	jrst	dofil0			;And loop to process it.

;	Here when done to write last RIB. Updated copy in N.RIB.
dofil2:	move	t1,wrtblk		;Block address of last block of file.
	aoj	t1,
	movem	t1,n.rib+ribslf		;Adjust RIBSLF word of 2nd RIB to point
					;to itself. Only difference from 1st.
	movei	t2,n.rib		;Location of RIB in core.
	movei	t3,blksiz		;Words to write.
	pushj	p,write			;Doit.
	popj	p,			;Return.

subttl	DOFIL3 - subprocess of DOFILE.

;	Read from old disk and write to new all blocks associated with
;	the RIB retrieval pointer currently being processed by DOFILE.
;	Called with T2=logical block address on old disk first block,
;	and T3=number of blocks to be copied.
;	WRTBLK is block address of where the last block of this file
;	was written on new disk.

dofil3:	move	t1,t2			;Logical block of start of File.
	move	t4,t2			;Compute last block allocated+1.
	add	t4,t3
	movei	t2,o.File		;Where to read File block into.
	movei	t3,blksiz		;How many words.

;	Here to read one block of File.
;	NOTE: t1,t2,t3 and t4 are in use for remainder of this routine.
dofil4:	caml	t1,t4			;Processed the last block?
	popj	p,			;Yes. Return. Get next retrieval ptr.
	savreg				;No.
	movem	t1,ribtst		;Save for RIBSLF check later.
	pushj	p,bfread
	resreg

;	Check to see if we have just read a RIB.
;	If the file doesn't have extended RIBs it will be ours.
;	If the file does have extended RIBs and we are processing the last
;	of the retrieval pointers, it will be ours.
;	If the file does have extended RIBs but we are not processing the
;	last of the retrieval poiters, it will be the 1st RIB of another file.
;	Regardless of whose RIB it is, it will indicate to us that we
;	should return to process the next retrieval pointer.
	move	t5,o.file+ribcod	;The word where a RIB's RIBCOD is.
	move	t6,o.file+ribslf	;The word where a RIB's RIBSLF is.
	camn	t5,[xwd 0,777777]	;Is it a RIBCOD?
	came	t6,ribtst		;And is it a RIBSLF?
	skipa				;Here if NOT a RIB.
	popj	p,			;Yes. Return.

;	Here to write the block out.
	savreg				;Save registers for DOFIL4 loop.
	aoj	wrtblk,
	move	t1,wrtblk		;Where to write this block on new disk.
	movei	t2,o.file		;Location in core of block.
	movei	t3,blksiz		;Words to write.
	pushj	p,write			;Doit.
	resreg				;Restore registers for DOFIL4 loop.
	aoja	t1,dofil4

subttl	DOUFD - a subprocess of WRITIT. Processes UFDs.

;	Call with:
;	MAPIDX pointing to MAP entry of UFD being processed by WRITIT.
;	O.RIB has rib of UFD.
;	Uses t1,t2,t3.

;	Check for special UFDs [1,1] and [1,4].
doufd:	move	t1,o.rib+ribnam		;Check for special cases, [1,4] [1,1].
	setzm	mufd			;Assume not MFD.
	camn	t1,[xwd 1,4]		;Is this it?
	pjrst(dosufd)			;Yes. Goto routine to process it.
	camn	t1,[xwd 1,1]		;Check for special case, [1,1].UFD.
	setom	mufd			;Set [1,1].UFD flag for UPDRIB rtn.

;	Here for directories other than [1,4].ufd
;	Initialize RIBSIZ decrement counter.
	move	t1,o.rib+ribsiz		;Words written in UFD.
	idivi	t1,blksiz		;Make into blocks.
	skipe	t2			;If a remainder,
	  die(?DOUFD: RIBSIZ is not an even factor of block size.)
	movem	t1,totblk		;Keep the decremental counter here.

;	Update and write the first RIB.
;	Need to get 1st word of 1st block for RIB Retrieval Pointer Checksum.
	move	t1,oldcfp(mapidx)	;Address of first RIB on old disk.
	aoj	t1,			;Address of first data block.
	movei	t2,o.file
	movei	t3,blksiz
	movem	t1,ribtst		;Save for RIBSLF check later.
	pushj	p,bfread
	move	t1,o.file		;Get 1st word for checksumming.
	movem	t1,n.chks		;Keep it here for routine CHKSUM.

;	If this UFD has no data, only RIBs, then the block just read
;	for checksumming will be a RIB. In this instance we want a 
;	checksum of zero. The following checks for this.
	move	t1,o.file+ribcod	;The word where a RIB's RIBCOD is.
	move	t2,o.file+ribslf	;The word where a RIB's RIBSLF is.
	camn	t1,[xwd 0,777777]	;Is it a RIBCOD?
	came	t2,ribtst		;And is it a RIBSLF?
	skipa				;Here if NOT a RIB.
	setzm	n.chks			;Yes. Zero the Checksum word.

;	Update RIB.
	pushj	p,updrib		;Called with RIB in O.RIB and MAPIDX
					;pointing to file's entry in MAP.
					;Updated RIB will be in N.RIB.
;	Write RIB.
	move	t1,newcfp(mapidx)	;Prepare to write the first RIB.
	movei	t2,n.rib
	movei	t3,blksiz
	pushj	p,write

;	Process UFD data.
	move	wrtblk,newcfp(mapidx)	;WRTBLK keeps new disk block
					;address to which we last wrote a
					;block of this file. Initialize to
					;block address of RIB on new disk.
	move	maptmp,nxtnod(mapidx)	;@MAPTMP is address of first
					;MAP entry to which current UFD entry
					;being processed by MAPWRT, points.
doufd0:	hrrz	t1,o.rib+ribfir		;RIB index to 1st retrieval pointer.
	addi	t1,1			;You just have to do this.
	move	t2,o.rib(t1)		;And get the first pointer.
	pushj	p,brkpto		;Break info out of pointer. Returns
					;t2=block where UFD starts t3=# blocks,
					;t4=checksum.
	came	t2,o.rib+ribslf		;Confirm that it points to itself.
	  die(?DOUFD: Address from RIB retrieval pointer is bad.)

	aoj	t2,			;The first pointer points to itself,
					;so the UFD we want follows. Add 1.
	soj	t3,			;Which also means one less block of
					;directory information for processing.
	savreg
	pushj	p,doufd3		;Process it.
					;First call to DOUFD3 will update
					;and wrie the first RIB.
					;Updated RIB will be in N.RIB.
	resreg
doufd1:	addi	t1,1			;Move to next retrieval pointer.
	caile	t1,ribcod		;Check to see it's in bounds.
	  die(?DOUFD: RIB retrieval pointer index is out of bounds.)
	cail	t1,ribcod		;Out of pointers?
	jrst	doufdx			;Yes. Check if RIB is extended.
	move	t2,o.rib(t1)		;Get next pointer.
	jumpe	t2,doufdx		;Is the retrieval pointer zero?
					;Yes. Go check if RIB is extended.
	pushj	p,brkpto		;No. Get info and process it.
					;Returns t2=UFD address t3=# blocks,
					;t4=checksum.
	savreg
	pushj	p,doufd3		;Process it.
	resreg
	jrst	doufd1			;Loop for next.

;	Here to check for extended RIBs.
doufdx:	skipn	t1,o.rib+ribxra		;Extended?
	jrst	doufd2			;No. Return.
	move	t4,o.rib+ribnam		;For security check later.
	movei	t2,o.rib		;Yes. Prepare to read it.
	movei	t3,blksiz
	savreg
	pushj	p,bfread		;Read the extended RIB.
	resreg
	came	t4,o.rib+ribnam		;Do RIBNAMs match?
	  die(?DOUFDX: Extended RIBNAM doesn't match RIBNAM in prime RIB.)
	jrst	doufd0			;And loop to process it.

;	Here when done to write last RIB. Updated copy in N.RIB.
doufd2:	move	t1,wrtblk		;Block address of last block of file.
	aoj	t1,
	movem	t1,n.rib+ribslf		;Adjust RIBSLF word of 2nd RIB to point
					;to itself. Only difference from 1st.
	movei	t2,n.rib		;Location of RIB in core.
	movei	t3,blksiz		;Words to write.
	pushj	p,write			;Doit.
	popj	p,

subttl	DOUFD3 - subprocess of DOUFD.

;	Ccalled once for each of the UFD's rib retrieval pointers.
;	Called with t2=logical block number from rib retrieval pointer,
;	and t3=number of blocks from the rib retrieval pointer.
;	Updates each entry in the UFD with new CFP.

doufd3:	skipg	totblk			;Check RIBSIZ decrement counter.
	popj	p,			;We have already read as many blocks
					;in this UFD as are actually used.
					;The RIB retrieval pointer we have
					;been asked to process must be the
					;result of an Uncompressed RIB, and
					;hence is not really in use. Skip it.

;	Here if we haven't read all the blocks in the UFD yet.
	move	t1,t2			;Logical block of start of data.
	move	t4,t2			;Compute last block allocated+1.
	add	t4,t3
	movei	t2,o.ufd		;Where to read UFD block into.
	movei	t3,blksiz		;How many words.

;	Here to read one block of UFD.
;	note: t1,t2,t3,t4 are in use for balance of routine.
doufd4:	caml	t1,t4			;Processed the last blk of this ptr?
	popj	p,			; Yes. Return to get next retrieval ptr.
	sosge	totblk			;Decrement blocks read counter by one.
	popj	p,			; Have we read all the used blocks in
					; in the UFD? Return.
	savreg				;No. Continue.
	pushj	p,bfread
	resreg

;	Here to process the block of the UFD just read.
	setz	t5,			;Index to entries in UFD.
doufd5:	caile	t5,blksiz-2		;Finished this block? 2 words/entry.
	jrst	doufd7			;Yes. Go write this block to new disk.
	move	t6,o.ufd(t5)		;Get sixbit filename from UFD entry.
	jumpe	t6,doufd7		;Zero, meaning no more data in block?

;	Here if with t5 pointing to UFD block entry to be updated.
;	Update the entry with MAP entry pointed to by MAPTMP.
;	Check that the FileNames correspond for added security.
doufd6:	came	t6,name(maptmp)		;Same as in MAP entry?
	  die(?DOUFD6: UFD entry in MAP does not correspond with UFD block.)
	aoj	t5,
	hlrz	t6,ext(maptmp)		;File Exntension from MAP entry.
	hlrz	t7,o.ufd(t5)		;File Extension from UFD.
	came	t6,t7			;Same?
	   die(?DOUFD6: UFD entry in MAP does not correspond with UFD block.)
	move	t6,newcfp(maptmp)	;File's block address on new disk.
	idiv	t6,n.home+hombpc	;Covert to CFP.
	skipe	t7			;Remainder from division?
	  die(?DOUFD6: Conversion of block address to CFP not exact.)
	hrrm	t6,o.ufd(t5)		;Update UFD pointer to file.
	addi	maptmp,mapsiz		;Next entry in MAP.
	aoja	t5,doufd5		;Next entry in UFD block.

;	Here to write out updated UFD block.
doufd7:	savreg				;Save registers for DOUFD4 loop.
	aoj	wrtblk,
	move	t1,wrtblk		;Where to write this block on new disk.
	movei	t2,o.ufd		;Location in core of block.
	movei	t3,blksiz		;Words to write.
	pushj	p,write			;Doit.
	resreg				;Restore registers for DOUFD4 loop.
	aoja	t1,doufd4

	subttl	DOSUFD - a subprocess of WRITIT. Processes [1,4].UFD only.

;	Call with:
;	MAPIDX pointing to the [1,4].UFD entry in MAP.
;	O.RIB has the [1,4].UFD RIB.
;	WRTBLK is block address of where the 1st RIB will be on new disk.
;	Uses all registers.
;	t1 and t2 are dedicated indexes, not to destroyed in this routine.

;	Update and write the first RIB.
;	Need to get 1st word of 1st block for RIB Retrieval Pointer Checksum.
dosufd:	move	t1,oldcfp(mapidx)	;Address of first RIB on old disk.
	aoj	t1,			;Address of first data block.
	movei	t2,o.file
	movei	t3,blksiz
	movem	t1,ribtst		;Save for RIBSLF check later.
	pushj	p,bfread
	move	t1,o.file		;Get 1st word for checksumming.
	movem	t1,n.chks		;Keep it here for routine CHKSUM.

;	If the SYS UFD has no data, only RIBs, then the block just read
;	for checksumming will be a RIB. In this instance we want a 
;	checksum of zero. The following checks for this.
	move	t1,o.file+ribcod	;The word where a RIB's RIBCOD is.
	move	t2,o.file+ribslf	;The word where a RIB's RIBSLF is.
	camn	t1,[xwd 0,777777]	;Is it a RIBCOD?
	came	t2,ribtst		;And is it a RIBSLF?
	skipa				;Here if NOT a RIB.
	setzm	n.chks			;Yes. Zero the Checksum word.

;	Update RIB.
	pushj	p,updrib		;Called with RIB in O.RIB and MAPIDX
					;pointing to file's entry in MAP.
					;Updated RIB will be in N.RIB.
;	Write RIB.
	move	t1,newcfp(mapidx)	;Prepare to write the first RIB.
	movei	t2,n.rib
	movei	t3,blksiz
	pushj	p,write

;	Process SYS UFD data.
	move	wrtblk,newcfp(mapidx)	;WRTBLK keeps new disk block
					;address to which we last wrote a
					;block of this file. Initialize to
					;block address of RIB on new disk.
	setz	t2,			;Find 1st free filename position
dosuf1:	skipe	n.sufd(t2)		;in N.SUFD.
	aoja	t2,dosuf1		;Failed, try next word.
	cail	t2,blksiz-2		;Check to see the word's in bounds.
	  die(?DOSUFD: N.SUFD has no free words in it.)
	move	maptmp,nxtnod(mapidx)	;First entry pointed to by [1,4].
	hrrz	t1,ext(mapidx)		;Number of entries.

dosuf2:	sosge	t1			;For each of [1,4]'s entries do:
	jrst	dosuf6			;Here when done. Go finish up.
	pushj	p,dosuf3		;Add entry to UFD block being built.
	addi	maptmp,mapsiz		;Point to next [1,4] entry.
	jrst	dosuf2			;Go process it.

;	Here to add [1,4] entry pointed to by MAPTMP to UFD block.
dosuf3:	caile	t2,blksiz-2		;This UFD block full?
	pushj	p,dosuf4		;Yes. Write the block out, reset
					;index t2, and zero out N.SUFD.
	move	t3,name(maptmp)		;File name.
	movem	t3,n.sufd(t2)		;Put in UFD block.
	aoj	t2,			;Incriment index to extension word.
	move	t3,newcfp(maptmp)	;File's address on new disk.
	idiv	t3,n.home+hombpc	;Change to a Compressed File Ptr.
	skipe	t4			;A remainder from division?
	  die(?DOSUFD: Conversion from block address to CFP not exact.)
	hll	t3,ext(maptmp)		;and the File extension.
	movem	t3,n.sufd(t2)		;Add to UFD block.
	aoj	t2,			;Incriment index to next entry.
	popj	p,			;Return.

;	Here to write out N.SUFD when it has become full.
;	Also resets index t2 to zero, and zeroes the N.SUFD.
dosuf4:	savreg				;Save registers for DOSUF2, DOSUF3.
	aoj	wrtblk,
	move	t1,wrtblk		;Where on new disk to write this block.
	movei	t2,n.sufd		;Blocks location in core.
	movei	t3,blksiz		;Number of words to write.
	pushj	p,write			;Doit.
	resreg				;Restore registers for DOSUF2, DOSUF3

	setzm	n.sufd			;Zero out N.SUFD buffer.
	hrli	t2,n.sufd		;Prepare for BLT.
	hrri	t2,n.sufd+1
	blt	t2,n.sufe		;Zero through to end word.
	setz	t2,			;Reset buffer index to top.
	popj	p,

;	Here when done to write current contents of N.SUFD and
;	to write last RIB.
dosuf6:	pushj	p,dosuf4		;Write out contents of N.SUFD.
;	Now the RIB.
	move	t1,wrtblk		;Block address of last block of file.
	aoj	t1,
	movem	t1,o.rib+ribslf		;Adjust RIBSLF word of 2nd RIB to point
					;to itself. Only difference from 1st.
	movei	t2,o.rib		;Location of RIB in core.
	movei	t3,blksiz		;Words to write.
	pushj	p,write			;Doit.
	popj	p,

	subttl	Data Storage

totblk:	block	1	;Use for counting blocks read of a UFD.
foo:	block	1
Ribtst:	block	1	;Temp word used for checking if a block is a RIB.
Frompk:	block	1	;Name of pack copying from.
Topk:	block	1	;Name of pack copying to.
ToPkId:	block	1	;I.D. of pack copying to.
maxfil:	block	1	;Used to determine if a file is too large for D2D.
map:	block	1	;Will contain starting address of core map.
pdlist:	block	pdlen	;Push down stack.
sufd:	block	1	;Flag to indicate to MAP builder that 
			;SYS.UFD ([1,4]) is being processed (nonzero).
mufd:	block	1	;Flag to indicate to UPDRIB rtn that [1,1].UFD is
			;bein processed.
outbuf:	block	1	;Pointer to top of free core used for buffering
			;output to target disk.
			;WARNING: nothing should be placed in free core
			;after the point to which this word points.
topblk:	block	1	;Logical disk address on new pack of first block
			;of data in buffer area pointed to by OUTBUF.
inblks==^d3		;Number of blocks in INBUF.
inbuf:	block	inblks*blksiz	;Pointer to Input buffer used by BFREAD.
inaddr:	-1		;Logical disk address on first block of data
			;in INBUF.

;	The following apply to the old pack from which data is being copied.
o.home:	block	blksiz	;For reading in HOME block.
o.rib:	block	blksiz	;For reading in RIBs.
o.file:	block	blksiz	;For reading in data portion of files.
o.ufd:	block	blksiz	;For reading in UFDs.
o.ribp:	block	1	;RIB retrieval pointer word.
o.ptra:	xwd	0,o.ribp	;Point to cluster add in retrieval pointer.
o.ptrc:	xwd	0,o.ribp	;Point to cluster count in retrieval pointer.
o.ptrs:	xwd	0,o.ribp	;Point to checksum in retrieval pointer.

;	The following apply to the new pack to which data is being copied.
n.home:	block	blksiz	;For reading in HOME block.
n.rib:	block	blksiz	;For building new RIBs from old ones.
n.satr:	block	blksiz	;For target packs SAT.SYS RIB.
n.tmp:	block	1	;Misc. read-in's.
n.ribp:	block	1	;RIB retrieval Pointter word.
n.ptra:	xwd	0,n.ribp	;PoinTR to cluster Address in RIBP.
n.ptrc:	xwd	0,n.ribp	;PoinTR to cluster Count in RIBP.
n.ptrs:	xwd	0,n.ribp	;PoinTR to checksum in RIBP.
n.sufd:	block	blksiz		;For building a System UFD block for new disk.
				;[1,4].ufd is treated seperately because of
				;certain files there not be be copied.
n.sufe:	.-1			;Last word of N.SUFD.
n.chks:	block	1		;For computing checksums.

;	The following refer to the New pack's SAT which is built in-core.
n.sat:	block	1	;Permanent pointer to in-core SAT.
n.satt:	block	1	;SAT Top. Address of 1st word in-core SAT with
			;free clusters. May move as space allocation proceeds.
n.dska:	block	50	;DiSK Address. c(N.DSKA+n) is the
			;logical block address of the first cluster pointed to
			;by SAT block n.
n.sate:	block	1	;SAT End. Address of last word in-core SAT.
n.satw:	block	1	;SAT Words. Number of words in each SAT block 
			;that are actually used to represent clusters.
			;used to respresent clusters.
n.satp:	point	1,0	;Used for marking single bits(one cluster) in SAT.
n.bckp:	block	1	;BaCKPointer will be built here.
			;It will be a pointer into the SAT area used to
			;mark the Back or start of a contiguos group of
			;free cluster pointers.
n.fwdp:	block	1	;ForWarDPointer will be built here.
			;It will be a pointer into the SAT area used to
			;search forward from where the BaCKPointer points
			;to determine if there are a enough contiguous
			;clusters to meet the request made on routine ALLOC.
n.satb:	block	1	;Blocks per SAT on new pack.

	end	d2d	;Show where to start execution.