Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap1_198111 - decus/20-0003/fordum.mac
There are 15 other files named fordum.mac in the archive. Click here to see a list.
	TITLE	FORDUM	%4.(405) ERROR PROCESSING MODULE FOR THE FOROTS SYSTEM
	SUBTTL	D. TODD/DRT/MD		02-OCT-74
		;**;[405],DUMMY ERROR ROUTINE WHEN FOROTS NOT USED

	search monsym
define outstr(x) <
	push p,1
	hrroi 1,x
	psout
	pop p,1>
define outchr(x) <
	push p,1
	move 1,x
	pbout
	pop p,1>
define skpinc <
	push p,1
	push p,2
	movei 1,.priou
	rfmod
	tlz 2,(tt%osp)
	sfmod
	pop p,2
	pop p,1>


;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

;COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION



	SUBTTL	REVISION HISTORY

;405	14115	CREATION




	ENTRY	FORER.		;[405] DEFINE IT
	ENTRY	FORER%		;ENTRY POINT TO FORERR - MUST BE DEFINED BEFORE


	SEARCH	FORPRM	;GLOBAL SYMBOLS DEFINED IN FORPRM

HGH.AC==T5			;NUMBER OF AC'S TO SAVE


;CONTROL FLAGS IN THE LEFT HALF OF THE MESSAGE TABLE ENTRIES
;	FOLLOWING FLAGS ARE CONTAINED IN T5 DURING ERROR PROCESSING

ER.HDR==400000	;MESSAGE HEADER TO BE TYPED OUT
ER.DDB==200000	;DEVICE INFO TO BE TYPED OUT
ER.EDB==100000	;EXTENDED DEVICE INFO TO BE TYPED (IMPLIES ER.DDB)
ER.MSG==040000	;ASSOCIATED SPECIAL ROUTINE (ROUTINE ADDRESS)
ER.USR==020000	;USER'S ADDRESS IS NOT AVAILABLE FOR MESSAGE HEADER
	SUBTTL FORERR ENTRY POINTS DEFINED BY ERRDIR IN (FORRM)
ERDIR%:		;DEFINE THE BEGINNING OF THE DISPATCH TABLE
	SALL

	ERRDIR
FORER.:				;**;[405], DEFINE FORER.
FORER%:	PUSHJ	P,.+1		;SAVE THE CALLING PC
	ADD	P,[XWD HGH.AC+1,HGH.AC+1]	;MAKE ROOM TO SAVE THE AC'S
	MOVEM	HGH.AC,(P)	;SAVE THE LAST AC
	MOVEI	HGH.AC,-HGH.AC(P)	;GET THE BEGINNING OF THE SAVE AREA
	BLT	HGH.AC,-1(P)	;SAVE THE AC'S
	N.==HGH.AC+1		;DEFINE THE STACK DEPTH
				;**;[405],DO NOT USE P4 (.JBOPS)
	MOVE	T3,-N.(P)	;GET THE XCT ADDR +1
	HLRZ	T4,(T3)		;GET THE TYPE AND SEVERITY CODE
	ANDI	T4,757		;SAVE THE INDEX AND AC FIELD
	ROT	T4,-5		;POSITION THE AC FIELD
	PUSH	P,T4		;SAVE THE TYPE CODE ON THE  STACK
	N.=N.+1			;COUNT THE SEVERITY CODE AND TYPE CODE
	ANDCMI	T4,-1		;CLEAR THE RIGHT HALR
	ROT	T4,5		;GET THE SEVERITY CODE BACK
	HRLM	T4,(P)		;PUT THE SEVERITY IN THE LEFT HALF
	HLRZ	T4,-1(T3)	;GET THE CLASS CODE
	LSH	T4,-5		;GET THE AC FIELD
	ANDI	T4,17		;SAVE FOUR BITS
	MOVEI	T1,FORRTN	;GET THE RETURN ADDRESS
	HLL	T1,ERDIR%(T4)	;GET THE CLASS NAME
	PUSH	P,T1		;SAVE ON THE STACK
	N.=N.+1		;COUNT THE PUSH
	HRRZ	T1,ERDIR%(T4)	;GET THE DISPATCH ADDRESS
NN.==N.			;DEFINE THE STACK DEPTH FOR THE REST
	JRST	(T1)		;GO TO THE ERROR CLASS ROUTINE
FORRTN:				;RETURN FROM THE CLASS ROUTINE
	N.=N.-1			;ACCOUNT FOR THE POPJ BACK HEHRE
	HRRZ	T3,@-N.(P)	;GET THE RETURN ADDRESS
	JUMPN	T3,FORRT3	;IS A RETURN SPECIFIED
				;**;[405], DO NOT CALL TRACE
FORRT0:	MOVEI	T3,EXIT.##	;[405] NO, USE SYSTEM RETURN
	OUTSTR	[ASCIZ /
? Job aborted
/]
FORRT3:	MOVEM	T3,-N.(P)	;SET THE RETURN ADDRESS
FORRT1:	POP	P,(P)		;GET THE TYPE CODE AND SEVERITY OFF THE STACK
	N.=N.-1
				;**;[405], DO NOT USE P4
	MOVSI	HGH.AC,-HGH.AC(P)	;SET A BLT POINT TO RESTORE THE AC'S
	BLT	HGH.AC,HGH.AC	;RESTORE THE AC'S
	SUB	P,[XWD HGH.AC+1,HGH.AC+1] ;MAKE THE STACK RIGHT
	N.=N.-HGH.AC
	POPJ	P,		;RETURN
	N.=N.-1

SYSRET:	POP	P,T0		;RETURN TO MONITOR VIA EXIT
	JRST	FORRT0		;LOAD THE EXIT RETURN

USRRET:	POP	P,T0		;REMOVE THE CALLING ADDRESS
	JRST	FORRT1		;EXIT
	SUBTTL	TY%XXX GENERAL PURPOSE OUTPUT ROUTINES TO THE TTY
;				;ROUTINE TO TYPE A STRING ON THE
				;CURRENT OUTPUT DEVICE
;	CALL
;	TYPSTR (ADDR OF STRING)		;CALLED BY THE TYPE STRING MACRO
;	(RETURN)
TY%STR:	MOVE	T2,(P)		;GET THE ARGUMENT
	MOVEI	T2,@(T2)	;GET THE LOCATION OF THE MESSAGE
	HRLI	T2,100		;SET UPPER CASE SHIFT MODE
TY%FI1:	MOVE	T1,(T2)		;GET A FIVBIT WORD
	TRNN	T1,1		;CHECK FOR LAST WORD OF THE STRING
	TLO	T2,400000	;YES, LAST WORD SET FLAG
TY%FI3:	SETZ	T0,		;CLEAR THE OUTPUT WORD
	LSHC	T0,5		;GET FIVE BITS
	CAIN	T0,37		;IS THIS A CASE SHIFT
	JRST	[TLC  T2,40	;YES, COMPLEMENT CASE SHIFT
		JRST	TY%FI3]	;GET THE NEXT CHARACTER
	JUMPE	T0,.+2		;JUMP IS A FIVBIT BLANK SEEN
	TSOA	T0,T2		;SET UP THE CASE SHIFT
	MOVEI	T0," "		;GET A BLANK
	JUMPN	T1,.+2		;CHECK FOR END OF WORD
	AOJGE	T2,TY%FI1	;CONTINUE UNLESS END OF STRING
	OUTCHR	T0		;OUTPUT THE ASCII CHARACTER
	JUMPN	T1,TY%FI3	;ANY CHARACTERS LEFT
	JUMPGE	T2,TY%FI3	;AND NOT LAST WORD 
	POPJ	P,		;UNLESS END OF STRING

TY%SIX:				;OUTPUT THE SIXBIT WORD IN T1
	SETZ	T0,		;CLEAR THE RECEIVER OF THE SIXBIT CHARACTER
	LSHC	T0,6		;GET A SIXBIT CHARACTER
	ADDI	T0," "		;CONVERT TO ASCII
	OUTCHR	T0		;OUTPUT THE CHARACTER
	JUMPN	T1,TY%SIX	;CONTINUE, IF ANY CHARACTERS LEFT
	POPJ	P,		;RETURN

				;**;[405], DO NOT NEED TY%XWD
TY%OCT:	SKIPA	T2,[10]		;SET OCTAL RADIX
TY%DEC:	MOVEI	T2,^D10		;SET DECIMAL RADIX
TY%RDX:	JUMPGE	T0,TYRDX1	;JUMP IF +
	OUTSTR	[ASCIZ /-/]	;SUMP A MINUS SIGN
	MOVNS	T0		;NEGATE THE NUMBER
TYRDX1:IDIVI	T0,(T2)		;GET A DIGIT
	HRLM	T1,(P)		;SAVE ON THE STACK
	SKIPE	T0		;ANY DIGITS LEFT
	PUSHJ	P,TYRDX1	;YES, CONTINUE
	HLRZ	T0,(P)		;GET A DIGIT BACK
	ADDI	T0,"0"		;CONVERT TO ASCII
	CAILE	T0,"9"		;IF DIGIT IS GREATER THAN 9
	ADDI	T0,"A"-"0"	;CONVERT TO LETTERS
	OUTCHR	T0		;OUTPUT
	POPJ	P,		;RETURN FOR NEXT DIGIT

				;**;[405], DO NOT NEED TY%TIM
	SUBTTL ERROR MESSAGE PROCESSOR
TY%HDR:
	SKPINC			;KILL ^O TYPE OUT
	JFCL
	OUTSTR	[ASCIZ/
%FRS/]	;TYPE A WARNING FLAG
	HLLZ	T1,-1(P)	;GET THE CLASS NAME
	PUSHJ	P,TY%SIX	;type OUT THE SIXBIT
	OUTSTR	[ASCII / /]	;AND A SPACE
	POPJ	P,		;RETURN TO SOMEONE

;THE FOLLOWING ENTRIES ARE NOT DEFINED
ER%UUO:ER%QUE:ER%UNF:ER%US0:ER%US1:ER%US2:
ERCALL:	PUSHJ	P,TY%HDR	;TYPE THE HEADER
	TYPSTR	[FIVBIT (Undefined ENTRY in FORERR)]
	POPJ	P,


	;**;[405], DEFINE THE DUMMY ENTRIES WHICH SHOULD NOT BE USED

ER%OPN:	ER%DEV:	ER%DAT:		;[405]
	PUSHJ	P,TY%HDR	;[405] TYPE HEADER
	TYPSTR	[FIVBIT (Undefined ENTRY in FORLIB without FOROTS)]
	POPJ	P,		;[405]
	SUBTTL SYS ERROR PROCESSOR
ER%SYS:
	HRRZ	T5,-1(P)	;GET THE TYPE CODE
	CAILE	T5,SYS.MX		;CHECK FOR IN RANGE
	PJRST	ERCALL		;UNDEFINED ENTRY
	MOVE	T5,SYSTAB(T5)	;GET THE ERROR ENTRY
	TLNE	T5,ER.HDR	;HEADER TO BE TYPED
	PUSHJ	P,TY%HDR	;YES, TYPE IT
	TLNN	T5,ER.MSG	;MESSAGE TO BE TYPE
	PJRST	@T5		;NO, ROUTINE DISPATCH
	TYPSTR	(@T5)		;YES, TYPE THE MESSAGE
	POPJ	P,		;EXIT
SYSTAB:				;SYSTEM ERROR TABLE
XWD ER.HDR!ER.MSG,[FIVBIT (FOROTS system error)]			;(0)
XWD	,SYS01								;(1)
XWD ER.HDR!ER.MSG,[FIVBIT (ARGUMENT BLOCK not in the correct format)]	;(2)
XWD ER.HDR!ER.MSG,[FIVBIT (MONITOR not built to support FOROTS)]	;(3)
XWD ,SYSRET								;(4)
XWD ER.HDR!ER.MSG,[FIVBIT (User program has requested more core than is available)]	;(5)
SYS.MX==.-SYSTAB-1		;SYSTBL SIZE

SYS01:			;PRINT THE TIMES OUT
	SKPINC		;KILL ^O TYPE OUT
	JFCL
	OUTSTR	[ASCIZ /
END OF EXECUTION
/]				;[405] DO NOT TIME MISSING INFO
;	CALLI	12		;EXIT TO MONITOR
	haltf
	hrroi 1,[asciz / Can't continue
/]
	esout
	jrst .-3

	;**;[405], DO NOT NEED ER%OPN

	SUBTTL APR ARITHMETIC FAULT ERROR PROCESSOR
FXU=1B11	;FLOATING EXPONENT UNDERFLOW FLAG
FOV=1B3		;FLOATING OVERFLOW BIT
NDV=1B12	;NO DIVIDE BIT
ER%APR:		;ENTRY TO APR FAULT
				;**;[405], DO NOT COUNT ERRORS
	HRRZ	T4,-NN.(P)	;GET THE ERROR MACRO PC
	HRRZ	T5,-1(P)	;GET THE TYPE CODE
	SOJGE	T5,ERAPR1	;SPECIAL ENTRY FOR A MESSAGE TYPE
	MOVE	T4,.JBTPC	;GET THE APR TRAP LOC
	HLRZ	T5,T4		;GET THE TRAP BITS
	ANDI	T5,(FXU!FOV!NDV)	;SAVE THE FLAG BITS
	LSH	T5,-5		;MAKE A MESSAGE POINTER
	TRZE	T5,(1B8)	;INDEX
	IORI	T5,1B33		;BETWEEN 0-7
ERAPR1:	MOVE	T5,APRTAB(T5)		;GET THE FLAGS
	PUSHJ	P,TY%HDR	;TYPE OUT THE HEADER
	TYPSTR	(@T5)		;TYPE THE ERROR MESSAGE
	OUTSTR	[ASCIZ /	PC= /]
	MOVEI	T0,-1(T4)	;GET THE ERROR LOCATION
	PUSHJ	P,TY%OCT	;60;TYPE OUT THE PC
	OUTSTR	[ASCIZ /
/]
	POPJ	P,		;RETURN
APRTAB:
	XWD	ER.USR,[FIVBIT (Integer overflow)]	;(0)
	XWD	ER.USR,[FIVBIT (Integer divide check)];(1)
	XWD	ER.USR,[FIVBIT (Illegal APR trap)]	;(2)
	ARG	ER.USR,@APRTAB+2			;(3)
	XWD	ER.USR,[FIVBIT (Floating overflow)]	;(4)
	XWD	ER.USR,[FIVBIT (Floating divide check)];(5)
	XWD	ER.USR,[FIVBIT (Floating underflow)]	;(6)
	ARG	ER.USR,@APRTAB+2			;[335] (7)
	SUBTTL LIB LIBRARY ERROR FAULT PROCESSOR
ER%LIB:				;ENTRY POINT
				;**;[405], DO NOT COUNT LIB ERRORS
	PUSHJ	P,TY%HDR	;TYPE THE HEADER
	MOVE	T5,@-NN.(P)	;[200] GET THE MESSAGE ADDRESS
	OUTSTR	0(T5)		;[200] TYPE THE MESSAGE
				;**;[405], DO NOT CALL TRACE
	JRST	USRRET		;[200] RETURN TO THE USER
	;**;[405], DO NOT NEED ER%DAT
	;**;[405], DO NOT NEED ER%DEV


	SUBTTL MSG TYPE A MESSAGE OUT
ER%MSG:
	MOVE	T5,@-NN.(P)	;GET THE MESSAGE ADDRESS
	OUTSTR	(T5)		;OUTPUT THE MESSAGE
	OUTSTR	[ASCIZ /
/]
	JRST	USRRET		;RETURN TO THE ERROR MACRO
	SUBTTL	ERROR MESSAGE FOR ARRAY OUT OF BOUNDS

;ROUTINE TO GIVE A MESSAGE WHEN AN ARRAY BOUNDS VIOLATION IS
; DETECTED BY "PROAR."
;CALLED VIA FORER% WITH:
;	T1 - NAME OF THE ARRAY IN SIXBIT
;	T2 - LINE NUMBER OF THE STATEMENT IN THE
;		FORTRAN SOURCE THAT CONTAINS THE ARRAY REFERENCE
;	T4 - THE VALUE OF THE ILLEGAL SUBSCRIPT
;	T3 - THE DIMENSION THAT WAS VIOLATED
;     (THESE PARAMETERS WILL HAVE BEEN STORED ON THE STACK UPON
;	 ENTRY TO %FORER - WHERE "-NN.+1+TN(P)" IS THE
;	 ADDRESS AT WHICH TN IS SAVED)

ER%SRE:	PUSHJ	P,TY%HDR	;[250] TYPE ERROR HEADER
	OUTSTR	[ASCIZ/Subscript range error on line /]
	MOVE	T0,-NN.+1+T2(P)	;[250] LINE NUMBER ON WHICH ERROR
				;[250]  OCCURRED
	PUSHJ	P,TY%DEC	;[250] TYPE IT
				;**;[405], DO NOT SEARCH NAME OF ROUTINE
	OUTSTR	[ASCIZ/
		Subscript /]
	MOVE	T0,-NN.+1+T3(P)	;[250] DIMENSION FOR WHICH BOUNDS
				;[250]  WERE EXCEEDED
	PUSHJ	P,TY%DEC	;[250]  TYPE IT
	OUTSTR	[ASCIZ/ of array /]
	MOVE	T1,-NN.+1+T1(P)	;[250] NAME OF ARRAY IN SIXBIT
	PUSHJ	P,TY%SIX	;[250] TYPE IT

	OUTSTR	[ASCIZ/ = /]
	MOVE	T0,-NN.+1+T4(P)	;[250] SUBSCRIPT VALUE
	PUSHJ	P,TY%DEC	;[250]  TYPE IT
	OUTSTR	[ASCIZ/
/]
	POPJ	P,		;[250] RETURN TO PROAR.
	;**;[405], DO NOT NEED TRACE% ROUTINE

        if2 ,<purge pbout,psout,rfmod,sfmod>

	END