.TITLE 	TIME	ROUTINE TO GATHER PC HISTOGRAM DATA
	.IDENT	/V01.00/
 
;++
; FACILITY:	FOR GENERAL USE
;
; ABSTRACT:	THIS ROUTINE IS A FORTRAN-CALLABLE SUBROUTINE TO GATHER AND
;		STORE PROGRAM COUNTER HISTOGRAM DATA.
;
; ENVIRONMENT:	USER MODE
;
;--
;
; AUTHOR: D. ELDERKIN,  CREATION DATE:	20-NOV-78
;
; MODIFIED BY:
;
; INCLUDE FILES:
;
 
	$JPIDEF				;DEFINE $GETJPI CODES
	$SSDEF				;DEFINE SYSTEM SERVICE ERROR CODES
 
;
; EXTERNAL SYMBOLS:
;
 
;
; MACROS:
;
 
	.MACRO	TEXT ABC,?A,?B
	.WORD	B-A
	.WORD	0
	.LONG	A
A:
	.ASCII	%ABC%
B:
	.ENDM
 
	.MACRO	ERROR	ERRNUM
	PUSHL	#ERRNUM
	BSBW	ERROR
	.ENDM
 
	.MACRO	STATUS	ERRNUM,?A
	BLBS	R0,A
	ERROR	ERRNUM			;DECLARE THE ERROR
A:
	.ENDM
 
	.MACRO	DEFINE_ERROR	ERROR_NAME,MESSAGE
ERROR_NAME=ERRNUM
ERRNUM=ERRNUM+1
	.WORD	ERROR_NAME'_MSG
	.SAVE
	.PSECT	TIME_ERRTXT,BYTE,NOWRT,RD,NOEXE
ERROR_NAME'_MSG:
	.ASCIC	&MESSAGE&
	.RESTORE
	.ENDM
 
;
; EQUATED SYMBOLS:
;
 
LF=10					;LINE FEED
CR=13					;CARRIAGE RETURN
ESC=^X1B				;ESCAPE
 
OUT_BUFF_SIZE=132			;LENGTH OF GENERAL PURPOSE BUFFER
DISK_BUFF_SIZE=512			;LENGTH OF DISK BUFFER
ONE_TICK=-10*1000*10			;LENGTH OF 0.01 SEC IN 100NS UNITS
					;ARG LIST OFFSETS
OFF_INTERVAL=4				;INTERVAL PARAMETER
OFF_TIME=OFF_INTERVAL+4			;TIMING PERIOD
OFF_DISPOSE=OFF_TIME+4			;DISPOSTION PARAMETER
OFF_NAME=OFF_DISPOSE+4			;DISK/GLBSCT NAME PARAMETER
OFF_LOCK=OFF_NAME+4			;WORKING SET LOCK PARAMETER
					;DEFAULTS
INTERVAL_DEF=1				;DEFAULT TIMING INTERVAL IS 0.01 SECOND
TIME_DEF=60				;DEFAULT TIMING PERIOD IS 60 SECONDS
DISPOSE_DEF=2				;DEFAULT DISPOSITION IS TO GBLSECTION
LOCK_DEF=1				;DEFAULT IS TO LOCK CODE+BUFFERS IN W/S
 
;
; OWN STORAGE - READ/WRITE
;
 
	.PSECT	TIME_DATA,QUAD,NOEXE,PIC,RD,WRT,NOSHR
	.ALIGN	QUAD			;START OF QUADWORD ALIGNED DATA
OUT_FAB:				;FAB FOR TERMINAL OUTPUT
	$FAB	FAC=PUT,-
		FNA=OUT_NAME,-
		FNS=OUT_NAME_SIZE,-
		ORG=SEQ,-
		MRS=132,-
		RAT=CR
OUT_RAB:				;RAB FOR TERMINAL OUTPUT
	$RAB	RAC=SEQ,-
		FAB=OUT_FAB
FILE_FAB:
	$FAB	FAC=<GET,PUT,TRN>,-
		ORG=SEQ,-
		FOP=CBT,-		;CONTIGUOUS-BEST-TRY FOR THIS FILE
		RFM=FIX,-		;FIXED LENGTH RECORDS
		DNM=<.DAT>,-		;SET DEFAULT EXTENTION
		MRS=512
FILE_RAB:				;RAB FOR OUTPUT FILE
	$RAB	RAC=SEQ,-
		ROP=<ASY,WBH>,-		;TURN ON WRITE BEHIND AND ASYNCH PROCESSING
		FAB=FILE_FAB,-
		RBF=DISK_BUFF1,-	;THIS IS THE BUFFER ADDRESS
		RSZ=DISK_BUFF_SIZE,-	;THIS IS THE BUFFER LENGTH
		MBF=2			;MULTI-BUFFER WITH TWO BUFFERS
OUT_BUFF_DESC:				;DESCRIPTOR FOR OUT_BUFF
	.LONG	OUT_BUFF_SIZE
	.LONG	OUT_BUFF
 
DELTA_TIME:				;LOCATION TO RECEIVE COMPUTED DELTA_TIME
	.BLKQ	1
 
REQ_RANGE:				;REQUESTED RANGES OF ADDRESSES FOR
	.BLKQ	1			;$CRMPSC SYSTEM SERVICE
RET_RANGE:				;RETURNED RANGES OF ADDRESSES FROM
	.BLKQ	1			;$CRMPSC SYSTEM SERVICE
 
	.ALIGN	LONG			;START OF LONGWORD ALIGNED DATA
INTERVAL:				;TIMING INTERVAL
	.BLKL	1
TIME:					;NUMBER OF SECONDS FOR WHICH TO RUN TEST
	.BLKL	1
DISPOSE:				;DISPOSITION FLAG, 1=DISK,2=GLOBAL SECT
	.BLKL	1
NAME:					;ADDRESS OF DESCRIPTOR FOR OUTPUT NAME
	.BLKL	1
SAMPLES:				;TOTAL NUMBER OF SAMPLES TO TAKE
	.BLKL	1
VIRTUAL_ALQ:				;BYTES OF VIRTUAL MEMORY ADDED TO US
	.BLKL	1
BUFF_INDX:				;INDEX INTO BUFFER
	.BLKL	1
BUFF_ADDR:				;ADDRESS OF BUFFER INTO WHICH TO WRITE
	.BLKL	1
	.ALIGN	WORD			;START OF WORD ALIGNED DATA
FILE_CHAN:				;SPOT TO STORE CHANNEL USED TO ACCESS SCT
	.BLKW	1
	.ALIGN	BYTE			;START OF BYTE ALIGNED DATA
LOCK:					;MEMORY USAGE FLAG, 1=LOCK CODE IN WS
	.BLKB	1
OUT_BUFF:				;GENERAL PURPOSE LINE BUFFER
	.BLKB	OUT_BUFF_SIZE
;
; OWN STORAGE - READ ONLY
;
	.PSECT	TIME_DATA_RO,QUAD,NOWRT,RD,NOEXE
	.ALIGN	QUAD			;START OF QUADWORD ALIGNED DATA
DEF_NAME_DESC:				;DESCRIPTOR OF DEFAULT NAME
	.LONG	DEF_NAME_SIZE
	.LONG	DEF_NAME
FAO_DESC:
	.LONG	FAO_LINE_SIZE
	.LONG	FAO_LINE
	.ALIGN	LONG			;START OF LONGWORD ALIGNED DATA
JPI_ARG:				;ARGUMENT LIST FOR $GETJPI SYSTEM SERVICE
	.WORD	4			;LENGTH OF THIS BUFFER
	.WORD	JPI$_FREP0VA		;ADDRESS OF FIRST FREE P0 PAGE
	.LONG	REQ_RANGE		;PUT ANSWER IN ARG LIST FOR $CRMPSC
	.LONG	0			;UNUSED
	.LONG	0			;END OF THIS LIST
 
	.ALIGN	WORD			;START OF WORD ALIGNED DATA
	.ALIGN	BYTE			;START OF BYTE ALIGNED DATA
DEF_NAME:				;DEFAULT NAME FOR ALL THIS GOOD STUFF
	.ASCII	/PCHIST/
DEF_NAME_SIZE=.-DEF_NAME
FAO_LINE:
	.ASCII	/** !AC ** at PC=!XL/
FAO_LINE_SIZE=.-FAO_LINE
OUT_NAME:				;SYS$OUTPUT NAME
	.ASCII	/SYS$OUTPUT/
OUT_NAME_SIZE=.-OUT_NAME
;
; DISK BUFFERS
;
	.SAVE
	.PSECT	TIME_BUFF,PAGE,RD,WRT,NOEXE
DISK_BUFF1:
	.BLKB	DISK_BUFF_SIZE
;
; ERROR MESSAGES
;
	.ALIGN	WORD			;ERROR MESSAGE INFO IS WORD ALIGNED
ERRNUM=0				;START COUNTING ERRORS AT 0
ERROR_TABLE:				;START OF ERROR TABLE
	DEFINE_ERROR	BADERROR,<ERROR FROM RMS>
	DEFINE_ERROR	CREERROR,<Error creating output file>
	DEFINE_ERROR	CONERROR,<Error setting up access stream to output file>
	DEFINE_ERROR	JPIERROR,<Error during $GETJPI system service>
	DEFINE_ERROR	CRMPSCERROR,<Error creating and mapping global section>

	.PSECT	TIME_CODE,PAGE,RD,WRT,EXE
;	.PSECT	TIME_CODE,QUAD,RD,NOWRT,EXE,SHR
;++
;
; FUNCTIONAL DESCRIPTION:
;	THIS ROUTINE GATHERS PC HISTOGRAM DATA FOR A PROGRAM.  THE DATA
; IS WRITTEN EITHER TO A DISK FILE OR INTO A GLOBAL SECTION.
;
;	SAMPLE FORTRAN CALL:
;
;	CALL START_TIME(1,120,2,'PC.DAT')
;
;	 1 - SAMPLE EACH CLOCK TICK (.01 SEC)
;	120- SAMPLE FOR 120 SECONDS (OR UNTIL A CALL TO STOP_TIME)
;	 2 - PLACE COLLECTED DATA IN PROCESS SECTION
;	'PC.DAT' - NAME OF DISK FILE CREATED BY THIS ROUTINE
;
; CALLING SEQUENCE:
;	CALLG/S START_TIME
;
; INPUT PARAMETERS:
;	@4(AP) - SAMPLING INTERVAL IN 0.01 SECOND INCREMENTS (DEFAULT=1)
;	@8(AP) - SAMPLING TIME IN SECONDS (DEFALT=60)
;	@12(AP)- DISK/MEM FLAG, 1=STORE RESULTS ON DISK, 2=STORE IN GBLSCT
;	@16(AP)- DISK FILE/GBLSCT NAME DESCRIPTOR
;	@20(AP)- LOCK/UNLOCK FLAG - LOCK CODE+BUFFERS IN WORKSET (DEFAULT=LOCK)
;
; IMPLICIT INPUTS:
;	NONE
;
; OUTPUT PARAMETERS:
;	NONE
;
; IMPLICIT OUTPUTS:
;	NONE
;
;--
	.ENABL	LSB
	.ENTRY	START_TIME,^M<R2,R11>	;ENTRY POINT DESCRIPTION
;
; OPEN PATH TO SYS$OUTPUT FOR ERROR MESSAGES
;
	$OPEN	FAB=OUT_FAB		;OPEN SYS$OUTPUT
	STATUS	BADERROR		;CHECK STATUS
	MOVAL	OUT_RAB,R11		;POINT TO THE OUTPUT RAB
	$CONNECT (R11)			;CONNECT TO THE FAB
	STATUS	BADERROR
;
; AT THIS POINT, R11 -> SYS$OUTPUT RAB
;
; FETCH ARGUMENTS AND APPLY DEFAULTS
;
	MOVL	#OFF_INTERVAL,R1	;SET DESIRED PARAMETER
	MOVL	#INTERVAL_DEF,R0	;SET DEFALT VALUE
	BSBW	GETARG			;GET THE ARGUMENT (IF ANY)
	MOVL	R0,INTERVAL		;STORE THE PARAMETER (OR DEFAULT)
	MOVL	#OFF_TIME,R1		;SET DESIRED OFFSET
	MOVL	#TIME_DEF,R0		;SET THE DEFAULT TIME INTERVAL (1 MIN)
	BSBW	GETARG			;GET THE ARGUMENT (IF ANY)
	MOVL	R0,TIME			;STORE THE PARAMETER (OR DEFAULT)
	MOVL	#OFF_DISPOSE,R1		;SET DESIRED OFFSET
	MOVL	#DISPOSE_DEF,R0		;SET THE DEFAULT VALUE
	BSBW	GETARG			;GET THE ARGUMENT (IF ANY)
	MOVL	R0,DISPOSE		;STORE THE PARAMETER (OR DEFAULT)
	MOVL	#OFF_NAME,R1		;SET DESIRED OFFSET
	MOVAQ	DEF_NAME_DESC,R0	;SET THE DEFAULT VALUE
	BSBW	GETARG			;GET THE ARGUMET (IF ANY)
	MOVL	R2,NAME			;STORE THE PARAMETER (OR DEFAULT)
	MOVL	#OFF_LOCK,R1		;SET DESIRED OFFSET
	MOVL	#LOCK_DEF,R0		;SET THE DEFAULT VALUE
	BSBW	GETARG			;GET THE ARGUMENT (IF ANY)
	MOVB	R0,LOCK			;STORE THE PARAMETER (OR DEFAULT)
;
; DEFALTS ARE NOW IMPOSED ON ARGUMENTS, READY FOR REAL WORK
;
	MOVL	NAME,R0			;GET ADDRESS OF FILE NAME DESCRIPTOR
	MOVAB	FILE_FAB,R2		;ASSUME WRITING TO DISK, POINT TO FAB
	DECL	DISPOSE			;MAKE DISPOSE 0=DISK,1=GLOBALSECT
	CVTWB	(R0),FAB$B_FNS(R2)	;STORE LENGTH OF FILE NAME
	MOVL	4(R0),FAB$L_FNA(R2)	;STORE ADDRESS OF NAME STRING
;
; COMPUTE ALOCATION QUANTITY FOR FILE BEING CREATED
;
	MULL3	#100,TIME,R0		;COMPUTE NUMBER OF TICKS TO SAMPLE FOR
	DIVL	INTERVAL,R0		;DIVIDE BY TICKS PER SAMPLE
	MOVL	R0,SAMPLES		;STORE TOTAL NUMBER OF SAMPLES TO TAKE
	ADDL	#127,R0			;GET READY TO ROUND UP TO EVEN DISK BLOCK
	DIVL	#128,R0			;DIVIDE BY LONGWORDS PER DISK BLOCK
	ADDL3	DISPOSE,R0,FAB$L_ALQ(R2) ;ADD IN FUDGE FOR GLOBAL SECTION HDR
	BBC	#0,DISPOSE,20$		;IF CLR, WORKING WITH DISK FILE
	BISL	#FAB$M_UFO,FAB$L_FOP(R2) ;TURN ON USER FILE OPEN PROCESSING
20$:
	$CREATE	(R2)			;CREATE THE OUTPUT FILE
	STATUS	CREERROR		;CHECK FOR SUCCESS
	TSTL	DISPOSE			;IS THIS FOR DISK OR GLOBAL SECTION?
	BNEQ	30$			;IF NEQ, FOR GLOBAL SECTION
	BRW	40$			;ELSE, FOR DISK
30$:
	MOVW	FAB$L_STV(R2),FILE_CHAN	;STORE CHANNEL NUMBER JUST GENERATED
	MULL3	#512,FAB$L_ALQ(R2),VIRTUAL_ALQ ;CALC AND STORE BYTE COUNT OF SCT
	$GETJPI_S ITMLST=JPI_ARG	;FIND TOP VIRTUAL ADDRESS IN IMAGE
	STATUS	JPIERROR		;CHECK FOR SUCCESS
	ADDL3	VIRTUAL_ALQ,REQ_RANGE,REQ_RANGE+4 ;COMPUTE BOUNDS OF VIRT MEM
	.LIST	MEB
	$CRMPSC_S INADR=REQ_RANGE,-	;CREATE AND MAP A GLOBAL SECTION TO
		RETADR=RET_RANGE,-	;CONTAIN THE DATA WHICH THE AST ROUTINE
		FLAGS=#<SEC$M_DZRO!SEC$M_WRT>,- ;WILL GENERATE ON THE FLY
		RELPAG=#0,-		;MAKE IT DEMAND ZERO AND WRITABLE, START
		VBN=#1,-		;AT VIRTUAL BLOCK AND PAGE 0
		CHAN=FILE_CHAN,-	;USE THE CHANNEL JUST OPENED BY $CREATE
		PAGCNT=#0,-		;MAP ALL THE PAGES POSSIBLE
		PROT=#0,-		;ALLOW WIDE OPEN ACCESS FOR NOW
		PFC=#1			;WIRE IN A SMALL PAGE FAULT CLUSTER SIZE
	.NLIST	MEB
	STATUS	CRMPSCERROR		;CHECK FOR SUCCESS
	MOVL	RET_RANGE,BUFF_ADDR	;SET ADDRESS OF DATA STORAGE BUFFER
	BRB	50$			;FINISH BY SETTING TIMER
40$:
	$CONNECT RAB=FILE_RAB		;SET UP ACCESS STREAM
	STATUS	CONERROR		;CHECK FOR SUCCESS
	MOVAB	DISK_BUFF1,BUFF_ADDR	;SET ADDRESS OF DATA STORAGE BUFFER
50$:
	CLRL	BUFF_INDX		;SET UP INITIAL COUNT
	EMUL	INTERVAL,#ONE_TICK,#0,DELTA_TIME ;COMPUTE TIMER INTERVAL
	$SETIMR_S DAYTIM=DELTA_TIME,-	;SET UP A TIMER TO GO OFF IN A BIT
		ASTADR=W^TIMR_AST	;ENTER THIS AST AT THAT TIME
	RET				;AND RETURN TO CALLER WITH STATUS OK
;++
;
; FUNCTIONAL DESCRIPTION:
;	THIS ROUTINE TURNS OFF THE TIMING THAT START_TIME GOT STARTED
;
; CALLING SEQUENCE:
;	CALLG/S STOP_TIME
;
; INPUT PARAMETERS:
;	NONE
;
; IMPLICIT INPUTS:
;	NONE
;
; OUTPUT PARAMETERS:
;	NONE
;
; IMPLICIT OUTPUTS:
;	NONE
;
;--
	.ENABL	LSB
STOP_TIME::
	.WORD	^M<R2>			;ENTRY MASK
	$CANTIM_S			;CANCEL ALL THE TIMER REQUESTS
STOP_TIME1:				;ALTERNATE ENTRY POINT FROM AST
	MOVAB	FILE_RAB,R2		;POINT TO RAB FOR DISK FILE
	BBC	#0,DISPOSE,10$		;IF CLR, WORKING WITH DISK FILE
	$DELTVA_S INADR=RET_RANGE	;DELETE THE MAPPING TO THE SECTION
	$DASSGN_S CHAN=FILE_CHAN	;DEASSIGN THE CHANNEL TO THE SECTION
	RET				;DONE
10$:
	$WAIT	(R2)			;WAIT FOR THE LAST I/O OPERATION TO FIN
	BICL	#RAB$M_ASY,RAB$L_ROP(R2) ;TURN OFF ASYNCHRONOUS PROCESSING
	$PUT	(R2)			;WRITE OUT A JUNK RECORD
	BISB	#RAB$C_RFA,RAB$B_RAC(R2) ;TURN ON RFA MODE ACCESSING
	BICB	#RAB$C_SEQ,RAB$B_RAC(R2) ;TURN OFF SEQUENTIAL PROCESSING
	$FIND	(R2)			;POSITION FOR THE TRUNCATE
	$TRUNCATE (R2)			;CHOP OFF THE FILE AT THIS POINT
	$DISCONNECT RAB=FILE_RAB	;SHUT DOWN THE ACCESS STREAM
	$CLOSE	FAB=FILE_FAB		;CLOSE THE OUTPUT FILE
	RET				;AND RETURN
;++
;
; FUNCTIONAL DESCRIPTION:
;	THIS ROUTINE IS ENTERED AS AN AST EACH TIME THE TIMER GOES OFF.
;
; CALLING SEQUENCE:
;	CALLG TIMR_AST (BY EXEC)
;
; INPUT PARAMETERS:
;	(AP)   - 5 (NUMBER OF ARGUMENTS)
;	@4(AP) - AST PARAMETER (NONE)
;	@8(AP) - SAVED R0
;	@12(AP)- SAVED R1
;	@16(AP)- SAVED PC
;	@20(AP)- SAVED PSL
;
; IMPLICIT INPUTS:
;	NONE
;
; OUTPUT PARAMETERS:
;	NONE
;
; IMPLICIT OUTPUTS:
;	NONE
;
;--
	.ENABL	LSB
	.ALIGN	PAGE
TIMR_AST:
	.WORD	^M<R2,R3,R4,R5>		;ENTRY MASK
	MOVL	BUFF_INDX,R2		;FETCH INDEX
	MOVL	16(AP),@BUFF_ADDR[R2]	;STORE SAVED PC
	INCL	R2			;MOVE ON TO NEXT CELL
	CMPL	#<DISK_BUFF_SIZE/4>,R2	;AT END OF DISK BLOCK?
	BGTR	10$			;IF GTR NO, DONT WRITE TO DISK
	BSBB	EMPTY_BUFFER		;DO WORK TO CLEAN OUT BUFFER
10$:
	MOVL	R2,BUFF_INDX		;RESAVE INDEX
	DECL	SAMPLES			;COUNT DOWM THE SAMPLES LEFT TO TAKE
	BNEQ	20$			;IF NEQ NOT DONE YET
	BSBB	EMPTY_BUFFER		;WRITE OUT THE LAST BLOCK TO DISK
	BRW	STOP_TIME1		;FINISH UP THIS WORK
20$:
	$SETIMR_S DAYTIM=DELTA_TIME,-	;SET UP THE NEXT TIMER REQUEST
		ASTADR=W^TIMR_AST	;WITH THIS AS AN AST
	RET
	.ENABL	LSB
EMPTY_BUFFER:				;WRITE OUT BUFFERS USING RMS
	TSTL	R2			;HAS BUFFER ALREADY BEEN WRITTEN?
	BEQL	10$			;IF EQL YES, DONT WRITE IT AGAIN
	BBS	#0,DISPOSE,10$		;IF SET, WORKING TO GLOBAL SECTION, NOT DISK
	CLRL	R2			;RESET INDEX
	$WAIT	RAB=FILE_RAB		;WAIT FOR PREVIOUS OPERATION TO FINISH
	$PUT	RAB=FILE_RAB		;WRITE NEXT BLOCK TO DISK
10$:
	RSB
 
;++
;
; FUNCTIONAL DESCRIPTION:
;	THIS SUBROUTINE RETREIVES AN ARGUMENT (OR DEFAULT VALUE) FROM
; THE CALLING ROUTINE
;
; CALLING SEQUENCE:
;	BSB/JSB	GETARG
;
; INPUT PARAMETERS:
;	R0 - DEFAULT VALUE OF PARAMETER OF NO ARGLIST VALUE IS PRESENT
;	R1 - ARGUMENT LIST OFFSET OF PARAMETER
;
; IMPLICIT INPUTS:
;	NONE
;
; OUTPUT PARAMETERS:
;	R0 -RESULTANT VALUE FOR ARGUMENT
;	R1 - ADDRESS FROM WHICH R0 COMETH
;
; IMPLICIT OUTPUTS:
;	NONE
;
;--
	.ENABL	LSB
GETARG:
	MOVL	R0,R2			;STORE DEFAULT FOR A BIT
	DIVL	#4,R1			;CONVERT TO LONGWORD COUNT
	CMPL	R1,(AP)			;ARE ENOUGH ARGUMENTS PRESENT?
	BGTR	10$			;IF GTR NO, USE DEFAULT
	MOVL	(AP)[R1],R2		;GET ADDRESS OF ARGUMENT
	MOVL	(R2),R0			;GET ACTUAL ARGUMENT
10$:
	RSB				;RETURN TO CALLER WITH ARG IN R0
;++
;
; FUNCTIONAL DESCRIPTION:
;	THIS ROUTINE PROCESSES ERRORS DETECTED BY THE MAIN ROUTINE
;
; CALLING SEQUENCE:
;	PUSHL	ERROR-NUMBER
;	BSBW	ERROR
;
; INPUT PARAMETERS:
;	(SP) - ADDRESS AT WHICH ERROR TOOK PLACE
;	4(SP)- ERROR CODE
;
; IMPLICIT INPUTS:
;	ERROR_TABLE IS A LIST OF ERRORS WHICH THIS ROUTINE CAN PROCESS
;
; OUTPUT PARAMETERS:
;	NONE- THIS ROUTINE EXITS AFTER PRINTING AN ERROR MESSAGE
;
; IMPLICIT OUTPUTS:
;	NONE
;
;--
	.ENABL	LSB
ERROR:
	MOVAL	OUT_RAB,R11		;POINT TO SYS$OUTPUT RAB
	MOVAB	OUT_BUFF,RAB$L_RBF(R11)	;SET OUTPUT BUFFER ADDRESS IN RAB
	SUBL3	#6,(SP)+,R9		;FETCH ERRANT PC
	MOVL	(SP)+,R10		;AND ERROR NUMBER
	BEQL	10$			;IF EQL, BAD ERROR, NO MESSAGE
	PUSHL	R0			;SAVE THE FAILING STATUS
					;R9 = ERROR PC
					;R10= ERROR MESSAGE NUMBER
	MOVZWL	ERROR_TABLE[R10],R10	;GET THE ADDRESS OF THE MESSAGE
	$FAO_S	CTRSTR=FAO_DESC,-	;FORMAT THE MESSAGE
		OUTLEN=RAB$W_RSZ(R11),- ;PUT THE LENGTH IN THE RAB
		OUTBUF=OUT_BUFF_DESC,-;PUT THE MESSAGE IN THE BUFFER
		P1=R10,P2=R9		;THESE ARE THE PARAMETERS
	$PUT	(R11)			;PUT THE MESSAGE
	POPL	R0			;RESTORE R0
10$:
	$EXIT_S R0			;AND CALL IT A DAY
	.END