(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