Trailing-Edge
-
PDP-10 Archives
-
bb-h138f-bm
-
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