.enabl	lc
	.title	C library
	.rem	$

I/O and runtime support library for Small C.
Written March, 1984, by John Wilson, C.A. '84.

Includes the following functions:

fopen(*filename,*access)
fclose(handle)
putc(c,handle)
getc(handle)
putchar(c)
getchar()
puts(*string)
gets(*string)
peek(address)
poke(address,contents)
rsts(lowbyte)

Plus EIS math routines and predicates.

$
	.radix	8
;
	.mcall	.exit,.ttyout
;
firqb=	402	;file request queue block
xrb=	442	;transfer request block
corcmn=	461	;460 holds length
nl=	12	;newline character (yecch - UNIX)
cr=	15	;car ret
lf=	12	;line feed
esc=	33	;escape
;
calfip=	emt+0	;call to file processor
opnfq=	2	;open an existing file
crefq=	4	;create and open a new file
.read=	emt+2	;read a block
.write=	emt+4	;write a block
.dofss=	emt+365	;do a .FSS (file string scan) after restoring low core
;+
;
; fopen (*filename,*access)
;
; opens filename[], with access as follows:
; access[0]	access
;
;  'r'		input
;  'i'		input
;  'w'		output
;  'o'		output
;
; This routine returns a file handle in r1.  If r1=0,
; the open was NOT successful.  The type of the handle
; is int, not FILE (I'm going to tell C about this, so
; it will be transparent).
;
;-
fopen::	mov	#firqb,r0	;point at FIRQB
	mov	#20,r1		;length
10$:	clr	(r0)+		;clear a word
	sob	r1,10$		;loop
	mov	4(sp),r0	;get &filename[]
	.dofss			;do a file string scan
	tstb	firqb
	bne	90$		;.FSS error
	movb	@2(sp),r0
	mov	r0,-(sp)
	jsr	pc,toupper	;convert access[0] to upper case
	tst	(sp)+
	cmpb	r1,#'R		;read?
	beq	20$
	cmpb	r1,#'I
	bne	30$
20$:	movb	#opnfq,firqb+3	;set up for input
	mov	#512.,r2	;initial buffer pointer
	br	50$
30$:	cmpb	r1,#'W		;write?
	beq	40$
	cmpb	r1,#'O
	bne	90$		;bad access letter
40$:	movb	#crefq,firqb+3	;set up for create and output
	clr	r2		;initial buffer pointer
50$:	mov	#4,r0
	mov	#bfflgs,r1
60$:	tstb	(r1)+		;find a free buffer
	beq	70$		;found one
	sob	r0,60$		;check all 4 buffer flags
	br	90$		;no free buffers
70$:	movb	firqb+3,-(r1)	;put access in buffer flag
	sub	#bfflgs-1,r1	;get channel number
	asl	r1		;convert to firqb format
	movb	r1,firqb+4	;put channel number
	mov	r2,bfctrs-2(r1)	;init character counter
	clr	block-2(r1)	;start at begn
	mov	buffs-2(r1),bfptrs-2(r1) ;init buffer ptr
; now do the open
	emt	377		;RSTS prefix
	calfip			;call to FIP (file processor)
	tstb	firqb		;open successful?
	beq	80$		;yes
	asr	r1
	clrb	bfflgs-1(r1)	;clear flag
	br	90$		;return NULL (error)
80$:	rts	pc
90$:	clr	r1		;error, return NULL
	rts	pc
;+
;
; fclose(handle)
;
; Closes channel #<handle/2> (handle is int).
; Returns 0 if successful, otherwise RSTS error code.
;
;-
fclose::
	mov	2(sp),r0
	jsr	pc,flush	;flush output buffer, if output
	clrb	firqb+3		;func=CLSFQ, close channel
	movb	2(sp),firqb+4
	emt	377		;RSTS prefix
	calfip			;close the file
	movb	firqb,r1	;get error code
	mov	2(sp),r0
	asr	r0		;point at bfflgs entry
	clrb	bfflgs(r0)	;free the buffer
	rts	pc
;+
;
; flush(handle)
;
; Internal routine to see if buffer for handle is empty,
; and if not, write it to the file (assuming it's an output
; file).  The handle is passed in r0.
;
;-
flush:	mov	r0,r1		;copy handle
	asr	r0		;convert to channel #
	movb	bfflgs-1(r0),r2	;file open?
	beq	3$		;no, return
	cmpb	r2,#crefq	;opened for output?
	bne	3$		;no, return
	mov	#512.,r3	;block size
	sub	bfctrs-2(r1),r3	;block full?
	beq	2$		;yes, write it
	cmp	r3,#512.	;block empty?
	beq	3$		;yes, never mind
	mov	bfptrs-2(r1),r2	;no, get ptr
1$:	clrb	(r2)+		;clear a byte
	sob	r3,1$		;loop
2$:	mov	#512.,xrb
	mov	#512.,xrb+2
	mov	buffs-2(r1),xrb+4
	mov	buffs-2(r1),bfptrs-2(r1) ;reset pointer
	clr	bfctrs-2(r1)	;reinit buffer count
	mov	r1,xrb+6	;(should clear xrb+7)
	inc	block-2(r1)
	mov	block-2(r1),xrb+10
	clr	xrb+14
	emt	377
	.write			;write buffer
3$:	rts	pc		;return
;+
;
; putc(c,handle)
;
; Sends character c to channel <handle/2>.  The actual
; transfers take place in 512.-byte blocks (buffered
; I/O), because RSTS is so nasty about file transfers.
; TSS/8 to the max!
;
;-
putc::	movb	4(sp),r1	;get byte
	cmp	r1,#nl		;nl?
	bne	1$		;no
	movb	#cr,r1		;yes, send cr/lf
	movb	r1,4$		;set flag
1$:	mov	2(sp),r0	;get handle
	movb	r1,@bfptrs-2(r0) ;put byte in buffer
	inc	bfctrs-2(r0)	;inc ctr
	inc	bfptrs-2(r0)	;and ptr
	cmp	bfctrs-2(r0),#512. ;buffer full?
	bne	2$		;no, skip
	jsr	pc,flush	;yes, flush buffer
2$:	tstb	4$		;lf needed?
	bne	3$		;yes
	rts	pc
3$:	mov	#lf,r1		;load lf
	clrb	4$		;clear flag
	br	1$		;write lf
4$:	.word	0	;if non-zero, next char should be lf
;+
;
; getc(handle)
;
; Reads character from channel <handle/2> (buffered),
; returns in r1.  If returned value is negative, it's
; the 2's complement of a RSTS error code.
;
;-
getc::	mov	2(sp),r0
	cmp	bfctrs-2(r0),#512. ;buffer empty?
	bne	1$		;no
; fill buffer
	clr	bfctrs-2(r0)	;0 chars read from buffer
	mov	#512.,xrb
	clr	xrb+2
	mov	buffs-2(r0),xrb+4
	mov	buffs-2(r0),bfptrs-2(r0) ;reinit ptr
	clr	bfctrs-2(r0)	;init ctr
	mov	r0,xrb+6	;this ought to clear xrb+7
	inc	block-2(r0)
	mov	block-2(r0),xrb+10 ;set block number
	clr	xrb+12		;unlimited KB wait (if KB)
	clr	xrb+14		;RECORD 0%
	emt	377
	.read			;read a block
	movb	firqb,r1	;error?
	beq	1$		;no
	neg	r1		;return -<error code>
	rts	pc
1$:	movb	@bfptrs-2(r0),r1 ;get byte from buffer
	inc	bfptrs-2(r0)	;inc ptr
	inc	bfctrs-2(r0)	;inc ctr
	cmp	r1,#cr		;cr? (UNIX - yecch)
	beq	getc		;ignore
	rts	pc		;and return
;+
;
; putchar(c)
;
; Prints c on terminal.
;
;-
putchar::
	movb	2(sp),r0	;get char
	cmp	r0,#nl		;newline? (grumble)
	bne	1$		;no
	.ttyout	#cr		;send a cr
	mov	#lf,r0		;load a lf
1$:	.ttyout			;print the char
	rts	pc
;+
;
; getchar()
;
; Returns next character from _TT: (buffered by line).
;
;-
getchar::
	mov	#1,xrb		;length=1
	clr	xrb+2
	mov	#cbuf,xrb+4	;point at buffer
	clr	xrb+6		;channel 0
	clr	xrb+10		;next block
	clr	xrb+12		;unlimited KB wait
	clr	xrb+14		;RECORD 0%
	emt	377
	.read
	movb	cbuf,r1		;get char
	rts	pc		;and return
;+
;
; puts(*string)
;
; Prints .asciz string at @#string on terminal.
;
;-
puts::	mov	2(sp),r1	;point at string
	mov	r1,r0		;copy
1$:	tstb	(r0)+		;find end of string
	bne	1$
	sub	r1,r0		;calculate length
	dec	r0		;correct (don't count NUL)
	mov	#xrb,r2		;point at xrb
	mov	r0,(r2)+	;put length
	mov	r0,(r2)+	;...
	mov	r1,(r2)+	;buffer address
	clr	(r2)+		;channel 0, next block
	clr	(r2)+		;next block
	clr	(r2)+		;(nothing to wait for on output)
	clr	(r2)		;RECORD 0%
	emt	377
	.write			;send the string
	rts	pc		;return
;+
;
; gets(*buffer)
;
; Gets line from _TT:, puts it in ptr[] (.asciz).
;
;-
gets::	mov	#xrb,r1		;point at xrb
	mov	#80.,(r1)+	;buffer length
	clr	(r1)+		;nothing read yet
	mov	2(sp),(r1)+	;buffer address
	clr	(r1)+		;channel 0, next block
	clr	(r1)+		;next block
	clr	(r1)+		;WAIT 0%
	clr	(r1)		;RECORD 0%
	emt	377
	.read			;read (part of) a line
	tstb	firqb		;error?
	bne	exit		;no
	mov	xrb+2,r0	;get length
	add	2(sp),r0	;point at end of string
	movb	-(r0),r1	;get last char in string
	cmpb	r1,#cr		;cr or lf?
	beq	1$
	cmpb	r1,#lf
	bne	2$		;no
1$:	dec	r0		;yes, eat the other char (cr/lf, lf/cr)
2$:	clrb	(r0)		;mark end of string
	clr	r1		;no error
	rts	pc		;return
;+
;
; len(*string)
;
; Returns length of string[].
;
;-
len::	mov	2(sp),r1	;get ptr
1$:	tstb	(r1)+		;end?
	bne	1$		;no, loop
	sub	2(sp),r1	;yes, find length
	dec	r1		;don't count the NUL
	rts	pc		;return
;+
;
; toupper(c)
;
; returns c (char), converted to upper case, if lower case.
;
;-
toupper::
	movb	2(sp),r1
	cmpb	r1,#'A+40
	blo	1$
	cmp	r1,#'Z+40
	bhi	1$
	sub	#40,r1		;convert
1$:	return
;+
;
; peek(addr)
;
; Returns value of byte at @#addr.
; Type is char or int (not sign-extended).
;
;-
peek::	movb	@2(sp),r1	;get the byte
	bic	#177400,r1	;clear high byte
	rts	pc
;+
;
; poke(addr,val)
;
; Puts #val (byte) into @#addr.
;
;-
poke::	movb	2(sp),@4(sp)	;aren't PDP-11s fun?
	rts	pc
;+
;
; rsts(lowbyte)
;
; performs RSTS/E EMT number #lowbyte.
; Used to access RSTS directly.
; Returns @#firqb (byte).
;
;-
rsts::	movb	2(sp),1$	;poke low byte
	emt	377		;RSTS prefix
1$:	emt	0		;'0' will be replaced
	movb	firqb,r1	;get error code
	rts	pc
;+
;
; exit()
;
; Exits to KB monitor.
;
;-
exit::	clr	r0		;implied .HRESET
	;bug in RT-11 emulator occasionally wedges
	;your job if you don't do the .HRESET!!!!
	.exit			;see you around
;+
;
; Signed divide and mod;
; r1=r2/r1, r2=r2%r1
;
;-
$div::	mov	r2,r3		;move down to next reg
	sxt	r2		;sign extend
	div	r1,r2		;do it
	mov	r2,r1		;copy quotient
	mov	r3,r2		;copy remainder
	rts	pc
;+
;
; Shift r2 right r1 bits; result in r1.
;
;-
$asr::	neg	r1		;right shift
;;; fall through
;+
;
; Shift r2 left r1 bits; result in r1.
;
;-
$asl::	ash	r1,r2		;do the shift
	mov	r2,r1		;get result
	rts	pc
;+
;
; Conditional stuff.
;
;-
$eq::	cmp	r2,r1
	beq	true
	br	false
;
$ne::	cmp	r2,r1
	bne	true
	br	false
;
$gt::	cmp	r2,r1
	bgt	true
	br	false
;
$ge::	cmp	r2,r1
	bge	true
	br	false
;
$le::	cmp	r2,r1
	ble	true
	br	false
;
$lt::	cmp	r2,r1
	blt	true
	br	false
;
$ugt::	cmp	r2,r1
	bhi	true
	br	false
;
$uge::	cmp	r2,r1
	bhis	true
	br	false
;
$ule::	cmp	r2,r1
	blos	true
	br	false
;
$ult::	cmp	r2,r1
	blo	true
;
false:	clr	r1
	rts	pc
;
true:	mov	#-1,r1
	rts	pc
;
buffs:	.word	buff1,buff2,buff3,buff4
buff1:	.=.+512.
buff2:	.=.+512.
buff3:	.=.+512.
buff4:	.=.+512.
block:	.word	0,0,0,0
bfctrs:	.word	0,0,0,0
bfptrs:	.word	0,0,0,0
bfflgs:	.byte	0,0,0,0
cbuf:	.byte
	.even
	.=.+4000	;1kw stack
	.word	0	;make sure we get enough core allocated
$stack==.
	.end