einit.sjI6
	.globl	__fbrk
	.globl	_globs,_end
	.bss
__iocmd:.=.+6		/ place to put system call for sys indir
__curhp:.=.+2		/ pointer to current heap header
__fsthp:.=.+6		/ first heap header, must be last in bss

/ offsets in heap header
hptop	=0		/ pointer to start of free area
hpprev	=2		/ pointer to previous heap header
hpsize	=4		/ current size of free area

/ definition of a file control block
bufvar	=0
eof	=2
flags	=3
	IN	=1	/ open for in flag
	OUT	=2	/ open for out flag
	ISTTY	=4	/ file is tty
maxsiz	=4
fildes	=6
valid	=8.
buffer	=10.
BUFSIZ	=512.	/ 512 byte buffers
FILSIZ	=buffer+BUFSIZ	/ size of file variable
READ	=sys read
WRITE	=sys write
OPEN	=sys open
CREAT	=sys creat
BREAK	=sys break
GTTY	=sys gtty
indir	=0	/ indir system call

/ some useful offsets in the globals
curfil=0	/ offset of address of current file
outfil=2	/ offset of output file variable
infile=outfil+FILSIZ	/ offset of input file variable
/ constants used in heap management
BRKLO	=256.	/ nr. bytes in request to increase bss size
BRKHI	=512.	/ nr. bytes in minimum request to shrink bss size
/ misc. constants
CMODE	=664	/ mode for created files
	.text
/  error #: reason
/
/	2: eof on get
/	3: no eof on put
/	4: file not opened for input
/	5: file not opened for output
/	6: file open error
/	8: bad call to new
/	9: mark error
/	10: release error
/	11: out of heap space
/
/	___000: initialize
/register usage:
/	r0 : scratch
/	r1 -> file blocks
/	r4 = return address
/ NOTE: By default, file descriptors 0 and 1 are treated as if they are
/ 	ttys.  This is true even if redirection occurs, to avoid gobbling
/	up command files prematurely.  Identifying a file descriptor as
/	a tty turns the usual (Pascal-oriented) move-fetch sequence to a
/	fetch-move.

	.globl	___000
___000:	mov	(sp)+,r4	/ pop return address into r4
	mov	sp,r0		/ sp -> nargs,argv: nargs is 1st parameter
	tst	(r0)+		/ r0 -> argv
	mov	r0,-(sp)	/ create 2nd parameter: pointer to argv
	clr	-(sp)		/ build dummy stack frame
	clr	-(sp)
	clr	-(sp)
	mov	sp,r5		/ level 0 stack frame

	mov	$__fsthp,r1		/ get address of first heap header
	mov	r1,__curhp		/ it is the current heap
	mov	$_end,(r1)+		/ pointer to top
	clr	(r1)+			/ no previous heap
	clr	(r1)+			/ no free space

	mov	$_globs+outfil,r1	/ initialize output file variable
	mov	r1,(r1)
	add	$buffer,(r1)+		/ buffer variable pointer
	mov	$[ISTTY+OUT]*256.+1,(r1)+	/ eof=true, flags=OUT+ISTTY
	mov	$1,(r1)+		/ maxsize=1 byte
	mov	$1,(r1)+		/ fildes=1
	clr	(r1)			/ valid=0

	mov	$_globs+infile,r1	/ initialize input file variable
	mov	r1,(r1)
	add	$buffer,(r1)+		/ buffer variable pointer
	mov	$[ISTTY+IN]*256.,(r1)+		/ eof=false, flags=IN+ISTTY
	mov	$1,(r1)+		/ maxsize=1 byte
	clr	(r1)+			/ fildes=0
	clr	(r1)			/ valid=0

	jmp	(r4)		/ return (return address is in r4)
/	___001: exit

	.globl	___001
___001:	mov	$_globs+outfil,r1	/ Flush standard output
	jsr	pc,__fbrk
	clr	r0			/ Good exit status
	sys	exit
/	___016: fileblockinit(@filvar,max_size_buffer_variable)/
/ register usage:
/	r0 : scratch
/	r1 -> file variable

	.globl	___016
___016:	mov	4(sp),r1		/ 1st parameter: @filvar
	mov	(sp)+,2(sp)		/ move down return address

	mov	r1,r0
	mov	r1,(r0)			/ create pointer to
	add	$buffer,(r0)+		/ ... buffer variable
	mov	$1,(r0)+		/ set eof=TRUE, flags=0
	mov	(sp)+,(r0)+		/ set max buffer variable size
	mov	$-1,(r0)+		/ set file descriptor = -1
	clr	(r0)+			/ set nr valid bytes = 0
	clr	(r0)+			/ zero first buffer word (just in case)
	rts	pc
new.sjI6	.globl	__expd,__error
/	___004: new(size in bytes)
/ register usage:
/	r0 = size required (in bytes)
/	r1 -> current heap header

	.globl	___004
___004:	mov	2(sp),r0		/ parameter = size

	inc	r0			/ round up size
	bic	$1,r0			/ ... to even number of bytes
	ble	1f			/ check for valid request

	mov	__curhp,r1		/ get address of current heap header
	beq	1f			/ if zero, no heap

3:	sub	r0,hpsize(r1)		/ adjust size
	bge	2f			/ goto 2f if enough room

	add	r0,hpsize(r1)		/ repair size
	jsr	pc,__expd		/ expand heap
	br	3b

2:	mov	hptop(r1),2(sp)		/ return pointer
	add	r0,hptop(r1)		/ ... and adjust top

	rts	pc

1:	mov	$10,r1			/ error #8: bad call to new
	jmp	__error
mark.sjI6	.globl	__expd,__error
/	___006: mark
/ register usage:
/	r0 -> new heap header
/	r1 -> old heap header

	.globl	___006
___006:	mov	__curhp,r1
	beq	1f			/ error if no heap header

3:	cmp	hpsize(r1),$6
	bge	2f			/ goto 2f if enough room for new header

	jsr	pc,__expd
	br	3b

2:	mov	hptop(r1),r0		/ r0 -> new heap header
	mov	r0,__curhp		/ it becomes the current heap
	mov	hptop(r1),(r0)		/ initialize pointer to top as old top
	add	$6,(r0)+		/ ... plus size of header
	mov	r1,(r0)+		/ pointer to previous heap header
	mov	hpsize(r1),(r0)		/ size is size of previous
	sub	$6,(r0)			/ ... minus size of header
	rts	pc

1:	mov	$11,r1			/ error #9: mark error
	jmp	__error
rrelease.sj{I6m	.globl	__error
/	___007: release
/ register usage:
/	r1 -> current (released) heap header

	.globl	___007
___007:	mov	__curhp,r1		/ get address of current heap header
	beq	1f			/ error if no current heap

	mov	hpprev(r1),r0		/ get address of previous heap header
	beq	1f			/ error if no previous heap
	mov	r0,__curhp
	mov	hptop(r1),-(sp)		/ current top
	add	hpsize(r1),(sp)		/ ... + current size (is end of area)
	sub	hptop(r0),(sp)		/ ... - previous top
	mov	(sp)+,hpsize(r0)	/ ... = size of current free area
/ could possibly shrink bss allocation here
	rts	pc

1:	mov	$12,r1			/ error #10: release error
	jmp	__error
_expd.sjRI6G	.globl	__error
	.globl	__expd
__expd:	mov	$BREAK,__iocmd		/ setup break system call
	mov	hptop(r1),__iocmd+2
	add	$BRKLO,hpsize(r1)
	add	hpsize(r1),__iocmd+2	/ desired break address
	sys	indir; __iocmd		/ issue system call
	bec	4f			/ if no, errors continue
	mov	$13,r1			/ error #11: out of heap space
	jmp	__error
4:	rts	pc
popenclose.sj+I6c	.globl	__dchr,__fnxt,__fbrk,__error
/	___017: open_a_file(@filvar,@name,{0=>read, 1=>write, 2=>update})
/ register usage:
/	r0 : scratch
/	r1 -> file variable

	.globl	___017
___017:	mov	6(sp),-(sp)		/ call close just in case
	jsr	pc,___020		/ ... it was already open
	mov	6(sp),r1		/ 1st parameter: @filvar
	mov	(sp)+,4(sp)		/ move down return address
	mov	(sp)+,__iocmd+4		/ 3rd parameter: mode
	mov	(sp)+,__iocmd+2		/ 2nd parameter: @name
	mov	__iocmd+4,-(sp)		/ save mode on top of stack
	cmp	$1,(sp)			/ mode = write only?
	beq	4f			/ if so, must creat instead of open

	mov	$OPEN,__iocmd		/ set up an "open" system call
	sys	indir; __iocmd		/ indir call to open
	bec	3f			/ if no errors, goto 3

	tst	(sp)			/ mode = read only?
	beq	1f			/ if so, barf...otherwise assume error
					/ ... caused by non-existent file
4:	mov	$CREAT,__iocmd		/ set up a "creat" system call
	mov	$CMODE,__iocmd+4
	sys	indir; __iocmd
	bes	1f			/ barf on any creat errors

	cmp	$2,(sp)			/ mode = read and write?
	bne	3f			/ if not, following code not necessary

	sys	close			/ close the file just created 'cause
					/ ... we didn't get read access
	bes	1f

	mov	$OPEN,__iocmd		/ and reopen
	mov	(sp),__iocmd+4		/ ... with read and write access
	sys	indir; __iocmd
	bes	1f

3:	mov	r0,fildes(r1)		/ store file descriptor
	mov	(sp)+,r0		/ get mode and change to form
	inc	r0			/ ... used by other routines
	movb	r0,flags(r1)		/ ... and store it in flags
	jsr	pc,__dchr		/ set device characteristics
	bit	$1,r0			/ open for read?
	beq	2f			/ no, skip buffer priming
	bitb	$ISTTY,flags(r1)	/ a tty?
	bne	2f			/ yes, skip buffer priming

	clrb	eof(r1)			/ set eof to FALSE
	jsr	pc,__fnxt		/ get the first buffer full

2:	rts	pc

1:	tst	(sp)+			/ pop off saved mode
	mov	$6,r1			/ error #6: file open error
	jmp	__error
/
/	___020: close_a_file(@filvar)
/ register usage:
/	r0 = file descriptor
/	r1 -> file variable

	.globl	___020
___020:	mov	2(sp),r1		/ 1st parameter: @filvar
	mov	(sp)+,(sp)		/ move down return address

	tstb	flags(r1)		/ is file open?
	beq	1f			/ no, don't need to close

	bitb	$OUT,flags(r1)		/ file open for write
	beq	2f			/ no, skip the flush
	jsr	pc,__fbrk

2:	mov	fildes(r1),r0		/ get file descriptor in r0
	sys	close			/ call system close, ignore errors

1:	rts	pc
odchr.sj`H4J	.globl	__dchr
/	__dchr:	check file characteristics
/register usage:
/	r0 : scratch(preserved)
/	r1 -> file block (assumed)
/ sets ISTTY in flags(r1) if the file is a tty
/ ****NOTE****this depends on the action of gtty(II), which normally
/ 		will distinguish ttys from otherer files.  At NBS, the
/		may be other devices which gtty will approve of.
/
__dchr:	mov	r0,-(sp)		/ save r0
	mov	$GTTY,__iocmd		/ set up for gtty
	mov	$argbuf,__iocmd+2	/ buffer for return value(ignored)
	mov	fildes(r1),r0		/ file to gtty on
	indir	sys; __iocmd		/ do it
	bes	1f
	bisb	$ISTTY,flags(r1)	/ It is!
	br	2f
1:	bicb	$ISTTY,flags(r1)	/ It isn't!
2:	mov	(sp)+,r0		/ restore r0
	rts	pc			/ ...
argbuf:	.=.+6				/ for gtty results
readc.sjV?6"	.globl	__fget
/	___024: read char(@filvar,@char)

	.globl	___024
___024:	mov	4(sp),r1		/ 1st parameter: @filvar
	mov	(sp)+,2(sp)		/ move down return address

	bitb	$ISTTY,flags(r1)	/ a tty?
	beq	1f			/ no

	mov	$1,r0			/ yes...fetch first
	jsr	pc,__fget
	movb	*(r1),*(sp)+		/   then give a char
	br	2f

1:	movb	*(r1),*(sp)+		/ else move char from buffer
	mov	$1,r0
	jsr	pc,__fget		/ and then get(filvar,1)

2:	rts	pc
readf.sst'6h
	.globl	__fget,__iget,__spce,__sgn
/	___034:	read real(@filvar,@real)
/
	.globl	___034
___034:
	mov	4(sp),r1		/ 1st parameter
	mov	(sp)+,2(sp)		/ move down return address
	stfps	-(sp)			/ push status
	jsr	pc,_fread		/ do the read
	movfo	fr0,*2(sp)		/ put away the value (single)
	ldfps	(sp)+			/ restore status
	tst	(sp)+			/ pop 2nd parameter
	rts	pc
/
/	___036: read double(@filvar,@double)
/
	.globl	___036
___036:
	mov	4(sp),r1		/ 1st parameter
	mov	(sp)+,2(sp)		/ move down return address
	stfps	-(sp)			/ push status
	jsr	pc,_fread		/ do the read
	movf	fr0,*2(sp)		/ put away the value (double)
	ldfps	(sp)+			/ restore status
	tst	(sp)+			/ pop 2nd parameter
	rts	pc
/
/	_fread:	common part of ___034, ___036
/
_fread:
	ldfps	$0200			/ set fps to known state
	mov	r3,-(sp)		/ save r3
	mov	r2,-(sp)		/ save r2
	jsr	pc,__spce		/ clean out white space
	jsr	pc,__sgn		/ get actual sign
	mov	r0,-(sp)		/ save sign
	clrf	fr0			/ for accumulated value
	jsr	pc,__rget		/ get integer part
	clr	r2			/ init the scale factor
	cmpb	$'.,*(r1)		/ fractional part?
	bne	1f			/ ...no
	mov	$1,r0			/ skip
	jsr	pc,__fget		/  past the dot
	jsr	pc,__rget		/ continue computing value
1:	tst	(sp)+			/ check the sign
	beq	2f
	negf	fr0			/ <0
2:	clr	r3			/ init exponent value to zero
	cmpb	$'e,*(r1)		/ check for exponent
	beq	3f
	cmpb	$'E,*(r1)
	bne	1f			/ no exponent
3:	mov	$1,r0			/ skip the 'e'
	jsr	pc,__fget
	jsr	pc,__sgn		/ compute the sign
	mov	r0,-(sp)		/ save the sign
	jsr	pc,__iget		/ compute the exponent
	tst	(sp)+			/ check the sign
	beq	1f
	neg	r3			/ make negative
1:	movf	$one,fr2		/ initialize scale factor
	movf	$ten,fr3		/  and the multiplier
	add	r3,r2			/ compute # decimal places in result
	beq	9f			/ stop if no motion
	bgt	5f			/ if negative
	neg	r2			/  make the count positive and
	movf	tenth,fr3		/  invert the multiplier
5:	bit	$1,r2
	beq	6f
	mulf	fr3,fr2			/ multiply up the scale factor
6:	mulf	fr3,fr3			/ square the multiplier
	asr	r2			/ halve the # digits
	bne	5b			/ and continue
9:	mulf	fr2,fr0			/ factor in the scale factor
	mov	(sp)+,r2		/ restore r2
	mov	(sp)+,r3		/ restore r3
	rts	pc
/
/
/	__rget: read in integer as floating value
/ register usage:
/	r0: scratch
/	r1: @fileblock
/	r2: digit count (for possible scale factor)
/	fr0: accumulated value
/	fr1: current digit
/
	.globl __rget
__rget:
	movb	*(r1),r0		/ fetch digit
	sub	$'0,r0			/ check to assure
	blt	1f			/  that it is
	cmpb	$9.,r0			/  really
	blt	1f			/  a digit
	movif	r0,fr1			/ float it
	mulf	$ten,fr0		/  and compute
	addf	fr1,fr0			/  the new value
	dec	r2			/ count the digit
	mov	$1,r0
	jsr	pc,__fget		/ bump to the next one
	br	__rget
1:	rts	pc
/
/ constants and data
	.data
one = 40200				/ = 1.0
ten = 41040				/ = 10.0
tenth:	37314; 146314; 146314; 146315	/ 1.0/10.0, to 64 bits
readi.s}Ji6	.globl	__fget
/	___030: read integer(@filvar,@integer)

	.globl	___030
___030:	mov	4(sp),r1		/ 1st parameter: @filvar
	mov	(sp)+,2(sp)		/ move down return address
	mov	(sp)+,r0		/ 2nd parameter: @integer
	mov	r3,-(sp)		/ save r3
	mov	r2,-(sp)		/ save r2
	mov	r0,r2			/ r2 -> result
	jsr	pc,__spce		/ clean out leading white space
	jsr	pc,__sgn		/ compute actual sign
	mov	r0,-(sp)		/ save sign
	clr	r3			/ r3 = value
	jsr	pc,__iget		/ compute int value in r3
	tst	(sp)+			/ check sign
	beq	1f
	neg	r3			/ is < 0
1:	mov	r3,(r2)			/ store result
	mov	(sp)+,r2		/ restore r2
	mov	(sp)+,r3		/ restore r3
	rts	pc
/
/	__spce: skip over leading ctrl chars and spaces
/ register usage:
/	r0: scratch
/	r1: @fileblock
/
	.globl	__spce
__spce:
	cmpb	$' ,*(r1)		/ skip over spaces and control chars
	blo	1f
	mov	$1,r0
	jsr	pc,__fget
	br	__spce
1:	rts	pc
/
/	__sgn: compute sign for numeric value
/ register usage:
/	r1: @fileblock
/
	.globl	__sgn
__sgn:
	clr	-(sp)
	cmpb	$'+,*(r1)
	beq	1f
	cmpb	$'-,*(r1)
	bne	2f			/ branch if neither sign
	inc	(sp)			/ wrong -- it was a '-'
1:	mov	$1,r0
	jsr	pc,__fget		/ skip over sign
2:	mov	(sp)+,r0		/ return value
	rts	pc
/
/	__iget: read in integer value
/ register usage:
/	r0: scratch
/	r1: @fileblock
/	r3: accumulated value
/
	.globl	__iget
__iget:
	movb	*(r1),r0		/ examine next character
	sub	$'0,r0
	blt	1f			/ branch if smaller than '0'
	cmp	$9.,r0
	blt	1f			/ branch if larger than '9'
	mul	$10.,r3			/ [r3] = [r3]*10
	add	r0,r3
	mov	$1,r0
	jsr	pc,__fget		/ get next character
	br	__iget
1:	rts	pc
gget.sjtI6p	.globl	__fnxt,__fget,__error,__ioerr
/	___021: get(@filvar,bytesize)
/ register usage:
/	r0 : scratch
/	r1 -> file block
/ calls:
/	__fnxt

	.globl	___021
___021:	mov	4(sp),r1		/ 1st parameter: @filvar
	mov	(sp)+,2(sp)		/ move down return address
	mov	(sp)+,r0		/ 2nd parameter: bytesize

__fget:	tstb	eof(r1)			/ eof must not be set
	bne	4f
	add	r0,(r1)			/ bump buffer variable pointer
	sub	r0,valid(r1)		/ valid data left?
	bgt	2f			/ Yes
	clr	valid(r1)		/ No...
	br	3f			/ ...go get some
2:	cmp	valid(r1),maxsiz(r1)	/ enough valid data left
	bge	1f			/ yes, go home
3:	jsr	pc,__fnxt		/  and get a bufferfull
1:	rts	pc

4:	mov	$2,r1			/ error #2: eof on get
	jmp	__error
/
/ internal subroutine __fnxt to get a bufferfull
/ register usage:
/	r0 : scratch
/	r1 -> file block, initialized
/	r2 : scratch
/	r3 : scratch

__fnxt:	mov	r1,r0			/ create pointer to start of buffer
	add	$buffer,r0		/ ..in r0
	mov	r0,(r1)			/ ..this is new buffer variable pointer
	tst	valid(r1)		/ any leftovers in buffer?
	ble	1f			/ if not, nothing to move
	mov	r3,-(sp)		/ save r3
	mov	r2,-(sp)		/ save r2
	mov	valid(r1),r3		/ r3 = size leftovers
	mov	(r1),r2			/ r2 -> leftovers
3:	movb	(r2)+,(r0)+		/ move up leftovers
	sob	r3,3b
	mov	(sp)+,r2		/ restore r2
	mov	(sp)+,r3		/ restore r3
1:	bitb	$IN,flags(r1)		/ file opened for input?
	beq	4f			/ if not, error
	mov	$READ,__iocmd		/ setup read system call
	mov	r0,__iocmd+2		/ ..address of buffer
	mov	$BUFSIZ,r0		/ ..byte count is buffer size
	sub	valid(r1),r0		/ ....less size of leftovers
	mov	r0,__iocmd+4		/ ..byte count for read
	mov	fildes(r1),r0		/ ..get file descriptor in r0
	sys	indir; __iocmd		/ issue indir system call
	bes	5f
	add	r0,valid(r1)		/ add number bytes read to valid
	bgt	2f			/ if anything in buffer, return
	movb	$1,eof(r1)		/ ..else set eof to true
2:	rts	pc

4:	mov	$4,r1			/ error #4: file not opened for input
	jmp	__error
5:	jmp	__ioerr
writec.sjJ6z	.globl	__fput,__fpad
/	___025: write char(@filvar,char,fieldwidth)

	.globl	___025
___025:	mov	r3,-(sp)		/ save r3
	mov	r2,-(sp)		/ save r2
	mov	10.(sp),r1		/ 1st parameter: @filvar
	mov	4(sp),10.(sp)		/ move down return address

	movb	8.(sp),*(r1)		/ move char into buffer
	mov	$1,r0
	jsr	pc,__fput		/ put(filvar,1)
	mov	6(sp),r3		/ 3rd parameter: field width
	dec	r3
	ble	1f
	mov	$' ,r2
	jsr	pc,__fpad

1:	mov	(sp)+,r2		/ restore r2
	mov	(sp)+,r3		/ restore r3
	add	$6,sp			/ pop off parameters
	rts	pc
writeb.sjt<6I	.globl	___027
/	___029 - Write boolean(@filvar,boolean,field width)
/
/Register usage:
/
/Calls: ___027 (Modifies stack and fakes a call)

	.globl	___029
___029:	mov	(sp),-(sp)		/Jack up ret addr
	mov	4(sp),2(sp)		/Move up field width
	mov	$5,4(sp)		/string length 5
	tst	6(sp)			/check which string
	beq	1f			/ to print
	mov	$Tstr,6(sp)		/ "TRUE "
	br	2f
1:	mov	$Fstr,6(sp)		/ "FALSE"
2:	jmp	___027			/ Print the string
	.data
Tstr:	<TRUE >
Fstr:	<FALSE>
owrites.sj4J6L	.globl	__fput,__fpad
/	___027: write string(@filvar,@string,stringlength,fieldwidth)
/ register usage:
/	r0 : scratch
/	r1 -> file block
/	r2 = pad character
/	r3 = count
/ calls:
/	__fput,__fpad

	.globl	___027
___027:	mov	r3,-(sp)		/ save r3
	mov	r2,-(sp)		/ save r2
	mov	12.(sp),r1		/ 1st parameter: @filvar
	mov	4(sp),12.(sp)		/ move down return address
	mov	8.(sp),r3		/ 3rd parameter: length
	mov	6(sp),r0		/ 4th parameter: width
	bgt	1f			/ if width <= 0 then
	mov	r3,r0			/ ...width := length
	mov	r0,6(sp)		/ update 4th parameter
1:	cmp	r0,r3			/ if width < length
	bge	2f			/ then
	mov	r0,r3			/ length := width
2:	mov	r3,8.(sp)		/ update 3rd parameter
	blt	3f			/ if count > 0 then
	mov	10.(sp),r2		/ 2nd parameter: pointer to string
4:	movb	(r2)+,*(r1)		/ but a char into buffer
	mov	$1,r0			/ ...and put
	jsr	pc,__fput
	sob	r3,4b			/ until count = 0

3:	mov	6.(sp),r3		/ 4th parameter: width
	sub	8.(sp),r3		/ - 3rd parameter: length
	ble	5f			/ if padding > 0
	mov	$' ,r2			/ pad with space char
	jsr	pc,__fpad

5:	mov	(sp)+,r2
	mov	(sp)+,r3
	add	$8.,sp			/ pop off parameters
	rts	pc
writei.sj%J6H/	___031: write integer(@filvar,integer,field width)
/ register usage:
/	r0 : scratch
/	r1 -> file block
/	r2 : scratch for div inst
/	r3 : scratch for div inst
/	r4 : Not used

	.globl	__fput,__fpad
	.globl	___031
___031:	mov	6(sp),r1		/ 1st parameter: @filvar
	mov	(sp)+,4(sp)		/ move down return address
	mov	r3,-(sp)		/ save r3
	mov	r2,-(sp)		/ save r2
	mov	sp,r0			/ r0 -> local workspace
	sub	$6,sp			/ size of workspace = 6 bytes
	mov	12.(sp),r2		/ r2 = value to be printed
	bge	1f
	neg	r2			/ get absolute value
1:	mov	r2,r3			/ prepare for divide
	clr	r2
	div	$10.,r2			/ divide value by 10
	add	$'0,r3			/ make ascii digit of remainder
	movb	r3,-(r0)		/ store it in workspace
	tst	r2			/ is anything left
	bne	1b			/ yes, loop on
	tst	12.(sp)			/ was original value < 0
	bge	2f
	movb	$'-,-(r0)		/ yes, move in minus sign
2:	mov	10.(sp),r3		/ get field width
	mov	sp,r2			/ compute length of string built
	add	$6,r2
	sub	r0,r2			/ r2 = length of string
	mov	r0,-(sp)		/ save pointer to string
	mov	r2,-(sp)		/ save length of string
	sub	r2,r3			/ compute padding needed
	ble	3f			/ branch if none needed
	movb	$' ,r2
	jsr	pc,__fpad		/ output padding
3:	mov	(sp)+,r3		/ restore length of string to r3
	mov	(sp)+,r2		/ restore address of string to r2
4:	movb	(r2)+,*(r1)		/ put out string
	mov	$1,r0
	jsr	pc,__fput
	sob	r3,4b
5:	add	$6,sp			/ delete workspace
	mov	(sp)+,r2		/ restore r2
	mov	(sp)+,r3		/ restore r3
	cmp	(sp)+,(sp)+		/ pop off remaining parameters
	rts	pc
writed.s}ii6|/	___35:	write_short_floating(@filvar,real,field_width,fraction_width)
/ register usage:

	.globl	__fput,__fpad
	.globl	___035
___035:
	mov	10.(sp),r0		/ swap @filvar
	mov	(sp),10.(sp)		/  with the
	mov	r0,(sp)			/  return address
	mov	r2,-(sp)
	mov	r3,-(sp)
	mov	r4,-(sp)
	stfps	-(sp)
	ldfps	$200			/ fpu status = doublereal, shortint
	movof	14.(sp),fr0		/ get real number to be printed
	jsr	pc,__fcvt			/ convert in "floating" format
	ldfps	(sp)+			/ restore fpu status
	mov	(sp)+,r4
	mov	(sp)+,r3
	mov	(sp)+,r2
	add	$10.,sp			/ delete parameters
	rts	pc			/ return
/
/	___37:	write_double_floating(@filvar,double,field_width,fraction_width)
/ register usage:

	.globl	__fput,__fpad
	.globl	___037
___037:
	mov	14.(sp),r0		/ swap @filvar
	mov	(sp),14.(sp)		/  with the
	mov	r0,(sp)			/  return address
	mov	r2,-(sp)
	mov	r3,-(sp)
	mov	r4,-(sp)
	stfps	-(sp)
	ldfps	$200			/ fpu status = doublereal, shortint
	movf	14.(sp),fr0		/ get long real number to be printed
	jsr	pc,__fcvt			/ convert in "floating" format
	ldfps	(sp)+			/ restore fpu status
	mov	(sp)+,r4
	mov	(sp)+,r3
	mov	(sp)+,r2
	add	$14.,sp			/ delete parameters
	rts	pc			/ return
/
/	__fcvt: write out a real/double in fr0
/ register usage:
/	r0 - scratch
/	r1 - @fileblock, @buffer
/	r2 - scratch, for __fpad
/	r3 - @buffer, count
/	r4 - count
/	fr0-fr3 - clobbered

__fcvt:
	mov	sp,r3			/ r3 -> end of buffer + 1
	sub	$bufsiz,sp		/ make room for buffer in stack
	mov	sp,r1			/ r1 -> start of buffer
	clr	sign			/ assume > 0.0
	cfcc				/ get fcc from movf in caller
	bgt	1f			/ if > 0.0 goto 1f
	beq	2f			/ if = 0.0 goto 2f
	negf	fr0			/ r < 0.0, make it positive
	inc	sign			/ make < 0.0
1:	modf	$one,fr0			/ see if < 1.0
	tstf	fr1
	cfcc
	beq	3f			/ if so, goto 3f

	clr	r2			/ r2 = nr digits in integer part
	movf	fr0,fr4			/ r >= 1.0 comes here, save fraction
	movf	fr1,fr0			/ put integer part in fr0
1:	modf	tenth,fr0		/ put lower order integer digit into fraction
	movf	fr0,fr2			/ get fraction in fr2
	movf	fr1,fr0			/ will get to remaining integer part later
	addf	$noise,fr2		/ because 0.1 is nonterminating binary
	modf	$ten,fr2		/ isolate the lower order integer digit
	movfi	fr3,r0
	add	$'0,r0
	movb	r0,-(r3)		/ put into buffer backwards
	inc	r2			/ bump integer field counter
	tstf	fr0			/ anything left in integer part
	cfcc
	bne	1b			/ if so, continue

	mov	r2,r0			/ number of digits produced so far
0:	movb	(r3)+,(r1)+		/ move them to head of buffer
	sob	r0,0b
	movf	fr4,fr0			/ restore fractional part
	br	3f

2:	inc	r2			/ r = 0.0 comes here
	movb	$'0,(r1)+

3:
	mov	12.+bufsiz(sp),r4			/ nr fractional digits requested
	ble	5f
	inc	r4			/ make one more for round-up
	mov	r4,nfdig		/  and save for later
4:	modf	$ten,fr0
	movfi	fr1,r0
	add	$'0,r0
	movb	r0,(r1)+
	sob	r4,4b

5:
	tst	nfdig			/ fractional part?
	ble	6f			/  no
	mov	r1,r2			/ save ptr to last digit
	mov	r1,r4
	sub	sp,r4			/ compute total digits
	movb	-(r2),r0		/ get last (extra) digit
	add	$5,r0			/ round it up
	movb	r0,(r2)			/  and replace
1:	cmpb	(r2),$'9		/ bigger than a nine?
	ble	6f			/  no.  round-up done
	movb	$'0,(r2)		/ make this a zero and
	incb	-(r2)			/  and propagate carry, while backing
	sob	r4,1b			/  up ptr;  do the whole string

6:
	mov	r1,r4			/ calculate nr chars in buffer
	sub	sp,r4
	mov	10.+bufsiz(sp),r1	/ r1 -> file variable
	mov	14.+bufsiz(sp),r3
	sub	r4,r3			/ compute pad count
	dec	r3			/ account for '.'
	tst	sign			/  and possible sign
	beq	1f
	dec	r3
1:	mov	$' ,r2			/ pad with blank
	jsr	pc,__fpad
	mov	sp,r3			/ r3 -> start of buffer
	tst	sign
	beq	1f			/ sign?
	movb	$'-,*(r1)		/  yes...write it out
	mov	$1,r0
	jsr	pc,__fput
1:	sub	nfdig,r4		/ compute length of integer part
	ble	1f			/ none...
	jsr	pc,outdig		/ write out the string of digits
1:					/ now the fractional part
	movb	$'.,*(r1)		/ put out '.'
	mov	$1,r0
	jsr	pc,__fput
	mov	nfdig,r4
	dec	r4			/ account for extra digit
	ble	1f				/ there is no frac part
	jsr	pc,outdig			/  yes there is.
1:	add	$bufsiz,sp
	rts	pc
/
/	outdig: write out string of digits
/ register usage:
/	r0: scratch
/	r1: @fileblock
/	r3: @buffer
/	r4: buffer length
outdig:	movb	(r3)+,*(r1)			/ and put them out
	mov	$1,r0
	jsr	pc,__fput
	sob	r4,outdig
	rts	pc

	.data
one = 40200
ten = 41040
noise = 37114		/ largest one word less than 0.05
tenth:	37314; 146314; 146314; 146315
bufsiz = 40.		/ max nr digits before decimal point + 1
sign:	0		/ flag for presence of minus sign on output
nfdig:	0		/ local storage for number of digits in fraction
writeo.sj;6/	.globl	__fput,__fpad
/	___039: write octal(@filvar,integer,field width (>= 6))
/
/Register usage:
/	r0 : Byte count for __fput
/	r1 -> File block
/	r2 : Pad character, scratch
/	r3 : Pad count, value to convert
/	r4 : Loop count
/
	.globl	___039
___039:
	mov	6(sp),r1	/ unpack stack frame: @filvar
	mov	(sp)+,4(sp)	/ move in return address to simplify return
	mov	r4,-(sp)	/ save r4
	mov	r3,-(sp)	/ save r3
	mov	r2,-(sp)	/ save r2
	mov	6(sp),r3	/ get width
	ble	2f		/  skip if no padding needed
	sub	$6,r3
	bgt	1f		/ pad with blanks
	beq	2f		/ don't pad
	mov	$'*,r2		/ pad with *'s
	neg	r3		/ 6-(r3) is neg
	jsr	pc,__fpad
	tst	(sp)+		/ dump value, we won't output
	br 3f
1:	mov	$' ,r2		/ use blanks
	jsr	pc,__fpad
2:	mov	$6,r4
	mov	8.(sp),r3	/ get value
	clr	r2
	ashc	$1,r2		/ get one bit for 1st digit
4:	add	$'0,r2		/ convert to ASCII digit
	movb	r2,*(r1)	/ store byte
	mov	$1,r0		/ byte count
	jsr	pc,__fput	/ update
	clr	r2
	ashc	$3,r2		/ next digit
	sob	r4,4b
3:	mov	(sp)+,r2
	mov	(sp)+,r3
	mov	(sp)+,r4
	cmp	(sp)+,(sp)+	/ to pop off width and value params
	rts	pc
	put.sozt4f	.globl	__fput,__fpad,__fbrk
	.globl	__error,__ioerr
/	___022: put(@filvar,bytesize)
/ register usage:
/	r1 -> file block
/	r0 = bytesize
/ calls:
/	__fbrk

	.globl	___022
___022:	mov	4(sp),r1		/ file variable argument
	mov	(sp)+,2(sp)		/ move down return addr
	mov	(sp)+,r0		/ byte size argument
__fput:	tstb	eof(r1)			/ eof should be set
	beq	2f			/ otherwise error
	add	r0,(r1)			/ bump buffer variable pointer
	add	valid(r1),r0		/ r1 is now updated size
	mov	r0,valid(r1)		/ and now valid is also
	add	maxsiz(r1),r0		/ check to see if there is room
	cmp	r0,$BUFSIZ		/ ...for next buffer variable
	ble	1f
	jsr	pc,__fbrk		/ if not, flush the buffer
1:	rts	pc

2:	mov	$3,r1			/ error #3: no eof on put
	jmp	__error
/
/	___023: break(filvar)
/register usage:
/	r1 -> file block
/	r0 : scratch

	.globl	___023
___023:	mov	2(sp),r1		/ file variable argument
	mov	(sp)+,(sp)		/ move down return addr
__fbrk:	bitb	$OUT,flags(r1)		/ opened for output?
	beq	4f			/ if not, error
	tst	valid(r1)		/ any valid data?
	ble	1f			/ if not, ignore
	mov	$WRITE,__iocmd		/ setup write system call
	mov	r1,r0			/ create pointer to buffer
	add	$buffer,r0
	mov	r0,__iocmd+2		/ store in system call
	mov	r0,bufvar(r1)		/ ...and as new buffer variable pointer
	mov	valid(r1),__iocmd+4	/ store byte count in system call
	mov	fildes(r1),r0		/ get file descriptor in r0
	sys	indir; __iocmd		/ indir system call
	bes	5f			/ branch if error
	clr	valid(r1)		/ valid count is now 0
1:	rts	pc

4:	mov	$5,r1			/ error #5: file not opened for output
	jmp	__error
5:	jmp	__ioerr
/
/	__fpad: puts out pad characters
/ register usage:
/	r0 = count for __fput
/	r1 -> file block
/	r2 = pad character
/	r3 = pad count
/ calls:
/	__fput

__fpad:	tst	r3
	ble	1f
2:	movb	r2,*(r1)
	mov	$1,r0
	jsr	pc,__fput
	sob	r3,2b
1:	rts	pc
/
/	___045: write-end-of-line(@filvar)
	.globl	___045
___045:	mov	2(sp),r1		/ r1-> file variable
	mov	(sp)+,(sp)		/ move down return address
	movb	$12,*(r1)		/ insert LF in buffer
	mov	$1,r0
	jmp	__fput			/ jmp instead of jsr; rts
error.sjW:6	.globl	__error,__ioerr
/	error handler
/ register usage:
/	r0 = unix system error number (if any)
/	r1 = runtime support error number

__ioerr:
	mov	$m2,__iocmd+2		/ point to msg
	mov	$m2l,__iocmd+4		/ msg length
	mov	r0,-(sp)		/ save error number
	br	1f
__error:
	mov	$m1,__iocmd+2		/ point to msg
	mov	$m1l,__iocmd+4		/ msg length
	mov	r1,-(sp)		/ save Pascal error number
1:	mov	$WRITE,__iocmd		/ Going to write
	mov	$2,r0			/  to controlling tty
	sys	indir; __iocmd		/ execute write
	bes	1f			/ oops
	mov	$m3,__iocmd+2		/ point to 2nd msg
	mov	$m3l,__iocmd+4		/ msg length
	clr	r0			/ zap r0 for
	mov	(sp)+,r1		/  computation of error number
	div	$12,r0			/ get two octal digits:
	add	$60,r0
	add	$60,r1
	movb	r0,m3+6
	movb	r1,m3+7
	mov	$2,r0			/ use tty
	sys	indir; __iocmd		/ print error number
	br	1f			/ just a no-op
1:	sys	exit			/ bail out
	.data
m1:	<Pascal \0>
m2:	<UNIX \0>
m3:	<error 00\n\0>
m1l=7
m2l=5
m3l=9
t
