Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
(FILECREATED "10-OCT-78 15:56:04" <LISPUSERS>TIME.;10 6949
changes to: TIMEPRINT1
previous date: "28-SEP-78 02:09:54" <LISPUSERS>TIME.;9)
(PRETTYCOMPRINT TIMECOMS)
(RPAQQ TIMECOMS ((DECLARE: FIRST (ADDVARS (NOSWAPFNS INSTRS)))
(P (MOVD (QUOTE USERLISPXPRINT)
(QUOTE LISPXTIMEPRINT)))
(LOCALVARS . T)
(FNS PDP10INSTR INSTRS TIME TIMEPRINT TIMEPRINT1)
(BLOCKS (TIMEPRINT TIMEPRINT TIMEPRINT1 (LOCALFREEVARS PAIRS CNT)
(GLOBALVARS BRKDWNTYPES)
(NOLINKFNS EVAL))
(NIL PDP10INSTR TIME INSTRS (LOCALVARS . T)))
(DECLARE: EVAL@COMPILE (PROP OPD RICTR)
(PROP MACRO PDP10INSTR DOTIMING)
(ALISTS (BRKDWNTYPES INSTRS GCTIME REALTIME TIME CONSES PAGEFAULTS BOXES
FBOXES)))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML TIME)
(LAMA)))
(PROP ARGNAMES DOTIMING)))
(DECLARE: FIRST
(ADDTOVAR NOSWAPFNS INSTRS)
)
(MOVD (QUOTE USERLISPXPRINT)
(QUOTE LISPXTIMEPRINT))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DEFINEQ
(PDP10INSTR
(LAMBDA NIL
(COND
((EQ (EVALV (QUOTE BYTELISPFLG))
T)
(LOC (ASSEMBLE NIL
(RICTR 1 , 7))))
(T 0))))
(INSTRS
(LAMBDA (FORM CNT) (* lmm "28-SEP-78 02:02")
(PROG (PAIRS VAL)
(LISPXTIMEPRINT (DOTIMING (SETQ VAL (EVAL FORM))
(OR CNT (SETQ CNT 1))
(CONSES PAGEFAULTS GCTIME FBOXES BOXES REALTIME TIME INSTRS))
T
(CONS CNT (LOADAV)))
(RETURN VAL))))
(TIME
(NLAMBDA (FORM CNT)
(INSTRS FORM CNT)))
(TIMEPRINT
(LAMBDA (PAIRS FILE FLG) (* lmm "28-SEP-78 02:04")
(PROG ((SPEED (QUOTE (INSTRS TIME REALTIME GCTIME LOADAV)))
(PFLG "Speed: ")
(SPACE (QUOTE (CONSES BOXES FBOXES PAGEFAULTS)))
(AFLG "Space: ")
(CNT (CAR FLG))
(LA (CDR FLG)))
LP (COND
((EQ SPEED T)
(COND
((NULL SPACE)
(TERPRI T)
(RETURN))))
((NULL SPEED)
(PRINTOUT T 0 "load av=" .F9.3 LA ,)
(SETQ SPEED T))
((TIMEPRINT1 (CAR SPEED)
1 PFLG)
(SETQ PFLG)
(pop SPEED))
(T (pop SPEED)
(GO LP)))
ALP (COND
((LISTP SPACE)
(COND
((TIMEPRINT1 (CAR SPACE)
37 AFLG)
(SETQ AFLG))
(T (pop SPACE)
(GO ALP)))
(pop SPACE)))
(GO LP))))
(TIMEPRINT1
(LAMBDA (NAME TAB ISTR) (* lmm "10-OCT-78 15:55")
(PROG ((VAL (for X in PAIRS when (EQ (CDR X)
NAME)
do (RETURN (CAR X))))
(FN (FASSOC NAME BRKDWNTYPES))
STR)
(COND
(FN (SETQ STR (CADDDR FN))
(SETQ FN (CADDR FN))))
(OR VAL (RETURN))
(COND
(FN (SETQ VAL (APPLY* FN VAL))))
(OR (IEQP CNT 1)
(SETQ VAL (COND
((AND (FIXP VAL)
(ZEROP (IREMAINDER VAL CNT)))
(IQUOTIENT VAL CNT))
(T (FQUOTIENT VAL CNT)))))
(COND
((EQP VAL 0)
(RETURN)))
(TAB TAB NIL T)
(COND
(ISTR (PRIN1 ISTR T))
(T (SPACES 7 T)))
(COND
((FLOATP VAL)
(COND
((FLESSP VAL .01)
(PRINTOUT T .F9.6 VAL))
(T (PRINTOUT T .F9.3 VAL))))
(T (PRINTOUT T .I9 VAL)))
(SPACES 1 T)
(PRIN1 (OR STR NAME)
T)
(RETURN T))))
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: TIMEPRINT TIMEPRINT TIMEPRINT1 (LOCALFREEVARS PAIRS CNT)
(GLOBALVARS BRKDWNTYPES)
(NOLINKFNS EVAL))
(BLOCK: NIL PDP10INSTR TIME INSTRS (LOCALVARS . T))
]
(DECLARE: EVAL@COMPILE
(PUTPROPS RICTR OPD 261120)
(PUTPROPS PDP10INSTR MACRO (X (COND
(BYTELISPFLG (QUOTE (LOC (ASSEMBLE NIL
(RICTR 1 , 7)
(SUB 1 , GCINST)))))
(T 0))))
(PUTPROPS DOTIMING MACRO (X
(PROG ((TYPELST (CADDR X))
FN NN I)
(SETQ I (IDIFFERENCE -1 (SETQ NN (LENGTH TYPELST))))
(RETURN (NCONC (LIST (QUOTE ASSEMBLE)
NIL
(LIST (QUOTE CQ)
(LIST (QUOTE VAG)
(LIST (QUOTE FIX)
(CADR X))))
(CONS (QUOTE PUSHNN)
(CONS (QUOTE (1))
(MAPCAR TYPELST (FUNCTION (LAMBDA (TYPE)
(QUOTE (1))))))))
(MAPCONC TYPELST
(FUNCTION (LAMBDA (TYPE)
(LIST (LIST (QUOTE CQ)
(LIST (QUOTE VAG)
(LIST (QUOTE FIX)
(CADR (ASSOC TYPE BRKDWNTYPES)))
))
(LIST (QUOTE NREF)
(LIST (QUOTE MOVEM)
1
(QUOTE ,)
(SETQ I (ADD1 I))))))))
(APPEND (QUOTE ((NREF (MOVE 1 , 0))
(JUMPLE 1 , DONE)
LP))
(LIST (LIST (QUOTE CQ)
(CAR X)))
(QUOTE ((NREF (SOSLE 0))
(JRST LP)
DONE))
NIL)
(MAPCONC (SETQ TYPELST (REVERSE TYPELST))
(FUNCTION (LAMBDA (TYPE)
(LIST (LIST (QUOTE CQ)
(LIST (QUOTE VAG)
(LIST (QUOTE FIX)
(CADR (ASSOC TYPE BRKDWNTYPES)))
))
(LIST (QUOTE NREF)
(LIST (QUOTE SUBM)
1
(QUOTE ,)
(PROG1 I (SETQ I (SUB1 I)))))))))
(LIST (LIST (QUOTE CQ)
(KWOTE (MAPCAR TYPELST (FUNCTION (LAMBDA (TYPE)
(CONS (IPLUS 1000000)
TYPE))))))
(QUOTE (MOVEI 2 , 0 (1))))
(PROGN (SETQ I 0)
(MAPCONC TYPELST (FUNCTION (LAMBDA (TYPE)
(LIST (LIST (QUOTE NREF)
(LIST (QUOTE MOVE)
3
(QUOTE ,)
(SETQ I (SUB1 I))))
(QUOTE (HRRZ 4 , 0 (2)))
(QUOTE (HRRZ 4 , 0 (4)))
(QUOTE (MOVEM 3 , 0 (4)))
(QUOTE (HLRZ 2 , 0 (2))))))))
(LIST (LIST (QUOTE POPNN)
(ADD1 NN))))))))
(ADDTOVAR BRKDWNTYPES (INSTRS (PDP10INSTR)
(LAMBDA (X)
(FQUOTIENT X 1000))
"K PDP10 instrs")
(GCTIME (LOC (ASSEMBLE NIL (MOVE 1 , GCTIM)))
(LAMBDA (X)
(FQUOTIENT X 1000))
"gc time")
(REALTIME (LOC (ASSEMBLE NIL (JSYS 14Q)))
(LAMBDA (X)
(FQUOTIENT X 1000))
"real seconds")
(TIME (CPUTIME)
(LAMBDA (X)
(FQUOTIENT X 1000))
"CPU seconds")
(CONSES (CONSCOUNT)
NIL "conses")
(PAGEFAULTS (PAGEFAULTS)
NIL "page faults")
(BOXES (IBOXCOUNT)
NIL "large integers")
(FBOXES (FBOXCOUNT)
NIL "floating numbers"))
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML TIME)
(ADDTOVAR LAMA )
)
(PUTPROPS DOTIMING ARGNAMES (FORM REPEATCOUNT TIMETYPES))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1114 3564 (PDP10INSTR 1126 . 1279) (INSTRS 1283 . 1632) (TIME 1636 . 1697) (TIMEPRINT
1701 . 2553) (TIMEPRINT1 2557 . 3561)))))
STOP