Artifact 3ea6fad7215371cc26ae257de029e5861e86e7bc9b8c3a2df0e632965a007fc1:
- File
psl-1983/tests/psl-timer.sl
— part of check-in
[eb17ceb7f6]
at
2020-04-21 19:40:01
on branch master
— Add Reduce 3.0 to the historical section of the archive, and some more
files relating to version sof PSL from the early 1980s. Thanks are due to
Paul McJones and Nelson Beebe for these, as well as to all the original
authors.git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 5629) [annotate] [blame] [check-ins using] [more...]
% PSL-TIMER.SL Source of PSL "spectral" tests % Compile this file to produce psl-timer.b % then LAPIN the file "time-psl.sl" '( (sstatus translink t) (declare (localf tak gtak)) (def de (macro (x) (cons 'defun (cdr x)))) (def igreaterp (macro (x) (cons '> (cdr x)))) (def ilessp (macro (x) (cons '< (cdr x)))) (def iadd1 (macro (x) (cons '1+ (cdr x)))) (def isub1 (macro (x) (cons '1- (cdr x)))) (def itimes2 (macro (x) (cons '* (cdr x)))) (allocate 'fixnum 2000) (allocate 'list 500) (setq $gcprint t) (defun time () (* (car (ptime)) 17)) (defun reclaim () (gc)) ) (de TestSetup () (progn (setq TestList (PrepareTest 1000)) (setq TestList2 (PrepareTest 2000)) (MakeLongList) (setq EvalForm '(setq Foo (cadr '(1 2 3)))))) (de MakeLongList () (prog (I) (setq LongList '(a b c d e f g h i j k l m n o p q r s t u v w x y z)) (setq I 0) loop (cond ((igreaterp I 5) (return nil))) (setq LongList (append LongList LongList)) (setq I (iadd1 I)) (go loop))) (de PrepareTest (n) (prog (l i) (setq i -1 l nil) top (cond ((ilessp n i) (return l))) (setq i (iadd1 i) l (cons nil l)) (go top))) (de Cdr1Test (N) (prog (I L) (setq I -1) loop (setq I (iadd1 I)) (setq L LongList) (cond ((igreaterp I N) (return nil))) loop1 (cond ((atom (setq L (cdr L))) (go loop))) (go loop1))) (de Cdr2Test (N) (prog (I L) (setq I -1) loop (setq I (iadd1 I)) (setq L LongList) (cond ((igreaterp I N) (return nil))) loop1 (cond ((null (setq L (cdr L))) (go loop))) (go loop1))) (de CddrTest (N) (prog (I L) (setq I -1) loop (setq I (iadd1 I)) (setq L LongList) (cond ((igreaterp I N) (return nil))) loop1 (cond ((null (setq L (cddr L))) (go loop))) (go loop1))) (de ListOnlyCdrTest1 () (prog (l1 l2) (setq l1 TestList) top (setq l2 TestList) again (cond ((null (setq l2 (cdr l2))) (cond ((null (setq l1 (cdr l1))) (return nil)) (t (go top)))) (t (go again))))) (de ListOnlyCddrTest1 () (prog (l1 l2) (setq l1 TestList2) top (setq l2 TestList2) again (cond ((null (setq l2 (cddr l2))) (cond ((null (setq l1 (cddr l1))) (return nil)) (t (go top)))) (t (go again))))) (de ListOnlyCdrTest2 () (prog (l1 l2) (setq l1 TestList) top (setq l2 TestList) again (cond ((atom (setq l2 (cdr l2))) (cond ((atom (setq l1 (cdr l1))) (return nil)) (t (go top)))) (t (go again))))) (de ListOnlyCddrTest2 () (prog (l1 l2) (setq l1 TestList2) top (setq l2 TestList2) again (cond ((atom (setq l2 (cddr l2))) (cond ((atom (setq l1 (cddr l1))) (return nil)) (t (go top)))) (t (go again))))) (de EmptyTest (N) (prog (I) (setq I 0) loop (cond ((igreaterp I N) (return nil))) (setq I (iadd1 I)) (go loop))) (de SlowEmptyTest (N) (prog (I) (setq I 0) loop (cond ((greaterp I N) (return nil))) (setq I (add1 I)) (go loop))) (de ReverseTest (N) (prog (I) (setq I 0) loop (cond ((igreaterp I N) (return nil))) (reverse LongList) (setq I (iadd1 I)) (go loop))) (de MyReverse1Test (N) (prog (I) (setq I 0) loop (cond ((igreaterp I N) (return nil))) (myreverse1 LongList) (setq I (iadd1 I)) (go loop))) (de myreverse1 (L) (prog (M) loop (cond ((atom L) (return M))) (setq M (cons (car L) M)) (setq L (cdr L)) (go loop))) (de MyReverse2Test (N) (prog (I) (setq I 0) loop (cond ((igreaterp I N) (return nil))) (myreverse2 LongList) (setq I (iadd1 I)) (go loop))) (de myreverse2 (L) (prog (M) loop (cond ((null L) (return M))) (setq M (cons (car L) M)) (setq L (cdr L)) (go loop))) (de LengthTest (N) (prog (I) (setq I 0) loop (cond ((igreaterp I N) (return nil))) (length LongList) (setq I (iadd1 I)) (go loop))) (de Fact (N) (cond ((ilessp N 2) 1) (t (itimes2 N (Fact (isub1 N)))))) (de ArithmeticTest (N) (prog (I) (setq I 0) loop (cond ((igreaterp I N) (return nil))) (Fact 9) (setq I (iadd1 I)) (go loop))) (de EvalTest (N) (prog (I) (setq I 0) loop (cond ((igreaterp I N) (return nil))) (eval EvalForm) (setq I (iadd1 I)) (go loop))) (de TimeEval (Form) (prog (I) (setq I (time)) (eval Form) (return (difference (time) I)))) (de topleveltak (x y z) (tak x y z)) (de tak (x y z) (cond ((null (ilessp y x)) z) (t (tak (tak (isub1 x) y z) (tak (isub1 y) z x) (tak (isub1 z) x y))))) (de toplevelgtak (x y z) (gtak x y z)) (de gtak (x y z) (cond ((null (lessp y x)) z) (t (gtak (gtak (sub1 x) y z) (gtak (sub1 y) z x) (gtak (sub1 z) x y))))) (de gtsta (F) (prog (I) (setq I 1) Loop (cond ((igreaterp I 100000) (return nil))) (apply F (list I)) (setq I (iadd1 I)) (go Loop))) (de gtstb (F) (prog (I) (setq I 1) Loop (cond ((igreaterp I 100000) (return nil))) (funcall F I) (setq I (iadd1 I)) (go Loop))) (de g0 (X) X) (de g1 (X) (iadd1 X)) (de nreverse (x) (nreconc x nil)) (de nreconc (x y) (prog (z) L (cond ((atom x) (return y))) (setq z x) (setq x (cdr x)) (setq y (rplacd z y)) (go L))) (de nnils (N) (prog (LST i) (setq i 0) loop (cond ((igreaterp i N) (return LST))) (setq LST (cons nil LST)) (setq i (iadd1 i)) (go loop))) (global '(TestGlobalVar)) (de nils (N) (setq TESTGLOBALVAR (nnils N)) N) (de nr () (setq TESTGLOBALVAR (nreverse TESTGLOBALVAR)) nil)