PDP-10 Archive: forxit.mac from BB-D480F-SB_FORTRAN10

Trailing-Edge - PDP-10 Archives - BB-D480F-SB_FORTRAN10_V10 - forxit.mac

There are 13 other files named forxit.mac in the archive. Click here to see a list.


	SEARCH	MTHPRM,FORPRM
	TV	FORXIT  NORMAL AND ERROR EXIT,7(4174)

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1981, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

COMMENT \

***** Begin Revision History *****

1464	DAW	14-May-81
	Error messages.

1523	JLC	03-Jul-81
	Quiet exit flag, set via a FOROP call.

1571	DAW	31-Jul-81
	Set F to I.FLAGS at %ABORT.

1656	DAW	2-Sep-81
	Get rid of magic numbers.

1760	JLC	5-Oct-81	Q10-6522
	Changed elapsed time calc to use system uptime instead of
	time of day.

2007	JLC	16-Oct-81
	Fix runtime and elapsed time calcs.

2012	JLC	19-Oct-81
	Changed elapsed time calcs yet again.

2025	JLC	26-Oct-81
	Fixed elasped time calcs on -10 yet again.

***** Begin Version 6A *****

2040	DAW	21-Dec-81
	Fix elapsed time calculation for TOPS-10, wrong after
	system uptime becomes greater than about 160 hours.

***** Begin Version 7 *****

3035	JLC	5-Feb-82
	FOROT6 becomes FOROT7. Eliminate extra CRLF output at EOJ since
	it is now done at CLOSE of TTY.

3056	JLC	23-Mar-82
	Remove call to %FSAVE, change error table names, close all
	open files on exit.

3122	JLC	28-May-82
	Moved error summary text here.

3125	JLC	3-Jun-82
	Move the AC save routine to the hiseg.

3136	JLC	26-Jun-82
	Added summary line for non-ANSI usage warnings.

3150	JLC	13-Jul-82
	Fix new summary messages, were in wrong place in table,
	and never got output anyway.

3165	JLC	28-Aug-82
	Fixed output of summary messages again, to avoid
	printing of spurious numbers which have no summary text,
	notably EOF.

3167	JLC	1-Sep-82
	Added summary message for bounds check warnings.

3172	JLC	2-Sep-82
	Change name of summary message.

3212	JLC	11-Nov-82
	Fix ABORT so it doesn't drift through a SIXBIT name.

3250	JLC	7-Jan-83
	Add more messages to summary.

3252	JLC	12-Jan-83
	Added FENTRY.

3256	JLC	14-Jan-83
	Added some null summary texts at the end of the error table,
	since it expanded.

***** End V7 Development *****

3324	TGS	14-Jun-83	SPR:NONE
	To conform to the ANSI standard, a program which OPENs a file,
	does no I/O to it, then exits, should still create the file. Move
	the setting of %ABFLG from EXIT% to %ABORT.

3352	MRB	27-Sep-83	SPR:10-34127
	Changed summary error message from "Integer overflow" to
	"Arithmetic integer overflow".

3407	TGS	31-Jan-84	SPR:20-19929
	Make QUIETX suppress library routine error summaries as well as
	CPU summaries.

***** Begin Version 10 *****

4014	JLC	14-Jun-83
	Fix recursive %ABORT calls.

4044	JLC	19-Sep-83
	Added new check at exit. If memory manager debugger is on,
	deallocate all known blocks and pages and report if any
	are still allocated in warning messages.

4055	JLC	27-Oct-83
	Removed "arithmetic" in integer overflow msg, thereby
	undoing edit 3252.

4065	JLC	6-Dec-83
	Set entry vector of PA1050 to -1 in case it came in.

4077	JLC	6-Feb-84
	Remove saving of stack pntr, not needed by TRACE anymore.

4111	JLC	16-Mar-84
	Modify error calling sequence again.

4174	JLC	9-Jan-85
	Fix message about I/O warnings so it doesn't imply something
	about flagger warnings.

***** End V10 Development *****

***** End Revision History *****
\

	SEGMENT	CODE

	ENTRY	%ABORT

	EXTERN	%TRACX,%EXIT1,%ERRCT,%ERRSZ,%SAVAC
	EXTERN	I.RUNTM,I.DAYTM
	EXTERN	%CRLF
	EXTERN	%QUIET,%ABFLG,%EX1N
	EXTERN	%MMDEB,%DEFMT,%FREBLK,%BLCNT,%PGCNT,%CPBLK,%JBASE
	EXTERN	%FUNCX,%FNBLK,%FCODE,%FSTAT,%FARG1,%FARG2,%FARG3

	FENTRY	(ABORT)
%ABORT:	SKIPE	%ABFLG		;WERE WE ABORTING OR EXITING?
	 JRST	%EX1N		;YES. GO BACK TO CLOSE LOOP!
	SETZ	F,		;CLEAR FLAG WORD
	PUSHJ	P,%TRACX	;TYPE TRACEBACK
	SETOM	%ABFLG		;[3324] SET THE ABORT FLAG TO PREVENT
				;[3324] RECURSIVE CALLS TO EXIT1
	JRST	EXITF

	FENTRY	(EXIT)
	PUSHJ	P,%SAVAC	;SAVE USER'S ACS (FOR ERRORS ONLY)
EXITF:	PUSHJ	P,%EXIT1	;[3324] CLOSE ALL FILES AND CLEAN UP

	SKIPN	%MMDEB		;DEBUG MEMORY MANAGER?
	 JRST	NOMMD		;NO
	PUSHJ	P,%DEFMT	;YES. DEALLOCATE ENCODED FORMATS, ETC.
	SKIPE	T1,%CPBLK	;DEALLOCATE ARG-COPIER BLOCK IF ANY
	 PUSHJ	P,%FREBLK
	SKIPE	T1,%BLCNT	;ANY BLOCKS STILL ALLOCATED?
	 $ECALL	BLK		;YES. TYPE WARNING

	MOVE	T1,%JBASE	;GET INITIAL .JBFF ABOVE SYMBOL TABLE
	MOVEM	T1,.JBFF
	MOVEI	T1,FN%CBC	;DO CUT BACK CORE FUNCT. CALL
	MOVEM	T1,%FCODE
	XMOVEI	L,%FNBLK
	PUSHJ	P,%FUNCX	;CALL FUNCT.

	SKIPE	T1,%PGCNT	;ANY PAGES STILL ALLOCATED?
	 $ECALL	PAG		;YES. TYPE WARNING

NOMMD:	SKIPE	%QUIET		;QUIET EXIT DESIRED?
	 JRST	QUIXIT		;[3407] YES.

IF20,<
	MOVEI	T1,.FHSLF	;GET RUNTIME
	RUNTM%
	SUBM	T1,I.RUNTM	;SUBTRACT INITIAL RUNTIME, GIVING USED RUNTIME
	TIME%			;GET CURRENT UPTIME IN MILLISECS
	SUB	T1,I.DAYTM	;GET DIFFERENCE
>;END IF20

IF10,<
	SETZ	T1,		;GET RUNTIME
	RUNTIM	T1,
	SUBM	T1,I.RUNTM	;SUBTRACT INITIAL RUNTIME, GIVING USED RUNTIME
	MOVE	T1,[%CNSUP]	;GET UPTIME IN JIFFIES
	GETTAB	T1,
	  SETZ	T1,
	SUB	T1,I.DAYTM	;GET ELAPSED TIME IN JIFFIES
	MULI	T1,^D1000	;GET ELAPSED TIME IN JIFFIES*1000
	MOVE	T3,[%CNTIC]	;GET JIFFIES/SEC
	GETTAB	T3,
	 MOVEI	T3,^D60		;USE 60 IF NOT THERE
	LSH	T3,-1		;DIVIDE BY 2 FOR ROUNDING (A NIT)
	ADDI	T2,(T3)		;[2040] ROUND UP
	LSH	T3,1		;GET JIFFIES/SEC BACK AGAIN
	DIVI	T1,(T3)		;GET UPTIME IN MILLISECS
>;END IF10

	
;	ERR	(TIM,,CPU time $Y   Elapsed time $Y,<I.RUNTM,T1>)
	$ECALL	TIM		;Print CPU time

;TYPE APR ERROR SUMMARY

	MOVSI	T1,-%ERRSZ	;[3407] SET TO GO THROUGH TABLE AGAIN
SUMLP:	SKIPN	T2,%ERRCT(T1)	;GET ERROR COUNT
	  JRST	SUMNXT		;ZERO, GO TO NEXT
	MOVEI	T3,[0]		;ASSUME NOT PLURAL
	CAIE	T2,1		;SINGLE ERROR?
	  MOVEI	T3,[ASCIZ /s/]	;NO, PUT -S ON END OF TEXT
	SKIPE	T4,%ERRTXT(T1)	;Get address of string to print
;	ERR	(SUM,,$D$3T$A$A,<T2,T1,T3>)
	$ECALL	SUM
SUMNXT:	AOBJN	T1,SUMLP	;TYPE WHOLE TABLE

QUIXIT:				;[3407]
IF20,<
	MOVNI	T1,1		;CLOSE ALL FILES
	CLOSF%
	 JSHALT

	MOVEI	T1,.FHSLF
	SETO	T2,		;TURN OFF PA1050 IF THERE
	SCVEC%			;SO THE EXEC DOESN'T GO THERE
	 JSHALT

	HALTF%			;QUIT
	JRST	.-1		;AND STAY THAT WAY
>

IF10,<
	EXIT			;QUIT AND STAY THAT WAY
>

%ERRTXT:
	[ASCIZ /Integer overflow/]		;0 - APR trap: 000
	[ASCIZ /Integer divide check/]		;1 - APR trap: 001  NDV
	[ASCIZ /Input integer overflow/]	;2 - FLIRT warning
	[ASCIZ /Input floating overflow/]	;3 - FLIRT warning
	[ASCIZ /Floating overflow/]		;4 - APR trap: 100  FXO
	[ASCIZ /Floating divide check/]		;5 - APR trap: 101  FXO,NDV
	[ASCIZ /Floating underflow/]		;6 - APR trap: 110  FXO,FXU
	[ASCIZ /Input floating underflow/]	;7 - INTI warning
	[ASCIZ /Library routine error/]		;8 - MATHLIB error
	[ASCIZ /Output conversion error/]	;9 - Output field width overflow
REPEAT ^D11,<0>					;10-20 reserved for MATHLIB
	[ASCIZ /FORLIB library routine error/]	;21 - FORLIB errors
	[ASCIZ &I/O warning&]			;22 - I/O warnings
	[ASCIZ /Bounds check warning/]		;23 - array and string bounds
	0					;24 - ?EOF
	0					;25 - ?record errors
	[ASCIZ &OPEN/CLOSE warning&]		;26 - OPEN and CLOSE warnings
	0					;27 - unused
	0					;28 - ?CLOSE errors
	0					;29 - unused
	0					;30 - ?OPEN errors

	END