(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