	.title	rstsio
	.ident	/009/

;	Copyright (C) 1979 1980 1981  Brian Nelson
;
;
;	
;	This software is furnished in  an  as-is
;	condition,  with no committments of sup-
;	port or updates.  This software may  NOT
;	be sold for profit nor can it be includ-
;	ed in any package to be sold for  profit
;	without  the  written consent of the au-
;	thor.  This software may  be  used  only
;	within the above conditions of use.
;	
;	The information in contained  herein  is
;	subject  to  change  or  revision at any
;	time without notice.
;	
;	
;	
;	p.s.  If that sounds  a little heavy, you
;	ARE  getting  this  for  free.  It is the
;	system editor at Toledo,  and in  use  at
;	several other sites.   We have an average
;	access count of 200,000 each quarter here
;	for it.
;

	.globl	getc	,retc
	.sbttl	get a line from disk/tape/keyboard ect....

	.if ne	,rsx11m
	.ift
	.enabl	gbl
	.endc

;	edits
;
;	05-oct-82	bdn	fix for null records from f77 created files


	section	$edio

	.sbttl	open,close,create files

;$open	0(r5)	=	the filename address, null terminated
;	2(r5)	=	channel number to use
;	on exit:
;	bufpnt(2*chan)	=	bufsiz+1
;	iostat(2*chan)	=	RSTS 'STATUS' word, as in BASIC
;	blknum(2*chan)	=	0

	questr	=	2 + 4 + 40 + 100 ; A '*' or '?' in filespec
	illnam	=	2		 ; ? Illegal filename err num

	.globl	rmswrn	,suspend


$open::	call	ope			; try the open out for size
	cmpb	@#errsav,#32.		; Run out of small buffers.
	bne	10$			; no, all may be well (?)
	call	suspend			; wait a second please.
	call	ope			; and try one more time.
10$:	return				; bye.....


ope:	save	<r0,r1>
;-	calls	$fscan	,<@r5>		; Load the firqb and then open
	call	$fscan			;
	iferr	1$
	bit	#questr	,@#xrb+10
	bne	2$
	clr	@#opnprot
	clr	@#opnsize
	mov	2(r5)	,r0		; the channel number to open.
	asl	r0			; convert to RSTS channel * 2
	movb	r0	,@#firqb+fqfil	; load firqb with the channel
	movb	#opnfq	,@#firqb+fqfun	; we want to 'OPEN FOR INPUT'
	.priv
	calfip
	movb	@#firqb+iosts,@#errsav	; copy the error to save area
	bne	1$
	cmpb	#dkhnd	,@#firqb+fqflag
	bne	5$
	 movb	@#firqb+fqprot,@#opnprot
	 mov	@#firqb+fqsiz,@#opnsize	; save size and prot
5$:	mov	@#firqb+fqflag,iostat(r0)
	mov	@#bufsiz,bufpnt(r0)
	inc	bufpnt(r0)
	clr	blknum(r0)
	clr	rd$siz(r0)
	clr	rm$siz(r0)
	clr	mx$siz(r0)
	cmpb	iostat(r0),#dkhnd	; Must be a disk device
	bne	1$			; go away if it isn't.
	mov	#firqb+fqfun,r1		; An address in the firqb
	movb	#-25.	,(r1)+		; UUO subfunction code
	movb	2(r5)	,(r1)+		; channel number 
10$:	clrb	(r1)+	
	cmp	r1	,#firqb+fqent+1
	blo	10$
	.priv
	.uuo	
	mov	#firqb+6,r1		; address of record format 
	clr	rc$fmt(r0)
	clr	la$byt(r0)
	clr	la$blk(r0)
	movb	@#firqb+iosts,@#errsav	; Check for errors.
	bne	1$
	tst	@r1			; read anything at all ?
	beq	1$			; If zero, then no
	 bit	#4	,@r1		; or perhaps stream attribute
	 bne	1$			; yep, exit now

	  mov	(r1)+ 	,rc$fmt(r0)	; record format
	  mov	@r1	,mx$siz(r0)	; max record size
	  .print #rmswrn		; print warning message
	  mov	@#firqb+20,la$blk(r0)	; Yes. Copy eof junk out.
	  mov	@#firqb+22,la$byt(r0)

1$:	unsave	<r1,r0>
	return

2$:	movb	#illnam	,@#firqb+iosts
	movb	#illnam	,@#errsav
	br	1$



	.sbttl	close a file for TED

	routine	$close


;	(r5)	=	channel number
;
;	output:	iostat(2*chan)	= 0
;		bufpnt(2*chan)	= 0
;
	save	<r0,r1>
	mov	(r5)	,r0		; the channel number to open.
	asl	r0			; convert to RSTS channel * 2
	movb	r0	,@#firqb+fqfil	; load firqb with the channel
	movb	#clsfq	,@#firqb+fqfun	; we want to 'OPEN FOR INPUT'
	.priv
	calfip
	movb	@#firqb+iosts,@#errsav	; copy the error to save area
	clr	iostat(r0)
	mov	bufpnt(r0),r1
	clr	bufpnt(r0)
	clr	rd$siz(r0)
	mov	blknum(r0),@#lstblk	; save the end of the file
;	clr	r0
;	div	#512.	,r0
;	add	r0	,@#lstblk
	unsave	<r1,r0>
	return


	.sbttl	create temp file (for RSTS)

cretmp::call	getprv			; get temp privs
	mov	#100$	,r0		; default tempdev
	bit	#sw$dev	,$inswi		; user override tempdev?
	beq	5$			; no
	mov	#tmpdev	,r0		; yes, use theirs please
5$:	calls	$fscan	,<r0>		; tranlate edrt: logical
	movb	firqb+2	,r1
	asrb	r1
	clr	r0			; set up to convert job num
	div	#10.	,r0		; into a radix 50 string .
	add	#30.	,r0		; digits are mapped 30.-39.
	add	#30.	,r1		; in radix fifty. add  on,
	mov	r1	,r3		; save the last rad 50 char.
	mov	r0	,r1		; the second radix  50 char.
	mul	#50	,r1		; convert it, and  then set
	add	r1	,r3		; the bits for that char in
	add	#50*50*30.,r3		; the dest. add  '?' at the
	mov	#firqb+fqfun,r0		; point to firqb for params
	movb	#crefq	,(r0)+		; create temp file call next
	movb	#tmplun*2,(r0)+		; channel number times 2
	clrb	(r0)+			; clear the rest of firqb
	tst	(r0)+			; skip over ppn field
	mov	#^REDI	,(r0)+		; generate EDI0nn.TMP
	mov	r3	,(r0)+		; jobnumber field
	mov	#^RTMP	,(r0)+		; extension
	mov	#40	,(r0)+		; initial size of the file
	mov	#100000!40,firqb+fqmode	; tentative please
	mov	#firqb+fqclus,r0	; set clustersize in next
	clr	(r0)+			; clear it
	clr	@r0			; clear device clusternumber
	bit	#df$32	,$flags		; use /cl:32 ?
	beq	20$			; no
	mov	#40	,-(r0)		; yes, stuff clustersize in
20$:	.priv
	calfip				; do it
	movb	firqb	,errsav		; copy errors and exit
	call	drpprv			; no privs needed
	return				; bye

	global	<df$32	,$flags	,drpprv	,getprv	,$fscan>
	global	<sw$dev	,tmpdev>

100$:	.asciz	#EDRT:#
	.even


	.sbttl	create file

	.globl	bakext

;	0(r5)	=	address of filespec, null terminated
;	2(r5)	=	channel number to use
;	on exit:
;	bufpnt(2*chan)	=	0
;	iostat(2*chan)	=	RSTS 'STATUS' word, as in BASIC
;	blknum(2*chan)	=	0
;

	questr	=	2 + 4 + 40 + 100 ; Wildcard name or extension
	illnam	=	2		 ; ? Illegal filename err num.

e$crea::
$creat::call	cre			; try to create it !	
	cmpb	@#errsav,#32.		; but we ran out of buffers?		
	bne	10$			; no, maybe ok, maybe error.
	call	suspend			; sleep a while
	call	cre			; and try once again please.
10$:	return				; bye now.

	.globl	suspend			; is somewhere else me thinks

	
cre:	call	$fscan			; initial check on the filename
	iferr	40$			; oops
	bit	#questr	,@#xrb+10	; Check for star or ques mark
	bne	50$			; no good then

	save	<r0>			; save all temps please
	clr	r0			; and get input files prot code
	bisb	@#inprot,r0		; set it in there now
	call	$fscan			; assume @r5 has address
	tstb	@#firqb+fqprot		; Did they give a prot code ?
	beq	30$			; no, so skip it
	clr	r0			; yes, set users protection code
	bisb	@#firqb+fqprot,r0	; copy user specified prot code

30$:	movb	#crefq	,@#firqb+fqfun	; we want to 'OPEN FOR OUTPUT'
	movb	r0	,@#firqb+fqprot ; Copy the old protection
	beq	34$			; no explicit code given.
	 movb	#377	,@#firqb+fqprot-1
	 bicb	#2	,@#firqb+fqprot	; no sense in write protection
34$:	tst	@#firqb+fqmode		; mode passed at all ?
	bmi	35$			; yes, force it to be 'real'.
	 bis	#100040	,@#firqb+fqmode	; create tentative file please
35$:	mov	2(r5)	,r0		; the channel number to open.
	asl	r0			; convert to RSTS channel * 2
	movb	r0	,@#firqb+fqfil	; load firqb with the channel
	mov	@#outsiz,@#firqb+fqsiz	; perhaps pre-extend the file
	.priv
	calfip
	mov	@#firqb+fqflag,iostat(r0)
36$:	movb	@#firqb+iosts,@#errsav	; copy the error to save area
	clr	bufpnt(r0)
	clr	blknum(r0)
	unsave	<r0>
40$:	return


50$:	movb	#illnam	,errsav		; Fake illegal filename err
	return				; and exit


	.sbttl	delete a file

	routine	$delete


;-	calls	$fscan	,<@r5>		; Load the firqb first and
	call	$fscan			; assume @r5 has address
	iferr	1$			; check for any errors .
	movb	#delfq	,@#firqb+fqfun	; Set the firqb up for the
	.priv				; delete a file FIP sub-fun
	calfip
	movb	@#firqb+iosts,@#errsav
1$:	return

	.sbttl	rename a disk file, extension only


;	input:	0(r5)	=	address of old filespecification
;		2(r5)	=	new extension, in RAD50


	routine	$rename

	save	<r0,r1>
;-	calls	$fscan	,<@r5>		; Set up the firqb for RENFQ
	call	$fscan			; assume @r5 has address
	iferr	10$			; exit if there were any errors

	cmpb	#dkhnd	,@#firqb+fqflag	; Must be a disk, else ignore
	bne	10$
	mov	#firqb+fqnam1,r0	; address of parsed filename
	mov	#firqb+fqnam2,r1	; the new file name offset
	mov	(r0)+	,(r1)+		; Set up the new file to be the
	mov	(r0)+	,(r1)+		; same as the old, but use  new
	mov	2(r5)	,(r1)+		; new extension.
	clr	@#firqb+fqprot-1	; use the old protection code
	mov	#-1	,@#firqb+fqsiz	; Tell RSTS to delete existing.
	movb	#renfq	,@#firqb+fqfun	; FIP code to rename a file.
	.priv
	calfip
	movb	@#firqb+iosts,@#errsav	; return any error codes
	beq	10$
	cmpb	#ed.fnd	,@#errsav	; If the error was file not fnd
	bne	10$			; then ignore the error.
	 clrb	@#errsav

10$:	unsave	<r1,r0>
	return				; byebye


	.sbttl	check horizontal position of keyboard


	routine	$pos

	clr	@#xrb+xrci		; The channel number * 2 to do
	.priv
	.postn				; get RSTS to post some things
	mov	@#xrb+2	,r0
	return


	.sbttl	return current terminal width setting

	routine	$width	

	clrb	@#xrb+xrci
	.priv
	.postn
	clr	r0
	bisb	@#xrb+0	,r0
	return

	.sbttl	reset echo and control - o

	routine	recho

	.priv
	.ttech
	.priv
	.ttrst
	return

	.sbttl	file name string scan
;
;	call up RSTS (FIP) to do a terminating filename string
;	scan. The string MUST be null terminated. Called as in:
;
;	calls	$fscan	,<stringaddress>
;

	routine	$fscan

	save	<r0,r1>
	mov	(r5)	,r0		; address of the string
	clr	r1			; initial length of file name
1$:
	tstb	(r0)+			; terminated with a null (0) ?
	beq	2$			; r1=r1+1 while mid(str$,r1,1)
	inc	r1			; increment length count
	br	1$
2$:
	mov	#xrb	,r0		; set up for the .fss
	mov	r1	,(r0)+
	mov	r1	,(r0)+		; len to xrlen and xrbc
	mov	(r5)	,(r0)+		; move address to xrloc
	clr	(r0)+			; chan 0, msb of block=0
	clr	(r0)+			; lsw of block = 0
	clr	(r0)+			; clear xrtime
					; same as  mov #asgprt,@#xrb+12
					; 	   mov #44    ,@#xrb+10
	mov	#firqb	,r0
	mov	#fqbsiz	,r1		; set up to zero the firqb first
3$:	clrb	(r0)+
	sob	r1	,3$
	.priv				; call up the  rsts  monitor
	.fss				; to do file name string scan
	movb	@#firqb+iosts,@#errsav	; save any errors encountered
	unsave	<r1,r0>
	return


	.sbttl	flush buffer

	routine	$flush

;	(r5)	=	buffer address
;	2(r5)	=	channel number
;
e$flus::save	<r0,r1,r2,r3>
	mov	(r5)	,r0		; The buffer address first and
	mov	2(r5)	,r1		; next get the channel number.
	asl	r1			; Change chan to channel# * 2.
	mov	@#bufsiz,r3
	cmp	bufpnt(r1),r3		; See if we have a full buffer
	bge	3$
	 clr	r2			; setup for div
	 div	#512.	,r2		; get buffer count in r2
	 mov	#512.	,r3		; and fugure out how much to do.
100$:	 cmp	bufpnt(r1),r3		; compare to multiples of 512
	 beq	3$			; exactly a block mulitple
	 blt	110$			; fit yet ?
	  asl	r3			; no
	 sob	r2	,100$
	 asr	r3

110$:	  save	<r0>
	  mov	r3	,r2		; Partial buffer. fill rest of
	  add	bufpnt(r1),r0		; buffer with null characters.
	  sub	bufpnt(r1),r2		; How much to zero out of buff
	  ble	2$			; better have someting there.
1$:	  clrb	(r0)+
	  sob	r2	,1$
2$:	  unsave	<r0>

3$:	mov	r1	,r2
	asr	r2			; get the channel number back
	inc	blknum(r1)
	calls	$putbl	,<r0,r3,r2,blknum(r1)>
	clr	r2			; fix the block number to be
	div	#512.	,r2		; corrected by the buffer size.
	dec	r2			;
	ble	4$
	 add	r2	,blknum(r1)
4$:	unsave	<r3,r2,r1,r0>
	return



	.sbttl	check for file being acceptable org


;	input:	(r5)	=	channel number to use
;
;	output:	r0	=	0	if file is stream ascii
;		r0	=	-1	if file is not stream ascii


	uu.atr	=	-25.
	strasc	=	4

$catr::	clr	-(sp)
	movb	@r5	,r0		; get the channel number
	beq	100$			; KB:
	asl	r0			; make it channel * 2
	cmpb	iostat(r0),#dkhnd	; Must be a disk device
	bne	100$			; go away if it isn't.
	bit	#20!40	,rc$fmt(r0)	; indexed or relative?
	beq	100$
	mov	sp	,@sp		; yes, that's a nono
100$:	mov	(sp)+	,r0
	return
	


	.sbttl	zap firqb, get/drop privs for RSTS

	routine	$zapfqb

	save	<r0,r1>
	mov	#firqb	,r1
	mov	#40/2	,r0
1$:	clr	(r1)+
	sob	r0	,1$
	unsave	<r1,r0>
	return


	routine	drpprv

	mov	#jfsys	,@#xrb+0
	.priv
	.clear
	return

	routine	getprv

	mov	#jfsys	,@#xrb+0
	.priv
	.set
	return



	.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


	.sbttl	printer spooling for RSTS


	.iif ndf, uu.spl, uu.spl = -28.
	.iif ndf, uu.sys, uu.sys = 26.


;	defaults for the GOLD Q command, patchable by ONLPAT
;
;	q.priv	offset 0	unit number for users whose project
;				number is less than q.ppn
;	q.nopr	offset 0	unit number for users whose project
;				number is greater than q.ppn
;	q.ppn	offset 0	see above


q.priv::.byte	0			; local printer (lp0)
q.ppn::	.byte	7			; max prog # for local printer
q.nopr::.byte	2			; remote printer(lp2)
	.even



;	Q S P O O L
;
;	calls QSPOOL	,<address(filename)>
;
;	returns:	r0 := rsts error code (if any)
;
;	side effects:	temporary privledges, if on, are dropped


qspool::save	<r1>
	call	getprv			; spooling call may be priv
	mov	#firqb+fqfun,r1		; get project number first now
	movb	#uu.sys	,(r1)+		; look up our job
	clr	(r1)+			; current job number, function
	.priv
	.uuo				; easy to do
	mov	firqb+26,r0		; save ppn for a moment
	calls	$fscan	,<@r5>		; let .FSS stuff the filename
	movb	errsav	,r0		; errors ?
	bne	100$			; yes, please exit
	mov	#firqb+16,r1		; stuff the rest of the params
	mov	#"LP	,(r1)+		; LP of course
	movb	q.priv	,(r1)+		; assume LP0 for a moment
	swab	r0			; shift project and prog fields
	cmpb	r0	,q.ppn		; should we use the remote LP?
	blos	20$			; no
	movb	q.nopr	,-1(r1)		; yes
20$:	movb	#377	,(r1)+		; unit is real for sure
	clr	(r1)+			; must be zero
	mov	#4!40	,(r1)+		; /delete/noheader
	movb	#uu.spl	,firqb+fqfun
	.priv
	.uuo				; simple to do
	movb	firqb	,r0		; return any error codes
100$:	call	drpprv			; drop temp privs please
	unsave	<r1>
	return

	global	<$fscan	,getprv	,drpprv>


	.end
