Trailing-Edge
-
PDP-10 Archives
-
FORTRAN-10_V7wLink_Feb83
-
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
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1976, 1983
; 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