Trailing-Edge
-
PDP-10 Archives
-
FORTRAN-10_Alpha_31-jul-86
-
mthdum.mac
There are 23 other files named mthdum.mac in the archive. Click here to see a list.
SEARCH MTHPRM
TV MTHERR Error output routine for MTHLIB, 2(4021)
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1986
;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 *****
3224 JLC 10-Dec-82
New module, derived from FORERR, for MACRO use of
the math library.
***** End Revision History *****
***** Begin Version 2 *****
4003 JLC 8-Sep-83
Fix extended addressing bug in GETPC.
4004 JLC 27-Sep-83
Add some really dummy modules (which do nothing right
now) to resolve global refs from MTHCNV.
4007 JLC 29-Feb-84
Change S1, a label, to SIX1, since S1 is now an AC.
4010 JLC 16-Mar-84
Added a new entry point for fatal error calls - %AERR.
4011 JLC 5-May-84
Fixed some error calls to match changes in MTHPRM.
4021 MRB 13-Jan-86
The math library may not give the correct name of the math function
in which an error was detected. This is due to the incorrect
computation of the high-segment starting address. (This is edit 4221
to FOROTS)
\
PRGEND
TITLE DUMIN DUMMY INPUT ROUTINES FOR MTHLIB
SEARCH MTHPRM
;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 1983, 1986
;ALL RIGHTS RESERVED.
ENTRY %IBYTE,%SKIP
INTERN %IJFN
SEGMENT CODE
%IBYTE: POPJ P,
%SKIP: POPJ P,
SEGMENT DATA
%IJFN: BLOCK 1 ;JFN FOR INPUT
SEGMENT CODE
PRGEND
TITLE DUMOUT DUMMY OUTPUT ROUTINES FOR MTHLIB
SEARCH MTHPRM
;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 1983, 1986
;ALL RIGHTS RESERVED.
ENTRY %OBYTE,%OMBYT,%OMSPC,%OMPAD,%CBDO,%FTSUC
INTERN %OJFN,%MSPAD
EXTERN %FIXED,%FWVAL,%ERTYP,IO.TYP
SEGMENT CODE
%OBYTE: POPJ P,
%OMBYT: POPJ P,
%OMSPC: POPJ P,
%OMPAD: MOVEM T1,%MSPAD ;SAVE PADDING CHAR
POPJ P,
%CBDO: POPJ P,
%FTSUC: MOVEI T1,"*" ;FILL WITH ASTERISKS
MOVE T3,%FWVAL ;GET OUTPUT WIDTH
PUSHJ P,%OMPAD ;OUTPUT STARS
MOVE T1,IO.TYP ;GET DATA TYPE
MOVEM T1,%ERTYP ;SAVE FOR USER SUBR
$ECALL FTS ;ISSUE ERROR MSG, CALL SUBR IF DESIRED
POPJ P,
SEGMENT DATA
%MSPAD: BLOCK 1 ;PADDING CHAR FOR MOVSLJ
%OJFN: BLOCK 1 ;JFN FOR OUTPUT
SEGMENT CODE
PRGEND
TITLE DUMERR DUMMY ERROR ROUTINES FOR MTHLIB
SEARCH MTHPRM
FSRCH
;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 1983, 1986
;ALL RIGHTS RESERVED.
;ROUTINE TO TYPE A MESSAGE FOR STAND-ALONE MATHLIB.
;NO ERROR LIMITS ARE CHECKED, NO SYMBOL TABLES ARE SEARCHED.
;THE INTENTION IS TO MAKE THIS ROUTINE AS SMALL AND BARE AS POSSIBLE
;AND STILL PROVIDE REASONABLY LUCID ERROR MESSAGES.
ENTRY MTHER.,%TRPER,%ERINI,%OTSER,%AERR
ENTRY %FWVAL,%XPVAL,%DWVAL,%SCLFC,%BZFLG,%SPFLG,%FTAST,IO.ADR,IO.TYP
ENTRY %DEINF,ILLEG.,%EJFN,%FTSLB
ENTRY %ERRPC,%ERTYP,%ERPDP,%TRFLG,%FIXED,%UNFXD
EXTERN %ABORT
SEGMENT CODE
%ERINI: XMOVEI T1,(P) ;GET EXTENDED ADDR OF PDL
MOVEM T1,PDLBOT ;SAVE CURRENT PDP AS LOWEST
XMOVEI T1,ERRSTK ;SETUP ERROR STACK
MOVEM T1,ERSTKP
HLLZM T1,%FSECT ;RECORD OUR RUNNING SECTION
POPJ P,
%TRPER: POP P,%ERPTR ;GET ERROR BLOCK POINTER
PUSHJ P,SVEACS ;SAVE THE ACS ON THE ERROR STACK
MOVE T1,%ERPDP ;GET USER'S PDP
MOVEM T1,%TRPDP ;SAVE FOR TRACE
MOVE T1,%ERRPC ;GET ERROR PC
MOVEM T1,MSGPC ;SAVE FOR MESSAGE
MOVE T1,%ERPTR ;GET ERROR BLOCK POINTER
MOVE T2,%NUM1(T1) ;GET ERROR CLASS NUMBER
MOVEM T2,%ERNM1 ;SAVE ERROR CLASS NUMBER
MOVE T2,%NUM2(T1) ;GET 2ND ERROR NUMBER
MOVEM T2,%ERNM2 ;SAVE 2ND ERROR NUMBER
PUSHJ P,FOREC ;OUTPUT THE MESSAGE
PJRST CALRET ;CALL USER ROUTINE, RESTORE ACS, RETURN
%AERR:
%OTSER:
MTHER.: POP P,%ERPTR ;SAVE ERROR BLOCK POINTER
MOVEM P,%ERPDP ;SAVE USER'S STACK PNTR
MOVEM P,%TRPDP ;SAVE FOR TRACE
PUSHJ P,SVEACS ;SAVE ACS ON STACK
MOVE T1,%ERPTR ;GET ERROR BLOCK POINTER
MOVE T2,%NUM1(T1) ;GET ERROR CLASS NUMBER
MOVEM T2,%ERNM1 ;SAVE ERROR CLASS NUMBER
MOVE T2,%NUM2(T1) ;GET 2ND ERROR NUMBER
MOVEM T2,%ERNM2 ;SAVE 2ND ERROR NUMBER
MOVE T2,%CHR(T1) ;GET ERROR CHARACTER
MOVEM T2,%ERCHR ;SAVE IT
MOVE P1,%ERPDP ;GET ERROR STACK PNTR AGAIN
PUSHJ P,GETPC ;GET CALLER ADDR
MOVEM T1,%ERRPC ;SAVE IT
MOVEM T1,MSGPC ;SAVE FOR MESSAGE
MOVE T1,-1(T2) ;GET NAME OF LIBRARY ROUTINE
MOVEM T1,%ERNAM ;SAVE FOR MESSAGE
PUSHJ P,FOREC ;OUTPUT MESSAGE
PUSHJ P,CALRET ;RESTORE ACS
JRST %ABORT ;AND GO TO FATAL ERROR HANDLER
CALRET: MOVNI T1,20 ;DROP THE ERROR STACK POINTER
ADDM T1,ERSTKP ;A BLOCK OF ACS
HRLZ 16,AERACS ;RESTORE ACS
BLT 16,16
%POPJ: POPJ P,
FOREC: MOVE P2,%ERPTR ;POINT TO ERROR BLOCK
PUSHJ P,EMSGT0 ;Get error message text
SKIPE MSGPC ;PC TO PRINT?
PUSHJ P,ADDPCM ;YES. Add PC to message text.
PUSHJ P,EMSGT1 ;Append null to string so can output msg.
MOVEI T1,ERRBUF ;POINT TO MESSAGE
HRLI T1,(POINT 7)
IF10,< OUTSTR (T1)> ;OUTPUT MESSAGE
IF20,< PSOUT% >
POPJ P,
;Routine to save the acs on the stack
;Call: PUSHJ P,SVEACS
; <return here>
SVEACS: DMOVEM 0,@ERSTKP ;SAVE 0 AND 1
MOVE 1,ERSTKP ;GET BASE OF SAVED ACS
MOVEM 1,AERACS ;SAVE FOR MSG
MOVEI 0,(1) ;SETUP FOR BLT
ADD 0,[2,,2] ;SAVE 2-17
BLT 0,17(1)
MOVEI 0,20 ;AND ADJUST THE ERROR STACK
ADDM 0,ERSTKP
POPJ P,
;ROUTINE TO FIND THE NEXT PC ON THE STACK
;ARG: P1 = POINTER TO STACK
;RETURN: P1 = UPDATED TO PAST RETURNED PC, 0 IF NO PC FOUND
; T1 = PC OF PUSHJ
; T2 = DEST ADDRESS OF PUSHJ
; T3 = ADDRESS OF ARG LIST
GETPC: XMOVEI P1,(P1) ;GET EXTENDED ADDR
GETPCL: MOVE T1,(P1) ;GET SOMETHING OFF STACK
CAMN T1,['STOP!!'] ;MAGIC END-OF-STACK CONSTANT?
JRST GETPCE ;YES, GO RETURN END-OF-STACK INDICATION
CAMGE P1,PDLBOT ;MIGHT NOT BE A TRACE USER
JRST GETPCE ;SO LEAVE IF BELOW PDP FOR %ERINI
SKIPN %FSECT ;NON-ZERO SECTION?
TLZ T1,-1 ;[3151] No, discard section 0 flag bits
TLNE T1,(77B5) ;[3151] Leftmost 6 bits must be zero by now
SOJA P1,GETPCL ;[3151] Nope, can't be a saved PC
PUSHJ P,ADRCHK ;CHECK THAT ADDRESS IS REASONABLE
SOJA P1,GETPCL ;NOT, NOT A PC
MOVE T1,(P1) ;GET ENTIRE ADDR AGAIN
SKIPN %FSECT ;SECTION ZERO?
TLZ T1,-1 ;[3151] Yes, throw away flag bits
HLLZM T1,PCSECT ;SAVE SECTION #
SUBI T1,1 ;DECR PC
HLRZ T2,(T1) ;GET INSTRUCTION POINTED TO BY STACK
TRZ T2,37 ;TURN OFF INDIRECT AND INDEX
CAIE T2,(PUSHJ P,) ;A SUBROUTINE CALL?
SOJA P1,GETPCL ;NO, NOT A PC
HLRZ T2,-1(T1) ;GET INSTRUCTION BEFORE THE PUSHJ
TRZ T2,37 ;TURN OFF INDIRECT AND INDEX
CAIE T2,(MOVEI L,) ;CORRECT?
CAIN T2,(XMOVEI L,) ; (The other choice)
TRNA ;Yes
SOJA P1,GETPCL ;NO
MOVE T3,(T1) ;GET THE PUSH INST
TLNE T3,17 ;INDEXED?
JRST UNKDST ;YES. DESTINATION UNKNOWN
HRRZ T2,(T1) ;GET THE PUSHJ INST DEST
HLL T2,PCSECT ;GET SECTION FROM CALLER ADDR
TLNE T3,(@) ;INDIRECT?
XMOVEI T2,@(T2) ;[4003] YES. GET DEST ADDR OF PUSHJ
HLRZ T3,(T2) ;GET INSTRUCTION AT THAT ADDRESS
CAIE T3,(JSP 1,) ;POSSIBLE OVRLAY CALL?
JRST GETPC1 ;NO
HRRZ T3,(T2) ;GET RH OF JSP
MOVE T4,-1(T3) ;GET WORD BEFORE JSP TARGET
CAME T4,['.OVRLA'] ;IS IT LINK'S OVERLAY ROUTINE?
JRST GETPC1 ;NO, NOT AN OVERLAY CALL
MOVE T2,(T3) ;GET THE WORD AFTER THE JSP
TLO T2,(IFIW) ;MAKE IT A LOCAL
TLZ T2,(1B1) ;[3147] Clear the undefined IFIW bit
XMOVEI T2,@T2 ;GET THE DEST ADDR OF THE OVERLAY CALL
JRST GETPC1 ;AND PROCESS IT
UNKDST: XMOVEI T2,1+[EXP <SIXBIT /UNKNWN/>,0]
GETPC1: MOVE T3,-1(T2) ;GET ROUTINE NAME
TLNN T3,770000 ;FIRST 6 BITS NON-ZERO?
JRST ZERARG ;YES. THERE IS NO ARG LIST
MOVE T4,-1(T1) ;GET XMOVEI OR MOVEI AGAIN
TLNE T4,17 ;INDEXED?
JRST ZERARG ;YES. UNKNOWN ARG LIST
HRRZ T3,-1(T1) ;GET ARG LIST ADDRESS FROM MOVEI INSTRUCTION
HLL T3,PCSECT ;ADD IN SECTION #
TLNE T4,(@) ;INDIRECT XMOVEI?
XMOVEI T3,@(T3) ;YES. RESOLVE IT
MOVS T4,-1(T3) ;GET ARG COUNT FROM -1 WORD OF LIST
CAIL T4,400000 ;MUST BE NEGATIVE
CAILE T4,777777
JUMPN T4,GETPCN ;OR ZERO
SOJA P1,%POPJ ;DONE
GETPCN: SOJA P1,GETPCL ;NOT SO, NOT A POSSIBLE PC
ZERARG: XMOVEI T3,1+[EXP <0>,<0>] ;POINT T3 AT NULL ARG LIST
SOJA P1,%POPJ ;DONE
GETPCE: SETZ P1, ;FLAG THAT PDL IS DONE
SETZ T1, ;Return a zero.
XMOVEI T2,1+[EXP <SIXBIT /UNKNWN/>,0]
XMOVEI T3,1+[EXP <0>,<0>] ;NO ARGS
POPJ P, ;DONE
;ROUTINE TO ADDRESS CHECK A PC
;ARG: T1 = ADDRESS
;SKIP RETURN IF ADDRESS OK, NONSKIP OTHERWISE
;ADDRESS IS OK IF IT'S IN LOW SEGMENT, HIGH SEGMENT, OR FOROTS
ADRCHK:
IF10,< ;[3151] This code doesn't work for Tops-20
CAIGE T1,140 ;BELOW LOW SEG START?
POPJ P, ;NO, BAD
CAMG T1,.JBREL ;BELOW LOW SEG END?
JRST %POPJ1 ;YES, FINE
SKIPN T2,.JBHRL ;[4021]Is there a hi-segment?
POPJ P, ;[4021]No.
HRRZ T2,T2 ;[4021]Get end of High-Segment
MOVE T3,[XWD -2,.GTUPM];[4021]Set up for a GETTAB
GETTAB T3, ;[4021]Get hi-segment origin
POPJ P, ;[4021]GETTAB Error!
HLRZ T3,T3 ;[4021]Shift to Right-Half
CAIL T1,(T3) ;[4021]Is Addr.GE.Hi-Seg-Start-Addr
CAILE T1,(T2) ;[4021].AND.Addr.LE.Hi-Seg-End-Addr?
POPJ P, ;[4021]No, It's Bad
%POPJ1: AOS (P) ;YES, IT'S OK
POPJ P, ;ADDRESS IS ILLEGAL
> ;[3151] End of IF10
IF20,<
FH%EPN==1B19 ;[3162] Extended page number (Release 5 symbol)
TXNE T1,777B8 ;[3155] Does the page number fit on a KL ?
POPJ P, ;[3155] No, can't be a good address
LSH T1,-^D9 ;[3151] Change to page number
HRLI T1,.FHSLF ;[3151] Inquire about our process
SKIPE %FSECT ;[3217] Running in a non-zero section ?
TXO T1,(FH%EPN) ;[3162] Yes, don't let section 0 be defaulted
RPACS% ;[3151] See what the page's attributes are
ERJMP RETURN ;[3151] Definitely not a return PC, punt
TXNE T2,PA%PEX ;[3151] Does the page exist ?
AOS (P) ;[3151] Yes, set up for skip (success return)
RETURN: POPJ P, ;[3151] Return
> ;[3151] End of IF20
;%EMSGT - Get error message text in ERRBUF.
; This routine just sets it up, it does not type it.
; (In case of taking the ERR= branch you don't want to!).
;Input:
;P2 points to error arg block.
%EMSGT: PUSHJ P,EMSGT0 ;Get message text with no null
;Enter here to append null to error string
EMSGT1: MOVE T1,INICHR ;GET INITIAL CHAR AGAIN
CAIE T1,"[" ;OPEN BRACKET?
JRST EMSNUL ;NO. GO INSERT NULL
MOVEI T1,"]" ;YES, TYPE CLOSING BRACKET
PUSHJ P,EPUTCH
EMSNUL: MOVEI T1,15 ;ADD CRLF
IDPB T1,ERRPTR
MOVEI T1,12
IDPB T1,ERRPTR
SETZ T1, ;And store a null
IDPB T1,ERRPTR
POPJ P, ;Return
EMSGT0: MOVE P3,%MSG(P2) ;MAKE POINTER TO INPUT ERROR STRING
MOVE T1,[POINT 7,ERRBUF] ;SET POINTER TO START OF OUTPUT ERR STRING
MOVEM T1,ERRPTR
MOVEI T1,5*LERRBF-1 ;SET COUNT (LEAVE SPACE FOR A NULL)
MOVEM T1,ERRCNT
XMOVEI T1,%ARGS-1(P2) ;GET ARG POINTER
MOVEM T1,ARGPTR
MOVE T1,%CHR(P2) ;GET INITIAL CHAR
CAIN T1,"$" ;INDIRECT CHAR?
PUSHJ P,GETARG ;YES, GET PREFIX CHAR
MOVEM T1,INICHR ;SAVE IT
CAIN T1,"@" ;IS IT REALLY BAD?
MOVEI T1,"?" ;YES. SUBSTITUTE A QUERY
PUSHJ P,EPUTCH ;Type it.
ENXTCH: ILDB T1,P3 ;GET NEXT CHAR FROM MSG
JUMPE T1,%POPJ ;END. WE'RE DONE
CAIE T1,"$" ;SPECIAL CHAR?
JRST ECHR ;NO, JUST NORMAL TEXT CHAR
ILDB T1,P3 ;GET NEXT CHAR
MOVSI T2,-LERRTB ;GET AOBJN POINTER TO ERR TABLE
ERTBLP: HLRZ T3,ERRTAB(T2) ;GET CHAR
CAIE T1,(T3) ;MATCH?
AOBJN T2,ERTBLP ;NO, KEEP LOOKING
JUMPGE T2,ENXTCH ;NOT FOUND, IGNORE
HRRZ T2,ERRTAB(T2) ;GET ROUTINE ADDRESS
PUSHJ P,(T2) ;CALL ROUTINE
JRST ENXTCH ;LOOP
ECHR: PUSHJ P,EPUTCH ;PUT CHAR IN OUTPUT STRING
JRST ENXTCH ;LOOP
;TABLE OF SPECIAL CHAR ACTIONS IN MESSAGES
ERRTAB: XWD "A",$A ;ASCIZ STRING
XWD "O",$O ;OCTAL NUMBER
XWD "S",$S ;SIXBIT WORD
XWD "N",$N ;NAME OF ROUTINE (SIXBIT) FROM %ERNAM [NO ARG]
XWD "5",$5 ;RADIX50 WORD
XWD "P",$P ;ERROR PC, OCTAL [NO ARG]
LERRTB==.-ERRTAB
$N: MOVE T2,%ERNAM
NOPLP: JUMPE T2,%POPJ ;DONE IF ONLY SPACES LEFT
SETZ T1, ;CLEAR CHAR
LSHC T1,6 ;GET CHAR
ADDI T1,40 ;CONVERT TO ASCII
CAIE T1,"." ;PRINT IF NOT DOT
PUSHJ P,EPUTCH ;OUTPUT CHAR
JRST NOPLP
$S: PUSHJ P,GETARG
SIXTYP: MOVE T2,T1
SIX1: JUMPE T2,%POPJ
SETZ T1,
LSHC T1,6
ADDI T1,40
PUSHJ P,EPUTCH
JRST SIX1
PCTYP: HLRZ T1,MSGPC ;GET SECTION #
JUMPE T1,PCTYP0
PUSHJ P,OCTTYP ;Type section #
MOVEI T1,","
PUSHJ P,EPUTCH
PUSHJ P,EPUTCH ;",,"
PCTYP0: HRRZ T1,MSGPC ;GET LOCAL ADDR
PJRST OCTTYP
$A: PUSHJ P,GETARG ;GET ADDRESS OF STRING
ASCTYP: HRLI T1,(POINT 7,) ;MAKE INTO BYTE POINTER
MOVE T4,T1 ;PUT IN SAFE PLACE
ASCLP: ILDB T1,T4 ;GET CHAR OF STRING
JUMPE T1,%POPJ ;NULL TERMINATES STRING
PUSHJ P,EPUTCH ;TYPE CHAR
JRST ASCLP ;LOOP
$O: PUSHJ P,GETARG ;GET ARG IN T1
OCTTYP: MOVEI T3,^D8
NUMLP: LSHC T1,-^D35
LSH T2,-1
DIVI T1,(T3)
JUMPE T1,.+4
PUSH P,T2
PUSHJ P,NUMLP
POP P,T2
MOVEI T1,"0"(T2)
PJRST EPUTCH
$P: MOVE T1,%ERPDP ;GET PDP OF ERROR.
MOVE T1,(T1) ;GET THE CALLER ADDR+1
SUBI T1,1 ;GET ADDR OF CALL
PJRST OCTTYP ;TYPE IT IN OCTAL
;Routine called to append the PC to the error message.
ADDPCM: MOVEI T1,[ASCIZ/ at PC /]
PUSHJ P,ASCTYP
PJRST PCTYP ;GO TYPE PC IN OCTAL
$5: PUSHJ P,GETARG ;GET ARG IN T1
JUMPE T1,%POPJ
PUSH P,T1
MOVEI T1," "
PUSHJ P,EPUTCH
POP P,T1
R50TYP:
R50LP: IDIVI T1,50
JUMPE T1,.+4
PUSH P,T2
PUSHJ P,R50LP
POP P,T2
JUMPE T2,%POPJ
MOVEI T1,<"0"-R50(0)>(T2)
CAILE T1,"9"
ADDI T1,"A"-R50(A)-"0"+R50(0)
CAILE T1,"Z"
SUBI T1,-<"$"-R50($)-"A"+R50(A)>
CAIN T1,"$"-1
MOVEI T1,"."
JRST EPUTCH
EPUTCH: AOS COLCNT ;KEEP TRACK OF WHAT COL WE'RE ON
SOSL ERRCNT ;DECREMENT COUNT OF CHARS LEFT
IDPB T1,ERRPTR ;SPACE LEFT, STORE CHAR
POPJ P,
OFFTYP: JUMPE T1,%POPJ ;DON'T TYPE 0
PUSH P,T1 ;SAVE IT
CAIGE T1,0 ;POSITIVE?
SKIPA T1,["-"] ;NO
MOVEI T1,"+" ;YES
PUSHJ P,EPUTCH ;TYPE SIGN
POP P,T1
MOVM T1,T1
JRST OCTTYP ;TYPE OCTAL NUMBER
;GETARG - GETS THE NEXT ARG ON THE ARGUMENT LIST.
;DOES NOT SUPPORT INDEXING OR INDIRECTION
GETARG: AOS T1,ARGPTR ;GET CURRENT POINTER
MOVE T1,(T1) ;GET ARG ADDR
CAIG T1,17 ;IS ARG IN AC?
JRST ACARG ;YES. GO GET IT
HLL T1,ARGPTR ;ADD SECTION # OF CALLER
MOVE T1,(T1) ;GET ACTUAL ARG
POPJ P,
ACARG: ADD T1,AERACS ;POINT TO SAVED AC
MOVE T1,(T1) ;GET ACTUAL ARG
POPJ P,
$AERR (?,ILC,0,-1,Illegal character in data)
$ERR (%,IOV,0,-1,Integer overflow)
$ERR (%,FOV,0,-1,Floating overflow)
$ERR (%,FUN,0,-1,Floating underflow)
$ERR (%,FTS,0,-1,Output field width too small)
SEGMENT DATA
%FWVAL: BLOCK 1 ;FIELD WIDTH
%XPVAL: BLOCK 1 ;EXPONENT WIDTH
%DWVAL: BLOCK 1 ;DECIMAL (FRACTION) WIDTH
%SCLFC: BLOCK 1 ;SCALE FACTOR
%BZFLG: BLOCK 1 ;BLANK=ZERO FLAG
%SPFLG: BLOCK 1 ;FORCE "+" FLAG
%FTAST: BLOCK 1 ;OUTPUT ASTERISKS ON OVERFLOW
IO.ADR: BLOCK 1 ;I/O ADDRESS
IO.TYP: BLOCK 1 ;I/O DATA TYPE
%DEINF: BLOCK 1 ;DECIMAL POINT OR EXPONENT FOUND
ILLEG.: BLOCK 1 ;ILLEGAL INPUT FLAG
%FTSLB: BLOCK 1 ;SUPPRESS LEADING BLANKS FOR OUTPUT
%ERTYP: BLOCK 1 ;VARIABLE TYPE
%UNFXD: BLOCK 4 ;UNFIXED RESULT
%FIXED: BLOCK 4 ;FIXED RESULT
%ERNM1: BLOCK 1 ;ERROR CLASS NUMBER
%ERNM2: BLOCK 1 ;2ND ERROR NUMBER
%ERNAM: BLOCK 1 ;ROUTINE NAME FOR MESSAGE
%ERRPC: BLOCK 1 ;PC TO TYPE
%ERPTR: BLOCK 1 ;POINTER TO ERROR BLOCK
%ERPDP: BLOCK 1 ;STACK POINTER FOR GETPC, NOSYM
%ERCHR: BLOCK 1 ;ERROR CHAR FOR I/O ERRORS
%EJFN: BLOCK 1 ;JFN FOR OUTPUT OF ERROR MSGS
%TRFLG: BLOCK 1 ;FLAG FOR TRAP IN PROGRESS
%TRPDP: BLOCK 1 ;PDP FOR TRACE
ERSTKP: BLOCK 1 ;ERROR AC STACK POINTER
ERRSTK: BLOCK 60 ;ERROR AC STACK
MSGPC: BLOCK 1 ;PC FOR MESSAGE
AERACS: BLOCK 1 ;ADDRESS OF SAVED ACS
LERRBF==60
ERRBUF: BLOCK LERRBF ;BUFFER FOR THE ERROR MESSAGE
ERRCNT: BLOCK 1 ;COUNT OF CHARS LEFT IN IT
ERRPTR: BLOCK 1 ;POINTER TO NEXT FREE CHAR
ERRARG: BLOCK 1 ;ARG TO $<N>X COMMAND
COLCNT: BLOCK 1 ;COLUMN NUMBER
ARGPTR: BLOCK 1 ;POINTER TO NEXT ARG
INICHR: BLOCK 1 ;INITIAL ERROR CHAR
%FSECT: BLOCK 1 ;LH=SECTION NUMBER OF ERROR ROUTINE
PCSECT: BLOCK 1 ;SECTION OF CALLER ROUTINE
PDLBOT: BLOCK 1 ;PDP BOTTOM IN CASE NON-TRACE STACK
SEGMENT CODE
PRGEND
TITLE ABORT
SEARCH MTHPRM
FSRCH
ENTRY %ABORT,ABORT.
ABORT.:
%ABORT:
IF10,< EXIT >
IF20,< HALTF%
JRST .-1>
END