github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-05-24 14:20:34 +00:00
Code Issues Releases Wiki Activity
Files
94802880ea78e7ff2c9ad13f96c5e49e6c926ed7
PDP-10.its/src/z/timer.99
Eric Swenson 7516530c3d Added several more LSPLIB packages. 
Resolves #713.
2018-03-25 10:47:49 +02:00

521 lines
15 KiB
Plaintext
Raw Blame History

; -*- 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
Reference in New Issue View Git Blame Copy Permalink