PDP-10 Archive: mthprm.unv from FORTRAN-10_Alpha

Trailing-Edge - PDP-10 Archives - FORTRAN-10_Alpha_31-jul-86 - mthprm.unv

There are 28 other files named mthprm.unv in the archive. Click here to see a list.

x,Rc@P CJ<Q CJ==rQ `CJ>N8Q I6N @X4
 IRP A,`<
  IRP B,<
   DEFINE TXAB (A C,E) <
 IFE <@<E>&777777000000>`,<TRAB AC,<E> ;>     IFE <<E>&00 0000777777>,<TLA@B AC,(E) ;> 			 `   TDAB AC,[E]
   > ;END TXYZ
   > ;END IRP B
@ > ;END IRP A
> ;END IRP A
I` o`_
	XALL
p
	ENTRY	DFL.A		;p ENTRY POINT TO DFp@L.A
	SIXBIT	/DFp`L.A/
DFL.A:	MOqVEI	A+1,0		;CLEAq R LOW ORDER WORD
	ASHC	A,-8		;MAq`KE ROOM FOR EXPONrENT IN HI WORD
	r TLC	A,243000	;SEr@T EXP TO 27+8 DECr`IMAL
	DFAD	A,[EsXP 0,0]	;NORMALIZs E
	POPJ	P,		;RETs@URN A=THE DOUBLEs` PRECISION RESULT
PfHI5 `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: 
 X
	SALL
	
@SEARCH	JOBDAT		;[
`3207] For  .JBxyz   symbols.    Th is
				;[3207] *@MUST* preceed  th`e search  of
				;[3207] UUOSYM,  which contains EX@TERNs
				;[3207`] of the JOBDAT symbols.
IF10,<	S EARCH	UUOSYM,MACT@EN>

IF20,<	SEA`RCH	MONSYM,MACSYM>

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

@Q MVt= 2 [&
 IF2,<IF2@NDEF A,<EXTERN 2`A>>
 .ARGN.=0
 3IRP B,<.ARGN.=.A3 RGN.+1>
	PUSH	P,3@L
	XMOVEI	L,1+[-3`.ARGN.,,0
		    4 IRP B,<IFIW REM4 OVE(B)>] 
	PUSH4@J	P,A
	POP	P,L
 PURGE	.ARGN.
 PURGE	.ARGN.
NDP NHP NLP NPP OI  @O$k

``4
	 XMOVEI

 A,0		
	 SKIPN

 A		
	 JSP	A,b

@	
	 XSFM	A		
b:
SFM	A		
O

@ @O&` `OO OO

@ @OfL@ On @O  `O0  O>|H\ 8`[F
	POPJ	P,

	POPJ	P,ONt{  Qf@ +QeK` 5 [B
 IFNB <5@B>,<
  IFDIF <B5`><.>,<
	ENTRY A6
	SIXBIT /B/
6 A:
  > ;END IFDI6@F

  IFIDN <B>6`<.>,<
	ENTRY A.7
	SIXBIT /A./
7 A.:
  > ;END IF7@IDN
 > ;END IFNB7`

 IFB <B>,<
8	ENTRY A
	SIXBI8 T /A/
A:
 > ;END IFB

 > ;S0 t _V
	XALL
t@
	ENTRY	IDF.A
	t`SIXBIT	/IDF.A/
uIDF.A:	PUSH	P,L	u 	;SAVE THE SCRATCu@H REG
	HLRE	L,Au`		;GET THE EXPONEvNT
	ASH	L,-9		;Rv IGHT 8 BITS
	JUMv@PGE	A,IDF.XT	;JUv`MP IF POS.
	DMOVwN	A,A		;NEGATE
	TRC	L,-1		;COMPw@LEMENT THE EXPONEw`NT
IDF.XT:	TLZ	xA,777000	;CLEAR Tx HE EXPONENT
	ASHx@C	A,-201-^D26(L)x`	;CHANGE FRACTIONy TO INTEGER
	TLNy E	L,400000	;SKIP y@IF POS.
	MOVN	Ay`,A		;NEGATE
	POzP	P,L		;RESTORE Tz HE SCRATCH REG
	z@POPJ	P,		;RETURN z`A=FIXED NUMBER
	2]p	2.,@S
 `OIFN FT10S W`IFN FT20SNp @UKI@ +XP [0$P [?7  XN
 IFE <<B>&777777000000>,@<MOVEI A,<B> ;>`  IFE <<B>&000000777777>,<MOVSI  A,(B) ;>  IFE <<@B>_-22 - 777777>`,<HRROI A,<<B>&	777777> ;>  IFE <	 <B>&777777-77777	@7>,<HRLOI A,<<B	`>_-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 
 XR<RADIX50 0,A><RADIX50 0em}R [ANLek

`F
	 TLZ	A

 ,(PC%OVF+PC%FOV+P

@C%FUF+PC%NDV)

` XMOVEI	A+1,b


	 TLNE	A+1,-1

 
	 XJRSTF	A

@	 HRR	A,A+1

`	 JRSTF	(A)		
b:
F	(A)		
fDP fHP fLP fPP g=Y7 
`[



  IFDEF $SEG$,<
IF2,<
IFE <$SEG$-1>,<$@SEG$==2
	TWOSEG	`400000
  > ;END

IFE $SEG$-1
IFE

 <$SEG$+1>,<$SEG$=

@=2
	TWOSEG	40000

`0
S>G;END IFE $
 >2;END I
> ;END IFDEF -@$SEG$

  IFNDEF-` $SEG$,<
	TWOSEG.	400000
IF1,<	$S. EG$==1>
IF2,<	$S.@EG$==2>
> ;END I.`FNDEF $SEG$

	$/NAME$=='A'

  / IFE <$NAME$-'DATA/@'>,<		
   IFG $S/`EG$,<
	RELOC
IF01,<	$SEG$==-1>
I0 F2,<	$SEG$==-2>>>0@

  IFN <$NAME$0`-'DATA'>,<		
   1IFL $SEG$,<
	REL1 OC
IF1,<	$SEG$==1@1>
IF2,<	$SEG$==2>>>
 	$SEG$==gh +g:8 { `,
	XALL
{@
	ENTRY	SNG.A
	{`SIXBIT	/SNG.A/
|SNG.A:	JUMPL	A,| SNG3		;NEGATIVE A|@RGUMENT?
	TLNE	|`A+1,(1B1)	;POSITI}VE. ROUND REQUIRE} D?
	TRON	A,1		;}@YES, TRY TO ROUND}` BY SETTING LSB
~	  POPJ	P,		;WE W~ ON, FINISHED
	MO~@VE	A+1,A		;COPY~` HIGH PART OF ARG
	AND	A,[777000 ,,1]	;MAKE UNNORM@ALIZED LSB, SAME `EXPONENT
	FAD	A

,A+1		;ROUND & R

 ENORMALIZE
	POPJ

@	P,

;HERE IF A

`RG IS NEGATIVE
S

NG3:	DMOVN	A,A

 	;MAKE POSITIVE

@	TLNE	A+1,(1B1)

`;NEED ROUNDING?

	TRON	A,1		;YES,

  TRY TO DO IT BY

@SETTING LSB
	JRS

`T	SNG4		;DONE
	M

OVN	A+1,A		;MAK

 E RE-NEGATED COPY

@ OF HIGH PART
	O

`RCA	A,[777,,-1]

;GET UNNORM NEG L

 SB WITH SAME EXPO

@NENT
	FADR	A,A

`+1		;ROUND & NORM

ALIZE
	POPJ	P,

 
SNG4:	MOVN	A,

@A		;RE-NEGATE
	POPJ	P,		;EXIT
h@P hD@ hHP hLP hPP hTP i@*0P i@*PP i@*h]P 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 9 \

 TITLE9@ A  B
 FSRCH
9`
 VMAJOR==<VMINO:R==<VEDIT==<VWHO=: =0>>>
%VWHO==0

 IRPC B,<

:`  IFLE <"B"-"A">;*<"B"-"Z">,<VMIN; OR==VMINOR*^D26 +;@ "B" - "A" + 1>

  IFLE <"B"-"<0">*<"B"-"9">,<V< MAJOR==VMAJOR*^D8<@ + "B" - "0">
<`
=IFIDN <B><(>,=<%VMAJOR==VMAJOR
		VMAJOR==0>

=@  IFIDN <B><)>,<=`VEDIT==VMAJOR
		>VMAJOR==%VMAJOR>

  IFIDN <B><->@>,<%VMAJOR==VMAJO>`R
		VMAJOR==0
	?	%VWHO==-1>
 > ;? END IRPC

 IFN ?@%VWHO,<VWHO==VMAJ?`OR
	    VMAJOR==@%VMAJOR>

	DEFI@ NE	VER <	BYTE	(3)@@VWHO(9)VMAJOR(6)V@`MINOR(18)VEDIT>
A
 PURGE %VMAJOR,A %VWHO

 ASUPPREA@SS			
 PURGE T0,A`T1,T2,T3,T4,T5,L,P	

,T4,T5,L,ib +@Zh
    IFE +`<<B>&77777700000,0>,<TRC A,<B> ;, >     IFE <<B>&0,@00000777777>,<TLC,` A,(B) ;> 			  -  TDC A,[B]
   DC A,[B]
  ib )@ZX
 IFE )`<<B>&77777700000*0>,<TRCA A,<B> * ;>     IFE <<B>&*@000000777777>,<TL*`CA A,(B) ;> 			+    TDCA A,[B]
ibCA A,[B]
 IFE '`<<B>&77777700000(0>,<TRCE A,<B> ( ;>     IFE <<B>&(@000000777777>,<TL(`CE A,(B) ;> 			)    TDCE A,[B]
ibCE A,[B]
 IFE %`<<B>&77777700000&0>,<TRCN A,<B> & ;>     IFE <<B>&&@000000777777>,<TL&`CN A,(B) ;> 			'    TDCN A,[B]
ibpCN A,[B]
    IFE `<<B>&777777000000>,<TRN A,<B> ; >     IFE <<B>&0@00000777777>,<TLN` A,(B) ;> 			    TDN A,[B]
   DN A,[B]
  ibt @Y
 IFE `<<B>&777777000000>,<TRNA A,<B>  ;>     IFE <<B>&@000000777777>,<TL`NA A,(B) ;> 			    TDNA A,[B]
ibtNA A,[B]
 IFE `<<B>&777777000000>,<TRNE A,<B>  ;>     IFE <<B>&@000000777777>,<TL`NE A,(B) ;> 			    TDNE A,[B]
ibuNEA,[B]
`<<IFE77777000000>,<TRNN A,<B>  ;>     IFE <<B>&@000000777777>,<TL`NN A,(B) ;> 			    TDNN A,[B]
ibxNN A,[B]
    IFE #`<<B>&77777700000$0>,<TRO A,<B> ;$ >     IFE <<B>&0$@00000777777>,<TLO$` A,(B) ;> 			  %  TDO A,[B]
   DO A,[B]
  ib| !@Z
 IFE !`<<B>&77777700000"0>,<TROA A,<B> " ;>     IFE <<B>&"@000000777777>,<TL"`OA A,(B) ;> 			#    TDOA A,[B]
ib|OA A,[B]
 IFE `<<B>&77777700000 0>,<TROE A,<B>   ;>     IFE <<B>& @000000777777>,<TL `OE A,(B) ;> 			!    TDOE A,[B]
ib}OE A,[B]
 IFE `<<B>&777777000000>,<TRON A,<B>  ;>     IFE <<B>&@000000777777>,<TL`ON A,(B) ;> 			    TDON A,[B]
icPON A,[B]
    IFE `<<B>&777777000000>,<TRZ A,<B> ; >     IFE <<B>&0@00000777777>,<TLZ` A,(B) ;> 			    TDZ A,[B]
   DZ A,[B]
  icT @YX
 IFE `<<B>&777777000000>,<TRZA A,<B>  ;>     IFE <<B>&@000000777777>,<TL`ZA A,(B) ;> 			    TDZA A,[B]
icTZA A,[B]
 IFE `<<B>&777777000000>,<TRZE A,<B>  ;>     IFE <<B>&@000000777777>,<TL`ZE A,(B) ;> 			    TDZE A,[B]
icUZE A,[B]
 IFE `<<B>&777777000000>,<TRZN A,<B>  ;>     IFE <<B>&@000000777777>,<TL`ZN A,(B) ;> 			    TDZN A,[B]
q  ZN A,[B]
f@ q+= +q+= +
q6~i4 C 	 \ ]l
IFNB <B\@>,<PRINTX ?ACALL \`CONTINUATION ADDR]ESS SPECIFIED - I] GNORED>
	EXTERN	]@A.A
	PUSHJ	P,A.A

USHJ	P,A.	.,@ K`\|

	INTERLN	A.B
A.B:

L  IF2,<IFNDEF %AERL@R,<EXTERN %AERR>>L`
		PUSHJ	P,%AERRM
		"A"			;ERRORM  CHARACTER
		SIXM@BIT	/B/		;ERROR M`PREFIX
		EXP	C,ND		;ERROR NUMBERN S
		POINT 7,[ASCN@IZ \E\]	;POINTERN` TO MESSAGE
		EXOP	G		;ATTRIBUTE O G
IRP F,	<F>	O@		;ARGUMENTS, IF ANY

NTS, IF 	T86 Z@]^
IFNB <BZ`>,<PRINTX ?AJCAL [CONTINUATION ADDR[ ESS SPECIFIED - I[@GNORED>
	EXTERN	[`A.A
	ERCAL	A.A

	ERCAL	A.A	.,@ G@\Z

	INTERG`N	D.B
D.B:

H IF2,<IFNDEF %DERH R,<EXTERN %DERR>>H@
		PUSHJ	P,%DERRH`
		"A"			;ERRORI CHARACTER
		SIXI BIT	/B/		;ERROR I@PREFIX
		EXP	C,I`D		;ERROR NUMBERJS
		POINT 7,[ASCJ IZ \E\]	;POINTERJ@ TO MESSAGE
		EXJ`P	G		;ATTRIBUTE KG
IRP F,	<F>	K 		;ARGUMENTS, IF ANY

NTS, IF 	 W@]D
	EXTERN W`E.A
IFB <B>,<	XPUSHJ	P,E.A >
IX FNB <B>,<JRST	[PX@USHJ P,E.A
			JRST B] >
			J	T86 Y]P
	EXTERN Y E.A
IFB <B>,<EY@RCAL	E.A >
IFNBY` <B>,<ERJMP	[PUSZHJ P,E.A
			JRST B] >
			JRS	  B \8


IFNBB@ <B>,<
	ENTRY	EB`.B
E.B:				;DECFINE THE ERROR IFC  NOT NULL
>

IC@F2,<IFNDEF %OTSERC`,<EXTERN %OTSER>>D
		PUSHJ	P,%OTSED R	;ERROR CALL
		D@"A"			;ERROR CHAD`RACTER
		SIXBIT	E/B/		;ERROR PREFE IX
		EXP	C,D		E@;ERROR NUMBERS
	E`	POINT 7,[ASCIZ \FE\]	;POINTER TO F MESSAGE
		EXP	GF@		;ATTRIBUTE G
F`IRP F,	<F>			;AGRGUMENTS, IF ANY

NTS,IFANY]|
IF2,<IFN^ DEF L.A,<	EXTERN^@	L.A >>
IFB <B^`>,<	PUSHJ	P,L.A _>
IFNB <B>,<JRS_ T	[PUSHJ P,L.A
_@			JRST B] >

	JRST B] >

	2.,@ P]

	ENTRYP 	L.B
L.B:
		PP@USHJ	P,MTHER.##
P`		"A"			;ERROR CQHARACTER
		SIXBIQ T	/B/		;ERROR PRQ@EFIX
		EXP	C,DQ`		;ERROR NUMBERS
		POINT 7,[ASCIZR  \E\]	;POINTER TR@O MESSAGE
		EXP	R`G		;ATTRIBUTE GS
IRP F,	<F>			S ;ARGUMENTS, IF ANY

NTS, IF AN	2T86 `^

IF2,<IFN` DEF L.A,<	EXTERN`@	L.A>>
IFB <B>``,<	ERCAL	L.A >
aIFNB <B>,<	ERJMPa 	[PUSHJ P,L.A
			JRST B] >
		J n@^x
IFNDEF	%n`LFIXD,<EXTERN	%LFoIXD>
	DMOVE	T0,%LFIXD
OVE	T0,%	J&

@ l@^h
IFNDEF	%l`LFIXD,<EXTERN	%LFmIXD>
	DMOVE	T0,%LFIXD
OVE	T0,%	J& m@^p
IFNDEF	%m`LFIXD,<EXTERN	%LFnIXD>
	DMOVE	T0,%LFIXD
OVE	T0,%	K

@ k@^`
IFNDEF	%k`LFIXD,<EXTERN	%LFlIXD>
	MOVE	T0,%LFIXD
OVE	T0,%L	N i@^X
IFNDEF	%i`LFIXD,<EXTERN	%LFjIXD>
IFNDEF	%LERj TP,<EXTERN	%LERTPj@>
	DMOVEM	T0,%LFj`IXD
	MOVEI	T0,TPk%DPX
	MOVEM	T0,%LERTP
VEM	T0,%	N&

@ e@^8
IFNDEF	%e`LFIXD,<EXTERN	%LFfIXD>
IFNDEF	%LERf TP,<EXTERN	%LERTPf@>
	DMOVEM	T0,%LFf`IXD
	MOVEI	T0,TPg%DPR
	MOVEM	T0,%LERTP
VEM	T0,%	N& g@^H
IFNDEF	%g`LFIXD,<EXTERN	%LFhIXD>
IFNDEF	%LERh TP,<EXTERN	%LERTPh@>
	DMOVEM	T0,%LFh`IXD
	MOVEI	T0,TPi%DPX
	MOVEM	T0,%LERTP
VEM	T0,%	O

@ c@^(
IFNDEF	%c`LFIXD,<EXTERN	%LFdIXD>
IFNDEF	%LERd TP,<EXTERN	%LERTPd@>
	MOVEM	T0,%LFId`XD
	MOVEI	T0,TP%eSPR
	MOVEM	T0,%LERTP
VEM	T0,%L	R a`^
IF2,<IFNbDEF T.A,<	EXTERNb 	T.A>>
IFB <B>b@,<	PUSHJ	P,T.A >b`
IFNB <B>,<JRSTc	[PUSHJ P,T.A
			JRST B] >
		R.,@ S`]8

	ENTRYT	T.B
T.B:
		PT USHJ	P,%TRPER##
T@		"A"			;ERROR CT`HARACTER
		SIXBIUT	/B/		;ERROR PRU EFIX
		EXP	C,DU@		;ERROR NUMBERS
		POINT 7,[ASCIZV \E\]	;POINTER TV O MESSAGE
		EXP	V@G		;ATTRIBUTE GV`
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 >.`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