TITLE	.$ALOC	ARRAY SPACE ALLOCATION


	ENTRY	.$ALOC
	EXTERN	ERRMSG,.$SNAL,.$MOVE
	SEARCH	IMPPRM
;AC DEFNS
	AC==0
	T4==1
	T1==5
	T2==6
	T3==7


.$ALOC:	SUB	T1,T2
	AOJLE	T1,$.ERR
	IMUL	T1,AC
	IMUL	T2,AC
	MOVN	T2,T2
	JRST	AC,0(J)
$.ERR:	
	PRMERRORR	23,0,0,IMPSTR<Array space exhausted>

	PRGEND
TITLE	.$CONC	STRING CONCATENATION PRIMITIVE

;	.$CONC CONCTENATES THE STRING POINTED TO BY P2 ONTO THE END OF
;	THE STRING POINTED TO BY P1.
;	P1 AND P2 ARE PRESERVED
;	AC,T4 AND T5 ARE DESTROYED

	ENTRY	.$CONC
	EXTERN	ERRMSG,.$SNAL,.$MOVE

	SEARCH	IMPPRM
;AC DEFNS
	AC==0
	T4==1
	T1==5
	T2==6
	T3==7


.$CONC:	MOVE	AC,[POINT 9,(P2),8]
	MOVEM	AC,P2POINT	;SAVE IT
	LDB	T2,P2POINT	;GET LENGTH OF P2
	JUMPE	T2,0(J)		;IF NULL RETURN
	MOVEM	T2,AC		;STORE LENGTH FOR A CYCLE COUNT
	LDB	T1,BYTTBL	;GET LENGTH OF P1
	ADD	T2,T1		;GET NEW LENGTH
	CAILE	T2,^D255
	JRST $COERR		;TOO LONG
	DPB	T2,BYTTBL	;DEPOSIT NEW LENGTH IN NEW STRING
	MOVEM	T1,T2		;MAKE COPY OF LENGTH OF P1
	ANDI	T2,3		;GET BYTE NUMBER
	LSH	T1,-2		;AND WORD NUMBER
	IOR	T1,BYTTBL(T2)	;AND HENCE APPROPRIATE POINTER
SLP:	ILDB	T2,P2POINT	;GET BYTE FROM P2
	IDPB	T2,T1		;COPY IT ONTO END OF P1
	SOJG	AC,SLP		;CONTINUE
	JRST	0(J)		;RETURN

$COERR:	PRMERROR	6,1,0,IMPSTR<Concatenated string too long>

P2POINT: Z

BYTTBL:	POINT 9,(P1),8
	POINT 9,(P1),17
	POINT 9,(P1),26
	POINT 9,(P1),35

	PRGEND

TITLE .$MOVE	STRING MOVE

	ENTRY	.$MOVE

	SEARCH	IMPPRM
;AC DEFNS
	AC==0
	T4==1
	T1==5
	T2==6
	T3==7


;	.$MOVE TAKES THE STRING POINTED TO BY P2 AND MOVES IT TO THE
;	LOCATIONS POINTED TO BY P1.
;	P1 IS PRESERVED
;	P2 AND AC ARE DESTROYED

.$MOVE:	HRL	P2,P2
	HLRZ	AC,0(P2)		;GET FIRST WORD OF STRING
	LSH	AC,^D-11		;GET NUMBER OF WORDS FROM LENGTH
	HRR	P2,P1
	HRRZ	T1,P1
	ADD	T1,AC
	BLT	P2,(T1)		;COPY
	JRST	0(J)		;RETURN

	PRGEND

TITLE	.$COMP	STRING COMPARISON

	ENTRY	.$COMP

	SEARCH	IMPPRM
;AC DEFNS
	AC==0
	T4==1
	T1==5
	T2==6
	T3==7

;	.$COMP COMPARES THE STRINGS POINTED TO BY P1 AND P2
;	RESULTS ARE AC<0 IF P1<P2, AC=0 IF P1=P2, AC>0 IF P1>P2
;	P1 AND P2 ARE PRESERVED
;	AC,T1 AND T2 ARE DESTROYED

.$COMP:	DMOVE	T1,P1PT		;GET THE 2 POINTERS
	DMOVEM	T1,P1PTR	;SAVE THEM
	LDB	AC,P1PTR	;GET LENGTH OF P1
	LDB	T2,P2PTR	;GET LENGTH OF P2
	CAMLE	T2,AC		;
	MOVE	T2,AC		;GET WHICHEVER LENGTH IS SHORTER
	JUMPE	T2,COMFIN	;IF ZERO DO NOT COMPARE FIRST BYTE
LP:	ILDB	AC,P1PTR	;GET CHAR FROM P1
	ILDB	T1,P2PTR	;GET CHAR FROM P2
	SUB	AC,T1
	JUMPN	AC,0(J)		;RETURN WITH CORRECT VALUE IN AC IF NOT EQUAL
	SOJG	T2,LP		;KEEP GOING UNTIL DONE
;HERE WHEN ALL EQUAL
COMFIN:	LDB	AC,P1PT	;GET LENGTH OF P1
	LDB	T1,P2PT		;GET LENGTH OF P2
	SUB	AC,T1		;GET APPROPRIATE VALUE IN AC
	JRST	0(J)		;RETURN

P1PT:	POINT 9,(P1),8
P2PT:	POINT 9,(P2),8
P1PTR:	Z
P2PTR:	Z

	PRGEND


TITLE	.$IEXP	INTEGER EXPONENTIATION


	SEARCH	IMPPRM
	ENTRY	.$IEXP
;AC DEFNS
	AC==0
	T4==1
	T1==5
	T2==6
	T3==7


.$IEXP:	MOVEI	P2,1
IEX1:	SOJL	AC,0(J)
	IMUL	P2,P1
	JRST	AC,IEX1

;*;SINGLE PRECISION INTEGER TO INTEGER EXP FUNCTION.
;*
;*;EXP CALCULATES I**J, WHERE
;*
;*A=0
;*B=1
;*C=2
;*D=3
;*E=4
;*F=5
;*G=6
;*H=7
;*P=17
;*
;*;	J=Q(0) + Q(1)*2 + Q(2)*4 + ..., WHERE Q(I)=0 OR 1.
;*IEXP:	JUMPE	B,[MOVEI A,1		;BASE**0 RETURNS 1
;*		POPJ P,]
;*	JUMPN	A,BASNT0	;GO AHEAD IF BASE NE 0.
;*	JUMPGE	B,IEXP4		;RETURN IF BASE=0, EXP >= 0.
;*IOVFL:	ERROR	(APR,5,1,.+1)	;O'E, SET UP
;*	HRLOI	0,377777	;ANS.= INFINITY
;*	POPJ	17,		;AND RETURN.
;*
;*BASNT0:	JUMPL	B,[TRNN B,1	;TEST FOR EXP<0.  IS EXP ODD?
;*		MOVMS A		;EXP IS EVEN. GET ABS(BASE)
;*		CAIE A,1	;IS BASE +-1?
;*		CAMN A,[-1]
;*		POPJ P,		;YES, RETURN +-1
;*		MOVEI A,0	;NO, RETURN 0
;*		POPJ P,]
;*	PUSH	P,C		;SAVE A WORKING AC.
;*	MOVEI	C,1		;INITIALIZE ANSWER TO 0.
;*	MOVEM	C,SAVEC		;INITIALIZE FLAG WORD TO > 0.
;*	JUMPG	A,IEXP2		;GO TO CALC. IF ANSWER WILL BE > 0.
;*	TRNN	B,1		;IS EXP ODD OR EVEN?
;*	JRST	IEXP2		;EXP IS EVEN, ANS WILL BE > 0.
;*	SETCMM	SAVEC		;EXP IS ODD, BASE < 0, ANS WILL BE <0. 
;*	JRST	IEXP2		;GO TO CALC.
;*
;*IEXP1:	IMUL	A,A		;
;*	JFCL	1,OVER		;TRANSFER TO OVER IF OVERFLOW.
;*	LSH	B,-1		;DIVIDE B BY 2.
;*IEXP2:	TRZE	B,1		;CHECK LAST BIT OF B.
;*	IMUL	C,A		;
;*	JFCL	1,OVER		;TRANSFER TO OVER IF OVERFLOW.
;*	JUMPG	B,IEXP1		;GO TO RETURN IF B HAS BECOME 0.
;*IEXP3:	MOVE	A,C		;PUT ANSWER IN AC A.
;*IEXP3A:	POP	P,C		;RESTORE AC C.
;*IEXP4:	POPJ	P,		;RETURN.
;*
;*OVER:	PUSHJ	P,IOVFL		;SET ANSWER TO + INFINITY.
;*	SKIPL	SAVEC		;SKIP IF ANS IS TO BE < 0.
;*	JRST	IEXP3A		;GO TO RETURN.
;*	MOVNS	A,A		;SET UP -
;*	SUBI	A,1		;INFINITY
;*	JRST	IEXP3A		;GO TO RETURN.
;*
;*SAVEC:	0
;*
;*	LIT
	PRGEND

TITLE	.$REXP	REAL EXPONENTIATION


	SEARCH	IMPPRM
	ENTRY	.$REXP
;AC DEFNS
	AC==0
	T4==1
	T1==5
	T2==6
	T3==7

.$REXP:	MOVM	T5,AC
	HRLZI	P2,201400
	SOJL	T5,REX2
REX1:	FMPR	P2,P1
	SOJGE	T5,REX1
REX2:	JUMPGE	AC,0(J)
	MOVE 	P1,P2
	HRLZI	P2,201400
	FDVR	P2,P1
	JRST	AC,0(J)


;*;SINGLE PRECISION FORTRAN IV EXP.3 FUNCTIONS
;*;THESE ROUTINES CALCULATE A FLOATING POINT NUMBER RAISED TO A
;*;FLOATING POINT POWER. THE CALCULATION IS
;*;	A**B= EXP(B*LOG(A))
;*
;*;IF THE EXPONENT IS AN INTEGER < 2**35 IN MAGNITUDE, THE
;*;RESULT WILL BE COMPUTED USING "EXP2.." AND THE ANSWER 
;*;WILL HAVE THE CORRECT SIGN. (REMEMBER THAT THE "INTEGER"
;*;HAS ONLY 27 SIGNIFCANT BITS.)
;*;SINCE NEGATIVE NUMBERS RAISED TO NON-INTEGER POWERS YIELD
;*;COMPLEX ANSWERS, THE MAIN ALGORITHM CALCULATES
;*;	EXP(B*LOG(ABSF(A)))
;*;ACCUMULATOR DEFINITIONS
;*	A=	0
;*	B=	1
;*	C=	2
;*	D=	3
;*	E=	4
;*	F=	5
;*	G=	6
;*	H=	7
;*	Q=	16
;*	P=	17
;*
;*REXP:	JUMPE	B,[MOVSI A,(1.0)	;BASE**0, RETURNS 1
;*		POPJ P,]
;*	JUMPN	A,EXP30A	;GO AHEAD IF BASE NE 0.
;*	JUMPGE	B,EXP3A		;EXIT IF BASE = 0, EXP >= 0,
;*	ERROR	(APR,5,1,.+1)	;O'E, TYHE AN ERROR MESSAGE
;*	HRLOI	A,377777	;ANS.=+INFINITY
;*	POPJ	17,		;AND EXIT.
;*
;*EXP30A:	PUSH	P,C		;SAVE AC C
;*	PUSH	P,D		;SAVE AC D
;*	MOVM	D,B		;SET EXP. POSITIVE.
;*	MOVEI	C,0		;CLEAR AC C TO ZERO
;*	LSHC	C,11		;SHIFT 9 PLACES LEFT
;*	SUBI	C,200		;TO OBTAIN SHIFTING FACTOR
;*	PUSH	P,E		;SAVE AC E.
;*	JUMPLE	C,EXP3GO	;IS C > 0
;*	HRR	E,C		;SET UP E AS AN INDEX REG.
;*	MOVEI	C,0		;CLEAR OUT AC C
;*	LSH	D,-1		;RIGHT ADJUST EXP TO BIT 1.
;*	ASHC	C,(E)		;SHIFT LFT BY CONTENTS OF E
;*	JFCL	EXP3GO		;IF OVERFLOW, GO TO EXP3GO.
;*	JUMPN	D,EXP3GO	;IS EXPONENT AN INTEGER ?
;*	JUMPGE	B,.+2		;YES, WAS  IT NEG. ?
;*	MOVNS	C		;YES, NEGATE IT
;*	MOVE	B,C		;MOVE INTEGER INTO B
;*	PUSHJ	P,EXP2..	;%216% OBTAIN RESULT USING EXP2..
;*	JRST	EXPPOP		;RETURN TO RESTORE ACS C&D&E.
;*
;*EXP3GO:	MOVM	E,A		;GET ABS(BASE) IN NE 0 OR 1.
;*	MOVE	D,A		;SAVE SIGN OF A
;*	MOVE	C,B		;SAVE AC B.
;*	FUNCT	ALOG.,<E>	;CALCULATE LOG OF A
;*	FMPRM	A, C		;CALCULATE B*LOG(A)
;*	FUNCT	EXP.,<C>		;CALCULATE EXP(B*LOG(A))
;*	JUMPGE	D,EXPPOP	;SHOULD SIGN BE NEGATIVE?
;*	MOVN	A,A		;YES, NEGATE RESULT
;*EXPPOP:	POP	P,E		;RESTORE AC E.
;*	POP	P,D		;RESTORE AC D.
;*	POP	P,C		;RESTORE AC C.
;*EXP3A:	POPJ	P,		;EXIT
;*
;*	LIT
;*	PRGEND
;*;SINGLE PRECISION EXP.2 FUNCTIONS
;*;THESE ROUTINES CALCULATE A FLOATING POINT NUMBER TO A FIXED
;*;POINT POWER. THE CALCULATION IS A**B, WHERE B IS OF THE FORM
;*
;*;	B=Q(0) + Q(1)*2 + Q(2)*4 + ...WHERE Q(I)=0 OR 1
;*
;*;THERE ARE NO RESTRICTIONS ON THE BASE OR EXPONENT
;*
;*EXP2..:	JUMPE	B,[MOVSI A,(1.0)		;BASE**0, RETURNS 1
;*		POPJ P,]
;*	JUMPN	A,EXP2A		;GO AHEAD IF BASE NE 0.
;*	JUMPGE	B,FEXP4		;EXIT IF BASE =0, EXP >= 0,
;*	ERROR	(APR,5,1,.+1)	;O'E, SET UP
;*	HRLOI	0,377777	;AN ANSWER OF INFINITY.
;*	POPJ	17,		;RETURN.
;*
;*EXP2A:	MOVEM	C,SAVEC  	;SAVE A WORKING ACCUMULATOR.
;*	MOVSI	C, 201400	;GET 1.0 IN ACCUMULATOR C.
;*	MOVEM	A,SAVEA		;STORE BASE IN SAVEA.
;*	MOVEM	B,SAVEB		;STORE EXP. IN SAVEB.
;*	JUMPGE	B, FEXP2	;IS EXPONENT POSITIVE?
;*	MOVMS	B		;NO, MAKE IT POSITIVE
;*	JFCL	MININF		;IF EXP WAS 400000,,0 GO TO MININF.
;*	PUSHJ	P, FEXP2	;CALL MAIN PART OF PROGRAM.
;*INV:	MOVSI	B, 201400	;GET 1.0 IN B.
;*	FDVM	B, A		;FORM 1/(A**B) FOR NEG. EXPONENT.
;*	POPJ	P,		;RETURN.
;*
;*FEXP1:	FMP	A, A		;FORM A**N, FLOATING POINT.
;*	JFCL	OVER		;IF OVER/UNDERFLOW, GO TO OVER.
;*	LSH	B, -1		;SHIFT EXPONENT FOR NEXT BIT.
;*FEXP2:	TRZE	B, 1		;IS THE BIT ON?
;*	FMP	C, A		;YES, MULTIPLY ANSWER BY A**N.
;*	JFCL	OVER		;IF OVER/UNDERFLOW, GO TO OVER.
;*	JUMPN	B, FEXP1	;UPDATE A**N UNLESS ALL THROUGH.
;*FEXP3:	MOVE	A, C		;PICK UP RESULT FROM C.
;*FEXP3A:	MOVE	C,SAVEC		;RESTORE A WORKING ACCUMULATOR.
;*FEXP4:	POPJ	P,		;RETURN.
;*OVER:	MOVE	C,.JBTPC		;PICK UP FLAGS.
;*	SKIPG	SAVEB		;JUMP TO INVERT IF
;*	JRST	INVERT		;EXP. WAS NEGATIVE.
;*	TLNE	C,(1B11)	;UNDERFLOW, IN WHICH CASE,
;*	ERROR	(APR,7,1,OUT)	;UNDER FLOW
;*	ERROR	(APR,5,1,OUT)	;OVER FLOW
;*OUT:	HRLOI	A,377777	;ANS. IS SET TO + INFINITY.
;*	TLNE	C,(1B11)	;SKIP IF OVERFLOW FLAG SET.
;*	SETZ	A,		;O'E, SET ANSWER TO 0.
;*OUT2:	SKIPL	SAVEA		;ANS. IS >= 0, IF
;*	JRST	FEXP3A		;A WAS >= 0.
;*	MOVE	B,SAVEB		;PICK UP THE EXP.
;*	TRNE	B,1		;ANS. IS < 0, IF A < 0 AND
;*	MOVNS	A		;THE EXP. WAS ODD.
;*	JRST	FEXP3A		;GO TO RETURN.
;*
;*INVERT:	SUB	P,[XWD 1,1]	;ADJUST PDP.
;*	TLCN	C,(1B11)	;IF TRUE UNDERFLOW, GO
;*	JRST	ALOGRT		;TO ALOGRT.
;*	ERROR	(APR,1,1,OUT)	;TYPE AN ERROR MESSAGE
;*
;*ALOGRT:	MOVM	C,SAVEA		;PICK UP ABS(BASE).
;*	FUNCT	ALOG.,<C>	;CALC. LOG(ABS(A)).
;*	MOVEM	A,C		;RESULTS TO C.
;*IFE CPU-KI10,<FLTR	0,SAVEB>
;*IFE CPU-KA10,<FUNCT	FLOAT.,<SAVEB>	;MAKE EXP. A FLOATING
;*>
;*	FMPRM	A,C		;CALC. B*ALOG(ABS(A)).
;*	FUNCT	EXP.,<C>		;FIND EXP. OF THIS.
;*	JRST	OUT2		;GO AND TYPE ERROR MESSAGE.
;*
;*MININF:	HRLOI	B,377777	;SET EXP = +INFINITY.
;*	PUSHJ	P,FEXP2		;GO TO MAIN ROUTINE.
;*	FMPR	A,SAVEA		;ANS. = ANS. TIMES A.
;*	JFCL	OVER		;GO TO OVER IF OVERFLOW.
;*	JRST	INV		;OTHERWISE, GO TO INV.
;*
;*
;*SAVEA:	0			;TEMP FOR A.
;*SAVEB:	0			;TEMP FOR B.
;*SAVEC:	0			;TEMP FOR C.
;*
;*	LIT
;*	PRGEND
	PRGEND

TITLE	.$SRES	STRING RESOLUTIION

	ENTRY	.$SRES, .$RESF
	EXTERNAL	.$SNAL

	SEARCH	IMPPRM
;AC DEFNS
	AC==0
	T4==1
	T1==5
	T2==6
	T3==7


	TWOSEG
	RELOC	400000
				; S -> A.(B).C
.$SRES:	MOVEM	6,A
	MOVEM	5,C
	HRLI	2,331100
	HRLI	1,331100
	MOVEM	2,S
	MOVEM	1,B
	LDB	0,1
	LDB	4,2
	SUB	4,0	; LENGTH OF REMAINDER
	JUMPL	FAIL	; PAST THE END
	MOVNM	4,X	; X = -(LENGTH OF REM)
RES0:	MOVEM	2,SB
RES1:	SOJL	0,FOUND
	ILDB	5,2
	ILDB	6,1
	CAMN	5,6
	JRST	RES1
	SOJL	4,FAIL
	MOVE	2,SB
	IBP	0,2
	MOVE	1,B
	LDB	0,1
	JRST	RES0
FAIL:	SETZ	1,0
	MOVE	2,S
	JRST	0(3)
ASS:	JUMPN	2,ASS1
	JUMPE	4,0(5)
	JRST	FAIL
ASS1:	HRLI	2,331100
	DPB	4,2
ASS2:	ILDB	6,1
	IDPB	6,2
	SOJG	4,ASS2	;KMF REMOVED SOSGE 4,ASS2
	JRST	0(5)

FOUND:	MOVEM	2,TEMP
	ADDM	4,X	; X = -(LENGTH OF LHS)
	MOVEM	4,SB
	MOVE	1,S
	HRLI	1,331100
	MOVE	2,A
	MOVN	4,X
	JSP	5,ASS
	MOVE	1,TEMP
	MOVE	2,C
	MOVE	4,SB
	JSP	5,ASS
	SETO	1,0
	MOVE	2,S
	JRST	0(3)
.$RESF:	PRMERROR	7,0,0,IMPSTR<Resolution fails>
	RELOC	0
TEMP:	0
S:	0
SB:	0
A:	0
B:	0
C:	0
X:	0
	PRGEND

TITLE	.$SNAL	SIGNAL MECHANISM


	SEARCH	IMPPRM
;AC DEFNS
	AC==0
	T4==1
	T1==5
	T2==6
	T3==7


	TWOSEG
	RELOC	400000
	ENTRY .$SNAL
	ENTRY	EVENT, SUBEVE, EVENTI
	EXTERNAL %PROG,.$HERE
	EXTERNAL $SIGNAL

.$SNAL:
	MOVEM	6,.EVENT
	MOVEM	5,.SUBEV
	MOVEM	4,.EVINF
	MOVEI	5,1
	LSH	5,0(6)
FF0:	HRRZ	3,3
	CAIE	3,.$HERE	;PROC PARAM
	JRST	FF01	;NO
	MOVEI	0,TEMPL
	EXCH	0,1(BASE5)
	JRST	0(3)	;LET .$PENT RECOVER
TEMPL:	HRRZ	3,0		;RESTORE RETN ADDR
FF01:	MOVEI	4,%PROG
FF1:	MOVEI	2,1(4)
	MOVE	1,0(2)
	CAMG	3,2
	JRST	FF11
	CAMG	3,1
	JRST	FF12
FF11:	SKIPN	4,0(4)
	JRST	FF5
	JRST	FF1
FF12:	MOVEI	6,20

	MOVEI	1,1(2)
FF2:	SOJ	6,0
	MOVE	2,1
	MOVE	1,0(2)
	CAMLE	3,1
	JRST	FF2
				; FIND TRAP
	MOVEI	1,1(2)
FF3:	MOVE	2,1
	HLRZ	1,0(2)
	JUMPE	1,FF4
	CAMLE	3,1
	JRST	FF3
	HRRZ	1,0(2)
	CAMG	3,1
	JRST	FF4
	TSNN	5,1(2)
	JRST	FF4
	HRRZ	3,1(2)
	JRST	0(3)
FF4:	CAIN	6,17
	JRST	FF41	; CHEAP PROCEDURE
	MOVE	17,@6
	MOVE	0,1(17)
	MOVEM	0,@6
FF41:	POP	17,3
	JRST	FF0
				; GIVE UP AND REPORT IT
FF5:	MOVE	6,.EVENT
	MOVE	5,.SUBEV
	MOVE	4,.EVINF
	JRST	$SIGNAL
EVENT:	MOVE	1,.EVENT
	POPJ	17,
SUBEVE:MOVE	1,.SUBEV
	POPJ	17,
EVENTI:MOVE	1,.EVINF
	POPJ	17,
	RELOC	0
.EVENT:	0
.SUBEV:	0
.EVINF:	0
	PRGEND

TITLE	.$PENT	PROCEDURE ENTRY

	ENTRY	.$PENT,.$HERE		; PROC PARM ENTRY

	SEARCH	IMPPRM
;AC DEFNS
	AC==0
	T4==1
	T1==5
	T2==6
	T3==7


.$PENT:	MOVEM	J,1(2)		; SAVE RETURN ADDR
	EXCH	BASE1,2(2)
	EXCH	BASE2,3(2)
	EXCH	BASE3,4(2)
	EXCH	BASE4,5(2)
	EXCH	BASE5,6(2)
	PUSHJ	P,@0(2)	; ENTER THE PROCEDURE
.$HERE:	MOVE	J,1(BASE5)		; RETURN ADDRESS
	EXCH	BASE1,2(BASE5)
	EXCH	BASE2,3(BASE5)
	EXCH	BASE3,4(BASE5)
	EXCH	BASE4,5(BASE5)
	EXCH	BASE5,6(BASE5)
	JRST	0(3)		; RETURN TO PROGRAM
	PRGEND

TITLE	.$PASS	PROCEDURE PARAMETERS

	ENTRY	.$PASS	; PROCEDURE PARAM ASSIGNMENT

	SEARCH	IMPPRM
;AC DEFNS
	AC==0
	T4==1
	T1==5
	T2==6
	T3==7


.$PASS:	MOVEM	0,0(2)	; ENTRY POINT
	MOVEM	BASE1,2(2)
	MOVEM	BASE2,3(2)
	MOVEM	BASE3,4(2)
	MOVEM	BASE4,5(2)
	MOVEM	2,6(2)	; ADDRESS OF VECTOR
	JRST	0(J)
	PRGEND



TITLE	FLOAT

	SEARCH	IMPPRM
	ENTRY	FLOAT

FLOAT:	HLRE	AC,ARG1
	HLL	ARG1,AC
	FSC	ARG1,233
	SKIPGE	0,ARG1
	AOSE	0,AC
	FSC	AC,255
	FADR	AC,ARG1
	JRST	0(J)


	END