	.title	diskio	i/o modeled after VMS i/o, taken from Kermit-11
	.ident	/1.0.01/

	.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	strcat	dst,src
	mov	src	,-(sp)
	mov	dst	,-(sp)
	jsr	pc	,strcat
	.globl	strcat
	.endm	strcat


	.macro	strcpy	dst,src
	mov	src	,-(sp)
	mov	dst	,-(sp)
	jsr	pc	,strcpy
	.globl	strcpy
	.endm	strcpy






	.macro	indexm	reg		; check for auto increment/decrement
	.ntype	$$$0	,reg		; modes for macro's that can't have
	.if	ne	,$$$0-27	; always allow pc autoincrement
	$$$0	=	<$$$0 & 177770>/10 ; these modes in their arg list.
	.ift				;
	.if	ge	,$$$0-2		; get the mode into 0..7
	.ift				; if mode >= 2 and mode <= 5 then error
	.iif	ge	,5-$$$0, .error	; can't use auto inc/dec mode here
	.endc				;
	.endc				;
	.endm	indexm			; end of indexm macro


	.macro	push	reg
	mov	reg	,-(sp)
	.endm	push

	.macro	pop	reg
	mov	(sp)+	,reg
	.endm	pop


	.macro	scan	ch,str
	mov	str	,-(sp)
	clr	-(sp)
	bisb	ch	,@sp
	call	scanch
	.globl	scanch
	.endm	scan

	.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



;	CALLS macro
;
;	subroutine call with arguements passed in an area
;	pointed to by R5 (similiar to F4 and BP2). All args
;	are pushed onto the stack, with the first args  at
;	the lower address and the last ones at the  higher
;	addresses. R5 will point to the SP before the call.
;	R5 is saved and restored.



	.macro	calls	name,arglst,gbl	; standard  call  macro using
					; the hardware stack (%6) for
	  .if b, gbl
	  .ift
	   .globl	name
	  .iff
	  .iif dif, 'gbl ,nogbl, .globl name
	  .iif dif, 'gbl ,NOGBL, .globl name
	  .endc
	  $$	=	0		; arguement transmission with
	  .irp	x	,<arglst>	; r5 passed as  a pointer  to
	    $$	=	$$ + 1		; to the arguement list.  The
	  .endr				; called name is declared globl
	 .if eq	,$$			; No args present ? If so, gen
	  .ift				; a simple jsr pc call to sub.
	    jsr	pc	,name		; No argument list given.
	  .iff

	    push	r5		; At least one arg in <arglst>
	    .if eq , $$ - 1		; One arguement in the list

	     .ift
	      mov	arglst	,-(sp)	; One arg. Generate less code
	      .chksp	arglst		; Check for SP modes on param.
	      mov	sp	,r5	; Set pointer to argument list
	      jsr	pc	,name	; call the subroutine
	      tst	(sp)+		; pop parameter list from stack
	      pop	r5		; restore r5 pointer

	     .iff			; argcount > 1


	      $$2	=	$$	; more than 1 arguement. Thus
	      .rept	$$		; extract the args in reverse
	      $$1	=	0	; order so that we might save
	      .irp x	,<arglst>	; a little core (4 words).
	       $$1	=	$$1 + 1	; Scan the arg list until we
	       .if eq	, $$2 - $$1	; we come to the last one we
		.ift			; before the one we just did.
		 .chksp	x		; Check for SP addressing mode.
		 mov	x	,-(sp)	; Push it, and exit the .irp.
		 .mexit			; exit
	       .endc
	      .endr
	      $$2 = $$2 - 1		; backwards to previous arg.
	      .endr
	      mov	sp	,r5	; Set up the argument lst ptr.
	      jsr	pc	,name	; and go to the routine.
	      .if ne , $$ - 2		; Gen 'Add 2*argnum, sp' ?
	      .ift			; yes, else gen CMP (sp)+,(sp)+
	       add	#$$*2	,sp	; fix the stack up, restore r5
	      .iff
	       cmp	(sp)+	,(sp)+
	      .endc
	      unsave	<r5>		; restore r5 pointer
	      .endc
	 .endc

	.endm	calls			; thats all


	


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

	nb$nod	=	400	; Node in file or default string (FNB in NAM)

	.enabl	gbl

	.save
	.globl	$vexta
	.psect	$$vex1	,rw,d,gbl,rel,ovr
.vex1:	.word	termtype
	.word	systyp
	.word	ttinit
	.restore


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

systyp::.word	0
ttinit:	.word	0

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

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

	.mcall	fab$b	,fab$e	,rab$b	,rab$e
	.mcall	xab$b	,xab$e
	.mcall	nam$b	,nam$e
	.mcall	$initif	,org$
	.mcall	pool$b	,pool$e	,p$bdb	,p$fab
	.mcall	p$rabx	,p$idx	,p$buf

	.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


	.psect	rmsdat	,rw,d,lcl,rel,con

	org$	SEQ,<CRE,DEL,GET,PUT>


	.psect	rmsdat	,rw,d,lcl,rel,con

					; task extension or to use
rmsbuf::pool$b				; static pools
	p$rab	8.			; plenty of record streams
	p$bdb	7			; same goes for block buffers
	p$fab	7			; up to 2 fabs (needed for search)
	p$buf	1024.			; for 1 files and directory i/o
	pool$e				; end of static pool

	.psect	rmsdat	,rw,d,lcl,rel,con



	.sbttl	rms file access blocks

	facc	=	fb$get ! fb$put

nowin:	.asciz	/Dynamic region creation failed %d/<12>
	.even
tmpnam:	.ascii	/SY:EDIT.TMP/
tmplen = 13
	.even


fab$work::
	fab$b
	f$alq	40.			; initial allocation of 40 blocks
	f$deq	5			; Extend size
	f$fac	fb$rea!fb$wri		; allowed i/o operations
	f$fna	tmpnam			; name of the file
	f$fns	tmplen			; length of the filename
	f$fop	fb$tmp!fb$sup!fb$mkd	; supercede old versions
	f$lch	1			; channel number to use
	f$mrs	1024.			; maximum recordsize
	f$org	fb$seq			; seq
	f$rat	0			; implied carriage control
	f$rfm	fb$fix			; variable length records
	f$shr	FB$NIL			; No sharing
	fab$e

fab$scwork::
	fab$b
	f$alq	8.			; initial allocation of 8 blocks
	f$deq	5			; Extend size
	f$fac	fb$rea!fb$wri		; allowed i/o operations
	f$fna	tmpnam			; name of the file
	f$fns	tmplen			; length of the filename
	f$fop	fb$tmp!fb$sup!fb$mkd	; supercede old versions
	f$lch	2			; channel number to use
	f$mrs	512.			; maximum recordsize
	f$org	fb$seq			; seq
	f$rat	0			; implied carriage control
	f$rfm	fb$fix			; variable length records
	f$shr	FB$NIL			; No sharing
	fab$e

fab$c1::
	fab$b
	f$alq	8.			; initial allocation of 8 blocks
	f$deq	5			; Extend size
	f$fac	fb$rea!fb$wri		; allowed i/o operations
	f$fna	tmpnam			; name of the file
	f$fns	tmplen			; length of the filename
	f$fop	fb$tmp!fb$sup!fb$mkd	; supercede old versions
	f$lch	3			; channel number to use
	f$mrs	512.			; maximum recordsize
	f$org	fb$seq			; seq
	f$rat	0			; implied carriage control
	f$rfm	fb$fix			; variable length records
	f$shr	FB$NIL			; No sharing
	fab$e

fab$c2::
	fab$b
	f$alq	8.			; initial allocation of 8 blocks
	f$deq	5			; Extend size
	f$fac	fb$rea!fb$wri		; allowed i/o operations
	f$fna	tmpnam			; name of the file
	f$fns	tmplen			; length of the filename
	f$fop	fb$tmp!fb$sup!fb$mkd	; supercede old versions
	f$lch	4			; channel number to use
	f$mrs	512.			; maximum recordsize
	f$org	fb$seq			; seq
	f$rat	0			; implied carriage control
	f$rfm	fb$fix			; variable length records
	f$shr	FB$NIL			; No sharing
	fab$e

fab$file::
	fab$b
	f$alq	0			; initial allocation of 10 blocks
	f$fac	facc			; allowed i/o operations
	f$fns	0			; length of the filename
	f$fop	fb$sup			; supercede old versions
	f$lch	6			; channel number to use
	f$org	fb$seq			; seq
	f$rat	fb$cr			; implied carriage control
	f$rfm	fb$var			; variable length records
	fab$e

fab$ind::
	fab$b
	f$alq	0			; initial allocation of 10 blocks
	f$fac	fb$get			; allowed i/o operations
	f$fns	0			; length of the filename
	f$fop	fb$sup			; supercede old versions
	f$lch	7			; channel number to use
	f$org	fb$seq			; seq
	f$rat	fb$cr			; implied carriage control
	f$rfm	fb$var			; variable length records
	fab$e

fab$hl::
	fab$b
	f$fac	fb$rea			; allowed i/o operations
	f$lch	8			; channel number to use
	f$mrs	512.			; maximum recordsize
	f$org	fb$seq			; seq
	f$rat	0			; implied carriage control
	f$rfm	fb$fix			; variable length records
	fab$e

fab$nex::
	fab$b
	f$alq	0			; initial allocation of 10 blocks
	f$fac	fb$get!fb$put		; allowed i/o operations
	f$fop	fb$sup			; supercede old versions
	f$lch	9			; channel number to use
	f$nam	nam$nex
	fab$e

fab$sea::
	fab$b
	f$alq	0			; initial allocation of 10 blocks
	f$fac	fb$get!fb$put		; allowed i/o operations
	f$fop	fb$sup			; supercede old versions
	f$lch	9			; channel number to use
	f$nam	nam$sea
	fab$e

nam$sea::
	nam$b
	n$esa	expnam
	n$ess	64.
	n$rsa	resnam
	n$rss	64.
	nam$e
nam$nex::
	nam$b
	n$esa	expnam
	n$ess	64.
	n$rsa	resnam
	n$rss	64.
	nam$e

nxtwdi::.word	0
nxtwcc::.word	0
oldwdi::.word	0
oldwcc::.word	0
oldidx::.word	0

expnam:	.blkb	100
resnam:	.blkb	100




sydisk::.ascii	/SY:/
sylen	==	. - sydisk
	.even
sydska	==	sydisk
sydskl	==	sylen

	cwork	=	0
	cwork1	=	1
	ccut1	=	2
	ccut2	=	3
	cfile	==	4
	cind	==	5

fablst::.word	fab$work,fab$scwork,fab$c1,fab$c2,fab$file,fab$ind,0,0,0,0,0,0
rablst::.word	rab1	,rab2	,rab3	,rab4	,rab5	  ,rab$ind,0,0,0,0,0,0
cutmap::.word	ccut1	,ccut2	,0	,0	,0	,0
cutope::.word	0	,0	,0	,0	,0	,0
tempma::.word	cwork	,cwork1	,0	,0	,0	,0


rab1::	rab$b				; define record access block
	r$fab	fab$work		; associate a fab with this rab
	rab$e				; end of record access block

rab2::	rab$b				; define record access block
	r$fab	fab$scwork		; associate a fab with this rab
	rab$e				; end of record access block

rab3:	rab$b				; define record access block
	r$fab	fab$c1			; associate a fab with this rab
	rab$e				; end of record access block

rab4:	rab$b				; define record access block
	r$fab	fab$c2			; associate a fab with this rab
	rab$e				; end of record access block

rab$fi::
rab5:	rab$b
	r$fab	fab$file
	rab$e

rab$in::rab$b
	r$fab	fab$ind
	rab$e

rab$hl::rab$b
	r$fab	fab$hl
	rab$e


proxab::xab$b	XB$PRO
	x$nxt	0
	x$pro	0
	xab$e


proset:	.word	0
inpro:	.word	0
inprg:	.word	0
inprj:	.word	0
inrat:	.word	0
inrfm:	.word	0
rwfunc:	.word	0
tedsyserror::
	.word	0,0
markast:.word	0

	.psect	rmscod

reterr::mov	tedsyserror,r0
	return



	.sbttl	read/write blocks for workfiles

;	GETTBLOCK(buffer_address,size,vbn,window)
;	PUTTBLOCK(buffer_address,size,vbn,window)
;
;	Decus C conventions:
;
;	Passed:
;		2(sp)	buffer address
;		4(sp)	size
;		6(sp)	vbn
;		10(sp)	window
;
;	Return:	r0	zero for error, one for success
;
	$nsave	=	6

gettblock::
	cmpb	systype	,#4		; RSTS/E ?
	bne	10$			; No
	jmp	rstsge			; Yes, goto reslib
10$:	clr	rwfunc
	br	reawri
puttblock::
	cmpb	systype	,#4		; RSTS/E ?
	bne	10$			; No
	jmp	rstspu			; Yes, goto reslib
10$:	mov	sp	,rwfunc
	br	reawri

reawri:
	save	<r1,r2,r3>		; save temp registers please
	mov	10+$nsave(sp),r3	; copy the window number over
	asl	r3			; word addressing
	mov	tempmap(r3),r3		; get the map into internal lun
	asl	r3			; word addressing
	mov	rablst(r3),r2		; get the record access block address
	mov	6+$nsave(sp),o$bkt(r2)	; stuff the desired vbn to read/write
	clr	o$bkt+2(r2)		; never use the high vnb word
	tst	rwfunc			; read or write today?
	bne	10$			; write
	clr	o$rsz(r2)		; ????
	mov	2+$nsave(sp),o$ubf(r2)	; stuff the user buffer address
	mov	4+$nsave(sp),o$usz(r2)	; and the user buffer size
	$read	r2			; read
	br	20$			; exit
10$:	mov	2+$nsave(sp),o$rbf(r2)	; the user record buffer address
	mov	4+$nsave(sp),o$rsz(r2)	; and size
	$write	r2			;
20$:	mov	o$sts(r2),tedsyserror	; get the io status
	bmi	30$			; success
	mov	#1	,r0		; return(1)
	br	100$			; and exit
30$:	mov	o$stv(r2),-(sp)		; System error code
	mov	o$sts(r2),-(sp)		; Dump error text
	mov	#200$	,-(sp)		; Formatting string
	call	xprintf
	add	#6	,sp
	clr	r0			; return(0)
100$:	unsave	<r3,r2,r1>		; pop registers and exit
	return

200$:	.asciz	/RMS error: %d, STV is %d/<12>





	.sbttl	read from file/terminal

;	getline(tedlun,&buffer,&sizeofread)
;
;	2(sp)	internal lun
;	4(sp)	buffer address
;	6(sp)	address of returned record size
;	r0	1 for success


getlin::save	<r1,r2,r3>		; save registers that we mauy use
	mov	sp	,r3		; get pointer to arg list
	add	#4*2	,r3		; backup over regs and ret address
	mov	#cfile	,r2		; assume disk input today
	cmpb	@r3	,inlun		; check to make sure
	beq	10$			; no
	mov	#cind	,r2		; assume indirect now
	cmpb	@r3	,indlun		; indirect file ?
	beq	10$			; yes
	calls	td$ttr	,<2(r3),maxlen>	; get a line from terminal
	mov	r0	,@4(r3)		; return size
	beq	90$			; oops
	br	80$
10$:	calls	td$grec	,<2(r3),maxlen,r2>
	tst	r0			; did it work ok ?
	bmi	90$			; no
	mov	r1	,@4(r3)		; return size of the read
80$:	mov	#1	,r0		; success
	br	100$
90$:	mov	eoferr	,r0		; return eof error
100$:	unsave	<r3,r2,r1>		; pop registers and exit
	return

getprm::save	<r1,r2>			; read with prompt from tt
	call	clrdlm			; clear delimiter mask for RSTS/E
	mov	sp	,r2		; an arglist pointer
	cmp	(r2)+	,(r2)+		; back up
	clr	-(sp)
	mov	4(r2)	,-(sp)
	call	putbin
	cmp	(sp)+	,(sp)+
	calls	td$ttr	,<2(r2),6(r2)>	; read the line
	tst	ttinit
	beq	100$
	call	setdlm
100$:	unsave	<r2,r1>
	return


;	getyesno(&prompt,&default)





getyesno::
	save	<r1,r2>			; as always, save them
	mov	sp	,r2		; an arglist pointer
	cmp	(r2)+	,(r2)+		; backup
	sub	#20	,sp		; allocate a small buffer
	mov	sp	,r1		; and a pointer to it
	mov	#20	,-(sp)
	mov	2(r2)	,-(sp)
	mov	r1	,-(sp)
	call	getprm
	add	#3*2	,sp
	tst	r0			; did we get anything ?
	beq	90$			; no
	cmpb	@r1	,#CR		; just a crlf response ?
	bne	10$			; no
	movb	@4(r2)	,@r1		; yes, insert default
10$:	cmpb	@r1	,#'Y&137	; check for Y and y
	beq	20$			; success, return(1)
	cmpb	@r1	,#'y!40		; lower case check
	bne	30$			; no good
20$:	mov	#1	,r0		; success
	br	100$			; exit
30$:	clr	r0			; return(failure)
	br	100$
90$:	mov	#-1	,r0		; return(-1) on read error
100$:	add	#20	,sp
	unsave	<r2,r1>
	return


	.sbttl	putline

;	putlin(lun,&buffer,len)

putlin::save	<r1,r2,r3>		; save registers we zap
	mov	sp	,r3		; point to arglist
	add	#4*2	,r3		; backup over regs and ret addr
	mov	#cfile*2,r2		; get index for file i/o
	cmpb	@r3	,outlun		; write to disk today?
	beq	10$			; yes
	mov	4(r3)	,-(sp)		; no, just dump to terminal
	mov	2(r3)	,-(sp)		; push length and buffer address
	call	putbin			; dump
	cmp	(sp)+	,(sp)+		; pop arg list and exit
	br	80$
10$:
	mov	4(r3)	,r1		; get record size
	cmp	r1	,#2		; if the linelength > 1
	blo	20$			; then check for a CRLF pair
	mov	r1	,r0		; at the end of the line. If
	add	2(r3)	,r0		; so, get rid of them as RMS
	cmpb	-(r0)	,#LF		; will be creating implied
	bne	20$			; carriage return files.
	cmpb	-(r0)	,#CR		; a line feed after the CR?
	bne	20$			; no
	dec	r1			; yes, fix the recordsize up
	dec	r1			; ...
20$:	mov	rablst(r2),r2		; writing to a disk file
	$store	2(r3),RBF,r2		; store the buffer address
	$store	r1,RSZ,r2		; stuff the size of the write
	$put	r2			; and do it
	$fetch	r0,STS,r2		; get the i/o status
	bmi	90$			; and exit on error
80$:	mov	#1	,r0
	br	100$
90$:	mov	r0	,tedsyserror
	clr	r0
100$:	unsave	<r3,r2,r1>
	return




	.sbttl	read/write records

td$grec:save	<r2,r3>
	mov	4(r5)	,r2		; get internal lun
	asl	r2			; times two for indexing
	mov	rablst(r2),r2		; the rab address for get
	$store	#0,RSZ,r2		; must be zero for rms11 v2
	$store	@r5,UBF,r2		; user buffer address
	mov	2(r5)	,r0		; get user buffer maxsize
	sub	#3	,r0		; insure room for cr/lf/null
	bmi	90$			; no room
	$store	r0,USZ,r2		; maximum record size to read
	$get	r2			; simple to read
	$fetch	r0,STS,r2		; get the status of the op
	bmi	90$			; failed
	$fetch	r1,RSZ,r2		; get the size of the read
	mov	r1	,r3		; save it please
	add	@r5	,r3		; point to the end of buffer
	cmpb	-1(r3)	,#FF		; if form feed exit
	beq	10$			; ok
	movb	#CR	,(r3)+		; stuff a cr/lf
	movb	#LF	,(r3)+		; and a line feed
	add	#2	,r1		; save size of the read
10$:	clrb	@r3			; insure .asciz
	br	100$			; exit
90$:	clr	r1			; no data on error
100$:	unsave	<r3,r2>
	return



	.sbttl	terminal i/o


	CR	=	15
	FF	=	14
	LF	=	12
	EF.TT	=	10

;	 A few of RSTSism's here. Since the only RSTS/E specific code
;	is that for single character terminal reads and for control C
;	trapping, we will brnch at run time based on the system type.

	.iif ndf, .SPEC	, .SPEC  =	EMT + 14
	.iif ndf, TTYHND, TTYHND =	2
	.iif ndf, XRB   , XRB	 =	442
	.iif ndf, FIRQB , FIRQB  =	402
	.iif ndf, FQFUN , FQFUN  =	3
	.iif ndf, FQFIL , FQFIL  =	4
	.iif ndf, FQDEV , FQDEV  =	30
	.iif ndf, CALFIP, CALFIP =	EMT + 0
	.iif ndf, OPNFQ,  OPNFQ  =	2
	.iif ndf, CLSFQ,  CLSFQ	 =	0
	.iif ndf, .WRITE, .WRITE =	EMT + 4
	.iif ndf, .READ,  .READ	 =	EMT + 2
	.iif ndf, .TTECH, .TTECH =	EMT + 20
	.iif ndf, .TTNCH, .TTNCH =	EMT + 22
	.iif ndf, .TTRST, .TTRST =	EMT + 26
	.iif ndf, .UUO	, .UUO	 =	EMT + 66
	.iif ndf, UU.TRM, UU.TRM =	20
	.iif ndf, .SET	, .SET	 =	EMT + 36
	.iif ndf, .CLEAR, .CLEAR =	EMT + 56
	.iif ndf, JFSYS	, JFSYS  =	4000
	.iif ndf, .SLEEP, .SLEEP =	EMT + 10

;	End of RSTS/E specific definitions


	.mcall	alun$s	,astx$s	,qiow$s	,exit$s	,gtsk$s
xinit::
	sub	#40	,sp		; get system type
	mov	sp	,r1		; simple
	gtsk$s	r1			; ask for it
	movb	g.tssy(r1),systype	; save it
	add	#40	,sp		; pop buffer
	alun$s	#5,#"TI,#0			; Assign command term.
	call	setcc				; enable ^C asts
	call	crewin			; create the private region
	cmp	r0	,#1		; successful ?
	bne	90$			; no
	call	unmapcache		; insure cache is currently unmapped
	br	100$			; exit
90$:	mov	r0	,-(sp)
	mov	#nowin	,-(sp)
	call	xprintf
	exit$s
100$:	call	drpprv
	return




resumeo::
checkterminal::
noecho::
	mov	#1	,r0
	return


	.iif ndf, .FSS	,.FSS	= EMT + 64
	.iif ndf, RENFQ	,RENFQ	= 10
	.iif ndf, FQNAM1,FQNAM1	= 10
	.iif ndf, FQNAM2,FQNAM2 = 20

;	Rename input file , RSTS/E only

backup::cmpb	systyp	,#4		; This takes a lot less code
	bne	100$			; than doing it with RMS, and
	mov	2(sp)	,r0		; we may be able to squeeze it
10$:	tstb	(r0)+			; into the root also.
	bne	10$			; Get the string length
	sub	2(sp)	,r0		; ...
	dec	r0			;  ...
	mov	#FIRQB	,r1		; Clear the FIRQB and the XRB
20$:	clr	(r1)+			; ...
	cmp	r1	,#XRB+14	; Done yet
	blos	20$			; No
	mov	#XRB	,r1		; Yes, setup for a .FSS
	mov	r0	,(r1)+		; Length
	mov	r0	,(r1)+		; Ditto
	mov	2(sp)	,(r1)+		; Buffer address
	.FSS				; Parse filename
	tstb	FIRQB			; Success?
	bne	100$			; No, exit
	mov	FIRQB+FQNAM1+0,FIRQB+FQNAM2+0	; Yes, setup for rename
	mov	FIRQB+FQNAM1+2,FIRQB+FQNAM2+2	; ...
	mov	#^RBAK	,FIRQB+FQNAM2+4	;  ...
	movb	#RENFQ	,FIRQB+FQFUN	;   ...
	mov	#-1	,FIRQB+16	; Delete any existing file.
	CALFIP				; Do it and exit
100$:	return				; Bye


drpprv::cmpb	systyp	,#4		; RSTS/E ?
	bne	100$			; No
	mov	#JFSYS	,XRB+0		; Yes, we may have needed INSTAL
	.CLEAR				; priv to create the region. But
100$:	return				; since we don't need privs now...



	.sbttl	control C trapping routines



setcc::	cmpb	systyp	,#4
	bne	10$
	mov	#cctrap	,@#24
	br	20$
10$:	qiow$s	#io.ata,#5,#ef.tt,,#kbiost,,<,,#cctrap>
20$:	clr	cctyped
	return

cctrap::call	setcc
	cmpb	systyp	,#4
	bne	10$
	.TTRST
	tst	ttinit
	bne	5$
	.TTECH
5$:	inc	cctyped
	rti

10$:	cmpb	(sp)	,#'c&37
	bne	100$
	inc	cctyped
100$:	tst	(sp)+
	astx$s

testcc::mov	cctyped	,r0
	clr	cctyped
	return


	.save
	.psect	rwdata	,rw,d,lcl,rel,con
cctype::.word	0
linef:	.byte	12,0
kbiost:	.word	0,0
	.restore


	.sbttl	timer routines

;	suspend(seconds)


	timeref	=	2

	.mcall	astx$s	,cmkt$s	,mrkt$s	,wtse$s

suspen::mov	2(sp)	,r0
	cmpb	systype	,#4		; RSTS/E ?
	bne	10$			; No, must be P/OS or M+
	mov	r0	,XRB+0		; RSTS/E, have to do a .SLEEP
	.SLEEP				; as MARKTIME does not work
	br	100$			; Exit
10$:	mrkt$s	#timeref,r0,#2		; sleep integral # of seconds
	wtse$s	#timeref
100$:	return

waitte::mrkt$s	#timeref,#6,#1		; set a ast for 1/10 sec
	wtse$s	#timeref		; now wait for the ef
	return

settim::mov	sp	,r0
	mov	4(r0)	,markast
	mrkt$s	#timeref,2(r0),#2,#mast	; setup an ast for 2(sp) seconds
	mov	#1	,r0
	return

cantim::cmkt$s	#timeref
	mov	#1	,r0
	return

mast:	mov	r0	,-(sp)
	mov	r1	,-(sp)
	mov	r2	,-(sp)
	mov	r5	,-(sp)
	call	@markast
	mov	(sp)+	,r5
	mov	(sp)+	,r2
	mov	(sp)+	,r1
	mov	(sp)+	,r0
	tst	(sp)+
	astx$s



	.sbttl	misc string routines

strcpy::save	<r1,r2>
	mov	2+4(sp)	,r2
	mov	4+4(sp)	,r1
10$:	movb	(r1)+	,(r2)+
	bne	10$
	unsave	<r2,r1>
	mov	2(sp)	,r0
	return

blkmov::save	<r1,r2>
	mov	2+4(sp)	,r2
	mov	4+4(sp)	,r1
	mov	#1000/10,r0
	bit	#1	,r1
	bne	10$
	bit	#1	,r2
	beq	20$
10$:	movb	(r1)+	,(r2)+
	movb	(r1)+	,(r2)+
	movb	(r1)+	,(r2)+
	movb	(r1)+	,(r2)+
	movb	(r1)+	,(r2)+
	movb	(r1)+	,(r2)+
	movb	(r1)+	,(r2)+
	movb	(r1)+	,(r2)+
	sob	r0	,10$
	br	100$
20$:	asr	r0
30$:	mov	(r1)+	,(r2)+
	mov	(r1)+	,(r2)+
	mov	(r1)+	,(r2)+
	mov	(r1)+	,(r2)+
	mov	(r1)+	,(r2)+
	mov	(r1)+	,(r2)+
	mov	(r1)+	,(r2)+
	mov	(r1)+	,(r2)+
	sob	r0	,30$
100$:	unsave	<r2,r1>
	return

scopy::	save	<r1,r2>
	mov	2+4(sp)	,r2
	mov	4+4(sp)	,r1
	mov	6+4(sp)	,r0
	beq	20$
10$:	movb	(r1)+	,(r2)+
	sob	r0	,10$
20$:	unsave	<r2,r1>
	return

strlen::save	<r1>
	mov	2+2(sp)	,r1
	clr	r0
10$:	tstb	(r1)+
	beq	20$
	inc	r0
	br	10$
20$:	unsave	<r1>
	return

strcmp::mov	2(sp),r0	;Pick up 'a'
	mov	4(sp),r1	;And 'b'
10$:	cmpb	(r0)+,(r1)	;Are they the same
	bne	20$		;No
	tstb	(r1)+		;At the end of the string
	bne	10$		;No
	clr	r0		;Equal return
	return

20$:	blo	30$		;Br if a<b
	mov	#1,r0		;A>b return
	return

30$:	mov	#-1,r0		;A<b return
	return			;
	


	.sbttl	fixfilename	remove version number

;	fixfilename(&dst,&src)


getuniquefile::
	save	<r1>
	mov	#tempf	,r0
	mov	4(sp)	,r1
10$:	movb	(r0)+	,(r1)+
	bne	10$
	unsave	<r1>
	return

	.save
	.psect	rwdata
tempf:	.asciz	/TEMP.DAT/
	.even
	.restore



	.sbttl	Vanilla read from command terminal


;	TD$TTREAD(&buffer,buffer_size)
;
; Read a line from the command terminal
;
; Passed:
;	2(sp)	buffer address
;	4(sp)	buffer size
;
; Returns:
;	r0	# characters read (success) else zero (failure)
;
;	Echoes a <LF> on completion to counter Dave Cutler's old
;	FORTRAN record processing view of the world.

td$ttr:	save	<r1>
	mov	4(sp)	,r1		; buffer address
	clrb	@r1			; .asciz
	mov	6(sp)	,r0		; buffer size
	sub	#3	,r0		; allow for terminators and a null
	ble	90$			; no room
	qiow$s	#io.rvb,#5,#ef.tt,,#kbiost,,<r1,r0>
	mov	kbiost+2,r0		; get set to return length
	add	r0	,r1		; get pointer to eol
	cmpb	kbiost	,#is.cr		; cr/lf at end desired ?
	bne	10$			; no
	movb	#CR	,(r1)+		; *buffer++ = CR
	movb	#LF	,(r1)+		; *buffer++ = LF
	clrb	@r1			; .asciz
	add	#2	,r0		; length += 2
10$:	cmpb	kbiost	,#is.suc	; successful read ?
	beq	100$			; yes
90$:	clr	r0			; no, return(0)
100$:	qiow$s	#io.wvb,#5,#ef.tt,,#kbiost,,<#linef,#1>
	unsave	<r1>
	return



	.sbttl	terminal read/write binary mode

;	putbin(buffer,len)
;
; Passed:
;	2(sp)	buffer address
;	4(sp)	buffer length


putbin::save	<r1>			; save temp registers

	mov	6(sp)	,r0		; get the passed length please
	bne	20$			; something real to print
	mov	4(sp)	,r1		; null length, asssume .asciz
10$:	tstb	(r1)+			; find the end of the string
	beq	20$			; found it
	inc	r0			; not ye, len++
	br	10$			; go back for next one
20$:	mov	4(sp)	,r1		; get the pointer to the string
	cmpb	systyp	,#4		; RSTS/E ?
	bne	30$			; no

	mov	#XRB	,r1		; yes, do straight .writes
	mov	r0	,(r1)+		; size of the write
	mov	r0	,(r1)+		; size of the write, again
	mov	4(sp)	,(r1)+		; buffer address
	clr	(r1)+			; channel zero
	clr	(r1)+			; unused
	clr	(r1)+			; unused also
	mov	#4096.	,(r1)+		; io.wal
	.WRITE
	br	40$			; exit

30$:	qiow$s	#io.wal,#5,#ef.tt,,#kbiost,,<r1,r0> ; and dump it
40$:	clr	r0			; assume no errors and exit
	unsave	<r1>			; pop register
	return				;


;	Since the RSX ttdrv is not emualated on RSTS/E very well, we
;	have to drop back to direct RSTS exec calls to do tt reads.
	
getbin::clr	-(sp)			; allocate single character buffer
	mov	sp	,r0		; and a pointer in r0 for it
	cmpb	systyp	,#4		; RSTS/E ?
	bne	10$			; no, use normal IO.RAL!TF.RNE
	mov	#xrb	,r1		; RSTS, setup for 1 character read
	mov	#1	,(r1)+		; on channel 14 (8). We opened the
	clr	(r1)+			; terminal on that channel earlier.
	mov	r0	,(r1)+		; buffer address
	mov	#14*2	,(r1)+		; channel number times 2
	clr	(r1)+			; unused
	clr	(r1)+			; ...ditto
	clr	(r1)+			; .......
	.READ				; do the read
	tstb	firqb			; if failure, then insure that we
	beq	20$			; return a NULL please
	.TTNCH
	qiow$s	#io.ral,#5,,,,,<r0,#1>
	.TTECH
	br	20$
10$:	qiow$s	#io.ral!tf.rne,#5,#ef.tt,,#kbiost,,<r0,#1>
20$:	mov	(sp)+	,r0
	return


crlfout::
	mov	#2	,-(sp)
	mov	#crlf	,-(sp)
	call	putbin
	cmp	(sp)+	,(sp)+
	return

	.save
	.psect	rwdata
crlf:	.byte	CR,LF,0
	.even
	.restore



	.mcall	tlon$s	,clon$s

	.save
	.psect	lognam	,ro,d,lcl,rel,con
homdir:	.asciz	/SYS$LOGIN:/
homedl	=	. - homdir - 1
lastfi:	.asciz	/TED$LAST$FILE$EDITED/
lastfl	=	. - lastfi - 1

	.psect	logdat	,rw,d,lcl,rel,con
retv:	.word	0,0
	.even
	.restore

	.iif ndf, IN.USR, IN.USR = 1
	.iif ndf, IN.SES, IN.SES = 20
	.iif ndf, IN.GRP, IN.GRP = 4
	.iif ndf, IN.SYS, IN.SYS = 10
	.iif ndf, LT.SES, LT.SES = 4

savefi::mov	2(sp)	,r1		; Get the string address
	sub	#110	,sp		; Allocate a buffer
	mov	sp	,r0		; And a pointer to it
	mov	r1	,-(sp)		; Now setup a call to PRSNAM
	mov	r0	,-(sp)		; The destination address
	call	prsnam			; Parse it
	cmp	(sp)+	,(sp)+		; Pop parameter list
	tst	r0			; Successfull?
	beq	90$			; No, exit
	mov	sp	,r1		; Point to the expanded name string
	mov	r1	,-(sp)		; Get string length
	call	strlen			; Get string length
	tst	(sp)+			; Pop arg
	CLON$S	#0,#LT.SES,#lastfi,#lastfl,r1,r0
	bcs	90$			; Oops
	cmpb	@#$DSW	,#IS.SUC	; Successful?
	beq	100$			; Yes, exit
	cmpb	@#$DSW	,#IS.SUP	; Superseded?
	beq	100$			; Yes
90$:	clr	r0			; Otherwise error
	br	110$			; Exit
100$:	mov	#1	,r0		; Success
110$:	add	#110	,sp		; Pop local buffer
	return				; Exit


rstfil::mov	2(sp)	,r1		; Returned string buffer
	TLON$S	#0,#<IN.SYS!IN.GRP>,#0,#lastfi,#lastfl,r1,#77,#retv,#retv+2
	bcs	90$			; It failed
	cmpb	@#$DSW	,#IS.SUC	; Successful?
	bne	90$			; No
	add	retv	,r1		; Success, insure .ASCIZ
	clrb	@r1			; Simple
	mov	#1	,r0		; Success
	return				; Exit
90$:	clr	r0			; Failure
	return				; Exit

dclinpast::
clrinpast::
delspawn::
dombx::
	clr	r0
	return


gsyserror::
	mov	tedsyserror,r0
	return


geterr::mov	r5	,-(sp)
	mov	4(sp)	,r0
	mov	r0	,-(sp)
	mov	#tedsys	,-(sp)
	mov	#2	,-(sp)
	mov	sp	,r5
	call	rmserr
	add	#3*2	,sp
	mov	(sp)+	,r5
	return



	.sbttl	save/restore filename and filename

savepr::mov	#proxab	,r0
	$fetch	inpro,PRO,r0		; get last opened file protection
	$fetch	inprg,PRG,r0		; and owner please
	$fetch	inprj,PRJ,r0		; both words
	mov	#fab$file,r0
	$fetch	inrat,RAT,r0
	$fetch	inrfm,RFM,r0
	clr	O$XAB(r0)
	mov	#1	,r0
	mov	r0	,proset		; say we did it
	return

setpro::mov	#proxab	,r0		; get address of proxab
	tst	proset			; Ever do it?
	beq	100$			; No
	$store	inpro,PRO,r0		; and stuff the saved crap in
	$store	inprg,PRG,r0		; protection and owner please
	$store	inprj,PRJ,r0		; two words
	mov	#fab$file,r0
	$store	inrat,RAT,r0
	$store	inrfm,RFM,r0
	$store	#proxab,XAB,r0
	clr	proset			; Don't reuse this
100$:	mov	#1	,r0
	return







gethom::mov	2(sp)	,r0
	clrb	@r0
	return


quefil::clr	r0
	return




div$li::mov	2(sp)	,r0
	mov	4(sp)	,r1
	div	6(sp)	,r0
	mov	r0	,r1
	return

	.sbttl	epts to convert (sp) arglist to (r5) arglist to get into reslib


gettim::mov	r5	,-(sp)
	mov	sp	,r5
	cmp	(r5)+	,(r5)+
	call	rgetti
	mov	(sp)+	,r5
	return
	
finstr::mov	r5	,-(sp)
	mov	sp	,r5
	cmp	(r5)+	,(r5)+
	call	$finstr
	mov	(sp)+	,r5
	return

instr::	mov	r5	,-(sp)
	mov	sp	,r5
	cmp	(r5)+	,(r5)+
	call	$instr
	mov	(sp)+	,r5
	return


chkrmt::clr	r0
	return
inista::
accsta::
disbuf::
enabuf::
qiosta::mov	#1	,r0
	return




	.sbttl	csv$	C register save and restore
;+
;
;
; Index		C register save and restore
; Index		C program execution environment
;
; Usage
;
;	jsr	r5,csv$
;	...
;	jmp	cret$
;
; Description
;
; 		C program Run-time Environment
;
;	Each C subroutine starts with a call to CSV$ and exits by
;	jumping to CRET$.  Upon exit, the stack need not be equal
;	to its value on entrance.
;
;	During the execution of all C subroutines, register R5
;	points to the current "environment."  Within a subroutine,
;	it appears as follows:
;
;		 _______________
;		|		|
;	  SP ->	| 1st loc. var. | -10(R5)	C$AUTO-2(R5)
;		|_______________|
;		|		|
;		| Saved R2	|  -6(R5)
;		|_______________|
;		|		|
;		| Saved R3	|  -4(R5)
;		|_______________|
;		|		|
;		| Saved R4	|  -2(R5)
;		|_______________|
;		|		|
;	  R5 ->	| Saved R5	|
;		|_______________|
;		|		|
;		| Return add.	|  +2(R5)
;		|_______________|
;		|		|
;		| First arg.	|  +4(R5)	C$PMTR+0(R5)
;		|_______________|
;		|		|
;		| Second arg.	|  +6(R5)	C$PMTR+2(R5)
;		|_______________|
;
;	Within a subroutine, Registers R0-R4 and the top of the
;	stack, (sp) are available for use. Registers R0 and R1
;	are not preserved by subroutines and may be used to pass
;	a return value.
;
;	R5 must not be modified by a subroutine.  All variable
;	addressing must be done by offsets to R5.  Subroutine
;	arguments must be accessed by reference to C$PMTR.
;	Subroutine local variables must be accessed by reference
;	to C$AUTO.  This permits modification of calling sequences
;	without rewriting all subroutines.
;
;	CSV$ refers to global symbol $$main to call the run-time startup
;	program from the (RSX) library.
;
; Internal
;
;	The global symbols needed for the Whitesmith's C compiler
;	are also included.
;
; Bugs
;
;-
;
; Edit history
; 01 JMT	Original
; 02 MM		Documentation
; 03 MM		Fix bug in CRET$ and define C$PMTR, C$AUTO
; 04 MM		Bum one word and name $$main
; 05 MM		C$PMTR/C$AUTO are now defined in RSX.MAC and RT11.MAC
; 06 MM		Added C$SAV, C$RET and C$RETS entries for Whitesmith's
;
;
; If C$PMTR/C$AUTO are undefined, just define them		;05+
;
.iif	ndf	C$PMTR	C$PMTR	=  4	;formal[n] @ c$pmtr+<n*2>(r5)
.iif	ndf	C$AUTO	C$AUTO	= -6	;local[n]  @ c$auto-<n*2>(r5)
	.globl	C$PMTR, C$AUTO
.iif	ne	C$PMTR-4	.error	Bad definition of C$PMTR
.iif	ne	C$AUTO+6	.error	Bad definition of C$AUTO
;
; By defining C$PMTR and C$AUTO as local symbols, the task
; builder need not do so much work				;05-

	.GLOBL	$$MAIN	;Call start from the library		;04

	.psect	c$code
;
; save R4-R2 and make a one-word temp slot on the stack.
;
C$SAV::								;06
CSV$::
	MOV	R5, R0
	MOV	SP, R5
	MOV	R4, -(SP)
	MOV	R3, -(SP)
	MOV	R2, -(SP)
	JSR	PC,(R0)		;TST -(SP) JMP (R0)		;04
;
; pop R2-R4 and restore stack linkage registers.
;
C$RET::								;06
CRET$::
	MOV	R5, R2						;03 +
	MOV	-(R2), R4
	MOV	-(R2), R3
	MOV	-(R2), R2					;03 -
C$RETS::			;Funny Whitesmith's entry	;06
	MOV	R5, SP
	MOV	(SP)+, R5
	RTS	PC

	.psect	rmscod	,ro,i
	.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


	.sbttl	pattern matching

;	FINSTR
;	INSTR
;	
; input:
;
;	(r5)	=	address of the first string
;	2(r5)	=	length of the first string .
;	4(r5)	=	address of the second string, the one to find.
;	6(r5)	=	length of the second string.
;
; output:
;
;	r0	=	if > 0 then r0=position of second in first
;			       else the second is not a substring.
;
;	edits:
;
;
;	01-mar-82	do not convert ctl's to letters bug
;	22-Aug-85	mod for use in C TED into the reslib




$finst::mov	sp	,r0		; ignore case of letter
	br	x			; and off to common code

$instr::clr	r0			; flag normal case match
x:	save	<r1,r2,r3,r4,r5>	; we use these here, so save.
	mov	4(r5)	,r1		; the address of second  one.
	mov	6(r5)	,r2		; the length of  second  one.
	ble	60$			; a null string ?
	mov	2(r5)	,r4		; the length of  first.
	ble	60$			; a null string ?
	sub	r2	,r4		; convert to looping  counter
	clr	r3			; the real loop counter.
	mov	@r5	,r5		; stuff address into r5 please

10$:	cmp	r3	,r4		; are we done yet ?
	bgt	60$			; yes, if r3 > r4 .

;	 cmpb	@r5	,@r1		; speed things up a little by
;	 beq	15$			; placing the obvious test in line
	 call	mch			; check for a character match
	 bcs	50$			; c bit set is match failure.

15$:	 save	<r5,r1,r2>		; found first character match.
	 inc	r5
	 inc	r1			; point to the next character
	 dec	r2			; length of pattern thats left
	 ble	30$			; in case the len( pattern ) =1

20$:	 call	mch			; characters match ?
	 bcs	40$			; no match
	 inc	r5			; and bump up to the next chars
	 inc	r1			; this one please
	 sob	r2	,20$		; loop for len( pattern ) - 1
30$:	 mov	r3	,r0		; the current loop  count
	 inc	r0
	 add	#6	,sp		; fix the stack from save <  >
	 br	70$

40$:	 unsave	<r2,r1,r5>		; the match failed. restore the
50$:	inc	r3			; pointers and go try the  next
	inc	r5
	br	10$			; character in the first string


60$:	clr	r0			; complete failure if  get here
70$:	unsave	<r5,r4,r3,r2,r1>	; restore the registers we used
	return				; and go away.


	.sbttl	check for character match

	.enabl	lsb


mch:	cmpb	@r5	,@r1		; see if the characters match
	beq	50$			; yes
mchx:	cmpb	@r1	,#192.		; see if special match control?
	bhis	70$			; yes
	tst	r0			; no match, ignore letter case?
	beq	40$			; no, set carry and exit

	mov	r2	,-(sp)		; get a temp register to use.
	movb	@r1	,r2		; get the pattern character
	bicb	#40	,r2		; if a letter, force upper case
	cmpb	r2	,#'a&137	; less than an uppercase 'a' ?
	blo	10$			; yes, exit with failure set.
	cmpb	r2	,#'z&137	; greater than uppercase 'z' ?
	bhi	10$			; yes, exit with failure.
	movb	@r5	,r2		; ok, first char is a letter.
	bicb	#40	,r2		; but is this one a character?
	cmpb	r2	,#'a&137	; we are avoiding calling 'islet'
	blo	10$			; to make this code much faster.
	cmpb	r2	,#'z&137	; if not a letter exit with carry
	bhi	10$			; complete failure

	movb	@r1	,-(sp)		; both characters to compare are
	bicb	#40	,@sp		; letters, force both to upcase
	cmpb	r2	,(sp)+		; and compare
	beq	20$			; a match! (case insensitive)

10$:	mov	(sp)+	,r2		; failure exit, pop r2 and exit
	br	40$			; bye

20$:	mov	(sp)+	,r2		; a match, pop r2 and exit
	br	50$			; bye

40$:	sec				; exit with failure
	return

50$:	clc				; exit with success
	return				; bye



;	come here for checking meta characters out
;	ie, ^E? (compiled to codes > 191 (10) )

70$:	mov	r4	,-(sp)
	mov	#mlist	,r4		; look for a match in special
80$:	tstb	@r4			; end of the table yet ?
	beq	100$			; yes
	cmpb	@r1	,(r4)+		; no, so look for a match!
	bne	80$			; the end
	dec	r4			; fix the pointer up please
	sub	#mlist	,r4		; convert to 0..end
	asl	r4			; times two for jsr
	jsr	pc	,@mdsp(r4)	; and call the correct matcher
90$:	mov	(sp)+	,r4		; pop temp register please
	return
100$:	sec				; could not find the match char
	br	90$			; exit with failure 'c' bit set

	.dsabl	lsb


	.sbttl	dispatch on match character code
	.enabl	lsb

100$:	br	x.succ			; ^X 	any character will do

120$:	call	180$			; ^S	not a letter or digit
	bcs	x.succ			; simply swap the 'success'
	br	x.fail			; exit


140$:	br	x.fail			; not implemented


160$:	call	islet			; (^E)A	match any letter
	return


180$:	call	islet			; (^E)C match letter,digit,$
	bcc	x.succ			; did it
	call	isdig			; try for a digit next
	bcc	x.succ			; made it
	cmpb	@r5	,#'$		; try dollar symbol
	beq	x.succ			; a dollar cahr
	cmpb	@r5	,#'.		; last thing is a dot
	beq	x.succ			; found a '.'
	br	x.fail			; no


200$:	call	isdig			; (^E)D match any digit
	return				;	exit

220$:					; (^E)Gq
240$:	br	x.fail			; (^E)L


260$:	call	isuc			; (^E)R	match digit or upper
	bcc	270$			;	case letter
	call	isdig			;
270$:	return				; bye


280$:	cmpb	@r5	,#40		; (^E)s	match a space or tab
	beq	x.succ			;	space matches
	cmpb	@r5	,#11		;	try a tab next please
	beq	x.succ			;	match
	br	x.fail			;	no match

300$:	call	islc			; (^E)v	lower case letters
	return				;	bye

320$:	call	isuc			; (^E)w	upper case letters
	return				;	bye

x.succ:	clc				; yes, clear carry and exit
	return				; bye
x.fail:	sec				; no match, set carry bit
	return


	.sbttl	special match control characters
;
;	case ord(match_char) of
;
;	1..128: match := ch = match_char ;
;	192:	match := true ;
;	193:	match :=  not ( ch in digits ) or ( ch in letters )
;	194:	error(not_implemented) ;
;	195:	match := ( ch in letters ) ;
;	196:	match :=   ( ch in letters ) or ( ch in digits )
;			or ( ch in ['$','.'] ) ;
;	197:	match := ( ch in digits ) ;
;	198:	error(not_implemented) ;
;	199:	error(not_implemented) ;
;	200:	match := ( ch in digits ) or ( ch in big_letters );
;	201:	match := ( ch = tab ) or ( ch = space ) ;
;	202:	match := ( ch in small_letters ) ;
;	203:	match := ( ch in big_letters )   ;
;
;	end ;

	.blkb	46			;****?????****
	.save
	.psect	insdsp	,ro,d,lcl,rel,con
mlist:	.byte	192.,193.,194.,195.,196.,197.,198.,199.
	.byte	200.,201.,202.,203.,0
	.even
mdsp:	.word	100$,120$,140$,160$,180$,200$,220$,240$
	.word	260$,280$,300$,320$
	.restore
	.dsabl	lsb

	.enabl	lsb
	.dsabl	lc


isdig:	cmpb	@r5	,#'0		; digit match?
	blo	10$			; no
	cmpb	@r5	,#'9		; next part please
	bhi	10$			; no
5$:	clc				; yes
	return
10$:	sec				; not a digit
	return				; bye


islet:	call	isuc			; try for upper case
	bcc	20$			; yep
	call	islc			; try for lower case
20$:	return				; bye

isuc:	cmpb	@r5	,#'A		; try for a letter
	blo	10$			; no a letter for sure
	cmpb	@r5	,#'Z		; might be a letter
	blos	5$			; yep
	br	10$			; exit

islc:	cmpb	@r5	,#'A!40		; try lower case
	blo	10$			; no
	cmpb	@r5	,#'Z!40		; maybe
	blos	5$			; no
	br	10$			; yes

	.dsabl	lsb






	.sbttl	dummy main ept
	.mcall	exit$s

$$main::cmp	resver	,#..resv
	beq	10$
	clr	-(sp)
	mov	#badver	,-(sp)
	call	putbin
	exit$s
10$:	call	main
	exit$s

	.save
	.psect	rwdata	,d
badver:	.asciz	/Wrong version of EDRESL/<15><12>
	.even
	.restore

	.globl	resver,..resv

	.end	$$main
