PDP-10.its/src/mudsys/arith.94

TITLE ARITHMETIC PRIMITIVES FOR MUDDLE

.GLOBAL HI,RLOW,CPLUS,CMINUS,CTIMES,CDIVID,CFIX,CFLOAT
.GLOBAL CLQ,CGQ,CLEQ,CGEQ,C1Q,C0Q,CMAX,CMIN,CABS,CMOD,CCOS,CSIN,CATAN,CLOG
.GLOBAL CEXP,CSQRT,CTIME,CORB,CXORB,CANDB,CEQVB,CRAND,CLSH,CROT,
.GLOBAL SAT,BFLOAT,FLGSET

;BKD

;DEFINES MUDDLE PRIMITIVES:   FIX,FLOAT,ATAN,IEXP,LOG,
;	G?,L?,0?,1?,+,-,*,/,MAX,MIN,ABS,SIN,COS,SQRT,RANDOM,
;	TIME,SORT.

RELOCATABLE

.INSRT MUDDLE >

O=0


DEFINE	TYP1
	(AB) TERMIN
DEFINE VAL1
	(AB)+1 TERMIN

DEFINE	TYP2
	(AB)+2 TERMIN
DEFINE	VAL2
	(AB)+3 TERMIN

DEFINE	TYP3
	(AB)+4 TERMIN
DEFINE	VAL3
	(AB)+5 TERMIN

DEFINE	TYPN
	(D) TERMIN
DEFINE	VALN
	(D)+1 TERMIN


YES:	MOVSI	A,TATOM		;RETURN PATH FOR 'TRUE'
	MOVE	B,IMQUOTE T
	AOS	(P)
	POPJ	P,

NO:	MOVSI	A,TFALSE	;RETURN PATH FOR 'FALSE'
	MOVEI	B,NIL
	POPJ	P,

;ERROR RETURNS AND OTHER UTILITY ROUTINES

OVRFLW==10
OVRFLD:	ERRUUO	EQUOTE OVERFLOW

CARGCH:	GETYP	0,A		; GET TYPE
	CAIN	0,TFLOAT
	POPJ	P,
	JSP	A,BFLOAT
	POPJ	P,

ARGCHK:			;CHECK FOR SINGLE FIXED OR FLOATING
			;ARGUMENT IF FIXED CONVERT TO FLOATING
			;RETURN FLOATING ARGRUMENT IN B ALWAYS
	ENTRY	1
	GETYP	C,TYP1	
	MOVE	B,VAL1
	CAIN	C,TFLOAT	;FLOATING?
	POPJ	P,		;YES, RETURN
	CAIE	C,TFIX		;FIXED?
	JRST	WTYP1		;NO, ERROR
	JSP	A,BFLOAT	;YES, CONVERT TO FLOATING AND RETURN
	POPJ	P,

OUTRNG:	ERRUUO	EQUOTE ARGUMENT-OUT-OF-RANGE

NSQRT:	ERRUUO	EQUOTE NEGATIVE-ARGUMENT

DEFINE MFLOAT AC
	IDIVI	AC,400000
	FSC	AC+1,233
	FSC	AC,254
	FADR	AC,AC+1
	TERMIN

BFLOAT:	MFLOAT 	B
	JRST	(A)

OFLOAT:	MFLOAT	O
	JRST	(C)

BFIX:	MULI	B,400
	TSC	B,B
	ASH	C,(B)-243
	MOVE	B,C
	JRST	(A)

;DISPATCH TABLES USED TO CONTROL THE FLOW OF THE VARIOUS PRIMITIVES

TABLE2:	SETZ	NO		;TABLE2 (0)
TABLE3:	SETZ	YES		;TABLE2 (1)  &  TABLE3 (0)
	SETZ	NO		;TABLE2 (2)
	SETZ	YES
	SETZ	NO

TABLE4:	SETZ	NO
	SETZ	NO
	SETZ	YES
	SETZ	YES



FUNC:	JSP	A,BFIX
	JSP	A,BFLOAT
	SUB	B,VALN
	IDIV	B,VALN
	ADD	B,VALN
	IMUL	B,VALN
	JSP	C,SWITCH
	JSP	C,SWITCH



FLFUNC==.-2
	FSBR	B,O
	FDVR	B,O
	FADR	B,O
	FMPR	B,O
	JSP	C,FLSWCH
	JSP	C,FLSWCH

DEFVAL==.-2
	0
	1
	0
	1
	377777,,-1
	400000,,1

DEFTYP==.-2
	TFIX,,
	TFIX,,
	TFIX,,
	TFIX,,
	TFLOAT,,
	TFLOAT,,
;PRIMITIVES FLOAT AND FIX

IMFUNCTION	FIX,SUBR

	ENTRY	1

	JSP	C,FXFL
	MOVE	B,1(AB)
	CAIE	A,TFIX
	JSP	A,BFIX
	MOVSI	A,TFIX
	JRST	FINIS

IMFUNCTION	FLOAT,SUBR

	ENTRY	1

	JSP	C,FXFL
	MOVE	B,1(AB)
	CAIE	A,TFLOAT
	JSP	A,BFLOAT
	MOVSI	A,TFLOAT
	JRST	FINIS

CFIX:	GETYP	0,A
	CAIN	0,TFIX
	POPJ	P,
	JSP	A,BFIX
	MOVSI	A,TFIX
	POPJ	P,

CFLOAT:	GETYP	0,A
	CAIN	0,TFLOAT
	POPJ	P,
	JSP	A,BFLOAT
	MOVSI	A,TFLOAT
	POPJ	P,

FXFL:	GETYP	A,(AB)
	CAIE	A,TFIX
	CAIN	A,TFLOAT
	JRST	(C)
	JRST	WTYP1


MFUNCTION	ABS,SUBR
	ENTRY	1
	GETYP	A,TYP1
	CAIE	A,TFIX
	CAIN	A,TFLOAT
	JRST	MOVIT
	JRST	WTYP1
MOVIT:	MOVM	B,VAL1		;GET ABSOLUTE VALUE OF ARGUMENT
AFINIS:	HRLZS	A		;MOVE TYPE CODE INTO LEFT HALF
	JRST	FINIS



MFUNCTION	MOD,SUBR
	ENTRY	2
	GETYP	A,TYP1
	CAIE	A,TFIX		;FIRST ARG FIXED ?
	JRST	WTYP1
	GETYP	A,TYP2
	CAIE	A,TFIX		;SECOND ARG FIXED ?
	JRST	WTYP2
	MOVE	A,VAL1
	IDIV	A,VAL2		;FORM QUOTIENT & REMAINDER
	JUMPGE	B,.+2		;Only return positive remainders
	ADD	B,VAL2
	MOVSI	A,TFIX
	JRST	FINIS
;PRIMITIVES PLUS, DIFFERENCE, TIMES, DIVIDE, MIN, AND MAX

MFUNCTION	MIN,SUBR
	
	ENTRY

	MOVEI	E,6
	JRST	GOPT

IMFUNCTION	MAX,SUBR

	ENTRY

	MOVEI	E,7
	JRST	GOPT

MFUNCTION	DIVIDE,SUBR,[/]

	ENTRY

	MOVEI	E,3
	JRST	GOPT

MFUNCTION	DIFFERENCE,SUBR,[-]

	ENTRY

	MOVEI	E,2
	JRST	GOPT

IMFUNCTION	TIMES,SUBR,[*]

	ENTRY

	MOVEI	E,5
	JRST	GOPT

MFUNCTION	PLUS,SUBR,[+]

	ENTRY

	MOVEI	E,4

GOPT:	MOVE	D,AB		;ARGUMENT POINTER
	HLRE	A,AB
	MOVMS	A
	ASH	A,-1
	PUSHJ	P,CARITH
	JRST	FINIS

; BUILD COMPILER ENTRIES TO THESE ROUTINES

IRP NAME,,[CMINUS,CDIVID,CPLUS,CTIMES,CMIN,CMAX]CODE,,[2,3,4,5,6,7]

NAME:	MOVEI	E,CODE
	JRST	CARIT1
TERMIN

CARIT1:	MOVEI	D,(A)
	ASH	D,1		; TIMES 2
	HRLI	D,(D)
	SUBM	TP,D		; POINT TO ARGS
	PUSH	TP,$TTP
	AOBJN	D,.+1
	PUSH	TP,D
	PUSHJ	P,CARITH
	MOVE	TP,(TP)
	SUB	TP,[1,,1]
	POPJ	P,

CARITH:	MOVE	B,DEFVAL(E)	; GET VAL
	JFCL	OVRFLW,.+1
	MOVEI	0,TFIX		; FIX UNTIL CHANGE
	JUMPN	A,ARITH0	; AT LEAST ONE ARG
	MOVE	A,DEFTYP(E)
	POPJ	P,

ARITH0:	SOJE	A,ARITH1	; FALL IN WITH ONE ARG
	MOVE	B,1(D)
	GETYP	C,(D)		; TYPE OF 1ST ARG
	ADD	D,[2,,2]	; GO TO NEXT
	CAIN	C,TFLOAT
	JRST	ARITH3
	CAIN	C,TFIX
	JRST	ARITH1
	JRST	WRONGT

ARITH1:	GETYP	C,0(D)		; GET NEXT TYPE
	CAIE	C,TFIX
	JRST	ARITH2		; TO FLOAT LOOP
	XCT	FUNC(E)		; DO IT
	ADD	D,[2,,2]
	SOJG	A,ARITH1	; KEEP ADDING OR WHATEVER
	SKIPE	OVFLG
	JFCL	OVRFLW,OVRFLD
	MOVSI	A,TFIX
	POPJ	P,

ARITH3:	GETYP	C,0(D)
	MOVE	0,1(D)		; GET ARG
	CAIE	C,TFIX
	JRST	ARITH4
	PUSH	P,A
	JSP	C,OFLOAT	; FLOAT IT
	POP	P,A
	JRST	ARITH5
ARITH4:	CAIE	C,TFLOAT
	JRST	WRONGT
	JRST	ARITH5

ARITH2:	CAIE	C,TFLOAT	; FLOATER?
	JRST	WRONGT
	PUSH	P,A
	JSP	A,BFLOAT
	POP	P,A
	MOVE	0,1(D)

ARITH5:	XCT	FLFUNC(E)
	ADD	D,[2,,2]
	SOJG	A,ARITH3

	SKIPE	OVFLG
	JFCL	OVRFLW,OVRFLD
	MOVSI	A,TFLOAT
	POPJ	P,

SWITCH:	XCT	COMPAR(E)	;FOR MAX & MIN TESTING
	MOVE	B,VALN
	JRST	(C)
COMPAR==.-6
	CAMLE	B,VALN
	CAMGE	B,VALN



FLSWCH:	XCT	FLCMPR(E)
	MOVE	B,O
	JRST	(C)
FLCMPR==.-6
	CAMLE	B,O
	CAMGE	B,O
;PRIMITIVES ONEP AND ZEROP

MFUNCTION	ONEP,SUBR,[1?]
	MOVEI	E,1
	JRST	JOIN

MFUNCTION	ZEROP,SUBR,[0?]
	MOVEI	E,

JOIN:	ENTRY 1
	GETYP	A,TYP1
	CAIN	A,TFIX	;fixed ?
	JRST	TESTFX
	CAIE	A,TFLOAT	;floating ?
	JRST	WTYP1
	MOVE	B,VAL1
	CAMN	B,NUMBR(E)	;equal to correct value ?
	JRST	YES1
	JRST	NO1

TESTFX:	CAMN	E,VAL1	;equal to correct value ?
	JRST	YES1

NO1:	MOVSI	A,TFALSE
	MOVEI	B,0
	JRST	FINIS

YES1:	MOVSI	A,TATOM
	MOVE	B,IMQUOTE T
	JRST	FINIS

NUMBR:	0	;FLOATING PT  ZERO
	201400,,0	;FLOATING PT ONE
;PRIMITIVES LESSP AND GREATERP

MFUNCTION	LEQP,SUBR,[L=?]
	MOVEI	E,3
	JRST	ARGS

MFUNCTION	GEQP,SUBR,[G=?]
	MOVEI	E,2
	JRST	ARGS


MFUNCTION	LESSP,SUBR,[L?]
	MOVEI	E,1
	JRST	ARGS

MFUNCTION	GREATERP,SUBR,[G?]
	MOVEI	E,0

ARGS:	ENTRY 2
	MOVE	B,VAL1
	MOVE	A,TYP1
	GETYP	0,A
	PUSHJ	P,CMPTYP
	JRST	WTYP1
	MOVE	D,VAL2
	MOVE	C,TYP2
	GETYP	0,C
	PUSHJ	P,CMPTYP
	JRST	WTYP2
	PUSHJ	P,ACOMPS
	JFCL
	JRST	FINIS

; COMPILERS ENTRIES TO THESE GUYS

IRP NAME,,[CGQ,CLQ,CGEQ,CLEQ]COD,,[0,1,2,3]

NAME:	MOVEI	E,COD
	JRST	ACOMPS
TERMIN

ACOMPS:	GETYP	A,A
	GETYP	0,C
	CAIE	0,(A)
	JRST	COMPD		; COMPARING FIX AND FLOAT
TEST:	CAMN	B,D
	JRST	@TABLE4(E)
	CAMG	B,D
	JRST	@TABLE2(E)
	JRST	@TABLE3(E)

CMPTYP:	CAIE	0,TFIX
	CAIN	0,TFLOAT
	AOS	(P)
	POPJ	P,
COMPD:	EXCH	B,D
	CAIN	A,TFLOAT
	JSP	A,BFLOAT
	EXCH	B,D
	CAIN	0,TFLOAT
	JSP	A,BFLOAT
COMPF:	JRST	TEST

MFUNCTION RANDOM,SUBR
	ENTRY
	HLRE	A,AB
	CAMGE	A,[-4]		;At most two arguments to random to set seeds
	JRST	TMA
	JRST	RANDGO(A)
	MOVE	B,VAL2		;Set second seed
	MOVEM	B,RLOW
	MOVE	A,VAL1		;Set first seed
	MOVEM	A,RHI
RANDGO:	PUSHJ	P,CRAND
	JRST	FINIS

CRAND:	MOVE	A,RHI
	MOVE	B,RLOW
	MOVEM	A,RLOW		;Update Low seed
	LSHC	A,-1		;Shift both right one bit
	XORB	B,RHI		;Generate output and update High seed
	MOVSI	A,TFIX
	POPJ	P,


MFUNCTION SQRT,SUBR
	PUSHJ	P,ARGCHK
	JUMPL	B,NSQRT
	PUSHJ	P,ISQRT
	JRST	FINIS

ISQRT:	MOVE	A,B
	ASH	B,-1
	FSC	B,100
SQ2:	MOVE	C,B	;NEWTON'S METHOD, SPECINER'S HACK.
	FDVRM	A,B
	FADRM	C,B
	FSC	B,-1
	CAME	C,B
	JRST	SQ2
	MOVSI	A,TFLOAT
	POPJ	P,

MFUNCTION COS,SUBR
	PUSHJ	P,ARGCHK
	FADR	B,[1.570796326]		;COS(X)=SIN (X+PI/2)
	PUSHJ	P,.SIN
	MOVSI	A,TFLOAT
	JRST	FINIS

MFUNCTION SIN,SUBR
	PUSHJ	P,ARGCHK
	PUSHJ	P,.SIN
	MOVSI	A,TFLOAT
	JRST	FINIS

.SIN:	MOVM	A,B
	CAMG	A,[.0001]
	POPJ	P,		;GOSPER'S RECURSIVE SIN.
	FDVR	B,[-3.0]	;SIN(X)=4*SIN(X/-3)**3-3*SIN(X/-3)
	PUSHJ	P,.SIN
	FSC	A,1
	FMPR	A,A
	FADR	A,[-3.0]
	FMPRB	A,B
	POPJ	P,

CSQRT:	PUSHJ	P,CARGCH
	JUMPL	B,NSQRT
	JRST	ISQRT

CSIN:	PUSHJ	P,CARGCH
CSIN1:	PUSHJ	P,.SIN
	MOVSI	A,TFLOAT
	POPJ	P,

CCOS:	PUSHJ	P,CARGCH
	FADR	B,[1.570796326]
	JRST	CSIN1
MFUNCTION	LOG,SUBR
	PUSHJ	P,ARGCHK	;LEAVES ARGUMENT IN B
	PUSHJ	P,ILOG
	JRST	FINIS

CLOG:	PUSHJ	P,CARGCH

ILOG:	JUMPLE	B,OUTRNG
	LDB	D,[331100,,B]	;GRAB EXPONENT
	SUBI	D,201		;REMOVE BIAS
	TLZ	B,777000	;SET EXPONENT
	TLO	B,201000	; TO 1
	MOVE	A,B
	FSBR	A,RT2
	FADR	B,RT2
	FDVB	A,B
	FMPR	B,B
	MOVE	C,[0.434259751]
	FMPR	C,B
	FADR	C,[0.576584342]
	FMPR	C,B
	FADR	C,[0.961800762]
	FMPR	C,B
	FADR	C,[2.88539007]
	FMPR	C,A
	FADR	C,[0.5]
	MOVE	B,D
	FSC	B,233
	FADR	B,C
	FMPR	B,[0.693147180]	;LOG E OF 2
	MOVSI	A,TFLOAT
	POPJ	P,

RT2:	1.41421356
MFUNCTION	ATAN,SUBR
	PUSHJ	P,ARGCHK
	PUSHJ	P,IATAN
	JRST	FINIS

CATAN:	PUSHJ	P,CARGCH

IATAN:	PUSH	P,B
	MOVM	D,B
	CAMG	D,[0.4^-8]	;SMALL ENOUGH SO ATAN(X)=X?
	JRST	ATAN3		;YES
	CAML	D,[7.0^7]	;LARGE ENOUGH SO THAT ATAN(X)=PI/2?
	JRST	ATAN1		;YES
	MOVN	C,[1.0]
	CAMLE	D,[1.0]		;IS ABS(X)<1.0?
	FDVM	C,D		;NO,SCALE IT DOWN
	MOVE	B,D
	FMPR	B,B
	MOVE	C,[1.44863154]
	FADR	C,B
	MOVE	A,[-0.264768620]
	FDVM	A,C
	FADR	C,B
	FADR	C,[3.31633543]
	MOVE	A,[-7.10676005]
	FDVM	A,C
	FADR	C,B
	FADR	C,[6.76213924]
	MOVE	B,[3.70925626]
	FDVR	B,C
	FADR	B,[0.174655439]
	FMPR	B,D
	JUMPG	D,ATAN2		;WAS ARG SCALED?
	FADR	B,PI2		;YES,  ATAN(X)=PI/2-ATAN(1/X)
	JRST	ATAN2
ATAN1:	MOVE	B,PI2
ATAN2:	SKIPGE	(P)		;WAS INPUT NEGATIVE?
	MOVNS	B		;YES,COMPLEMENT
ATAN3:	MOVSI	A,TFLOAT	
	SUB	P,[1,,1]
	POPJ	P,

PI2:	1.57079632
MFUNCTION	IEXP,SUBR,[EXP]	
	PUSHJ	P,ARGCHK	;LEAVE FLOATING POINT ARG IN B
	PUSHJ	P,IIEXP
	JRST	FINIS

CEXP:	PUSHJ	P,CARGCH

IIEXP:	PUSH	P,B
	MOVM	A,B
	SETZM	B
	FMPR	A,[0.434294481]	;LOG BASE 10 OF E
	MOVE	D,[1.0]
	CAMG	A,D
	JRST	RATEX
	MULI	A,400
	ASHC	B,-243(A)
	CAILE	B,43
	JRST	OUTRNG
	CAILE	B,7
	JRST	EXPR2
EXPR1:	FMPR	D,FLOAP1(B)
	LDB	A,[103300,,C]	
	SKIPE	A
	TLO	A,177000
	FADR	A,A
RATEX:	MOVEI	B,7
	SETZM	C
RATEY:	FADR	C,COEF2-1(B)
	FMPR	C,A
	SOJN	B,RATEY
	FADR	C,[1.0]	
	FMPR	C,C
	FMPR	D,C
	MOVE	B,[1.0]
	SKIPL	(P)		;SKIP IF INPUT NEGATIVE
	SKIPN	B,D
	FDVR	B,D
	MOVSI	A,TFLOAT
	SUB	P,[1,,1]
	POPJ	P,

EXPR2:	LDB	E,[030300,,B]	
	ANDI	B,7
	MOVE	D,FLOAP1(E)
	FMPR	D,D		;TO THE 8TH POWER
	FMPR	D,D
	FMPR	D,D
	JRST	EXPR1

COEF2:	1.15129278
	0.662730884
	0.254393575
	0.0729517367
	0.0174211199
	2.55491796^-3
	9.3264267^-4

FLOAP1:	1.0
	10.0
	100.0
	1000.0
	10000.0
	100000.0
	1000000.0
	10000000.0

;LSH AND ROT (ERB WOULD BE PLEASED) PDL 2/22/79

MFUNCTION %LSH,SUBR,LSH
	ENTRY	2
	MOVE	C,[LSH B,(A)]
	JRST	LSHROT

MFUNCTION %ROT,SUBR,ROT
	ENTRY	2
	MOVE	C,[ROT B,(A)]
LSHROT:	GETYP	A,(AB)
	PUSHJ	P,SAT
	CAIE	A,S1WORD
	 JRST	WRONGT
	GETYP	A,2(AB)
	CAIE	A,TFIX
	 JRST	WTYP2
	MOVE	A,3(AB)
	MOVE	B,1(AB)
	XCT	C
	MOVE	A,$TWORD
       	JRST	FINIS

;BITWISE BOOLEAN FUNCTIONS

MFUNCTION %ANDB,SUBR,ANDB
	ENTRY
	HRREI	B,-1		;START ANDING WITH ALL ONES
	MOVE	D,[AND B,A]	;LOGICAL INSTRUCTION
	JRST	LOGFUN		;DO THE OPERATION

MFUNCTION %ORB,SUBR,ORB
	ENTRY
	MOVEI	B,0
	MOVE	D,[IOR B,A]
	JRST	LOGFUN

MFUNCTION %XORB,SUBR,XORB
	ENTRY
	MOVEI	B,0
	MOVE	D,[XOR B,A]
	JRST	LOGFUN

MFUNCTION %EQVB,SUBR,EQVB
	ENTRY
	HRREI	B,-1
	MOVE	D,[EQV B,A]

LOGFUN:	JUMPGE	AB,ZROARG
LOGTYP:	GETYP	A,(AB)		;GRAB THE TYPE
	PUSHJ	P,SAT		;STORAGE ALLOCATION TYPE
	CAIE	A,S1WORD
	JRST	WRONGT		;WRONG TYPE...LOSE
	MOVE	A,1(AB)		;LOAD ARG INTO A
	XCT	D		;DO THE LOGICAL OPERATION
	AOBJP	AB,.+2		;ADD ONE TO BOTH HALVES
	AOBJN	AB,LOGTYP	;ADD AGAIN AND LOOP IF NEEDED

ZROARG:	MOVE	A,$TWORD
	JRST	FINIS
REPEAT 0,[
;routine to sort lists or vectors of either fixed point or floating numbers
;the components are interchanged repeatedly to acheive the sort
;first arg:	the structure to be sorted
;if no second arg sort in descending order
;second arg:	if false then sort in ascending order
;		else sort in descending order

MFUNCTION	SORT,SUBR
	ENTRY 
	HLRZ	A,AB
	CAIGE	A,-4		;Only two arguments allowed
	JRST	TMA
	MOVE	O,DESCEND	;Set up "O" to test for descending order as default condition
	CAIE	A,-4		;Optional second argument?
	JRST	.+4
	GETYP	B,TYP2		;See if it is other than false
	CAIN	B,TFALSE
	MOVE	O,ASCEND	;Set up "O" to test for ascending order
	GETYP	A,TYP1		;CHECK TYPE OF FIRST ARGUMENT
	CAIN	A,TLIST
	JRST	LSORT
	CAIN	A,TVEC
	JRST	VSORT
	JRST	WTYP1




GOBACK:	MOVE	A,TYP1		;RETURN THE SORTED ARGUMENT AS VALUE
	MOVE	B,VAL1
	JRST	FINIS

DESCEND:	CAMG	C,(A)+1
ASCEND:		CAML	C,(A)+1
;ROUTINE TO SORT LISTS IN NUMERICAL ORDER

LSORT:	MOVE	A,VAL1
	JUMPE	A,GOBACK	;EMPTY LIST?
	HLRZ	B,(A)		;TYPE OF FIRST COMPONENT
	CAIE	B,TFIX
	CAIN	B,TFLOAT
	SKIPA
	JRST	WRONGT
	MOVEI	E,0		;FOR COUNT OF LENGTH OF LIST
LCOUNT:	JUMPE	A,LLSORT	;REACHED END OF LIST?
	MOVE	A,(A)		;NEXT COMPONENT
	TLZ	A,(B)		;SAME TYPE AS FIRST COMPONENT?
	TLNE	A,-1
	JRST	WRONGT
	AOJA	E,LCOUNT	;INCREMENT COUNT AND CONTINUE

LLSORT:	SOJE	E,GOBACK	;FINISHED WITH SORTING?
	HRRZ	A,VAL1		;START THIS LOOP OF SORTING AT THE BEGINNING
	MOVEM	E,(P)+1		;Save the iteration depth
CLSORT:	HRRZ	B,(A)		;NEXT COMPONENT
	MOVE	C,(B)+1		;ITS VALUE
	XCT	O		;ARE THESE TWO COMPONENTS IN ORDER?
	JRST	.+4
	MOVE	D,(A)+1		;INTERCHANGE THEM
	MOVEM	D,(B)+1
	MOVEM	C,(A)+1
	MOVE	A,B		;MAKE THE COMPONENT IN "B" THE CURRENT ONE
	SOJG	E,CLSORT
	MOVE	E,(P)+1		;Restore the iteration depth
	JRST	LLSORT
;ROUTINE TO SORT VECTORS IN NUMERICAL ORDER

VSORT:	HLRE	D,VAL1		;GET COUNT FIELD OF VECTOR
	IDIV	D,[-2]		;LENGTH
	JUMPE	D,GOBACK	;EMPTY VECTOR?
	MOVE	E,D		;SAVE LENGTH IN "E"
	HRRZ	A,VAL1		;POINTER TO VECTOR
	MOVE	B,(A)		;TYPE OF FIRST COMPONENT
	CAME	B,$TFIX
	CAMN	B,$TFLOAT
	SKIPA
	JRST	WRONGT
	SOJLE	D,GOBACK	;IF ONLY ONE COMPONENT THEN FINISHED
VCOUNT:	ADDI	A,2		;CHECK NEXT COMPONENT
	CAME	B,(A)		;SAME TYPE AS FIRST COMPONENT?
	JRST	WRONGT
	SOJG	D,VCOUNT	;CONTINUE WITH NEXT COMPONENT

VVSORT:	SOJE	E,GOBACK	;FINISHED SORTING?
	HRRZ	A,VAL1		;START THIS LOOP OF SORTING AT THE BEGINNING
	MOVEM	E,(P)+1		;Save the iteration depth
CVSORT:	MOVE	C,(A)+3		;VALUE OF NEXT COMPONENT
	XCT	O		;ARE THESE TWO COMPONENTS IN ORDER?
	JRST	.+4
	MOVE	D,(A)+1		;INTERCHANGE THEM
	MOVEM	D,(A)+3
	MOVEM	C,(A)+1
	ADDI	A,2		;UPDATE THE CURRENT COMPONENT
	SOJG	E,CVSORT
	MOVE	E,(P)+1		;Restore the iteration depth
	JRST	VVSORT
]

MFUNCTION OVERFLOW,SUBR

	ENTRY

	MOVEI	E,OVFLG
	JRST	FLGSET
	

MFUNCTION TIME,SUBR
	ENTRY
	PUSHJ	P,CTIME
	JRST	FINIS

IMPURE

RHI:	267762113337
RLOW:	155256071112
OVFLG:	-1
PURE


END