127 lines
4.0 KiB
Plaintext
127 lines
4.0 KiB
Plaintext
;; Function To Be Tested: TIME (Programmer's Assistant Command)
|
|
;;
|
|
;; Source: Xerox Common Lisp Implementation Notes (Lyric Beta Release)
|
|
;; CLtL, Section 20.2
|
|
;; Section: The EXEC
|
|
;; Page: 29
|
|
;;
|
|
;; Created By: John Park
|
|
;;
|
|
;; Creation Date: Feb 23, 1987
|
|
;;
|
|
;; Last Update: March 24, 1987
|
|
;;
|
|
;; Filed As: {ERIS}<lispcore>exec>time.u
|
|
;;
|
|
;;
|
|
;; Syntax: TIME FORM &key REPEAT &environment ENV
|
|
;;
|
|
;; Function Description: Time the evaluation of FORM in the lexical environment
|
|
;; ENV, repeating REPEAT number of times. Information is displayed in the exec
|
|
;; window.
|
|
;;
|
|
;; Argument(s): FORM
|
|
;; REPEAT (number)
|
|
;; ENV (environment)
|
|
;;
|
|
;; Returns: See function description
|
|
;;
|
|
;; Constraints/Limitations: Due to the nature of Programmer's Assistant commands,
|
|
;; testing them will not be totally automatic. Comments are incorporated within
|
|
;; each command file, which will be run by using the function bksysbuf.
|
|
;; Each test setup is titled "COMMAND-TEST-SETUP", which executes the command
|
|
;; string. The do-test form within the command file will return T or "test
|
|
;; failed" This test file requires TEDIT package.
|
|
;;
|
|
;; Messages will be printed before each command in the command files is executed
|
|
;; for user monitoring. This test will determine whether the correct results for
|
|
;; TIME are returned "elapsed time","net compute time, etc". Test result is
|
|
;; logged on {eris}<lispcore>test>exec>test.report.
|
|
|
|
(DO-TEST "TIME-TEST-SETUP"
|
|
(PROGN
|
|
(SETQ MESS0 "Printing time statistics for compilation of the function palindromep...")
|
|
(SETQ MESS1 "Various time statics have been saved in {core}testfor analysis...")
|
|
(SETQ MESS2 "Do-test will determine if various statics have been printed.....")
|
|
(IF (FBOUNDP 'PALINDROMEP) (FMAKUNBOUND 'PALINDROMEP))
|
|
;; palindrome reads the same forwards and backwards
|
|
(setf (symbol-function 'palindromep)
|
|
'(lambda (string &optional
|
|
(start 0)
|
|
(end (length string)))
|
|
(dotimes (k (floor (- end start) 2) t)
|
|
(unless (char-equal (char string (+ start k))
|
|
(char string (- end k 1)))
|
|
(return nil)))))
|
|
(SETQ {CORE}TEST "{CORE}TIME") ; this is where the results are stored
|
|
(SETQ TIME-CATEGORIES
|
|
'("Elapsed time " "SWAP time " "reclaim time "
|
|
"net compute time"))
|
|
(SETQ TEST-RESULT "{ERIS}<LISPCORE>TEST>EXECUTIVE>TEST.REPORT")
|
|
(DEFUN T-FORMAT (STATUS)
|
|
(FORMAT *OUTPUT* "~%COMMAND: TIME~%STATUS: ~A DATE: ~A TESTER: ~A~%" STATUS (IL:DATE) IL:USERNAME))
|
|
|
|
(SETQ TIME-COMMAND-STRING
|
|
"(FORMAT NIL MESS0)
|
|
(DRIBBLE '{CORE}TIME)
|
|
TIME (COMPILE 'PALINDROMEP)
|
|
(DRIBBLE)
|
|
(FORMAT NIL MESS1)
|
|
(FORMAT NIL MESS2)
|
|
(FMAKUNBOUND 'PALINDROMEP)
|
|
(DO-TEST 'TIME-TEST-RESULT
|
|
(PROGN (SETQ TIME-PRINTOUT-FLG NIL TIME-UNIT-FLG NIL)
|
|
(SETQ *TIME-STREAM* (OPEN {CORE}TEST :DIRECTION :INPUT))
|
|
(DEFUN MOVE-PTR (NO) (DO ((CNT 1 (1+ CNT)))
|
|
((= CNT (1+ NO)) T)
|
|
(READ *TIME-STREAM*)))
|
|
(MOVE-PTR 4)
|
|
(READ-LINE *TIME-STREAM*)
|
|
;; Checking for various time statistics
|
|
(DOLIST (Y TIME-CATEGORIES)
|
|
(IF (STRING-EQUAL Y (READ-LINE *TIME-STREAM*):END2 16)
|
|
(PUSH T TIME-PRINTOUT-FLG)
|
|
(PUSH NIL TIME-PRINTOUT-FLG)
|
|
)
|
|
)
|
|
(CLOSE *TIME-STREAM*)
|
|
(SETQ *TIME-STREAM* (OPEN {CORE}TEST :DIRECTION :INPUT))
|
|
(MOVE-PTR 8)
|
|
;; Checking to see if time is indicated in floating-point number
|
|
|
|
(DO ((CNT 1 (1+ CNT)))
|
|
((= CNT 4) T)
|
|
(IF (FLOATP (PROG1 (READ *TIME-STREAM*)(MOVE-PTR 4)))
|
|
(PUSH T TIME-UNIT-FLG)
|
|
(PUSH NIL TIME-UNIT-FLG)
|
|
)
|
|
)
|
|
(READ *TIME-STREAM*)
|
|
(IF (FLOATP (READ *TIME-STREAM*)(MOVE-PTR 4))
|
|
(PUSH T TIME-UNIT-FLG)
|
|
(PUSH NIL TIME-UNIT-FLG)
|
|
)
|
|
(CLOSE *TIME-STREAM*)
|
|
(MAPCAR #'DELETE-FILE (IL:DIRECTORY '{CORE}))
|
|
(LET ((*OUTPUT* (OPEN TEST-RESULT :DIRECTION :OUTPUT
|
|
:IF-EXISTS :APPEND)))
|
|
(PROGN
|
|
(IF(AND (NOTANY #'NULL TIME-PRINTOUT-FLG)
|
|
(NOTANY #'NULL TIME-UNIT-FLG))
|
|
(T-FORMAT 'SUCCESS)
|
|
(T-FORMAT 'FAILED))
|
|
(CLOSE *OUTPUT*)))
|
|
)
|
|
)
|
|
|
|
")
|
|
(IL:BKSYSBUF TIME-COMMAND-STRING)
|
|
)
|
|
)
|
|
|
|
STOP
|
|
|
|
|
|
|
|
|