.TITLE	TECOIO	ROOT MODULE
.SBTTL	ROOT MODULE

; LAST EDIT ON 17-MAR-80 BY MARK BRAMHALL

.IDENT	/V36/

L$$IST	=	1	;LIST THE PREFIX FILE

.MCALL	.DATE,	.EXIT,	.GVAL,	.RCTRLO,.READC,	.SETTOP,.TTINR,	.TTYOUT,.WRITC

.SBTTL	GLOBAL DEFINITION

SIZERB	==	1024.	;EXPAND MEMORY IN 1K (BYTE) CHUNKS
.SBTTL	"ET" (EDIT TYPEOUT) BITS

.BSECT

ET$BIN::.BLKB	.	;    +1., OUTPUT IN BINARY (IMAGE) MODE
ET$CRT::.BLKB	.	;    +2., DO SCOPE TYPE RUBOUT AND CONTROL/U
ET$LC::	.BLKB	.	;    +4., ACCEPT LOWER CASE INPUT
ET$NCH::.BLKB	.	;    +8., NO ECHO DURING INPUT FOR CTRL/T
ET$CCO::.BLKB	.	;   +16., CANCEL CONTROL/O ON OUTPUT
ET$CKE::.BLKB	.	;   +32., RETURN -1 IF ERROR/NO INPUT ON CTRL/T
ET$DET::.BLKB	.	;   +64., DETACH AND DETACHED FLAG
ET$XIT::.BLKB	.	;  +128., "NO PROMPT YET" FLAG
ET$TRU::.BLKB	.	;  +256., TRUNCATE LONG OUTPUT LINES
ET$IAS::.BLKB	.	;  +512., INTERACTIVE SCOPE AVAILABLE FOR "WATCH"
ET$RFS::.BLKB	.	; +1024., REFRESH SCOPE AVAILABLE FOR "WATCH"
	.BLKB	.	; +2048., UNUSED
	.BLKB	.	; +4096., UNUSED
	.BLKB	.	; +8192., UNUSED
	.BLKB	.	;+16384., UNUSED
ET$CC::	.BLKB	.	;-32768., ALLOW PROGRAM TO TRAP CONTROL/C

.SBTTL	"ED" (EDIT MODE) BITS

.BSECT

ED$CTL::.BLKB	.	;    +1., DON'T ALLOW "^" AS MEANING CONTROL CHARACTER
ED$YNK::.BLKB	.	;    +2., ALLOW YANKS, ETC. TO CLOBBER TEXT BUFFER
ED$EXP::.BLKB	.	;    +4., DON'T ALLOW ARBITRARY EXPANSION(S)
	.BLKB	.	;    +8., RESERVED BY TECO-8
ED$SRH::.BLKB	.	;   +16., DON'T RESET "DOT" ON SEARCH FAILURE
ED$IMD::.BLKB	.	;   +32., ALLOW IMMEDIATE MODE COMMANDS
ED$INC::.BLKB	.	;   +64., ONLY MOVE "DOT" BY ONE ON ITERATIVE SEARCH FAILURES
	.BLKB	.	;  +128., UNUSED
	.BLKB	.	;  +256., UNUSED
	.BLKB	.	;  +512., UNUSED
	.BLKB	.	; +1024., UNUSED
	.BLKB	.	; +2048., UNUSED
	.BLKB	.	; +4096., UNUSED
	.BLKB	.	; +8192., UNUSED
	.BLKB	.	;+16384., UNUSED
	.BLKB	.	;-32768., UNUSED
.SBTTL	ASSEMBLING TECO

;+
; Assembling TECO.
;
;	The following are supplied in .OBJ form only:
;
;		teco
;		screen
;		scrins
;		scroll
;
;	The following are always assembled and have no conditionals:
;
;		tecov,tecov/c=tiopre,tecov
;		tecoio,tecoio/c=tiopre,tecoio
;		tiofet,tiofet/c=tiopre,tiofet
;		tioeio,tioeio/c=tiopre,tioeio
;		tioenc,tioenc/c=tiopre,tioenc
;		tioini,tioini/c=tiopre,tioini
;		tiodcd,tiodcd/c=tiopre,tiodcd
;
;	The following need only be assembled if refresh scope
;	support (e.g., VT11, VS60) is desired:
;
;		tiorfs,tiorfs/c=tiopre,tiorfs
;
;	The following need only be assembled if interactive scope
;	support (e.g., VT05, VT52, VT100) is desired:
;
;		tioias,tioias/c=tiopre,tioias
;		crtrub,crtrub/c=PARAMS,crtrub
;
;	where PARAMS is some variation of (read CRTRUB source):
;
;	RT11	=	1	;ASSEMBLE FOR RT-11 SCOPE TYPE DETERMINATION
;	WATCH	=	1	;ASSEMBLE TO INCLUDE "WATCH" SUPPORT
;	SCROLL	=	1	;ASSEMBLE TO INCLUDE SCROLLING SUPPORT
;	IMMEDC	=	1	;ASSEMBLE TO INCLUDE IMMEDIATE MODE COMMANDS
;	I$$SOB	=	0	;ASSEMBLE WITHOUT HARDWARE SOB INSTRUCTION
;	I$$DIV	=	0	;ASSEMBLE WITHOUT HARDWARE DIVIDE INSTRUCTION
;-
.SBTTL	LINKING TECO

;+
; Linking TECO.
;
;	1) A full-blown TECO is linked as:
;
;		teco=teco,tecoio,tiofet/c
;		tioeio/o:1/c
;		tioias/o:1,screen,scrins,scroll,crtrub/c
;		tioenc/o:1/c
;		tioini/o:1/c
;		tiorfs/o:1/c
;		tiodcd/o:1
;
;	2) A TECO with only refresh scope support is linked as:
;	   (Note: SCRLOD will come up as an undefined global.)
;
;		teco=teco,tecoio,tiofet/c
;		tioeio/o:1/c
;		tioenc/o:1/c
;		tioini/o:1/c
;		tiorfs/o:1/c
;		tiodcd/o:1
;
;	3) A TECO with only interactive scope "watch" support is linked as:
;	   (Note: SCPLOD will come up as an undefined global.)
;
;		teco=teco,tecoio,tiofet/c
;		tioeio/o:1/c
;		tioias/o:1,screen,scrins,scroll,crtrub/c
;		tioenc/o:1/c
;		tioini/o:1/c
;		tiodcd/o:1
;
;	4) A minimum TECO is linked as:
;	   (Note: SCRLOD and SCPLOD will come up as undefined globals.)
;
;		teco=teco,tecoio,tiofet/c
;		tioeio/o:1/c
;		tioenc/o:1/c
;		tioini/o:1/c
;		tiodcd/o:1
;
;	To eliminate the interactive scope scroller from #1 or #3 above,
;	change the third line to:
;
;		tioias/o:1,screen,scrins,crtrub/c
;
;	To eliminate the screen insert optimizer from #1 or #3 above,
;	change the third line to:
;
;		tioias/o:1,screen,scroll,crtrub/c
;
;	To add interactive scope RUBOUT and CTRL/U support to #2 or #4 above,
;	assemble CRTRUB with WATCH=0 and change the first line to:
;
;		teco=teco,tecoio,tiofet,tioias,crtrub/c
;
;	To save a little space, the TIOFET module can be removed from
;	any of the above first lines at the cost of only being able to
;	use device handlers that are already resident.
;
;	If you are using the RT-11 V4 (or later) XM monitor, TECO can be
;	run as a virtual job using the virtual .SETTOP feature.  This will
;	greatly expand TECO's text buffer space.  To enable the virtual
;	.SETTOP feature, simply patch TECO.SAV as follows:
;
;		 Addr	 Old	 New	 Comment
;		000000	000000	105372	The .RAD50 of "VIR"
;		000044	001000	003000	Add "virtual" bit (2000) to JSW
;
;	A TECO that will run as a foreground job is linked as:
;	(Note: You cannot use TIOFET, SCRINS, or SCROLL in a foreground link.)
;
;		teco/r:400=teco,tecoio/e:20000/c
;		tioeio/o:1/c
;		tioias/o:1,screen,crtrub/c
;		tioenc/o:1/c
;		tioini/o:1/c
;		tiorfs/o:1/c
;		tiodcd/o:1
;		morbuf
;
;	The /e:nnn in the first line allocates the specified amount of
;	space to TECO's combined text buffer, Q-register, and I/O buffer
;	storage area.  The nnn is in octal bytes; this example specified
;	4K words which is a reasonable number.  You need not use the /e:nnn
;	(and the corresponding MORBUF) if you always FRUN TECO with an
;	explicit /BUFFER:nnn switch.  If you do use the /e:nnn at link
;	time, the /BUFFER:nnn switch will allocate additional memory to
;	TECO at run time.
;
;	If you use the /TERM:n switch, TECO will find and use the specified
;	terminal.
;
;	If you are using the RT-11 V4 (or later) XM monitor, you can
;	FRUN or SRUN TECO.SAV after making the virtual .SETTOP feature
;	patch described above.  Or, to make TECO's root segment as small
;	as possible, but at the expense of using lots of virtual memory,
;	you can link TECO to use virtual overlays.  A virtually overlaid
;	TECO can also be invoked via FRUN or SRUN.
;	(Note: You cannot use TIOFET or TIORFS in a virtual overlaid link.)
;
;		teco=tecov,tecoio/c
;		teco/v:1/c
;		tioeio/v:2/c
;		tioias/v:2,screen,scrins,scroll,crtrub/c
;		tioenc/v:2/c
;		tioini/v:2/c
;		tiodcd/v:2
;-
.SBTTL	INITIALIZATION DEFAULTS

;+
; INITIALIZATION DEFAULTS.
;
;	$$VT	TRUE SCOPE TYPE DETERMINATION CONTROL (4 WORDS @ START-20)
;	    $$VT+0 000000 => TECO FIGURES OUT THE SCOPE TYPE...
;		   000001 => SPECIFICALLY NOT A SCOPE TYPE TERMINAL
;		   100000 => SPECIFIC SCOPE TYPE OF "VT05"  (SEE $$VT+6)
;		   100000 => SPECIFIC SCOPE TYPE OF "VT52"  (SEE $$VT+6)
;		   100020 => SPECIFIC SCOPE TYPE OF "VT100" (SEE $$VT+6)
;	    $$VT+6    72. => FORCE SCOPE WIDTH TO 72.  ("VT05")
;		      80. => FORCE SCOPE WIDTH TO 80.  ("VT52/VT100")
;		     132. => FORCE SCOPE WIDTH TO 132. ("VT52/VT100")
;
;	$$EU	INITIAL VALUE FOR TECO'S "EU" FLAG (WORD @ START-10)
;
;	$$ED	INITIAL VALUE FOR TECO'S "ED" FLAG (WORD @ START-6)
;
;	$$ET	INITIAL VALUE FOR TECO'S "ET" FLAG (WORD @ START-4)
;	    ET$RFS 002000 => TRY FOR REFRESH SCOPE SUPPORT
;	    ET$IAS 001000 => TRY FOR INTERACTIVE SCOPE SUPPORT
;	    ET$CRT 000002 => TRY FOR SCOPE RUBOUT & CONTROL/U SUPPORT
;-

	ORG	TECOIO

.ASSUME	.	EQ	START-20
$$VT	==	.	;**INIT** TRUE SCOPE TYPE DETERMINATION CONTROL
	.WORD	0
	.WORD	0
	.BYTE	0,0
	.BYTE	0,0

.ASSUME	.	EQ	START-10
$$EU	==	.	;**INIT** INITIAL VALUE FOR "EU" FLAG
	.WORD	-1

.ASSUME	.	EQ	START-6
$$ED	==	.	;**INIT** INITIAL VALUE FOR "ED" FLAG
	.WORD	0

.ASSUME	.	EQ	START-4
$$ET	==	.	;**INIT** INITIAL VALUE FOR "ET" FLAG
	.WORD	ET$RFS!ET$IAS!ET$CRT
.SBTTL	ENTRY AND REENTRY POINTS

;+
; START-2 - REENTRY POINT.
; START - ENTRY POINT.
;-

.ASSUME	.	EQ	START-2
	TST	(PC)+		;REENTRY POINT, SET C=0
START::	SEC			;ENTRY POINT, SET C=1
	MOV	@#USERSP,SP	;RESET THE SP STACK
	ROR	-(SP)		;SAVE THE C-BIT INDICATION
	JMPX	INIT		;NOW GO INITIALIZE OURSELVES
.SBTTL	REGISTER SAVE/RESTORE

;+
; SAVREG - REGISTER SAVE/RESTORE.
;
;	CALL	SAVREG,R4
;	...
;	RETURN
;
;	SAVES/RESTORES R0, R1, R2, R3, R4; RE-LOADS CORRECT R5.
;	GUARENTEES C-BIT=0 ON EXIT.
;
;	R0OFF = OFFSET TO SAVED R0
;	R1OFF = OFFSET TO SAVED R1
;	R2OFF = OFFSET TO SAVED R2
;-

.ENABL	LSB

SAVREG::;MOV	R4,-(SP)	;R4 WAS SAVED BY THE 'JSR R4,'
	MOV	R3,-(SP)	;SAVE R3
	MOV	R1,-(SP)	; AND R1
	MOV	SP,SPSAVE(R5)	;SAVE SP STACK FOR ERROR RECOVERY
	MOV	R0,-(SP)	;SAVE R0
	MOV	R2,-(SP)	; AND R2
	MOV	R4,-(SP)	;STACK THE RETURN ADDRESS
	MOV	5*2(SP),R4	; THEN PUT THE REAL VALUE BACK
	CALL	@(SP)+		;CO-ROUTINE CALL BACK (C-BIT SAVED FROM CALL!)
	MOV	(SP)+,R2	;RESTORE R2
	MOV	(SP)+,R0	; AND R0
	CLC			;SET C=0 FOR GOODNESS
10$:	MOV	(SP)+,R1	;RESTORE R1
	MOV	(SP)+,R3	; AND R3
	MOV	(SP)+,R4	;  AND R4
	MOV	#0,R5		;RE-LOAD CORRECT R5
$$R5	==	.-2	;**INIT** CORRECT VALUE FOR R5 FILLED IN
	RETURN			; THEN REALLY EXIT

R0OFF	==	4		;OFFSET TO SAVED R0
R1OFF	==	6		;OFFSET TO SAVED R1
R2OFF	==	2		;OFFSET TO SAVED R2
.SBTTL	ERROR PROCESSING

;+
; ERR - ERROR PROCESSING.
;
;	CALL	ERR,R4,$$$$$$
;
;	$$$$$$:	.RAD50	/ERR/
;		.ASCIZ	/MESSAGE/
;
;	R0 -> .ASCIZ "MESSAGE"
;	R2 =  .RAD50 "ERR"
;	RESTORES R1, R3, R4; RE-LOADS CORRECT R5; SP STACK IS FLUSHED.
;	SETS C-BIT=1 ON EXIT (NO RETURN TO CALLER).
;-

ERR::	MOV	(R4)+,R2	;POINT TO: RAD50 CODE, ASCIZ TEXT
	MOV	(R2)+,R0	;SET THE RAD50 ERROR CODE
	MOV	SPSAVE(R5),SP	;FLUSH THE SP STACK
	SEC			;SET C=1 FOR BADNESS
	BR	10$		; AND GO EXIT

.DSABL	LSB
.SBTTL	TERMINAL OUTPUT

;+
; PRINTF - PRINT WITH CASE FLAGGING.
;
;	R3 -> CHARACTERS
;	R4 =  CHARACTER COUNT
;
;	CALL	PRINTF
;-

PRINTF::SAVREG			;SAVE ALL REGISTERS
	CALL	PRINTX,R2	;"PRINTF" USES "TYPEF"
	.BR	TYPEF		;SO GO DO IT

;+
; TYPEF - TYPE WITH CASE FLAGGING.
;
;	R0 =  CHARACTER
;
;	CALL	TYPEF
;-

.ENABL	LSB

TYPEF::	BIT	#ET$BIN,ETYPE(R5) ;BINARY MODE OUTPUT?
	BNE	100$		;YES, JUST DO IT
	TST	EUFLAG(R5)	;NO, WHAT KIND OF CASE FLAGGING
	BMI	30$		;NONE (<0)
	BEQ	10$		;FLAG LOWER (=0)
	CMP	R0,#'@		;FLAG UPPER (>0), IS IT UPPER CASE?
	BLO	30$		;NEVER
	CMP	R0,#'_		;MIGHT BE...
	BHI	30$		;BUT IT ISN'T
	BR	20$		;IT'S UPPER CASE, GO FLAG IT

10$:	CMP	R0,#'@+40	;FLAG LOWER (=0), IS IT LOWER CASE?
	BLT	30$		;NOPE
20$:	MOV	R0,-(SP)	;SAVE R0
	MOV	#130$,-(SP)	; AND SET THE RETURN ADDRESS
	CALL	120$,R4,<''>	;GO PREFIX WITH A "'"
	BR	100$		; THEN OUTPUT THE UPPER CASE EQUIVALENT

;+
; PRINTB - PRINT RINGING BELLS.
;
;	R3 -> CHARACTERS
;	R4 =  CHARACTER COUNT
;
;	CALL	PRINTB
;-

PRINTB::SAVREG			;SAVE ALL REGISTERS
	CALL	PRINTX,R2	;"PRINTB" USES "TYPEB"
	.BR	TYPEB		;SO GO DO IT

;+
; TYPEB - TYPE RINGING BELLS.
;
;	R0 =  CHARACTER
;
;	CALL	TYPEB
;-

TYPEB::	.CALLR	TYPEBF		;TYPE RINGING BELLS

;+
; TYPEBF - BUFFER A TYPED CHARACTER.
;
;	R0 =  CHARACTER
;
;	CALL	TYPEBF
;-

TYPEBF::BIT	#ET$BIN,ETYPE(R5) ;BINARY MODE OUTPUT?
	BNE	100$		;YES, JUST DO IT
	CMP	R0,#BEL		;NO, IS IT A BELL?
	BEQ	100$		;BELL'S GO OUT AS IS
30$:	MOV	R0,-(SP)	;SAVE R0
	MOV	#130$,-(SP)	; AND SET A RETURN ADDRESS
40$:	CMP	R0,#SPACE	;A NORMAL GRAPHIC?
	BHIS	100$		;YES
	CMP	R0,#CR		;CARRIAGE RETURN OR HIGHER?
	BHI	90$		;HIGHER
	BEQ	100$		;IT'S A CARRIAGE RETURN
	CMP	R0,#BEL		;BELL OR LOWER?
	BHI	70$		;HIGHER, IT'S BS, TAB, LF, VT, OR FF
	BLO	50$		;LOWER
	CALL	100$		;IT'S A BELL, GO RING THE BELL
50$:	TST	R0		;A NULL?
	BEQ	100$		;YES, LET THAT GO AS IS
60$:	CALL	120$,R4,<'^>	;GO PREFIX WITH AN "^"
	BR	100$		; THEN PRINT THE CONTROL AS A GRAPHIC

70$:	CMP	R0,#VT		;IS IT EITHER VT OR FF?
	BLO	100$		;NOPE, IT'S BS, TAB, OR LF
	BEQ	80$		;IT'S A VT, GO DO 2 LINE FEED'S
	MOV	PC,-(SP)	;IT'S A FF, SET TO DO 4 LINE FEED'S
80$:	MOV	PC,-(SP)	;SET TO DO 2 LINE FEED'S
	MOV	#LF,R0		;SET CHARACTER TO TYPE AS LINE FEED
	BR	100$		; AND GO DO IT

90$:	CMP	R0,#ESC		;IS IT AN ESCAPE?
	BNE	60$		;NO, GO PREFIX WITH "^"
	MOV	#'$,R0		;YES, USE "$"
100$:	BIT	#ET$CCO,ETYPE(R5) ;CANCEL CONTROL/O?
	BEQ	110$		;NO
	CALL	NOCCO		;YES, SO GO DO SO
110$:	.TTYOUT			;OUTPUT THE CHARACTER
	BIS	#2,OUTDNE(R5)	; AND INDICATE OUTPUT WAS DONE

;+
; TYPEBC - FORCE OUT BUFFERED OUTPUT.
;
;	CALL	TYPEBC
;-

TYPEBC::RETURN			;EXIT

120$:	MOV	R0,-(SP)	;SAVE ORIGINAL CHARACTER
	MOV	(R4)+,R0	;NOW GET THE PREFIX
	CALL	100$		; AND OUTPUT IT
	MOV	(SP)+,R0	;RESTORE ORIGINAL CHARACTER
	BIC	#40,R0		;ENSURE IT IS UPPER CASE
	BIS	#100,R0		; AND A NORMAL GRAPHIC
	RETURN	R4		;  THEN EXIT WITH IT

;+
; PRINT - PRINT CHARACTERS.
;
;	R3 -> CHARACTERS
;	R4 =  CHARACTER COUNT
;
;	CALL	PRINT
;-

PRINT::	SAVREG			;SAVE ALL REGISTERS
	CALL	PRINTX,R2	;"PRINT" USES "TYPE"
	.BR	TYPE		;SO GO DO IT

;+
; TYPE - TYPE A CHARACTER.
;
;	R0 =  CHARACTER
;
;	CALL	TYPE
;-

TYPE::	MOV	R0,-(SP)	;SAVE R0
	CALL	40$		;GO DO NORMAL MODE OUTPUT
130$:	MOV	(SP)+,R0	;RESTORE R0
	RETURN			; AND EXIT

.DSABL	LSB
.SBTTL	TERMINAL INPUT

;+
; TLISTN - TERMINAL INPUT FOR CONTROL/T.
;
;	CALL	TLISTN
;
;	R0 =  CHARACTER OR -1
;-

.ENABL	LSB

TLISTN::CALL	GETINP		;SET UP FOR GETTING TERMINAL INPUT
	BIT	#ET$CKE,ETYPE(R5) ;SET Z-BIT=0 IF NO INPUT WAIT DESIRED
	CALL	@(SP)+		;CALL BACK FOR THE REAL INPUT
	BCS	10$		;NOT A DOUBLE CTRL/C
	BIS	#100000,TFLG(R5) ;DOUBLE CTRL/C, SET THE "STOPON" FLAG BIT
10$:	BIT	#ET$NCH,ETYPE(R5) ;ARE WE ECHOING?
	BNE	30$		;NOPE, SO DON'T
20$:	CMP	R0,#DEL		;IS THE CHARACTER DELETE?
	BNE	TYPE		;NO, ECHO IT & EXIT
30$:	RETURN			;EXIT

;+
; LISTEN - TERMINAL INPUT.
;
;	CALL	LISTEN
;
;	R0 =  CHARACTER
;-

LISTEN::CALL	GETINP		;SET UP FOR GETTING TERMINAL INPUT
	CALL	@(SP)+		;NO FURTHER SET UP, JUST CALL BACK
	BCS	20$		;NOT A DOUBLE CTRL/C, GO ECHO & EXIT
	INCB	CTXFLG(R5)	;COUNT DOUBLE CTRL/C'S
	CMPB	CTXFLG(R5),#2	;DOUBLE-DOUBLE CTRL/C (^C^C^C^C)?
	BEQ	20$		;MIDDLE (^C^C^C), JUST ECHO IT
	BHI	TEXIT		;DOUBLE-DOUBLE (^C^C^C^C), EXIT FROM TECO
	JMPX	TECOCR		;INITIAL (^C^C), RETURN CARRIAGE & RE-START

.DSABL	LSB
.SBTTL	RANDOM ROUTINES

;+
; ALLERR - AN ERROR OCCURED.
;
;	CALL	ALLERR
;
;	EXITS IF "EXIT ON ERROR" (ET$XIT) IS ON IN "ET" (ETYPE).
;-

.ENABL	LSB

ALLERR::BIC	#ET$CC!ET$CKE!ET$CCO!ET$NCH!ET$BIN,ETYPE(R5) ;CLEAR SOME IN "ET"
	CALL	20$		;GO EAT ALL INPUT (ALSO EATS BATCH STREAMS!)
	TSTB	ETYPE(R5)	;ANY PROMPT YET?
	BPL	INDCLS		;YES, JUST CONTINUE
.ASSUME	ET$XIT	EQ	200
	CALL	@(SP)+		;NOPE, CO-ROUTINE RETURN
	CALLX	CRLFNO		;CANCEL ^O AND RESTORE CARRIAGE
	BR	TEXIT		; AND, THEN, EXIT

;+
; STOPON - THE STOP INDICATOR IS ON.
;
;	CALL	STOPON
;
;	RETURNS TO CALLER'S CALLER IF "TRAP CONTROL/C" (ET$CC) IS
;		ON IN "ET" (ETYPE).
;	ELSE EXITS IF "EXIT ON ERROR" (ET$XIT) IS ON IN "ET" (ETYPE).
;	ELSE JUST EXITS.
;-

STOPON::BIT	#ET$CC!ET$XIT,ETYPE(R5) ;CTRL/C TRAP OR EXIT ON ERROR?
	BMI	10$		;WE'RE CTRL/C TRAPPING
.ASSUME	ET$CC	EQ	100000
	BNE	TEXIT		;EXIT NOW IF SO INDICATED
	RETURN			;ELSE JUST EXIT

10$:	BIC	#ET$CC,ETYPE(R5) ;TURN OFF THE CTRL/C TRAPPING BIT NOW
	TST	(SP)+		; AND RETURN TO CALLER'S CALLER
20$:	MOV	R0,-(SP)	;SAVE R0
	BIS	#TTLC$!TTSPC$!TCBIT$,@#JSW ;TURN ON NO INPUT STALL MODE, ETC.
30$:	.TTINR			;EMPTY THE TYPEAHEAD BUFFER
	BCC	30$		; UNTIL WELL DONE...
	BIC	#TCBIT$,@#JSW	;ALL EMPTIED, ALLOW A STALL AGAIN
	BR	40$		;GO RESTORE R0 AND EXIT

;+
; XITNOW - ABOUT TO EXIT TECO, DE-CONDITION TERMINAL HANDLING.
;
;	CALL	XITNOW
;-

XITNOW::BIC	#TTLC$!TTSPC$!TCBIT$,@#JSW ;TURN OFF OUR "FUNNY" MODES
	.CALLR	NOCTLO		;CANCEL CONTROL/O & EXIT

;+
; NOCTLO - CANCEL CONTROL/O EFFECT AND CLOSE "FUNNY" INDIRECT COMMAND FILE.
; NOCCO - CANCEL CONTROL/O EFFECT.
;
;	CALL	NOCTLO
;	CALL	NOCCO
;-

NOCTLO::BIT	INDIR(R5),#1	;IS INDIRECT FILE IN "FUNNY" STATE?
	BEQ	NOCCO		;NO
	CLR	INDIR(R5)	;YES, SO REALLY "CLOSE" IT
NOCCO::	MOV	R0,-(SP)	;SAVE R0
	.RCTRLO			;NOW CANCEL THE CONTROL/O EFFECT
	BIC	#ET$CCO,ETYPE(R5) ; AND SAY WE DID IT
40$:	MOV	(SP)+,R0	;RESTORE R0
50$:	RETURN			;EXIT

INDCLS:	SAVREG			;SAVE REGISTERS, ETC.
	.CALLR	INDCL0		; AND GO CLOSE THE INDIRECT COMMAND FILE

;+
; INCDL0 - CLOSE INDIRECT COMMAND FILE.
;
;	CALL	INDCL0
;
;	R0 =  UNDEFINED
;	R3 =  UNDEFINED
;	R4 =  UNDEFINED
;-

INDCL0::MOV	INDIR(R5),R3	;GET INDIRECT PARAMETER POINTER
	CLR	INDIR(R5)	; THEN CLEAR OUT THE POINTER
	CMP	R3,#1		;IS THERE REALLY AN INDIRECT FILE?
	BLOS	50$		;NO, JUST EXIT
	TST	-(R3)		;YES, CORRECT TO POINT TO "SZ"
.ASSUME	SZ	EQ	CC-2
	CALLRX	PURGE		;GO CLOSE THE INDIRECT COMMAND FILE

.DSABL	LSB
.SBTTL	EXITS

;+
; GEXIT - EXIT AND GO -OR- SPECIAL FUNCTION CALL.
;
;	CALL	GEXIT
;-

.ENABL	LSB

10$:	BIS	#TTLC$!TTSPC$,@#JSW ;(RE-)ESTABLISH OUR "FUNNY" TERMINAL MODES
	CLR	N(R5)		;NO SPECIAL FUNCTIONS, SET RETURN OF 0
	RETURN			; AND EXIT

20$:	CLRB	(R0)+		;CHANGE ANY <LF> INTO A <NULL>
	BR	30$		; THEN CONTINUE...

GEXIT::	TST	NFLG(R5)	;REALLY A SPECIAL FUNCTION CALL?
	BMI	10$		;YES
	MOV	#512,R0		;NO, SET UP TO EXECUTE COMMAND
	MOV	R0,R1		;SAVE POINTER FOR LATER
	MOV	FILBUF(R5),R2	;POINT TO THE DESIRED COMMAND
30$:	MOVB	(R2)+,(R0)	;MOVE OVER A COMMAND STRING BYTE
	CMPB	(R0),#CR	;IS THIS A <CR>?
	BEQ	30$		;YEP, IGNORE IT...
	CMPB	(R0),#LF	;IS THIS A <LF>?
	BEQ	20$		;YEP, GO CHANGE IT INTO A <NULL>
	BICB	#^C<177>,(R0)+	;TRIM TO 7-BIT ASCII
	BNE	30$		; UNTIL THE ENDING NULL...
	SUB	R1,R0		;FIND SIZE OF COMMAND
	MOV	R0,-(R1)	; AND STORE IT @ 510
	BIS	#CMDEX$,@#JSW	;SET FLAG FOR MONITOR
	.BR	HEXIT		; AND GO DO A HARD EXIT

.DSABL	LSB

;+
; HEXIT - HARD EXIT.
; TEXIT - SOFT EXIT.
;
;	JMP	HEXIT
;	JMP	TEXIT
;-

HEXIT::	TST	(PC)+		;INDICATE HARD EXIT WITH C=0
TEXIT::	SEC			;INDICATE SOFT EXIT WITH C=1
	MOV	@#USERSP,SP	;RESET SP STACK
	BIC	-(SP),(SP)	;CLEAR A WORD ON THE STACK
	SBC	(SP)		;SET SOFT(-1) OR HARD(0) EXIT
	CALL	XITNOW		;DE-CONDITION ANYTHING FUNNY WE DID
	CLR	R0		;SET ARGUMENT TO SHUT OFF SCOPES
	MOV	#10000.,NWATCH(R5) ;ENSURE IT'S NOT THE DEFAULT VALUE
	CALL	WATCH		; AND GO DO IT
	MOV	(SP),R0		;GET THE SOFT/HARD EXIT FLAG
	BNE	10$		;IT'S SOFT
	.SETTOP			;IT'S HARD, DON'T TRY TO SWAP OUT MEMORY
10$:	MOV	(SP)+,R0	;SET SOFT(-1) OR HARD(0) EXIT
	.EXIT			; AND EXIT...
.SBTTL	SIMPLE VALUE RETURNING ROUTINES

;+
; DATE - GET DATE.
;
;	CALL	DATE
;
;	R0 =  DATE
;-

DATE::	.DATE			;FETCH THE DATE
$$RTSP	==	.	;**INIT** LOCATION OF A SIMPLE 'RTS PC'
	RETURN			; AND EXIT WITH IT

;+
; SWITCH - GET SWITCHES.
;
;	CALL	SWITCH
;
;	R0 =  SWITCHES
;-

$$SWR	==	.	;**INIT** 'CLR R0'; 'RTS PC' IF NO SWITCH REGISTER
SWITCH::MOV	#10$,R0		;POINT TO THE MONITOR CALL BLOCK
	.GVAL			;GET THE SWITCH VALUE
	RETURN			; AND EXIT WITH IT

10$:	.BYTE	0,34		;MONITOR CALL BLOCK FOR .GVAL
$$SWRO	==	.	;**INIT** RMON BIAS SUBTRACTED FROM ACTUAL VALUE
	.WORD	177570		; OF THE SWITCH REGISTER

;+
; TIMDIV - HERTZ DIVISORS FOR TIME REQUEST.
;-

$$TIMD	==	.	;**INIT** 50HZ DIVISORS FILLED IN IF NEEDED
TIMDIV::.WORD	60.*2/4, 60.*2*512. ;60HZ DIVISORS
.SBTTL	EB, EI, EN, ER, AND EW

;+
; GETFLS - GET FILES.
;
;	R2 =  'B-'R FOR "EB"
;	      'I-'R FOR "EI"
;	      'N-'R FOR "EN"
;	      'R-'R FOR "ER"
;	      'W-'R FOR "EW"
;
;	CALL	GETFLS
;-

GETFLS::CMP	R2,#'N-'R	;IS IT "EN"?
	BEQ	10$		;YES
	CALLRX	OPEN		;NO, IT'S AN OPEN OF SOME SORT

10$:	CALLRX	WILD		;GO OFF TO THE WILD CODE...
.SBTTL	PRINT SUBROUTINES

;+
; PRINTS - PRINT A STRING & EXIT.
;
;	SP -> RETURN ADDRESS
;
;	CALL	PRINTS,R2,<STRING>
;
; STRING: .ASCII <LENGTH>"TEXT"
;
;	R0 =  UNDEFINED
;	R3 =  UNDEFINED
;	R4 =  UNDEFINED
;-

PRINTS::MOV	(R2)+,R3	;GET POINTER TO LENGTH, MESSAGE TEXT
	MOVB	(R3)+,R4	;NOW GET THE TEXT'S LENGTH, POINT TO TEXT
	MOV	#TYPE,R2	;WE'LL USE "TYPE" FOR THE ACTUAL OUTPUT
PRINTX:	TST	TFLG(R5)	;IS THE "STOPON" FLAG ON?
	BPL	10$		;NOPE
	TST	ETYPE(R5)	;YEP, BUT WE TRAPPING CONTROL/C'S?
	BPL	20$		;NOT TRAPPING, TAKE AN EARLY EXIT
.ASSUME	ET$CC	EQ	100000
10$:	DEC	R4		;MORE TO GO?
	BMI	20$		;NO, DONE
	MOVB	(R3)+,R0	;YES, GET NEXT CHARACTER
	CALL	(R2)		; AND GO OUTPUT IT
	BR	PRINTX		;  THEN LOOP...

20$:	MOV	(SP)+,R2	;RESTORE THE SAVED R2 (FROM 'JSR R2,')
	RETURN			; AND EXIT
.SBTTL	FLAG HANDLING

;+
; FLAGRW - HANDLE FLAG CHANGES.
;
;	R0 =  N OF "NEJ" (IF R2=0)
;	      NEW FLAG VALUE (IF R2<>0 AND R3=-1)
;	R2 =  0 FOR "EJ"
;	      FLAG R5 OFFSET FOR OTHER FLAGS
;	R3 =  -1 FOR FLAG MODIFICATION (IF R2<>0)
;	   <> -1 FOR FLAG READ (IF R2<>0)
;
;	CALL	FLAGRW
;
;	R0 =  REAL NEW FLAG VALUE (IF R2=0 OR (R2<>0 AND R3=-1))
;-

FLAGRW::TST	R2		;"EJ"?
	BNE	20$		;NOPE
	CLR	-(SP)		;YEP, GUESS AT A RETURNED ZERO
	TST	R0		;WHAT "EJ" IS IT?
	BPL	10$		;ALL BUT "-1EJ" RETURN A ZERO...
	MOV	#7,(SP)		;"-1EJ" RETURNS 7 (FOR RT-11)
10$:	MOV	(SP)+,R0	;SET THE RETURNED VALUE
	RETURN			; AND EXIT

20$:	CMP	R2,#ETYPE	;"ET"?
	BNE	30$		;NOPE
	CMP	R3,#-1		;YEP, MODIFYING IT?
	BNE	30$		;NO AGAIN
	MOV	ETYPE(R5),-(SP)	;GET OLD "ET"
	BIC	#^C<ET$RFS!ET$IAS!ET$DET>,(SP) ;ISOLATE READ-ONLY BITS
	BIC	#ET$RFS!ET$IAS!ET$DET,R0 ;TRIM THOSE FROM CALLER'S VALUE
	BIS	(SP)+,R0	;ENSURE A CORRECT VALUE
30$:	RETURN			;EXIT
.SBTTL	TERMINAL INPUT SUBROUTINE

.ENABL	LSB

10$:	MOVB	NC-CC(R0),-(SP)	;SAVE THE PRE-FETCHED CHARACTER
	MOV	R3,-(SP)	;SAVE R3
	MOV	R0,R3		;COPY POINTER TO CURRENT COUNT
	CALL	GETBYT		; THEN GET THE NEXT CHARACTER
	BNE	20$		;REAL DATA OBTAINED
	CALL	INDCLS		;ELSE GO CLOSE THE INDIRECT COMMAND FILE
	INC	INDIR(R5)	; AND MARK IT AS "FUNNY"
	CLR	R0		;SAY NO PRE-FETCHED CHARACTER
20$:	MOVB	R0,NC-CC(R3)	;SAVE CHARACTER FOR LATER
	MOV	(SP)+,R3	;RESTORE R3
	MOVB	(SP)+,R0	;RESTORE PRE-FETCHED CHARACTER
	BNE	90$		;GOT SOMETHING, EXIT WITH IT
GETINP:	MOV	INDIR(R5),R0	;GET INDIRECT COMMAND FILE POINTER
	CMP	R0,#1		;REALLY AN INDIRECT COMMAND FILE ACTIVE?
	BHI	10$		;YES, GO USE IT
	MOV	#JSW,R0		;GET A HANDY JOB STATUS WORD POINTER
	BIS	#TTLC$!TTSPC$,(R0) ;ENSURE SPECIAL TERMINAL INPUT MODE, ETC.
	BIC	#TCBIT$,(R0)	;ASSUME INPUT STALL
	CLR	INDIR(R5)	;ENSURE INDIRECT FILES ARE SHUT OFF
	;SEZ			;Z-BIT=1 FROM 'CLR' ABOVE
	CALL	@(SP)+		;CALL BACK FOR ANY FURTHER PROCESSING...
	BEQ	30$		;NORMAL, STALL MODE, INPUT DESIRED
	BIS	#TCBIT$,(R0)	;NO STALL MODE, SO SAY SO
30$:	.TTINR			;READ FROM THE TERMINAL
	BIC	#^C<177>,R0	;GET RID OF ANY PARITY BIT
	BLOS	80$		;BRANCH IF NO INPUT (C=1) OR NULL (Z=1)
	BIT	#ET$LC,ETYPE(R5) ;IS LOWER CASE ENABLED?
	BNE	50$		;YES, DON'T CONVERT LOWER CASE OR OLD ALTMODES
	CMP	R0,#'A+40	;NO, POSSIBLE LOWER CASE?
	BLO	50$		;NOPE
	CMP	R0,#'Z+40	;IS IT A LOWER CASE ALPHABETIC?
	BLOS	40$		;YEP, GO CONVERT IT INTO UPPER CASE
	CMP	R0,#175		;OLD STYLE ALTMODE?
	BLO	50$		;NOPE
	CMP	R0,#176		;MIGHT BE...
	BHI	50$		;BUT IT ISN'T
	MOV	#ESC,R0		;CONVERT OLD ALTMODES TO ESCAPES
40$:	BIC	#40,R0		;CONVERT LOWER CASE INTO UPPER CASE
50$:	CMP	R0,#'C-100	;IS THIS A CTRL/C?
	BNE	60$		;NOPE
	CMPB	R0,LSTCHR(R5)	;YEP, IS IT A DOUBLE CTRL/C?
	BEQ	70$		;DOUBLE CTRL/C EXITS WITH C-BIT=0 (FROM 'BEQ')
60$:	MOV	R0,LSTCHR(R5)	;ELSE SAVE NEW LAST CHARACTER, CLEAR EXIT FLAG
.ASSUME	CTXFLG	EQ	LSTCHR+1
	SEC			; AND SET C-BIT=1
70$:	BIC	#TCBIT$,@#JSW	;TURN OFF NO STALL MODE
	RETURN			;EXIT WITH C-BIT=1 IF NOT DOUBLE CTRL/C

80$:	BCC	30$		;LOOP BACK FOR MORE IF INPUT OBTAINED (A NULL)
	BIT	#TCBIT$,@#JSW	;WAS THIS A NO STALL CALL?
	BEQ	30$		;NOPE, GO WAIT FOR A CHARACTER
	MOV	#-1,R0		;YEP, SET RETURN VALUE TO -1
90$:	TST	(SP)+		;POP THE INTERMEDIATE RETURN
	BR	60$		;GO EXIT ENSURING C-BIT=1 AND EXIT FLAG CLEAR

.DSABL	LSB
.SBTTL	FILE OUTPUT

;+
; PUTBUF - FILE OUTPUT.
;
;	R0 -> CHARACTERS
;	R1 =  CHARACTER COUNT
;	R2 =  -1 => APPEND <FF> TO OUTPUT
;	   <> -1 => DON'T
;
;	CALL	PUTBUF
;-

.ENABL	LSB

10$:	ERR	NFO,<"No file for output">

PUTBUF::SAVREG			;SAVE ALL REGISTERS
	MOV	OUPNTR(R5),R3	;GET THE OUTPUT PARAMETERS (->SZ)
	TST	(R3)+		;IS OUTPUT FILE OPEN (SZ<>0)?
	BEQ	10$		;NOPE
	MOV	R1,R4		;YEP, COPY NUMBER OF CHARACTERS TO GO
	SUB	R2,R4		; ADDING IN THE FORM FEED IF SPECIFIED
	SUB	(R3),R4		;  TAKING AWAY CURRENT FREE SPACE
.ASSUME	CC	EQ	SZ+2
	BLO	20$		;UNDERFLOW, ALWAYS WILL BE O.K.
	CLRB	R4		;ELSE DO QUICK DIVIDE
	SWAB	R4		; BY 256.
	ASR	R4		;  THEN BY 512. (CHARACTERS/BLOCK)
	INC	R4		;BE SAFE, ADD IN ONE MORE BLOCK
	ADD	BK-CC(R3),R4	;ADD IN WHERE WE CURRENTLY ARE
	CMP	R4,SZ-CC(R3)	;WOULD WE OVERFLOW?
	BHI	90$		;YES, GIVE AN ERROR INSTEAD
20$:	MOV	R0,R4		;MOVE CHARACTER POINTER TO BETTER SPOT
30$:	DEC	R1		;MORE TO GO?
	BMI	40$		;NO, CHECK FOR <FF> TO OUTPUT
	MOVB	(R4)+,R2	;YES, GET A CHARACTER
	CALL	PUTBYT		; AND GO BUFFER IT
	BR	30$		;  THEN LOOP FOR MORE...

40$:	TST	R2OFF(SP)	;OUTPUT A <FF>?
	BEQ	60$		;NOPE, GO EXIT
	MOV	#FF,R2		;YES, SO SET FOR A <FF>
	.CALLR	PUTBYT		; AND GO OUTPUT IT & EXIT
.SBTTL	PUT A BYTE SUBROUTINE

;+
; PUTBYT - OUTPUT A BYTE.
;
;	R2 =  BYTE
;	R3 -> I/O PARAMETER BLOCK @ CC
;
;	CALL	PUTBYT
;
;	R0 =  UNDEFINED
;-

PUTBYT::TST	(R3)+		;ANY ROOM LEFT IN BUFFER (CC<>0)?
	BNE	50$		;YES
	CALL	70$		;NO, PUT OUT THE BUFFER
	MOV	RP-CP(R3),(R3)	;SET CURRENT POINTER TO RESET POINTER
.ASSUME	CP	EQ	CC+2
	MOV	#512.,CC-CP(R3)	; AND RESET CURRENT COUNT
50$:	MOVB	R2,@(R3)+	;STORE INTO THE BUFFER
	INC	-(R3)		;BUMP THE CURRENT POINTER
	DEC	-(R3)		; AND DECREMENT THE CURRENT COUNT
60$:	RETURN			;NOW EXIT

70$:	TST	(R3)		;IS THIS THE FIRST TIME (CP=0)?
	BEQ	60$		;YES, JUST EXIT
	MOV	R3,R0		;NO, COPY POINTER TO CURRENT POINTER
	CMP	(R0)+,-(R3)	;POINT TO I/O LIST AND BACK TO CURRENT COUNT
.ASSUME	CH	EQ	CP+2
.ASSUME	CC	EQ	CP-2
	.WRITC			;DO THE WRITE
	BCS	80$		;WHOOPS, SOME ERROR
	INC	BK-CC(R3)	;ADVANCE THE BLOCK NUMBER
	CLR	(R3)+		;NOW CURRENT COUNT AND
	CLR	(R3)		; CURRENT POINTER GET CLEARED
	RETURN			;EXIT

80$:	TSTB	@#ERRBYT	;WHAT KIND OF ERROR?
	BNE	100$		;HARDWARE ERROR
				;FULL? SHOULDN'T HAPPEN...
90$:	ERR	FUL,<"Output file full">

100$:	ERR	OUT,<"Output error">

.DSABL	LSB
.SBTTL	FILE INPUT

;+
; GETBUF - FILE INPUT.
;
;	R0 -> CHARACTER STORE LOCATION
;	R1 =  SPACE AVAILABLE TO STORE
;	R2 =  STORE LIMIT
;
;	CALL	GETBUF
;-

.ENABL	LSB

10$:	ERR	INP,<"Input error">

20$:	ERR	NFI,<"No file for input">

30$:	TST	R0		;END-OF-FILE(0) OR INPUT ERROR(<>0)?
	BNE	10$		;A REAL INPUT ERROR
	INCB	FG-CC(R3)	;EOF, SET END-OF-FILE FLAG
.ASSUME	ATEOF	EQ	1
40$:	COM	EOFLAG(R5)	;SET END-OF-FILE FLAG FOR "TECO"
	RETURN			; AND EXIT

GETBUF::SAVREG			;SAVE ALL REGISTERS
	MOV	INPNTR(R5),R3	;GET INPUT PARAMETERS POINTER (->SZ)
	MOV	R0,R2		;MOVE BUFFER POINTER TO BETTER SPOT
	CLR	FFFLAG(R5)	;PRE-CLEAR THE FORM FEED FLAG
	CLR	EOFLAG(R5)	;PRE-CLEAR THE EOF FLAG
	TST	(R3)+		;IS THIS INPUT FILE OPEN (SZ<>0)?
	BEQ	20$		;NOPE
	BITB	#ATEOF,FG-CC(R3) ;ARE WE ALREADY AT END-OF-FILE?
.ASSUME	CC	EQ	SZ+2
	BNE	40$		;AT EOF, RETURN SUCH
50$:	DEC	R1		;MORE ROOM IN "TECO"S BUFFER?
	BLE	80$		;NO, GO EXIT
60$:	CALL	GETBYT		;ROOM EXISTS, GET A BYTE
	BEQ	30$		;EOF OR ERROR
	CMP	R0,#DEL		;A DELETE?
	BEQ	60$		;YES, IGNORE IT
	CMP	R0,#FF		;FORM FEED?
	BEQ	90$		;YES, ALL DONE
	MOVB	R0,(R2)+	;ELSE STORE DATA FOR "TECO"
	INC	ZZ(R5)		; AND COUNT IT AS STORED
	CMP	R0,#LF		;DID WE STORE A <LF>?
	BNE	70$		;NO
	CMP	R1,R2OFF(SP)	;LESS THAN DESIRED FREE LEFT NOW?
	BLT	80$		;YES, GO EXIT
70$:	CMP	R1,#128.	;UP TO ALMOST FULL NOW?
	BGT	50$		;IF >128. THEN CONTINUE
80$:	RETURN			;EXIT

90$:	COM	FFFLAG(R5)	;INDICATE A <FF> FOUND
	RETURN			; THEN EXIT

.DSABL	LSB
.SBTTL	GET A BYTE SUBROUTINE

;+
; GETBYT - GET A BYTE.
;
;	R3 -> I/O PARAMETER BLOCK @ CC
;
;	CALL	GETBYT
;
;	R0 =  CHARACTER
;
;	IF Z-BIT=0 ('BNE') THEN CHARACTER OBTAINED
;	IF Z-BIT=1 ('BEQ') THEN
;		R0 = 0 => END-OF-FILE
;		   <>0 => INPUT ERROR
;-

.ENABL	LSB

10$:	INC	BK-CC(R3)	;ADVANCE THE BLOCK NUMBER
	ASL	R0		;MAKE RETURNED WORD COUNT INTO BYTE COUNT
	MOV	R0,(R3)+	;SET CURRENT COUNT TO WHATEVER
	MOV	RP-CP(R3),(R3)	; AND RESET THE CURRENT POINTER
20$:	MOVB	@(R3)+,R0	;PICKUP A CHARACTER
	INC	-(R3)		;BUMP THE CURRENT POINTER
	DEC	-(R3)		; AND DECREMENT THE CURRENT COUNT
	BIC	#^C<177>,R0	;TRIM TO 7-BIT ASCII
	BNE	40$		;REAL DATA, GO EXIT Z-BIT=0
GETBYT:	TST	(R3)+		;IS THERE DATA IN BUFFER (CC<>0)?
	BNE	20$		;YES, GO GET IT
	MOV	R3,R0		;COPY POINTER TO CURRENT POINTER
.ASSUME	CP	EQ	CC+2
	CMP	(R0)+,-(R3)	;POINT TO I/O LIST & BACK TO CURRENT COUNT
.ASSUME	CH	EQ	CP+2
	.READC			;DO THE READ
	BCC	10$		;NO ERROR
30$:	MOVB	@#ERRBYT,R0	;GET THE KIND OF ERROR (0 => EOF)
	SEZ			; AND ENSURE Z-BIT=1, R0=0 IF EOF
40$:	RETURN			;EXIT, Z=0=>REAL DATA, Z=1=>EOF OR ERROR

.DSABL	LSB
.SBTTL	GET MORE MEMORY

;+
; SIZER - GET MORE MEMORY IF POSSIBLE.
;
;	R1 =  DESIRED SIZE OF NEW MEMORY
;
;	CALL	SIZER
;
;	IF C=0 ('BCC') THEN MEMORY OBTAINED
;	IF C=1 ('BCS') THEN NO MORE MEMORY AVAILABLE
;-

.ENABL	LSB

SIZER::	MOV	R0,-(SP)	;SAVE R0
	MOV	R4,-(SP)	; AND R4
	MOV	@#USERTOP,R4	;GET CURRENT TOP
	.SETTOP	#-2		;ASK FOR AS MUCH AS POSSIBLE
	SUB	R4,R0		;FIND HOW MUCH WE OBTAINED
	CMP	R0,R1		;IS IT ENOUGH FOR THIS REQUEST?
	BLO	30$		;NOPE
	TST	(R4)+		;YEP, ADVANCE TO JUST BEYOND OLD TOP
	CALL	BUFDAL		; AND GO SHUFFLE THOSE I/O BUFFERS
	TSTB	ETYPE(R5)	;SHOULD WE BE DOING ANNOUNCEMENTS?
	BMI	10$		;NOPE, SO DON'T
.ASSUME	ET$XIT	EQ	200
	MOV	R3,-(SP)	;SAVE R3
	CALL	40$		;TELL USER ABOUT NEW, SWAPPING USR
	BIS	#1,OUTDNE(R5)	; AND SAY WE DID IT
	MOV	(SP)+,R3	;RESTORE R3
10$:	CLC			;SET C=0 FOR EXIT
20$:	MOV	(SP)+,R4	;RESTORE R4
	MOV	(SP)+,R0	; AND R0
	RETURN			;  THEN EXIT

30$:	.SETTOP	R4		;SET TOP BACK TO WHERE IT WAS
	SEC			;SET C=1 FOR EXIT
	BR	20$		; AND GO EXIT

40$:	PRINTS	<"[Swapping USR]"<CR><LF>>

.DSABL	LSB
.SBTTL	DEALLOCATE AN I/O BUFFER

;+
; BUFDAL - DEALLOCATE AN I/O BUFFER.
;
;	R0 =  SIZE OF BUFFER BEING DEALLOCATED
;	R4 -> BUFFER BEING DEALLOCATED
;
;	CALL	BUFDAL
;
;	R0 =  UNDEFINED
;	R4 =  UNDEFINED
;-

BUFDAL::MOV	R0,-(SP)	;SAVE SIZE OF BUFFER BEING DEALLOCATED
	MOV	#CMDPRM+RP,R0	;GET POINTER TO OTHER PARAMETER BLOCKS
	ADD	R5,R0		; AND MAKE IT ABSOLUTE
10$:	TST	(R0)		;ANY I/O BUFFER HERE?
	BEQ	20$		;NOPE
	CMP	(R0),R4		;YEP, IS IT BELOW THE REMOVED I/O BUFFER?
	BHIS	20$		;NOPE AGAIN
	ADD	(SP),(R0)	;YEP, SO MOVE THE POINTER UP
	TST	CP-RP(R0)	;ANY ACTIVE POINTER?
	BEQ	20$		;NO
	ADD	(SP),CP-RP(R0)	;YES, CORRECT THAT ALSO
20$:	ADD	#PARMSZ,R0	;MOVE UP TO NEXT PARAMETER BLOCK
.ASSUME	INPNOR+RP EQ	CMDPRM+RP+PARMSZ
.ASSUME	INPALT+RP EQ	INPNOR+RP+PARMSZ
.ASSUME	OUPNOR+RP EQ	INPALT+RP+PARMSZ
.ASSUME	OUPALT+RP EQ	OUPNOR+RP+PARMSZ
	CMP	R0,R5		;TOO FAR?
	BLO	10$		;NOPE, KEEP GOING...
.ASSUME	OUPALT+RP+PARMSZ GE 0
	MOV	R4,R0		;COPY POINTER TO OLD BUFFER'S START
	ADD	(SP),R0		; AND FORM POINTER JUST BEYOND THAT BUFFER
	MOV	R1,-(SP)	;SAVE R1
	MOV	QRSTOR(R5),R1	;GET START OF Q-REGS
	ADD	QMAX(R5),R1	; THEN SKIP THEM
	ADD	CURFRE(R5),R1	;  THEN SKIP TO START OF OUR I/O BUFFERS
	BR	40$		;ENTER MOVE LOOP

30$:	MOV	-(R4),-(R0)	;MOVE UP A WORD OF DATA
40$:	CMP	R4,R1		;DONE?
	BHI	30$		;NOT YET, LOOP...
	MOV	(SP)+,R1	;RESTORE R1
	ADD	(SP)+,CURFRE(R5) ;GIVE BACK I/O BUFFER AS FREE SPACE
	RETURN			;EXIT
.SBTTL	SCOPE WATCH

;+
; WATCH - SCOPE WATCH.
;
;	R0 =  CALL PARAMETER
;
;	CALL	WATCH
;
;	R0 =  RETURN PARAMETER
;-

WATCH::	JSR	PC,@(PC)+	;DO REFRESH SCOPE FIRST
$$RFSC	==	.	;**INIT** CHANGED TO CALL REFRESH SCOPE IF ACTIVE
	 .WORD	$$RTSP		;INITIALLY ADDRESS OF A SIMPLE 'RTS PC'
	CALLR	SCREEN		;DO INTERACTIVE SCOPE NEXT & EXIT

.PSECT	SCRCTL,RO,D,GBL,REL,OVR
	DEFORG	SCRCTL

.ASSUME	.	EQ	SCRCTL
$$DVEC	==	.	;**INIT** DPU'S VECTOR ADDRESS FILLED IN HERE...
DPCVEC:	.BLKW			;DPU'S VECTOR ADDRESS
.ASSUME	.	EQ	SCRCTL+2
DPCADR:				;DPU'S CSR ADDRESS

.GLOBL	SCPLOD			;MAKE "SCPLOD" REFERENCES AUTO-LOAD VECTORS

.PSECT	SCREEN,RO,I,GBL,REL,OVR
	DEFORG	SCREEN

SCREEN:	RETURN			;NOTHING'S HERE YET...

.GLOBL	SCRLOD			;MAKE "SCRLOD" REFERENCES AUTO-LOAD VECTORS
.SBTTL	FETCH A DEVICE HANDLER

;+
; FETCH - FETCH DEVICE HANDLER.
;
;	R1 -> DEVICE NAME (RAD50)
;	R4 -> INFORMATION RETURNED BY .DSTAT
;
;	CALL	FETCH
;
;	R0 =  UNDEFINED
;	R4 =  UNDEFINED
;
;	IF C=0 ('BCC') THEN HANDLER FETCHED
;	IF C=1 ('BCS') THEN SOME ERROR FETCHING HANDLER
;-

.PSECT	TIOFET,RO,I,GBL,REL,OVR
	DEFORG	TIOFET

$$FET	==	.	;**INIT** ENSURED TO BE 'SEC; RTS PC' IF FOREGROUND
.ASSUME	.	EQ	TIOFET
FETCH::	SEC			;INDICATE AN ERROR
	RETURN			; AND EXIT
.SBTTL	CHARACTER/LINE DELETION ECHOING

;+
; DELLIN - ECHO THE DELETION OF A LINE.
;
;	CALL	DELLIN
;
;	R0, R1, R2, R3, R4 UNDEFINED
;-

.PSECT	TIOIAS,RO,I,GBL,REL,OVR
	DEFORG	TIOIAS

$$DELN	==	.	;**INIT** 'JMP @#CRLF' IF VT11/VS60 SCROLLER
.ASSUME	.	EQ	TIOIAS
DELLIN::CALLRX	CRLF		;ECHO <CR><LF> AFTER THE CONTROL/U

;+
; DELCHR - ECHO THE DELETION OF A CHARACTER.
;
;	R0 =  CHARACTER DELETED
;
;	CALL	DELCHR
;
;	R0, R1, R2, R3, R4 UNDEFINED
;-

.ASSUME	.	EQ	TIOIAS+4
DELCHR::CALLR	TYPE		;ECHO THE CHARACTER DELETED

.PSECT	CRTRUB,RO,I,GBL,REL,OVR
	DEFORG	CRTRUB

$$CRTS	==	.	;**INIT** NOT 'CLR R4' IF SCOPE RUBOUT SEQUENCES
CRTRUB:	CLR	R4		;NO "WATCH" READ/WRITE REGION
	RETURN			; AND EXIT

$$CUPS	==	CRTRUB+2 ;**INIT** CURSOR UP CHANGED IF VT11/VS60 SCROLLER
$$ERLS	==	CRTRUB+12 ;**INIT** ERASE LINE CHANGED IF VT11/VS60 SCROLLER

.END	START