Google
 

Trailing-Edge - PDP-10 Archives - BB-H138F-BM_1988 - 7-sources/mthdyn.mac
There are 3 other files named mthdyn.mac in the archive. Click here to see a list.
	TITLE	MTHDYN -- TOPS-20 RTL interface to MTHLIB

	SEARCH	DYNSYM,DDBSYM,MONSYM,MACSYM,MTHPRM

;
;	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1984, 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 THAT IS NOT SUPPLIED BY DIGITAL.
;

COMMENT \

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

MTHDUM.MAC

3224	JLC	10-Dec-82
	New module, derived from FORERR, for MACRO use of
	the math library.

***** Start MTHDYN.MAC *****

V1.0

	DD-B	9-NOV-83
	Start making this part of the dynamic run-time library.
	Restriction: MTHLIB routines cannot be reentered.  MTHLIB
	itself cannot be reentered.  Don't call MTHLIB routines from
	places that can be reached by interrupting out of MTHLIB!

Version 1.1

;.EDIT 50	Formally go to version 1.1, update copyright, insert V1.1
;			development changes (previously V2)
;		DDB,15-Jan-85,SPR:NONE

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

\
	SALL

	ENTRY	MTHER.

	INTERN PDLBOT
	INTERN %FSECT,%LFIXD,%LERTP

	EXTERNAL RTLERS,SG$SIG,SG$DLG

	SEGMENT	CODE

; This, as far as I am concerned, is the guts of the whole thing.
; This routine is called by the $LERR macros that exist in MTHLIB.  
; The PUSHJ P, in the $LERR call is followed by an error block (see definition
; of $lerr in MTHPRM) which gives error information.  In addition, this
; relies on many globals.

MTHER.:	POP	P,%ERPTR	;SAVE ERROR BLOCK POINTER
	MOVEM P, %ERPDP
	SAVACS			;Save 0-16 on stack
	XMOVEI T0, .SVAC0(17)	;Get address of AC0
	MOVEM T0, AERACS	;Need to know how to find them later
	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	P1,%ERPDP	;GET ERROR STACK PNTR AGAIN
	PUSHJ	P,GETPC		;GET CALLER ADDR
				;(returns T1, T2, T3)
	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

; Cheat -- we will now ask RTLERS to make us a block for our own nefarious
; purposes.
MMGLEN==60			;Length to allow for message in words
	PUSH P, [MMGLEN,,0]
	PUSH P, [MT$OEM]
	CALL RTLERS
	MOVE P7, T1		;Save SG block address
	MOVE T1, %ERRPC
	MOVEM T1, .SGPC(P7)	;PC call to MTHLIB that got error
	SETZM .SGDAT(P7)	;No user data
	XMOVEI T1, .SGLEN(P7)	;There is no DATA area
				;Put message over the EXTRA and MESSAGE areas
	TXO T1, 67B5		;9-BIT OWGBP
	MOVEM T1, .SGMSG(P7)	;Message pointer
	MOVEM T1, ERRPTR
	MOVX T1, MMGLEN*4-1
	MOVEM T1, ERRCNT

FOREC:	MOVE	P2,%ERPTR	;POINT TO ERROR BLOCK
	PUSHJ	P,EMSGT0	;Get error message text with no NUL
	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.
	
; Now we have a MT$OEM block all filled out, address in P7
; Now make an MT$ERR block, point it at the OEM block, and signal it
	PUSH P, %ERNM1
	PUSH P, %ERNM2
	PUSH P, %LERTP
	XMOVEI T1, %LFIXD
	PUSH P, T1
	PUSH P, [4]
	PUSH P, [MT$ERR]
	CALL RTLERS
	MOVE T0, %ERRPC
	MOVEM T0, .SGPC(T1)
	MOVEM P7, .SGNXT(T1)
	MOVEM T1, P7
	CALL SG$SIG
	MOVE T1, P7
	CALL SG$DLG		;De-allocate the signal chain

	RSTACS			;Restore saved ACs if continued
	; fall through to exit

; Used to do conditional POPJ with a JUMPE, SOJLE, or whatever
%POPJ:	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

	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
	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 CX,)	;CORRECT?
	CAIN	T2,(XMOVEI CX,)	; (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,@0(T2)	;YES. GET DEST ADDR OF PUSHJ
				;Note: if multi-level indirect, indexing after
				;the first level won't be trapped, but still
				;won't work.  This could give faulty error 
				;reports.
	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 page number is valid and page exists.

ADRCHK:
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
	TXO	T1,(FH%EPN)	;[3162] 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
;%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:	SETZ	T1,		;And store a null
	IDPB	T1,ERRPTR
	POPJ	P,		;Return

; This is a subroutine.
; Arguments:
;	P2/	Address of error block
;	ERRPTR/	Pointer to destination string
;	ERRCNT/ Count of characters available at destination string

EMSGT0:	GETBP P3, %MSG(P2), T1	;Get proper byte pointer to input error string

; Take the pointer to output error string in ERRPTR on entry
; Take the count of characters available at ERRPTR in ERRCNT on entry

	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
S1:	JUMPE	T2,%POPJ
	SETZ	T1,
	LSHC	T1,6
	ADDI	T1,40
	PUSHJ	P,EPUTCH
	JRST	S1

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,

	SEGMENT	DATA

%ERTYP:	BLOCK	1		;VARIABLE TYPE

%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

%TRPDP:	BLOCK	1		;PDP FOR TRACE

ERSTKP:: BLOCK	1		;ERROR AC STACK POINTER (IFIW)
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
%LFIXD:	BLOCK 1			;User-fixed result of routine
%LERTP: BLOCK 1			;Error type code

	END