Google
 
Trailing-Edge - PDP-10 Archives - BB-D480F-SB_FORTRAN10_V10 - mthprm.unv
There are 28 other files named mthprm.unv in the archive. Click here to see a list.
x,5c@P CJ<Q CJ==rQ `CJ>N8Q I6N o
 IRP A,o0<
  IRP B,<
  oP DEFINE TXAB (AopC,E) <
qP IFE <p<E>&777777000000>p0,<TRAB AC,<E> ;pP>     IFE <<E>&00pp0000777777>,<TLAqB AC,(E) ;> 			 q0   TDAB AC,[E]
   > ;END TXYZ
qp  > ;END IRP B
r > ;END IRP A
> ;END IRP A
I` ZPu
	XALL
Zp
	ENTRY	DFL.A		;[ENTRY POINT TO DF[0L.A
	SIXBIT	/DF[PL.A/
DFL.A:	MO[pVEI	A+1,0		;CLEA\R LOW ORDER WORD
	ASHC	A,-8		;MA\PKE ROOM FOR EXPON\pENT IN HI WORD
	]TLC	A,243000	;SE]0T EXP TO 27+8 DEC]PIMAL
	DFAD	A,[E]pXP 0,0]	;NORMALIZ^E
	POPJ	P,		;RET^0URN A=THE DOUBLE^P PRECISION RESULT
%P%WI5 `I5  I5M `I?,+	 _ KJ 4KJU\ 4M8,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 MO: jpu
	SALL
	kSEARCH	JOBDAT		;[k03207] For  .JBxyzkP   symbols.    Thkpis
				;[3207] *lMUST* preceed  thl0e search  of
			lP	;[3207] UUOSYM, lpwhich contains EXmTERNs
				;[3207m0] of the JOBDAT smPymbols.
IF10,<	SmpEARCH	UUOSYM,MACTnEN>

IF20,<	SEAn0RCH	MONSYM,MACSYMnP>

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

@Q MVt= p
 IF2,<IFNDEF A,<EXTERN 0A>>
 .ARGN.=0
 PIRP B,<.ARGN.=.ApRGN.+1>
	PUSH	P,L
	XMOVEI	L,1+[-0.ARGN.,,0
		    P IRP B,<IFIW REMpOVE(B)>] 
	PUSH J	P,A
	POP	P,L
 PURGE	.ARGN.
 PURGE	.ARGN.
NDP NHP NLP NPP OI  @O$k pP
	 XMOVEIpp A,0		
	 SKIPN	qA		
	 JSP	A,bq0	
	 XSFM	A		
b:
SFM	A		
O

@ @O&` `OO OO

@ @OfL@ On @O  `O0  O>|H\ $0#
	POPJ	P,

	POPJ	P,ONt{  Qf@ +QeK`  p
 IFNB <!B>,<
  IFDIF <B!0><.>,<
	ENTRY A!P
	SIXBIT /B/
!pA:
  > ;END IFDI"F

  IFIDN <B>"0<.>,<
	ENTRY A."P
	SIXBIT /A./
"pA.:
  > ;END IF#IDN
 > ;END IFNB#0

 IFB <B>,<
#P	ENTRY A
	SIXBI#pT /A/
A:
 > ;END IFB

 > ;S0 _-
	XALL
0
	ENTRY	IDF.A
	_PSIXBIT	/IDF.A/
_pIDF.A:	PUSH	P,L	`	;SAVE THE SCRATC`0H REG
	HLRE	L,A`P		;GET THE EXPONE`pNT
	ASH	L,-9		;RaIGHT 8 BITS
	JUMa0PGE	A,IDF.XT	;JUaPMP IF POS.
	DMOVapN	A,A		;NEGATE
	TRC	L,-1		;COMPb0LEMENT THE EXPONEbPNT
IDF.XT:	TLZ	bpA,777000	;CLEAR TcHE EXPONENT
	ASHc0C	A,-201-^D26(L)cP	;CHANGE FRACTIONcp TO INTEGER
	TLNdE	L,400000	;SKIP d0IF POS.
	MOVN	AdP,A		;NEGATE
	POdpP	P,L		;RESTORE TeHE SCRATCH REG
	e0POPJ	P,		;RETURN ePA=FIXED NUMBER
S
 &IFN FT10S =IFN FT20SNp @UKI@ +XP [0$P [?7 rp+
 IFE <<rPB>&777777000000>,s<MOVEI A,<B> ;>s0  IFE <<B>&00000sP0777777>,<MOVSI spA,(B) ;>  IFE <<tB>_-22 - 777777>t0,<HRROI A,<<B>&tP777777> ;>  IFE <tp<B>&777777-77777u7>,<HRLOI A,<<Bu0>_-22> ;> 			 MOVE A,[B]
 MOV]? ``P `DP `HP `LP `PP 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 up/<RADIX50 0,A><RADIX50 0em}R kA20ek qp
	 TLZ	Ar,(PC%OVF+PC%FOV+Pr0C%FUF+PC%NDV) 
	rP XMOVEI	A+1,b	
	 TLNE	A+1,-1		s
	 XJRSTF	A		
s0	 HRR	A,A+1		
sP	 JRSTF	(A)		
b:
F	(A)		
fDP fHP fLP fPP g=Y7 v0i

  IFDEvPF $SEG$,<
IF2,<
IFE <$SEG$-1>,<$wSEG$==2
	TWOSEG	w0400000
  > ;END wPIFE $SEG$-1
IFE wp<$SEG$+1>,<$SEG$=x=2
	TWOSEG	40000x00
  > ;END IFE $xPSEG$+1
 > ;END IxpF2
> ;END IFDEF $SEG$

  IFNDEF0 $SEG$,<
	TWOSEGP	400000
IF1,<	$SpEG$==1>
IF2,<	$SEG$==2>
> ;END I0FNDEF $SEG$

	$PNAME$=='A'

  pIFE <$NAME$-'DATA'>,<		
   IFG $S0EG$,<
	RELOC
IFP1,<	$SEG$==-1>
IpF2,<	$SEG$==-2>>>

  IFN <$NAME$0-'DATA'>,<		
   PIFL $SEG$,<
	RELpOC
IF1,<	$SEG$==1>
IF2,<	$SEG$==2>>>
 	$SEG$==gh +g:8 f
	XALL
f0
	ENTRY	SNG.A
	fPSIXBIT	/SNG.A/
fpSNG.A:	JUMPL	A,gSNG3		;NEGATIVE Ag0RGUMENT?
	TLNE	gPA+1,(1B1)	;POSITIgpVE. ROUND REQUIREhD?
	TRON	A,1		;h0YES, TRY TO ROUNDhP BY SETTING LSB
hp	  POPJ	P,		;WE WiON, FINISHED
	MOi0VE	A+1,A		;COPYiP HIGH PART OF ARGip
	AND	A,[777000j,,1]	;MAKE UNNORMj0ALIZED LSB, SAME jPEXPONENT
	FAD	Ajp,A+1		;ROUND & RkENORMALIZE
	POPJk0	P,

;HERE IF AkPRG IS NEGATIVE
SkpNG3:	DMOVN	A,A	l	;MAKE POSITIVE
l0	TLNE	A+1,(1B1)	lP;NEED ROUNDING?
lp	TRON	A,1		;YES,m TRY TO DO IT BY m0SETTING LSB
	JRSmPT	SNG4		;DONE
	MmpOVN	A+1,A		;MAKnE RE-NEGATED COPYn0 OF HIGH PART
	OnPRCA	A,[777,,-1]	np;GET UNNORM NEG LoSB WITH SAME EXPOo0NENT
	FADR	A,AoP+1		;ROUND & NORMopALIZE
	POPJ	P,
p
SNG4:	MOVN	A,p0A		;RE-NEGATE
	POPJ	P,		;EXIT
h@P hD@ hHP hLP hPP hTP 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 [email protected]P iX $pe

 TITLE% A  B
 FSRCH
%0
 VMAJOR==<VMINO%PR==<VEDIT==<VWHO=%p=0>>>
%VWHO==0

 IRPC B,<

&0  IFLE <"B"-"A">&P*<"B"-"Z">,<VMIN&pOR==VMINOR*^D26 +' "B" - "A" + 1>

  IFLE <"B"-"'P0">*<"B"-"9">,<V'pMAJOR==VMAJOR*^D8( + "B" - "0">
(0
(IFIDN <B><(>,(P<%VMAJOR==VMAJOR
		VMAJOR==0>

)  IFIDN <B><)>,<)0VEDIT==VMAJOR
		)PVMAJOR==%VMAJOR>

  IFIDN <B><-*>,<%VMAJOR==VMAJO*0R
		VMAJOR==0
	*P	%VWHO==-1>
 > ;*pEND IRPC

 IFN +%VWHO,<VWHO==VMAJ+0OR
	    VMAJOR==+P%VMAJOR>

	DEFI+pNE	VER <	BYTE	(3),VWHO(9)VMAJOR(6)V,0MINOR(18)VEDIT>
,P
 PURGE %VMAJOR,%VWHO
%VMAJOR,ib E
    IFE 0<<B>&77777700000P0>,<TRC A,<B> ;p>     IFE <<B>&000000777777>,<TLC0 A,(B) ;> 			  P  TDC A,[B]
   DC A,[B]
  ib 5
 IFE 0<<B>&77777700000P0>,<TRCA A,<B> p;>     IFE <<B>&000000777777>,<TL0CA A,(B) ;> 			P    TDCA A,[B]
ibCA A,[B]
 IFE 0<<B>&77777700000P0>,<TRCE A,<B> p;>     IFE <<B>&000000777777>,<TL0CE A,(B) ;> 			P    TDCE A,[B]
ibCE A,[B]
 IFE 0<<B>&77777700000P0>,<TRCN A,<B> p;>     IFE <<B>&000000777777>,<TL0CN A,(B) ;> 			P    TDCN A,[B]
ibpCN A,[B]
    IFE 0<<B>&77777700000P0>,<TRN A,<B> ;p>     IFE <<B>&000000777777>,<TLN0 A,(B) ;> 			  P  TDN A,[B]
   DN A,[B]
  ibt }u
 IFE }0<<B>&77777700000}P0>,<TRNA A,<B> }p;>     IFE <<B>&~000000777777>,<TL~0NA A,(B) ;> 			~P    TDNA A,[B]
ibtNA A,[B]
 IFE {0<<B>&77777700000{P0>,<TRNE A,<B> {p;>     IFE <<B>&|000000777777>,<TL|0NE A,(B) ;> 			|P    TDNE A,[B]
ibuNE A,[B]
 IFE y0<<B>&77777700000yP0>,<TRNN A,<B> yp;>     IFE <<B>&z000000777777>,<TLz0NN A,(B) ;> 			zP    TDNN A,[B]
ibxNN A,[B]
    IFE 0<<B>&77777700000P0>,<TRO A,<B> ;p>     IFE <<B>&000000777777>,<TLO0 A,(B) ;> 			  P  TDO A,[B]
   DO A,[B]
ib| 
0<<IFE7777700000000000777777>,<TL0OA A,(B) ;> 			P    TDOA A,[B]
ib|OA A,[B]
    IFE 0<<B>&77777700000P0>,<TROE A,<B> p;>     IFE <<B>&

000000777777>,<TL

0OE A,(B) ;> 			

P  TDOE A,[B]
ib}OE A,[B]
    IFE 	0<<B>&77777700000	P0>,<TRON A,<B> 	p;>     IFE <<B>&
000000777777>,<TL
0ON A,(B) ;> 			
P  TDON A,[B]
icPON A,[B]
    IFE 0<<B>&77777700000P0>,<TRZ A,<B> ;p>     IFE <<B>&000000777777>,<TLZ0 A,(B) ;> 			  P  TDZ A,[B]
   DZ A,[B]
  icT 5
 IFE 0<<B>&77777700000P0>,<TRZA A,<B> p;>     IFE <<B>&000000777777>,<TL0ZA A,(B) ;> 			P    TDZA A,[B]
icTZA A,[B]
 IFE 0<<B>&77777700000P0>,<TRZE A,<B> p;>     IFE <<B>&000000777777>,<TL0ZE A,(B) ;> 			P    TDZE A,[B]
icUZE A,[B]
 IFE 0<<B>&77777700000P0>,<TRZN A,<B> p;>     IFE <<B>&000000777777>,<TL0ZN A,(B) ;> 			P    TDZN A,[B]
q  ZN A,[B]
f@ q+= +q+= +
q6~i4 C 	 GC
IFNB <BG0>,<PRINTX ?ACALL GPCONTINUATION ADDRGpESS SPECIFIED - IHGNORED>
	EXTERN	H0A.A
	PUSHJ	P,A.A

USHJ	P,A.	.,@ 6PS

	INTER6pN	A.B
A.B:

7 IF2,<IFNDEF %AER70R,<EXTERN %AERR>>7P
		PUSHJ	P,%AERR7p
		"A"			;ERROR8 CHARACTER
		SIX80BIT	/B/		;ERROR 8PPREFIX
		EXP	C,8pD		;ERROR NUMBER9S
		POINT 7,[ASC90IZ \E\]	;POINTER9P TO MESSAGE
		EX9pP	G		;ATTRIBUTE :G
IRP F,	<F>	:0		;ARGUMENTS, IF ANY

NTS, IF 	T86 E05
IFNB <BEP>,<PRINTX ?AJCAL EpCONTINUATION ADDRFESS SPECIFIED - IF0GNORED>
	EXTERN	FPA.A
	ERCAL	A.A

	ERCAL	A.A	.,@ 201

	INTER2PN	D.B
D.B:

2p IF2,<IFNDEF %DER3R,<EXTERN %DERR>>30
		PUSHJ	P,%DERR3P
		"A"			;ERROR3p CHARACTER
		SIX4BIT	/B/		;ERROR 40PREFIX
		EXP	C,4PD		;ERROR NUMBER4pS
		POINT 7,[ASC5IZ \E\]	;POINTER50 TO MESSAGE
		EX5PP	G		;ATTRIBUTE 5pG
IRP F,	<F>	6		;ARGUMENTS, IF ANY

NTS, IF 	 B0
	EXTERN BPE.A
IFB <B>,<	BpPUSHJ	P,E.A >
ICFNB <B>,<JRST	[PC0USHJ P,E.A
			JRST B] >
			J	T86 Cp'
	EXTERN DE.A
IFB <B>,<ED0RCAL	E.A >
IFNBDP <B>,<ERJMP	[PUSDpHJ P,E.A
			JRST B] >
			JRS	  -


IFNB-0 <B>,<
	ENTRY	E-P.B
E.B:				;DE-pFINE THE ERROR IF. NOT NULL
>

I.0F2,<IFNDEF %OTSER.P,<EXTERN %OTSER>>.p
		PUSHJ	P,%OTSE/R	;ERROR CALL
		/0"A"			;ERROR CHA/PRACTER
		SIXBIT	/p/B/		;ERROR PREF0IX
		EXP	C,D		00;ERROR NUMBERS
	0P	POINT 7,[ASCIZ \0pE\]	;POINTER TO 1MESSAGE
		EXP	G10		;ATTRIBUTE G
1PIRP F,	<F>			;A1pRGUMENTS, IF ANY

NTS,IFANYS
IF2,<IFNIDEF L.A,<	EXTERNI0	L.A >>
IFB <BIP>,<	PUSHJ	P,L.A Ip>
IFNB <B>,<JRSJT	[PUSHJ P,L.A
J0			JRST B] >

	JRST B] >

	2.,@ :pq

	ENTRY;	L.B
L.B:
		P;0USHJ	P,MTHER.##
;P		"A"			;ERROR C;pHARACTER
		SIXBI<T	/B/		;ERROR PR<0EFIX
		EXP	C,D<P		;ERROR NUMBERS
		POINT 7,[ASCIZ= \E\]	;POINTER T=0O MESSAGE
		EXP	=PG		;ATTRIBUTE G=p
IRP F,	<F>			>;ARGUMENTS, IF ANY

NTS, IF AN	2T86 Jpa
IF2,<IFNKDEF L.A,<	EXTERNK0	L.A>>
IFB <B>KP,<	ERCAL	L.A >
KpIFNB <B>,<	ERJMPL	[PUSHJ P,L.A
			JRST B] >
		J Y0O
IFNDEF	%YPLFIXD,<EXTERN	%LFYpIXD>
	DMOVE	T0,%LFIXD
OVE	T0,%	J&

@ W0?
IFNDEF	%WPLFIXD,<EXTERN	%LFWpIXD>
	DMOVE	T0,%LFIXD
OVE	T0,%	J& X0G
IFNDEF	%XPLFIXD,<EXTERN	%LFXpIXD>
	DMOVE	T0,%LFIXD
OVE	T0,%	K

@ V07
IFNDEF	%VPLFIXD,<EXTERN	%LFVpIXD>
	MOVE	T0,%LFIXD
OVE	T0,%L	N T0/
IFNDEF	%TPLFIXD,<EXTERN	%LFTpIXD>
IFNDEF	%LERUTP,<EXTERN	%LERTPU0>
	DMOVEM	T0,%LFUPIXD
	MOVEI	T0,TPUp%DPX
	MOVEM	T0,%LERTP
VEM	T0,%	N&

@ P0
IFNDEF	%PPLFIXD,<EXTERN	%LFPpIXD>
IFNDEF	%LERQTP,<EXTERN	%LERTPQ0>
	DMOVEM	T0,%LFQPIXD
	MOVEI	T0,TPQp%DPR
	MOVEM	T0,%LERTP
VEM	T0,%	N& R0
IFNDEF	%RPLFIXD,<EXTERN	%LFRpIXD>
IFNDEF	%LERSTP,<EXTERN	%LERTPS0>
	DMOVEM	T0,%LFSPIXD
	MOVEI	T0,TPSp%DPX
	MOVEM	T0,%LERTP
VEM	T0,%	O

@ N0
IFNDEF	%NPLFIXD,<EXTERN	%LFNpIXD>
IFNDEF	%LEROTP,<EXTERN	%LERTPO0>
	MOVEM	T0,%LFIOPXD
	MOVEI	T0,TP%OpSPR
	MOVEM	T0,%LERTP
VEM	T0,%L	R LPo
IF2,<IFNLpDEF T.A,<	EXTERNM	T.A>>
IFB <B>M0,<	PUSHJ	P,T.A >MP
IFNB <B>,<JRSTMp	[PUSHJ P,T.A
			JRST B] >
		R.,@ >P

	ENTRY>p	T.B
T.B:
		P?USHJ	P,%TRPER##
?0		"A"			;ERROR C?PHARACTER
		SIXBI?pT	/B/		;ERROR PR@EFIX
		EXP	C,D@0		;ERROR NUMBERS
		POINT 7,[ASCIZ@p \E\]	;POINTER TAO MESSAGE
		EXP	A0G		;ATTRIBUTE GAP
IRP F,	<F>			Ap;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 >.`P >5P >L[@P ?'P ?,nP [ P S@P $hhP $hiP $hiP $khP $m(P $m)P %P %WP %ZP %7P %{P %LRP %LzP %m6P %xrP >}{woP