.Title	TRAP
.IDENT	/V01.05/
.ENABL	LC
;TRAP.MAC - Routines to set/remove trap on Control C
;
;		IF (ITRAP()) GOTO xxx	- Sets trap
;	where:
;
;		xxx =	Line Number to trap to on Control C
;
;		CALL UNTRAP() 		- Removes trap
;
; T. Miles, 04-Sep-1982
;  TRIUMF
;   4004 Wesbrook Mall
;    Vancouver, B.C.
;     CANADA, V6T 1W5
;
.MCALL	ASTX$S,QIO$S
;
; Define Stack Structure at AST time
;
C.HAR	=.-.		; Unsolicited Character
D.SW	=C.HAR+2	; Saved DSW
P.C	=D.SW+2		; Saved PC
;
; Define offset of interest in FORTRAN work area
;
FILPTR	=30		; Address of active FFDB 
;
; The following LUN should be assigned to device TI:  This is the default.
;
TILUN	=5		; Lun for Console Device
;
.PSECT	TRAP,I,RW,LCL,CON
;
ITRAP::	CALL	UNTRAP		; Remove any previous trap
	CALL	TRAP		; Insert Trap - call user back as co-routine
	CALL	UNTRAP		; Remove Trap
	RTS	PC		; Return to Caller's Caller
;
UNTRAP::TST	SAVESP		; Trap active?
	BNE	.+4		;
	RTS	PC		;
;
	MOV	R0,SAVER0	; Save R0
	MOV	SAVESP,R0	; R0 --> Previous Frame
;
10$:	CMP	R0,SP		; Finished squeeze?
	BEQ	20$		;
	MOV	-2(R0),(R0)	;  ...no, squeeze next frame
	TST	-(R0)		;  ...and bubble up
	BR	10$
;
20$:	TST	(SP)+		; Pop excess frame
	QIO$S	#IO.DET,#TILUN	;  ...blow trap away
	MOV	SAVER0,R0	;  ...restore R0
	CLR	SAVESP		;  ...indicate trap gone
	RTS	PC		;  ...and return to caller
;
TRAP:	MOV	2(SP),SAVEPC	; SAVEPC --> User's frame
	MOV	(SP),2(SP)	;  ...now returns to ITRAP subroutine
	TST	(SP)+		;  ...pop stack frame
	MOV	SP,SAVESP	;  ...and save SP
	QIO$S 	#IO.ATA,#TILUN,,,,,#CHAR
	CLR	R0		;  ...not trapped
	MOV	SAVEPC,PC	; Call user back
;
CHAR:	BIC	#^C177,C.HAR(SP); Remove extraneous bits from CHAR
	CMPB	#3,C.HAR(SP)	;  ...was it a Control C?
	BNE	.+10		;
	MOV	#10$,P.C(SP)	;  ...yes, lose AST status
	TST	(SP)+		;  ...remove unsolicited character
	ASTX$S			;  ...and return from AST
10$:	MOV	@#$OTSV,R0	;  ...R0 --> Fortran work area
	CLR	FILPTR(R0)	;  ...make FORTRAN think I/O completed
	MOV	SAVESP,R0	;  ...save a copy
	CALL	UNTRAP		;  ...remove TRAP
	MOV	R0,SP		;  ...restore SP
	MOV	SAVEPC,(SP)	;  ...and Caller's frame
	BIS	#-1,R0		;  ...indicate Trap
	RTS	PC		;  ...back to Caller
;
SAVER0:	.WORD	0		; Saved R0
SAVESP:	.WORD	0		; Saved SP
SAVEPC:	.WORD	0		; Saved PC
;
.END