; -*- MIDAS -*-

TITLE SUBR TIMER PACKAGE

.FASL
IF1,.INSRT SYS:.FASL DEFS

;;; THIS FILE CONTAINS THE FOLLOWING FUNCTIONS:

; TIME-FUNCTION   -- TAKES A SYMBOL WITH SUBR, LSUBR, OR FSUBR PROP TO TIME
; TIME-SUBR	  -- TAKES A SUBR POINTER AND A SYMBOL, TO TIME THE SUBR
; TIME-LSUBR	  -- TAKES AN LSUBR POINTER AND A SYMBOL, TO TIME THE LSUBR
; UNTIME-FUNCTION -- TAKES A SYMBOL, TO UNTIME THE ASSOCIATED FUNCTION
; INIT-TIMER	  -- INITIALIZE TIMER.  SHOULD BE CALLED EACH TIME
;		     BEFORE RUNNING CODE, TO BE SURE THAT EACH FUNCTION IS
;		     TIMED, AND THAT THE COUNTS/TIMES START AT 0
; SET-TIMER	  -- MAKES SURE ALL PROBES ARE IN PLACE.  SHOULD BE DONE
;		     AFTER QUITTING OR ERRORS, IF INIT-TIMER IS NOT TO BE DONE
; GET-ALL-TIMES	  -- TAKES NO ARGUMENTS, AND RETURNS AN ALIST OF TIMINGS.
;		     (SYMBOL CALL-COUNT MICROSECONDS REALTIME=SECONDS)
; GET-TIME	  -- TAKES SINGLE ARGUMENT, OF SYMBOL OR SUBR-POINTER, AND
;		     RETURNS (CALL-COUNT MICROSECONDS REALTIME-SECONDS)
; UNTIME	  -- REMOVES ALL FUNCTIONS FROM THE TABLE.

FSYMB=:0			   ;Symbol for function being timed
				   ; [*NOTE*  THIS SYMBOL WILL NOT BE GC
				   ;	      PROTECTED, SO DON'T DELETE IT'S
				   ;	      PLIST OR IT COULD GO AWAY!!
				   ;	      (NOT VERY DAMNED LIKELY!)]
FCOUNT=:1			   ;Count of number of times function called
FTIME=:2			   ;runtime of function, in units of 4 uS.
FETIME=:3
FSUBR=:4			   ;SUBR ptr to function
FJSP=:5
FINST=:6			   ;First instruction of function, for
				   ;clobbering purposes.
FINST0=:7			   ;Second instruction of function, for
				   ;clobbering purposes.
ENTSIZ=:8			   ;Minimum size of each entry.

.GLOBAL SEGLOG

VERPRT TIMER

.SXEVAL (SSTATUS FEATURE TIMER)

;;; TAKES A SYMBOL, TO STORE IT AND IT'S SUBR/LSUBR/FSUBR PTR IN ARRAY SLOT.

.ENTRY TIME-FUNCTION SUBR 002

	JSP T,SYMBP		   ;MAKE SURE IT'S A SYMBOL
	MOVE F,[JSP TT,FHANDL]	   ;HANDLER FOR SUBR'S AND FSUBRS
	PUSHJ P,FGET		   ;GET THE SUBR-PROPERTY IN B
	  MOVE F,[JSP TT,LHANDL]   ;HANDLER FOR LSUBRS (LOSE!)
TIMEFN:	PUSH P,A
	PUSH P,B
	PUSH P,F
	PUSH P,T
	
	PUSHJ P,UNPUR		   ;  UNPURIFY IT!
	HLR T,SCALL1		   ;CHECK THE CALL .FUNCTION RUNTIME'S
	CAIN T,(PUSHJ P,)	   ;HAVE THEY BEEN SMASHED?
	  JRST SETUP1		   ;  YES, DON'T BOTHER DOING IT AGAIN!
	JSP T,SPECBIND
	0,,.SPECIAL NOUUO	   ;MAKS SURE THAT THE SMASHING HAPPENS
	XCT SCALL1		   ;NO, SMASH THE BEGGARS
	XCT SCALL2
	XCT SCALL3
	XCT SCALL4
	XCT TCALL1
	XCT TCALL2
	XCT TCALL3
	XCT TCALL4
	PUSHJ P,UNBIND		   ;AND UNBIND NOUUO

SETUP1:	POP P,T			   ;AND RESTORE OUR INFO
	POP P,F
	POP P,B
	POP P,A
LOCKTOPOPJ			   ;LOCK OUT INTERRUPTS SO WE CAN WIN!
	MOVE T,.SPECIAL FUNCTION-TIMES-ARRAY
	PUSHJ P,FIND		   ;FIND IT IF IT'S ALREADY THERE
	  CAIA			   ;  NOT THERE, GET A FREE ONE
	    JRST FOUND		   ;    IT'S THERE, WIN!
	PUSHJ P,GETFRE		   ;GET A FREE ENTRY
FOUND:	MOVEM B,FSUBR(TT)	   ;STORE OUR POINTER
	SETZM FTIME(TT)		   ;NO TIME YET
	SETZM FETIME(TT)
	SETZM FCOUNT(TT)	   ;NO CALLS YET
	MOVE R,(B)		   ;GET THE INSTRUCTIONS WE'LL CLOBBER
	MOVEM R,FINST(TT)	   ;AND REMEMBER THEM
	MOVE R,1(B)
	MOVEM R,FINST0(TT)
	MOVEM F,(B)		   ;CLOBBER! WE ALREADY UNPURIFIED!
	MOVEM F,1(B)
	MOVEM F,FJSP(TT)	   ;AND REMEMBER OUR CLOBBERING TYPE
	MOVEM A,FSYMB(TT)	   ;SAVE OUR SYMBOL
	MOVEI A,.ATOM T		   ;T !!
	POPJ P,


;; (TIME-SUBR <SUBR> <SYMBOL>)
;; (TIME-LSUBR <SUBR> <SYMBOL>)
.ENTRY TIME-LSUBR SUBR 002
	SKIPA F,[JSP TT,LHANDL]	   ;USE LSUBR HANDLER
.ENTRY TIME-SUBR SUBR 002
	MOVE F,[JSP TT,FHANDL]	   ;HANDLER FOR SUBR'S AND FSUBRS
	JSP T,SUBRP
	EXCH A,B		   ;GET SYMBOL IN A AND SUBR IN B
	JSP T,SYMBP		   ;MAKE SURE A IS A SYMBOL
	JRST TIMEFN		   ;GO TIME THE FUNCTION.

;;; TAKES A FUNCTION NAME AND STOPS TIMING IT
.ENTRY UNTIME-FUNCTION SUBR 002
LOCKTOPOPJ
        MOVE T,.SPECIAL FUNCTION-TIMES-ARRAY
	PUSHJ P,FIND
	  JRST [SETZ A, ? POPJ P,] ;NOT THERE, RETURN NIL
	MOVE T,FSUBR(TT)	   ;GET THE LOCATION OF THE ROUTINE
	MOVE R,FINST(TT)	   ;AND THE INSTRUCTIONS THAT GOES THERE
	MOVEM R,(T)		   ;AND RESTORE THEM TO NORMAL
	MOVE R,FINST0(TT)
	MOVEM R,1(T)
	SETZM FSUBR(TT)		   ;SO FFIND DOESN'T FIND THIS SLOT
	SETZM FSYMB(TT)		   ;SO FIND DOESN'T FIND THIS SLOT
	MOVEI A,.ATOM T
	POPJ P,

;;; INITIALIZES THE FUNCTION-TIMES-ARRAY TO ZERO TIMES AND LOCKS CLEARED.
.ENTRY INIT-TIMER SUBR 001
LOCKTOPOPJ
	MOVE T,.SPECIAL FUNCTION-TIMES-ARRAY
	PUSHJ P, GETPTR		   ;GET A POINTER TO THE ARRAY
FIN0:	SKIPN R,FSUBR(TT)	   ;IS THERE A ROUTINE HERE?
	  JRST FIN1		   ;  NO, JUST GO ON TO THE NEXT ONE
	SETZM FTIME(TT)		   ;CLEAR OUT DATA
	SETZM FETIME(TT)
	SETZM FCOUNT(TT)
	MOVE T,FJSP(TT)		   ;GET CLOBBERING INSTRUCTION
	MOVEM T,(R)		   ;CLOBBER THE INSTRUCTION IN CASE OF ^G
	MOVEM T,1(R)
FIN1:	ADD TT,D
	JUMPL TT,FIN0
	MOVEI A,.ATOM T
	POPJ P,

;;; MAKES SURE THAT ALL PROBES ARE IN.
.ENTRY SET-TIMER SUBR 001
LOCKTOPOPJ
	MOVE T,.SPECIAL FUNCTION-TIMES-ARRAY
	PUSHJ P, GETPTR		   ;GET A POINTER TO THE ARRAY
SIN0:	SKIPN R,FSUBR(TT)	   ;IS THERE A ROUTINE HERE?
	  JRST SIN1		   ;  NO, JUST GO ON TO THE NEXT ONE
	MOVE T,FJSP(TT)		   ;GET CLOBBERING INSTRUCTION
	MOVEM T,(R)		   ;CLOBBER THE INSTRUCTION IN CASE OF ^G
	MOVEM T,1(R)
SIN1:	ADD TT,D
	JUMPL TT,SIN0
	MOVEI A,.ATOM T
	POPJ P,

;;; MAKES SURE THAT ALL PROBES ARE IN.
.ENTRY UNTIME SUBR 001
LOCKTOPOPJ
	MOVE T,.SPECIAL FUNCTION-TIMES-ARRAY
	PUSHJ P, GETPTR		   ;GET A POINTER TO THE ARRAY
	SETZ A,			   ;CONS UP OUR RETURN LIST HERE.
UN0:	SKIPN R,FSUBR(TT)	   ;IS THERE A ROUTINE HERE?
	  JRST UN1		   ;  NO, JUST GO ON TO THE NEXT ONE
	MOVE T,FINST(TT)	   ;GET ORIGINAL INSTRUCTION
	MOVEM T,(R)		   ;AND RESTORE IT
	MOVE T,FINST0(TT)
	MOVEM T,1(R)
	SETZB B,FSUBR(TT)	   ;CLEAR OUT THE RELEVANT FIELDS
	EXCH B,FSYMB(TT)	   ;AND RECOVER THE SYMBOL
	EXCH A,B		   ;TO CONS ONTO OUR RETURN VALUE
	JSP T,%CONS
UN1:	ADD TT,D
	JUMPL TT,UN0
	POPJ P,

;;; RETURNS A ALIST OF TIMES
.ENTRY GET-ALL-TIMES SUBR 001
LOCKTOPOPJ
	MOVE T,.SPECIAL FUNCTION-TIMES-ARRAY
	PUSHJ P,GETPTR		   ;GET POINTER TO THE ARRAY
	SETZ AR1,		   ;GETS ALIST
	MOVE F,TT		   ;F GETS POINTER TO ARRAY
AFUN0:	SKIPN FSYMB(F)		   ;IS THERE A FUNCTION HERE?
	  JRST AFUN1		   ;  NO, JUST GRAB NEXT
	PUSHJ P,FUNCON		   ;CONS UP DATA ON FUNCTION
	MOVEI B,(A)
	MOVE A,FSYMB(F)		   ;CONS ON THE SYMBOL TO THE DATA
	JSP T,%CONS
	MOVE B,AR1		   ;AND CONS THAT ONTO THE ALIST
	JSP T,%CONS
	MOVE AR1,A
AFUN1:	ADD F,D			   ;NEXT ENTRY
	JUMPL F,AFUN0
	MOVE A,AR1		   ;RETURN OUR ALIST
	POPJ P,

;;; TAKES IN F THE POINTER TO THE ENTRY IN THE TABLE, RETURNS IN A A
;;; DESCRIPTION.
FUNCON: MOVE TT,FETIME(F)	   ;GET REAL TIME AS FLONUM
	JSP T,FLCONS		   ;AND CONS IT UP
	JSP T,%NCONS		   ;NCONS IT
	MOVEI B,(A)
	MOVE TT,FTIME(F)	   ;THE RUN TIME IN uS.
	JSP T,FXCONS
	JSP T,%CONS
	MOVEI B,(A)
	MOVE TT,FCOUNT(F)	   ;GRAB THE COUNT
	JSP T,FXCONS
	JSP T,%CONS
	POPJ P,


;;; This returns the time so far for a given function.

.ENTRY GET-TIME SUBR 002
        MOVE T,.SPECIAL FUNCTION-TIMES-ARRAY 
	PUSHJ P,FIND		   ;FIND THE ENTRY
	  JRST [SETZ A, ? POPJ P,] ;  NOT THERE!
	MOVEI F,(TT)		   ;F GETS POINTER TO THE ENTRY
	JRST FUNCON		   ;CONS UP THE INFO ON THE FUNCTION AND RETURN


;;; GETFRE FINDS A FREE ENTRY IN THE TABLE, SKIPING IF SUCCESSFUL.

GETFRE:	MOVE T,.SPECIAL FUNCTION-TIMES-ARRAY
	PUSHJ P,GETPTR		   ;GET AOBJN PTR TO ARRAY DATA
GETFR0:	SKIPN T,FSYMB(TT)	   ;IS THIS ONE FREE?
	  POPJ P,		   ;  YES, USE IT!
	ADD TT,D		   ;NEXT ENTRY
	JUMPL TT,GETFR0
	
	PUSH P,A		   ;DON'T LET THE *REARRAY CLOBBER AC'S!
	PUSH P,B		   ;A HAS ATOM, B HAS SUBR, AND F HAS HANDLER
	PUSH FXP,F

	STRT 0,[SIXBIT/^M;GROWING ARRAY -- TIME-FUNCTION^M!/
]
				   ;FAILED, GET BIGGER ARRAY
	PUSH P,[GETFR1]		   ;RETURN TO GETFRE AFTER *REARRAYING
	PUSH P,.SPECIAL FUNCTION-TIMES-ARRAY
	PUSH P,[.ATOM FIXNUM ]
	MOVE TT,@-1(P)		   ;GET THE ASAR
	MOVE T,3(TT)		   ;GET THE FIRST DIMENSION
	ADDI T,10.		   ;AND GROW IT SOME
	PUSH FXP,T		   ;AND MAKE IT INTO A FIXNUM
	PUSH P,FXP
	PUSH FXP,4(TT)		   ;GET THE SECOND DIMENTION
	PUSH P,FXP
	MOVNI T,4		   ;3 ARGUMENTS
	JCALL 16,.FUNCTION *REARRAY
GETFR1:	SUB FXP,[2,,2]
	POP FXP,F
	POP P,B
	POP P,A
	JRST GETFRE


;;; FIND GIVEN SYMBOL
FIND:	PUSHJ P,GETPTR		   ;GET AOBJN PTR TO ARRAY DATA
FIND0:	CAMN A,FSYMB(TT)
	  JRST POPJ1		   ;  FOUND IT, SKIP!
	ADD TT,D
	JUMPL TT,FIND0		   ;NOT FOUND YET?
	POPJ P,			   ;FAILED, DON'T SKIP

;;; FIND GIVEN SUBR POINTER

FFIND:	PUSHJ P,GETPTR		   ;GET AOBJN PTR TO ARRAY DATA
	MOVEI R,-1(C)		   ;R IS PREVIOUS LOCATION, IN CASE OF
				   ;NCALL FOO ENTERING AN FOO+1
FFIND0:	CAMN C,FSUBR(TT)
	  JRST POPJ1		   ;  FOUND IT, SKIP!
	CAMN R,FSUBR(TT)
	  JRST POPJ1
	ADD TT,D
	JUMPL TT,FFIND0		   ;NOT FOUND YET?
	POPJ P,			   ;FAILED, DON'T SKIP

;;; GETS CALLED WITH ADDRESS OF ROUTINE TO CALL IN FREEAC, CLOBBERS ITS
;;; FIRST INSTRUCTION BACK AGAIN FROM ITS ENTRY IN FUNCTION-TIMES-ARRAY
;;; AND CALLS IT, AND RE-CLOBBERS TO JSP TT,FHANDL ON RETURN.
;;; IT COUNTS THE CALLS, AND THE TIME SPENT IN THE FUNCTION.

FHANDL:
LOCKI
	MOVE T,.SPECIAL FUNCTION-TIMES-ARRAY
	PUSH P,C
	MOVEI C,(TT)-1		   ;C GETS SUBR POINTER TO LOOK UP
	PUSHJ P,FFIND		   ;FIND THE SLOT WITH THIS SUBR POINTER
	  .LOSE			   ;  HUH?  WE'RE WEDGED!

	MOVE R,FINST(TT)	   ;GET THE OLD INSTRUCTIONS
	MOVEM R,(C)		   ;AND RESTORE THEM TO RIGHTFUL HOME
	MOVE R,FINST0(TT)
	MOVEM R,1(C)

	HRRZ T,TTSAR(T)		   ;CONVERT TT TO ARRAY OFFSET
	SUB TT,T
	HRRZ TT,TT
	PUSH FLP,TT		   ;SAVE THE ARRAY INDEX
	
UNLOCKI	

TCALL1:	NCALL 0,.FUNCTION TIME	   ;AND GET REAL TIME
	PUSH FLP,TT

SCALL1:	NCALL 0,.FUNCTION RUNTIME  ;GET RUNTIME
	PUSH FLP,TT		   ;SAVE IT FOR LATER
	

	MOVEI TT,(C)		   ;GET ENTRY PC IN TT AGAIN
	POP P,C			   ;AND RESTORE THE STACK

	PUSHJ P,(TT)		   ;CALL OUR RESTORED FUNCTION


SCALL2:	NCALL 0,.FUNCTION RUNTIME  ;GET OUR RUN TIME
	POP FLP,R		   ;GET THE OLD TIME
	SUB TT,R		   ;FIND DIFFERENCE
	PUSH FXP,TT		   ;SAVE IT ACROSS THE CALL TO TIME

TCALL2:	NCALL 0,.FUNCTION TIME	   ;GET OUR RUN TIME
	POP FXP,R		   ;RECOVER OUR OLD DIFFERENCE RUNTIM
	POP FLP,F		   ;GET THE OLD TIME
	FSBR TT,F		   ;FIND DIFFERENCE
	MOVE F,TT		   ;AND PUT IN A LESS TEMPORARY AC
LOCKI
	MOVE T,.SPECIAL FUNCTION-TIMES-ARRAY
	PUSHJ P,GETPTR		   ;GET POINTER TO ARRAY DATA
	ADD TT,(FLP)		   ;AND POINT TO ENTRY

	ADDM R,FTIME(TT)	   ;ADD THE TIME TO THE TOTAL
	FSBRM F,FETIME(TT)	   ;AND THE RUN TIME

	AOS FCOUNT(TT)		   ;COUNT THIS CALL

	MOVE T,FJSP(TT)		   ;GET INSTRUCTION TO CLOBBER WITH
	MOVE R,FSUBR(TT)	   ;AND WHERE IT GOES
	MOVEM T,(R)		   ;CLOBBER!
	MOVEM T,1(R)

	POP FLP,TT		   ;ALIGN THE PDL

UNLOCKI

	POPJ P,

;;; LSUBR HANDLER.  LIKE FHANDL, BUT PUSHES CALLED ROUTINE'S RETURN ADDRESS 
;;; ON FXP, AND CLOBBERS IT TO POINT TO THE LHANDL CONTINUATION.

LHANDL:
LOCKI
	PUSH P,T		   ;SAVE OUR ARGUMENT
	MOVEI C,(TT)-1		   ;C GETS SUBR POINTER TO LOOK UP

	MOVEI TT,(P)-1		   ;CALCULATE ADDRESS OF RETURN ADDRESS
	ADD TT,(P)
	MOVE T,(TT)		   ;T GETS RETURN ADDRESS
	PUSH FLP,T		   ;SAVE THE REAL RETURN ADDRESS
	MOVEI T,LHNDLC		   ;AND CLOBBER TO BE OUR CONTINUATION
	MOVEM T,(TT)

	MOVE T,.SPECIAL FUNCTION-TIMES-ARRAY
	PUSHJ P,FFIND		   ;FIND THE SLOT WITH THIS SUBR POINTER
	  .LOSE			   ;  HUH?  WE'RE WEDGED!

	MOVE R,FINST(TT)	   ;GET THE OLD INSTRUCTIONS
	MOVEM R,(C)		   ;AND RESTORE THEM TO RIGHTFUL HOME
	MOVE R,FINST0(TT)
	MOVEM R,1(C)

	HRRZ T,TTSAR(T)		   ;CONVERT TT TO ARRAY OFFSET
	SUB TT,T
	HRRZ TT,TT
	PUSH FLP,TT		   ;SAVE THE ARRAY INDEX

UNLOCKI	
	PUSH P,C
TCALL3:	NCALL 0,.FUNCTION TIME	   ;GET REAL TIME SO FAR
	PUSH FLP,TT		   ;SAVE IT FOR LATER

SCALL3:	NCALL 0,.FUNCTION RUNTIME  ;GET RUN TIME SO FAR
	PUSH FLP,TT		   ;SAVE IT FOR LATER

	POP P,C
	POP P,T
	JRST (C)		   ;CALL OUR RESTORED FUNCTION

;;; THE FOLLOWING IS REACHED BY CLOBBER OF THE ROUTINE'S RETURN ADDRESS
LHNDLC:
SCALL4:	NCALL 0,.FUNCTION RUNTIME  ;GET OUR RUN TIME
	POP FLP,R		   ;GET THE OLD TIME
	SUB TT,R		   ;FIND DIFFERENCE
	PUSH FXP,TT		   ;SAVE THE DIFFERENCE ACROSS THE CALL TO TIME

TCALL4:	NCALL 0,.FUNCTION TIME	   ;GET OUR REAL TIME
	POP FXP,R		   ;RECOVER THE OLD RUNTIME DIFFERENCE
	POP FLP,F		   ;GET THE OLD TIME
	FSBR TT,F		   ;FIND DIFFERENCE
	MOVE F,TT		   ;AND MOVE TO A LESS TEMPORARY AC
	

	MOVE T,.SPECIAL FUNCTION-TIMES-ARRAY
LOCKI
	PUSHJ P,GETPTR		   ;GET POINTER TO ARRAY DATA
	ADD TT,(FLP)		   ;AND POINT TO ENTRY

	ADDM R,FTIME(TT)	   ;ADD THE TIME TO THE TOTAL
	FADRM F,FETIME(TT)	   ;AND THE REAL TIME.

	AOS FCOUNT(TT)		   ;COUNT THIS CALL

	MOVE T,FJSP(TT)		   ;GET INSTRUCTION TO CLOBBER WITH
	MOVE R,FSUBR(TT)	   ;AND WHERE IT GOES
	MOVEM T,(R)		   ;RE-CLOBBER!
	MOVEM T,1(R)
UNLOCKI
	POP FLP,T		   ;FLUSH THE ARRAY LOCATION FROM THE STACK
	POPJ FLP,		   ;AND RETURN FROM ADDRESS WE SAVED ON FLP


;;; GET AOBJN PTR TO STUFF IN ARRAY!
GETPTR:	MOVEI TT,(T)
	LSH TT,-SEGLOG		   ;CHECK WHICH SEGMENT IT'S IN
	HRRZ TT,ST(TT)		   ;INDEX THE SEGMENT TABLE
	CAIE TT,.ATOM ARRAY	   ;ARRAY?
	  JRST BADONE
	HLRZ TT,ASAR(T)		   ;CHECK THE ARRAY TYPE
	TRNN TT,AS.FX		   ;IS IT AN FIXNUM ARRAY?
	  JRST BADONE
	MOVEI TT,@ASAR(T)
	HRRZ D,4(TT)		   ;SECOND DIMENSION
	CAIGE D,ENTSIZ		   ;IS THE SECOND DIMENSION BIG ENOUGH?
	  JRST BADONE		   ;  NO, COMPLAIN
	HRLI D,1		   ;D IS NOW THING TO ADD TO AOBJN PTR TO
				   ;ARRAY DATA AREA
	MOVN TT,3(TT)		   ;Get the size
	HRLZ TT,TT		   ;make into AOBJN ptr
	HRR TT,TTSAR(T)		   ;to the actual data area
	POPJ P,

POPJ1:	AOS (P)
	POPJ P,

BADONE:
UNLOCKI
	MOVE A,.SPECIAL FUNCTION-TIMES-ARRAY
FAC [BAD VALUE FOR FUNCTION-TIMES-ARRAY, NOT 2D FIXNUM WITH SECOND DIM > 7!]
	  .LOSE

;; GET THE FUNCTIONAL PROPERTY

FGET:	HRRZ T,(A)		   ;GET PLIST
FGET0:	HLRZ B,(T)		   ;GET INDICATOR
	CAIN B,.ATOM SUBR	   ;IS IT A SUBR?
	  JRST FGET9		   ;  YES, WIN!
	CAIN B,.ATOM LSUBR	   ;IS IT AN LSUBR?
	  JRST FGET9L		   ;  YES, WIN, BUT GOTTA HACK DIFFERENTY
	CAIN B,.ATOM FSUBR	   ;IS IT AN FSUBR?
	  JRST FGET9		   ;  YES, WIN!
	HRRZ T,(T)		   ;CDR DOWN PAST VALUE CONS
	HRRZ T,(T)		   ;TO NEXT INDICATOR CONS
	JUMPN T,FGET0		   ;IF WE HAVEN'T REACHED THE END, TRY AGAIN

	%WTA NCF		   ;NOT COMPILED FUNCTION
	JRST FGET

FGET9:	AOS (P)			   ;SKIP RETURN -- NON-LSUBR
FGET9L:	HRRZ T,(T)		   ;CDR PAST INDICATOR CONS
	HLRZ B,(T)		   ;RETURN THE VALUE
	POPJ P,


;;; UNPURIFY THE LOCATION IN B

UNPUR:	PUSH FXP,B		   ;(PURIFY <B> <B> NIL)
	AOS B
	PUSH FXP,B
	MOVEI A,-1(FXP)
	MOVEI B,(FXP)
	SETZ C,
	CALL 3,.FUNCTION PURIFY
	POP FXP,B
	POP FXP,B
	POPJ P,

;;; ERROR IF NOT SYMBOL
SYMBP:	MOVEI TT,(A)		   ;CHECK IF A IS SUBR
	LSH TT,-SEGLOG		   ;POINT TO SEGMENT
	HRRZ TT,ST(TT)		   ;LOOK IT UP IN SEGMENT TABLE
	CAIE TT,.ATOM SYMBOL	   ;SYMBOL?
          %WTA NCF		   ;  NOT COMPILED FUNCTION
	JRST (T)

;;; ERROR IF NOT A SUBR
SUBRP:	MOVEI TT,(A)		   ;CHECK IF A IS SUBR
	LSH TT,-SEGLOG		   ;POINT TO SEGMENT
	HRRZ TT,ST(TT)		   ;LOOK IT UP IN SEGMENT TABLE
	CAIE TT,.ATOM RANDOM	   ;SUBR?
          WTA [NOT SUBR OBJECT!]

	JRST (T)

NCF:	SIXBIT /NOT COMPILED FUNCTION NAME -- TIME-FUNCTION!/

CONSTANTS

.SXEVAL (ARRAY FUNCTION-TIMES-ARRAY FIXNUM #10 #8 )

.SXEVAL (SETQ FUNCTION-TIMES-ARRAY (GET (QUOTE FUNCTION-TIMES-ARRAY) (QUOTE ARRAY)))

FASEND