.title	CLE	A simple command line editor, RSTS/E 9.x
	.ident	/9.5.01/

;	Terry Kennedy  03-Oct-87  01:35:18
;
;	Last edit: 03-Oct-87  20:12:43
;
;	 Modifications at SPC -  Monitor for a SWITCH  command also,
;	change prompt (cosmetic), ensure CRT is in VT1xx mode rather
;	than VT52 mode, add ^X mapping as ^U, drop insert  mode upon
;	RETURN keypress, enable running without INSTAL priv, correct
;	problem W/ extra CR/LF before prompt caused by VT52 mode fix
;	above, re-enable ICFP detection, support VT3xx family CRT's,
;	show terminal type code in 'only runs on' message.
;
;	Brian Nelson  24-Jul-86  09:29:26
;
;	Last edit: 08-Aug-86  11:30:28
;
;	 This  is a simple command line editor for RSTS/E 9.x. It  is
;	a  run  time  system  that  one  sets to be the current  (NOT
;	system)  default  RTS.  It  reads   commands  in  ODT   mode,
;	allowing  for  editing  with  the  normal arrow keys, rubout,
;	control B, E, H and X keys.  It stores up to 20  commands  in
;	a buffer allocated in a private 1KW dynamic region. Currently
;	the maximum line length is 80 characters.  Continuation lines
;	are not supported.  It will  ONLY  function on RSTS/E  9.2 or
;	later.
;
;	WARNING
;
;	 This RTS runs in privileged mode and must be installed <232>
;	in _SY0:[0,1]CLE.RTS in order to function properly. It's run-
;	time system must also be set to CLE. It is assumed that after
;	calling DCL, DCL will immediately drop privileges. If that is
;	not the case, there is potential for a serious security viol-
;	ation. Note that DCL's behavior is specified in RSTS/E system
;	architecture, so this should not be a problem. 
;
;	Restrictions:
;
;	 Since the dynamic region is created to be permanent,  this RTS
;	tries to intercept the LOG command so it can delete the region.
;	In other words,  if jobs are killed that have created  a region
;	the region will not  go away  until you  manually remove it via
;	the REM/LIB command. The RTS also intercepts the SWITCH command
;	when given without any arguments. I [tmk] suggest you apply the
;	patch to LOGOUT which causes the CLE region to be removed after
;	logging out.
;
;	 This RTS only works correctly on 9.2 or later due to modifica-
;	tions to the Job Data Block (specifically the offset of JDFLG3)
;
;	 The code  below is the  patch to LOGOUT.BAS to  remove the CLE
;	region at logout time. This solves all of the problems mention-
;	ed above regarding region deletion.
;
;	9035	ON ERROR GOTO 9040 &
;		\ A$="CLEJ"+RIGHT(NUM1$(JOB%+100%),2%) &
;		\ A$=MID(SYS(CHR$(6%)+CHR$(-10%)+A$),7%,4%) &
;		\ A$=SYS(CHR$(6%)+CHR$(-18%)+CHR$(20%)+STRING$(3%,0%)+A$) &
;		\ ON ERROR GOTO 19000 &
;		! CONSTRUCT CLE LIBRARY NAME FROM JOB NUMBER, &
;		!  CONVERT TO RAD-50, AND REMOVE &
;

	$$SIMPLE	==	1	; Use a good encryption routine
					; (CLECRY.MAC) if == 0

;	For performance reasons, it is a good idea to add the command
;
;		$ LOAD/OVER TER
;
;	to SY:[0,1]START.COM
;
;
;	Please see the comments prefixing the entry point CHKBYE for
;	security issues.

	.include	/SY:[1,2]COMMON.MAC/

	.iif ndf, JDFLG3, JDFLG3 = 34

	.title	CLE	A simple command line editor, RSTS/E 9.x

	.enabl	gbl

	.PSECT	 $RTQUE,RW,D,GBL,REL,OVR
	.PSECT	 $RWDAT,RW,D,GBL,REL,CON
	.PSECT	 $PDATA,RO,D,LCL,REL,CON
	.PSECT	 RWDATA,RW,D,LCL,REL,CON
	.PSECT	 CLECTX,RW,D,GBL,REL,CON

	.PSECT	DESCOD	,RO,I,LCL,REL,CON
	.PSECT	DESDAT	,RO,D,LCL,REL,CON
	.PSECT	$CODE	,RO,I,LCL,REL,CON

;	Files needed:
;	CLE.MAC			Runtime system
;	K11EDI.MAC		Editor from the authors Kermit-11
;	K11MAC.MAC		Include file from Kermit-11
;
;	$ ass sy: in
;	$ ccl macro in:cle=in:cle
;	$ ccl macro in:k11edi=in:k11edi
;	$ ccl link
;	in:cle/z,in:cle,in:cle=in:cle,in:k11edi/x/h:#177776/u:#4000
;	.99998
;	$ run $silus
;	in:cle.rts<232>,tt:=in:cle
;	$ rem/run cle
;	$ pip [0,1]cle.rts=in:cle.rts
;	$ set file [0,1]cle.rts/runtime_system=cle
;	$ ins/run [0,1]cle



	LF	=	12
	FF	=	14
	CR	=	15
	ESC	=	33
	RUB	=	177
	FIEXST	=	^D16
	ER$EOF	==	-1

	TTY	=	0
	VT100	=	1
	VT200	=	1




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

	.macro	ATOR50	addr
	mov	addr	,-(sp)
	call	ascrad
	.endm	ATOR50

	.macro	DECOUT	val
	mov	val	,-(sp)
	call	putdec
	.endm	DECOUT

	.macro	OCTOUT	val
	mov	val	,-(sp)
	call	putOCT
	.endm	OCTOUT

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


	.macro	STRCMP	s1,s2
	mov	s2	,-(sp)
	mov	s1	,-(sp)
	call	strcmp
	.endm	STRCMP

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

	.macro	STRLEN	addr
	mov	addr	,-(sp)
	call	STRLEN
	.endm	STRLEN
	
	.macro	PRINT	addr
	mov	addr	,-(sp)
	call	TTYOUT
	.endm	PRINT

	.macro	CLRXRB
	call	$CLRXRB
	.endm	CLRXRB

	.macro	CLRFQB
	call	$CLRFQB
	.endm	CLRFQB

	.save				; Save current psect context

	.ASECT
	.	=	140000
EDICMD::.BLKW	1
EDILEN::.BLKW	1
EDIPOS::.BLKW	1
EDIPPN::.BLKW	1
EDITIM::.BLKW	1
EDISTS::.BLKW	1
$ENCKE::.BLKB	62.
$DECKE::.BLKB	62.
$SKEY::	.BLKB	60
	EDIEND	==	.		; End of fixed data

	LN$CNT	==	20.		; Number of buffer
	LN$MAX	==	80.		; Max line length
	LN$SIZE	==	LN$MAX+4	; Allocation
	MAPSIZ	==	40		; Map 1KW (32*32 (10)) words

	.ASSUME	<LN$SIZE*LN$CNT> LT 3770; Insure we will fit in 1KW

	.psect	$RODATA	,RO,D,LCL,REL,CON

edikey::.byte	'S!200			; If using simple minded XOR
	.byte	'Z!200			; encryption. Otherwise build
	.byte	'1!200			; one at run time.
	.byte	'p!200
	.byte	'#!200
	.byte	'x!200
	.byte	'7!200
	.byte	'c!200
	.byte	'[!200
	.byte	'.!200
	.byte	'a!200
	.byte	':!200
	.byte	'k!200
	.byte	0
					; we will never get a NULL.
prm::	.asciz	/_$ /			; A prompt
nulprm:	.byte	0
	.blkb	10			; In case of patching?
	.even				; Please
lastcn::.word	LN$CNT			; Buffer count
edisiz::.word	LN$MAX			;
	$$BUFP	=	0		; Now generate command buffers
lastli::				; Start of buffer address table
	.rept	LN$CNT			; Generate the structure
	$BADDR	=EDIEND+<LN$SIZE*$$BUFP>; Compute the address
	.ASSUME	$BADDR	LT <143777-LN$SIZE>
	.word	$BADDR			; Insert the address
	$$BUFP	= $$BUFP+1		; Move up
	.endr				; Next please


	.asect				; Local R/W data. You can NOT
					; place data here that needs to be
	.	=	1000		; saved between commands.
stklim::.blkw	300			; A small stack
stack::	.blkw	1			; Top of it
buf::	.blkb	200			; A buffer for reading
tmpbuf:	.blkb	200
jobn:	.blkw	1			; Current job number
regid:	.blkw	1			; Region id for dynamic region
regnam:	.blkw	2			; Region name
func:	.blkw	1			; Debugging
vttype::.blkw	1			; Terminal type (0=Hcopy, 1=CRT)
exttyp:	.blkw	1			; 'Extended' terminal type (code)
curppn:	.blkw	1			; Current UIC
prmadr:	.blkw	1
	.restore

	.sbttl	Entry to the run time system

	.psect	$CODE	,ro,i,lcl,rel,con

...NEW::mov	#stack	,sp		; Insure sufficient stack space
	mov	#chain	,func		; Set up for possible error
	CLRFQB				; A nice clean FIRQB
	movb	#1	,FIRQB+FQPPN	; Execute [0,1] ...
	mov	#^RCLE	,FIRQB+FQNAM1	; ... CLE. ...
	mov	#^RRTS	,FIRQB+FQEXT	; ... RTS
	.CHAIN				; This should do the trick...
	jmp	..oops			; Print error and exit if failed

...RUN::mov	#stack	,sp		; Insure sufficient stack space
	call	init			; Start things up
10$:	call	leftm			; Insure cursor at left margin
	clr	@#edists		; Ensure insert mode is off to start
	mov	#buf	,-(sp)		; Read, edit and store a line
	mov	prmadr	,-(sp)		; Stuff buffer address and a
	mov	sp	,r5		; promt. Point R5 to params. This
	call	kbredi			; is because we use the editor with
	cmp	(sp)+	,(sp)+		; Minitab and Kermit-11. Pop args.
	tst	r1			; Anyting there?
	beq	10$			; No
	mov	#buf	,r2		; Remove trailing control chars
	add	r1	,r2		; Point to end of the line
20$:	cmpb	-(r2)	,#40		; Well?
	bhi	30$			; No more
	sob	r1	,20$		; Found one, keep looking
	br	10$			; Nothing, ignore it.
30$:	cmp	r1	,#1		; One character?
	bne	40$			; No
	cmpb	buf	,#'$		; Just a '$' command
	beq	10$			; Yes, ignore
40$:	mov	#buf	,-(sp)		; No. Now comes the REAL KLUDGE.
	call	chkbye			; Since we can't tell the exec to
	bcs	50$			; delete the region when its creator
	call	detreg			; disappers, we will try to catch
	call	delreg			; the likely logout message and then
50$:	mov	#buf	,-(sp)		; detach and delete the region here.
	.TTECH				; Insure echoing.
	call	docmd			; Generate and execute '$ commandline'
	jmp	...huh			; This can't happen.

	.even


	.sbttl	Utility routines


;	DOCMD
;
;	Passed:	2(sp)	Command line to build
;	Return:		If '$' is a valid CCL command, it never returns

Docmd:	mov	r4	,-(sp)		; Save it
	mov	r3	,-(sp)		; This one also
	mov	2+4(sp)	,r3		; Get string address
	STRLEN	r3			; Get the length now
	mov	r0	,r2		; Copy it
	beq	100$			; Nothing to do.
	add	#5	,r2		; Room for '$ ' and null.
	bic	#1	,r2		; Insure even value
	sub	r2	,sp		; Allocate a buffer
	mov	sp	,r4		; And a pointer to it
	movb	#'$	,(r4)+		; Insert DCL prefix
	movb	#40	,(r4)+		; ...
	STRCPY	r4	,r3		; Make a copy of the command
	mov	sp	,r4		; Reset buffer address
	CLRXRB				; Insure XRB is cleared out
	STRLEN	r4			; Get total length
	mov	r0	,XRB+XRLEN	; Length of the CCL command
	mov	r0	,XRB+XRBC	; Again
	mov	r4	,XRB+XRLOC	; String address
	.CCL				; Try it out
	PRINT	#200$			; Huh? This can't happen
	add	r2	,sp		; But it did. Restore the stack
100$:	mov	(sp)+	,r3		; Pop registers
	mov	(sp)+	,r4		; Simple
	mov	(sp)+	,(sp)		; Move return address up
	return				; And exit


200$:	.asciz	<CR><LF>/$ (DCL) CCL command failed/<CR><LF>
	.even


	.sbttl	Get started

;	INIT
;
;	Passed:	Nothing
;
;	Init handles all initialization whenever a user enters the RTS.
;	It does the following things:
;
;	1. Save current UIC.
;	2. Get terminal type, reject entry if not a VT1xx, 2xx or 3xx.
;	3. Change name to ...CLE, Reset I/O channels, Get Job number,
;	   Reset terminal echoing and output.
;	4. Compute region name as CLEJnn, where NN is the job number.
;	5. Attempt to create the region.  If this fails for any reason
;	   other that an already existing region, then exit.  Thus one
;	   needs the INSTAL priv.  If it was created,  save region ID.
;	6. Attach to the region by name. Save the region id.
;	7. Create address window off of APR6 (the RTS is mapped on 7).
;	8. If region was just created, save current UIC in the region.
;	9. If current UIC <> Saved UIC, or the region was just created
;	   the clear the command line buffers.


init::	.STAT				; Get current PPN
	mov	XRB+10	,curppn		; Save it
	mov	#prm	,prmadr		; A real prompt
	CLRFQB				; Clear FIRQB out
	movb	#UU.SYS	,FIRQB+FQFUN	; ...
	incb	FIRQB+5			; Subfunction 1
	.UUO				; Do it
	mov	FIRQB+32,XRB+0		; Now get JDFLG3
	add	#JDFLG3	,XRB+0		; Offset to flag 3
	.PEEK				; Do it
	tstb	FIRQB			; Well?
	bne	5$			; No
	tstb	XRB+0			; Running a ICFP ?
	bpl	5$			; No
	mov	#nulprm	,prmadr		; Yes, a null prompt
5$:	call	inqter			; Get the terminal type
	mov	r0	,vttype		; And save the terminal type
	bne	10$			; Must be a video terminal here.
	mov	FIRQB+6	,exttyp		; Save extended terminal type
	PRINT	#notvt1			; Print first part of message
	DECOUT	exttyp			; Print offending terminal type
	print	#notvt2			; And rest of message
	jmp	...dcl			; Back to DCL folks.
10$:	call	leftm			; See if we need a CRLF
	mov	#unknown,func		; Unknown call
	mov	#^R...	,FIRQB+FQNAM1+0	; Change program name
	mov	#^RCLE	,FIRQB+FQNAM1+2	; to ...CLE
	.NAME				; Simple to do
	CLRFQB				; Reset I/O channels
	movb	#RSTFQ	,FIRQB+FQFUN	; Simple
	CALFIP				; Do it
	movb	FIRQB+FQJOB,jobn	; Save job number
	asrb	jobn			; Not times two
	.TTRST				; Insure terminal is ok
	.TTECH				; Ditto
	.sbttl	Initialize, continued...

	movb	jobn	,r1		; Convert to ASCII
	clr	r0			; Simple
	div	#12	,r0		; Do it
	add	#'0	,r0		; Convert to ascii now
	add	#'0	,r1		; Ditto
	sub	#4	,sp		; Allocate a buffer
	mov	sp	,r2		; And a pointer
	movb	#'J	,(r2)+		; Generate the second half of
	movb	r0	,(r2)+		; the dynamic region name now.
	movb	r1	,(r2)+		; And then we convert to R50
	mov	sp	,r2		; Fix the pointer
	ATOR50	r2			; Convert
	add	#4	,sp		; Fix the stack back up
	mov	#^RCLE	,regnam+0	; Save the region's name
	mov	r0	,regnam+2	; ...Save the region's name
	mov	#$uurts	,func		; Error message header for UU.RTS
	CLRFQB				; Get set for a .CRRG
	movb	#UU.RTS	,FIRQB+FQFUN	; On RSTS/E we use UU.RTS
	movb	#30	,FIRQB+FQFIL	; Subfunction to create region
	mov	#^RCLE	,FIRQB+FQNAM1+0	; First half of the regions name
	mov	r0	,FIRQB+FQNAM1+2	; Second half of the region name
	movb	#1	,FIRQB+FQSIZ	; 1KW please
	mov	#100000	,FIRQB+FQMODE	; Keep the region around
	mov	#1000	,FIRQB+FQFLAG	; This region is private
	decb	FIRQB+FQPFLG		; Next byte is real protection
	movb	#60.	,FIRQB+FQPROT	; Owner only
	.UUO				; At last
	clr	r5			; Flag if the region was already there
	cmpb	FIRQB	,#FIEXST	; Does the region already exit?
	beq	20$			; Then just attach to it
	tstb	FIRQB			; Otherwise, did this fail?
	bne	..oops			; Yes, it's fatal
	movb	FIRQB+FQPPN,regid	; Save this for a moment.
	dec	r5			; First time
20$:	mov	#$atrfq	,func		; ATRFQ of .PLAS failed
	CLRFQB				; Zap the FIRQB again please
	movb	#ATRFQ	,FIRQB+4	; Attach to region subfunction of .PLAS
	mov	regnam+0,FIRQB+12	; Region name to attach to.
	mov	regnam+2,FIRQB+14	; ...Region name to attach to.
	mov	#2	,FIRQB+FQMODE	; We must have r/w access to it.
	.PLAS				; Well, lets get it done with
	tstb	FIRQB			; Success ?
	bne	..oops			; No, die
	mov	FIRQB+6	,regid		; Yes, copy the region identification.
	.sbttl	More init, do a CRAW$S and init the region if need be.


	mov	#$crafq	,func		; Set debug address text
	CLRFQB				; Yes, once again, zap the FIRQB now.
	movb	#CRAFQ	,FIRQB+4	; Create an address window now
	movb	#6	,FIRQB+7	; Based from APR6, 140000-157777
	mov	#MAPSIZ	,FIRQB+12	; Set the map size
	mov	regid	,FIRQB+14	; The region ident word
	mov	#MAPSIZ	,FIRQB+20	; How much to map.
	mov	#202	,FIRQB+FQMODE	; Read/write + implicit MAP$S
	.PLAS				; Do it
	tstb	FIRQB			; Did it work?
	bne	..oops			; No
	tst	r5			; First time here?
	beq	30$			; No
	mov	curppn	,@#edippn	; And save the current UIC please
30$:	cmp	curppn	,@#edippn	; Same UIC
	bne	40$			; No, init the region then.
	tst	r5			; First time?
	beq	100$			; No
40$:	call	inireg			; Yes, init things
100$:	clr	@#edipos		; Clear out cursor position
	clr	@#edilen		; Clear length
	return				; Exit

..oops:	movb	FIRQB	,r0		; Dump the error code
	DECOUT	r0			; Do it
	PRINT	#inierr			; Error text
	PRINT	func			; Function
	jmp	...dcl			; Goto DCL


	.save
	.psect	$RODATA	,D
inierr:	.asciz	/. was the init error. /<CR><LF>
chain:	.asciz	!.CHAIN failed (is _SY0:[0,1]CLE.RTS set <232>/RTS=CLE?)!<CR><LF>
unknown:.asciz	/Unknown init failure/<CR><LF>
$uurts:	.asciz	/Failed to create region/<CR><LF>
$atrfq:	.asciz	/.PLAS ATRFQ failed/<CR><LF>
$crafq:	.asciz	/.PLAS CRAFQ failed/<CR><LF>
notvt1:	.asciz	/??CLE-F-/
notvt2:	.asciz	/ CLE can only be used from VTxxx series terminals/
crlf:	.byte	CR,LF,0
	.even
	.restore


	.enabl	LSB

inireg::mov	#-1	,@#edicmd	; Init the current command to -1
	clr	@#edists		; Clear status
	mov	#LN$CNT	,r0		; Number of buffers to clear
	mov	#lastli	,r1		; Address of list
10$:	mov	(r1)+	,r2		; Address of current buffer
	clrb	@r2			; Zap it
	sob	r0	,10$		; Next please
	CLRFQB				; Use UU.SYS for a key
	movb	#UU.SYS	,FIRQB+FQFUN	; Function
	incb	FIRQB+5			; Part one
	.UUO				;
	mov	#FIRQB+2,r1		; A pointer
	mov	#34	,r0		; Size
	mov	#$skey	,r2		; ...
20$:	movb	(r1)+	,(r2)		; Copy
	bne	30$			; Ok
	incb	(r2)			; Insure > 0
30$:	bisb	#200	,(r2)+		; Insure > 200
	sob	r0	,20$		; Next
	clrb	@r2			; .ASCIZ
	.DATE				; Get current stuff
	movb	XRB+5	,@#editim	; Save ticks till minute
	mov	#$ENCKEY,-(sp)		; Inittialize keys
	clr	-(sp)			; Get ENCODE key
	mov	#200$	,-(sp)		; Using time info
	call	kinit			; Do it
	inc	2(sp)			; Get DECODE key next
	mov	#$DECKEY,4(sp)		; Simple
	call	kinit			; Again
	add	#3*2	,sp		; Pop stack.
	return				; Exit

;	 Since the tables  in CLECRY.MAC are key dependent, we will
;	use the old one and do the en/decryption based on the ticks
;	to next second at region creation.

	.save
	.radix	10
	.psect	$PDATA	,D
200$:	.byte  31, 41, 59, 26, 53, 58, 97, 93, 238, 46, 26, 43, 38, 32, 79
	.even
	.radix	8
	.restore
	.dsabl	lsb
	.sbttl	Detach, delete region


Detreg::CLRFQB				; Always do this
	movb	#DTRFQ	,FIRQB+4	; .PLAS subfunction
	mov	regid	,FIRQB+6	; Region ID
	.PLAS				; Simple
	clc				; Always say it worked.
	return				; Exit


Delreg::CLRFQB				; Ditto, insure no oddball defaults
	mov	regnam+0,FIRQB+FQNAM1+0	; Stuff the region name in
	mov	regnam+2,FIRQB+FQNAM1+2	; ...Stuff the region name in
	movb	#24	,FIRQB+4	; UU.RTS subfunction, delete region
	movb	#UU.RTS	,FIRQB+FQFUN	; .UUO function code
	.UUO				; Simple
	clc				; Always say it works
	return				; And exit



	.sbttl	Utility routines

Clrcns::return

Read1c::CLRXRB				; Insure XRB is zapped
	.TTNCH				; No echo
	.TTDDT				; One shot ODT mode
	CLRXRB				; Insure XRB zapped
	clr	-(sp)			; Allocate a buffer
	mov	sp	,r1		; A pointer
	mov	r1	,XRB+XRLOC	; Buffer address
	inc	XRB+XRLEN		; One character size buffer
	mov	#100000	,XRB+XRTIME	; KMON read
	.READ				; Simple
	clr	r0			; Return the character next
	tstb	FIRQB			; Errors?
	bne	100$			; Yes, return a NULL
	tst	XRB+XRBC		; No data?????
	beq	100$			; Should never happen.
	bisb	@r1	,r0		; No, return the data then.
100$:	tst	(sp)+			; Pop the buffer and exit
	return				; Bye

kbread::return				; No-op for hardcopy terminals


;	TTYOUT
;
; Passed: 2(sp)	.ASCIZ string address
;
;
;	 The entry point  MOUT is present for compatibility with K11EDI
;	having been assembled for Kermit-11 with the K11MAC.MAC include
;	file.

MOUT::
TTYOUT::mov	r0	,-(sp)		; Save R0
	mov	r1	,-(sp)		; Save R1
	mov	2+4(sp)	,r0		; no length, assume .asciz
10$:	tstb	(r0)+			; move along looking for a null
	bne	10$			; none yet so far
	sub	2+4(sp)	,r0		; get the length
	dec	r0			; off by one
	ble	100$			; Nothing to do, exit
20$:	mov	#XRB	,r1		; address of xrb parameter block
	mov	r0	,(r1)+		; buffer length
	mov	r0	,(r1)+		; byte count for the i/o
	mov	2+4(sp)	,(r1)+		; address of the buffer
	clr	(r1)+			; Channel zero
	clr	(r1)+			; unused
	clr	(r1)+			; unused
	mov	#40100	,@r1		; stuff xrmod with transparent mode
	.WRITE				; Dump
	tstb	FIRQB			; Success?
	beq	100$			; Yes, exit
	sec				; No, set carry and then exit
100$:	mov	(sp)+	,r1		; Pop R1
	mov	(sp)+	,r0		; And also pop R0
	mov	(sp)+	,(sp)		; Pop return
	return

L$TTYO::mov	(r5)	,-(sp)		; Convert to other form so K11EDI
	call	TTYOUT			; will get it's globals resolved.
	return				; Exit

	.sbttl	other junk

;	Clear FIRQB and clear XRB


$CLRXR::mov	r0	,-(sp)		; Clear the XRB out
	mov	#XRB	,r0		; Starting address of it
10$:	clr	(r0)+			; Zap a word
	cmp	r0	,#XRB+14	; Done?
	blos	10$			; No
	mov	(sp)+	,r0		; Pop R0
	return				; And exit



$CLRFQ::mov	r0	,-(sp)		; Clear the FIRQB out
	mov	#FIRQB	,r0		; Start address
10$:	clr	(r0)+			; Do a word
	cmp	r0	,#FIRQB+36	; Done?
	blos	10$			; No
	mov	(sp)+	,r0		; Yes, Pop R0
	return				; And exit


Leftm:	CLRXRB				; See if we need a CRLF
	.POSTN				; Get current position
	tst	XRB+2			; Well?
	beq	100$			; Not needed
	PRINT	#crlf			; Needed, do a CRLF
100$:	return				; Exit


;	Convert 3 ascii to 1 rad50
;
;	Passed:
;		2(sp)	Address of the string
;	Return:	R0	The rad50 value


Ascrad:	SAVE	<r1,r2,r3,r4>		; save the scratch registers .
	mov	2+10(sp),r4		; the address of the ASCII str.
	clr	r3
	mov	#3	,r0
1$:	mov	#radchr	,r1
	mov	#40.	,r2
2$:	cmpb	(r4)	,(r1)+
	beq	3$			; Found the character. EXIT loop
	sob	r2	,2$
	mov	#40.	,r2
3$:	dec	r2
	mul	#40.	,r3		; We accumulate the RAD50 chars
	sub	r2	,r3		; in r3. R1 has the next  rad50
	add	#39.	,r3
	tstb	(r4)+			; to add on. Move to  the  next
	sob	r0	,1$		; byte ( for a total of 3 bytes)

	mov	r3	,r0
	UNSAVE	<r4,r3,r2,r1>		; return result in r0 and return
	mov	(sp)+	,(sp)		; Pop return address
	return				; And exit

	.nlist	bex
radchr:	.ascii	/ ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789:/
	.list	bex
	.even


	.sbttl	strcat and strcpy

;	STRCPY
;
;	input:
;		0(sp)	return address
;		2(sp)	dst address
;		4(sp)	src address
;	output:	r0	dest address


STRCPY::mov	r1	,-(sp)		; save temp registers please
	mov	2+2(sp)	,r0		; destination address
	mov	2+4(sp)	,r1		; source .asciz address
10$:	movb	(r1)+	,(r0)+		; copy until a null
	bne	10$			; not done
	mov	2+2(sp)	,r0		; return the dst address
	mov	(sp)+	,r1		; pop r1 and exit
	mov	(sp)	,4(sp)		; move return address up now
	cmp	(sp)+	,(sp)+		; pop junk and exit
	return


STRCAT::mov	r1	,-(sp)		; save temp registers please
	mov	2+2(sp)	,r0		; destination address
	mov	2+4(sp)	,r1		; source .asciz address
5$:	tstb	(r0)+			; look for the end of the dst string
	bne	5$			; not found yet
	dec	r0			; found it, fix the pointer
10$:	movb	(r1)+	,(r0)+		; copy until a null
	bne	10$			; not done
	mov	2+2(sp)	,r0		; return the dst address
	mov	(sp)+	,r1		; pop r1 and exit
	mov	(sp)	,4(sp)		; move return address up now
	cmp	(sp)+	,(sp)+		; pop junk and exit
	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
	br	100$			; Exit

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

30$:	mov	#-1,r0			; A<b return
100$:	mov	(sp)	,4(sp)		; move return address up now
	cmp	(sp)+	,(sp)+		; pop junk and exit
	return


L$len::	STRLEN	r0			; Kermit call convention again
	return				; Exit

Strlen:	mov	2(sp)	,r0		; Get string length
10$:	tstb	(r0)+			; Anything there?
	bne	10$			; Yes, keep looking
	sub	2(sp)	,r0		; Compute length now
	dec	r0			; Off by one
	mov	(sp)+	,(sp)		; Move return address up
	return				; And exit
	

	.sbttl	number printing

L$wroc::mov	@r5	,-(sp)		; Resolve entry point from
	call	putoct			; the CLE being possibly assembled
	return				; for Kermit-11.

Putoct:	SAVE	<r3>
	mov	#$cbomg	,r3		; Octal conversion
	br	pcom

Putdec:	SAVE	<r3>
	mov	#$cbdmg	,r3		; Decimal conversion

Pcom:	SAVE	<r0,r1,r2>		; Save some more registers
	mov	10+2(sp),r1		; The value
	sub	#20	,sp		; Create a buffer
	mov	sp	,r0		; The buffer
;	movb	#40	,(r0)+		; Stuff a blank in
	clr	r2			; Formatting options
	jsr	pc	,@r3		; Now format
	clrb	@r0			; Make it .ASCIZ now
	mov	sp	,r0		; Reset the buffer address
	PRINT	r0			; And dump the data
	add	#20	,sp		; Pop buffer
	UNSAVE	<r2,r1,r0,r3>		; Pop registers
	mov	(sp)+	,(sp)		; Move return address up
	return				; And exit

Scanch::save	<r2>			; save temps
	mov	6(sp)	,r2		; get address of the string
	clr	r0			; initial found position
10$:	tstb	@r2			; end of the string yet ?
	beq	90$			; yes
	inc	r0			; no, pos := succ(pos)
	cmpb	4(sp)	,(r2)+		; does the ch match the next one?
	bne	10$			; no, try again
	br	100$			; yes, exit loop
90$:	clr	r0			; failure, return postion = 0
100$:	unsave	<r2>			; pop r2
	mov	@sp	,4(sp)		; move return address up
	cmp	(sp)+	,(sp)+		; pop stack
	return				; and exit

	.sbttl	RSX Syslib conversion routines

$SAVRG::MOV	R4,-(SP)
	MOV	R3,-(SP)
	MOV	R5,-(SP)
	MOV	6(SP),R5
	CALL	@(SP)+
	MOV	(SP)+,R3
	MOV	(SP)+,R4
	MOV	(SP)+,R5
	RETURN

$CBDMG::MOV	#25012,-(SP)
	BR	E00072
$CBDSG::MOV	#25412,-(SP)
	BR	E00072
$CBOMG::MOV	#31010,-(SP)
	BR	E00072
$CBOSG::MOV	#31410,-(SP)
	BR	E00072
$CBTMG::BIC	#-400,R1
	MOV	#15010,-(SP)
E00072:	TST	R2
	BNE	E00102
	BIC	#1000,(SP)
E00102:	MOV	(SP)+,R2
$CBTA::JSR	R5,$SAVRG
	MOVB	R2,R5
	CLRB	R2
	SWAB	R2
	ASR	R2
	BCC	E00134
	TST	R1
	BPL	E00134
	NEG	R1
	MOVB	#55,(R0)+
E00134:	MOV	R0,R4
	ROR	R2
	ROR	R2
	ROR	R3
	CLRB	R3
	BISB	R2,R3
	CLRB	R2
	BISB	#60,R2
	MOV	R1,R0
E00160:	MOV	R0,R1
	CLR	R0
	DIV	R5,R0
	CMP	R1,#11
	BLOS	E00200
	ADD	#7,R1
E00200:	ADD	R2,R1
	MOV	R1,-(SP)
	DECB	R3
	BLE	E00234
	TST	R0
	BNE	E00230
	TST	R2
	BPL	E00234
	TST	R3
	BPL	E00230
	BIC	#20,R2
E00230:	CALL	E00160
E00234:	MOVB	(SP)+,(R4)+
	MOV	R4,R0
	RETURN


	.sbttl	Get terminal type
	.enabl	lsb

;	Assume:	Login.com did a $ SET TER/INQ
;
;	INQTER
;
;	Passed:	Nothing
;	Return:	R0	= 0 if hardcopy
;		R0	= 1 if VT1xx or VT2xx series


Inqter::CLRFQB				; Clear out again
	movb	#UU.TRM	,FIRQB+FQFUN	; Terminal char function
	mov	#1+<400*377>,FIRQB+4	; Subfunction 1, KB:
	.UUO				; Read chars
	tstb	FIRQB			; Success?
	bne	90$			; No
	mov	#200$	,r0		; Yes, look for VT type term
10$:	tstb	@r0			; End of list yet?
	beq	90$			; Yes, return( TTY )
	cmpb	(r0)+	,FIRQB+6	; No, check for a match
	bne	10$			; Not yet
	PRINT	#300$			; VT series, ensure in 100 mode
	mov	#VT100	,r0		; Yes, return(VT100)
	br	100$			; Exit

90$:	mov	#TTY	,r0		; Nothing
100$:	return				; Exit


	.save
	.psect	$RODATA	,D

200$:	.byte	6.			; VT100
	.byte	13.			; VT101
	.byte	14.			; VT102
	.byte	15.			; VT125
	.byte	16.			; VT131
	.byte	17.			; VT132
	.byte	18.			; VT220
	.byte	19.			; VT240
	.byte	20.			; VT241
	.byte	21.			; VT105
	.byte	22.			; VK100 (gigi)
	.byte	23.			; RT02
	.byte	48.			; VT330
	.byte	49.			; VT340
	.byte	0			; End

300$:	.byte	ESC,74,15,0		; Enter VT100 mode (vs. VT52)
	.even
	.restore
	.dsabl	lsb

	.sbttl	Try to catch LOGOUT, BYE or SWITCH commands


;	 This is a kludge. The problem is that we do not have a  way
;	to  tell  the EXEC at region creation time to get rid of the
;	region when the creator process (your job) is  removed  (via
;	UU.BYE  or  job kill). Ideally, one would like to be able to
;	do so. But in the mean time, what we can do is to check  for
;	LIKELY  logout  strings,  like LOG*OUT or BYE*, and if found
;	detach and delete the region ourself. 
;
;
;	CHKBYE
;
;	Passed:	2(sp)	Command line address
;	Return:	C bit	Cleared --> Logout command found
;		C bit	Set     --> We did not find LOG*OUT, BYE or SW*ITCH?


Chkbye::SAVE	<r1,r2,r3>		; Save temps
	mov	2+<2*3>(sp),r1		; Command line
	sub	#LN$SIZE+2,sp		; Allocate a buffer
	mov	sp	,r2		; Point to it
10$:	movb	(r1)+	,@r2		; Copy command character
	beq	20$			; Alldone
	cmpb	@r2	,#CR		; Carriage return?
	beq	20$			; Yes, done
	cmpb	@r2	,#LF		; Line feed?
	beq	20$			; Done
	cmpb	@r2	,#'A!40		; Lower case?
	blo	15$			; No
	cmpb	@r2	,#'Z!40		; Well...
	bhi	15$			; No
	bicb	#40	,@r2		; Yes, force to lower case then.
15$:	inc	r2			; Not done, point to the next one
	br	10$			; Next
20$:	clrb	@r2			; Done, insure .ASCIZ
	mov	sp	,r2		; Reset buffer pointer
	mov	#log$lis,r3		; Point to command list
30$:	tst	@r3			; Done checking for logout commands?
	beq	90$			; Yes, set carry and exit
	STRCMP	r2	,(r3)+		; No, check again
	tst	r0			; A match?
	bne	30$			; No
	add	#LN$SIZE+2,sp		; Yes, pop buffer and exit
	clc				; Flag sucess
	br	100$			; Exit
90$:	add	#LN$SIZE+2,sp		; Yes, pop buffer and exit
	sec				; Done, no match.
100$:	UNSAVE	<r3,r2,r1>		; Pop registers and exit
	mov	(sp)+	,(sp)		; Move return address up
	return				; And now exit.



	.save
	.psect	$RODATA
	.even
log$li::.word	LOG	,LOGO	,LOGOU	,LOGOUT	,BYE	,BYEF	,BYEI	,BYEY
	.word	SW	,SWI	,SWIT	,SWITC	,SWITCH
	.word	0
log::	.asciz	/LOG/
logo::	.asciz	/LOGO/
logou::	.asciz	/LOGOU/
logout::.asciz	/LOGOUT/
bye::	.asciz	/BYE/
byey::	.asciz	/BYEY/
byef::	.asciz	/BYEF/
byei::	.asciz	/BYEI/
sw::	.asciz	/SW/
swi::	.asciz	/SWI/
swit::	.asciz	/SWIT/
switc::	.asciz	/SWITC/
switch::.asciz	/SWITCH/
	.even
	.restore

	.sbttl	Encryption

	.iif 	ndf	,$$SIMPLE, $$SIMPLE = 1
	.if	ne	,$$SIMPLE
	.ift

;	ENCRYPT
;
;	Passed:
;		2(sp)	String to do
;		4(sp)	Key string
;	Return:	2(sp)	Output string
;
;	This is simply an XOR encryption, which is trivial to break.
;	It's better than nothing for now until I get a 'DES' routine
;	or something similiar. It will prevent casual browsing.

Decryp::
Encryp::SAVE	<r0,r1,r2,r3,r4,r5>	; Save all
	mov	2+<6*2>(sp),r5		; Get pointer to string
	mov	4+<6*2>(sp),r4		; Get pointer to key string
	mov	#$skey	,r4		; *** Override the key address ***
	STRLEN	r4			; Get length of the key
	mov	r0	,-(sp)		; Save the key length
	beq	100$			; Nothing to do.
	clr	r1			; Offset into the key string
10$:	clr	r2			; Copy the next character
	bisb	@r5	,r2		; Get the character now.
	beq	100$			; All done
	mov	r4	,r3		; Key string
	add	r1	,r3		; Point to current key char
	clr	r0			; Always avoid sign extension
	bisb	@r3	,r0		; Get next key character
	xor	r2	,r0		; Do the xor
	movb	r0	,(r5)+		; And copy over the source
	inc	r1			; Next key character
	clr	r0			; Get remainder after division
	div	(sp)	,r0		; Do it
	br	10$			; Next please
100$:	clrb	@r5			; Insure .asciz
	tst	(sp)+			; Pop temp
	UNSAVE	<r5,r4,r3,r2,r1,r0>	; Pop all
	mov	(sp)	,4(sp)		; Move return address up
	cmp	(sp)+	,(sp)+
	return

kinit:	return

	.iff				; Use more advanced routine
	.enabl	lsb

Encryp::
Decryp::
10$:	mov	r2	,-(sp)
	mov	sp	,r2
	mov	r3	,-(sp)
	mov	r4	,-(sp)
	mov	6(r2)	,-(sp)
	mov	4(r2)	,r3
	mov	r3	,-(sp)
	mov	#LN$MAX	,r4
	asr	r4
	asr	r4
	asr	r4
20$:	mov	r3	,(sp)
	movb	editim	,r2
	asr	r2
	asr	r2
	asr	r2
	inc	r2
30$:	call	desalt
	sob	r2	,30$
	add	#10	,r3
	sob	r4	,20$
	cmp	(sp)+	,(sp)+
	mov	(sp)+	,r4
	mov	(sp)+	,r3
	mov	(sp)+	,r2
	mov	(sp)	,4(sp)
	cmp	(sp)+	,(sp)+
	return

	.dsabl	lsb

	.endc


	.sbttl	Control C, Synch interupts and psuedo vector
...CC::					; Control C things
...2CC::.TTECH				; Enable echoing
	.TTRST				; And reset other terminal stuff
	rti				; And dismiss the interupt


	.enabl	lsb

...IOT::PRINT	#210$
	br	...DCL

..FPER::				; Should never get here.

...BAD::movb	FIRQB	,r2		; Save exec's error code
	mov	sp	,r3		; Save stack
	PRINT	#200$			; Die
	PRINT	#230$			; Info
	OCTOUT	r2			; Error code
	OCTOUT	@r3			; PC
	OCTOUT	2(r3)			; PS
	PRINT	#300$			; CR/LF	
	br	...dcl			; Exit

...HUH::PRINT	#220$			; A message
	br	...dcl			; And goto DCL

...DCL::CLRXRB				; Clear XRB out
	CLRFQB				; Ditto for the FIRQB
	mov	#^RDCL	,FIRQB+FQNAM1	; Go to DCL now
	mov	#-1	,FIRQB+FQEXT	; Make it the default
	.RTS				; Try to do this
	.EXIT				; Go away now.

	.save
	.psect	$RODATA	,D
200$:	.asciz	/??CLE-F  FP error or other trap/<CR><LF>
210$:	.asciz	/IOT trap/<CR><LF>
220$:	.asciz	/??CLE-F  $ (DCL) CCL Command failed/<CR><LF>
230$:	.asciz	/Error code, PC and PS:/<CR><LF>
300$:	.byte	15,12,0
	.even
	.restore


	.psect	.99998
	.blkw	30
	.psect	.99999

..psta::.word	PF.KBM!PF.NER		; KBM and no error logging
	.rad50	/CLE/			; Default 'runnable' extention
	.word	0			; Reserved
	.word	1			; 1 KW min size
	.word	..FPER			; FIS (an 11/40?)
	.word	0			; Reserved
	.word	0			; Reserved
	.word	...NEW			; 'New' user entry point
	.word	...RUN			; 'Run' entry
	.word	...BAD			; Junk
	.word	...BAD			; BPT
	.word	...IOT			; IOT
	.word	...BAD			; Non-exec EMT's
	.word	...BAD			; TRAP's
	.word	..FPER			; FPU errors
	.word	...CC			; Control C
	.word	...2CC			; Two of the things
	.word	1			; P.SIZE, max size
..pend::
	.end