	.text

	bra	begin

******************************************************************************
*									     *
*           This section is entered during event_timer interrupts            *
*									     *
******************************************************************************

start:	

	movem.l	d0-d7/a0-a7,-(sp)
	move.w	sr,-(sp)
	ori.w	#$700,sr

	clr.l	d0
	cmpi.l	#$0,tfile	; if 1st 4 bytes at tfile are 0 then no
	beq	more		; existing work so check for more.  Otherwise
	
	cmpi.l	#$0,byteso	; if no more bytes to send
	ble	newbuf		; then refill buffer (goto newbuf).  Otherwise,

cont:	move.w	#$18,d5		; Loop 24 times max trying to print 3 chars
V1:	move.l	bufptr,a6	; print a character of text
	move.b	(a6)+,d4
	bsr	put
	tst.l	d0		; If no character was sent then forget it
	blt	out6		; and try again.  Otherwise,

	subq.l	#$1,byteso	; subtract one from byteso,
	subq.l	#$1,fsize	; subtract one from file size
	move.l	a6,bufptr	; update buffer pointer
	cmpi.l	#$0,byteso	; If the buffer is empty
	ble	out		; then break out of the loop

out6:	tst.w	d5		; Otherwise, try again
	dbeq	d5,V1		; 
	bra	out

newbuf:	move.l	clust,d0	
	cmpi.l	#$FF0,d0	; If this cluster is illegal or the last one
	bge	nextf		; then get next file.  Otherwise,

	move.l	d0,d3
	bsr	nextcl		; compute the next cluster to get.
	cmpi.w	#$1,d0		; If next cluster is 1 or 0 then
	ble	nextf		; get next file, if any.  Otherwise,

	move.l	d0,clust	; save next cluster and
	move.l	d3,d0
	bsr	trans		; transfer 1k to buffer from cluster in d0
	
	move.l	#$400,byteso	; If more than 1k left to transfer 
	cmpi.l	#$400,fsize	; then set byteso to 1k otherwise
	bgt	full
	move.l	fsize,byteso	; set byteso to number of bytes left 
full:	move.l	#buffer,bufptr	; Set  bufptr.

	bra	out

more:	move.l	$42E,a0		; Check if we think that pqueue.tmp exists.
	move.b	-(a0),d0
	move.b	d0,d1
	andi.l	#$2,d0
	tst.w	d0
	beq	out		; If we don't think so then leave.
	andi.l	#$1,d1
	tst.w	d1
	bne	out

	move.l	#tlext,a0	; Open pqueue.tmp
	bsr	findf
	move.l	a0,qfadd	; file descriptor address
	move.l	d1,qclus	; cluster start
	move.l	size,qsize	; size of pqueue.tmp (bytes)

	tst.w	d0		; If it does not exist then leave 
	bmi	non		; Otherwise,

	cmpi.l	#$4,qsize	; if the number of bytes in queue.tmp is less 
	bmi	erasp		; than 4 then erase pqueue.tmp.  Otherwise,

	move.l	qclus,d0	; pqueue.tmp cluster number is parameter
	bsr	compcl		; compute pqueue.tmp cluster address (a0)
	move.l	#tfile,a1	; a1 has the address of the tfile_name buffer
	move.l	#$B,d1		; set up loop to transfer 12 bytes
B1:	move.b	(a0)+,(a1)+	; Transfer bytes
	tst.l	d1
	dbeq	d1,B1

	move.b	#$0,(a1)+	; straighten up tfile so it terminates with 0
	move.b	#$0,(a1)+

	move.l	#tfile,a0	; locate the tfile
	bsr	findf
	tst.w	d0		; If the file specified has some problem
	bmi	nextf		; then branch to error.  Otherwise,

	move.l	a0,descrp	; save the file descriptor address,
	move.l	d1,clust	; save the first cluster location, and
	move.l	size,fsize	; save file size.
	bra	out		; Branch to out (with the file name in tfile).

nextf:	move.l	#$C,d4		; Form feed.
	bsr	put

	move.l	#tfile,a0	; Delete the text file.
	bsr	findf
	move.b	#$E5,(a0)
	move.l	d1,d0
AA1:	cmpi.w	#$0,d0
	beq	zf
	cmpi.w	#$FF0,d0
	bge	zf
	bsr	erascl
	bra	AA1

zf:	move.l	#tfile,a0	; Zero out the tfile field.
	move.l	#$0,(a0)

	move.l	$42E,a0		; Check if we think that pqueue.tmp exists.
	move.b	-(a0),d0
	move.b	d0,d1
	andi.l	#$2,d0
	tst.w	d0
	beq	out		; If we don't think so then leave.
	andi.l	#$1,d1
	tst.w	d1
	bne	out		; leave if it is

	move.l	#tlext,a0	; Open pqueue.tmp
	bsr	findf
	move.l	a0,qfadd	; file descriptor address
	move.l	d1,qclus	; cluster start
	move.l	size,qsize	; size of pqueue.tmp (bytes)

	tst.w	d0		; If pqueue.tmp does not exist
	bmi	non		; then leave.
	
	move.l	qsize,d2	; Set up to remove first record.
	sub.l	#$E,d2		; d1 has the number of bytes to transfer.
	cmpi.l	#$4,d2		; If print queue file is empty then 
	bmi	erasp		; branch to cleanup routine.  Otherwise,

	move.l	d2,qsize	; Remove first record of pqueue.tmp:
	sub.l	#$1,d2
	move.l	qclus,d0	; pqueue.tmp cluster number is parameter
	bsr	compcl		; compute pqueue.tmp cluster address (a0)
	movea.l	a0,a1		; a0 points to the beginning of pqueue.tmp
	add.l	#$E,a1		; a1 points to beginning of 2nd record
B2:	move.b	(a1)+,(a0)+	; Move bytes.
	tst.l	d2
	dbeq	d2,B2		; Result: erase first record in pqueue.tmp

	movea.l	#qsize,a1	; Record new size for file pqueue.tmp.
	movea.l	qfadd,a0	; a1 points to pqueue.tmp size field.
	add.l	#32,a0		; a0 points to end of pqueue.tmp descriptor.
	move.b	(a1)+,-(a0)
	move.b	(a1)+,-(a0)
	move.b	(a1)+,-(a0)
	move.b	(a1)+,-(a0)

	move.l	$42E,a0
	move.b	-(a0),d0	; record the fact that pqueue.tmp exists
	ori.b	#$2,d0
	move.b	d0,(a0)
	bra	out		; and leave.

erasp:	move.l	#tlext,a0	; Delete the text file.
	bsr	findf
	move.b	#$E5,(a0)
	move.l	d1,d0
Q1:	cmpi.w	#$0,d0
	beq	non
	cmpi.w	#$FF0,d0
	bge	non
	bsr	erascl
	bra	Q1

non:	move.l	$42E,a0
	move.b	-(a0),d0	; Record the fact that pqueue.tmp is gone.
	move.b	#$4,d0
	move.b	d0,(a0)

out:	
	move.w	(sp)+,sr
	movem.l	(sp)+,d0-d7/a0-a7

	move.l	event,a3	; load event_timer vector
	jmp	(a3)		; jump to event_timer handler

*******************************************************************************
*									      *
*    This section is entered on trap 13 calls (to handle bconout and stat)    *
*									      *
*******************************************************************************

trap:	move.w	sr,-(sp)
	ori.w	#$700,sr

	move.l	#stack,stack
	move.l	a0,tmpa0
	movea.l	stack,a0
	move.l	tmpa0,-(a0)
	move.l	d0,-(a0)
	move.w	(a7),d0
	move.w	(a7)+,-(a0)
	move.l	(a7)+,-(a0)
	movem.l	d1-d7/a1-a7,-(a0)
	move.l	a0,stack

	btst	#$D,d0		; Check if supervisor mode
	bne	hit		; if so continue
	move.l	usp,a7		; Otherwise make user stack

hit:	move.w	(a7),d0		; The function number is in d0
	cmp.w	#$3,d0		; If the function is not bconstat 
	bne	hit1		; then continue checking for bconout
	tst.w	$2(a7)
	bne	out2		; If the device is not printer, continue
	move.l	$42E,a0		; Otherwise,
	move.b	-(a0),d3
	move.b	d3,d4
	andi.l	#$2,d3
	tst.w	d3		; if pqueue.tmp exists
	bne	out3		; then return from exception
	andi.l	#$1,d4		; if pqueue.tmp busy
	tst.w	d4
	bne	out3		; then return from exception
	bra	out2		; Otherwise continue with trap

hit1:	cmp.w	#$8,d0		; If the function is not bconout 
	bne	out2		; then continue with trap
	tst.w	$2(a7)
	bne	out2		; If the device is not printer, continue
	move.l	$42E,a0		; Otherwise
	move.b	-(a0),d3
	move.b	d3,d4
	andi.l	#$2,d3
	tst.w	d3		; if pqueue.tmp exists
	bne	out3		; then return from exception
	andi.l	#$1,d4
	tst.w	d4		; if pqueue.tmp is busy
	bne	out3		; then return from exception
	bra	out2		; Otherwise continue with trap

out2:	movea.l	stack,a0
	movem.l	(a0)+,d1-d7/a1-a7
	move.l	(a0)+,-(a7)
	move.w	(a0)+,-(a7)
	move.l	(a0)+,d0
	move.l	(a0)+,a0
	move.w	(sp)+,sr
	movea.l	trapv,a0
	jmp	(a0)

out3:	movea.l	stack,a0
	movem.l	(a0)+,d1-d7/a1-a7
	move.l	(a0)+,-(a7)
	move.w	(a0)+,-(a7)
	move.l	(a0)+,d0
	move.l	(a0)+,a0
	move.w	(sp)+,sr
	move.l	#$0,d0
	rte
	
*******************************************************************************
*									      *
*	Routine to write a character to the centronics port.  The character   *
*	is placed in d4.  Only d0, d4 and a0 are affected by this call.       *
*       Returns immediately if the centronics port is busy (character not     *
*       printed).							      *
*									      *
*	Input:	d4 - character to print					      *
*									      *
*	Output: d0 - -1 if the character is not printed			      *
*									      *
*	Modifies:	d0,d4,a0					      *
*									      *
*******************************************************************************

put:	move.w	sr,-(sp)	; disable interrupts
	ori.w	#$700,sr
	move.l	#-$1,d0		; default status is fail 

	move.l	#$FFFFA01,a0
	btst.b	#$0,0(a0)
	bne	nope

	move.l	#$FFFF8800,a0	; sound chip register address

	move.b	#$7,(a0)	; select register 7 
	clr.l	d0
	move.b	(a0),d0		; read status byte to d0
	ori.b	#$80,d0		; 8th bit set to high (write to centronics)

	move.b	#$7,(a0)	; select register 7
	move.b	d0,2(a0)	; write new status byte to sound chip

	move.b	#$F,(a0)	; select register 15 (B port)
	move.b	d4,2(a0)	; write character to address

	move.b	#$E,(a0)	; read register 14
	clr.l	d0
	move.b	(a0),d0
	andi.b	#$DF,d0		; set strobe bit to low
	move.b	#$E,(a0)	; write to register 14 (setting strobe low)
	move.b	d0,2(a0)

	move.b	#$E,(a0)	; read register 14
	clr.l	d0
	move.b	(a0),d0
	ori.b	#$20,d0		; set strobe bit to high
	move.b	#$E,(a0)	; write to register 14
	move.b	d0,2(a0)

	move.l	#$0,d0		; status set to succeed

nope:	move.w	(sp)+,sr	; enable interrupts

	rts


*******************************************************************************
*									      *
*	Compute the absolute address of a ramdisk cluster		      *
*									      *
*	Input:	d0 - the cluster number					      *
*									      *
*	Output:	a0 - the cluster absolute address			      *
*									      *
*******************************************************************************

compcl:	move.l	d0,d1
	sub.l	#2,d1
	lsl.l	#$8,d1
	lsl.l	#$2,d1
	add.l	datast,d1	; Cluster Address = (d0-2)*1024 + data_start
	movea.l	d1,a0

	rts


*******************************************************************************
*									      *
*	Transfer data from a cluster on RD to the text buffer		      *
*									      *
*	Input:	d0 - cluster number to transfer				      *
*									      *
*	Output:	none							      *
*									      *
*******************************************************************************

trans:	cmpi.l	#$FF0,d0	; if cluster number is greater than $FF0 then
	bge	M1		; we are finished 

	bsr	compcl		; compute cluster absolute address (a0)

	move.w	#$1F,d1		; transfer 1024 bytes quickly (assume even
	move.l	#buffer,a1	; address boundary)
M2:	move.l	(a0)+,(a1)+
	move.l	(a0)+,(a1)+
	move.l	(a0)+,(a1)+
	move.l	(a0)+,(a1)+
	move.l	(a0)+,(a1)+
	move.l	(a0)+,(a1)+
	move.l	(a0)+,(a1)+
	move.l	(a0)+,(a1)+
	tst.w	d1
	dbeq	d1,M2
	
M1:	rts

*******************************************************************************
*									      *
*	Compute the next cluster in a chain of FAT entries		      *
*									      *
*	Input:	d0 - Current cluster number				      *
*									      *
*	Output:	d0 - Contains the next cluster in the chain		      *
*									      *
*	Uses:	fatst - the absolute address of the start of the ramdisk FAT  *
*									      *
*	Modifies:	d0,d1,a0					      *
*									      *
*******************************************************************************

nextcl:	move.l	fatst,a0
	btst	#$0,d0		; if d0 is even
	beq	even2		; then branch

odd2:	move.l	d0,d1
	lsl.l	#$1,d1
	add.l	d1,d0		; d0 is multiplied by 3
	lsr.l	#$1,d0		; d0 is divided by 2
	add.l	d0,a0		; a0 has absolute address of low cluster byte
	move.b	(a0)+,d0	; d0 has next cluster low byte
	lsr.l	#$4,d0		; first 4 bits of d0 contain low 4 bits of clus
	andi.l	#$F,d0		; mask out anything else
	move.b	(a0),d1		; d1 has next cluster high byte
	lsl.l	#$4,d1		; move it left by 4 bits
	or.l	d1,d0		; combine high and low bytes into d0
	andi.l	#$FFF,d0	; get rid of any junk

	rts

even2:	move.l	d0,d1
	lsl.l	#$1,d1
	add.l	d1,d0		; d0 is multiplied by 3
	lsr.l	#$1,d0		; d0 is divided by 2
	add.l	d0,a0		; a0 has absolute address of low cluster byte
	move.b	(a0)+,d0	; d0 has next cluster low byte
	andi.l	#$FF,d0		; mask out anything else
	move.b	(a0),d1		; d1 has next cluster high byte
	lsl.l	#$8,d1		; move it left by 8 bits
	or.l	d1,d0		; combine high and low bytes into d0
	andi.l	#$FFF,d0	; get rid of any junk

	rts


*******************************************************************************
*									      *
*	Compute the next cluster in a chain of FAT entries and zero it	      *
*									      *
*	Input:	d0 - Current cluster number				      *
*									      *
*	Output:	d0 - Contains the next cluster in the chain		      *
*									      *
*	Uses:	fatst - the absolute address of the start of the ramdisk FAT  *
*									      *
*	Modifies:	d0,d1,d2,a0,a1					      *
*									      *
*******************************************************************************

erascl:	move.l	fatst,a0	; a0 has the absolute start address of 2nd FAT
	move.l	$42E,a1
	add.l	#$400,a1	; a1 has the absolute start address of 1st FAT
	btst	#$0,d0		; if d0 is even
	beq	even1		; then branch

odd1:	move.l	d0,d1
	lsl.l	#$1,d1
	add.l	d1,d0		; d0 is multiplied by 3
	lsr.l	#$1,d0		; d0 is divided by 2
	add.l	d0,a0		; a0 has absolute address of low cluster byte
	add.l	d0,a1		; a1 has same for 1st FAT
	move.b	(a0),d0		; d0 has next cluster low byte
	move.b	d0,d1
	andi.b	#$0F,d1		; zero out the low 4 bits
	move.b	d1,(a0)+	; in 2nd FAT
	move.b	d1,(a1)+	; and in 1st FAT
	lsr.l	#$4,d0		; first 4 bits of d0 contain low 4 bits of clus
	andi.l	#$F,d0		; mask out anything else
	move.b	(a0),d1		; d1 has next cluster high byte
	move.b	#0,(a0)		; zero out the high byte in 2nd FAT
	move.b	#0,(a1)		; zero out the high byte in 1st FAT
	lsl.l	#$4,d1		; move it left by 4 bits
	or.l	d1,d0		; combine high and low bytes into d0
	andi.l	#$FFF,d0	; get rid of any junk

	rts

even1:	move.l	d0,d1
	lsl.l	#$1,d1
	add.l	d1,d0		; d0 is multiplied by 3
	lsr.l	#$1,d0		; d0 is divided by 2
	add.l	d0,a0		; a0 has absolute address of low cluster byte
	add.l	d0,a1		; same for 1st FAT
	move.b	(a0),d0		; d0 has next cluster low byte
	move.b	#0,(a0)+	; zero out the low byte in 2nd FAT
	move.b	#0,(a1)+	; zero out the low byte in 1st FAT
	andi.l	#$FF,d0		; mask out anything else
	move.b	(a0),d1		; d1 has next cluster high byte
	move.b	d1,d2
	andi.b	#$F0,d2		; zero out the high 4 bits
	move.b	d2,(a0)		; update byte in 2nd FAT
	move.b	d2,(a1)		; update byte in 1st FAT
	lsl.l	#$8,d1		; move it left by 8 bits
	or.l	d1,d0		; combine high and low bytes into d0
	andi.l	#$FFF,d0	; get rid of any junk

	rts


*******************************************************************************
*									      *
*	Find a file in the ramdisk root directory, get address and info       *
*									      *
*	Inputs: a0 - name of file to compare against			      *
*									      *
*	Output:	d0 - -1 if file not found, otherwise meaningless	      *
*		d1 - cluster number of first cluster of file		      *
*		a0 - start (ram) address of file description in directory     *
*		size - long word memory location with file size		      *
*									      *
*	Uses:	rootst - absolute address of start of root directory	      *
*		size   - see above					      *
*									      *
*	Modifies:	d0,d1,d2,a1,a2,a3,a4				      *
*									      *
*******************************************************************************

findf:	move.l	#$6F,d0		; repeat the follwing $DF times (max number)
	move.l	rootst,a2	; (once for each possible file descriptor)

L1:	move.l	a2,a1		; let a1 have rootst and a4 have filename
	move.l	a0,a4		; repeat the following (once for each 
	move.w	#$7,d1		; character in filename)

L2:	cmp.b	(a1)+,(a4)+	; compare characters of filename with descript
	bne	O1		; if some character is not equal, try another
	tst.w	d1		; descriptor
	dbeq	d1,L2
	move.l	a2,a0		; if all characters matched then file found
	add.l	#26,a2		; so locate the first cluster bytes 
	move.b	(a2)+,d1	; and save them in d1
	move.b	(a2)+,d2
	lsl.l	#$8,d2
	or.l	d2,d1
	andi.l	#$FFFF,d1
	move.l	#size,a3
	addq.l	#$4,a2
	move.b	-(a2),(a3)+	; locate file size and save in d0
	move.b	-(a2),(a3)+
	move.b	-(a2),(a3)+
	move.b	-(a2),(a3)+
	rts
O1:	add.l	#$20,a2		; 32 bytes is a descriptor length
	tst.w	d0		; if we have not considered all descriptors
	dbeq	d0,L1		; then go back and consider the next one
	move.l	#-1,d0		; otherwise return code for failure
	rts

	.bss

*******************************************************************************
*									      *
*   Data area.  Meanings are as follows:				      *
*									      *
*   trapv:  - new trap 13 vector					      *
*   supsav: - save the system stack pointer when entering SUPER mode here.    *
*   tmpa0:  - temporary save area for a0 in trap 13 routine		      *
*   bufptr: - pointer to the buffer area				      *
*   byteso: - number of bytes in buffer left to transmit to printer.	      *
*   size:   - save file size here (no. bytes) when using findf subroutine     *
*   fsize:  - size gets moved here after finding a text file		      *
*   qsize:  - size gets moved here after finding pqueue.tmp		      *
*   descrp: - absolute address of text file root directory descriptor         *
*   clust:  - current cluster number being transfered			      *
*   qclus:  - cluster in which pqueue.tmp currently is			      *
*   qfadd:  - absolute address of pqueue.tmp root directory descriptor	      *
*   rootst: - absolute address of start of root directory of ramdisk	      *
*   fatst:  - absloute address of start of FAT of ramdisk		      *
*   datast: - absolute address of start of data area in ramdisk		      *
*   event:  - new event_timer vector					      *
*   buffer: - file transfer buffer for creating temporary files.              *
*   empty:  - curently unused						      *
*   pfile:  - space for *.prt file being printed			      *
*   tfile:  - same as above except drive descriptor is missing		      *
*   tlname: - name of the file containing the print queue.		      *
*   tlext:  - same as above except drive descriptor is missing		      *
*   qfile:  - another way to write 'pqueue.tmp' 			      *
*   reserv: - boundary of a local stack needed below			      *
*									      *
*******************************************************************************

trapv:	.ds.l	$1
supsav:	.ds.l	$1
tmpa0:	.ds.l	$1
bufptr:	.ds.l	$1
byteso:	.ds.l	$1
size:	.ds.l	$1
fsize:	.ds.l	$1
qsize:	.ds.l	$1
descrp:	.ds.l	$1
clust:	.ds.l	$1
qclus:	.ds.l	$1
qfadd:	.ds.l	$1
rootst:	.ds.l	$1
fatst:	.ds.l	$1
datast:	.ds.l	$1
event:	.ds.l	$1
quhand:	.ds.w	$1
buffer:	.ds.b	$402

	.data

empty:	.dc.w	0
pfile:	.dc.b	'm:'
tfile:	.dc.b	0,0,0,0,0,0,0,0,0,0,0,0,0,0
tlname:	.dc.b	'm:'
tlext:	.dc.b	'PQUEUE  .TMP',0
qfile:	.dc.b	'm:pqueue.tmp',0
qufil:	.dc.b	'm:spool.ttp',0
text:	.dc.b	'Spooler already installed',$D,$A,0
text1:	.dc.b	'ETERNAL Ramdisk cannot be found',$D,$A,0
ccsp:	.dc.b	'Cannot create SPOOL.PRG',$D,$A,0
cwsp:	.dc.b	'Cannot write SPOOL.PRG',$D,$A,0,0

	.bss

reserv:	.ds.l	$400
stack:	.ds.l	$1

******************************************************************************
*									     *
*   This section installs the spooler and sets up some spooler parameters.   *
*   The program 'queue.prg' is written to the ramdisk.                       *
*									     *
******************************************************************************

	.text

begin:	clr.l	-(sp)		; switch to supervisor mode
	move.w	#$20,-(sp)
	trap	#1
	addq.l	#$6,sp

	move.l	d0,supsav	; save old stack pointer

	move.l	$42E,a0		
	move.w	(a0),d0
	cmpi.w	#$200,d0
	beq	etern		; If the eternal ramdisk is there then continue

	move.l	#text1,d0	; otherwise display message
	bsr	up
	bra	quit		; and leave.

etern:	move.b	-(a0),d0	 
	andi.l	#$4,d0
	tst.w	d0
	beq	all		; If spooler does not exist then continue

	move.b	#$6,d0		; set 'pqueue.tmp exists' bit
	move.b	d0,(a0)		; display message
	move.l	#text,d0
	bsr	up	
	bra	quit		; and leave

all:	movea.l	sp,a5		; COMPUTE LENGTH OF PROGRAM
	movea.l	$4(a5),a5	; address is $100 bytes below base page
	move.l	$C(a5),d0	; length of program area
	add.l	$14(a5),d0	; add length of initialized data area
	add.l	$1C(a5),d0	; add length of uninitialized data area
	add.l	#$500,d0	; reserve base page space
	move.l	d0,d1		; length of reserved area in d1 and d0

	add.l	a5,d1		; $100 bytes below b.p. + program length
	and.l	#$FFFFFFFE,d1	; even out address
	movea.l	d1,sp		; stack begins at top of program
	move.l	d0,d6		; save for later

	move.l	d0,-(sp)	; length
	move.l	a5,-(sp)	; start of area to reserve
	clr.w	-(sp)
	move.w	#$4A,-(sp)	; SETBLOCK
	trap	#1
	add.l	#$C,sp

	move.l	#$0,bufptr
	move.l	#$0,byteso	; initialize number of bytes left to zero

	move.l	$42E,a0		; 
	move.l	a0,a1		;
	add.l	#$6,a1		;
	clr.l	d0
	clr.l	d1
	clr.l	d2
	clr.l	d3
	move.w	(a1)+,d0	; d0 has root directory length in sectors
	move.w	(a1)+,d1	; d1 has fat length in sectors
	move.w	(a1)+,d2	; d2 has fat start (sector number)
	move.w	(a1)+,d3	; d3 has data area start (sector number)
	add.l	#$200,a0	; add 512 byte displacement to beginning of RD
	move.l	a0,a1		;
	lsl.l	#$8,d2		; d2 has fat start in bytes from RD beginning
	lsl.l	#$1,d2		; d2 has fat start in bytes from RD beginning
	add.l	d2,a0		; address of fat in a0
	move.l	a0,fatst	; fatst has address of fat start
	lsl.l	#$8,d1		; d1 has length of fat in bytes
	lsl.l	#$1,d1		; d1 has length of fat in bytes
	add.l	d1,a0		; a0 has root directory start in bytes from RD
	move.l	a0,rootst	; rootst has start address of root dirctory
	lsl.l	#$8,d3
	lsl.l	#$1,d3
	add.l	d3,a1
	move.l	a1,datast	; datast has start address of data area
	
	suba.l	a5,a5
	move.l	$400(a5),event	; save event_timer vector
	move.l	#start,$400(a5) ; set new event_timer vector
	move.l	$42E,a0

	movea.l	a0,a1
	add.l	#21,a1
	move.b	(a1),d0
	add.b	#$41,d0
	move.b	d0,pfile	; set ramdisk drive id
	move.b	d0,tlname	; set ramdisk drive id
	move.b	d0,qfile	; set ramdisk drive id
	move.b	d0,qufil	; set ramdisk drive id

	move.b	#$6,d0		; set "pqueue exists" bit
*				; set "pqueue.tmp not busy"
	move.b	d0,-(a0)	; set "spooler already there"
	move.l	$B4(a5),trapv	; save trap 13 vector
	move.l	#trap,$B4(a5)	; set new trap 13 vector

	move.w	#$0,-(sp)	; create file spool.ttp
	move.l	#qufil,-(sp)
	move.w	#$3C,-(sp)
	trap	#1
	addq.l	#$8,sp

	tst.w	d0
	bge	N7

	move.l	#ccsp,d0
	bsr	up
	bra	quit

N7:	move.w	d0,quhand

	move.l	#pend,d0
	sub.l	#pbeg,d0	; d0 contains the bytes to move to spool.ttp

	move.l	#pbeg,-(sp)	; write to file spool.ttp
	move.l	d0,-(sp)
	move.w	quhand,-(sp)
	move.w	#$40,-(sp)
	trap	#1
	add.l	#$C,sp

	tst.w	d0
	bge	N8

	move.l	#cwsp,d0
	bsr	up
	bra	quit

N8:	move.l	supsav,-(sp)	; leave supervisor mode
	move.w	#$20,-(sp)
	trap	#1
	addq.l	#$6,sp

	move.l	d6,-(sp)	; terminate with program resident
	move.w	#$31,-(sp)
	trap	#1

quit:	move.l	supsav,-(sp)	; leave supervisor mode
	move.w	#$20,-(sp)
	trap	#1
	addq.l	#$6,sp

	clr.l	-(sp)		; If spooler there already then get out
	trap	#1

up:	move.l	d0,-(sp)
	move.w	#$9,-(sp)
	trap	#1
	addq.l	#6,sp
	
	rts

	.data

pbeg:	
	.dc.w	$601A,$0000,$0424,$0000,$0000,$0000,$0000,$0000
	.dc.w	$0000,$0000,$0000,$0000,$0000,$0000,$203C,$0000
	.dc.w	$035D,$90BC,$0000,$0000,$D0BC,$0000,$0500,$2A6F
	.dc.w	$0004,$2F00,$2F0D,$3F3C,$0000,$3F3C,$004A,$4E41
	.dc.w	$DFFC,$0000,$000C,$13FC,$0030,$0000,$0308,$42A7
	.dc.w	$3F3C,$0020,$4E41,$5C8F,$23C0,$0000,$02FA,$2078
	.dc.w	$042E,$2248,$D3FC,$0000,$0015,$1011,$D03C,$0041
	.dc.w	$13C0,$0000,$0350,$13C0,$0000,$0340,$1020,$13C0
	.dc.w	$0000,$033A,$08C0,$0000,$1080,$2F39,$0000,$02FA
	.dc.w	$3F3C,$0020,$4E41,$5C8F,$2F3C,$0000,$4000,$3F3C
	.dc.w	$0048,$4E41,$5C8F,$4A80,$6C00,$0010,$203C,$0000
	.dc.w	$039D,$6100,$0252,$6000,$020C,$23C0,$0000,$02F6
	.dc.w	$2055,$D1FC,$0000,$0081,$227C,$0000,$030A,$12D8
	.dc.w	$0C10,$0020,$6EF8,$12BC,$0000,$3F3C,$0002,$2F3C
	.dc.w	$0000,$030A,$3F3C,$003D,$4E41,$508F,$4A40,$6E00
	.dc.w	$0010,$203C,$0000,$0365,$6100,$020C,$6000,$01C6
	.dc.w	$33C0,$0000,$02FE,$3F3C,$0002,$2F3C,$0000,$0340
	.dc.w	$3F3C,$003D,$4E41,$508F,$4A40,$6B00,$000A,$5239
	.dc.w	$0000,$0342,$60E0,$3F3C,$0000,$2F3C,$0000,$0340
	.dc.w	$3F3C,$003C,$4E41,$508F,$4A40,$6C00,$0010,$203C
	.dc.w	$0000,$037D,$6100,$01C0,$6000,$016C,$33C0,$0000
	.dc.w	$0300,$2F39,$0000,$02F6,$2F3C,$0000,$3F00,$3F39
	.dc.w	$0000,$02FE,$3F3C,$003F,$4E41,$DFFC,$0000,$000C
	.dc.w	$4A80,$6C00,$0010,$203C,$0000,$03B2,$6100,$0188
	.dc.w	$6000,$0126,$6700,$003C,$23C0,$0000,$0304,$2F39
	.dc.w	$0000,$02F6,$2F39,$0000,$0304,$3F39,$0000,$0300
	.dc.w	$3F3C,$0040,$4E41,$DFFC,$0000,$000C,$4A80,$6C00
	.dc.w	$0010,$203C,$0000,$03CC,$6100,$014C,$6000,$00EA
	.dc.w	$6090,$3F3C,$0002,$2F3C,$0000,$0350,$3F3C,$003D
	.dc.w	$4E41,$508F,$4A40,$6C00,$0038,$3F3C,$0000,$2F3C
	.dc.w	$0000,$0350,$3F3C,$003C,$4E41,$508F,$4A40,$6E00
	.dc.w	$0020,$1039,$0000,$033A,$0880,$0001,$13C0,$0000
	.dc.w	$033A,$203C,$0000,$03EC,$6100,$00FC,$6000,$009A
	.dc.w	$33C0,$0000,$0302,$1039,$0000,$033A,$08C0,$0001
	.dc.w	$13C0,$0000,$033A,$3F3C,$0002,$3F39,$0000,$0302
	.dc.w	$2F3C,$0000,$0000,$3F3C,$0042,$4E41,$DFFC,$0000
	.dc.w	$000A,$207C,$0000,$0342,$D1FC,$0000,$000C,$10FC
	.dc.w	$000D,$10BC,$000A,$2F3C,$0000,$0342,$2F3C,$0000
	.dc.w	$000E,$3F39,$0000,$0302,$3F3C,$0040,$4E41,$DFFC
	.dc.w	$0000,$000C,$4A40,$6C00,$0010,$203C,$0000,$0407
	.dc.w	$6100,$0084,$6000,$0022,$3F39,$0000,$0302,$3F3C
	.dc.w	$003E,$4E41,$588F,$3F39,$0000,$0300,$3F3C,$003E
	.dc.w	$4E41,$588F,$6000,$0010,$2F3C,$0000,$0340,$3F3C
	.dc.w	$0041,$4E41,$5C8F,$3F39,$0000,$02FE,$3F3C,$003E
	.dc.w	$4E41,$588F,$42A7,$3F3C,$0020,$4E41,$5C8F,$23C0
	.dc.w	$0000,$02FA,$1039,$0000,$033A,$0880,$0000,$2078
	.dc.w	$042E,$1220,$1080,$2F39,$0000,$02FA,$3F3C,$0020
	.dc.w	$4E41,$5C8F,$2F39,$0000,$02F6,$3F3C,$0049,$4E41
	.dc.w	$5C8F,$42A7,$4E41,$2F00,$3F3C,$0009,$4E41,$5C8F
	.dc.w	$4E75,$0000,$0000,$0000,$0000,$0000,$0000,$0000
	.dc.w	$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000
	.dc.w	$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000
	.dc.w	$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000
	.dc.w	$0000,$0000,$0000,$0000,$0000,$0000,$6D3A,$4158
	.dc.w	$5858,$5854,$4D50,$2E50,$5254,$0000,$6D3A,$7071
	.dc.w	$7565,$7565,$2E74,$6D70,$000D,$0A50,$5254,$3E20
	.dc.w	$0053,$6F75,$7263,$6520,$6669,$6C65,$206E,$6F74
	.dc.w	$2066,$6F75,$6E64,$0D0A,$0043,$6F75,$6C64,$206E
	.dc.w	$6F74,$2063,$7265,$6174,$6520,$3F58,$5858,$5854
	.dc.w	$4D50,$2E50,$5254,$0D0A,$004F,$7574,$206F,$6620
	.dc.w	$4D61,$696E,$204D,$656D,$6F72,$790D,$0A00,$4361
	.dc.w	$6E6E,$6F74,$2072,$6561,$6420,$736F,$7572,$6365
	.dc.w	$2066,$696C,$650D,$0A00,$4361,$6E6E,$6F74,$2077
	.dc.w	$7269,$7465,$2064,$6573,$7469,$6E61,$7469,$6F6E
	.dc.w	$2066,$696C,$650D,$0A00,$4361,$6E6E,$6F74,$2063
	.dc.w	$7265,$6174,$6520,$5051,$5545,$5545,$2E54,$4D50
	.dc.w	$0D0A,$0043,$616E,$6E6F,$7420,$7772,$6974,$6520
	.dc.w	$746F,$2050,$5155,$4555,$452E,$544D,$500D,$0A00
	.dc.w	$0000,$0002,$0626,$1018,$0608,$0C22,$0E0E,$1614
	.dc.w	$0E0A,$140C,$140E,$060C,$1812,$0606,$0618,$1418
	.dc.w	$140A,$060E,$060A,$0A18,$140C,$180E,$0E12,$0E18
	.dc.w	$0612,$0E00,$0000,$0000,$0000,$0000,$0000,$0000
pend:	.dc.w	$0000

*******************************************************************************
*put1:	move.w	d4,-(sp)	; This section displays a character in d4     *
*	move.w	#$2,-(sp)	; ( low byte ).  Used for testing only.	      *
*	move.w	#$3,-(sp)						      *
*	trap	#13							      *
*	addq.l	#$6,sp							      *
*									      *
*	rts								      *
*******************************************************************************

	.end
