PDP-10 Archive: mthprm.unv from BB-D480G-SB_FORTRAN10_V11.0

Trailing-Edge - PDP-10 Archives - BB-D480G-SB_FORTRAN10_V11.0_short - mthprm.unv

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

x,Sc@P CJ<Q CJ==rQ `CJ>N8Q I6N  X:
 IRP A,@<
  IRP B,<
  ` DEFINE TXAB (AC,E) <
` IFE < <E>&777777000000>@,<TRAB AC,<E> ;`>     IFE <<E>&000000777777>,<TLA B AC,(E) ;> 			 @   TDAB AC,[E]
   > ;END TXYZ
  > ;END IRP B
  > ;END IRP A
> ;END IRP A
I` p@_$
	XALL
p`
	ENTRY	DFL.A		;qENTRY POINT TO DFq L.A
	SIXBIT	/DFq@L.A/
DFL.A:	MOq`VEI	A+1,0		;CLEArR LOW ORDER WORD
	ASHC	A,-8		;MAr@KE ROOM FOR EXPONr`ENT IN HI WORD
	sTLC	A,243000	;SEs T EXP TO 27+8 DECs@IMAL
	DFAD	A,[Es`XP 0,0]	;NORMALIZtE
	POPJ	P,		;RETt URN A=THE DOUBLEt@ PRECISION RESULT
PhDI5 `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.    This
				;[3207] * MUST* preceed  th@e search  of
			`	;[3207] UUOSYM, which contains EX TERNs
				;[3207@] of the JOBDAT s`ymbols.
IF10,<	SEARCH	UUOSYM,MACT EN>

IF20,<	SEA@RCH	MONSYM,MACSYM`>

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

@Q MVt= 3[,
 IF2,<IF3 NDEF A,<EXTERN 3@A>>
 .ARGN.=0
 3`IRP B,<.ARGN.=.A4RGN.+1>
	PUSH	P,4 L
	XMOVEI	L,1+[-4@.ARGN.,,0
		    4` IRP B,<IFIW REM5OVE(B)>] 
	PUSH5 J	P,A
	POP	P,L
 PURGE	.ARGN.
 PURGE	.ARGN.
NDP NHP NLP NPP OI  @O$k

@`:
	 XMOVEI

` A,0		
	 SKIPN

A		
	 JSP	A,b

 	
	 XSFM	A		
b:
SFM	A		
O

@ @O&` `OO OO

@ @OfL@ On @O  `O0  O>|H\ 9@[L
	POPJ	P,

	POPJ	P,ONt{  Qf@ +QeK` 6[H
 IFNB <6 B>,<
  IFDIF <B6@><.>,<
	ENTRY A6`
	SIXBIT /B/
7A:
  > ;END IFDI7 F

  IFIDN <B>7@<.>,<
	ENTRY A.7`
	SIXBIT /A./
8A.:
  > ;END IF8 IDN
 > ;END IFNB8@

 IFB <B>,<
8`	ENTRY A
	SIXBI9T /A/
A:
 > ;END IFB

 > ;S0 u_\
	XALL
u 
	ENTRY	IDF.A
	u@SIXBIT	/IDF.A/
u`IDF.A:	PUSH	P,L	v	;SAVE THE SCRATCv H REG
	HLRE	L,Av@		;GET THE EXPONEv`NT
	ASH	L,-9		;RwIGHT 8 BITS
	JUMw PGE	A,IDF.XT	;JUw@MP IF POS.
	DMOVw`N	A,A		;NEGATE
	TRC	L,-1		;COMPx LEMENT THE EXPONEx@NT
IDF.XT:	TLZ	x`A,777000	;CLEAR TyHE EXPONENT
	ASHy C	A,-201-^D26(L)y@	;CHANGE FRACTIONy` TO INTEGER
	TLNzE	L,400000	;SKIP z IF POS.
	MOVN	Az@,A		;NEGATE
	POz`P	P,L		;RESTORE T{HE SCRATCH REG
	{ POPJ	P,		;RETURN {@A=FIXED NUMBER
	R^	R.,@S
 `UIFN FT10S WfIFN FT20SNp @UKI@ +XP [0$P [?7 XT
 IFE <<`B>&777777000000>, <MOVEI A,<B> ;>@  IFE <<B>&00000`0777777>,<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 XX<RADIX50 0,A><RADIX50 0em}R [A}OO

@ek

``L
	 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 @[

  IFDE`F $SEG$,<
IF2,<


IFE <$SEG$-1>,<$

 SEG$==2
	TWOSEG

@400000
  > ;END

`IFE $SEG$-1
IFESG$+1>,<$SEG$=
	TWOSEG	40000
`S>G;END IFE $
 > ;END IF2
> ;END IFDEF . $SEG$

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

	$/`NAME$=='A'

  0IFE <$NAME$-'DATA0 '>,<		
   IFG $S0@EG$,<
	RELOC
IF0`1,<	$SEG$==-1>
I1F2,<	$SEG$==-2>>>1 

  IFN <$NAME$1@-'DATA'>,<		
   1`IFL $SEG$,<
	REL2OC
IF1,<	$SEG$==2 1>
IF2,<	$SEG$==2>>>
 	$SEG$==gh +g:8 |`2
	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 WON, 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 i@.YP iX :\

 TITLE:  A  B
 FSRCH
:@
 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>

	DEFIANE	VER <	BYTE	(3)A VWHO(9)VMAJOR(6)VA@MINOR(18)VEDIT>
A`
 PURGE %VMAJOR,B%VWHO

 ASUPPREB SS			
 PURGE T0,B@T1,T2,T3,T4,T5,L,P	

,T4,T5,L,ib , Zn
    IFE ,@<<B>&77777700000,`0>,<TRC A,<B> ;->     IFE <<B>&0- 00000777777>,<TLC-@ A,(B) ;> 			  -`  TDC A,[B]
   DC A,[B]
  ib * Z^
 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>&77777700000`0>,<TRN A,<B> ;>     IFE <<B>&0 00000777777>,<TLN@ A,(B) ;> 			  `  TDN A,[B]
   DN A,[B]
  ibt  Y
 IFE @<<B>&77777700000`0>,<TRNA A,<B> ;>     IFE <<B>& 000000777777>,<TL@NA A,(B) ;> 			`    TDNA A,[B]
ibtNA A,[B]
 IFE @<<B>&77777700000`0>,<TRNE A,<B> ;>     IFE <<B>& 000000777777>,<TL@NE A,(B) ;> 			`    TDNE A,[B]
ibuNE A,[B]
 IFE @<<B>&77777700000`0>,<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>&77777700000`0>,<TRON A,<B> ;>     IFE <<B>& 000000777777>,<TL@ON A,(B) ;> 			`    TDON A,[B]
icPON A,[B]
    IFE @<<B>&77777700000`0>,<TRZ A,<B> ;>     IFE <<B>&0 00000777777>,<TLZ@ A,(B) ;> 			  `  TDZ A,[B]
   DZ A,[B]
  icT  Y^
 IFE @<<B>&77777700000`0>,<TRZA A,<B> ;>     IFE <<B>& 000000777777>,<TL@ZA A,(B) ;> 			`    TDZA A,[B]
icTZA A,[B]
 IFE @<<B>&77777700000`0>,<TRZE A,<B> ;>     IFE <<B>& 000000777777>,<TL@ZE A,(B) ;> 			`    TDZE A,[B]
icUZE A,[B]
 IFE @<<B>&77777700000`0>,<TRZN A,<B> ;>     IFE <<B>& 000000777777>,<TL@ZN A,(B) ;> 			`    TDZN A,[B]
q  ZN A,[B]
f@ q+= +q+= +
q6~i4 C 	 ]]r
IFNB <B] >,<PRINTX ?ACALL ]@CONTINUATION ADDR]`ESS SPECIFIED - I^GNORED>
	EXTERN	^ A.A
	PUSHJ	P,A.A

USHJ	P,A.	.,@ L@]

	INTERL`N	A.B
A.B:

M IF2,<IFNDEF %AERM R,<EXTERN %AERR>>M@
		PUSHJ	P,%AERRM`
		"A"			;ERRORN CHARACTER
		SIXN BIT	/B/		;ERROR N@PREFIX
		EXP	C,N`D		;ERROR NUMBEROS
		POINT 7,[ASCO IZ \E\]	;POINTERO@ TO MESSAGE
		EXO`P	G		;ATTRIBUTE PG
IRP F,	<F>	P 		;ARGUMENTS, IF ANY

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

	ERCAL	A.A	.,@ H \`

	INTERH@N	D.B
D.B:

H` IF2,<IFNDEF %DERIR,<EXTERN %DERR>>I 
		PUSHJ	P,%DERRI@
		"A"			;ERRORI` CHARACTER
		SIXJBIT	/B/		;ERROR J PREFIX
		EXP	C,J@D		;ERROR NUMBERJ`S
		POINT 7,[ASCKIZ \E\]	;POINTERK  TO MESSAGE
		EXK@P	G		;ATTRIBUTE K`G
IRP F,	<F>	L		;ARGUMENTS, IF ANY

NTS, IF 	 X ]J
	EXTERN X@E.A
IFB <B>,<	X`PUSHJ	P,E.A >
IYFNB <B>,<JRST	[PY USHJ P,E.A
			JRST B] >
			J	T86 Y`]V
	EXTERN ZE.A
IFB <B>,<EZ RCAL	E.A >
IFNBZ@ <B>,<ERJMP	[PUSZ`HJ P,E.A
			JRST B] >
			JRS	  C\>


IFNBC  <B>,<
	ENTRY	EC@.B
E.B:				;DEC`FINE THE ERROR IFD NOT NULL
>

ID F2,<IFNDEF %OTSERD@,<EXTERN %OTSER>>D`
		PUSHJ	P,%OTSEER	;ERROR CALL
		E "A"			;ERROR CHAE@RACTER
		SIXBIT	E`/B/		;ERROR PREFFIX
		EXP	C,D		F ;ERROR NUMBERS
	F@	POINT 7,[ASCIZ \F`E\]	;POINTER TO GMESSAGE
		EXP	GG 		;ATTRIBUTE G
G@IRP F,	<F>			;AG`RGUMENTS, 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`] 

	ENTRYQ	L.B
L.B:
		PQ USHJ	P,MTHER.##
Q@		"A"			;ERROR CQ`HARACTER
		SIXBIRT	/B/		;ERROR PRR EFIX
		EXP	C,DR@		;ERROR NUMBERS
		POINT 7,[ASCIZS \E\]	;POINTER TS O MESSAGE
		EXP	S@G		;ATTRIBUTE GS`
IRP F,	<F>			T;ARGUMENTS, IF ANY

NTS, IF AN	2T86 ``^
IF2,<IFNaDEF L.A,<	EXTERNa 	L.A>>
IFB <B>a@,<	ERCAL	L.A >
a`IFNB <B>,<	ERJMPb	[PUSHJ P,L.A
			JRST B] >
		J o ^~
IFNDEF	%o@LFIXD,<EXTERN	%LFo`IXD>
	DMOVE	T0,%LFIXD
OVE	T0,%	J&

@ m ^n
IFNDEF	%m@LFIXD,<EXTERN	%LFm`IXD>
	DMOVE	T0,%LFIXD
OVE	T0,%	J& n ^v
IFNDEF	%n@LFIXD,<EXTERN	%LFn`IXD>
	DMOVE	T0,%LFIXD
OVE	T0,%	K

@ l ^f
IFNDEF	%l@LFIXD,<EXTERN	%LFl`IXD>
	MOVE	T0,%LFIXD
OVE	T0,%L	N j ^^
IFNDEF	%j@LFIXD,<EXTERN	%LFj`IXD>
IFNDEF	%LERkTP,<EXTERN	%LERTPk >
	DMOVEM	T0,%LFk@IXD
	MOVEI	T0,TPk`%DPX
	MOVEM	T0,%LERTP
VEM	T0,%	N&

@ f ^>
IFNDEF	%f@LFIXD,<EXTERN	%LFf`IXD>
IFNDEF	%LERgTP,<EXTERN	%LERTPg >
	DMOVEM	T0,%LFg@IXD
	MOVEI	T0,TPg`%DPR
	MOVEM	T0,%LERTP
VEM	T0,%	N& h ^N
IFNDEF	%h@LFIXD,<EXTERN	%LFh`IXD>
IFNDEF	%LERiTP,<EXTERN	%LERTPi >
	DMOVEM	T0,%LFi@IXD
	MOVEI	T0,TPi`%DPX
	MOVEM	T0,%LERTP
VEM	T0,%	O

@ d ^.
IFNDEF	%d@LFIXD,<EXTERN	%LFd`IXD>
IFNDEF	%LEReTP,<EXTERN	%LERTPe >
	MOVEM	T0,%LFIe@XD
	MOVEI	T0,TP%e`SPR
	MOVEM	T0,%LERTP
VEM	T0,%L	R b@^
IF2,<IFNb`DEF T.A,<	EXTERNc	T.A>>
IFB <B>c ,<	PUSHJ	P,T.A >c@
IFNB <B>,<JRSTc`	[PUSHJ P,T.A
			JRST B] >
		R.,@ T@]>

	ENTRYT`	T.B
T.B:
		PUUSHJ	P,%TRPER##
U 		"A"			;ERROR CU@HARACTER
		SIXBIU`T	/B/		;ERROR PRVEFIX
		EXP	C,DV 		;ERROR NUMBERS
		POINT 7,[ASCIZV` \E\]	;POINTER TWO MESSAGE
		EXP	W G		;ATTRIBUTE GW@
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