Google
 

Trailing-Edge - PDP-10 Archives - bb-4157h-bm_fortran20_v10_16mt9 - fortran-compiler/err3.mac
There are 12 other files named err3.mac in the archive. Click here to see a list.
	TITLE ERR3 -- FATAL ERROR MESSAGE GENERATOR
	SUBTTL Donald Lewine/PLB

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1976, 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.

; Author: DONALD LEWINE -- 12-JUNE-72

	TWOSEG	400K		;[1705] PUT IN HIGH SEGMENT

	INTERN	ERR3V
	ERR3V= BYTE (3)0(9)7(6)0(18)1705  ; Version Date: 22-Dec-82


	SUBTTL	Revision History


Comment \

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

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

1563	PLB	18-Jun-82
	Conversion for TOPS-20 native compiler; SEARCH FTTENX, and
	create TMSG & PUTC MACROs for compatible TTY output.

1705	PLB	22-Dec-82
	TWOSEG 400K; Routines must be in High-Segment

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

\

	SEARCH	FTTENX		;[1563] GET OPERATING SYSTEM FT

IFN FTTENX,<			;[1563] TOPS-20 ASSEMBLY
	SEARCH	MONSYM		;[1563] JSYS SYMBOLS NOT INSIDE MACRO
	SEARCH	MACSYM		;[1563] USE FLD MACRO TO BE CLEAN
> ;TOPS-20

;AC USAGE
	T1==1
	T2==2
	M==3		;MESSAGE POINTER
	P==17		;PUSH DOWN POINTER

IFE FTTENX,<			;[1563] TOPS-10
DEFINE	TMSG (S),<
	OUTSTR	[ASCIZ \S\]
> ; TOPS-10 TMSG

DEFINE	PUTC,<
	OUTCHR	T1
> ; TOPS-10 TYPCHR
> ; TOPS-10

IFN FTTENX,<			;[1563] TOPS-20
DEFINE	TMSG (S),<		;[1563] DON'T RELY ON MACSYM
	HRROI	T1,[ASCIZ \S\]
	PSOUT
> ; TOPS-20 TMSG
DEFINE	PUTC,<
	PBOUT
> ; TOPS-20 TYPCHR
> ; TOPS-20

;ERR3 IS CALLED WHEN AN ERROR IS FOUND IN THE INTERNAL DATA BASE
; OF THE FORTRAN COMPILER. ERR3 GENERATES A MESSAGE OF THE
; FORM:
; ?
; ? Internal compiler error processing statement nnnn
; ? Call to <entry> from xxxxxx
;
;IF DDT IS LOADED CONTROL TRANSFERS TO DDT.
;
;ALL AC'S AS RESTORED PRIOR TO EXIT FROM ERR3 AND THE STACK IS
; LEFT AT THE SAME DEPTH AS WHEN ERR3 WAS CALLED. SEVERAL LOCATIONS
; BEYOND THE END OF THE STACK ARE CLOBBERED. THERE ARE NO TEMPS AND
; ALL CODE IS IN THE HISEG.

	DEFINE	ERRORL(A),<
	XLIST
	IRP	A,<
A::	PUSH	P,M		;SAVE M ON STACK
	MOVEI	M,[ASCIZ /A/]	;LOAD NAME OF ENTRY POINT
	JRST	ERR3		;BOMB OUT
>
	LIST
>

;CALL TO ERRORL LIST ALL DEFINED ENTRY POINTS

	ERRORL	<SKERR,CGERR>
ERR3:	PUSH	P,T1		;[1563] SAVE REGISTERS
	PUSH	P,T2		;[1563] BEFORE FIRST TMSG
	TMSG	<?
? Internal compiler error processing statement >
	PUSHJ	P,TYPISN
	TMSG	<
? Call to >
IFE FTTENX,<
	OUTSTR	(M)		;[1563] PRINT THE ROUTINE NAME
> ;TOPS-20
IFN FTTENX,<
	HRRO	T1,M		;[1563] GET -1,,ADR
	PSOUT			;[1563] PRINT THE ROUTINE NAME
> ;TOPS-20
	TMSG	< from >	;[1563] MAKE MESSAGE LOOK NICE
	HRLZ	T2,-3(P)	;[1563] GET CALLING PC

	MOVEI	M,6		;SIX DIGITS
OOPSL:	SETZ	T1,		;CLEAR T1
	LSHC	T1,3		;SHIFT IN AN OCTAL DIGIT
	TRO	T1,60		;CONVERT TO ASCII
	PUTC			;[1663] OUTPUT THE DIGIT
	SOJG	M,OOPSL		;LOOP OVER THE PC

	TMSG	<
>				;[1563] GIVE A CRLF
IFE FTTENX,<			;[1563] TOPS-10
	HRRZ	M,.JBDDT##	;GET POINTER TO DDT
> ;TOPS-10
IFN FTTENX,<			;[1563] TOPS-20
	MOVE	T1,[.FHSLF,,770] ;[1563] WHERE UDDT LIVES
	MOVE	M,[JRST 770002]	;[1563] WHAT 777000 SHOULD CONTAIN
	RPACS			;[1563] MAGIC PAGE JSYS
	TLNE	T2,(PA%PEX)	;[1563] DOES PAGE EXIST?
	 CAME	M,770000	;[1563] PAGE IS THERE; LOOK LIKE UDDT?
	  SETZ	M,		;[1563] NO, TO ONE OF THE ABOVE.
> ;TOPS-20

	MOVEM	M,1(P)		;STORE AWAY

	POP	P,T2		;PUT BACK THE AC'S
	POP	P,T1		; ..
	POP	P,M		; ..
	SKIPN	4(P)		;IS DDT THERE?
IFE FTTENX,<			;[1563] TOPS-10
	EXIT			;NO--GOOD BY
> ;TOPS-10
IFN FTTENX,<			;[1563] TOPS-20
	JRST	EXITUUO##	;[1563] SIMULATED
> ;TOPS-20
	TMSG	<
Debugger execution:
>				;[1563] BE VERBOSE
	JRST	@4(P)		;GO TO DDT

TYPISN:
IFN FTTENX,<
	PUSH	P,M		;[1563] SAVE CALLER NAME
	MOVEI	T1,.PRIOU	;[1563] TO TTY
	MOVE	T2,ISN##	;[1563] INTERNAL SEQ NUMBER
	MOVE	M,[NO%OOV!NO%LFL!NO%ZRO!FLD(5,NO%COL)!^D10] ;[1563]LPAD W/0; 5 DIGITS
	NOUT			;[1563] MAGIC NUMOUT JSYS
	 JFCL			;[1563] MUST HAVE OVERFLOWED
	POP	P,M		;[1563] STRANGE NAME FOR T3!!
> ;TOPS-20

IFE FTTENX,<			;[1563] TOPS-10
	MOVE	T1,ISN##
TYPISL:	IDIVI	T1,^D10		;CAST OUT 10'S
	HRLM	T2,(P)		;SNEAK REMAINDER ONTO STACK
	SKIPE	T1		;ANYTHING LEFT?
	 PUSHJ	P,TYPISL	;YES, RECURSE
	HLRZ	T1,(P)		;SNEAK DIGIT OUT
	ADDI	T1,"0"		;MAKE ASCII
	OUTCHR	T1		;TYPE IT
> ;TOPS-10
	POPJ	P,

	END