.globl b1
.globl hblk
.globl headers
.globl	initl
.globl asmem
.globl b1s
.globl b1e
.globl w1
.globl stats
.globl	lookchar
.globl	flush
.globl	fsfile
.globl	seekchar
.globl	backspace
.globl	alterchar
.globl	zero
.globl	getchar
.globl	putchar
.globl	copy
.globl	rewind
.globl	create
.globl	allocate
.globl	release
.globl	collect
.globl	w,r,a,l
.globl	getword
.globl	putword
.globl	backword
.globl	alterword
/
/
/	routine to read next character from string
/	pointer to by r1; character returned in r0
/	c-bit set if character not availiable (eof)
/
/	mov	...,r1
/	jsr	pc,getchar
/	movb	r0,...
/
getchar:
	jsr	pc,lookchar
	bes	1f
	inc	r(r1)
	tst	r0		/clears c-bit
1:	rts	pc
/
/
/	routine to read a string backwards
/	the read pointer is decremented before reading
/
/	mov	...,r1
/	jsr	pc,backspace
/	mov	r0,...
/
backspace:
	cmp	a(r1),r(r1)
	bhis	nochc
	dec	r(r1)
	jsr	pc,lookchar
	rts	pc
nochc:	clr	r0
	sec
	rts	pc
/
/
/	routine to put a word onto the string
/
/	mov	...,r1
/	mov	...,r0
/	jsr	pc,putword
/
putword:
	mov	r0,-(sp)
	sub	$hblk,r0
	jsr	pc,putchar
	swab	r0
	jsr	pc,putchar
	mov	(sp)+,r0
	rts	pc
/
/
/	routine to get a word from the string
/
/	mov	...,r1
/	jsr	pc,getword
/	mov	r0,...
/
getword:
	jsr	pc,lookchar
	bes	1f
	movb	r0,nchar
	inc	r(r1)
	jsr	pc,lookchar
	bes	1f
	movb	r0,nchar+1
	inc	r(r1)
	mov	nchar,r0
	add	$hblk,r0
1:	rts	pc
/
/
/	routine to alter the word pointed to by r(r1)
/	by replacing the word there with r0
/
/	mov	wd,r0
/	mov	...,r1
/	jsr	pc,alterword
/
alterword:
	mov	r0,-(sp)
	sub	$hblk,r0
	jsr	pc,alterchar
	swab	r0
	jsr	pc,alterchar
	mov	(sp)+,r0
	rts	pc
/
/
/	routine to get words backwards from string
/
/	mov	...,r1
/	jsr	pc,backword
/	mov	r0,...
/
backword:
	cmp	a(r1),r(r1)
	bhis	nochw
	dec	r(r1)
	jsr	pc,lookchar
	movb	r0,nchar+1
	cmp	a(r1),r(r1)
	bhis	nochw
	dec	r(r1)
	jsr	pc,lookchar
	movb	r0,nchar
	mov	nchar,r0
	add	$hblk,r0
	rts	pc
/
nochw:
	clr	r0
	sec
	rts	pc
/
/
/	routine to copy the contents of one string
/	to another.
/
/	mov	source,r0
/	mov	dest,r1
/	jsr	pc,copy
/	mov	r1,...
/
/	on return, r1 points to the new string and should
/	be saved.  r0 is preserved.
/
copy:
	inc	stats+12.
	mov	r0,-(sp)
	mov	r1,-(sp)
	mov	r2,-(sp)
	mov	r3,-(sp)
	mov	w(r0),r2
	sub	a(r0),r2	/W-A (old)
	mov	l(r1),r3
	sub	a(r1),r3	/L-A (new)
	cmp	r2,r3
	blos	1f
	mov	r2,r0
	jsr	pc,allocate
	mov	4(sp),r0	/new
	jsr	pc,swap
	jsr	pc,release
	mov	r0,r1
	mov	0(sp),r0	/old
1:
	mov	a(r1),w(r1)	/rewind w pointer
	cmp	r2,$512.
	blos	copy1		/is a short string
/
	jsr	pc,flush
	jsr	pc,reset
/
	mov	a(r0),-(sp)
4:
	mov	(sp),0f
	mov	afi,r0
	sys	seek;0:.. ;0	/set input pointer
	cmp	r2,$512.
	blos	2f
	mov	$512.,r3	/# output this time
	mov	r3,0f
	mov	r3,3f
	add	r3,(sp)
	sub	r3,r2	/# left to output
	br	1f
2:
	mov	r2,0f
	mov	r2,3f
	mov	r2,r3
	clr	r2
1:
	mov	afi,r0
	sys	read;b1;0:..
	bes	bad
	cmp	r0,r3
	bne	bad
	mov	afout,r0
	mov	(r1),0f
	add	r3,(r1)
	sys	seek;0:.. ;0
	sys	write;b1;3:..
	bes	bad
	tst	r2
	bgt	4b
	tst	(sp)+
/
/	fix up read ptr of new string
/
copy2:
	mov	6(sp),r0	/restore r0
	mov	r(r0),r2
	sub	a(r0),r2
	add	a(r1),r2
	mov	r2,r(r1)
/
/	restore and return
/
	mov	(sp)+,r3
	mov	(sp)+,r2
	mov	(sp)+,r1
	mov	(sp)+,r0
	rts	pc
/
bad:	mov	$1,r0
	sys write;1f;2f-1f
	4
1:	<error on copy\n>
2:	.even
/
swap:
	mov	w(r1),-(sp)
	mov	w(r0),w(r1)
	mov	(sp),w(r0)
	mov	r(r1),(sp)

	mov	r(r0),r(r1)
	mov	(sp),r(r0)
	mov	a(r1),(sp)
	mov	a(r0),a(r1)
	mov	(sp),a(r0)
	mov	l(r1),(sp)
	mov	l(r0),l(r1)
	mov	(sp)+,l(r0)
	rts	pc
/
/	copy a short string
/
copy1:
	mov	r(r0),-(sp)
	mov	a(r0),r(r0)
	mov	nchar,-(sp)
	mov	r0,r2		/old
	mov	r1,r3		/new
1:
	mov	r2,r1
	jsr	pc,getchar
	bes	1f
	mov	r3,r1
	jsr	pc,putchar
	br	1b
1:
	mov	r2,r0
	mov	(sp)+,nchar
	mov	(sp)+,r(r0)
	mov	r3,r1
	br	copy2
/
/
/
/
/
/	routine to rewind read pointer of string
/	pointed to by r1
/
/	mov	...,r1
/	jsr	pc,rewind
/
rewind:
	mov	a(r1),r(r1)
	rts	pc
/
/
/	routine to rewind write pointer of string
/	pointed to by r1
/
/	mov	...,r1
/	jsr	pc,create
/
create:
	mov	a(r1),w(r1)
	mov	a(r1),r(r1)
	rts	pc
/
/
/	routine to zero a string
/
/	mov	...,r1
/	jsr	pc,zero
/
zero:
	mov	r0,-(sp)
	.if testing
	jsr	pc,preposterous
	.endif
	mov	a(r1),w(r1)
	clrb	r0
1:	cmp	w(r1),l(r1)
	bhis	1f
	jsr	pc,putchar
	br	1b
1:	mov	a(r1),w(r1)
	mov	(sp)+,r0
	rts	pc
/
/
/
/	routine to move the read pointer of a string to the
/	relative position indicated by r0.  the string is
/	extended if necessary - there is no error return.
/
/	mov	position,r0
/	mov	...,r1
/	jsr	pc,seekchar
/
seekchar:
	mov	r1,-(sp)
	mov	r0,-(sp)
	.if testing
	jsr	pc,preposterous
	.endif
	inc	stats+10.
1:
	mov	(sp),r0
	add	a(r1),r0
	cmp	r0,l(r1)
	bhi	3f
	mov	r0,r(r1)
	cmp	r0,w(r1)
	blo	1f
	mov	r0,w(r1)
	br	1f
3:
	mov	(sp),r0
	jsr	pc,allocate
	mov	2(sp),r0
	jsr	pc,copy
	jsr	pc,swap
	jsr	pc,release
	mov	2(sp),r1
	br	1b
1:
	mov	(sp)+,r0
	mov	(sp)+,r1
	rts	pc
/
/
/	routine to move read pointer of string to end of string
/
/	mov	...,r1
/	jsr	pc,fsfile
/
fsfile:
	mov	r0,-(sp)
	.if testing
	jsr	pc,preposterous
	.endif
	inc	stats+10.
	mov	w(r1),r(r1)
	mov	(sp)+,r0
	rts	pc
/
/
/	routine to place the character in r0 at the current
/	position of the read pointer - the read pointer
/	is not moved.
/
/	movb	ch,r0
/	mov	...,r1
/	jsr	pc,alterchar
/	mov	r1,...
/
alterchar:
	mov	r2,-(sp)
	mov	r1,-(sp)
	mov	r0,nchar
	.if testing
	jsr	pc,preposterous
	.endif
	inc	stats+8.
1:	cmp	r(r1),l(r1)	/W,L
	blo	3f
	mov	l(r1),r0
	inc	r0
	sub	a(r1),r0	/W-A+1
	jsr	pc,allocate
	mov	(sp),r0
	jsr	pc,copy
	jsr	pc,swap
	jsr	pc,release
	mov	(sp),r1
3:
	mov	r(r1),r0
	jsr	pc,bufchar
	bec	2f
	jsr	pc,getbuf

2:	movb	nchar,(r0)
	mov	$1,w1(r2)
	mov	nchar,r0	/to preserve r0 for user
	inc	r(r1)
	cmp	r(r1),w(r1)
	blos	3f
	mov	r(r1),w(r1)
3:
	mov	(sp)+,r1
	mov	(sp)+,r2
	rts	pc
/
/
/	routine to look at next character from string
/	pointed to by r1;  character returned in r0
/	c-bit set if character not available (end of file)
/	r1 is preserved
/
/	mov	...,r1
/	jsr	pc,lookchar
/	movb	r0,...
/
lookchar:
	mov	r2,-(sp)
	inc	stats+6.
	.if testing
	jsr	pc,preposterous
	.endif
	cmp	w(r1),r(r1)	/W,R
	blos	noch
	mov	r(r1),r0
	jsr	pc,bufchar
	bec	2f
	jsr	pc,getbuf
/
2:
	inc	flag
	bne	2f
	jsr	pc,fixct
	br	1f
2:
	mov	flag,u1(r2)
1:
	mov	(sp)+,r2
	movb	(r0),r0
	tst	r0	/clears c-bit
	rts	pc
/
noch:
	mov	(sp)+,r2
	clr	r0
	sec
	rts	pc
/
/
/	routine to put a character into the string
/	pointed to by r1;  character in r0
/	r0 is preserved; r1 points to the string
/	after return and must be saved.
/
/	movb	ch,r0
/	mov	...,r1
/	jsr	pc,putchar
/	mov	r1,...
/
putchar:
	mov	r2,-(sp)
	mov	r1,-(sp)
	mov	r0,nchar
	.if testing
	jsr	pc,preposterous
	.endif
	inc	stats+8.
1:	cmp	w(r1),l(r1)	/W,L
	blo	3f
	mov	w(r1),r0
	inc	r0
	sub	a(r1),r0	/W-A+1
	jsr	pc,allocate
	mov	(sp),r0
	jsr	pc,copy
	jsr	pc,swap
	jsr	pc,release
	mov	(sp),r1
3:
	mov	w(r1),r0
	jsr	pc,bufchar
	bec	2f
	jsr	pc,getbuf
2:	movb	nchar,(r0)
	mov	$1,w1(r2)
	mov	nchar,r0	/to preserve r0 for user
	inc	w(r1)
	inc	flag
	bne	2f
	jsr	pc,fixct
	br	1f
2:
	mov	flag,u1(r2)
1:
	mov	(sp)+,r1
	mov	(sp)+,r2
	rts	pc
/
/
/	routine to flush contents of all buffers.
/
/	jsr	pc,flush
/
flush:
	mov	r1,-(sp)
	mov	r2,-(sp)
	mov	r3,-(sp)
	clr	r3
1:
	cmp	r3,$numb
	bhis	1f
	mov	r3,r2
	asl	r2
	tst	w1(r2)
	ble	2f
	mov	r3,r1
	ashc	$9.,r1
	bic	$777,r1
	add	$b1,r1
	jsr	pc,clean
2:
	inc	r3
	br	1b
1:
	mov	(sp)+,r3
	mov	(sp)+,r2
	mov	(sp)+,r1
	rts	pc
/
/
reset:
	mov	r3,-(sp)
	mov	r2,-(sp)
	clr	r3
1:
	cmp	r3,$numb
	bge	1f
	mov	r3,r2
	asl	r2
	mov	$-1.,w1(r2)
	clr	b1s(r2)
	clr	b1e(r2)
	clr	u1(r2)
	inc	r3
	br	1b
1:
	clr	flag
	mov	(sp)+,r2
	mov	(sp)+,r3
	rts	pc
/
/
/	routine to read from disc to a buffer
/	wcing the buffer if necessary
/
/	mov	disc addr,r0
/	mov	buffer addr,r2
/	jsr	pc,getb
/
/	on return r0 = addr of byte in buffer
/
getb:
	mov	r3,-(sp)
	mov	r1,-(sp)
	mov	r0,-(sp)
	mov	r2,r3
	asr	r3
	mov	r3,r1
	ashc	$9.,r1
	bic	$777,r1
	add	$b1,r1
	tst	w1(r2)	/ w
	ble	1f

	jsr	pc,clean

1:	mov	(sp),r0
	bic	$777,r0		/get lowest multiple of 512.
	mov	r0,0f
	mov	r0,b1s(r2)	/set start
	mov	afi,r0
	sys	seek;0:..;0
	mov	r1,0f
	sys	read;0:..;512.

	mov	b1s(r2),b1e(r2)
	add	$512.,b1e(r2)	/ set end
	clr	w1(r2)		/clear w
	mov	(sp)+,r0
	sub	b1s(r2),r0
	add	r1,r0		/ set r0=byte addr in buffer
	mov	(sp)+,r1
	mov	(sp)+,r3
	rts	pc
/
/
/	routine to wc a buffer
/
/	mov	buffer addr,r2
/	mov	buffer addr+6,r1	beginning of buffer
/	jsr	pc,clean
/
clean:
	inc	stats+24.
	mov	r0,-(sp)
	mov	b1s(r2),0f
	mov	afout,r0
	sys	seek;0:..;0
	mov	r1,0f
	sys	write;0:..;512.

	clr	w1(r2)	/clear w
	mov	(sp)+,r0
	rts	pc
/
/
/	routine to get buffer addr of byte whose disc
/	addr is in r0 - also returns addr of write
/	flag for buffer in r2
/
/	mov	disc addr,r0
/	jsr	pc,bufchar
/	mov	(r0),r0	for read
/	inc	(r2)	for write must inc w
/
/	c-bit set if char not in either buffer
/
bufchar:
	mov	r1,-(sp)
	mov	r3,-(sp)
	clr	r3
1:
	mov	r3,r2
	asl	r2
	cmp	r0,b1s(r2)
	blo	2f
	cmp	r0,b1e(r2)
	bhis	2f
	sub	b1s(r2),r0
	mov	r3,r1
	ashc	$9.,r1
	bic	$777,r1
	add	r1,r0
	add	$b1,r0
	mov	(sp)+,r3
	mov	(sp)+,r1
	clc
	rts	pc
2:
	inc	r3
	cmp	r3,$numb
	blt	1b
	mov	(sp)+,r3
	mov	(sp)+,r1
	sec
	rts	pc
/
/
/	routine to get a buffer
/
/	mov	disc addr,r0
/	jsr	pc,getbuf
/	mov	(r0),r0		(for read)
/	inc	(r2)		must inc w for w
/
getbuf:
	mov	r4,-(sp)
	mov	r3,-(sp)
	mov	$2,r3
	clr	r2
	mov	$1,r4
1:
	cmp	r4,$numb
	bge	1f
	cmp	u1(r3),u1(r2)
	bhis	2f
	mov	r3,r2
2:
	inc	r4
	add	$2.,r3
	br	1b
1:
	mov	r2,r3
	jsr	pc,getb
	add	$stats+14.,r3
	inc	(r3)
	mov	(sp)+,r3
	mov	(sp)+,r4
	rts	pc
/
/
/	this routine renumbers the time used cell u1(r2)
/	of the buffers when the clock overflows
/
fixct:
	mov	r1,-(sp)
	mov	r3,-(sp)
	mov	$numb,r1
	mov	$numb,flag
2:
	mov	r1,u1(r2)
	dec	r1
	bge	1f
	mov	(sp)+,r3
	mov	(sp)+,r1
	rts	pc
1:
	clr	r2
	mov	$2,r3
1:
	cmp	r3,$numb2
	bge	2b
	cmp	u1(r3),u1(r2)
	blo	2f
	mov	r3,r2
2:
	add	$2,r3
	br	1b