	.title	edresl	misc cluster lib support routines for C TED



;	Last edit: 27-Jan-86  13:08:12 Brian Nelson
;
;	Removed root code for some terminal init/restore stuff


	.psect	rescod	,ro,i,lcl,rel,con
	.enabl	gbl
	.mcall	qiow$s
	.macro	save	list
	.if b , <list>
	.ift
	 save	<r0,r1,r2,r3,r4,r5>
	.iff
	.irp	x,<list>
	 mov	x,-(sp)
		.endr
	.endc
	.endm	save


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


	.sbttl	terminal read/write binary mode

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

	.WRITE	=	EMT + 4
	XRB	=	442

putbin::save	<r1>			; save temp registers

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

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

30$:	mov	(sp)+	,r0		;
	mov	4(sp)	,r1
	qiow$s	#io.wal,#5,,,,,<r1,r0>	; rsx and p/os
40$:	clr	r0			; assume no errors and exit
	unsave	<r1>			; pop register
	return				;


;putbin::mov	2(sp)	,r1
;	mov	r1	,r0
;10$:	tstb	(r0)+
;	bne	10$
;	sub	r1	,r0
;	dec	r0
;	qiow$s	#io.wal,#5,,,,,<r1,r0>
;	return

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

gterm::	mov	@#$vext	,r0
	mov	@(r0)	,r0
	return

gsys::	mov	@#$vext	,r0
	mov	@2(r0)	,r0
	return

gvext::	mov	@#$vext	,r0
	return



	.sbttl	get date and time


	.enabl	lc
	.mcall	gtim$s


rgetti::save	<r1,r2,r3>
	mov	@r5	,r0		; can't use sp for arg in clusters
	sub	#16.	,sp		; make room for result
	mov	sp	,r1		; result addr for gtim$
	gtim$s	r1			; get time and date
	mov	g.tida(r1),r2		; r2 := day
	jsr	pc	,cnvert		; convert and store day
	movb	#'-	,(r0)+		; insert dash
	mov	g.timo(r1),r2		; r2 := month
	asl	r2
	add	g.timo(r1),r2		; r2 := 3*month
	add	#mnthtab-3,r2		; r2 := mnthtab[3*month]@
	movb	(r2)+	,(r0)+
	movb	(r2)+	,(r0)+		; store month name
	movb	(r2)+	,(r0)+
	movb	#'-	,(r0)+		; insert dash
	mov	@r1	,r2		; r2 := year
	jsr	pc	,cnvert		; convert and store year
	movb	#40 	,(r0)+		; final space
	movb	#40 	,(r0)+		; final space

	mov	#3,r3			; loop count := 3
	add	#g.tihr,r1		; start with hours
1$:	mov	(r1)+,r2		; begin loop
	jsr	pc,cnvert		;   convert to ascii and store
	dec	r3			;   if done
	beq	2$			;     then exit loop
	movb	#':,(r0)+		;     else insert colon
	br	1$			; end loop
2$:	add	#16.,sp
	clrb	@r0			; .asciz and exit
	unsave	<r3,r2,r1>
	return
;
; cnvert: internal procedure to convert
; integer in r2 to ascii.
cnvert:	add	#366,r2		;begin loop
	tstb	r2
	bpl	cnvert		;end loop
	add	#"00-366,r2	;convert to ascii
	swab	r2		;reorder bytes
	movb	r2,(r0)+	;store digit
	swab	r2
	movb	r2,(r0)+	;store digit
	rts	pc
;

	.save
	.psect	rwdata
mnthtab:.ascii	/JanFebMarAprMayJunJulAugSepOctNovDec/
	.even
	.restore



	.sbttl	local copy of csv.mac for the reslib

.iif	ndf	C$PMTR	C$PMTR	=  4	;formal[n] @ c$pmtr+<n*2>(r5)
.iif	ndf	C$AUTO	C$AUTO	= -6	;local[n]  @ c$auto-<n*2>(r5)
.iif	ne	C$PMTR-4	.error	Bad definition of C$PMTR
.iif	ne	C$AUTO+6	.error	Bad definition of C$AUTO
;
; By defining C$PMTR and C$AUTO as local symbols, the task
; builder need not do so much work				;05-


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


	.sbttl	one shot terminal init code

;	27-Jan-86  13:04:44  Removed from PDPIO for placement in EDRESL
;
;	Brian Nelson


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


	.save
	.psect	dlmmsk	,ro,d,lcl,rel,con
dlmmsk:	.byte	^B11110111		;
	.byte	^B01111111		; For RSTS/E make everything a delimiter
	.rept	36			; other than control C for screen editor
	.byte	377			; single character reads. Much cleaner
	.endr				; this way rather than trying to use RSX
	.restore			; emulation for it under RSTS.

forcevtedit::
	clr	r0			; assume line mode
	mov	@#$vext	,r1
	cmpb	@2(r1)	,#11		; but is this p/os ?
	bne	100$			; no
	inc	r0			; yes, return(1)
100$:	return


inqtermtype::
	mov	@#$vext	,r1
	cmpb	@2(r1)	,#11		; but is this p/os ?
	beq	80$			; yes (vt100 please)
	cmpb	@2(r1)	,#4		; but is this RSTS ?
	bne	80$			; no, return( VT100 )

	mov	#FIRQB	,r0		; RSTS/E, find out the terminal type
	mov	#40	,r1		; clear firqb
10$:	clrb	(r0)+			; a byte at a time
	sob	r1	,10$		; ...
	movb	#UU.TRM	,FIRQB+FQFUN	; .UUO subfunction
	mov	#1+<400*377>,FIRQB+4	; function 1, 377 for current term
	.UUO				; call the exec
	tstb	FIRQB			; it should always work
	bne	100$			; no, so assumme vt100
	mov	#rsts100,r1		; check for vt100 series terminal
	clr	r0			;
	bisb	FIRQB+6	,r0		; terminal code into R0

70$:	tstb	@r1			; common code for checking VT100 type
	beq	90$			; end of list, assume VT220 then
	cmpb	(r1)+	,r0		; check for terminal being a 100 series
	bne	70$			; no

80$:	mov	#2	,r0		; return( vt100 )
	br	100$			; exit

90$:	mov	#3	,r0		; yes, return( vt220 )
100$:	return				; and exit


;	Terminal type codes
;	RSTS v9.x
;
;	unknown	=	1
;	vt100	=	6
;	vt101	=	13 (10)
;	vt125	=	15 (10)
;	vt131	=	16 (10)
;	vt132	=	17 (10)
;	vt105	=	21 (10)

	.save
	.psect	rmsdat
rsts100:.byte	1,6,13.,15.,16.,17.,21.,0
rsx100:	.byte	0
	.even
	.restore


	.sbttl	setup terminal for full screen editing


rstter::mov	@#$vext	,r0
	clr	@4(r0)			; ttinit = 0 ;
	call	clrdlm
100$:	mov	#1	,r0		; success
	return


setter::mov	@#$vext	,r0
	mov	sp	,@4(r0)		; ttinit = 1
	cmpb	@2(r0)	,#4		; is this RSTS/E
	bne	20$			; no
	mov	#firqb	,r1		; open the device up please
	mov	#40	,r0		; clear firqb out first
10$:	clrb	(r1)+			; simple
	sob	r0	,10$		; next
	mov	#"KB	,firqb+fqdev	; device name
	movb	#14*2	,firqb+fqfil	; channel times two
	movb	#OPNFQ	,firqb+fqfun	; CALFIP subfunction
	CALFIP				; open it
	call	setdlm			; a RSTSism (set delimiter mask)
	br	100$			; end of RSTSism's
20$:
100$:	mov	#1	,r0		; nop for setterminal()
	return				; for now


	.enabl	lsb

setdlm::mov	r0	,-(sp)		; save r0 please
	mov	@#$vext	,r0
	cmpb	@2(r0)	,#4		; is this RSTS/E
	bne	100$
	mov	#XRB	,r0		; setup mult private delims for RSTS/E
	mov	#11	,(r0)+		; setup
	mov	#40	,(r0)+		; size of the bitmask
	mov	#dlmmsk	,(r0)+		; address of the bitmask
	movb	#14*2	,(r0)+		; channel
	movb	#TTYHND	,(r0)+		; driver index
	clr	(r0)+			; unused
	clr	(r0)+			; unused
	mov	#1	,(r0)+		; subfunction
	.SPEC				; Do it
	br	100$			; exit

clrdlm::mov	r0	,-(sp)		; save r0
	mov	@#$vext	,r0
	cmpb	@2(r0)	,#4		; is this RSTS/E
	bne	100$			; no
	mov	#XRB	,r0		; yes, clear the delimiter mask
	mov	#11	,(r0)+		; function for .SPEC
	clr	(r0)+			; zero
	clr	(r0)+			; zero
	movb	#14*2	,(r0)+		; channel
	movb	#TTYHND	,(r0)+		; driver index
	clr	(r0)+			; unused
	clr	(r0)+			; unused
	clr	(r0)+			; clear the mask
	.SPEC				; do it and exit
	mov	#FIRQB	,r0		; Close it next
10$:	cmp	r0	,#FIRQB+36	; End of it ?
	bhi	20$			; Yes
	clr	(r0)+			; No
	br	10$			; Next please
20$:	movb	#CLSFQ	,FIRQB+FQFUN	; Function
	movb	#14*2	,FIRQB+FQFIL	; Channel number
	CALFIP				; Close the channel

100$:	mov	(sp)+	,r0
	return

	.dsabl	lsb


	.sbttl	check for typeahead

	.mcall	qiow$s

	sf.gmc	=	2560
	tc.tbf	=	71

typeahead::
	save	<r1>			; save r1 please
	clr	r0			; assume no typeahead
	clr	-(sp)			; get the typehead buffer size
	mov	@#$vext	,r1
	cmpb	@2(r1)	,#4		; is this RSTS/E
	beq	100$			; exit with failure if RSTS
	mov	sp	,r1		; point to the parameter area
	movb	#tc.tbf	,@r1		; we want amount in the buffer
	qiow$s	#sf.gmc,#5,,,,,<r1,#2>	; post the qio now
	tstb	1(r1)			; anything there ?
	beq	100$			; we have nothing to get there
	inc	r0			; we have something
100$:	tst	(sp)+			; pop buffer
	unsave	<r1>			; pop reg and exit
	return				; exit


	.end
