 	.title	disk i/o for native mode ted

;	Copyright (C) 1984   Change Software, Inc.
;	
;	
;	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 author.
;
;
;+	CHKFILENAME(filename)		Check a filename for validity
;+	CLOSEF(tedlun)			close the passed file
;+	CLOTMP()
;+	CRETMP()
;+	DCLCOMMAND(string)		execute a DCL command line
;+	FIXFILENAME(dst,src)		fix filename (remove version number)
;+	FLOOKUP(filename)		Find a file
;+	GETBIN()			Get the next character from terminal
;+	GETLINE(tedlun,buf,sizeaddr)	Get a line from the terminal
;+	GETMCRCOMMAND(string)		return the command line with imagename
;+	GETNEXT(resname,wildname,flag)	Find the next wildcarded file
;+	GETPRM(buffer,prompt,maxlen)	Get a line with prompting
;+	GETTBLOCK(bufferadr,size,vbn)	Read a workfile block
;+	GETUNIQUEFILE(filename)
;+	GETVM(size_of_block)		allocate/extend the workfile index
;+	GETYESNO(prompt,default)	return YES/NO for the prompt
;+	INSTR(src,srclen,pat,patlen)	Fast pattern matching using MATCHC
;+	ISWILD(filename)		See if a filename is wildcarded
;+	OPENFI(name,tedlun)		open the passed filename for r or w
;+	OPNHLP(address_helpfilename)	open the passed help filename
;+	PUTBIN(buffer [,length])	Write to TT: without translation
;+	PUTLINE(tedlun,buffer,length)	write to passed internal LUN
;+	PUTTBLOCK(bufferaddress,size,vbn)
;+	QUEFILE(filename)		send a file to SYS$PRINT
;+	REACBU(bufferaddress,vbn)	Read a cutpaste buffer in
;+	REAHLP(bufferaddress,vbn)	Read a HELP buffer
;+	RSTTERMINAL()			restore the terminal from SETTER
;+	SCOPY(to,from,fromsize)		use MOVC3 to copy a string
;+	SETTERMINAL()			setup the terminal for screen editing
;+	STRLEN(stringaddress)		return the length of .asciz string
;+	WRICBU(bufferaddress,vbn)
;+	XINIT()				do system dependent initialization

	.library	/SYS$LIBRARY:LIB.MLB/


	$ssdef
	$iodef
	$ttdef
	$tt2def
	$jpidef
	$prvdef
	$smrdef				; for printer
	$dvidef
	$devdef
	$fibdef
	$atrdef
	$fchdef


	.mcall	$fab			; define the fab's
	.mcall	$rab			; the record access blocks
	.mcall	$xabpro			; for prot and ownership
	.mcall	$connect		; connect to a record stream
	.mcall	$disconnect		; release a record access stream
	.mcall	$close			; close a file
	.mcall	$create			; create a new file
	.mcall	$open			; open existing file
	.mcall	$get	,$put		; record read/write
	.mcall	$read	,$write		; block i/o for work file
	.mcall	$namdef			; name block defs
	.mcall	$fabdef			; define fields in the fab
	.mcall	$rabdef			; ditto for the rab
	.mcall	$xabdef			; for extended attribute blocks
	.mcall	$rmsdef

	$fabdef
	$rabdef
	$rmsdef
	$namdef


	.psect	inlun	,PIC,USR,OVR,REL,GBL,SHR,NOEXE,RD,WRT,NOVEC,LONG
inlun:
	.psect	indlun	,PIC,USR,OVR,REL,GBL,SHR,NOEXE,RD,WRT,NOVEC,LONG
indlun:
	.psect	outlun	,PIC,USR,OVR,REL,GBL,SHR,NOEXE,RD,WRT,NOVEC,LONG
outlun:
	.psect	kblun	,PIC,USR,OVR,REL,GBL,SHR,NOEXE,RD,WRT,NOVEC,LONG
kblun:
	.psect	maxlen	,PIC,USR,OVR,REL,GBL,SHR,NOEXE,RD,WRT,NOVEC,LONG
maxlen:
	.psect	eoferror,PIC,USR,OVR,REL,GBL,SHR,NOEXE,RD,WRT,NOVEC,LONG
eoferror:
	.psect	filesize,PIC,USR,OVR,REL,GBL,SHR,NOEXE,RD,WRT,NOVEC,LONG
filesize:
	.psect	matchflag,PIC,USR,OVR,REL,GBL,SHR,NOEXE,RD,WRT,NOVEC,LONG
matchflag:
	.psect	prevchar,PIC,USR,OVR,REL,GBL,SHR,NOEXE,RD,WRT,NOVEC,LONG
prevchar:
	.word	0,0
	.blkb	30
	.psect	maxfilesize,PIC,USR,OVR,REL,GBL,SHR,NOEXE,RD,WRT,NOVEC,LONG
maxfilesize:
	.psect	astaction,PIC,USR,OVR,REL,GBL,SHR,NOEXE,RD,WRT,NOVEC,LONG
astaction:




	.sbttl	some macros that may be useful

	.psect	rwdata	,gbl,con,noexe,noshr,rel,wrt
	.psect	code	,lcl,con,exe,shr,rel,nowrt


	SYS_NORMAL	=	1
	SYS_TOOLONG	=	2

	CR	=	13
	LF	=	10
	SPACE	=	32
	FF	=	12
	CTRLZ	=	26
	BIGY	=	^A/Y/&^o137
	SMALLY	=	^A/y/!^o40
	BIGA	=	^A/A/&^o137
	BIGZ	=	^A/Z/&^o137
	BIGQ	=	^A/Q/&^o137


	.macro	newline
	calls	#0	,print_crlf
	.endm	newline


	.macro	printerror	val
	pushl	val
	calls	#1	,print_error
	.endm	printerror


	.macro	decout	val
	pushl	val
	calls	#1	,decout
	calls	#0	,crlfout
	.endm	decout

	.macro	hexout	val
	pushl	val
	calls	#1	,hexout
	calls	#0	,crlfout
	.endm	hexout

	.macro	print	str,len
	.if blank len
	.if_true			; if blank assume .asciz
	 pushal	str			; push the string address
	 pushl	#0			; and flag it
	 calls	#2	,type_ascii	; and do it
	.if_false
	 pushl	len			; assume passed length and
	 pushal	str			; address
	 pushl	#1			; flag for it
	 calls	#3	,type_ascii	; and do it
	.endc
	.endm	print



	.sbttl	data structures for file access

	.psect	rmsdata	,long,con,noexe,noshr,rel,wrt


	chan_work	==	0	; read/write access
	chan_work1	==	1	; read/write access
	chan_help	==	2	; read
	chan_input	==	3	; seq
	chan_output	==	4	; seq
	chan_terminal	==	5	; seq
	chan_ind	==	6	; seq, indirect commands
	chan_cut1	=	7	; r/w access, paste buffer 0
	chan_cut2	=	8	; and 1
	chan_cut3	=	9	; and 2


tempmap:.long		chan_work,chan_work1,0,0,0,0,0,0
cutmap:	.long		chan_cut1,chan_cut2,chan_cut3,0,0,0,0
cutopen:.long		0,0,0,0,0,0,0,0

fablist:.address	fab_work,fab_scwork,fab_help,fab_input,fab_output
	.address	fab_terminal,fab_ind,fab_cut1,fab_cut2,fab_cut3

rablist:.address	rab_work,rab_scwork,rab_help,rab_input,rab_output
	.address	rab_terminal,rab_ind,rab_cut1,rab_cut2,rab_cut3


fab_work:	$fab	fnm=<EDIT.TMP>, 	-
			fac=<BIO,GET,PUT>, 	-
			mrs=1024,		-
			rfm=FIX,		-
			alq=64,deq=32,rtv=0	-
			fop=TMD

fab_scwork:	$fab	fnm=<EDIT.TMP>, 	-
			fac=<BIO,GET,PUT>, 	-
			mrs=512,		-
			rfm=FIX,		-
			alq=8,deq=8,		-
			fop=TMD

fab_help:	$fab	fnm=<SYS$HELP:TED.HLB>, -
			fac=<BIO,GET>,shr=<GET>,-
			rfm=FIX

fab_input:	$fab	fac=<GET>,shr=<GET>,xab=in_proxab

fab_ind:	$fab	fac=<GET>,shr=<GET>

fab_output:	$fab	fac=<PUT>,xab=out_proxab

fab_terminal:	$fab	fnm=<SYS$COMMAND>


fab_cut1:	$fab	fnm=<EDIT.TMP>, 	-
			fac=<BIO,GET,PUT>, 	-
			mrs=512,		-
			rfm=FIX,		-
			alq=4,deq=4,		-
			fop=TMD

fab_cut2:	$fab	fnm=<EDIT.TMP>, 	-
			fac=<BIO,GET,PUT>, 	-
			mrs=512,		-
			rfm=FIX,		-
			alq=4,deq=4,		-
			fop=TMD

fab_cut3:	$fab	fnm=<EDIT.TMP>, 	-
			fac=<BIO,GET,PUT>, 	-
			mrs=512,		-
			rfm=FIX,		-
			alq=4,deq=4,		-
			fop=TMD

rab_work:	$rab	fab=fab_work
rab_scwork:	$rab	fab=fab_scwork
rab_help:	$rab	fab=fab_help
rab_input:	$rab	fab=fab_input,mbc=16
rab_output:	$rab	fab=fab_output,mbc=16
rab_terminal:	$rab	fab=fab_terminal
rab_ind:	$rab	fab=fab_ind
rab_cut1:	$rab	fab=fab_cut1
rab_cut2:	$rab	fab=fab_cut2
rab_cut3:	$rab	fab=fab_cut3

in_proxab:	$xabpro
out_proxab:	$xabpro
in_filepro:	$xabpro



acpsyserror::	.long	0
tedsyserror::	.long	0
cctyped:	.long	0
second:		.long	-10*1000*1000*1,-1
tenthsecond:	.long	-1*1000*1000,-1
curtime:	.long	23
		.address	timebuffer
timebuffer:	.blkb	24
		.align	long

		nam_maxsize = 127

fab_find:	$fab	fop=NAM,nam=nam_find,fac=<GET>,shr=<GET>
nam_find:	$nam	rsa=find_res_string,-
			rss=nam_maxsize,-
			esa=find_exp_string,-
			ess=nam_maxsize

find_res_string:.blkb	nam_maxsize
		.align	long
find_exp_string:.blkb	nam_maxsize
		.align	long

fab_next:	$fab	fop=NAM,nam=nam_next
nam_next:	$nam	rsa=next_res_string,-
			rss=nam_maxsize,-
			esa=next_exp_string,-
			ess=nam_maxsize
old_wcc:	.long	0
old_index:	.long	0


next_res_string:.blkb	nam_maxsize
		.align	long
next_exp_string:.blkb	nam_maxsize
		.align	long

astflag:	.long	0
ted_ast_buffer:	.blkb	10

oldtermchar:	.blkb	12
newtermchar:	.blkb	12
exquota_flag:	.long	0
commandline:	.long	63
		.address	cbuffer
cbuffer:	.blkb	64
commandlength:	.long	0


exquota:
	.long	<1@PRV$V_EXQUOTA>
	.long	0

authpriv:
	.word	8
	.word	jpi$_authpriv
	.address	10$
	.address	20$
	.long	0
10$:	.quad	0
20$:	.long	0

imagpriv:
	.word	8
	.word	jpi$_imagpriv
	.address	10$
	.address	20$
	.long	0
10$:	.quad	0
20$:	.long	0

curpriv:.word	8
	.word	jpi$_curpriv
	.address	10$
	.address	20$
	.long	0
10$:	.quad	0
20$:	.long	0

wsquota:.word	4
	.word	jpi$_wsquota
	.address	10$
	.address	20$
	.long	0
10$:	.long	0
20$:	.long	0

pid:	.word	4
	.word	jpi$_pid
	.address	pidval
	.address	pidlen
	.long	0
pidval:	.long	0
pidlen:	.long	0

imagename:	.word	63
		.word	jpi$_imagname
		.address	cbuffer
		.address	commandlength
		.long	0

vmsize:		.long	0,0,0,0,0,0,0
vmbase:		.long	0,0,0,0,0,0,0
vmalloc:	.long	0,0,0,0,0,0,0
oldvmbase:	.long	0,0,0,0,0,0,0
oldvmsize:	.long	0,0,0,0,0,0,0


getdevtyp:	.word	4
		.word	dvi$_devchar
		.address	devchar
		.address	devlen
		.long	0
devchar:	.long	0
devlen:		.long	0

homedir:	.asciz	/SYS$LOGIN:/
defsysque:	.asciz	/SYS$PRINT/
		.align	long
lastlogname:	.ascid	/TED_LAST_FILE_EDITED/
		.even

temp$devname:	.asciz	/TED_TEMP:EDIT.TMP/
temp$name:	.asciz	/EDIT.TMP/
help$device:	.asciz	/TED_HELP:/
help$filetype:	.asciz	/.HLP/
		.even

tty_lun:	.long	0
tty_outlun:	.long	0
tty_nam:	.long	63
		.address tty_str
tty_str:	.blkb	63
		.even
tty_dev:	.ascid	/SYS$COMMAND/
		.even
tty_outdev:	.ascid	/SYS$OUTPUT/
		.even


dev_nam:.blkb	16
	.byte	0,0
fil_dsc:.long		0
	.long		0
fib_dsc:.long		FIB$C_LENGTH
	.address	fib
fib:	.blkb		FIB$C_LENGTH

atrlst:	.word		ATR$S_UCHAR
	.word		ATR$C_UCHAR
	.address	uchar
	.long	0
uchar:	.blkb		ATR$S_UCHAR

hexmap:	.asciz	/0123456789ABCDEF/
	.align	long

	.psect	code	,lcl,con,exe,shr,rel,nowrt


	.sbttl	allocate virtual memory for the index

;+	char *GETVM(size_of_block,w,&all_size)	allocate/extend workfile index
;
;	 GETVM will request the passed number of bytes from VMS and return
;	the pointer to it in r0. If the allocation should fail, GETVM will
;	return a value of zero.  Since we can never be sure that a call to
;	LIB$GET_VM  will allocate  the next area contiguous to the current
;	area,  we check for the existance of a previous area and then copy
;	the entire  area over if so,  deallocating the  previous area when
;	done. Each index entry is 2 words + 1 longword (4 words) in size.
;-

	.psect	code	,lcl,con,exe,shr,rel,nowrt

	.entry	getvm			,^M<r2,r3,r4,r5,r6>

	movl	8(ap)	,r6		; the window to allocate for
	tstl	vmsize[r6]		; have we ever been called before?
	beql	10$			; no
	movl	vmsize[r6],oldvmsize[r6]; yes, save the old size please
	movl	vmbase[r6],oldvmbase[r6]; and save the old vm base address
10$:	mull3	4(ap),#8,vmsize[r6]	; number of entries * 4 words per
	pushal	vmbase[r6]		; stuff the place to return the base
	pushal	vmsize[r6]		; stuff the size of the request
	calls	#2	,G^lib$get_vm	; and get some memory from VMS
	blbc	r0	,90$		; oops
	movl	vmbase[r6],r0		; success, return the base address
	tstl	oldvmsize[r6]		; do we have to copy the old index to
	beql	100$			; the new index ?
	divl3	#2,oldvmsize[r6],r1	; yes
	movl	oldvmbase[r6],r2	; get the old size and base address
	movl	vmbase[r6],r3		; we are now all set to copy it
20$:	movw	(r2)+	,(r3)+		; simply copy it
	sobgtr	r1	,20$		; next please
	pushal	oldvmbase[r6]		; now free up the old region
	pushal	oldvmsize[r6]		; base and number of bytes
	calls	#2	,G^lib$free_vm	; done
	movl	vmbase[r6],r0		; return with the current base and exit
	subl3	vmalloc[r6],4(ap),@12(ap);return the incremental allocation
	movl	4(ap)	,vmalloc[r6]	; save total allocation for next time
	brb	100$			; exit
90$:	pushl	r0			; print error message text
	calls	#1	,print_error	;
	clrl	r0			; failure, return 0 for address
100$:	ret				; bye




	.sbttl	allocate virtual memory for workfile buffering


;	char *allbuffer(&n_allocated,pagesize,minimum_pagecount)
;
;	Input:	4(ap)	Return the number of 'ted' buffers allocated
;		8(ap)	Minimum number of 512 byte pages to allocate
;		12(ap)	Maximum number of 512 byte pages to allocate
;	Return:	4(ap)	Number actually allocated
;		r0	zero for error, else starting address
;
;	This routine is called to let  the editor's workfile cacher to
;	dynamically allocate buffers for that work file.  While on VMS
;	we could allocate up to our pagefilequota less current size of
;	buffers,  this is not reasonable since we can likely do better
;	than VMS regarding clustering of the buffers in cache. This is
;	an external routine for portability in that each implementaion
;	can make it's own decision on what to do about the size of the
;	cache at run time. For VMS, it is (for now) simply the WSQUOTA
;	divided by 10.  Soon I will  change this to be nonlinear since
;	user's with large WSQUOTA are penalized by using a linear all-
;	ocation function.
;
;	Called from PAGEINIT()
;
	.psect	rmsdata
ws_quo:	.long	500,750,1000,2000,0
bf_all:	.long	10,4,3,2,2		; last entry is max
	.psect	code


	.entry	allbuffer		^M<r2,r3,r4>

	clrl	-(sp)			; allocate a buffer for later
	clrl	-(sp)			; two words please
	movl	sp	,r4		; set a pointer to that buffer
	$getjpiw_s itmlst=wsquota	; allocate buffers based on WSQUOTA
	blbc	r0	,90$		; getjpi can't fail for self now!
	movl	@<wsquota+4>,r3		; get the current wsquota now
	clrl	r1			; index
5$:	tstl	ws_quo[r1]		; end of the table ?
	beql	6$			; yes
	cmpl	r3	,ws_quo[r1]	; no, find wsquota in the range?
	blequ	6$			; yes
	incl	r1			; no, try next entry
	brb	5$			; next please
6$:	divl3	bf_all[r1],r3,r2	; and get the size
	cmpw	r2	,8(ap)		; did we allocate enough pages?
	bgtru	10$			; yes
	movzwl	8(ap)	,r2		; no, make it the minimum please
10$:	cmpw	r2	,12(ap)		; is the value too high ?
	blequ	20$			; no
	movzwl	12(ap)	,r2		; yes, fix it please
20$:	mull3	r2,#512	,4(r4)		; convert to a byte count
	pushal	(r4)			; address of where to return size
	pushal	4(r4)			; size in bytes for the request
	calls	#2	,G^lib$get_vm	; and get some memory from VMS
	blbc	r0	,90$		; failure, return zero
	movl	r2	,@4(ap)		; return the number allocated
	movl	(r4)	,r0		; return the starting address
	brb	100$			; exit
90$:	clrl	r0			; error exit
	clrl	@4(ap)			; clear allocation count also
100$:	tstl	(sp)+			; pop a buffer and exit
	ret				; bye


	.sbttl	fixfilename	remove version number

;+	FIXFILENAME(dst,src)		fix filename (remove version number)
;
;	 FIXFILENAME will remove the version number from GETNEXT for
;	the default answer to the output file, thus avoiding RMS32's
;	lack of desire to supercede files.
;
;	Passed:
;
;		4(ap)	The address to return the filename, .asciz
;		8(ap)	The address of the filename to parse, .asciz
;
;	Returns:
;
;		R0	1, always successful
;-

	.entry	fixfilename		,^M<r2>

	movl	4(ap)	,r2		; where to put the filename
	movl	8(ap)	,r1		; where it comes from
10$:	cmpb	(r1)	,#^a/;/		; stop on null or ';'
	beql	20$			; found a semicolon
	movb	(r1)+	,(r2)+		; not found keep going
	bneq	10$			; next please
20$:	clrb	(r2)			; insure .asciz and exit
	movzbl	#1	,r0		; success
	ret				; bye



	.sbttl	get temp filename based on the process PID

;+	GETUNIQUEFILE(address(filename))
;
;	Input:	4(ap)	address of where to return filename
;	Return:	@4(ap)	asciz filename
;		r0	zero -> failure
;		r0	one  -> success
;
;	GETUNIQUEFILE is called by any routine that needs to create
;	a small workfile, such as is done in the  PARAGRAPH command
;	and in the QUE  command.  The returned filename is based on
;	the low word of the PID.
;-

	.entry	getuniquefile		,^M<r2,r3,r4>

	$getjpiw_s itmlst = pid		; get our own process id
	movl	4(ap)	,r4		; point to the destination
	movb	#^A/T/	,(r4)+		; copy 'ted' into it
	movb	#^A/E/	,(r4)+		; copy 'ted' into it
	movb	#^A/D/	,(r4)+		; copy 'ted' into it
	movl	#4	,r0		; loop and convert to hex
	movl	#^X1000	,r2		; divide the low part of the PID
10$:	bicl3	#^C^XFFFF,pidval,r3	; get the low part of the pid please
	divl2	r2	,r3		; and get the next digit shifted
	bicl2	#^C^XF	,r3		; mask off the higher digits left
	movb	L^hexmap(r3),(r4)+	; and copy the character
	divl2	#^X10	,r2		; divided by a little less next time
	sobgtr	r0	,10$		; next please
	movb	#^A/./	,(r4)+		; copy '.tmp' into it
	movb	#^A/T/	,(r4)+		; copy '.tmp' into it
	movb	#^A/M/	,(r4)+		; copy '.tmp' into it
	movb	#^A/P/	,(r4)+		; copy '.tmp' into it
	clrb	(r4)
	ret	
	ret


	.sbttl	user visible i/o routines for native mode ted

	.psect	code	,lcl,con,exe,shr,rel,nowrt


;	XINIT	start things for the exec we are running on
;+	XINIT()				do system dependent initialization
;+	SETTERMINAL()			setup the terminal for screen editing
;+	RSTTERMINAL()			restore the terminal from SETTER


	.entry	xinit		,^M<r2,r3>

	calls	#0	,open$tty
	clrl	cctyped			; no control C's
	clrl	exquota_flag		; we want to know if the image was
	$getjpiw_s itmlst=curpriv	; installed with EXQUOTA
	blbc	r0	,20$		; it failed (?)
	bitl	#1@PRV$V_EXQUOTA,@<curpriv+4>
	beqlu	20$			; no exqouta 
	incl	exquota_flag		; image installed with exquota
10$:	$getjpiw_s itmlst=authpriv	; but if the user has exquota in sysuaf
	blbc	r0	,20$		; then we could care less.
	bitl	#1@PRV$V_EXQUOTA,@<authpriv+4>
	beqlu	20$			; no exqouta 
	clrl	exquota_flag		; has exquota, so we never drop it.
20$:	cmpw	#nam_maxsize,L^maxfilesize; insure C routines allocate space
	blss	30$			; for the maximum length filename.
	halt				; no, die then
30$:	movzbl	#1	,r0		; return success and exit
	ret


	.entry	forcevtedit		,^M<>

	clrl	r0
	ret


	.entry	inqtermtype		,^M<r2,r3>

	subl2	#20	,sp		; allocate a buffer
	movl	sp	,r2		; point to the buffer allocated
	movl	#2	,r3		; assume a VT100 today
	$qiow_s	chan=tty_lun,-		; find out about the current settings
		func=#io$_sensemode,-	;
		p1=(r2),p2=#12		;
	blbc	r0	,100$		; assume vt100 on error
	bitl	#TT2$M_DECCRT2,8(r2)	; is this a VT2xx series terminal?
	beqlu	100$			; no
	incl	r3			; yes, return 3 (vt220)
100$:	movl	r3	,r0		; return result
	addl2	#20	,sp		; pop stack and exit
	ret				; bye


	.entry	setterminal		,^M<>

	$qiow_s	chan=tty_lun,-		; we want to first off all get
		func=#io$_sensemode,-	; the old terminal characteristics
		p1=oldtermchar,-	; save it in OLDTERMCHAR
		p2=#12			; we also want the extended chars
	movq	oldtermchar,newtermchar	; get the first 8 bytes
	movl	oldtermchar+8,newtermchar+8 ; and the next 4
	bisl2	#TT2$M_DECCRT,newtermchar+8 ; set ter/dec
	bisl2	#TT$M_MECHTAB,newtermchar+4 ; set ter/tab
	bicl2	#TT$M_WRAP   ,newtermchar+4 ; set ter/nowrap
	$qiow_s	chan=tty_lun,-		; now actually set the new stuff up
		func=#io$_setmode,-	; so that the editor will function
		p1=newtermchar,-	; properly please
		p2=#12			;
100$:	movzbl	#1	,r0		; return success and exit
	ret


	.entry	rstterminal		,^M<>

	$qiow_s	chan=tty_lun,-		; now actually set the new stuff up
		func=#io$_setmode,-	; so that the editor will function
		p1=oldtermchar,-	; properly please
		p2=#12			;
	bitl	#TT2$M_APP_KEYPAD,oldtermchar+8
	beql	10$			; SET TER/NOAPP
	calls	#0	,kpapplication	; force keypad back on please
10$:	movzbl	#1	,r0		; return success and exit
	ret

	.entry	noecho	,^M<>

	movzbl	#1	,r0		; return success and exit
	ret

	.entry	backup	,^M<>

	movzbl	#1	,r0
	ret




	.sbttl	suspend the image for a while

;+	SUSPEND(number_of_ seconds)
;
;	Input:	4(ap)	Number of seconds to suspend the image
;	Return:	r0	1, always successful
;-


	.entry	suspend			,^M<r2>

	cmpb	(ap)	,#1		; passed the right stuff?
	movzwl	#1	,r2		; assume 1 second wait please
	bneq	10$			; no
	movzwl	4(ap)	,r2		; get the amount to do it
10$:	$schdwk_s daytim=second		; schedule it and wait
	$hiber_s			; take a nap
	sobgtr	r2	,10$		; do it again?
100$:	movzbl	#1	,r0		; return success and exit
	ret


	.entry	waittenth		,^M<>

	$schdwk_s daytim=tenthsecond	; wait one tenth of a second
	$hiber_s			; do it
	movzbl	#1	,r0		; and return success please
	ret

	.entry	settimerast		,^M<r2>

;	SETTIMERAST(seconds,ast_addr)

	movq	second	,-(sp)		; convert the passed time to
	movl	sp	,r2		; proper format, and a pointer
	tstl	4(ap)			; to it. Ignore if <= zero
	bleq	100$			; exit
	mull2	4(ap)	,(r2)		; convert to vms time format
	$setimr_s daytim = (r2),-	; and schedule an ast
		  efn = #11,-		; must use a unique event flag
		  astadr = @8(ap)	; and the ast address
100$:	addl2	#8	,sp		; pop stack and exit
	ret

	.entry	cantimerast		,^M<>

	$cantim_s
	ret




	.sbttl	fast string copy,strlen and gettim


;+	STRLEN(stringaddress)		return the length of .asciz string
;	Note: STRLEN ept removed for VAX c version 2.
;
;	Input:	4(ap)	Address of asciz string
;	Return:	r0	The string length
;
;
;+	SCOPY(to,from,fromsize)		use MOVC3 to copy a string
;
;	Input:	4(ap)	The destination string address
;		8(ap)	The source string address
;		12(ap)	The number of bytes to copy
;
;	SCOPY uses whatever hardware features that are available to do
;	a very fast string copy. On the VAX, we simply used MOVC3.  On
;	something like a PDP11, we would try to break the copy into  a
;	fast loop (by using multiple MOVB instructions or folding  the
;	MOVB's into a MOV).
;-

;-	.entry	strlen			,^M<>
;
;	movl	4(ap)	,r1		; get the string address
;	clrl	r0			; the length to return
;10$:	tstb	(r1)+			; end of the string yet?
;	beql	20$			; yes
;	incl	r0			; no, count it
;	brb	10$			; next please
;20$:	ret				; exit


	.entry	scopy			,^M<r2,r3,r4,r5>

	movc3	12(ap),@8(ap),@4(ap)	; copy it please
	ret				; and exit




	.sbttl	get the date and time

;+	GETTIM(address(buffer))
;
;	Input:	4(ap)	Address of 18 character buffer to return the time
;	Return:	@4(ap)	Asciz string of the current date and time
;
;	GETTIM is used by the GOLD T command to insert a time stamp into
;	the text being edited.
;-


	.entry	gettim			,^M<r2>

	$asctim_s timbuf=curtime	; get it please
	movl	4(ap)	,r1		; get where we put it
	moval	timebuffer,r0		; where we just put it
	movl	#17	,r2		; size to return
10$:	movb	(r0)+	,(r1)+		; copy it
	sobgtr	r2	,10$		; copy the next one also
	clrb	(r1)			; insure .asciz
	ret				; exit


	.sbttl	getcommandline

;+	GETMCRCOMMAND(string)		return the command line with imagename
;
;	Input:	4(ap)	Address of buffer to return the string
;	Return:	@4(ap)	Asciz string of command name including image name
;		r0	zero for failure, one for success
;
;	Return the command line to the editor.  Since LIB$GET_FOREIGN
;	removes the command name we re-insert it by getting the image
;	name and removing everything but the filename field of it. We
;	then append to that the command line.
;-

	.entry	getmcrcommand		,^M<r2,r3,r4,r5,r6,r7>


	movl	4(ap)	,r7		; we need the buffer address asap
	clrl	r6			; and the counter for the returned len
	$getjpiw_s itmlst=imagename	; get current process info, like
	blbc	r0	,60$		; it failed ?
	movl	@imagename+8,r3		; get the length of the image name
	addl3	imagename+4,r3,r2 	; get a pointer to the end of string
10$:	cmpb	-(r2)	,#^A/./		; go backwards until we find the start
	beqlu	15$			; of the filetype field of the name
	sobgtr	r3	,10$		; not found, continue looking for a dot
	brb	60$			; not found (?)
15$:	clrl	r4			; now count the characters of the name

20$:	cmpb	-(r2)	,#BIGA		; now scan until we find something that
	blssu	30$			; is not an uppercase letter
	cmpb	(r2)	,#BIGZ		; ge than 'A', so check for le 'Z'
	bgtru	30$			; not a letter
	incl	r4			; count it into the length please
	sobgtr	r3	,20$		; a letter, continue on please
	brb	60$			; we just ran off the end of it (?)

30$:	tstb	(r2)+			; get repositioned please
40$:	movb	(r2)+	,(r7)+		; copy it please
	incl	r6			; add into the string length
	sobgtr	r4	,40$		; next please
	movb	#SPACE	,(r7)+		; a delimiter please
	incl	r6			; count the length please
	
60$:	pushal	commandlength		; onto the stack now
	pushl	#0			; no user prompt
	pushal	commandline		; and the address of the string
	calls	#3	,G^lib$get_foreign
	blbc	r0	,90$		; it failed for whatever reason
	movc3	commandlength,@commandline+4,(r7)
80$:	addl3	commandlength,r6,r0	; return the command line length
	brb	100$			; and exit
90$:	clrl	r0			; error exit, return nothing
100$:	ret




	.sbttl	save/restore the last filename edited

;	SAVEFILENAME(filename_address)
;
;	Input:	4(ap)	Address if asciz string of name to save
;	Output:	r0	zero for failure, otherwise one
;
;	 SAVEFILENAME takes the filename passed and defines that name
;	as a process logical name TED_LAST_FILE_EDITED.  Thus at  the
;	start of the editor, if no filename was passed on the command
;	line we can call RSTFILENAME to see if a valid translation of
;	that logical name exists.
;-

	.entry	SAVEFILENAME		,^M<r2,r3,r4,r5>

	pushl	4(ap)			; yes,get the string length
	calls	#1	,G^strlen	; may as well do it this way
	tstl	r0			; anything there ?
	beql	100$			; no
	movab	fab_find,r4		; setup to parse the name so we
	movab	nam_find,r5		; can get the full directory path
	movb	r0	,fab$b_fns(r4)	; and store it where we need it
	movl	4(ap)	,fab$l_fna(r4)	; and stuff the string address
	$parse	fab=r4			; and parse the filename
	blbc	r0	,90$		; failed, return 0 and save error
	movzbl	nam$b_esl(r5),r2	; get the expanded string's length
	movl	nam$l_esa(r5),r3	; get the expanded string's address
	clrl	r4			; count until we find a semicolon
10$:	cmpb	(r3)+	,#^A/;/		; look for the version number
	beql	20$			; found it, exit
	incl	r4			; not found, increment the length
	sobgtr	r2	,10$		; and do it again
20$:	
	subl2	#8	,sp		; allocate a string descriptor
	movl	sp	,r2		; and a pointer to it please
	movl	nam$l_esa(r5),4(r2)	; insert string address into descr.
	movl	r4	,(r2)
	pushl	r2			; pass the value to assign
	pushal	lastlogname		; and the equiv string to create
	calls	#2	,G^LIB$SET_LOGICAL
	blbc	r0	,90$		; failure
	movzbl	#1	,r0		; success, return(1)
	brb	100$			; exit
90$:	clrl	r0			; failure, return(0)
100$:	addl2	#8	,sp		; restore the stack and exit
	ret


;+	RSTFILENAME(filename_address)
;
;	Input:	4(ap)	Address of where to return the logical name translation
;	Return:	@4(ap)	If successful, the translation in asciz else a null
;		r0	zero for failure (no translation), otherwise one.
;
;	RSTFILENAME is called from EDSTART if a filename was absent from the
;	command line. When called, it will attempt a translation of the name
;	TED_LAST_FILE_EDITED.
;-

	.entry	RSTFILENAME		,^M<r2,r3>

	clrl	-(sp)			; where to return the length
	movl	sp	,r2		; save it please
	pushl	4(ap)			; push the buffer address
	pushl	#128			; and the maximum size of it
	movl	sp	,r3		; get the pointer to the descr.
	$trnlog_s -			; and try to xlate the ted saved name
		lognam = lastlogname ,-	; the name we wish to translate
		rsllen = (r2) , -	; where to return the length
		rslbuf = (r3)		; the descriptor to return to
	cmpl	r0	,#SS$_NOTRAN	; no equivalence name present?
	beqlu	90$			; yes, exit with nothing then.
	blbc	r0	,90$		; it failed, oops
	addl3	4(ap),(r2),r0		; success, point to the end of the
	clrb	(r0)			; string and make it .asciz please
	movzbl	#1	,r0		; return(success)
	brb	100$			; and exit
90$:	movl	4(ap)	,r0		; failure, return null string
	clrb	(r0)			; and return(0)
	clrl	r0			;
100$:	addl2	#4*3	,sp		; pop the stack and exit
	ret				; and exit





	.sbttl	return name of home directory name

	.entry	gethomedir		,^M<>

	movab	homedir	,r0
	movl	4(ap)	,r1
10$:	movb	(r0)+	,(r1)+
	bneq	10$
	movzbl	#1	,r0
	ret



	.sbttl	do a dcl command


;+	DCLCOMMAND(string)		execute a DCL command line


	.entry	dclcommand		,^M<r2,r3>

	subl2	#10	,sp		; allocate a string descriptor
	movl	sp	,r1		; and a pointer to it please
	movl	4(ap)	,r2		; get the command line address
	clrl	r0			; now get the string length please
10$:	tstb	(r2)+			; found the end of it yet?
	beql	20$			; yes
	incl	r0			; no, keep going please
	brb	10$			; and check the next one
20$:	movl	r0	,(r1)		; stuff the length in
	movl	4(ap)	,4(r1)		; and the string address
	pushl	r1			; stuff the command line and get
	calls	#1	,G^lib$spawn	; it spawned
	blbs	r0	,100$		; success
	pushl	r0			; failure, find out why
	calls	#1	,print_error	; simple
100$:	movzbl	#1	,r0		; always return success please
	addl2	#10	,sp		; pop string descriptor
	ret				; exit



	.sbttl	send a file to the printer


;+	QUEFILE(filename)		send a file to SYS$PRINT
	
	.entry	quefile			,^M<r2,r3,r4>

	pushl	fab_find+fab$l_fop	; save old file options flag
	pushl	4(ap)			; get the string length
	calls	#1	,G^strlen	; may as well do it this way
	tstl	r0			; anything there ?
	beql	100$			; no
	moval	fab_find,r2		; get the fab address please
	moval	nam_find,r3		; and the name block also
	movb	r0	,fab$b_fns(r2)	; and store it where we need it
	movl	4(ap)	,fab$l_fna(r2)	; and stuff the string address
	clrw	fab$w_ifi(r2)		; insure that internal fid is 0
	$parse	fab=r2			; and parse the filename
	blbc	r0	,90$		; failed, return 0 and save error
	bisl2	#fab$m_spl,fab$l_fop(r2); set for spooling at file close
	$open	fab=r2			; try to find the file now
	blbc	r0	,90$		; failure
	$close	fab=r2			; close up shop now
	movzbl	#1	,r0		; success
	brb	100$			; exit
90$:	movl	r0	,tedsyserror	; save the error
	clrl	r0			; and flag as being not there
100$:	popl	fab_find+fab$l_fop	; save old file options flag
	ret



	.sbttl	delete a file

	.entry	delfile			,^M<r2>

	pushl	4(ap)			; get the string length
	calls	#1	,G^strlen	; may as well do it this way
	tstl	r0			; anything there ?
	beql	100$			; no
	moval	fab_find,r2		; get the fab address please
	movb	r0	,fab$b_fns(r2)	; and store it where we need it
	movl	4(ap)	,fab$l_fna(r2)	; and stuff the string address
	clrw	fab$w_ifi(r2)		; insure that internal fid is 0
	$parse	fab=r2			; and parse the filename
	blbc	r0	,90$		; failed, return 0 and save error
	$erase	fab=r2			; get rid of it now
	blbc	r0	,90$		; success
	movzbl	#1	,r0		; return(1)
	brb	100$			; exit
90$:	clrl	r0			; failure
100$:	ret				; bye




	.sbttl	directory lookup routines

;+	ISDIRECTORY(f)
;
;	Passed:
;		4(ap)	address of .asciz filename
;
;	Returns:
;		r0	zero	if error or not a dir file
;			one	if a dir file
;-

	.entry	isdirectory		,^M<r2,r3,r4,r5,r6,r7,r8,r9,r10>

	clrl	uchar			; insure zeroed
	clrq	-(sp)			; allocate an IOSB
	movl	sp	,r10		; simple
	clrq	-(sp)			; allocate a descriptor
	movl	sp	,r7		; a pointer
	clrq	-(sp)			; another descriptor
	movl	sp	,r8		; and a pointer to it also
	movc5	#0,(sp),#0,#FIB$C_LENGTH,fib
	pushl	4(ap)			; get the string length
	calls	#1	,G^strlen	; may as well do it this way
	tstl	r0			; anything there ?
	bneq	10$			; no
	brw	100$
10$:	moval	fab_find,r2		; get the fab address please
	moval	nam_find,r6		; and the name block also
	movb	r0	,fab$b_fns(r2)	; and store it where we need it
	movl	4(ap)	,fab$l_fna(r2)	; and stuff the string address
	$parse	fab=r2			; and parse the filename
	blbc	r0	,20$		; parse failed
	$search	fab=r2			; do a search in case version is
	blbs	r0	,30$		; is missing. Succss
20$:	brw	90$			; failure
30$:	movc3	#16,NAM$T_DVI(r6),dev_nam ; copy the device name over
	movzbl	dev_nam	,(r7)		; setup a descriptor for it
	movab	dev_nam+1,4(r7)		; counted string
	$assign_s -			; and assign a channel to device
		devnam = (r7) , -	; the device name
		chan   = (r8)		; the channel is returned here
	blbc	r0	,90$		; but please exit on errors
	movzbl	NAM$B_TYPE(r6),r0	; setup a descriptor for the
	movzbl	NAM$B_VER(r6),r1	; filename+type+version
	movzbl	NAM$B_NAME(r6),r2	; ....
	addl2	r0	,r1		;   ....
	addl3	r1,r2,fil_dsc		; set the name+type+ver length
	movl	NAM$L_NAME(r6),fil_dsc+4; set the filename address up
	movab	FIB	,r9		; point to the FIB now
	movl	NAM$W_DID(r6),FIB$W_DID(r9)
	movw	NAM$W_DID+4(r6),FIB$W_DID+4(r9)
	$qiow_s	func	= #IO$_ACCESS ,-; access the file please
		iosb	= (r10) , -	; I/O status block
		chan	= (r8) , -	; channel number
		p1	= fib_dsc , -	; FIB block
		p2	= #fil_dsc , -	; filename descriptor
		p5	= #atrlst	; attribute list that we want
	blbc	r0	,90$		; qio failed
	movzwl	(r10)	,r0		; qio worked, see if the ACP
	blbc	r0	,90$		; found the file
	bitl	#FCH$M_DIRECTORY,uchar	; ok, see if directory bit is set
	beql	90$			; no, return failure
	movzbl	#1	,r0		; success
	brb	100$			; exit

90$:	movl	r0	,tedsyserror	; save the error
	clrl	r0			; and flag as being not there

100$:	addl2	#8*3	,sp		; pop the stack from data allocated
	pushl	r0			; save the return status
	movl	(r8)	,r8		; get the channel number
	beql	110$			; zero if $assign never called
	$dassgn_s chan = r8		; free the LUN now
110$:	popl	r0			; pop register and exit
	ret				; bye
	



	.sbttl	directory lookup routines

;+	FLOOKUP(filename)		Find a file
;
;	Passed:
;
;		4(ap)	address of .asciz filename
;
;	Returns:
;
;		r0	zero if error, else one
;-

	.entry	flookup			,^M<r2,r3,r4,r5>

	pushl	4(ap)			; get the string length
	calls	#1	,G^strlen	; may as well do it this way
	tstl	r0			; anything there ?
	beql	100$			; no
	moval	fab_find,r2		; get the fab address please
	moval	nam_find,r3		; and the name block also
	movb	r0	,fab$b_fns(r2)	; and store it where we need it
	movl	4(ap)	,fab$l_fna(r2)	; and stuff the string address
	$parse	fab=r2			; and parse the filename
	blbc	r0	,90$		; failed, return 0 and save error
	$search	fab=r2			; try to find the file now
	blbc	r0	,90$		; failure
	movzbl	#1	,r0		; success
	brb	100$			; exit
90$:	movl	r0	,tedsyserror	; save the error
	clrl	r0			; and flag as being not there
100$:	ret
	


	.sbttl	get next wildcarded input file


;+	GETNEXT(resname,wildname,flag)	Find the next wildcarded file
;
;	Passed:
;
;	4(ap)	address to return a .asciz name of the next file
;	8(ap)	source wildcarded name
;	12(ap)	parse flag, if zero, then start all over
;
;	Returns:
;
;	r0	2 for no more files, 1 for success, else 0
;-

	.entry	getnext			,^M<r2,r3,r4,r5>

	moval	fab_next,r2		; get the fab address please
	moval	nam_next,r3		; and the name block also
	movzbl	#1	,r5		; assume looking for next file
	tstl	12(ap)			; first time we have been called?
	bneq	5$			; no
	clrl	old_index		; yes, clear offset from directory top
	brb	10$			; and proceed to the $parse
5$:	cmpl	12(ap)	,old_index	; is the desired file the next one?
	bgequ	20$			; yes, skip the $parse then
	addl2	old_index,r5		; no, flag for looping on $search

10$:	pushl	8(ap)			; yes,get the string length
	calls	#1	,G^strlen	; may as well do it this way
	tstl	r0			; anything there ?
	beql	100$			; no
	movb	r0	,fab$b_fns(r2)	; and store it where we need it
	movl	8(ap)	,fab$l_fna(r2)	; and stuff the string address
	$parse	fab=r2			; and parse the filename
	blbc	r0	,90$		; failed, return 0 and save error

20$:	movl	12(ap)	,old_index	; and the index also please
30$:	$search	fab=r2			; try to find the file now
	blbc	r0	,90$		; failure
	sobgtr	r5	,30$		; we may have to look for a while
	movl	4(ap)	,r5		; where to return the string at
	clrb	(r5)			; start with .asciz please
	movzbl	nam$b_rsl(r3),r1	; get the resultant string size
	beql	100$			; nothing
	movl	nam$l_rsa(r3),r4	; get the string to get
40$:	movb	(r4)+	,(r5)+		; and copy it byte by byte
	sobgtr	r1	,40$		; and do the next one
	clrb	(r5)			; must return .asciz please
	movzbl	#1	,r0		; success
	brb	100$			; exit
90$:	movl	r0	,tedsyserror	; save the error
	cmpl	r0	,#RMS$_NMF	; NO MORE FILES ?
	bneq	95$			; no
	movzwl	#2	,r0		; yes, return such and exit
	brb	100$			; exit
95$:	clrl	r0			; and flag as being not there
100$:	ret




	.sbttl	check for wildcarding and parse a filename


;+	ISWILD(filename)		See if a filename is wildcarded
;
;	Passed:
;
;		4(ap)	.asciz string of a filename to check for wildcarding
;
;	Returns:
;
;		r0	zero for no wildcarding (or error), else 1 for wildcards
;-

	.entry	iswild			,^M<>

	pushl	4(ap)			; call parser to parse name
	calls	#1	,fss		; 
	tstl	r0			; did it work?
	beql	100$			; no
	clrl	r0			; assume not wildcarded
	bitl	#NAM$M_WILDCARD,nam_find+nam$l_fnb
	beql	100$			; no, it was not wildcarded
	incl	r0			; was wildcarded, return success
100$:	ret
	
	

;+	CHKFILENAME(filename)		Check a filename for validity
;
;	Passed:
;
;		4(ap)	.asciz string of the filename to check
;
;	Returns:
;
;		r0	zero for filename error, else 1
;-


	.entry	chkfilename		,^M<>

	pushl	4(ap)			; check to see if a filename
	calls	#1	,fss		; will parse
	ret				; exit
	
	.entry	fss			,^M<r2>

	pushl	4(ap)			; get the string length
	calls	#1	,G^strlen	; may as well do it this way
	tstl	r0			; anything there ?
	beql	100$			; no
	moval	fab_find,r2		; get the fab address please
	movb	r0	,fab$b_fns(r2)	; and store it where we need it
	movl	4(ap)	,fab$l_fna(r2)	; and stuff the string address
	$parse	fab=r2			; and parse the filename
	blbc	r0	,90$		; failed, return 0 and save error
	movzbl	#1	,r0		; success
	brb	100$			; exit
90$:	movl	r0	,tedsyserror	; save the error
	clrl	r0			; and flag as being not there
100$:	ret
	


	.sbttl	write pass all to the terminal and readpassall


;+	PUTBIN(buffer [,length])	Write to TT: without translation
;
;	PUTBIN simply writes the passed buffer to TI:. If 'LENGTH' is
;	omitted or zero, it is assumed that the string is .asciz.
;
;	Passed:
;
;		4(ap)	Buffer address
;		8(ap)	Optional buffer length
;-

	.entry	tedputbin		,^M<r2>

	clrl	r0			; assume length of zero
	cmpb	(ap)	,#1		; omitted the length arg ?
	beql	10$			; yes
	movzwl	8(ap)	,r0		; get the passed length
	bneq	20$			; something was there
10$:	pushl	4(ap)			; nothing, or zero length
	calls	#1	,G^strlen	; get the string length
20$:	$qiow_s	func=#io$_writevblk!io$m_noformat,-
		chan=tty_outlun,-
		p1=@4(ap),-
		p2=r0
	movzbl	#1	,r0		; no errors
	ret				; and exit



	.sbttl	Getbin	Read a character from SYS$INPUT

;+	GETBIN()			Get the next character from terminal
;
;	GETBIN reads one character from the terminal without translation.
;
;	Passed:
;
;		Nothing
;
;	Returns:
;
;		R0	NULL if error, otherwise the character just read
;-

	.entry	getbin		,^M<r2>

	movaw	prevchar,r2		; check for internally stored type
	tstw	(r2)			; ahead data from ast level routines.
	bleq	20$			; nothing is present in that buffer.
	movzwl	2(r2)	,r0		; get the offset now
	movzbl	prevchar+4(r0),r0	; and extract the desired character.
	incw	2(r2)			; fix the offset for the next time?
	decw	(r2)			; fix the remaining character count
	bgtr	100$			; something is left
	clrl	(r2)			; all gone, fix count and offset.
	brb	100$			; exit
20$:	clrl	(r2)			; nothing stored to fetch
	pushl	tty_lun			; do a readpassall
	calls	#1	,ted$binread	; simple to do
	blbc	r0	,90$		; error
	movl	r1	,r0		; no error, return the character
	brb	100$			; bye
90$:	clrl	r0			; error, return a null (nop)
100$:	ret


	.entry	typeahead	,^M<>	; find out if anything is present in
					; the typehead buffer. For systems that
					; can not tell use without actually
					; doing a read, save the character read
	pushl	tty_lun			; in 'prevchar' so getbin will find it.
	calls	#1	,ted$typeahead	; for VMS, do a io$_sensemode
	ret				; bye


	.sbttl	read from file/terminal


;	GETLINE
;+	GETLINE(tedlun,buf,sizeaddr)	Get a line from the terminal
;
;	4(ap)	ted's LUN , if eq KBLUN then terminal else INPLUN for disk
;	8(ap)	address of the user's byte buffer
;	12(ap)	address of where to return the record size read


	.entry	getline		,^M<r2>

	movzbl	#chan_input,r2		; assume disk input please
	cmpb	4(ap)	,inlun		; ted's input lun?
	beql	10$			; yes
	movzbl	#chan_ind,r2		; no, assume @file
	cmpb	4(ap)	,indlun		; ted's command file lun
	beql	10$			; yes
	movzbl	#chan_terminal,r2	; no, must be the terminal then
10$:	pushl	r2			; construct the call list for
	pushl	maxlen			; ted$getrecord. Push the max buffer
	pushl	8(ap)			; size and the buffer address
	calls	#3	,ted$getrecord	; simple enough to do
	clrl	@12(ap)			; assume the read failed
	cmpl	r0	,#RMS$_RTB	; did we get a record too long?
	bnequ	20$			; no
	movl	r1	,@12(ap)	; yes, return sys_toolong
	movzbl	#SYS_TOOLONG,r0		; and exit
	brb	100$			;
20$:	blbc	r0	,90$		; error exit
	movl	r1	,@12(ap)	; success, return the read size
	movzbl	#1	,r0		; and return success
	brb	100$
90$:	movl	eoferror,r0		; return failure
100$:	ret				; exit


;+	GETPRM(buffer,prompt,maxlen)	Get a line with prompting
;-
	.entry	getprm		,^M<r2>	; get with prompt string

	pushl	8(ap)			; asciz, push the buffer address
	pushl	#0			; and the flag for asciz
	calls	#2	,type_ascii	; dump it out please
	pushl	#chan_terminal		; reading from the terminal today
	pushl	12(ap)			; the max amout to do
	pushl	4(ap)			; the buffer address
	calls	#3	,ted$getrecord	; and read it in
	blbc	r0	,90$		; error
	movl	r1	,r0		; success, return(recordlength)
	brb	100$			; and exit
90$:	clrl	r0			; failure, return(0)
100$:	ret				; and exit

	


;+	GETYESNO(prompt,default)	return YES/NO for the prompt

	.entry	getyesno	,^M<r2,r3>

	pushl	4(ap)			; dump the prompt out please
	calls	#1	,putbin		; and then get the response
	subl2	#20	,sp		; allocate a buffer now
	movl	sp	,r2		; and a pointer to it also
	pushl	#20			; get the response from the terminal
	pushl	r2			; stuff maximum read size and buffer
	pushl	tty_lun			; the channel number to use
	calls	#3	,ted$ttread	; and get a line please
	blbc	r0	,80$		; the read failed for whatever reason
	cmpb	(r2)	,#CR		; a carriage return typed?
	bneq	10$			; no
	movb	@8(ap)	,(r2)		; yes, stuff the default response in
10$:	cmpb	(r2)	,#BIGY		; upper case 'Y' ?
	beql	20$			; yes
	cmpb	(r2)	,#SMALLY	; how about a lower case y
	bneq	90$			; no, return failure
20$:	movzbl	#1	,r0		; yes, return(1)
	brb	100$			; and exit

80$:	movl	#-1	,r0		; return (-1) on read errors
	brb	100$			; exit

90$:	clrl	r0			; return(0)
100$:	addl2	#20	,sp		; pop local buffer and exit
	ret



	.sbttl	put a line to terminal or file


;+	PUTLINE(tedlun,buffer,length)	write to passed internal LUN
;
;	Write a line out to disk, stripping the trailing <CR><LF>
;	off in the process.
;
;	4(ap)	ted's internal lun
;	8(ap)	buffer address
;	12(ap)	size of the record
;-


	.entry	putline		,^M<r2,r3>

	movzwl	12(ap)	,r3		; the size of the write
	cmpw	4(ap)	,outlun		; writing to a disk file ?
	beql	20$			; yes
	tstl	r3			; nothing to do ?
	beql	10$			; exit with success then
	pushl	12(ap)			; no, simple dump in write passall
	pushl	8(ap)			; push both the buffer address
	calls	#2	,putbin		; and the size of the buffer
10$:	movzbl	#1	,r0		; assume it worked ok
	brb	100$			; exit

20$:	cmpl	r3	,#2		; must have at least TWO characters
	blss	50$			; zero or one character, skip it.
	addl3	r3,8(ap),r2		; point to the end of the user buffer
	cmpb	-(r2)	,#LF		; a line feed hanging at the end?
	bneq	50$			; no, use the record as passed
	cmpb	-(r2)	,#CR		; a carriage return next to the <LF>?
	bneq	50$			; no, forget it
	decl	r3			; yes, byte count is off by one now
	decl	r3			; yes, byte count is off by two now

50$:	pushl	#chan_output		; we are writing today
	pushl	r3			; the size of the write
	pushl	8(ap)			; the buffer address
	calls	#3	,ted$putrecord	; simple to do
	blbc	r0	,60$		; success?
	movzbl	#1	,r0		; yes
	brb	100$			; exit
60$:	pushl	tedsyserror
	calls	#1	,print_error
	clrl	r0			; failure
100$:	ret



	.sbttl	misc routines



	.entry	crlfout		,^M<>	; dump a <CR><LF> sequence
	calls	#0	,print_crlf	; simple
	ret


	.entry	cretm1		,^M<>
	movzbl	#1	,r0		; dummy routine, return success
	ret				; exit


	.entry	cretm2		,^M<>
	movzbl	#1	,r0		; dummy routine, return success
	ret				; exit



	.sbttl	open and close

	.psect	rmscode	,exe,con,shr,nowrt,lcl,rel

;+	OPNHLP(address_helpfilename)	open the passed help filename
;
;-	open the passed help file

	.entry	opnhlp		,^M<>

	subl	#120	,sp		; allocate a buffer
	movl	sp	,r1		; and a pointer to that buffer
	movab	help$device,r0		; now copy the device string in
10$:	movb	(r0)+	,(r1)+		; simple
	bnequ	10$			; next please
	decl	r1			; backup to the null we copied
	movl	4(ap)	,r0		; and copy it
20$:	movb	(r0)+	,(r1)+		; simple
	bnequ	20$			; not done yet
	decl	r1			; backup over the null
	movab	help$filetype,r0	; add in a filetype please
30$:	movb	(r0)+	,(r1)+		; and copy it in
	bnequ	30$			; next please
	movl	sp	,r1		; point back to the buffer
	pushl	#chan_help		; the LUN
	pushl	r1			; the filename, .asciz
	calls	#2	,ted$open	; simple to do
	addl	#120	,sp		; pop the buffer and exit
	ret


;+	OPENFI(name,tedlun)		open the passed filename for r or w
;
;	open or create a sequential file based on 'channel'

	.entry	openfi		,^M<>

	cmpb	8(ap)	,outlun		; if output then do it for output
	bneq	10$			; must be for output
	pushl	#chan_output		; map to our lun table
	pushl	4(ap)			; simple
	calls	#2	,ted$create	; do it and exit
	brb	100$			; bye
10$:	cmpb	8(ap)	,inlun		; input file ?
	bneq	20$			; no (?)
	pushl	#chan_input		; map to our lun table
	brb	30$			; and open it
20$:	cmpb	8(ap)	,indlun		; command file today?
	bneq	90$			; no
	pushl	#chan_ind		; yes, use correct internal lun
30$:	pushl	4(ap)			; simple
	calls	#2	,ted$open	; do it and exit
	brb	100$			; exit
90$:	brb	100$
100$:	ret
	



	.sbttl	external ept CLOSEF for closing disk files

;+	CLOSEF(tedlun)			close the passed file

	.entry	closef	,^M<>

	cmpb	4(ap)	,outlun
	bneq	10$
	pushl	#chan_output
	calls	#1	,ted$close
	brb	100$
10$:	cmpb	4(ap)	,inlun
	bneq	20$
	pushl	#chan_input
	calls	#1	,ted$close
	brb	100$
20$:	cmpb	4(ap)	,indlun
	bneq	30$
	pushl	#chan_ind
	calls	#1	,ted$close
	brb	100$
30$:
100$:	movzbl	#1	,r0
	ret



	.sbttl	read/write blocks

;+	GETTBLOCK(bufferadr,size,vbn,window)	Read a workfile block
;
;	Read a bucket from the main work file

	.entry	gettblock	,^M<>

	movl	16(ap)	,r0
	pushl	tempmap[r0]		; the lun
	pushl	12(ap)			; the block number
	pushl	8(ap)			; the size of the read
	pushl	4(ap)			; the buffer address
	calls	#4	,ted$get_block	; simple
	tstl	r0
	bneq	100$
	pushl	tedsyserror		; yes, dump the error message
	calls	#1	,print_error	; and exit
	clrl	r0			; bye
100$:	ret





;+	REAHLP(bufferaddress,vbn)	Read a HELP buffer
;
;	Read a block from the help file

	.entry	reahlp		,^M<>

	pushl	#chan_help		; the lun
	pushl	8(ap)			; the vbn to do
	pushl	#512.			; the size of the read
	pushl	4(ap)			; the buffer address
	calls	#4	,ted$get_block	; and do it
	ret				; bye



;	GETBLOCK
;
;	input:	4(ap)	byte record buffer address
;		8(ap)	record size
;		12(ap)	block number
;		16(ap)	internal lun
;	output:	r0	rms sts
;		r1	record length
;
;	for the 'C' interface, return 1 if ok, else zero, saving
;	the error code in TEDSYSERROR

	.entry	ted$get_block	,^M<r2>

	movzwl	16(ap)	,r2		; get the internal lun to use
	movl	rablist[r2],r2		; get the rab for this file
	movw	8(ap)	,rab$w_usz(r2)	; set the max record size in place
	movl	4(ap)	,rab$l_ubf(r2)	; and the user's buffer address
	movl	12(ap)	,rab$l_bkt(r2)	; and the vbn to read
	$read	rab=r2			; read the next record now
	clrl	r1			; presume error, set size eq 0
	blbc	r0	,100$		; error, exit please
	movzwl	rab$w_rsz(r2),r1	; it worked, get the amount read
	movzbl	#1	,r0		; return success for 'C'
	brb	110$			; exit
100$:	movl	r0	,tedsyserror	;
	clrl	r0			; return failure
110$:	ret				; exit

	



;+	PUTTBLOCK(bufferaddress,size,vbn,window)
;
;	Write a bucket to the main work file

	.entry	puttblock	,^M<>

10$:	movl	16(ap)	,r0
	pushl	tempmap[r0]		; the lun
	pushl	12(ap)			; the block number
	pushl	8(ap)			; the size of the write
	pushl	4(ap)			; the buffer address
	calls	#4	,ted$put_block	; simple
	tstl	r0			; errors ?
	bneq	100$			; no
	pushl	tedsyserror		; yes, dump the error message
	calls	#1	,print_error	; and exit
	clrl	r0			; bye
100$:	ret



;	PUTBLOCK
;
;	input:	4(ap)	byte record buffer address
;		8(ap)	size of record to write
;		12(ap)	vbn
;		16(ap)	internal lun
;	output:	r0	rms rst


	.entry	ted$put_block	,^M<r2,r3>

	tstl	exquota_flag		; first of all, check to see if
	beql	10$			; we should get EXQUOTA back for
	$setprv_s prvadr=exquota , -	; the workfile write.
		  enbflg=#1		; if so, go get it please
10$:	jsb	200$			; now try the write operation
	tstl	r0			; if it worked, exit, otherwise
	bneq	100$			; we will have to retry the $PUT
	cmpl	tedsyserror,#RMS$_EXT	; in case it was an ACP extend
	bnequ	100$			; error.
	jsb	200$			; It was, so retry the operation
100$:	tstl	exquota_flag		; now see if we should drop EXQUOTA
	beql	120$			; no
	pushr	r0			; save error code flags
	$setprv_s prvadr=exquota , -	; yes, please drop it.
		  enbflg=#0		; and then exit
	popr	r0			;
120$:	ret				; bye

200$:	movzwl	16(ap)	,r2		; get the internal lun to use
	movl	rablist[r2],r3		; get the rab for this file
	movw	8(ap)	,rab$w_rsz(r3)	; set the record size in place
	movl	4(ap)	,rab$l_rbf(r3)	; and the user's buffer address
	movl	12(ap)	,rab$l_bkt(r3)	; block number
	$write	rab=r3			; write the next record now
	pushr	r0
	$wait	rab=r3
	popr	r0
	blbc	r0	,210$		; error exit
	movzbl	#1	,r0		; success
	brb	220$			; exit
210$:	movl	r0	,tedsyserror
	clrl	r0
220$:	rsb				; exit




	.sbttl	cut/paste i/o routines


;+	REACBU(bufferaddress,vbn)	Read a cutpaste buffer in
;
;	Read a block from the cut/paste buffer

	.entry	reacbuffer		,^M<r2,r3,r4>

	jsb	crecut			; insure the correct file is open
	tstl	r0			; did it work ?
	beql	100$			; no
	movzwl	12(ap)	,r0		; yes, map into internal routines
	pushl	cutmap[r0]		; map the buffer # into channel
	pushl	8(ap)			; the vbn to do
	pushl	#512.			; the size of the read
	pushl	4(ap)			; the buffer address
	calls	#4	,ted$get_block	; and do it
100$:	ret				; bye



;+	WRICBU(bufferaddress,vbn)
;
;	Write a block from the cut/paste buffer

	.entry	wricbuffer		,^M<r2,r3,r4>

	jsb	crecut			; insure the correct file is open
	tstl	r0			; did it work ?
	beql	100$			; no
	movzwl	12(ap)	,r0		; yes, map into internal routines
	pushl	cutmap[r0]		; map the buffer # into channel
	pushl	8(ap)			; the vbn to do
	pushl	#512.			; the size of the write
	pushl	4(ap)			; the buffer address
	calls	#4	,ted$put_block	; and do it
100$:	ret				; bye



crecut:	movzbl	#1	,r0		; assume success
	movl	12(ap)	,r2		; get the paste buffer to use
	movl	cutmap[r2],r3		; map the cut/paste buffer number
	beql	110$			; to an internal channel
	tstl	cutopen[r2]		; is the cut buffer open yet?
	bneq	120$			; file is already open
	movl	fablist[r3],r4
	$create	fab=r4			; create the work file for screen editor
	blbc	r0	,100$		; it failed, exit then
	movl	rablist[r3],r4
	$connect	rab=r4		; get the access stream set up
100$:	movl	r0	,tedsyserror	; save it
	blbc	r0	,110$		; failure, return with r0 = zero
	movl	#1	,cutopen[r2]	; success, flag as being open now
	clrl	tedsyserror		; success, clear saved error flag
	movzbl	#1	,r0		; return(1)
	brb	120$			; and exit
110$:	pushl	tedsyserror
	calls	#1	,print_error
	clrl	r0			; error return with status = 0
120$:	rsb				; bye


	.sbttl	create and close work files

;+	CRETMP()

	.entry	cretmp		,^M<>


	pushab	temp$devname		; try a logical name for size
	calls	#1	,G^strlen	; get the string length
	movab	temp$devname,fab_work+fab$l_fna
	movb	r0	,fab_work+fab$b_fns
	$create	fab=fab_work		; create the main work file
	blbs	r0	,10$		; it worked

	pushab	temp$name		; try a logical name for size
	calls	#1	,G^strlen	; get the string length
	movab	temp$name,fab_work+fab$l_fna
	movb	r0	,fab_work+fab$b_fns
	$create	fab=fab_work		; create the main work file
	blbc	r0	,110$		; it failed, exit then

10$:	$connect	rab=rab_work	; get the access stream set up
	blbc	r0	,110$		; it failed, exit then
	$create	fab=fab_scwork		; create the main work file
	blbc	r0	,110$		; it failed, exit then
	$connect	rab=rab_scwork	; get the access stream set up
	blbc	r0	,110$		; it failed, exit then
	clrl	tedsyserror		; success, clear saved error flag
	movzbl	#1	,r0		; return(1)
	brb	120$			; and exit
110$:	movl	r0	,tedsyserror
	clrl	r0			; error return with status = 0
120$:	ret				; bye



;+	CLOTMP()


	.entry	clotmp		,^M<r2,r3,r4>

	$disconnect	rab=rab_work	; remove the access now
	$close	fab=fab_work		; and close the file.
	$disconnect	rab=rab_scwork	; remove the access now
	$close	fab=fab_scwork		; and close the file.
	clrl	r2
10$:	movl	cutmap[r2],r3
	beql	100$
	tstl	cutopen[r2]
	beql	20$
	movl	rablist[r3],r4
	$disconnect	rab=r4
	movl	fablist[r3],r4
	$close		fab=r4
20$:	incl	r2
	brb	10$
100$:	ret



;	TED$CLOSE
;
;	input:	4(ap)	internal lun to use
;	output:	r0	rms sts


	.entry	ted$close	,^M<r2,r3>	; close a file


	movzwl	4(ap)	,r2		; get the internal lun
	movl	rablist[r2],r3		; get the rab for this file
	$disconnect rab=r3		; disconnect the access stream
	movl	fablist[r2],r3		; get the fab so we can close it
	$close	fab=r3			; simple
	ret				; bye



;	ted$CREATE
;
;	input:	4(ap)	filename address, .asciz
;		8(sp)	internal channel number
;	output:	r0	0 for error, else 1



	.entry	ted$create	,^M<r2,r3,r4,r5,r6,r7>


	movzwl	8(ap)	,r2		; get the internal channel number
	movl	fablist[r2],r3		; get the address of the fab
	movb	#fab$m_put,fab$b_fac(r3); insure put access allowed
	movb	#fab$c_seq,fab$b_org(r3); insure sequential files
	movb	#fab$m_cr ,fab$b_rat(r3); implied carriage control
	movb	#fab$c_var,fab$b_rfm(r3); variable length records
	movl	4(ap)	,r4		; get the filename address
	movl	r4	,fab$l_fna(r3)	; and insert the filename address
	clrl	r5			; counter for number of characters
10$:	tstb	(r4)+			; look for the null terminator
	beql	20$			; found the null
	incl	r5			; did not find the null yet
	brb	10$			; next please
20$:	movb	r5	,fab$b_fns(r3)	; insert the filename size now
	clrw	fab$w_ifi(r3)		; insure that internal fid is 0
	clrb	fab$b_rtv(r3)		; let the number of windows default
	cmpw	8(ap)	,#chan_output	; is this an output file?
	bneq	30$			; no
	movb	#255	,fab$b_rtv(r3)	; yes, map the entire thing if so
30$:	$create	fab=r3			; open the file up for reading now
	movl	fab$l_stv(r3),r4	; save the acp error code please
	blbc	r0	,100$		; oops, better exit then
	movl	rablist[r2],r3		; get the rab address now
	$connect rab=r3			; and connect to a record address stream
	blbs	r0	,110$		; no errors
	movl	rab$l_stv(r3),r4	; save the acp error code please
100$:	movl	r0	,tedsyserror	; error
	movl	r4	,acpsyserror	; save acp error if any
	cmpl	r0	,#RMS$_CRE	; acp create fail ?
	bneq	105$			; no
	movl	r4	,tedsyserror	; yes, use the system error code
105$:	clrl	r0			; return(0)
	brb	120$			; bye
110$:	movzbl	#1	,r0		; success, return(1)
	clrl	tedsyserror
120$:	ret				; bye



	.sbttl	get the next record




;	GETRECORD
;
;	input:	4(ap)	byte record buffer address
;		8(ap)	maximum record size allowed
;		12(ap)	internal lun
;	output:	r0	rms sts
;		r1	record length


	.entry	ted$getrecord	,^M<r2>

	movzwl	12(ap)	,r2		; get the internal lun to use
	cmpb	r2	,#chan_terminal	; the terminal?
	bneq	20$			; no
	tstl	tty_lun			; did we ever assign the terminal
	bneq	10$			; yes
	calls	#0	,open$tty	; no, open it please
10$:	pushl	8(ap)			; yes, use a qio to do it please
	pushl	4(ap)			; the buffer address is next
	pushl	tty_lun			; and that also please
	calls	#3	,ted$ttread	; and get from the terminal
	brb	100$			; exit with r0=status,r1=bytecount
20$:	movl	rablist[r2],r2		; get the rab for this file
	movw	8(ap)	,rab$w_usz(r2)	; set the max record size in place
	movl	4(ap)	,rab$l_ubf(r2)	; and the user's buffer address
	$get	rab=r2			; read the next record now
	clrl	r1			; presume error, set size eq 0
	movl	r0	,tedsyserror	; save the error code
	cmpl	r0	,#RMS$_RTB	; rtb errors are warnings only
	beqlu	25$			; ok
	blbc	r0	,100$		; error, exit please
25$:	clrl	tedsyserror		; save the error code
	movzwl	rab$w_rsz(r2),r1	; it worked, get the amount read
	addl3	4(ap),r1,r2		; point to the end of the user's buffer
	tstl	r1			; a blank line (ie, only <cr><lf>) ?
	beql	30$			; yes, insert CRLF
	cmpb	-1(r2)	,#FF		; a form feed?
	beql	40$			; yes, leave things as they stand
	cmpb	-1(r2)	,#LF		; stream file and a line feed in it? (?)
	beql	40$			; yes
30$:	movb	#CR	,(r2)+		; need a crlf then
	movb	#LF	,(r2)+		; simple to do
	addl2	#2	,r1		; line is two characters longer now
40$:
100$:	ret				; exit

	

;	PUTRECORD
;
;	input:	4(ap)	byte record buffer address
;		8(ap)	size of record to write
;		12(ap)	internal lun
;	output:	r0	rms rst


	.entry	ted$putrecord	,^M<r2,r3>

	movzwl	12(ap)	,r2		; get the internal lun to use
	cmpb	r2	,#chan_terminal	; the terminal?
	bneq	20$			; no
	tstl	tty_lun			; did we ever assign the terminal
	bneq	10$			; yes
	calls	#0	,open$tty	; no, open it please
10$:	print	4(ap)	,8(ap)		; and dump to the terminal
	brb	100$			; and exit
20$:	jsb	200$			; try the write out for size
	movl	r0	,tedsyserror	; save the error please
	blbs	r0	,90$		; success
	cmpl	r0	,#RMS$_EXT	; acp extend failure ?
	bneq	100$			; no, simply exit then
	jsb	200$			; extend failure, retry the operation
	movl	r0	,tedsyserror	; save the error, if any
	blbc	r0	,90$		; error, exit
90$:	clrl	tedsyserror		; no errors, clear saved error code
100$:	ret				; and exit


200$:	movl	rablist[r2],r3		; get the rab for this file
	movw	8(ap)	,rab$w_rsz(r3)	; set the record size in place
	movl	4(ap)	,rab$l_rbf(r3)	; and the user's buffer address
	$put	rab=r3			; write the next record now
	rsb				; exit




	.sbttl	internal open for OPENFI and OPNHLP


;	TED$OPEN
;
;	input:	4(ap)	filename address, .asciz
;		8(sp)	internal channel number
;	output:	r0	rms error code



	.entry	ted$open	,^M<r2,r3,r4,r5,r6,r7>


	movzwl	8(ap)	,r2		; get the internal channel number
	movl	fablist[r2],r3		; get the address of the fab
	movl	4(ap)	,r4		; address of the filename here
	movl	r4	,fab$l_fna(r3)	; and insert the filename address
	clrl	r5			; counter for number of characters
10$:	tstb	(r4)+			; look for the null terminator
	beql	20$			; found the null
	incl	r5			; did not find the null yet
	brb	10$			; next please
20$:	movb	r5	,fab$b_fns(r3)	; insert the filename size now
	clrw	fab$w_ifi(r3)		; insure that internal fid is 0
	clrb	fab$b_rtv(r3)		; let window count default
	cmpw	8(ap)	,#chan_input	; but if this is an input file tell
	bneq	30$			; rms to try to map the entire file
	movb	#255	,fab$b_rtv(r3)	; if it can
30$:	$open	fab=r3			; open the file up for reading now
	blbc	r0	,100$		; oops, better exit then
	movl	rablist[r2],r4		; get the rab address now
	$connect rab=r4			; and connect to a record address stream
100$:	blbs	r0	,110$		; no errors
	movl	r0	,tedsyserror	; error
	clrl	r0			; return(0)
	brb	120$			; bye
110$:	movzbl	#1	,r0		; success, return(1)
	movl	fab$l_alq(r3),filesize	; save the file size please
	clrl	tedsyserror
120$:	ret				; bye


	.entry	saveprotection		,^M<>

	movw	L^in_proxab+xab$w_pro,L^in_filepro+xab$w_pro
	movl	in_proxab+xab$l_uic,in_filepro+xab$l_uic
	ret


	.entry	setprotection		,^M<>

	movw	L^in_filepro+xab$w_pro,L^out_proxab+xab$w_pro
	clrl	out_proxab+xab$l_uic
	$getjpiw_s itmlst=curpriv
	bitl	#1@PRV$V_SYSPRV,@<curpriv+4>
	beqlu	100$
	movl	in_filepro+xab$l_uic,out_proxab+xab$l_uic
100$:	ret

	.entry	setmbc			,^M<>
	ret

	.entry	clrmbc			,^M<>
	ret



	.sbttl	initialize the terminal
	.psect	code

	.entry	checkterminal		,^M<>

;+	CHECKTERMINAL
;
;	Return 1 if SYS$OUTPUT is a terminal or mailbox
;	Return 0 if it is not
;-

	devmask = <1@DEV$V_TRM> ! <1@DEV$V_MBX>
	
	$getdvi_s itmlst= getdevtyp , -
		  efn	= #20 , -
		  devnam= tty_dev
	blbc	r0	,90$
	$waitfr_s efn	= #20
	movzbl	#1	,r0
	bitl	#devmask,devchar
	bnequ	100$
90$:	clrl	r0
100$:	ret	


;	O P E N $ T T Y
;
;	input:	nothing
;	output:	r0	system service status
;		r1	channel number assigned by sys$assign


	.entry	open$tty,		^m<r2,r3,r4>

	movab	tty_dev,r1		; get the sys$command assigned
	jsb	200$			; first. save the returned LUN
	blbc	r0	,100$		; and then get a channel for
	movl	r1	,tty_lun	; sys$output next.
	movab	tty_outdev,r1		; setup for translation of
	jsb	200$			; sys$output to the physical
	blbc	r0	,100$		; equivalent.
	movl	r1	,tty_outlun	; save and exit
100$:	ret


200$:	subl	#80.	,sp		; allocate a buffer for translated
	movl	sp	,r2		; logical name. use r2 as pointer
	movl	#63	,(r2)		; create a empty .ascid string
	movl	r2	,4(r2)		; and the address of the string
	addl	#8	,4(r2)		; skip over the length and type
	$trnlog_s lognam=(r1),-		; get sys$command tranlated first
		  rslbuf=(r2)		; pointer to result name buffer
	blbc	r0	,210$		; it failed
	clrl	-(sp)			; must pass address for channel #
	movl	sp	,r1		; use r1 to point to it
	$assign_s chan  =(r1),-		; get vms to allocate a channel
		  devnam=(r2)
	movl	(sp)+	,r1		; return channel number in r1
	blbc	r0	,210$
	movl	#ss$_normal,r0
210$:	addl	#80.	,sp
	rsb				; bye



	.sbttl	print ascii or .ascid string out to terminal

;	T Y P E $ A S C I I
;
;	Print either an ascii string with length passed or type
;	an .ascid standard descripter
;
;
;	input:	4(ap)	if eq -1, assume .ascid
;			if eq  0, assume .asciz
;			if eq  1, assume .ascii
;
;		@8(ap)	addres of string or string descriptor
;		12(ap)	length if not .ascid


	.entry	type_ascii,^m<r2,r3>	; print a string at 4(ap), len 8(ap)

	tstl	4(ap)			; if < 0 then assume .ascid
	bgtr	20$			; if > 0 assume passed length and addr
	blss	10$			; if = 0 assume .asciz

	movl	8(ap)	,r2		; assume .asciz  get address of string
	clrl	r3			; use r3 as a counter for length
5$:	tstb	(r2)+			; hit the end of the string yet?
	beql	6$			; yes
	incl	r3			; no, increment the length and test
	brb	5$			; again please
6$:	$qiow_s	func=#io$_writevblk,-
		chan=tty_outlun,-
		p1=@8(ap),-
		p2=r3
	brw	100$

10$:	movl	8(ap)	,r2		; get address of string descriptor
	movzwl	(r2)	,r3
	$qiow_s	func=#io$_writevblk,-
		chan=tty_outlun,-
		p1=@4(r2),-
		p2=r3
	brw	100$

20$:	$qiow_S	func=#io$_writevblk,-	; write virtual block to terminal
		chan=tty_outlun,-	; channel from $assign
		p1=@8(ap),-		; address of string to print
		p2=12(ap)		; length of the string to print
100$:	movl	#SS$_NORMAL,r0		; return success
	ret				; bye




;	T T W R I T E
;
;	write a line to the terminal
;
;	input:	4(ap)	string address
;		8(ap)	string length
;
;	output:	r0	system service completion code


	.entry	ted$ttwrite	,^m<>

	pushl	8(ap)			; stuff string length and
	pushl	4(ap)			; string address
	pushl	#1			; flag to type_ascii for passed length
	calls	#3,type_ascii
	ret





	.sbttl	cancel control O


;+
;	RESUMEOUTPUT()
;
;	Passed:	nothing
;	Return:	nothing
;-

	.entry	resumeoutput		,^M<>

	clrl	-(sp)
	movl	sp	,r1
	$qiow_s	func=#<io$_writevblk!io$m_canctrlo>,-
		chan=tty_outlun,-
		p1=(r1),-
		p2=#0
	tstl	(sp)+
	ret






	.sbttl	read from the terminal


;	T T R E A D
;
;
;	read a line from the terminal
;
;	input:	4(ap)	channel number
;		8(ap)	buffer address
;		12(ap)	buffer size (defaults to 132)
;
;	output:	8(ap)	the line just read
;		r0	completion status
;		r1	size of the read


	.entry	ted$ttread	,^m<r2,r3,r4>

	subl	#10	,sp		; allocate a iostatus block
	movl	sp	,r4		; and use r4 to point to it
	movl	#132.	,r3		; assume 132 character read
	cmpb	(ap)	,#2		; ommitted the buffer length?
	beql	10$			; yes
	movzwl	12(ap)	,r3		; no, use that which was passed

10$:	$qiow_s	chan = 4(ap),-		; do the read
		func = #io$_readvblk,-
		efn  = #3,-
		iosb = (r4),-		; pusha is wierd
		p1   = @8(ap),-		; buffer address
		p2   = r3,-		; max buffer size
		p4   = #200$		; allowed terminators
	clrl	r1			; clear returned length
	blbc	r0	,100$		; error if (r0 and 1) = 0
	movzwl	2(r4)	,r1		; return the length of the read
	addl3	r1,8(ap),r2		; point to the end of the buffer
	cmpb	4(r4)	,#CTRLZ		; control z typed today?
	bneq	20$			; no
	clrl	r0			; yes, return an error then
	brb	100$			; simple to do
20$:	movb	4(r4)	,(r2)		; not control Z, copy the terminator
	cmpb	(r2)+	,#FF		; a form feed today?
	beql	30$			; yes
	movb	#LF	,(r2)		; no, must be a carriage return then
	incl	r1			; count it
30$:	incl	r1			; count the previous character also
100$:	addl2	#10	,sp		; remove the iosb from the stack
	ret

200$:	.long	0
	.long	^b100000000000011010000000000	; allow <cr><lf> and <ff>


	.sbttl	read binary (passall)


;	T E D $ B I N R E A D
;
;	input:	4(ap)	channel number for terminal
;	output:	r0	system service code
;		r1	one character just read

	binmode = io$_readvblk + io$m_noecho + io$m_nofiltr

	.entry	ted$binread	,^M<r2,r3>


	subl	#10	,sp		; allocate a iostatus block
	movl	sp	,r3		; and use r4 to point to it
	clrl	-(sp)			; allocate a character buffer
	movl	sp	,r2		; and point to it
	$qiow_s	chan = 4(ap),-		; do the read
		func = #binmode,-	; io$_readpassall reads ^C and ^Y
		iosb = (r3),-		; pusha is wierd
		p1   = (r2),-		; buffer address
		p2   = #1,-		; max buffer size
		p4   = #200$
	movl	(sp)+	,r1		; get the character now
	addl	#10	,sp		; remove the iosb from the stack
	ret


200$:	.long	16			; terminator block. allow all
	.address 210$			; but control C to be one since
					; we would like to be able to get
210$:	.byte	^b11110111		; control C ast's
	.rept	15
	.byte	^b11111111
	.endr



	.entry	ted$typeahead		,^M<r2>


	clrq	-(sp)			; clear a 4 word buffer
	movl	sp	,r2		; save the address
	$qiow_s	chan = 4(ap),-		; do the read
		func = #<io$_sensemode!io$m_typeahdcnt>, -
		p1   = (r2),-		; buffer address
		p2   = #8		; max buffer size
	blbc	r0	,100$		; failure, exit please
	tstw	(r2)			; anything in the typeahead buffers?
	beql	100$			; no
	movzbl	#1	,r0		; yes, return success and exit
	brb	110$			; bye
100$:	clrl	r0			; failure or nothing waiting to be read
110$:	addl2	#8	,sp		; exit please
	ret



	.entry	print_crlf	,^M<>

	pushl	#2
	pushal	200$
	pushl	#1
	calls	#3	,type_ascii
	ret

200$:	.byte	13,10



	.sbttl	error text

	.mcall	$getmsg_s


	.entry	geterror	,^M<>	; get error text from last error

	pushl	4(ap)			; push the buffer address
	pushl	tedsyserror		; push the error number
	calls	#2	,sys_error	; and get the error text
	ret				; bye


;	SYS_ERROR
;
;	input:	4(ap)	the message id value
;		8(ap)	address of byte buffer for returned text
;	output:	r0	error code
;		r1	text length (text is also .asciz)


	.entry	sys_error	,^M<r2,r3,r4>


	movl	8(ap)	,r4		; point to the buffer address
	movl	r4	,-(sp)		; allocate a string descriptor
	movl	#79.	,-(sp)		; 80 bytes
	movl	sp	,r2		; point to it
	clrl	-(sp)			; where to return the text length
	movl	sp	,r3		; point to it
	$getmsg_s	msgid=4(ap),msglen=(r3),bufadr=(r2),flags=#15
	blbs	r0	,100$
	clrl	r1			; failure
	clrb	(r4)			; clear first byte out
	brb	110$			; exit
100$:	movzwl	(r3)	,r1		; the length
	addl	r1	,r4		; point to the last character
	clrb	(r4)			; also make this .asciz
110$:	addl	#12	,sp		; pop the stack and exit
	ret


	.entry	print_error	,^M<r2>

	subl	#80	,sp		; allocate a buffer from the stack
	movl	sp	,r2		; and a pointer to it please
	pushl	r2			; push the address of the buffer
	pushl	4(ap)			; and the value of the error code
	calls	#2	,sys_error	; get the error text
	pushl	r1			; now get set to print it out
	pushl	r2			; push the length and address
	pushl	#1			; and type flag
	calls	#3	,type_ascii	; do it
	addl	#80	,sp		; restore stack to it's former state
	ret				; and exit
	





	.psect	spdata	,noexe,noshr,rel,rd,wrt,long


sp_flags:	.long	1		; no waiting for the spawned process
mb_done:	.long	0		; set when spawn completion ast comes
mb_phyname:	.long	63		; to translate the mailbox logical
		.address	10$	; to the real device name, needed for
10$:		.blkb	64		; lib$spawn
mb_logname:	.ascid	/TED_MAILBOX/	; the logical name for the mailbox
mb_size	=	256			; size in bytes of the mailbox buffer
mb_buffer:	.blkb	mb_size		; the buffer for the mailbox
		.align	long		; for safety

mb_lun:		.word	0		; save the lun returned by crembx
mb_iosb:	.word	0,0,0,0		; i/o status block for the mailbox

	mb_efn	=	2		; for the mailbox reads
	wf_efn	=	3		; for the waitfor efn call
	wf_mask	=	^B0100		; the bitmask for waitfor


	.psect	code



;+	DOMBX(commandline,filename)
;
;	Spawn a subproccess.
;
;	If commandline is null, assume input will be from SYS$INPUT
;	Output will be placed into 'FILENAME', which will be opened
;	by the normal TED i/o system.
;
;	Passed:	4(ap)	Address of a command line, .asciz
;		8(ap)	Address of a filename to create and write to
;-	Return:	R0	zero for failure, else 1 for success


	.entry	dombx			,^M<r2,r3,r4,r5,r6,r7>

	pushl	#chan_output		; internal lun for writing
	pushl	8(ap)			; the .asciz filename to do
	calls	#2	,ted$create	; create the file please
	tstl	r0			; did this work ok?
	beql	110$			; no, exit
	jsb	create_mb		; get the mailbox created
	blbc	r0	,90$		; oops
	jsb	spawn			; spawn the process please
	blbc	r0	,90$		; check for success
	clrl	mb_done			; we are not done yet

50$:	tstl	mb_done			; did we get a completion ast?
	bneq	100$			; yes, exit please
	jsb	read_mb			; post a read for the mailbox
	blbc	r0	,90$		; exit if it fails
	$wflor_s -			; now wait for the mailbox to
		efn 	= #wf_efn ,-	; get some data from the spawned
		mask 	= #wf_mask	; process
	tstl	mb_done			; done yet ?
	bneq	100$			; yes
	jsb	read_mbfin		; no, post processing for the read
	blbs	r0	,50$		; it worked ok

90$:	movl	r0	,r2		; save the error code
	pushl	#chan_output		; close the file on error please
	calls	#1	,ted$close	; simple
	movl	r2	,tedsyserror	; save the error code
	clrl	r0			; exit with failure
	brb	110$			;
100$:	pushl	#chan_output		; close the file on successful end
	calls	#1	,ted$close	; exit
	movzbl	#1	,r0		; exit with success
110$:	ret				; bye

 


	.entry	exit_mb			,^M<r2,r3,r4,r5>

	$setef_s	efn = #mb_efn
	movl	#1	,mb_done
	ret

spawn:	subl2	#10	,sp		; space to create string descr
	movl	4(ap)	,r1		; get the command line to do
	tstb	(r1)			; anything to do ?
	bnequ	10$			; yes
	clrl	r1			; no, pass zero to lib$spawn
	brb	40$			;

10$:	movl	sp	,r1		; yes, so create string descripter
	movl	4(ap)	,r2		; first, count the string length
	clrl	r0			; count the length here
20$:	tstb	(r2)+			; loop until we find the end of it
	beqlu	30$			; did we get the end?
	incl	r0			; no, count the length some more
	brb	20$			; next please
30$:	movl	r0	,(r1)		; stuff the length
	movl	4(ap)	,4(r1)		; and the string address

40$:	pushal	exit_mb			; here when the subproccess exits
	pushl	#0			; completeion efn value
	pushl	#0			; completion status
	pushl	#0			; pid of the created process
	pushl	#0			; no process name passed
	pushal	sp_flags		; no wait
	pushal	mb_phyname		; the mailbox name
	pushl	#0			; sys$input please
	pushl	r1			; either zero or a nonnull command
	calls	#9	,G^lib$spawn	; and spawn the subprocess
	addl2	#10	,sp		; pop
	rsb


	.sbttl	post a qio to mailbox, finish after completion

read_mb:
	$qio_s	efn	= #mb_efn, -	; post a qio to the mailbox
		func	= #io$_readvblk,-
		chan	= mb_lun, -	; we will post one for the
		iosb	= mb_iosb, -	; terminal also and then wait
		p1	= mb_buffer, -	; for the logical or of the
		p2	= #mb_size	; event flags.
	rsb


read_mbfin:
	movaw	mb_iosb	,r4		; i/o status block address
	movzwl	2(r4)	,r1		; return the length of the read
	movl	r1	,r2		; save the actual length please
	movab	mb_buffer,r3		; the buffer address also please
	addl2	r1	,r3		; point to the end of the buffer
	cmpb	4(r4)	,#CTRLZ		; control z typed today?
	bneq	10$			; no
	clrl	r0			; yes, return an error then
	brb	40$			; simple to do
10$:	cmpb	4(r4)	,#FF		; was there a form feed terminator
	bneq	20$			; no
	movb	4(r4)	,(r3)		; yes, return it by itself and exit
	brb	30$			; and fix the byte count also
20$:	movb	#CR	,(r3)+		; otherwise insert a CRLF pair
	movb	#LF	,(r3)		; no, must be a carriage return then
	incl	r1			; count it
30$:	incl	r1			; count the previous character also
40$:	pushl	r1			; write the data to sys$output
	pushab	mb_buffer		; the buffer for the mailbox
	calls	#2	,ted$ttwrite	; and dump it to sys$output
	pushl	#chan_output		; internal lun for writing
	pushl	r2			; the actual byte count
	pushab	mb_buffer		; and the mailbox buffer address
	calls	#3	,ted$putrecord	; write the record out please
	rsb



	.sbttl	create mailbox

create_mb:
	$crembx_S -			; create the mailbox for the
		prmflg	= #0, -		; the spawned process. It should
		chan	= mb_lun, -	; be temporary of course.
		maxmsg	= #mb_size, -	; max we can read at once
		lognam  = mb_logname	; the name to use for it
	$trnlog_s lognam= mb_logname,-	; get sys$output tranlated first
		  rslbuf= mb_phyname	; pointer to result name buffer
	rsb



	.sbttl	declare ast for typeahead during screen refresh


;	DCLINPAST(address(ast_flag)
;
;	 This routine will be called before the editor puts up a new
;	page in response to a newpage command.  If anything is typed
;	during the screen update,  the ast routine will take a  look
;	at what was typed, and if it was an escape character it will
;	flag it by making the location passed to DCLINPAST non zero.
;	Thus the page update code can then exit and GETBIN will  get
;	the escape character the ast routine read.
;	 Actually, the way the code now functions is at the time  of
;	the ast,  the ast routine checks for the amout of typeahead.
;	If there are two characters waiting  after we find the first
;	one to  be an escape,  we will assume that a function/pf key
;	has been typed and then read the two characters. If the last
;	character is a 'Q' then we have a PF2 key, thus set the flag
;	and exit.  In any case,  any characters read here will be in
;	the 'PREVCHAR' buffer for GETBIN to extract.
;	 The proper method to handle this would be to call a routine
;	in the editor's command dispatched (SCCMD) to determine in a
;	terminal/keypad definition independent way if the escape seq
;	was a NEXTPAGE command. Later....

	.entry	dclinpast		,^M<>

	movl	4(ap)	,astflag	; get the address to set the flag at
	$qio_s	chan = tty_lun , -	; post an asynch single character read
		func = #binmode , -	; ala io$m_noecho + io$m_nofiltr
		astadr = ted_read_ast,-	; set the ast entry point
		efn = #10 , -		; must use an unique event flag here
		p1 = ted_ast_buffer , -	; the read buffer
		p2 = #1			; and the buffer size
	blbs	r0	,100$		; if error then die
	clrl	r0			; error
	clrl	astflag			; internal flag also please
	ret
100$:	movzbl	#1	,r0		; success flag
	ret


	.entry	ted_read_ast		,^M<r2,r3,r4,r5>

	clrq	-(sp)			; allocate buffer for io$m_typeahdcnt
	movab	ted_ast_buffer,r5	; get the ast entry point buffer
	tstl	astflag			; ensure we are primed for the ast
	bnequ	10$			; we are not, ignore this ast then
	brw	100$			; too far for byte branch
10$:	movaw	prevchar,r3		; get address of buffer control info
	movab	prevchar+4,r4		; get address of actual char buffer.
	movzwl	(r3)	,r0		; get the current character count
	addl2	r0	,r4		; and point to the next free spot
	movb	(r5)	,(r4)+		; stuff the character read away now
	incw	(r3)			; correct for character count
	cmpb	(r5)	,#27		; Was the character read an escape?
	bnequ	100$			; If not, just exit with char stored.
	tstl	astaction		; go ahead on any esc sequence ?
	bnequ	90$			; yes
	movl	sp	,r2		; save the address
	
	$qiow_s	chan = tty_lun ,-	; do the read
		func = #<io$_sensemode!io$m_typeahdcnt>, -
		efn  = #10 , -		; must use own event flag please
		p1   = (r2),-		; buffer address
		p2   = #8		; max buffer size
	blbc	r0	,100$		; nothing in typeahead, exit
	cmpw	(r2)	,#3		; we must have at least 3 characters
	blss	100$			; no, just exit then please
	$qiow_s	chan = tty_lun  , -	; something is there, get the next
		func = #binmode , -	; character from vms typeahead buffer
		efn  = #10	, -	; must use unique event flag
		p1   = (r5)	, -	; the buffer address
		p2   = #2		; must try for 2 characters this time
	blbc	r0	,100$		; it failed
	movb	(r5)+	,(r4)+		; copy the character
	movb	(r5)	,(r4)+		; likewise, the next one also
	addw2	#2	,(r3)		; fix the byte count and exit
	cmpb	(r5)	,#^A/5/		; VT220 next or prev page ?
	beql	90$			; yes
	cmpb	(r5)	,#^A/6/		; VT220 next or prev page ?
	beql	90$			; yes
	cmpb	(r5)	,#BIGQ		; If the third member of the esc seq
	bneq	100$			; was a Q (ie, $OQ) then we have a PF2
90$:	movzbl	#1	,@astflag	; We have it, flag for a newpage AST.
100$:	clrb	ted_ast_buffer		; clear out the ast buffer now
	addl2	#8	,sp		; pop the stack
	ret				; generate the ast


	.entry	clrinpast		,^M<>

	clrb	ted_ast_buffer		; clear out the ast buffer now
	tstl	astflag			; did we ever set the ast up ?
	beql	100$			; no
	clrl	astflag			; yes, it's off now
	$cancel_s chan = tty_lun	; cancel it
100$:	ret				; and exit






	.entry	xprintf			,^M<r2,r3,r4>
	movzbl	(ap)	,r2
	movzbl	(ap)	,r3
	beql	20$
	mull3	#4,r3	,r4
	addl3	ap,#4	,r1
	addl2	r4	,r1
10$:	pushl	-(r1)
	sobgtr	r2	,10$
20$:	calls	r3	,G^printf
	ret

	.entry	sxprintf		,^M<r2,r3,r4>
	movzbl	(ap)	,r2
	movzbl	(ap)	,r3
	beql	20$
	mull3	#4,r3	,r4
	addl3	ap,#4	,r1
	addl2	r4	,r1
10$:	pushl	-(r1)
	sobgtr	r2	,10$
20$:	calls	r3	,G^sprintf
	ret

	.end
