	.title	rsxio	rsx based i/o for TED

	.enabl	gbl

;	Brian Nelson
;	Computer Services
;	University of Toledo
;	2801 West Bancroft
;	Toledo , Ohio 43606
;
;	(419) 537-2511
;
;
;	
;	
;	Copyright (C) 1978, 1979, 1980, 1981, 1982 Brian Nelson
;	
;	
;	
;	This software is furnished under a license and may
;	be  used  and  copied  only in accordance with the
;	terms of such license and with  the  inclusion  of
;	the  above copyright notice.  This software or any
;	other copies thereof may not be provided or other-
;	wise made available to any other person.  No title
;	to and ownership of the software is hereby  trans-
;	ferred.
;	
;	The information in this  software  is  subject  to
;	change  without notice and should not be construed
;	as a commitment by the University of Toledo or  by
;	the author.
;	
;
;	Developed (of course) under RSTS 7.0 and 7.1 using
;	RSX emulation. Use of channel numbers  is done  in
;	order to retain operating system indepenence.
;	All i/o is in emulation of how things are done  on
;	RSTS, since the RSTS version was, after all,  done
;	first. Anyway, we do not use any FCS record i/o so
;	it is just as well.
;	

	.sbttl	macros used



	.mcall	fdbdf$	,fdat$a	,fdrc$a	,fdop$a	,fdbf$a	,fdbk$a
	.mcall	qiow$	,dir$	,finit$	,exit$s	,fsrsz$
	.mcall	csi$	,csi$1	,csi$2
	.mcall	opns$r	,open$w	,ofnb$r	,opnt$d	,close$
	.mcall	get$	,put$	,read$	,write$	,wait$	,fdbk$r
	.mcall	fdat$r
	.mcall	alun$s


	.psect

	.macro	.newline
	call	$pcrlf
	global	<$pcrlf>
	.endm	.newline

	.macro	moverr	err
	mov	err	,-(sp)
	call	seterr
	.endm	moverr


	.macro	attach
	mov	#ttast	,-(sp)
	clr	-(sp)
	clr	-(sp)
	mov	#io.ata!tf.esq,-(sp)
	call	doqio
	.endm


	.macro	detach
	mov	#ttast	,-(sp)
	clr	-(sp)
	clr	-(sp)
	mov	#io.det,-(sp)
	call	doqio
	.endm


	.macro	ttout	buff,len
	clr	-(sp)
	mov	len	,-(sp)
	mov	buff	,-(sp)
	mov	#io.wlb	,-(sp)
	call	doqio
	.endm

	.macro	ttread	buff,len
	clr	-(sp)
	mov	len	,-(sp)
	mov	buff	,-(sp)
	mov	#io.rlb	,-(sp)
	call	doqio
	.endm

	.macro	binout	buff,len
	clr	-(sp)
	mov	len	,-(sp)
	mov	buff	,-(sp)
	mov	#io.wlb!tf.cco!tf.wal,-(sp)
	call	doqio
	.endm

	.macro	binread	buff,len
	clr	-(sp)
	mov	len	,-(sp)
	mov	buff	,-(sp)
	mov	#io.rlb!tf.ral!tf.rne,-(sp)
	call	doqio
	.endm

	.macro	echo	buff,len
	clr	-(sp)
	mov	len	,-(sp)
	mov	buff	,-(sp)
	mov	#io.wlb!tf.cco,-(sp)
	call	doqio
	.endm


	.sbttl	file fdb definitions

	fcsio	=	0
	.iif ndf,fcsio	,fcsio	=	0
	.psect	fdbpnt	,ro,d,lcl,rel,con

;	note: lun 6 is help file, always uses block i/o
;
;	Index  into the fdb  for a known channel number. Simpler
;	than having to allocate FDB's all over the place as well
;	as being compatible with  the original  form of i/o used
;	under RSTS.
;
;	FDBLST:	fdb addresses for get/put operations
;	RWFDBL:	fdb addresses for read/write i/o ops
;	FILMOD:	save type of i/o for CLOSE (r/w or g/p)
;	BUFLST: addresses of default block buffers.
;	RWIOST:	addresses of i/o status blocks for read/write


	.if eq	,fcsio
	.iff
fdblst::.word	0 ,fdb1	 ,fdb2	,fdb3	,fdb4	,fdb5	,fdb6  ,fdb7
	.word	   fdb8
	.ift
fdblst::.word	0 ,rwfdb1,rwfdb2,rwfdb3	,rwfdb4	,rwfdb5	,fdb6  ,rwfdb7
	.word	   rwfdb8
	.endc
rwfdbl::.word	0 ,tmpfdb,rwfdb2,rwfdb3	,rwfdb4	,rwfdb5	,fdb6  ,rwfdb7
	.word	   rwfdb8
rwiost::.word	0 ,rwios1,rwios2,rwios3 ,rwios4 ,rwios5 ,hlpios,rwios7
	.word	   rwios8
buflst::.word	0 ,inpbuf,inpbuf,inpbuf	,inpbuf	,inpbuf	,inpbuf,jrnbuf
	.word	   errbuf

	.assume	tmplun eq 1
	.assume	hlplun eq 6
	.assume jrnlun eq 7



;	we never use record i/o in ted
;
	.iif eq	,resovr	,fsrsz$	0

	.mcall	fdrc$r	,fdbk$r	,fdop$r	,fdbf$r	,fdat$r
	.psect	$code

fcsini::save	<r0,r1,r2>
	.iif eq	,resovr	,finit$
	mov	#10	,r2		; set defaults for file attr

10$:	mov	r2	,r1		; must init all fdb's at run
	asl	r1			; time for reslib support
	fdrc$r	fdblst(r1),#fd.rwm	; we are using read$/write$
	fdbk$r	fdblst(r1),#inpbuf,#2048.,,#10,rwiost(r1)
	fdop$r	fdblst(r1),r2,#csiblk+c.dsds,,<#fa.wrt>
	calls	setatr	,<r2,#r.var,#fd.cr,#0>
	sob	r2	,10$

	fdbk$r	#tmpfdb,#tmpbuf,#2000,,#11,#tmpiost
	fdop$r	#tmpfdb,#tmplun,#tmpdsc,,<#fa.wrt!fa.tmp>

	fdbk$r	#hlpfdb,#hlpbuf,#1000,,#12,#hlpiost
	fdop$r	#hlpfdb,#hlplun,#csiblk+c.dsds,,<#fa.rd!fa.shr>

	unsave	<r2,r1,r0>
	return

tmpdsc:	.word	0,0,0,0,10,10$
10$:	.asciz	/EDIT.TMP/
	.even





;	S E T A T R
;
;	used to set record defaults for file creates
;
;	@r5	channel number
;	2(r5)	new default f.rtype	(0,r.fix or r.var)
;	4(r5)	new default f.ratt  	(0,fd.cr or fd.ftn)
;	6(r5)	new default f.rsiz	(meaningful for r.fix only)

setatr::save	<r0>			; set file atttrbutes for FDB
	mov	@r5	,r0		; channel number
	asl	r0			; always times 2 please
	fdat$r	rwfdbl(r0),2(r5),4(r5),6(r5)	; simple
	unsave	<r0>
	return


inpbuf	= inbuf
bf$pnt	= bufpnt
er$sav	= errsav
by$cnt	= recount
bl$num	= blknum
io$sta	= iostat


fcserr::.print	#100$
	mov	r0	,-(sp)
	movb	er$sav	,r0
	.wrdec	r0
	mov	(sp)+	,r0
	.print	#110$
	mov	er$sav	,-(sp)
	call	prterr
	.newline
	return

	.enabl	lc
100$:	.asciz	<cr><lf>/?EDIT - FCS error number /
110$:	.asciz	/  /
	.dsabl	lc
	.even


	.sbttl	close a file

$close::clr	er$sav			; no errors as of yet.
	mov	r0	,-(sp)
	mov	r1	,-(sp)		; save this one please
	mov	r2	,-(sp)
	mov	@r5	,r2		; channel number please
	ble	100$			; noop for zero
	asl	r2			; times 2
	mov	fdblst(r2),r1		; point to the fdb please
	bit	#fd.rwm	,filmod(r2)	; read/write mode today ?
	beq	10$			; no
	mov	rwfdbl(r2),r1		; yes, use correct mode
10$:	close$	r1			; close it up please
	bcc	100$			; successful !
	moverr	f.err(r1)		; return any errors
100$:	clr	filmod(r2)
	clr	io$sta(r2)
	calls	setatr	,<@r5,#r.var,#fd.cr,#0>
110$:	mov	(sp)+	,r2
	mov	(sp)+	,r1
	mov	(sp)+	,r0		; and exit
	return


	.sbttl	temp file i/o



cretmp::opnt$d	#tmpfdb			; create the temp file.
	movb	f.racc+tmpfdb,filmod+<tmplun*2>
	moverr	<tmpfdb+f.err>		; return any errors
	blt	10$			; < 0, it is an error!
	clr	er$sav			; zap err code
	return
10$:	sec				; yes
	return

rgettm::clr	er$sav			; say no errors for now
	mov	r0	,-(sp)		; zapped by read$
	mov	r1	,-(sp)		; save this please
	mov	2(r5)	,-(sp)		; block number stuff.
	clr	-(sp)			; setup 2 word area for virtual
	mov	sp	,r1		; virtual block number address.
	mov	#tmpfdb	,r0		;
	fdbk$r	,@r5,#pg.siz,r1,,#tmpiost; setup for read$
	read$
	wait$	#tmpfdb,,#tmpios	; force synch i/o operations.
	add	#4	,sp		; pop stack
	cmpb	#is.suc	,tmpios+0	; did it work ?
	beq	100$			; yes
	moverr	<tmpfdb+f.err>		; no, return the FCS error.
	sec				; set this also
	br	110$			; exit
100$:	clc				; success
	mov	tmpios+2,by$cnt		; size of the read
110$:	mov	(sp)+	,r1		; pop temp and exit
	mov	(sp)+	,r0		; pop it
	return


rputtm::clr	er$sav			; say no errors for now
	mov	r0	,-(sp)		; zapped by write$
	mov	r1	,-(sp)		; save this please
	mov	2(r5)	,-(sp)		; block number stuff.
	clr	-(sp)			; setup 2 word area for virtual
	mov	sp	,r1		; virtual block number address.
	mov	#tmpfdb	,r0		; fdb address
	fdbk$r	,@r5,#pg.siz,r1,,#tmpiost; setup for write$
	write$
	wait$	#tmpfdb,,#tmpios	; force synch i/o operations.
	add	#4	,sp		; pop stack
	cmpb	#is.suc	,tmpios+0	; did it work ?
	beq	100$			; yes
	moverr	<tmpfdb+f.err>		; no, return the FCS error.
	sec				; set this also
	br	110$			; exit
100$:	clc				; success
110$:	mov	(sp)+	,r1		; pop temp and exit
	mov	(sp)+	,r0		; pop it
	return


	.sbttl	direct access read/write

e$getb::
$getbl::clr	er$sav			; say no errors for now
	mov	r0	,-(sp)		; zapped by write$
	mov	r1	,-(sp)		; save this please
	mov	r2	,-(sp)		;  and so on
	mov	r3	,-(sp)		;   and so on
	mov	6(r5)	,-(sp)		; block number stuff.
	clr	-(sp)			; setup 2 word area for virtual
	mov	sp	,r1		; virtual block number address.
	mov	4(r5)	,r3		; channel number	
	asl	r3			; times 2
	mov	rwfdbl(r3),r2		; and get the fdb address
	mov	rwiost(r3),r0		; get i/o status block address
	clr	2(r0)			; preset no bytes read from dev
	mov	r2	,r0		; copy it for the calls
	fdbk$r	,@r5,2(r5),r1,,rwiost(r3); setup for write$
	read$
	bcs	10$			; oops
	wait$	r2,,rwiost(r3)		; force synch i/o operations.
10$:	add	#4	,sp		; pop virtual block number
	mov	rwiost(r3),r1		; get result of read operation
	mov	2(r1)	,rd$siz(r3)	; and save the read size
	mov	2(r1)	,by$cnt		; here also please
	beq	15$			; nothing, set ie.eof error
	cmpb	#is.suc	,@r1		; did it work ?
	beq	100$			; yes
	cmpb	@r1	,#ie.eov	; end of volume error ?
	bne	20$			; no
15$:	movb	#ie.eof	,@r1		; yes, change it to eof
20$:	clr	rd$siz(r3)		; no
	clr	by$cnt			;
	moverr	<@r1>			; no, return the FCS error.
	sec				; set this also
	br	110$			; exit
100$:	clc				; success
110$:	mov	(sp)+	,r3
	mov	(sp)+	,r2		; pop temp and exit
	mov	(sp)+	,r1		; pop temp and exit
	mov	(sp)+	,r0		; pop it
	return



	.sbttl	more read/write

$putbl::clr	er$sav			; say no errors for now
	tst	4(r5)			; convert channel zero in TI:
	bne	10$			; no, ok
	call	rputkb			; yes, do a qio to ti:
	return				; bye

10$:	mov	r0	,-(sp)		; zapped by write$
	mov	r1	,-(sp)		; save this please
	mov	r2	,-(sp)		;  and so on
	mov	r3	,-(sp)		;   and so on
	mov	6(r5)	,-(sp)		; block number stuff.
	clr	-(sp)			; setup 2 word area for virtual
	mov	sp	,r1		; virtual block number address.
	mov	4(r5)	,r3		; channel number	
	asl	r3			; times 2
	mov	rwfdbl(r3),r2		; and get the fdb address
	mov	rwiost(r3),r0		; get i/o status block address
	mov	r2	,r0		; copy it for the calls
	fdbk$r	,@r5,2(r5),r1,,rwiost(r3); setup for write$
	write$
	bcs	20$			; oops
	wait$	r2,,rwiost(r3)		; force synch i/o operations.
20$:	add	#4	,sp		; pop virtual block number
	mov	rwiost(r3),r1		; get result of read operation
	cmpb	#is.suc	,@r1		; did it work ?
	beq	100$			; yes
	moverr	<@r1>			; no, return the FCS error.
	sec				; set this also
	br	110$			; exit
100$:	clc				; success
110$:	mov	(sp)+	,r3
	mov	(sp)+	,r2		; pop temp and exit
	mov	(sp)+	,r1		; pop temp and exit
	mov	(sp)+	,r0		; pop it
	return


e$flus::
$flush::save	<r0,r1,r2,r3,r4>	; save all temps please
	mov	2(r5)	,r1		; channel number
	asl	r1			; time 2
	mov	rwfdbl(r1),r2		; get address of fdb
	mov	bufpnt(r1),r0		; get the current buffer pointer
	clr	r3			; clear size of remaining data
	tst	r0			; anything in the buffer ?
	beq	20$			; no
	tst	bl$num(r1)		; get number of next block 
	br	1$
	bne	5$
1$:	inc	bl$num(r1)		; get number of next block 
5$:	mov	bl$num(r1),r4		; save number of next block

10$:	tst	r0			; even here ?
	beq	20$			; yes, do not write extra block
	add	#1000	,r3		; increment size of leftovers
	cmp	r0	,#1000		; found out how much to dump?
	blo	20$			; yes
	sub	#1000	,r0		; no, keep looking for < block
	inc	bl$num(r1)		; increment eof data also
	br	10$			; and check again
20$:	tst	r3			; need to dump last block(s)?
	beq	30$			; no
	calls	$putbl	,<@r5,r3,2(r5),r4>; yes, dump remaining data
30$:	mov	bl$num(r1),f.efbk+2(r2)	; store eof block in fdb
	mov	r0	,f.ffby(r2)	; and first free byte also
	mov	mx$siz(r1),f.rsiz(r2)	; stuff max recordsize
	clr	bufpnt(r1)		; no longer useful
	clr	bl$num(r1)		; same for block number
	unsave	<r4,r3,r2,r1,r0>	; pop temps and exit
	return				; bye


	.sbttl	kb input and output

;	rgetkb	0(r5)	=	buffer address
;		2(r5)	=	buffer size
;		4(r5)	=	channel number

rgetkb::clr	by$cnt			; clear byte count
	clr	er$sav			; clear error flag
	alun$s	#5,#"TI,#tiunit		; insure it is assigned
	attach				; insure terminal is attatched
	ttread	@r5,2(r5)		; ask for the read now.
	cmpb	#ie.eof	,kbiost		; eof found?
	bne	10$			; exit
	moverr	#<ed.eof&377>		; yes, flag the error
	sec				; to be sure
	br	100$			; exit
10$:	cmpb	#is.suc	,kbiost		; successful read ?
	beq	20$			; yes
	moverr	kbiost			; no, return error code
	sec				; flag error and exit
	br	100$			; bye
20$:	mov	kbiost+2,by$cnt		; but did we get anything?
	cmp	#is.cr	,kbiost		; was it a cr/lf terminator?
	bne	30$			; no
	mov	r0	,-(sp)		; yes, stuff some at the end
	mov	@r5	,r0		; of the buffer then please.
	add	by$cnt	,r0		; pointing to the end now.
	movb	#cr	,(r0)+		; a carriage return
	movb	#lf	,(r0)+		; and a line feed
	clrb	@r0			; may as well do this also.
	add	#2	,by$cnt		; fix the length up and exit.
	mov	(sp)+	,r0		; pop this one please
30$:	clc				; insure ok
100$:	return



	.sbttl	terminal writes

	fubar	=	0
	rbsiz	=	50
rputkb::clr	er$sav			; clear out error codes

	.if ne	,fubar			; have problems writing data
	.ift				; thats in a reslib ????????
	save	<r0,r1,r2,r3>
	sub	#rbsiz+2,sp		; get a buffer
	mov	2(r5)	,r0		; get the size of this write
	mov	@r5	,r2		; address of the data

10$:	tst	r0			; anything to write?
	ble	40$			; no
	mov	#rbsiz	,r3		; assume we will copy this much
	cmp	r0	,r3		; but is write size > buffersiz
	bgt	20$			; yes
	mov	r0	,r3		; no, use size of leftovers
20$:	mov	sp	,r1		; insure pointing to the buffer
	mov	r3	,-(sp)		; save the size please

30$:	movb	(r2)+	,(r1)+		; copy a byte
	sob	r3	,30$		; next please
	mov	(sp)+	,r3		; pop length of the data
	mov	sp	,r1		; point back to the copy of it
	ttout	r1,r3			; and que up a write with a wait
	sub	#rbsiz	,r0		; adjust the size of whats left
	br	10$
40$:	add	#rbsiz+2,sp
	unsave	<r3,r2,r1,r0>
	return
	.endc				; if ne,fubar

	ttout	@r5,2(r5)		; and que up a write
	bcc	100$
	alun$s	#5,#"TI,#tiunit		; insure it is assigned
	ttout	@r5,2(r5)		; and que up a write
100$:	return				; and exit


tiatta::attach
	return

tidet::	detach
	return

recho::	clr	er$sav			; clear out error codes
	alun$s	#5,#"TI,#tiunit		; insure it is assigned
	attach
	echo	#10$,#1
	return				; and exit

10$:	.byte	0,0


	.mcall	astx$s

ttast::	cmpb	(sp)	,#3		; control C ?
	bne	100$			; no
	.setst	#rtcc			; yes, flag for checks
100$:	tst	(sp)+
	astx$s				; and exit from ast service


	.sbttl	binary i/o for scope editor


rgetbn::save	<r0,r1>			; for screen editor
	clr	errsav
	binread	r4,#1			; read one char, no echo, binary
	cmpb	#is.suc	,kbiost		; did it work?
	beq	20$			; yes
	alun$s	#5,#"TI,#tiunit		; insure it is assigned
	attach				; ensure terminal is there
	binread	r4,#1			; read one char, no echo, binary
	cmpb	#is.suc	,kbiost		; did it work ?
	beq	20$			; yes
	moverr	kbiost			; no, copy the error over
	.errprt	errsav
20$:	unsave	<r1,r0>			; and exit
	return


rputbn::save	<r0>			; for screen editor
	clr	errsav
	binout	@r5,2(r5)		; and write one character now.
	cmpb	#is.suc	,kbiost		; did it work ?
	beq	20$			; yes, exit
	alun$s	#5,#"TI,#tiunit		; insure it is assigned
	attach				; ensure terminal is there
	binout	@r5,2(r5)		; and write one character now.
	cmpb	#is.suc	,kbiost		; did it work ?
	beq	20$			; yes
	moverr	kbiost			; no, copy the error over
	.errprt	errsav
20$:	unsave	<r0>			; and exit
	return



seterr::mov	2(sp)	,er$sav
	mov	(sp)+	,(sp)
	tstb	er$sav
	return



	.sbttl	spool to lp0:

	.mcall	print$

rsxspl::mov	r0	,-(sp)		; save temps
	mov	r1	,-(sp)		; also this one
	mov	@r5	,r1		; unit number file is open on
	asl	r1			; get into word offset
	mov	fdblst(r1),r1		; fdb for that file
	clr	errsav
	print$	r1,,,#"LP,#1		; spool file to lp0 now
	bcc	100$
	moverr	f.err(r1)
100$:	mov	(sp)+	,r1		; pop temps and exit
	mov	(sp)+	,r0		;
	return				; bye




	.sbttl	do qio's for ti: (on lun 5)

;	input:	10(sp)	^C ast
;		6(sp)	byte count
;		4(sp)	buffer address
;		2(sp)	fcn
;		0(sp)	return address

	fcn	=	2+2
	bfa	=	2+4
	bfl	=	2+6
	qast	=	2+10

	.mcall	qiow$s

doqio::	mov	r2	,-(sp)
	mov	sp	,r2
	qiow$s	fcn(r2),#5,#20,#50,#kbiost,,<bfa(r2),bfl(r2),qast(r2)>
	mov	(sp)+	,r2
	mov	@sp	,10(sp)
	bcs	100$
	add	#4*2	,sp
	clc
	return
100$:	add	#4*2	,sp
	sec
	return


	.sbttl	delete a file
	.mcall	csi$,csi$1,csi$2,nmblk$
	csi$			;Define CSI offsets locally

	.enabl	gbl

defalt:	nmblk$	,,0,SY,0	;No default name or extension

	routine	$delete


	save
	mov	@r5,r3		;Get address of string
	.len	r3		;Get length of string
	sub	#c.size,sp	;Need a block for CSI
	mov	sp,r2		;Save address for later
	mov	#s.fdb,r1	;Length of FDB
	sub	r1,sp		;Get an FDB
	mov	sp,r4		;And save it
;
; at this point:
;	r0 = length of file name string
;	r1 = length of FDB for later
;	r2 => csi block
;	r3 => file name string
;	r4 => file descriptor block
;	r5 => input parameter
;
	mov	r0,c.cmld(r2)	;Save length of string
	mov	r3,c.cmld+2(r2) ;Save start of string
	csi$1	r2		;Do first scan
	bcs	100$		;Error
	csi$2	r2,OUTPUT	;Do second scan
	bcs	100$		;Error
	bitb	#cs.mor!cs.wld,c.stat(r2) ;Bad bits?
	bne	100$		;Yes, error
	add	#c.dsds,r2	;Point to CSI data set
	mov	#defalt,r3	;Point to NMBLK$
	mov	r4,r0		;Copy FDB pointer
10$:
	clrb	(r4)+		;Clear the FDB
	sob	r1,10$		;Do whole thing
	movb	#lstlun,f.lun(r0) ;Borrow a LUN
	mov	r0,r1		;Copy FDB pointer again
	add	#f.fnb,r1	;Point to FNB inside FDB
;
; At this point:
;	r0 => FDB
;	r1 => FNB in FDB
;	r2 => C.DSDS in CSI block
;	r3 => Default name block
;	r5 => Input parameters
;
	callg	.parse		;Parse the file name
	bcs	100$		;Error
	bit	#nb.ver,n.stat(r1) ;Was a version number spec.?
	beq	20$		;No
	bit	#nb.svr,n.stat(r1) ;Wildcarded version?
	beq	30$		;Yes
;
; Have no version, or wildcarded version
;
20$:
	bic	#nb.svr,n.stat(r1) ;Make sure not wildcarded
	bis	#nb.ver,n.stat(r1) ;Make sure have a version
	clr	n.fver(r1)	;And make it version 0
30$:
	callg	.dlfnb		;Delete the file if lucky
100$:
	mov	f.err(r0),@#er$sav ;Return the error code if any
	bmi	110$		;Have error
	clr	@#er$sav	;No error
110$:
	add	#s.fdb+c.size,sp ;Clean stack
	unsave
	return			;All done



	.sbttl	reqext - Requested exit ast
;
; This routine is called to tell the RSX executive that the
; task should be notified if somebody tries to force the
; editor to exit via the ABOrt command from MCR, or an ABORT$
; directive from a program.
;
; The purpose of requesting notification is so that we can
; make sure and close the temp file.  This is necessary as
; a temp file does not exist in the user directory, so there
; is no way to delete a temp file after the program exits.
;
; If the editor was to exit without closing the temp file,
; the file header and all blocks allocated to the temp file
; are not released, so you end up loosing both usable data
; blocks on disk and usable file headers in the index file.
; This was found out the hard way as the editor didnt used
; to close the temp file, but assumed that was taken care of
; by the exec when the EXIT$S call was executed.  When we
; finally got magtape so that we could do DSCs of our system
; disk (RM02), we found over 200 temp files that were created
; by about 6 people in one years time that were never deleted.
;
reqext::

	.mcall	srex$s,exit$s
	srex$s	#exast
; If there is an error, we will ignore it, as the directive
; is not essential to program operation.  Any error would be
; from a RSTS system, or an RSX system prior to V4.0, or an
; RSX V4.0 system that elected not to include directive during
; SYSGEN.
	clc			;Clear error flag
	return			;and exit for now

exast::
	close$	#tmpfdb		;Close the temp file
	exit$s			;And exit


	.sbttl	get date and time


	.enabl	lc
	.mcall	gtim$s


dattim::save
	mov	@r5	,r0		; r0 := caller result addr
	sub	#16.	,sp		; make room for result
	mov	sp	,r1		; result addr for gtim$
	gtim$s	r1			; get time and date
	mov	g.tida(r1),r2		; r2 := day
	jsr	pc	,cnvert		; convert and store day
	movb	#'-	,(r0)+		; insert dash
	mov	g.timo(r1),r2		; r2 := month
	asl	r2
	add	g.timo(r1),r2		; r2 := 3*month
	add	#mnthtab-3,r2		; r2 := mnthtab[3*month]@
	movb	(r2)+	,(r0)+
	movb	(r2)+	,(r0)+		; store month name
	movb	(r2)+	,(r0)+
	movb	#'-	,(r0)+		; insert dash
	mov	@r1	,r2		; r2 := year
	jsr	pc	,cnvert		; convert and store year
	movb	#40 	,(r0)+		; final space
	movb	#40 	,(r0)+		; final space

	mov	#3,r3			; loop count := 3
	add	#g.tihr,r1		; start with hours
1$:	mov	(r1)+,r2		; begin loop
	jsr	pc,cnvert		;   convert to ascii and store
	dec	r3			;   if done
	beq	2$			;     then exit loop
	movb	#':,(r0)+		;     else insert colon
	br	1$			; end loop
2$:	add	#16.,sp
	unsave
	return
;
; cnvert: internal procedure to convert
; integer in r2 to ascii.
cnvert:	add	#366,r2		;begin loop
	tstb	r2
	bpl	cnvert		;end loop
	add	#"00-366,r2	;convert to ascii
	swab	r2		;reorder bytes
	movb	r2,(r0)+	;store digit
	swab	r2
	movb	r2,(r0)+	;store digit
	rts	pc
;
mnthtab:.ascii	/JanFebMarAprMayJunJulAugSepOctNovDec/


	.sbttl	same tty i/o for RSX and RSTS but called

;	ttio0 0 is .asciz print, ttio1 has length on stack
;
;	ttio0:	0(sp)	=	return address
;		2(sp)	=	string address to print
;
;	ttio1:	0(sp)	=	return address
;		2(sp)	=	string address to print
;		4(sp)	=	length of the string



ttio0::	mov	r5	,-(sp)		; save a temp
	tst	-(sp)
	mov	sp	,r5		; emt 376, shuffle saved r5 and
	mov	2(sp)	,(r5)+		; 0(sp) = 2(sp) (saved r5)
	mov	4(sp)	,(r5)+		; 2(sp) = 4(sp) (saved return)
	mov	6(sp)	,(r5)+		; 4(sp) = 6(sp) (string address)
	clr	@r5			; 6(sp) = 0
	br	ttioc

ttio1::	mov	r5	,-(sp)		; save a temp
ttioc:	mov	sp	,r5		; set up the pointers
	add	#4	,r5		; point to the string address.
	callg	$ttyout			; call the TTYOUT subroutine.
	mov	(sp)+	,r5		; restore the register
	mov	(sp)	,4(sp)		; and pop the stack of the
	add	#4	,sp		; arguement list
	return

	.end
