; DECUS.MAR  This file contains source code for macro routines which came
;            from previous DECUS releases.


.TITLE	TRAP
.IDENT	/X02.09/
.ENABL	DBG
;TRAP.MAR - Programme to intercept errors and ^C from FORTRAN routines
;
;	CALL T$RAP(&line #)	! Cancels previous T$RAP (if any)
;				! and transfers control to Line #
;				! in the event of an error.
;				! Error message is printed on SYS$ERROR
;				!
;				! Trap is automatically removed
;				! when a RETURN statement is executed
;
; Alternate entry
;
;	CALL T$RAP(&line #,IERR)! Returns cause of TRAP in the
;				! associated INTEGER *4 variable IERR
;				! No error message is printed
;
; To cancel existing T$RAP
;
;	CALL UNT$RAP()		! Removes previous T$RAP (if any)
;
; T. Miles, TRIUMF
;	This version was created 02-Mar-1982
;

; Define fields in Call Frame

$SFDEF

; Define fields in Condition Handler

$CHFDEF

; Define AST Argument List

AST$B_ARG	=.-.		; Argument Counter
AST$L_PRM	=AST$B_ARG+4	; AST Parameter
AST$L_R0	=AST$L_PRM+4	; Saved R0
AST$L_R1	=AST$L_R0+4	; Saved R1
AST$L_PC	=AST$L_R1+4	; Saved PC
AST$L_PSL	=AST$L_PC+4	; Saved PSL

; Code follows...

.PSECT	T$RAP,NOWRT,EXE,LONG

.ENTRY	UNT$RAP,^M<IV,R11>	; Subroutine to Disable Trap
	JSB	UNTRAP_C	; Undo   ^C  trap (if any)
	JSB	UNTRAP_ERROR	; Undo error trap (if any)
	MOVZWL	#SS$_NORMAL,R0	; Return with Status OK
	RET

.ENTRY	T$RAP,^M<IV,R11>	; Subroutine to Enable Trap
	JSB	UNTRAP_C	; Undo   ^C  trap (if any)
	JSB	UNTRAP_ERROR	; Undo error trap (if any)
	JSB	SAVE_RG		; Save FP, caller's PC
	JSB	SET_STATUS	; Set up error return status
	JSB	TRAP_ERROR	; Trap errors
	JSB	TRAP_C		; Trap ^C
	JSB	CALL_CALLER	; Call caller back as co-routine
	JSB	UNTRAP_C	; Remove ^C  trap
	CLRL	SAVE_FP		; Indicate no error trap
	RET			; Return to caller's caller

; The following routine removes any ^C trap by deassigning the channel

UNTRAP_C:
	MOVL	R0,-(SP)	; Save all registers...
	MOVL	R1,-(SP)	;
	$DASSGN_S	CHAN=CHAN
	MOVL	(SP)+,R1	;  ...ignore errors
	MOVL	(SP)+,R0	;
	CLRL	CHAN		; Invalidate the channel
	RSB

; This routine removes any error trap by clearing the Condition Handler

UNTRAP_ERROR:
	MOVL	SAVE_FP,R0	; R0 --> Frame of current T$RAP
	BEQL	30$		;   (None - no T$RAP active)
	MOVL	FP,R1		; R1 --> Current Frame
10$:	CMPL	SF$L_SAVE_FP(R1),R0
	BEQL	20$		; R1 --> Frame before Saved Frame
	MOVL	SF$L_SAVE_FP(R1),R1
	BRW	10$
20$:	MOVL	SF$L_SAVE_FP(R0),-
		SF$L_SAVE_FP(R1); Delete Saved Frame (with Error Trap)
	CLRL	SAVE_FP		; Indicate no Error Trap
30$:	RSB

; The following routine saves R11 and SF$L_SAVE_PC(FP)

SAVE_RG:
	MOVL	FP,SAVE_FP	; Save FP
	MOVL	SF$L_SAVE_PC(FP),-
		SAVE_PC		; Save caller's PC
	RSB

; The following routine sets up the message and error status (if any)

SET_STATUS:
	CLRL	ERRADR		; Assume no status variable requested
	MOVL	#-1,ERRMSG	; Assume printed message
	TSTB	(AP)		; Status variable specified?
	BEQL	10$
	CLRL	ERRMSG		; Yes, then no printed message
	MOVL	4(AP),ERRADR	; Get address of status variable (if any)
	BEQL	10$
	MOVZWL	#SS$_NORMAL,-	; Initialize Status to SS$_NORMAL
		@4(AP)
10$:	RSB

; The following routine sets up the ^C trap

TRAP_C:
	$ASSIGN_S CHAN=CHAN,-	; Assign channel to TT
		DEVNAM=DEVNAM	;  ...ignore errors
	$QIO_S	CHAN=CHAN,-	; Enable ^C AST
		FUNC=#IO$_SETMODE!IO$M_CTRLCAST,-
		P1=CTRL$C,P3=#3	; Take CTRL$C on ^C
	RSB

; The following routine sets up the condition handler

TRAP_ERROR:
	MOVAL	TRAP_HANDLER,-	; Install Condition Handler
		SF$A_HANDLER(FP);
	RSB

; The following routine sets up registers to call user as co-routine

CALL_CALLER:
	MOVL	(SP)+,-		; Install return address
		SF$L_SAVE_PC(FP);  in call frame
	MOVL	SAVE_PC,-(SP)	; Set up return to co-routine
	MOVL	SF$L_SAVE_AP(FP),-
		AP		; Set up user's AP
	CLRL	R0		; Cause fall through CASE instruction
	RSB			; Return to user routine

; The next instruction is branched to on a trappable condition

TRAP_TRAP:
	JSB	UNTRAP_C	; Remove ^C trap
	CLRL	SAVE_FP		; Indicate no Error Trap
	TSTL	ERRADR		; Error Status requested?
	BEQL	10$		;
	MOVL	ERRTYP,@ERRADR	; Yes, return Error Status
10$:	MOVZBL	#1,R0		; Take error line # for CASE instruction
	JMP	@SAVE_PC	; Call the caller back

; The following procedure gets executed upon ^C as an AST routine

.ENTRY	CTRL$C,^M<>
	$WAKE_S			; Do this in case process is hibernating
	MOVAL	10$,AST$L_PC(AP); Continue as non-AST routine...
	RET
10$:	MOVZWL	#SS$_CONTROLC,-	; Insert the
		ERRTYP		;  Error Number
	$WAKE_S			; Ensure that WAKE is pending
	$HIBER_S		;  then cancel pending wake state
	CALLS	#0,WAIT_IO	; Wait for I/O to complete
	MOVL	SAVE_FP,FP	; Fiddle FP
	MOVAL	TRAP_TRAP,-	; Force Error Trap
		SF$L_SAVE_PC(FP)
	RET

; The following procedure gets executed upon an error condition

.ENTRY	TRAP_HANDLER,^M<>
	MOVL	CHF$L_SIGARGLST(AP),-
		R1		; R1 --> Signal Argument List
	MOVL	CHF$L_SIG_NAME(R1),-
		ERRTYP		; Install Error Number
	TSTL	ERRMSG		; Error Message Printout?
	BEQL	10$		;
	$PUTMSG_S MSGVEC=ERRVEC,-
	          FACNAM=FACNAM	; Yes, then complain...
10$:	CALLS	#0,WAIT_IO	; Wait for I/O to complete
	MOVL	SAVE_FP,FP	; Fiddle FP
	MOVAL	TRAP_TRAP,-	; Force Error Trap
		SF$L_SAVE_PC(FP)
	RET

; The following procedure waits for FORTRAN I/O to complete

.ENTRY	WAIT_IO,^M<>
	MOVAL	FOR$IO_TRAP,-	; Setup to ignore errors
		SF$A_HANDLER(FP);  because next call may trap
	CALLS	#0,FOR$IO_END	; Wait for I/O to complete
	RET

; The following procedure gets executed if FOR$IO_END call traps

.ENTRY	FOR$IO_TRAP,^M<>
	$UNWIND_S DEPADR=DEPADR	; Unwind one call frame
	MOVZWL	#SS$_CONTINUE,R0; Continue
	RET

.PSECT	T$RAP_DATA,WRT,NOEXE,LONG

CHAN:	.LONG	0		; Channel # for ^C Trap

ERRADR:	.LONG	0		; Address of error status variable
ERRMSG:	.LONG	0		; Non-Zero if printout requested

ERRVEC:	.LONG	1		; Argument List for $PUTMSG call
ERRTYP:	.BLKL	5		; Error Number (must follow ERRVEC)

SAVE_FP:	.LONG	0	; Saved FP
SAVE_PC:	.LONG	0	; Saved SF$L_SAVE_PC(FP)

.PSECT	T$RAP_PDATA,NOWRT,NOEXE,LONG

DEPADR:	.LONG	1		; Unwind one Call Frame
DEVNAM:	.ASCID	/TT/		; Name of terminal device
FACNAM:	.ASCID	/T$RAP/		; Name for $PUTMSG call

.END
	.TITLE	NARGS Return number of arguments
	.IDENT	/1.0/
;++
;
;   Functional description:
;
;	Thia routine returns the number of arguments given to its caller.
;	This routine is called by a procedure having optional arguments
;	and needing to know how many arguments it is passed.
;
;   Calling sequence:
;
;	CALL NARGS ( Number_of_arguments.wl.r )
;
;   Formal parameters:
;
;	Number_of_arguments	This argument returns the number of arguments
;				given to the caller of NARGS.
;
;   Implicit inputs:
;
;	The saved AP of the calling procedure.
;
;   Implicit outputs:
;
;	NONE
;
;   Side effects:
;
;	NONE
;
;--
SAVEAP	=	8
	.ENTRY	NARGS,^M<>
	MOVZBL	@SAVEAP(FP),@4(AP)
	RET
;
	.END
        .TITLE   DELAY
;----------------------------------------------------------------------;
;       SUBROUTINE:   DELAY                                            ;
;----------------------------------------------------------------------;
;       LANGUAGE:     VAX-11 MACRO ASSEMBLY LANGUAGE                   ;
;       SYSTEM:       VAX-11/780                                       ;
;                     MOSTEK CORPORATION                               ;
;                     COMPUTER AIDS TO DESIGN DIVISION                 ;
;                     1215 WEST CROSBY ROAD                            ;
;                     CARROLLTON, TEXAS  75006                         ;
;                     (214)  323-8813                                  ;
;----------------------------------------------------------------------;
;       PROGRAMMER:   KEVIN KLUGHART                                   ;
;----------------------------------------------------------------------;
;       DATE:         05-21-81 @ 13:00 CDST                            ;
;----------------------------------------------------------------------;
;       PURPOSE:      THIS SUBROUTINE DELAYS THE EXECUTION OF A        ;
;                     PROCESS A SPECIFIED AMOUNT OF TIME.  THIS        ;
;                     EXECUTION DELAY IS COMPUTED AS FOLLOWS:          ;
;                                                                      ;
;                                                                      ;
;                     1.  IF (TIME_DELAY <= 0) THEN THE PASSED         ;
;                         PARAMETER REPRESENTS THE NUMBER OF 100-      ;
;                         NANOSECOND UNITS TO ELAPSE BEFORE            ;
;                         PROGRAM EXECUTION IS RESUMED.                ;
;                                                                      ;
;                     2.  IF (TIME_DELAY > 0) THEN THE PASSED          ;
;                         PARAMETER REPRESENTS THE NUMBER OF           ;
;                         MILLISECOND UNITS TO ELAPSE BEFORE           ;
;                         PROGRAM EXECUTION IS RESUMED.                ;
;----------------------------------------------------------------------;
;       NOTES:        THIS SUBROUTINE ASSUMES THAT THE SYSTEM CLOCK    ;
;                     HAS UNIT INCREMENTS OF 100-NANOSECONDS, WHICH    ;
;                     IS CONSISTENT WITH THE VAX-11/780 SYSTEM         ;
;                     TIME QUADWORD FORMAT STANDARD.                   ;
;----------------------------------------------------------------------;
;       REFERENCES:   VAX-11/780 SYSTEM SERVICES REFERENCE             ;
;----------------------------------------------------------------------;
        .PAGE
        .SBTTL  DATA:     SYSTEM DELTA-TIME QUADWORDS
;----------------------------------------------------------------------;
;                                                                      ;
;       DATA AREA                                                      ;
;                                                                      ;
;----------------------------------------------------------------------;
;       DEFINE THE SYSTEM DELTA-TIME QUADWORD DATA AREAS               ;
;----------------------------------------------------------------------;
        .PSECT  DELAY$DATA,QUAD

        .ALIGN  QUAD
DELTIM: .QUAD   0               ; NORMAL PROCESS LEVEL DELTA-TIME QUADWORD 
DELAST: .QUAD   0               ; AST LEVEL DELTA-TIME QUADWORD
        .PAGE
        .SBTTL  CODE:     DELAY PROCESS EXECUTION 
;----------------------------------------------------------------------;
;                                                                      ;
;       DELAY:     DELAY PROCESS EXECUTION THE SPECIFIED TIME INTERVAL ;
;                                                                      ;
;----------------------------------------------------------------------;
;       THIS ENTRYPOINT IS INTENDED FOR EXECUTION IN NORMAL PROCESS    ;
;       MODE.  THIS ENTRYPOINT IS NOT REENTRANT.                       ;
;----------------------------------------------------------------------;
        .PSECT  DELAY$CODE
        .ENTRY  DELAY,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>


        MOVL    @4(AP),R0               ; GET FIRST PARAMETER (TIME_DELAY)
        BGEQ    MS_DLY                  ; IF >= 0, USE MILLISECOND DELAY
        MOVL    R0,DELTIM               ; CONVERT TO SYSTEM TIME (QUAD)
        MOVL    #-1,DELTIM+4            ; INITIALIZE DELTA-TIME LONGWORD
        JMP     HIBNML                  ; DELAY SET:  NOW EXECUTE WAIT

MS_DLY: EMUL    R0,#-10000,#0,DELTIM    ; CONVERT DELAY TO MILLISECONDS

HIBNML: $SCHDWK_S ,,DELTIM,             ; SCHEDULE PROCESS WAKE-UP (DELAY)
        $HIBER_S                        ; HIBERNATE UNTIL AWOKEN
        BRB     EXIT
        .PAGE
        .SBTTL  CODE:     AST LEVEL DELAY PROCESS EXECUTION
;----------------------------------------------------------------------;
;                                                                      ;
;       DELAY_AST:     DELAY AST EXECUTION THE SPECIFIED TIME INTERVAL ;
;                                                                      ;
;----------------------------------------------------------------------;
;       THIS ENTRYPOINT IS INTENDED FOR EXECUTION AT AST LEVEL.        ;
;       THIS ENTRYPOINT IS NOT REENTRANT.                              ;
;----------------------------------------------------------------------;
        .ENTRY  DELAY_AST,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>


        MOVL    @4(AP),R0               ; GET FIRST PARAMETER (TIME_DELAY)
        BGEQ    MS_AST                  ; IF >= 0, USE MILLISECOND DELAY
        MOVL    R0,DELAST               ; CONVERT TO SYSTEM TIME (QUAD)
        MOVL    #-1,DELAST+4            ; INITIALIZE DELTA-TIME LONGWORD
        JMP     HIBAST                  ; DELAY SET:  NOW EXECUTE WAIT

MS_AST: EMUL    R0,#-10000,#0,DELAST    ; CONVERT DELAY TO MILLISECONDS

HIBAST: $SCHDWK_S ,,DELAST,             ; SCHEDULE PROCESS WAKE-UP (DELAY)
        $HIBER_S                        ; HIBERNATE UNTIL AWOKEN
;----------------------------------------------------------------------;
;       END OF SUBROUTINE DELAY                                        ;
;----------------------------------------------------------------------;
EXIT:   RET
        .END