	.title	k11rt4	i/o for rt11 version 4 or 5 for Kermit-11
	.ident	/1.0.01/


;	08-Mar-84  09:18:25  Brian Nelson
;
;	Copyright (C) 1984 Change Software, Inc.
;
;	 This is the RT11 version of K11RMS.MAC.  It simply tries
;	to emulate,  as much as is  reasonable,  what the RMS i/o
;	routines do for  RSX and RSTS.  This strains a few things
;	in as  much that RT11  does not provide  much of anything
;	in the  sense of file services as compared to that  which
;	RMS11 v2 provides.  Since the whole of Kermit-11 is built
;	around RMS11  for i/o we will even  take the step  to map
;	RT11 error codes  into RMS11 error  codes,  thus allowing
;	the use  of the RMS error  routines and removing any need
;	to modify Kermit-11 elsewhere.  
;	We won't really use the RMS error routines since they are
;	much to comprehensive for the errors that RT can have.
;
;	This routine MUST be in the root segment.
;	The RT11 executive must have multiple terminal support.
;
;
;	Disk i/o epts
;
;	open  ( %loc filename, %val channel_number ,%val type )
;	create( %loc filename, %val channel_number ,%val type )
;	getrec( %loc buffer  , %val channel_number ) { returns RSZ in R1}
;	putrec( %loc buffer  , %val record_size    ,%val channel_number )
;	close ( %val channel_number )
;	putc  ( %val char    , %val channel_number )
;	getc  ( %val channel_number )


	.sbttl	non disk i/o entry points

;	In all cases, R0 will have the returned error code (zero for success)
;	For KBREAD and READ, R1 will have the size of the read
;	For BINREAD,  R1 will have the character just read
;
;	The use of %LOC and %VAL are from VMS Pascal and Fortran.
;	%LOC means ADDRESS, whereas %VAL means literal. All call
;	formats assume the first argument is at 0(r5), the next
;	at 2(r5) and so on, as in:
;
;	clr	-(sp)			; today's date by default
;	mov	#datebf	,-(sp)		; where to put the converted string
;	mov	sp	,r5		; call ASCDAT
;	call	ascdat			; simple
;	cmp	(sp)+	,(sp)+		; all done
;
;	or by using the CALLS macro (defined in K11MAC.MAC)
;
;	calls	ascdat	,<#datebf,#0>
;
;
;	Any version of Kermit-11 which can not, due to the lack of
;	executive  support,  implement a function should return an
;	error of -1 in r0.  For instance,  RT11 does not have  any
;	executive primitives to do wildcarding directory lookup.
;
;
;
;
;	ASCDAT	( %loc buffer, %val datevalue )
;	ASCTIM	( %loc buffer, %val timevalue )
;	ASSDEV	( %loc device_name )
;	BINREA	( %val lun, %val timeout )
;	BINWRI	( %loc buffer, %val byte_count, %val lun )
;	CANTYP	( %loc device_name, %val lun )
;	CHKABO	( )
;	DODIR	( %loc directory_string, %val lun )
;	DRPPRV	( )
;	DSKUSE	( %loc returned_string )
;	ECHO	( %loc terminal_name )
;	EXIT	( )
;	GETPRV	( )
;	GETUIC	( )
;	GTTNAM	( %loc returned_ttname )
;	KBREAD	( %loc buffer )
;	L$PCRL	( )
;	L$TTYO	( %loc buffer, %val bytecount )
;	LOGOUT	( )
;	NAMCVT	( %loc source_filename, %loc returned_normal_name )
;	NOECHO	( %loc device_name, %val lun )
;	QUOCHK	( )
;	READ	( %loc buffer, %val buffer_length, %val lun, %val block_number )
;	SETCC	( %loc control_c_ast_handler )
;	SETSPD	( %loc device_name, %val speed )
;	SUSPEN	( %val seconds, %val ticks )
;	SYSERR	( %val error_number, %loc error_text_buffer )
;	TTRFIN	( )
;	TTRINI	( )
;	TTSPEE	( %loc terminal_name )
;	TTYDTR	( %loc terminal_name )
;	TTYFIN	( %loc terminal_name, %val lun )
;	TTYHAN	( %loc terminal_name )
;	TTYINI	( %loc terminal_name, %val lun, %val open_flags )
;	TTYPAR	( %loc terminal_name, %val parity_code )
;	TTYRST	( %loc terminal_name )
;	TTYSAV	( %loc terminal_name )
;	TTYSET	( %loc terminal_name )
;	WRITE	( %loc buffer, %val buffer_length, %val lun, %val block_number )
;	XINIT	( )


	.sbttl	define macros and local i/o database


	.include	/IN:K11MAC.MAC/
	.iif ndf,k11inc	,.error	; missing INCLUDE for K11MAC.MAC

	cr	=	15
	lf	=	12
	ff	=	14
	soh	=	1
	maxsiz	=	1000
	errbyt	==	52
	topmem	=	50


	.enabl	gbl

	.psect	$code	,ro,i,lcl,rel,con
	.psect	rtdir1	,rw,d,gbl,rel,con
	.psect	rtioda	,rw,d,lcl,rel,con

;	Note that for RT11,  of course, all files are considered
;	to be image files. If there was a RMS11/RT we would have
;	had  transportability from RSX and  RSTS version of disk
;	i/o.

buflst:	.word	ttbuf	,buf1	,buf2	,buf3	,buf4
bufdef:	.word	ttbuf	,buf1	,buf2	,buf3	,buf4
bufsiz:	.word	ttbsiz	,maxsiz	,maxsiz	,maxsiz	,maxsiz
filtyp:	.word	terminal,text	,text	,text	,text
bufp:	.word	0	,0	,0	,0	,0
bufs:	.word	0	,0	,0	,0	,0
mode:	.word	1	,0	,0	,0	,0
blknum:	.word	0	,0	,0	,0	,0


	fb$stm	==	0
	fb$var	==	0
	fb$cr	==	0

df$rfm::.word	0
df$rat::.word	0


	ttbsiz	=	40
ttbuf:	.blkb	ttbsiz+2
buf1:	.blkb	maxsiz+2		; record buffer for GETC channel 1
buf2:	.blkb	maxsiz+2		; record buffer for GETC channel 2
buf3:	.blkb	maxsiz+2		; record buffer for GETC channel 3
buf4:	.blkb	maxsiz+2		; record buffer for GETC channel 4
prtbuf:	.blkb	40			; for doing .print output without cc
	.word	0
time:	.word	0,40


lun1	=	1
lun2	=	2
lun3	=	3
lun4	=	4
maxlun	=	lun4

	.sbttl	error codes that we will need thoughout Kermit-11


	er$cre	==	-1		; can't create a file
	er$dev	==	-2		; invalid device name
	er$eof	==	-3		; end of file
	er$fnf	==	-4		; file not found
	er$fnm	==	-5		; bad filename
	er$ful	==	-6		; device full
	er$nmf	==	-7		; no more files found
	er$iop	==	-10		; invalid i/o request
	er$sys	==	-11		; system error
	er$lby	==	-12		; lun open
	er$rer	==	-13		; read error
	er$wer	==	-14		; write error
	er$prv	==	-15		; protection error
	er$rtb	==	-16		; record too big
	er$que	==	-17		; no que elements
	er$nin	==	-20		; no input for .mtget
	er$nat	==	-21		; not attached for .mtxxxx
	er$lun	==	-22		; non-existant lun for .mtxxxx
	er$bsy	==	-23		; device not available
	er$buf	==	-24		; invalid buffer for xm exec
	er$sup	==	-25		; missing exec feature
	er$map	==	-26		; terminal unit not initialized
	er$spe	==	-27
	er$sy1	==	-30
	er$sy2	==	-31
	er$sy3	==	-32
	er$sy4	==	-33
	er$vol	==	-34
	er$nop	==	-35

	maxerr	==	35		; must be abs(maxerr)
	nodata	==	er$nin		; no data available

	.psect	$pdata			; error message text
	.enabl	lc

baderr:	.asciz	#Unknown error call#
nosup:	.asciz	#Missing executive feature#
	.even

errmap:	.word	5$,10$,20$,30$,40$,50$,60$,70$,100$,110$,120$
	.word	130$,140$,150$,160$,170$,200$,210$,220$,230$,240$,250$
	.word	260$,270$,300$,310$,320$,330$,340$,350$
	.word	baderr,0
5$:	.byte	0
10$:	.asciz	#Can't create file#
20$:	.asciz	#Invalid device name#
30$:	.asciz	#End of file#
40$:	.asciz	#File not found#
50$:	.asciz	#Bad filename#
60$:	.asciz	#Device full#
70$:	.asciz	#No more files#
100$:	.asciz	#Invalid i/o operation request#
110$:	.asciz	#System error#
120$:	.asciz	#Logical unit already open#
130$:	.asciz	#Device read error#
140$:	.asciz	#Device write error#
150$:	.asciz	#File is protected#
160$:	.asciz	#Record too large for user buffer#
170$:	.asciz	#No QUE elements available#
200$:	.asciz	#MT service - No data available/Buffer overflow#
210$:	.asciz	#MT service - Line not attached#
220$:	.asciz	#MT service - Non-existent unit#
230$:	.asciz	#MT service - Device not available#
240$:	.asciz	#MT service - Bad user buffer address (XM)#
250$:	.asciz	#Missing executive feature#
260$:	.asciz	#MT service - RT11 device unit not mapped to internal LUN#
270$:	.asciz	#Unknown speed#
300$:	.asciz	#System error from RT11 .CLOSE#
310$:	.asciz	#System error from RT11 .CSISPC#
320$:	.asciz	#System error from RT11 .ENTER#
330$:	.asciz	#System error from RT11 .FETCH#
340$:	.asciz	#Disk home block is not RT11 format#
350$:	.asciz	#I/O channel not open#

	.even
	
	.sbttl	error print and mapping

	.psect	$code

;	R M S E R R 
;
;	input:	@2(r5)	error number	(fortran/bp2 calling standard)
;	output:	4(r5)	the error text


syserr::calls	rmserr	,<#2,r5,2(r5)>	; simple
	return

rmserr::save	<r0,r1>			; the registers we will use
	mov	#baderr	,r1		; preset bad error text
	mov	4(r5)	,r0		; insure default of nothing
	clrb	@r0			; .asciz
	mov	@2(r5)	,r0		; the error number
	bge	10$			; must change into > 0
	neg	r0			; make it > 0
10$:	cmp	r0	,#maxerr	; is this a valid call today?
	bhi	20$			; yes
	asl	r0			; no, get error number into word
	mov	errmap(r0),r1		; offset and get the text address
20$:	mov	4(r5)	,r0		; where to put the error text
	mov	r1	,-(sp)
30$:	movb	(r1)+	,(r0)+		; copy it until a null byte
	bne	30$			; next please
	cmp	(sp)+	,#baderr	; ?Unknown error call ?
	bne	100$			; no
	movb	#'(	,-1(r0)		; yes, convert the error number
	deccvt	@2(r5)	,r0		; so we can see what it was
	add	#6	,r0		; skip past the converted number
	movb	#')	,(r0)+		; terminate the string
	movb	#40	,(r0)+		; a space to be nice
	clrb	@r0			; finally, .asciz please
100$:	unsave	<r1,r0>			; pop registers we used and exit
	return				; bye
	
	.psect	$pdata

cloerr::.word	er$sy1	,er$sy1	,er$sys	,er$prv
csierr::.word	er$fnm	,er$dev	,er$sy2
dsterr::.word	er$dev
enterr::.word	er$lby	,er$ful	,er$sy3	,er$prv	,er$sy3
feterr::.word	er$dev	,er$sy4
lokerr::.word	er$lby	,er$fnf	,er$sys
reaerr::.word	er$eof	,er$rer	,er$nop	,er$sys
wrierr::.word	er$eof	,er$wer	,er$nop	,er$sys
twaerr::.word	er$que
mrkerr::.word	er$que

	.word	er$sup
mterr::	.word	er$nin	,er$nat	,er$lun	,er$iop	,er$bsy	,er$buf	,er$sys

	.psect	$code
	
	.sbttl	one shot init code for Kermit-11 RT11


	.mcall	.qset,.twait	,.fetch

xinit::	.qset	#rtque,#5		; allocate extra que elements
	mov	@#50	,r1
	tst	(r1)+
	.fetch	r1,#dkdev
	sub	#2	,r0
	mov	r0	,@#50		; allways keep what we got
	clr	r0
	return

	.save
	.psect	$pdata
dkdev:	.rad50	/DK /
	.restore


	global	<lun.in,lun.ou,rtque>


	.sbttl	open a file for rt11

	.mcall	.csispc,.dstatus,.lookup,.fetch,.enter,.close
	.psect	$code

;	OPEN
;
;	open  ( %loc filename; %val channel_number, %val type )
;
;	input:	@r5	filename address
;		2(r5)	channel number
;		4(r5)	val 'binary' or 'text' or 0
;
;	output:	r0	rms (really a mapped RT11 error) error code
;
;
;	 For RT11, create a buffered image file. It is
;	always assumed that channel '0' implies writes
;	to the attached console terminal.



fopen::
open::	save	<r1,r2,r3>		; save all the temps please
	mov	@r5	,r1
	mov	2(r5)	,r3		; channel number here
	bne	5$			; not implied terminal open
	 mov	sp	,mode+0		; say we will be writing to it
	 clr	bufp+0			; and there is nothing there yet
	 clr	r0			; no errors are possible
	 br	120$			; bye

5$:	asl	r3			; times 2 for word indexing
	call	setatr			; initialize file control data
	mov	4(r5)	,filtyp(r3)	; ensure the correct type of file
	sub	#20.	,sp		; allocate buffer for the
	mov	sp	,r2		; device status call
	sub	#40.*2	,sp		; allocate a buffer for the
	mov	sp	,r1		; .csispc data
	mov	@r5	,r0		; string address
10$:	movb	(r0)+	,(r1)+		; copy it to the csi buffer
	bne	10$			; until a null byte is found.
	movb	#'=	,-1(r1)		; fake an output filespec here
	clrb	@r1			; and .asciz
	mov	sp	,r1		; reset pointer (also saving sp)
	.csispc	r1,#defext,r1		; and try to parse the name
	mov	r1	,sp		; restore from any switches
	bcs	80$			; oops
	.dstat	r2	,r1		; get some device information
	bcs	60$			;
	tst	4(r2)			; is the handler resident ?
	bne	20$			; yes
	mov	@#topmem,r2		; no, place it at the top of
	tst	(r2)+
	.fetch	r2,r1			; the world and hope we get it
	bcs	90$			; oops

20$:	tst	@r1			; a device is there ?
	bne	30$			; yes
	mov	#^RDK	,@r1		; no, stuff DK: in please
30$:	.lookup	#rtwork,2(r5),r1	; open the file for input
	bcs	100$			; can not find it
	mov	#-1	,bufp(r3)	; say we need to init the buffer
	clr	mode(r3)		; we are reading today
	clr	r0			; no errors
	br	120$			; and exit

60$:	mov	#dsterr	,r1
	br	110$
80$:	mov	#csierr	,r1		; .csispc error mapping
	br	110$			; get the correct error now
90$:	mov	#feterr	,r1		; .fetch error codes
	br	110$
100$:	mov	#lokerr	,r1		; .lookup error mapping
	br	110$

110$:	movb	@#errbyt,r0		; get the error code now
	asl	r0			; times 2 for indexing into error map
	add	r0	,r1		; now map the rt11 error into a fake
	mov	@r1	,r0		; of a rms11 error

120$:	add	#<40.*2>+20.,sp		; pop all the tiny buffers now.
	unsave	<r3,r2,r1>		; pop all the temps
	return				; and get out


defext:	.word	0
	.word	0
	.word	0
	.word	0



	.sbttl	create a file for RT11

	.psect	$pdata
en$siz::.word	0			; 1/2 largest free or 2nd largeset
	.psect	$code


	.mcall	.csispc,.dstatus,.lookup,.fetch,.enter,.close
	.psect	$code

;	CREATE
;
;	open  ( %loc filename; %val channel_number, %val type )
;
;	input:	@r5	filename address
;		2(r5)	channel number
;		4(r5)	val 'binary' or 'text' or 0
;
;	output:	r0	rms (really a mapped RT11 error) error code
;
;
;	 For RT11, create a buffered image file. It is
;	always assumed that channel '0' implies writes
;	to the attached console terminal.



fcreat::
create::save	<r1,r2,r3>		; save all the temps please
	mov	2(r5)	,r3		; channel number here
	bne	5$			; not implied terminal open
	 mov	sp	,mode+0		; say we will be writing to it
	 clr	bufp+0			; and there is nothing there yet
	 clr	r0			; no errors are possible
	 br	120$			; bye

5$:	asl	r3			; times 2 for word indexing
	call	setatr			; initialize file control data
	mov	4(r5)	,filtyp(r3)	; ensure the correct type of file
	sub	#20.	,sp		; allocate buffer for the
	mov	sp	,r2		; device status call
	sub	#40.*2	,sp		; allocate a buffer for the
	mov	sp	,r1		; .csispc data
	mov	@r5	,r0		; string address
10$:	movb	(r0)+	,(r1)+		; copy it to the csi buffer
	bne	10$			; until a null byte is found.
	movb	#'=	,-1(r1)		; fake an output filespec here
	clrb	@r1			; and .asciz
	mov	sp	,r1		; reset pointer (also saving sp)
	.csispc	r1,#defext,r1		; and try to parse the name
	mov	r1	,sp		; restore from any switches
	bcs	80$			; oops
	tst	@r1			; any device there ?
	bne	20$			; no
	mov	dkdev	,@r1		; yes, stuff a real name for DK: in
20$:	.dstat	r2	,r1		; get some device information
	bcs	60$			; oops, bad device name
	tst	4(r2)			; is the handler resident ?
	bne	30$			; yes
	mov	@#50	,r2		; no, place it at the top of
	tst	(r2)+
	.fetch	r2,r1			; the world and hope we get it
	bcs	90$			; oops

30$:	tst	2(r1)			; never allow NFS writes to disk
	beq	70$			; force bad filename error
	.enter	#rtwork,2(r5),r1,en$siz	; open the file for input
	bcs	100$			; can not find it
	clr	bufp(r3)		; say the buffer is empty
	mov	sp	,mode(r3)	; we are writing today
	clr	r0			; no errors
	br	120$			; and exit

60$:	mov	#dsterr	,r1		; error from .dstatus
	br	110$
70$:	mov	#er$fnm	,r0		; bad filename
	br	120$			; and exit
80$:	mov	#csierr	,r1		; .csispc error mapping
	br	110$			; get the correct error now
90$:	mov	#feterr	,r1		; .fetch error codes
	br	110$
100$:	mov	#enterr	,r1		; .enter error mapping
	br	110$

110$:	movb	@#errbyt,r0		; get the error code now
	asl	r0			; times 2 for indexing into error map
	add	r0	,r1		; now map the rt11 error into a fake
	mov	@r1	,r0		; of a rms11 error

120$:	add	#<40.*2>+20.,sp		; pop all the tiny buffers now.
	unsave	<r3,r2,r1>		; pop all the temps
	return				; and get out


	.sbttl	init things for open and close

;	input:	r3	channel number times 2
;	output:	nothing


setatr:	save	<r0,r1>			; init things for open and create
	clr	bufp(r3)		; offset into the buffer ?
	clr	bufs(r3)		; nothing is there today
	clr	mode(r3)		; say we are reading today
	clr	blknum(r3)		; no block number yet
	mov	#maxsiz	,bufsiz(r3)	; the size of the buffer (1000)
	mov	#binary	,filtyp(r3)	; always image mode for rt11
	mov	bufdef(r3),buflst(r3)	; insure buffer address is correct
	mov	buflst(r3),r0		; and clear it out please
	mov	bufsiz(r3),r1		; the size please
10$:	clrb	(r0)+			; simple
	sob	r1	,10$		; next please
	unsave	<r1,r0>			; pop and exit
	return




	.sbttl	close a file
	.mcall	.close


;	C L O S E
;
;	close (%val lun)
;
;	input:	@r5	channel number to close
;	output:	r0	mapped error code
;
;	calls:	flush(lun)


close::	save	<r1>			; save registers we may have
	call	flush			; dump out any remaining buffer
	mov	@r5	,r1		; then disconnect the access stream
	beq	10$			; terminal
	.close	r1			; do the rt close
	bcc	10$			; it worked
	movb	@#errbyt,r0		; it failed, map the rt11 error
	asl	r0			; to something more descriptive
	mov	cloerr(r0),r0		; simple
	br	20$			; map the error please
10$:	clr	r0			; no errors
20$:	asl	r1			; channel number times 2
	clr	bufp(r1)		; buffer_pointer[lun] := 0
	unsave	<r1>			; pop the saved r1
	return				; and exit with error in r0


rewind::mov	@r5	,r0		; get the channel number
	beq	100$			; for the terminal, a no-op
	asl	r0			; times two please
	mov	#-1	,bufp(r0)	; flag a buffer reload is needed
	clr	bufs(r0)		; nothing is in the buffer
	clr	blknum(r0)		; first block of the disk file
100$:	clr	r0			; no errors are possible
	return				; bye




	.sbttl	read a record from a sequential file


;	G E T R E C
;
;	getrec( %loc buffer, %val channel_number )
;
;	input:	@r5	address of user buffer, at least 80 bytes
;		2(r5)	channel number
;
;	output:	r0	rms sts
;		r1	record size
;
;	Read the next record from a disk file.  Assumes that the
;	user  has supplied a buffer of 132 characters to  return
;	the record to.
;
;	We really don't need GETREC for RT11 Kermit. It was used
;	in the RMS11 version (for RSXM/M+ and RSTS) only in con-
;	junction with GETC to fake RMS single character i/o. The
;	only  two places it  is called from is for  the TYPE and
;	HELP commands (C$TYPE and C$HELP).
;	GETREC assumes text (stream ascii) file only.


getrec::save	<r2,r3,r4>		; save registers we may need
	clr	r4			; recordsize := 0
	mov	@r5	,r3		; the recordbuffer address
	mov	#132.	,r2		; max size of a record to read
	clr	r1			; nothing read as of yet

10$:	cmpb	r1	,#ff		; exit if ch = form_feed
	beq	30$			;
	mov	2(r5)	,r0		; the channel number to use
	call	getcr0			; read the next character now
	tst	r0			; did it work ?
	bne	100$			; no
	cmpb	r1	,#cr		; exit if ch = carriage_return
	beq	30$			;
	cmpb	r1	,#'z&37		; exit if ch = control_z
	beq	30$			;
	cmpb	r1	,#lf		; ignore line feeds
	beq	10$			;
	inc	r4			; length := succ(length)
	movb	r1	,(r3)+		; yes, stuff the character in
	sob	r2	,10$		; up until maxrec size
	mov	#er$rtb	,r0		; too much data, return maxsize
	br	100$			; error


30$:	cmpb	r1	,#'z&37		; we get here on reading a record
	bne	40$			; terminator
	mov	#er$eof	,r0		; control z means end of file
	clr	r1			; no data is there at all
	br	100$
40$:	mov	r4	,r1		; return the record length
	br	100$			; all done if ff or lf	

100$:	unsave	<r4,r3,r2>		; pop registers we saved
	return				; bye


	.sbttl	put a record to an rt11 sequential file


;	P U T R E C
;
;	putrec( %loc buffer, %val record_size, %val channel_number )
;
;	input:	@r5	address of user buffer
;		2(r5)	record size
;		4(r5)	channel number
;
;	output:	r0	rms sts
;
;	Write the next record to  a disk file.
;
;	Assumption: The record to be written will have a cr/lf
;		    appended  to it unless the filetype is not
;		    text.  In other words, PUTREC provides the
;		    carriage control unless the file is a ter-
;		    minal.


putrec::save	<r1,r2,r3>		; save registers we may need
	mov	2(r5)	,r2		; the size of the i/o
	mov	@r5	,r3		; the buffer address
	mov	4(r5)	,r1		; the channel number please
	bne	10$			; a real disk file

	tst	r2			; faking output to a terminal
	beq	100$			; nothing at all to do ?
	print	r3	,r2		; do the terminal i/o
	br	100$			; bye
	

10$:	tst	r2			; the size of the i/o to do
	beq	30$			; nothing to do, add carriage control

20$:	clr	r0
	bisb	(r3)+	,r0		; the character to write out
	call	putcr0			; channel is passed in r1
	tst	r0			; did the write fail ?
	bne	100$			; yes, exit asap
	sob	r2	,20$		; next ch please

30$:	asl	r1			; get the channel number times 2
	cmp	filtyp(r1),#text	; is this a text file
	bne	100$			; no, don't add carriage control in
	asr	r1			; get the channel number back
	movb	#cr	,r0		; and add in a cr/lf
	call	putcr0			; simple
	movb	#lf	,r0		; and at last the line feed
	call	putcr0			; do the line feed at the end

100$:	unsave	<r3,r2,r1>		; pop registers we saved
	return				; bye


	.sbttl	getc	get one character from an input file
	.mcall	.readw


;	G E T C
;
;	getc(%val channel_number)
;
;	input:	@r5	channel_number
;	output:	r0	rms error status
;		r1	the character just read

getc::	mov	@r5	,r0
	call	getcr0
	return

getcr0::save	<r3>			; use for saving the channel#
10$:	mov	r0	,r3		; save the channel number please
	call	.getc			; get the next ch please
	tst	r0			; did the read work ok ?
	bne	100$			; no, exit
	asl	r3			; get the channel number times 2
	cmp	filtyp(r3),#text	; if filetype[lun] = text
	bne	100$			;  then
	tstb	r1			;   if ch = NULL
	bne	100$			;    then try-again
	asr	r3			; get origional channel back
	mov	r3	,r0		; setup the correct call format
	br	10$
100$:	unsave	<r3>
	return


.getc:	save	<r2,r3>			; save temps
	mov	r0	,r2		; channel number please
	mov	r0	,r1		; for the .readw please
	asl	r2			; times 2
	tst	bufs(r2)		; anything in the buffer ?
	beq	10$			; no, please load it
	cmp	bufp(r2),#-1		; need to initialize the buffer?
	bne	20$			; no
10$:	mov	bufsiz(r2),r3		; we need buffer size in words
	asr	r3			; convert bytes to words
	.readw	#rtwork,r1,buflst(r2),r3,blknum(r2)
	bcs	90$			; it failed, bye
	inc	blknum(r2)		; next time read the next block
	clr	bufp(r2)		; it worked. clear current pointer
	asl	r0			; convert words read to bytes
	mov	r0	,bufs(r2)	; and save the record size
20$:	mov	buflst(r2),r3		; get the address of the buffer
	add	bufp(r2),r3		; and point to the next character
	clr	r1			; to be returned in r1
	bisb	@r3	,r1		; simple
	inc	bufp(r2)		; buffer.pointer := succ(buffer.pointer)
	dec	bufs(r2)		; amountleft := pred( amountleft )
	clr	r0			; no errors please
	br	100$

90$:	movb	@#errbyt,r0		; get the error code
	asl	r0			; times two
	mov	reaerr(r0),r0		; map it into a unique global error

100$:	unsave	<r3,r2>
	return


	.sbttl	putc	put a single character to an rms file
	.mcall	.writw

;	P U T C
;
;	input:	@r5	the character to put
;		2(r5)	the channel number to use
;
;	Buffer single character i/o to internal disk buffer.
;	Buffer is dumped if internal buffer is  full.
;	The local buffers are allocated in CREATE and OPEN.


putc::	save	<r1>			; simply save r1 and call putcr0
	mov	2(r5)	,r1		; to do it. putcr0 will be somewhat
	clr	r0			; faster to call directly due to the
	bisb	@r5	,r0		; overhead involved in setting up an
	call	putcr0			; argument list.
	unsave	<r1>			; pop saved r1 and exit
	return				; bye


putcr0::save	<r1,r2,r3,r4>		; save registers we use
	mov	r1	,r2		; channel number
	asl	r2			; times 2 of course
	cmp	bufp(r2),bufsiz(r2)	; is the buffer full ?
	blo	20$			; no, store some more characters in it
	movb	r0	,r3		; yes, save the input character r0
	mov	bufsiz(r2),r4		; and setup for a .writw
	asr	r4			; rt11 needs word count not byte count
	tst	r1			; channel zero is always terminal
	beq	3$			; simple
	cmp	filtyp(r2),#terminal	; check for being a terminal today?
	bne	4$			; not a terminal
3$:	print	buflst(r2),bufsiz(r2)	; a terminal, force it out please
	br	5$			; and reinit the buffer now
4$:	.writw	#rtwork,r1,buflst(r2),r4,blknum(r2); dump this block to disk
	bcs	90$			; it failed for some reason
5$:	inc	blknum(r2)
	clr	bufp(r2)		; pointer := 0
	mov	buflst(r2),r4		; it worked. zero the buffer now
	mov	bufsiz(r2),r0		; get the buffer address and size
10$:	clrb	(r4)+			; for i := 1 to bufsiz
	sob	r0	,10$		;   do buffer[i] := chr(0)
	movb	r3	,r0		; ok, restore the old character
20$:	mov	bufp(r2),r1		; get the current buffer pointer
	add	buflst(r2),r1		; and point to a new home for the
	movb	r0	,@r1		; the input character in r0
	inc	bufp(r2)		; pointer := succ( pointer )
	clr	r0			; success
	br	100$

90$:	movb	@#errbyt,r0		; get the rt11 error code
	asl	r0			; times two
	mov	wrierr(r0),r0		; map it into a global error code

100$:	unsave	<r4,r3,r2,r1>
	return

	.sbttl	flush
	.mcall	.writw

flush:	save	<r1,r2>
	mov	@r5	,r1		; get the internal channel number
	asl	r1			; times 2 for indexing
	tst	bufp(r1)		; anything in the buffer
	beq	100$			; no
	tst	mode(r1)		; writing today ?
	beq	100$			; no
	tst	r1			; terminal today ?
	beq	20$			; yes
	mov	bufsiz(r1),r2		; rt11 likes to have word counts
	asr	r2			; simple
	.writw	#rtwork,@r5,buflst(r1),r2,blknum(r1)
	br	100$

20$:	print	buflst(r1),bufp(r1)
	br	100$

100$:	unsave	<r2,r1>
	clr	r0
	return





	.sbttl	rename
	.psect	$code


;	R E N A M E
;
;	input:	@r5	old filename address
;		2(r5)	new filename address
;		4(r5)	flag, lt 0 don't print the results else print a log
;
;	output:	r0	error code, zero if at least one file found
;		r1	number of files renamed
;
;	For the time being, return ER$IOP

rename::mov	#er$iop	,r0
	return






	.sbttl	delete a file(s)

;	input:	@r5	address of filename spec
;		2(r5)	if eq -1, don't print the results out
;			       0, print on terminal
;			      >0, write to lun in 2(r5)
;
;	output:	r0	RMS error code
;		r1	number of files renamed
;
;	For now, we will return ER$IOP for RT11



delete::save	<r2,r3,r4>		; save registers we may overwrite
	mov	#er$iop	,r0		; return illegal operation
	unsave	<r4,r3,r2>		; pop temps and exit
	return



	.sbttl	fparse	parse filename and fill in with defaults


;	F P A R S E
;
;	input:	@r5	input filename,     .asciz
;		defdir	the default directory name string to use
;
;	output:	2(r5)	expanded filename, .asciz, maximum length 63 bytes
;		r0	error codes
;
;	For RT11, simply return the passed string. Perhaps later do
;	something real.


fparse::save	<r1>
	mov	#defdir	,r0
	mov	2(r5)	,r1
10$:	movb	(r0)+	,(r1)+
	bne	10$
	dec	r1
	copyz	@r5	,r1		; simple
	clr	r0			; no errors are possible today
	unsave	<r1>
	return				; bye

	global	<defdir>





	.sbttl	l$ttyout

;	Print a string to the console terminal
;
;	Input:	@r5	buffer address
;		2(r5)	string length
;
;	If 2(r5) is zero, then assume .asciz


l$ttyo::save	<r0,r1,r2,r3>		; save registers we may need
	mov	@r5	,r1		; get the string address
	mov	2(r5)	,r2		; get the string length
	bne	20$			; non-zero then
	mov	r1	,r2		; count until a null now
10$:	tstb	(r2)+			; well ?
	bne	10$			; not yet, keep looking
	sub	r1	,r2		; get the length now
	dec	r2			; all done
	beq	100$			; nothing to print at all?

20$:	mov	#prtbuf	,r0		; now buffer the i/o to avoid
	mov	#36	,r3		; the printing of cr/lf at the
30$:	tstb	(r1)+			; don't copy nulls please
	beq	35$			; ignore if null
	movb	-1(r1)	,(r0)+		; copy a byte please
35$:	dec	r2			; done yet ?
	beq	40$			; yes
	sob	r3	,30$		; no, next please
40$:	movb	#200	,(r0)+		; insure no carraige control !
	clrb	@r0			; must be passed .asciz
	mov	#prtbuf	,r0		; point back to the start of buffer
	emt	351			; do the .print kmon request
	tst	r2			; any more data to buffer ?
	bne	20$			; yes, try again

100$:	unsave	<r3,r2,r1,r0>
	return



sttyou::mov	r5	,-(sp)
	mov	sp	,r5
	add	#4	,r5
	call	l$ttyo
	mov	(sp)+	,r5
	return


l$pcrl::print	#100$
	return

100$:	.byte	cr,lf,0,0





;	G E T S Y S
;
;	output:	r0	operating system
;
;	sy$11m	(1)	for rsx11m
;	sy$ias	(3)	for ias
;	sy$rsts	(4)	for rsts
;	sy$mpl	(6)	for m+
;	sy$rt	(7)	for rt11 ????


getsys::mov	#7	,r0		; this is rt11 folks
	return				; bye

	.sbttl	misc routines

;	E X I T
;
;	exit to kmon

	.mcall	.exit

exit::	.exit				; should always work ok
	halt				; huh ?


	.mcall	.twait			; mark time request


suspen::save	<r1>			; save temps
	mov	@r5	,r1		; sleep time in seconds
	beq	10$			; nothing, must be fractional
	mul	#60.	,r1		; sixty clock ticks in a second
	clr	r0			; low order part
	br	20$			; ignore the fractional part
10$:	mov	2(r5)	,r0		; sleep < 1 second
20$:	add	r1	,r0		; total time to sleep
	mov	r0	,-(sp)		; setup the timeout block
	clr	-(sp)			; two words please
	mov	sp	,r1		; point to it
	.twait	#rtwork,r1		; suspend ourself for a while
	bcs	30$			; it worked ok
	clr	r0			; return success
	br	100$			; bye
30$:	movb	@#errbyt,r0		; it failed, map the error into
	asl	r0			; a global error number
	mov	twaerr(r0),r0		; simple
100$:	cmp	(sp)+	,(sp)+		; pop time buffer and exit
	unsave	<r1>			; pop registers
	return				; bye


	.sbttl	dummy epts for rsx/rsts compatibility


;	Dummy routines
;
;	DRPPRV	( )
;	GETPRV	( )
;	GETUIC	( )
;	LOGOUT	( )
;	QUOCHK	( )
;	SETCC   ( %loc ast_handler )
;	TTRFIN	( )
;	TTRINI	( )


setcc::
getuic::
logout::
quochk::
qspool::
noecho::
echo::
runjob::
chkabo::clr	r0
getprv::
drpprv::
throtl::return

asctim::
ascdat::mov	@r5	,r0
	clrb	@r0
	return



getatr::mov	#er$iop	,r0
	return

putatr::clr	r0
	return

binfil::clr	r0
	calls	chkext	,<@r5>
	return

chkpar::clr	r0
	return

systat::
sercmd::mov	#er$iop	,r0
	return

okuser::mov	(sp)+	,@sp
	return


dskuse::mov	@r5	,r0
	clrb	@r0
	return

getmcr::mov	@r5	,r0
	clrb	@r0
	clr	r0
	return


	.sbttl	copy command

copy::	save	<r2,r3>			; save temp registers please
	clr	r2			; number of blocks = 0
	mov	#1000	,r3		;
	calls	open	,<@r5,#lun.in,#binary> ; get the input file
	tst	r0			; did it work?
	bne	110$			; no, simple exit then
	calls	create	,<2(r5),#lun.out,#binary> ; create the destination
	tst	r0			; did it work ?
	bne	100$			; no, close the input file now

10$:	calls	getc	,<#lun.in>	; get the next ch from the file
	tst	r0			; did it work ?
	bne	20$			; no, check for eof condition
	calls	putc	,<r1,#lun.ou>	; yes, copy to output file
	tst	r0			; did that work ?
	bne	20$			; no
	sob	r3	,10$		; next ch please
	inc	r2			; blocks := succ( blocks )
	mov	#1000	,r3		; copy the next block now
	br	10$			; back for more now please

20$:	cmp	r0	,#er$eof	; normal exit should be eof
	bne	30$			; it's not
	clr	r0			; clear error codes
30$:	save	<r0>			; save error code
	calls	close	,<#lun.in>	; close input file
	calls	close	,<#lun.ou>	; close output file
	unsave	<r0>			; restore error code and exit
	br	120$			; and exit

100$:	calls	close	,<#lun.in>	; close input if output create failed
110$:					;
120$:	mov	r2	,r1		; return number of blocks and exit
	unsave	<r3,r2>
	return






	.enabl	lsb

direr$::mov	r0	,-(sp)		; direrr will select whether or not
	mov	4(sp)	,r0		; to call rms error or FIP (or DIR)
	beq	10$			; error based on whether the error
	calls	syserr	,<r0,#errtxt>	; code is < 0 (implies RMS) or > 0
	print	#errtxt			; which  implies either FIP  (RSTS)
	message				; or a DIRECTIVE error (RSX).  Thus
10$:	mov	(sp)+	,r0		; for RSX all error codes should be
	mov	@sp	,2(sp)		; made > 0 for non RMS errors.
	tst	(sp)+			; error 0 is a no-op.
	return

	global	<errtxt>

	.dsabl	lsb

	.sbttl	things to do eis instructions


	.psect

$mul::	mov	r0	,-(sp)
	mov	r1	,-(sp)
	mov	6(sp)	,r0
	mov	10(sp)	,r1
	mov	r0,-(sp)
	mov	#21,-(sp)
	clr	r0
10$:	ror	r0
	ror	r1
	bcc	20$
	add	2(sp),r0
20$:	dec	(sp)
	bgt	10$
	cmp	(sp)+	,(sp)+
	mov	r1	,10(sp)
	mov	(sp)+	,r1
	mov	(sp)+	,r0
	mov	(sp)	,2(sp)
	tst	(sp)+
	return
	
$div::	mov	r0	,-(sp)
	mov	r1	,-(sp)
	mov	6(sp)	,r0
	mov	10(sp)	,r1
	mov	#20,-(sp)
	mov	r1,-(sp)
	clr	r1
e00040:	asl	r0
	rol	r1
	cmp	r1,(sp)
	bcs	e00054
	sub	(sp),r1
	inc	r0
e00054:	dec	2(sp)
	bgt	e00040
	cmp	(sp)+	,(sp)+
	mov	r1	,6(sp)
	mov	r0	,10(sp)
	mov	(sp)+	,r1
	mov	(sp)+	,r0
	return


$ash::	tst	2(sp)			; left shift or rigth shift?
	bmi	20$			; do some divisions by 2
10$:	tst	2(sp)			; anything left to do ?
	ble	100$			; no, time to go
	asl	4(sp)			; shift left
	dec	2(sp)			; all done yet ?
	br	10$
20$:	tst	2(sp)			; divide by 2
	bge	100$			; all done
	asr	4(sp)			; keep going
	inc	2(sp)			; all done yet ?
	br	20$
100$:	mov	(sp)+	,(sp)		; pop rept count and exit
	return


	.end
