Google
 

Trailing-Edge - PDP-10 Archives - bb-4157h-bm_fortran20_v10_16mt9 - fortran-ots-debugger/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(4011)

;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 *****

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.

\

	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, 1985
;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, 1985
;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, 1985
;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

	SKIPE	T2,.JBHRL	;GET HIGH SEG POINTER
	CAILE	T1,(T2)		;COULD ADDRESS BE IN HIGH SEG?
	 POPJ	P,		;NO
	HLRZ	T3,T2		;GET HIGH SEG LENGTH
	SUBI	T2,(T3)		;GET HIGH SEG ORIGIN
	CAIL	T1,(T2)		;IS ADDRESS IN HIGH SEG?
%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