	.library	/lb:[1,1]rmsmac.mlb/

;	20-Jun-85  16:38:04	Brian Nelson
;
;	For proper documentation, see DISKIO.MAR (the VMS version)
;	for detailed explanations of functions.




	.macro	save	list
	.if b , <list>
	.ift
	 save	<r0,r1,r2,r3,r4,r5>
	.iff
	.irp	x,<list>
	 mov	x,-(sp)
		.endr
	.endc
	.endm	save


	.macro	unsave	list
	.if b , <list>
	.ift
	unsave	<r5,r4,r3,r2,r1,r0>
	.iff
	.irp	x,<list>
	 mov	(sp)+,x
		.endr
	.endc
	.endm	unsave

	.macro	print	s,l
	.print	s,l
	.endm	print


	.MACRO	GLOBAL	LIST
	.GLOBL	LIST
	.ENDM	GLOBAL

	.MACRO	.ASSUME	ARG1,COND,ARG2
	.IF	COND	<ARG1>-<ARG2>
	.IFF
	.ERROR	ARG1 ;"COND ARG2" FAILS
	.ENDC
	.ENDM	.ASSUME

	.macro	.chksp	arg
	.ntype	$$5	,arg
	.iif eq,<$$5 & 7>-6, .error arg ; Illegal use of SP(r6) in call
	.endm	.chksp




	


	cr	=	15
	lf	=	12
	ff	=	14
	soh	=	1


	.enabl	gbl


	.psect	rmscod	,ro,i,lcl,rel,con
	.psect	rmsdat	,rw,d,lcl,rel,con


	.mcall	fabof$
	.mcall	rabof$
	.mcall	xabof$

	fabof$	RMS$L
	rabof$	RMS$L
	xabof$	RMS$L


	.mcall	$compar	,$fetch	,$store	,$rewin
	.mcall	$close	,$creat	,$erase	,$open
	.mcall	$connec	,$delet	,$discon,$find
	.mcall	$get	,$put	,$updat	,$flush
	.mcall	$read	,$write	,$off	,$set
	.mcall	$testbit,$parse

	.save
	.psect	rwdata	,rw,d,lcl,rel,con
hlpdef:	.asciz	/LB:[1,2]/
hlptyp:	.asciz	/.HLP/
	.even

workna:	.asciz	/TED$TEMP:EDIT.TMP/	; name for RSTS/E and P/OS
workln = . - workna
tmpnam:	.asciz	/SY:EDIT.TMP/
tmplen	= . - tmpnam
sysdv:	.ascii	/SY:/
sysln	=	. - sysdv
	.even
	.restore



	.sbttl	create work files
	.psect	rmscod

cretmp::cmpb	systype	,#4		; RSTS/E ?
	bne	5$			; No
	jmp	rstscr			; Yes, bypass RMS
5$:	save	<r1,r2>
	mov	#fab$search,r2		; fab to use for the $parse
	$store	#workna,FNA,r2		; setup for $PARSE to get dev and UIC
	$store	#workln,FNS,r2		; to see if the logical will translate
	$store	#sysdv,DNA,r2		; default device
	$store	#sysln,DNS,r2		; ...
	$parse	r2			; see if we can get the logical done
	$compar	#0,STS,r2		; success ?
	blt	10$			; no, revert to SY:
	$fetch	r2,NAM,r2		; get the NAM block address for FAB
	$fetch	r0,ESL,r2		; get expanded string length please
	$fetch	r1,ESA,r2		; get expanded string address
	add	r1	,r0		; make it .asciz
	clrb	@r0			; simple
	mov	r1	,-(sp)		; call the create routine 
	call	.cretm			; ...
	tst	(sp)+			; pop stack
	tst	r0			; did it work ok
	bne	100$			; yes
10$:	mov	#tmpnam	,-(sp)		; no, drop back to simple name
	call	.cretm			; and do it again
	tst	(sp)+			; pop stack
100$:	unsave	<r2,r1>
	return


.cretm:	mov	#fab$work,r1		; get the main workfile
	call	190$			; set up the fab with filename
	$create	r1			; try hard to create the thing
	call	200$			; check to see if it worked ok
	beq	100$			; no
	mov	#rab1	,r1		; it worked, now connect it up
	$store	#0,ROP,r1		; ??
	$connec r1			; ...
	call	200$			; see if it succeeded
	beq	100$			; no
	cmp	nwindows,#1		; don't bother with second file
	beq	100$			; if we will never need it
	mov	#fab$scwork,r1		; get the secondary workfile
	call	190$			; set up the fab with filename
	$create	r1			; try to create this one also
	call	200$			; and see if that worked ok
	beq	100$			; no
	mov	#rab2	,r1		; yes, so now try to connect the
	$connec r1			; access stream up now.
	call	200$			; check for success and exit
100$:	return


190$:	mov	4(sp)	,r0		; get filename address
	$store	r0,FNA,r1		; stuff the address into the fab
	mov	r0	,-(sp)		; stuff onto stack for strlen
	call	strlen			; get filename length
	$store	r0,FNS,r1
	tst	(sp)+			; pop stack
	cmpb	systype	,#4		; RSTS/E
	bne	195$			; no
	$off	#FB$TMP,FOP,r1		; yes. FB$TMP --> UIC's are ignored
195$:	$off	#FB$CTG,FOP,r1		; also, we can't extend contig files
	return				; exit


200$:	$fetch	r0,sts,r1		; get status back out please
	mov	r0	,tedsyserror	; save this please
	bmi	210$			; error, return(0)
	mov	#1	,r0		; no error, return(1)
	return
210$:	clr	r0
	return


clotmp::cmpb	systype	,#4		; RSTS/E ?
	bne	5$			; No
	jmp	rstscl			; Yes, ignore
5$:	save	<r1,r2,r3>
	$discon	#rab1
	$close	#fab$work
	$discon	#rab2
	$close	#fab$scwork
	mov	#cutmap	,r1
	mov	#cutopen,r2
10$:	tst	@r1			; see if this is the end of cutpaste
	beq	30$			; files
	tst	(r2)+			; not end, is this one open now?
	beq	20$			; no
	mov	@r1	,r3		; yes, index to the channel map
	asl	r3			; words please
	$discon	rablst(r3)		; disconnect access stream
	$close	fablst(r3)		; simple
20$:	tst	(r1)+			; next please
	br	10$			; simple
30$:
100$:	unsave	<r3,r2,r1>
	return

cretm1::
cretm2::mov	#1	,r0
	return


	.sbttl	help routines


opnhlp::save	<r2,r3>			; save temp registers
	mov	#fab$hl	,r2		;
	tst	o$ifi(r2)		; file already open?
	beq	5$			; no
	$discon	#rab$hl			; yes, close up please
	$close	r2			; ...
5$:	mov	sp	,r1		; save stack pointer
	sub	#100	,sp		; allocate a filename buffer
	mov	sp	,r3		; and a pointer to buffer
	mov	#hlpdef	,r2		; copy the default string
10$:	movb	(r2)+	,(r3)+		; move a byte
	bne	10$			; and do it again until a null
	dec	r3			; back up over the null
	mov	2+4(r1)	,r2		; get address of filename
20$:	movb	(r2)+	,(r3)+		; and copy it until a null
	bne	20$			; next
	dec	r3
	mov	#hlptyp	,r2		; stuff a filetype in
30$:	movb	(r2)+	,(r3)+		; ...
	bne	30$			;
	mov	sp	,r3		; point back to the buffer
	mov	r3	,-(sp)		; setup to call strlen
	call	strlen			; get the string length
	tst	(sp)+			; pop parameter
	mov	#fab$hl	,r2		; get the fab address
	$store	r3,FNA,r2		; stuff the filename in
	$store	r0,FNS,r2		; and the filename size
	$open	r2			; open it
	$fetch	r0,STS,r2		; and see if it worked
	bmi	90$			; no
	mov	#rab$hl	,r2		; it's open, now connect rab
	$connec	r2			; ...
	$fetch	r0,STS,r2		; successfull ?
	bmi	90$			; no
	mov	#1	,r0		; yes, return success
	br	100$			; exit
90$:	mov	r0	,tedsyserror	; save error code
	clr	-(sp)
	mov	r3	,-(sp)
	call	putbin
	cmp	(sp)+	,(sp)+
	clr	r0			; return(0)
100$:	add	#100	,sp		; pop local buffer and exit
	unsave	<r3,r2>			; pop regs
	return				; exit


	.sbttl	open/create file

openfi::save	<r2,r3,r4>
	mov	sp	,r4		; get pointer to arglist
	add	#4*2	,r4		; got it
	mov	#cfile	,r3		; assume fileio ?
	cmpb	2(r4)	,indlun		; is that the case
	bne	10$			; yes
	mov	#cind	,r3
	br	20$			; open it
10$:	cmpb	2(r4)	,inlun		; for reading ?
	beq	20$			; yes
	call	cre			; no, create the thing
	br	100$
20$:	call	ope
100$:	unsave	<r4,r3,r2>
	return


closef::save	<r2,r3>
	cmpb	2+4(sp)	,kblun
	beq	80$
	mov	#cfile	,r2
	cmpb	2+4(sp)	,indlun
	bne	10$
	mov	#cind	,r2
10$:	asl	r2
	mov	rablst(r2),r3
	$discon	r3
	mov	fablst(r2),r3
	$close	r3
80$:	mov	#1	,r0
100$:	unsave	<r3,r2>
	return



	.sbttl	open for read



ope:	asl	r3			; index into rab/fab mapping
	mov	fablst(r3),r2		; get the fab address
	mov	rablst(r3),r3		; get the rab address also
	mov	@r4	,-(sp)		; get filename length
	call	strlen			; length
	tst	(sp)+			; pop arglist
	$store	@r4,FNA,r2		; stuff the filename address
	$store	r0,FNS,r2		; insert the filename size
	$store	#FB$GET,FAC,r2		; get access only
	$store	#proxab,XAB,r2		; find out file protection
	$open	r2			; open the file please
	$fetch	r0,STS,r2		; see if the open worked
	bmi	90$			; failed
	$connec	r3			; connect access stream
	$fetch	r0,STS,r3		; see if that worked
	bmi	90$			; no
	mov	<o$alq+0>(r2),filesize	; save size of infile
	mov	#1	,r0		; success
	br	100$			; exit
90$:	mov	r0	,tedsyserror	; save error and exit
	clr	r0			; flag failure
100$:	return

setmbc::save	<r2,r3>
	mov	#rab$fi	,r3
	mov	#fab$fi	,r2
;-	cmpb	cmdlun	,kblun
;-	bne	100$
	call	pdpbuf
	$store	r0,BPA	,r2
	$store	r1,MBC	,r3
	mul	#1000	,r1
	$store	r1,BPS	,r2
100$:	unsave	<r3,r2>
	return

clrmbc::mov	#rab$fi	,r0
	$store	#0,MBC	,r0
	mov	#fab$fi	,r0
	$store	#0,BPA	,r0
	$store	#0,BPS	,r0
	return



	.sbttl	create seq file


cre:	asl	r3			; index into rab/fab mapping
	mov	fablst(r3),r2		; get the fab address
	mov	rablst(r3),r3		; get the rab address also
	mov	@r4	,-(sp)		; get filename length
	call	strlen			; length
	tst	(sp)+			; pop arglist
	clr	<o$alq+0>(r2)		; clear filesize
	$store	#FB$SEQ,ORG,r2		; sequential file
	$store	#FB$CR,RAT,r2		; implied carriage control
	$store	#FB$VAR,RFM,r2		; variable
	$store	#FB$PUT,FAC,r2		; get access only
	$store	@r4,FNA,r2		; stuff the filename address
	$store	r0,FNS,r2		; insert the filename size
	cmpb	systyp	,#4		; RSTS/E ?
	bne	10$			; no
	$store	#FB$STM,RFM,r2		; yes, default to stream ascii please
	$store	#0,RAT,r2		; ...
10$:	$create	r2			; open the file please
	$fetch	r0,STS,r2		; see if the open worked
	bmi	90$			; failed
	$connec	r3			; connect access stream
	$fetch	r0,STS,r3		; see if that worked
	bmi	90$			; no
	mov	#1	,r0		; success
	br	100$			; exit
90$:	mov	r0	,tedsyserror	; save error and exit
	clr	r0			; flag failure
100$:	return

	.end
