Google
 
Trailing-Edge - PDP-10 Archives - FORTRAN-10_V7wLink_Feb83 - mthprm.unv
There are 28 other files named mthprm.unv in the archive. Click here to see a list.
x,5V@P H@ I6N 0h#
 IRP A,1<
  IRP B,<
  1( DEFINE TXAB (A1HC,E) <
3( IFE <1h<E>&777777000000>2,<TRAB AC,<E> ;2(>     IFE <<E>&002H0000777777>,<TLA2hB AC,(E) ;> 			 3   TDAB AC,[E]
   > ;END TXYZ
3H  > ;END IRP B
3h > ;END IRP A
> ;END IRP A
I` (("
	XALL
H
	ENTRY	DFL.A		;hENTRY POINT TO DFL.A
	SIXBIT	/DF(L.A/
DFL.A:	MOHVEI	A+1,0		;CLEAhR LOW ORDER WORD
	ASHC	A,-8		;MA(KE ROOM FOR EXPONHENT IN HI WORD
	hTLC	A,243000	;SET EXP TO 27+8 DEC(IMAL
	DFAD	A,[EHXP 0,0]	;NORMALIZhE
	POPJ	P,		;RETURN A=THE DOUBLE( PRECISION RESULT
I5 `I5  I5M `I?,+	 _ KJ 4KJU\ 4L@ M8,8QP M8,;yP M8,x2P M8,xtP M8,{zP M8,|P M8,|P M8-YP M8-P M8-\P M8.(2P M8.(tP M8.+ZP M8.+zP M8.,P M8.,P M8.,YP M8.\P 	M8.|YP MJ,X1@ MO: ,H#
	SALL
	,hSEARCH	JOBDAT		;[-3207] For  .JBxyz-(   symbols.    Th-His
				;[3207] *-hMUST* preceed  th.e search  of
			.(	;[3207] UUOSYM, .Hwhich contains EX.hTERNs
				;[3207/] of the JOBDAT s/(ymbols.
IF10,<	S/HEARCH	UUOSYM,MACT/hEN>

IF20,<	SEA0RCH	MONSYM,MACSYM0(>

	.DIRECT	FLBLST
DIRECT	FLBMQ
Q MQP MR<kP MR]@Q MRlQ MS8zQ MS

@Q MVt= [h%p
 IF2,<IF\NDEF A,<EXTERN \(A>>
 .ARGN.=0
 \HIRP B,<.ARGN.=.A\hRGN.+1>
	PUSH	P,]L
	XMOVEI	L,1+[-](.ARGN.,,0
		    ]H IRP B,<IFIW!<B]h>>] 
	PUSHJ	P,A^
	POP	P,L
 PURGE	.ARGN.
 PURGND@ NH@ NL@ NP@ OI  @O

@ @O&` `OO OO

@ @OfL@ On @O  `O0  O>|H\ b&
	POPJ	P,

	POPJ	P,ONt{  Qf@ +QeK` ^H&


 IFNB <^hB>,<
  IFDIF <B_><.>,<
	ENTRY A_(
	SIXBIT /B/
_HA:
  > ;END IFDI_hF

  IFIDN <B>`<.>,<
	ENTRY A.`(
	SIXBIT /A./
`HA.:
  > ;END IF`hIDN
 > ;END IFNBa

 IFB <B>,<
a(	ENTRY A
	SIXBIaHT /A/
A:
 > ;END IFB

 > ;S0 h(Z
	XALL

	ENTRY	IDF.A
	(SIXBIT	/IDF.A/
HIDF.A:	PUSH	P,L	h	;SAVE THE SCRATCH REG
	HLRE	L,A(		;GET THE EXPONEHNT
	ASH	L,-9		;RhIGHT 8 BITS
	JUMPGE	A,IDF.XT	;JU(MP IF POS.
	DMOVHN	A,A		;NEGATE
	TRC	L,-1		;COMPLEMENT THE EXPONE(NT
IDF.XT:	TLZ	HA,777000	;CLEAR ThHE EXPONENT
	ASH	C	A,-201-^D26(L)	(	;CHANGE FRACTION	H TO INTEGER
	TLN	hE	L,400000	;SKIP 
IF POS.
	MOVN	A
(,A		;NEGATE
	PO
HP	P,L		;RESTORE T
hHE SCRATCH REG
	POPJ	P,		;RETURN (A=FIXED NUMBER
S
 )8IFN FT10S "MIFN FT20SNp @UKI@ +X@ [0$P [?7 4H#8
 IFE <<4(B>&777777000000>,4h<MOVEI A,<B> ;>5  IFE <<B>&000005(0777777>,<MOVSI 5HA,(B) ;>  IFE <<5hB>_-22 - 777777>6,<HRROI A,<<B>&6(777777> ;>  IFE <6H<B>&777777-777776h7>,<HRLOI A,<<B7>_-22> ;> 			 MOVE A,[B]
 MOV]? ``@ `D@ `H@ `L@ `P@ a

,TQ  a

,Q a

,*9Q a

,>(Q  a

,>(Q a

,k{Q a

,m3Q a

-J8Q @a

-iQ a

-}SQ @a

.Z7Q a

.\yQ a+= 5a?H6 +dU 7H#<<RADIX50 0,A><RADIX50 0f@ g=Y7 8%Z

  IFDE8(F $SEG$,<
IF1,<I8HFE <$SEG$-1>,<.EN8hDPS>>
IF2,<IFE <9$SEG$-2>,<.ENDPS>9(
    IFN <$SEG$-9H2>,<$SEG$==2>
 >9h ;END IF2
> ;END: IFDEF $SEG$

 :( IFNDEF $SEG$,<
:HIF1,<	$SEG$==1>
ZhIF2,<	$SEG$==2>
[> ;END IFNDEF

[(	.PSECT	.A.
	$NAME$=='A'
 $Ng:8 h)0
	XALL



	ENTRY	SNG.A
	

(SIXBIT	/SNG.A/


HSNG.A:	JUMPL	A,

hSNG3		;NEGATIVE A
	TLNE	1)	;POSITI
	TRON	A,1		;YES, TRY TO ROUND( BY SETTING LSB
H	  POPJ	P,		;WE WhON, FINISHED
	MOVE	A+1,A		;COPY( HIGH PART OF ARGH
	AND	A,[777000h,,1]	;MAKE UNNORMALIZED LSB, SAME (EXPONENT
	FAD	AH,A+1		;ROUND & RhENORMALIZE
	POPJ	P,

;HERE IF A(RG IS NEGATIVE
SHNG3:	DMOVN	A,A	h	;MAKE POSITIVE
	TLNE	A+1,(1B1)	(;NEED ROUNDING?
H	TRON	A,1		;YES,h TRY TO DO IT BY SETTING LSB
	JRS(T	SNG4		;DONE
	MHOVN	A+1,A		;MAKhE RE-NEGATED COPY OF HIGH PART
	O(RCA	A,[777,,-1]	H;GET UNNORM NEG LhSB WITH SAME EXPONENT
	FADR	A,A(+1		;ROUND & NORMHALIZE
	POPJ	P,
h
SNG4:	MOVN	A,A		;RE-NEGATE
	POPJ	P,		;EXIT
h@@ hD@ hH@ hL@ hP@ hT@ i@*@P i@*0P i@*PP i@,:P i@,<P i@,LP i@,LP i@,LP i@,LP i@-ZP i@-HVP i@-J:P i@-KsP i@.<P i@.<P i@.YP iX bH&R

 TITLEbh A  B
 FSRCH
c
 VMAJOR==<VMINOc(R==<VEDIT==<VWHO=cH=0>>>
%VWHO==0

 IRPC B,<

d  IFLE <"B"-"A">d(*<"B"-"Z">,<VMINdHOR==VMINOR*^D26 +dh "B" - "A" + 1>

  IFLE <"B"-"e(0">*<"B"-"9">,<VeHMAJOR==VMAJOR*^D8eh + "B" - "0">
f
fIFIDN <B><(>,f(<%VMAJOR==VMAJOR
		VMAJOR==0>

fh  IFIDN <B><)>,<gVEDIT==VMAJOR
		g(VMAJOR==%VMAJOR>

  IFIDN <B><-gh>,<%VMAJOR==VMAJOhR
		VMAJOR==0
	h(	%VWHO==-1>
 > ;hHEND IRPC

 IFN hh%VWHO,<VWHO==VMAJiOR
	    VMAJOR==i(%VMAJOR>

	DEFIiHNE	VER <	BYTE	(3)ihVWHO(9)VMAJOR(6)VjMINOR(18)VEDIT>
j(
 PURGE %VMAJOR,%VWHO
%VMAJOR,ib Xh%R
    IFE Y<<B>&77777700000Y(0>,<TRC A,<B> ;YH>     IFE <<B>&0Yh00000777777>,<TLCZ A,(B) ;> 			  Z(  TDC A,[B]
   DC A,[B]
  ib Vh%B
 IFE W<<B>&77777700000W(0>,<TRCA A,<B> WH;>     IFE <<B>&Wh000000777777>,<TLXCA A,(B) ;> 			X(    TDCA A,[B]
ibCA A,[B]
 IFE U<<B>&77777700000U(0>,<TRCE A,<B> UH;>     IFE <<B>&Uh000000777777>,<TLVCE A,(B) ;> 			V(    TDCE A,[B]
ibCE A,[B]
 IFE S<<B>&77777700000S(0>,<TRCN A,<B> SH;>     IFE <<B>&Sh000000777777>,<TLTCN A,(B) ;> 			T(    TDCN A,[B]
ibpCN A,[B]
    IFE A<<B>&77777700000A(0>,<TRN A,<B> ;AH>     IFE <<B>&0Ah00000777777>,<TLNB A,(B) ;> 			  B(  TDN A,[B]
   DN A,[B]
  ibt >h$
 IFE ?<<B>&77777700000?(0>,<TRNA A,<B> ?H;>     IFE <<B>&?h000000777777>,<TL@NA A,(B) ;> 			@(    TDNA A,[B]
ibtNA A,[B]
 IFE =<<B>&77777700000=(0>,<TRNE A,<B> =H;>     IFE <<B>&=h000000777777>,<TL>NE A,(B) ;> 			>(    TDNE A,[B]
ibuNE A,[B]
 IFE ;<<B>&77777700000;(0>,<TRNN A,<B> ;H;>     IFE <<B>&;h000000777777>,<TL<NN A,(B) ;> 			<(    TDNN A,[B]
ibxNN A,[B]
    IFE Q<<B>&77777700000Q(0>,<TRO A,<B> ;QH>     IFE <<B>&0Qh00000777777>,<TLOR A,(B) ;> 			  R(  TDO A,[B]
   DO A,[B]
  ib| Nh%
 IFE O<<B>&77777700000O(0>,<TROA A,<B> OH;>     IFE <<B>&Oh000000777777>,<TLPOA A,(B) ;> 			P(    TDOA A,[B]
ib|OA A,[B]
 IFE M<<B>&77777700000M(0>,<TROE A,<B> MH;>     IFE <<B>&Mh000000777777>,<TLNOE A,(B) ;> 			N(    TDOE A,[B]
ib}OE A,[B]
 IFE K<<B>&77777700000K(0>,<TRON A,<B> KH;>     IFE <<B>&Kh000000777777>,<TLLON A,(B) ;> 			L(    TDON A,[B]
icPON A,[B]
    IFE I<<B>&77777700000I(0>,<TRZ A,<B> ;IH>     IFE <<B>&0Ih00000777777>,<TLZJ A,(B) ;> 			  J(  TDZ A,[B]
   DZ A,[B]
  icT Fh$B
 IFE G<<B>&77777700000G(0>,<TRZA A,<B> GH;>     IFE <<B>&Gh000000777777>,<TLHZA A,(B) ;> 			H(    TDZA A,[B]
icTZA A,[B]
 IFE E<<B>&77777700000E(0>,<TRZE A,<B> EH;>     IFE <<B>&Eh000000777777>,<TLFZE A,(B) ;> 			F(    TDZE A,[B]
icUZE A,[B]
 IFE C<<B>&77777700000C(0>,<TRZN A,<B> CH;>     IFE <<B>&Ch000000777777>,<TLDZN A,(B) ;> 			D(    TDZN A,[B]
jZN A,[B]
f@ q+= +
q6~i4 C 	 wH'D
	EXTERN whE.A
IFB <B>,<	xPUSHJ	P,E.A >
Ix(FNB <B>,<JRST	[PxHUSHJ P,E.A
			JRST B] >
			J	T86 y'P
	EXTERN y(E.A
IFB <B>,<	yHERCAL	E.A >
IFNyhB <B>,<	ERJMP	[PzUSHJ P,E.A
			JRST B] >
			J	  jh&|


IFNBk <B>,<
	ENTRY	Ek(.B
E.B:				;DEkHFINE THE ERROR IFkh NOT NULL
>

IlF2,<IFNDEF %OTSERl(,<EXTERN %OTSER>>lH
		PUSHJ	P,%OTSElhR	;ERROR CALL
		m"A"			;ERROR CHAm(RACTER
		SIXBIT	mH/B/		;ERROR PREFmhIX
		EXP	C,D		n;ERROR NUMBERS
	n(	POINT 7,[ASCIZ \nHE\]	;POINTER TO nhMESSAGE
		EXP	Go		;ATTRIBUTE G
o(IRP F,	<F>			;AoHRGUMENTS, IF ANY

NTS,IFANY'`
IF2,<IFNzhDEF L.A,<	EXTERN{	L.A >>
IFB <B{(>,<	PUSHJ	P,L.A {H>
IFNB <B>,<JRS{hT	[PUSHJ P,L.A
|			JRST B] >

	JRST B] >

	2.,@ p'

	ENTRYp(	L.B
L.B:
		PpHUSHJ	P,MTHER.##
ph		"A"			;ERROR CqHARACTER
		SIXBIq(T	/B/		;ERROR PRqHEFIX
		EXP	C,Dqh		;ERROR NUMBERS
		POINT 7,[ASCIZr( \E\]	;POINTER TrHO MESSAGE
		EXP	rhG		;ATTRIBUTE Gs
IRP F,	<F>			s(;ARGUMENTS, IF ANY

NTS, IF AN	2T86 |H'n
IF2,<IFN|hDEF L.A,<	EXTERN}	L.A>>
IFB <B>}(,<	ERCAL	L.A >
}HIFNB <B>,<	ERJMP}h	[PUSHJ P,L.A
			JRST B] >
		R ~('|
IF2,<IFN~HDEF T.A,<	EXTERN~h	T.A>>
IFB <B>,<	PUSHJ	P,T.A >(
IFNB <B>,<JRSTH	[PUSHJ P,T.A
			JRST B] >
		R.,@ sh'8

	ENTRYt	T.B
T.B:
		Pt(USHJ	P,%TRPER##
tH		"A"			;ERROR CthHARACTER
		SIXBIuT	/B/		;ERROR PRu(EFIX
		EXP	C,DuH		;ERROR NUMBERS
		POINT 7,[ASCIZv \E\]	;POINTER Tv(O MESSAGE
		EXP	vHG		;ATTRIBUTE Gvh
IRP F,	<F>			w;ARGUMENTS, IF ANY

NTS, IF AN|`P F P |@P P P P  P 	0P 	@P 
0P d|`P 20P 7pP ;-T P ;-T@P [ P S@P $hhP $hiP $hiP $khP $m(P $m)P %P %WP %ZP %7P %{P %LRP %LzP %m6P %xrP >}{woP