(FILECREATED "13-Aug-86 17:46:12" {QV}<PEDERSEN>LISP>GAMM.;1 10971
previous date: "13-Jul-86 18:07:29" {SDRVX1}DSK5:<EHRLICH.LISP>GAMM.;16)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT GAMMCOMS)
(RPAQQ GAMMCOMS ((* * Gamm In Interlisp -- Single Precision Version, Mark 3 - National Physics
Laboratory Benchmark Gamm F - Call (GAMM-SETUP)
Before Executing (GAMM)
- The output return by GAMM is a list consisting of N, - 16.73343 22410 90064
71784 80142 13037 73134 63994, - 16.733... / N)
(* * Example: - ← (GAMM-SETUP)
- ← (GAMM 10))
(GLOBALVARS A B C)
(FNS GAMM GAMM* GAMM-SETUP GAMM-SETUP*)))
(* * Gamm In Interlisp -- Single Precision Version, Mark 3 - National Physics Laboratory
Benchmark Gamm F - Call (GAMM-SETUP) Before Executing (GAMM) - The output return by GAMM is a
list consisting of N, - 16.73343 22410 90064 71784 80142 13037 73134 63994, - %16.733... / N)
(* * Example: - ← (GAMM-SETUP) - ← (GAMM 10))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS A B C)
)
(DEFINEQ
(GAMM
[LAMBDA (N) (* dre: "13-Jul-86 17:52")
(* * GAMM in Interlisp-D -- Single Precision Version, Mark 3 -
National Physical Laboratory Benchmark GAMM F -
This program has a single parameter, N)
(bind (Root ← 0.0)
(X ← .1)
(Y ← 0.0)
(Acc ← 0.0)
(Acc1 ← 0.0)
(Divn ← (FQUOTIENT 1.0 (FLOAT N))) for Rep from 1 to N
declare (TYPE FLOATP Root X Y Acc Acc1 Divn)
do (* * First Addition/Subtraction loop)
(bind (I ← 30) for J from 1 to 30 do (SETA C I (FPLUS (ELT A I)
(ELT B I)))
(SETQ I (DIFFERENCE I 1)))
(* * First Polynomial Loop)
(SETQ Y 0.0)
[for I from 1 to 10 do (SETQ Y (FTIMES X (FPLUS Y (ELT C I]
(SETQ Acc1 (FTIMES Y Divn))
(* * First Maximum Element Loop)
(SETQ Y (ELT C 11))
[for I from 12 to 20 do (if (GREATERP (ELT C I)
Y)
then (SETQ Y (ELT C I]
(* * First Square Root Loop)
(SETQ Root 1.0)
[for I from 1 to 5 do (SETQ Root (FTIMES .5 (FPLUS Root (FQUOTIENT Y Root]
(SETQ Acc1 (FPLUS Acc1 (FTIMES Root Divn)))
(* * Second Addition/Subtraction Loop)
[for I from 1 to 10 do (SETA A I (FDIFFERENCE (ELT C I)
(ELT B I]
(* * Second Polynomial Loop)
(SETQ Y 0.0)
[for I from 1 to 10 do (SETQ Y (FTIMES X (FPLUS Y (ELT A I]
(* * Second Square Root Loop)
(SETQ Root 1.0)
[for I from 1 to 5 do (SETQ Root (FTIMES .5 (FPLUS Root (FQUOTIENT Y Root]
(SETQ Acc1 (FPLUS Acc1 (FTIMES Root Divn)))
(* * First Multiplication Loop)
[for I from 1 to 30 do (SETA C I (FTIMES (ELT C I)
(ELT B I]
(* * Second Maximum Element Loop)
(SETQ Y (ELT C 20))
[for I from 21 to 30 do (if (GREATERP (ELT C I)
Y)
then (SETQ Y (ELT C I]
(* * Third Square Root Loop)
(SETQ Root 1.0)
[for I from 1 to 5 do (SETQ Root (FTIMES .5 (FPLUS Root (FQUOTIENT Y Root]
(SETQ Acc1 (FPLUS Acc1 (FTIMES Root Divn)))
(* * Third Polynomial Loop)
(SETQ Y 0.0)
[for I from 1 to 10 do (SETQ Y (FTIMES X (FPLUS Y (ELT C I]
(SETQ Acc1 (FPLUS Acc1 (FTIMES Y Divn)))
(* * Third Maximum Element Loop)
(SETQ Y (ELT C 1))
[for I from 2 to 10 do (if (GREATERP (ELT C I)
Y)
then (SETQ Y (ELT C I]
(* * Fourth Square Root Loop)
(SETQ Root 1.0)
[for I from 1 to 5 do (SETQ Root (FTIMES .5 (FPLUS Root (FQUOTIENT Y Root]
[SETQ Acc (FPLUS Acc (SETQ Acc1 (FPLUS Acc1 (FTIMES Root Divn]
(* * End of timing loop)
finally (RETURN (LIST N Acc Acc1])
(GAMM*
[LAMBDA (N) (* jop: "13-Aug-86 17:22")
(* * GAMM* in Interlisp-D -- Single Precision Version, Mark 3 -
National Physical Laboratory Benchmark GAMM* F -
This program has a single parameter, N)
(bind (ABASE ← (\ARRAY-BASE A))
(BBASE ← (\ARRAY-BASE B))
(CBASE ← (\ARRAY-BASE C))
(Root ← 0.0)
(X ← .1)
(Y ← 0.0)
(Acc ← 0.0)
(Acc1 ← 0.0)
(Divn ← (FQUOTIENT 1.0 (FLOAT N))) for Rep from 1 to N
declare (TYPE FLOATP Root X Y Acc Acc1 Divn)
do (* * First Addition/Subtraction loop)
[for I from 0 to (LLSH 29 1) by 2 do (\PUTBASEFLOATP CBASE I (FPLUS (\GETBASEFLOATP ABASE I
)
(\GETBASEFLOATP BBASE I
]
(* * First Polynomial Loop)
[for I from 0 to (LLSH 9 1) by 2 do (SETQ Y (FTIMES X (FPLUS Y (\GETBASEFLOATP CBASE I]
(SETQ Acc1 (FTIMES Y Divn))
(* * First Maximum Element Loop)
(SETQ Y (\GETBASEFLOATP CBASE (LLSH 10 1)))
[for I from (LLSH 11 1) to (LLSH 19 1) by 2
do (if (UFGREATERP (\GETBASEFLOATP CBASE I)
Y)
then (SETQ Y (\GETBASEFLOATP CBASE I]
(* * First Square Root Loop)
(SETQ Root 1.0)
[for I from 1 to 5 do (SETQ Root (FTIMES .5 (FPLUS Root (FQUOTIENT Y Root]
(SETQ Acc1 (FPLUS Acc1 (FTIMES Root Divn)))
(* * Second Addition/Subtraction Loop)
[for I from 0 to (LLSH 9 1) by 2 do (\PUTBASEFLOATP ABASE I (FDIFFERENCE (\GETBASEFLOATP
CBASE I)
(\GETBASEFLOATP BBASE I]
(* * Second Polynomial Loop)
(SETQ Y 0.0)
[for I from 0 to (LLSH 9 1) by 2 do (SETQ Y (FTIMES X (FPLUS Y (\GETBASEFLOATP ABASE I]
(* * Second Square Root Loop)
(SETQ Root 1.0)
[for I from 1 to 5 do (SETQ Root (FTIMES .5 (FPLUS Root (FQUOTIENT Y Root]
(SETQ Acc1 (FPLUS Acc1 (FTIMES Root Divn)))
(* * First Multiplication Loop)
[for I from 0 to (LLSH 29 1) by 2 do (\PUTBASEFLOATP CBASE I (FTIMES (\GETBASEFLOATP CBASE
I)
(\GETBASEFLOATP BBASE I
]
(* * Second Maximum Element Loop)
(SETQ Y (\GETBASEFLOATP CBASE (LLSH 19 1)))
[for I from (LLSH 20 1) to (LLSH 29 1) by 2
do (if (UFGREATERP (\GETBASEFLOATP CBASE I)
Y)
then (SETQ Y (\GETBASEFLOATP CBASE I]
(* * Third Square Root Loop)
(SETQ Root 1.0)
[for I from 1 to 5 do (SETQ Root (FTIMES .5 (FPLUS Root (FQUOTIENT Y Root]
(SETQ Acc1 (FPLUS Acc1 (FTIMES Root Divn)))
(* * Third Polynomial Loop)
(SETQ Y 0.0)
[for I from 0 to (LLSH 9 1) by 2 do (SETQ Y (FTIMES X (FPLUS Y (\GETBASEFLOATP CBASE I]
(SETQ Acc1 (FPLUS Acc1 (FTIMES Y Divn)))
(* * Third Maximum Element Loop)
(SETQ Y (\GETBASEFLOATP CBASE 0))
[for I from (LLSH 1 1) to (LLSH 9 1) by 2 do (if (UFGREATERP (\GETBASEFLOATP CBASE I)
Y)
then (SETQ Y (\GETBASEFLOATP CBASE I]
(* * Fourth Square Root Loop)
(SETQ Root 1.0)
[for I from 1 to 5 do (SETQ Root (FTIMES .5 (FPLUS Root (FQUOTIENT Y Root]
[SETQ Acc (FPLUS Acc (SETQ Acc1 (FPLUS Acc1 (FTIMES Root Divn]
(* * End of timing loop)
finally (RETURN (LIST N Acc Acc1])
(GAMM-SETUP
[LAMBDA NIL (* dre: " 9-Jul-86 16:31")
(PROG NIL
(SETQ A (ARRAY 30 (QUOTE FLOATP)
0.0))
(SETQ B (ARRAY 30 (QUOTE FLOATP)
0.0))
(SETQ C (ARRAY 30 (QUOTE FLOATP)
0.0))
(bind (Y ← 1.0) for I from 1 to 30 do (SETA A I I)
(SETA B I (MINUS Y))
(SETQ Y (MINUS Y])
(GAMM-SETUP*
[LAMBDA NIL (* jop: "13-Aug-86 17:07")
[SETQ A (MAKE-ARRAY 30 (QUOTE :ELEMENT-TYPE)
(QUOTE FLOAT)
(QUOTE :INITIAL-CONTENTS)
(for I from 1 to 30 collect (FLOAT I]
[SETQ B (MAKE-ARRAY 30 (QUOTE :ELEMENT-TYPE)
(QUOTE FLOAT)
(QUOTE :INITIAL-CONTENTS)
(bind (Y ← 1.0) for I from 1 to 30 collect (SETQ Y (FMINUS Y]
(SETQ C (MAKE-ARRAY 30 (QUOTE :ELEMENT-TYPE)
(QUOTE FLOAT])
)
(PUTPROPS GAMM COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1201 10896 (GAMM 1211 . 4951) (GAMM* 4953 . 9703) (GAMM-SETUP 9705 . 10269) (
GAMM-SETUP* 10271 . 10894)))))
STOP