(FILECREATED " 3-Mar-86 22:40:22" {QV}<PEDERSEN>LISP>UNBOXEDOPS.;1 9358
changes to: (VARS UNBOXEDOPSCOMS)
(FNS \UNBOXFLOAT1.PATCH)
previous date: "20-Feb-86 15:58:55" {ERIS}<LISPUSERS>KOTO>UNBOXEDOPS.;1)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT UNBOXEDOPSCOMS)
(RPAQQ UNBOXEDOPSCOMS [(MACROS UFABS UFABS1 UFEQP UFEQP2 UFGEQ UFGEQ2 UFGREATERP UFGREATERP2 UFIX
UFIX1 UFLEQ UFLEQ2 UFLESSP UFLESSP2 UFMAX UFMAX2 UFMIN UFMIN2
UFMINUS UFMINUS1 UFREMAINDER UFREMAINDER2)
(FNS UFABS UFEQP UFGEQ UFGREATERP UFIX UFLEQ UFLESSP UFMAX UFMIN UFMINUS UFREMAINDER
\UNBOXFLOAT1.PATCH)
[DECLARE: DONTEVAL@LOAD DOCOPY (P (MOVD (QUOTE \UNBOXFLOAT1.PATCH)
(QUOTE \UNBOXFLOAT1]
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (LOCALVARS . T))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA UFMIN UFMAX])
(DECLARE: EVAL@COMPILE
(DEFMACRO UFABS (&OPTIONAL (ARG1 NIL ARG1GIVEN)
&REST RESTARGS &WHOLE ORIGINAL)
(if (OR (NOT ARG1GIVEN)
RESTARGS)
then
(PRINTOUT T "************" T)
(PRINTOUT T "Illegal args to UFABS" , , ORIGINAL T)
(PRINTOUT T "************" T))
(LIST (QUOTE UFABS1)
ARG1))
[PUTPROPS UFABS1 DMACRO ((X)
(\FLOATBOX ((OPCODES UBFLOAT1 2)
(\FLOATUNBOX X]
(DEFMACRO UFEQP (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
(ARG2 NIL ARG2GIVEN)
&REST RESTARGS)
(if (OR (NOT ARG1GIVEN)
(NOT ARG2GIVEN)
RESTARGS)
then
(PRINTOUT T "************" T)
(PRINTOUT T "Illegal args to UFEQP" , , ORIGINAL T)
(PRINTOUT T "************" T))
(LIST (QUOTE UFEQP2)
ARG1 ARG2))
(PUTPROPS UFEQP2 DMACRO ((X Y)
(EQ (\FLOATUNBOX (FDIFFERENCE X Y))
NIL)))
(DEFMACRO UFGEQ (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
(ARG2 NIL ARG2GIVEN)
&REST RESTARGS)
(if (OR (NOT ARG1GIVEN)
(NOT ARG2GIVEN)
RESTARGS)
then
(PRINTOUT T "************" T)
(PRINTOUT T "Illegal args to UFGEQ" , , ORIGINAL T)
(PRINTOUT T "************" T))
(LIST (QUOTE UFGEQ2)
ARG1 ARG2))
[PUTPROPS UFGEQ2 DMACRO ((X Y)
(NOT ((OPCODES SWAP UBFLOAT2 5)
(\FLOATUNBOX X)
(\FLOATUNBOX Y]
(DEFMACRO UFGREATERP (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
(ARG2 NIL ARG2GIVEN)
&REST RESTARGS)
(if (OR (NOT ARG1GIVEN)
(NOT ARG2GIVEN)
RESTARGS)
then
(PRINTOUT T "************" T)
(PRINTOUT T "Illegal args to UFGREATERP" , , ORIGINAL T)
(PRINTOUT T "************" T))
(LIST (QUOTE UFGREATERP2)
ARG1 ARG2))
[PUTPROPS UFGREATERP2 DMACRO ((X Y)
((OPCODES UBFLOAT2 5)
(\FLOATUNBOX X)
(\FLOATUNBOX Y]
(DEFMACRO UFIX (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
&REST RESTARGS)
(if (OR (NOT ARG1GIVEN)
RESTARGS)
then
(PRINTOUT T "************" T)
(PRINTOUT T "Illegal args to UFIX" , , ORIGINAL T)
(PRINTOUT T "************" T))
(LIST (QUOTE UFIX1)
ARG1))
[PUTPROPS UFIX1 DMACRO ((X)
((OPCODES UBFLOAT1 4)
(\FLOATUNBOX X]
(DEFMACRO UFLEQ (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
(ARG2 NIL ARG2GIVEN)
&REST RESTARGS)
(if (OR (NOT ARG1GIVEN)
(NOT ARG2GIVEN)
RESTARGS)
then
(PRINTOUT T "************" T)
(PRINTOUT T "Illegal args to UFLEQ" , , ORIGINAL T)
(PRINTOUT T "************" T))
(LIST (QUOTE UFLEQ2)
ARG1 ARG2))
[PUTPROPS UFLEQ2 DMACRO ((X Y)
(NOT ((OPCODES UBFLOAT2 5)
(\FLOATUNBOX X)
(\FLOATUNBOX Y]
(DEFMACRO UFLESSP (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
(ARG2 NIL ARG2GIVEN)
&REST RESTARGS)
(if (OR (NOT ARG1GIVEN)
(NOT ARG2GIVEN)
RESTARGS)
then
(PRINTOUT T "************" T)
(PRINTOUT T "Illegal args to UFLESSP" , , ORIGINAL T)
(PRINTOUT T "************" T))
(LIST (QUOTE UFLESSP2)
ARG1 ARG2))
[PUTPROPS UFLESSP2 DMACRO ((X Y)
((OPCODES SWAP UBFLOAT2 5)
(\FLOATUNBOX X)
(\FLOATUNBOX Y]
(DEFMACRO UFMAX (&OPTIONAL (ARG1 NIL ARG1GIVEN)
(ARG2 NIL ARG2GIVEN)
&REST RESTARGS)
(if (NOT ARG1GIVEN)
then
(QUOTE MIN.FLOAT)
elseif
(NOT ARG2GIVEN)
then
(BQUOTE (FLOAT , ARG1))
elseif RESTARGS then (BQUOTE (UFMAX (UFMAX2 , ARG1 , ARG2)
., RESTARGS))
else
(LIST (QUOTE UFMAX2)
ARG1 ARG2)))
[PUTPROPS UFMAX2 DMACRO ((X Y)
(\FLOATBOX ((OPCODES UBFLOAT2 6)
(\FLOATUNBOX X)
(\FLOATUNBOX Y]
(DEFMACRO UFMIN (&OPTIONAL (ARG1 NIL ARG1GIVEN)
(ARG2 NIL ARG2GIVEN)
&REST RESTARGS)
(if (NOT ARG1GIVEN)
then
(QUOTE MAX.FLOAT)
elseif
(NOT ARG2GIVEN)
then
(BQUOTE (FLOAT , ARG1))
elseif RESTARGS then (BQUOTE (UFMIN (UFMIN2 , ARG1 , ARG2)
., RESTARGS))
else
(LIST (QUOTE UFMIN2)
ARG1 ARG2)))
[PUTPROPS UFMIN2 DMACRO ((X Y)
(\FLOATBOX ((OPCODES UBFLOAT2 7)
(\FLOATUNBOX X)
(\FLOATUNBOX Y]
(DEFMACRO UFMINUS (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
&REST RESTARGS)
(if (OR (NOT ARG1GIVEN)
RESTARGS)
then
(PRINTOUT T "************" T)
(PRINTOUT T "Illegal args to UFMINUS" , , ORIGINAL T)
(PRINTOUT T "************" T))
(LIST (QUOTE UFMINUS1)
ARG1))
[PUTPROPS UFMINUS1 DMACRO ((X)
(\FLOATBOX ((OPCODES UBFLOAT1 3)
(\FLOATUNBOX X]
(DEFMACRO UFREMAINDER (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
(ARG2 NIL ARG2GIVEN)
&REST RESTARGS)
(if (OR (NOT ARG1GIVEN)
(NOT ARG2GIVEN)
RESTARGS)
then
(PRINTOUT T "************" T)
(PRINTOUT T "Illegal args to UFREMAINDER" , , ORIGINAL)
(PRINTOUT T "************" T))
(LIST (QUOTE UFREMAINDER2)
ARG1 ARG2))
[PUTPROPS UFREMAINDER2 DMACRO ((X Y)
(\FLOATBOX ((OPCODES UBFLOAT2 8)
(\FLOATUNBOX X)
(\FLOATUNBOX Y]
)
(DEFINEQ
(UFABS
[LAMBDA (X) (* jop: "30-Jan-86 15:10")
(FABS X])
(UFEQP
[LAMBDA (X Y) (* jop: "31-Jan-86 12:35")
(FEQP X Y])
(UFGEQ
[LAMBDA (X Y) (* jop: " 2-Feb-86 12:36")
(GEQ X Y])
(UFGREATERP
[LAMBDA (X Y) (* jop: "30-Jan-86 15:11")
(FGREATERP X Y])
(UFIX
[LAMBDA (X) (* jop: "30-Jan-86 15:11")
(FIX X])
(UFLEQ
[LAMBDA (X Y) (* jop: " 2-Feb-86 12:37")
(LEQ X Y])
(UFLESSP
[LAMBDA (X Y) (* jop: "31-Jan-86 12:20")
(FLESSP X Y])
(UFMAX
[LAMBDA ARGS (* jop: "30-Jan-86 15:12")
(bind (MAX ← MIN.FLOAT) for I from 1 to ARGS do (if (FGREATERP (ARG ARGS I)
MAX)
then (SETQ MAX
(ARG ARGS I)))
finally (RETURN MAX])
(UFMIN
[LAMBDA ARGS (* jop: "30-Jan-86 15:13")
(bind (MIN ← MAX.FLOAT) for I from 1 to ARGS do (if (FLESSP (ARG ARGS I)
MIN)
then (SETQ MIN
(ARG ARGS I)))
finally (RETURN MIN])
(UFMINUS
[LAMBDA (X) (* jop: "30-Jan-86 15:14")
(FMINUS X])
(UFREMAINDER
[LAMBDA (X Y) (* jop: "30-Jan-86 15:14")
(FREMAINDER X Y])
(\UNBOXFLOAT1.PATCH
[LAMBDA (OP) (* edited: " 3-Mar-86 22:29")
(* UFN for the unboxed floating 1-arg cases)
(\SLOWRETURN)
(SELECTQ OP
(0 (* BOX)
(\CALLER.ARGS (X)
(LET [(VAL (NCREATE (QUOTE FLOATP]
(replace (FLOATP HIWORD) of VAL with (\HILOC X))
(replace (FLOATP LOWORD) of VAL with (\LOLOC X))
VAL)))
(1 (* UNBOX)
(\CALLER.ARGS (X)
(\HAND.FLOATUNBOX X)))
[2 (* UFABS)
(\CALLER.ARGS ((X FLOATP))
(\FLOATUNBOX (ABS X]
[3 (* UFNEGATE)
(\CALLER.ARGS ((X FLOATP))
(\FLOATUNBOX (FMINUS X]
(4 (* UFIX)
(\CALLER.ARGS ((X FLOATP))
(FIX X)))
(HELP "\UNBOXFLOAT1 called with illegal op " OP])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(MOVD (QUOTE \UNBOXFLOAT1.PATCH)
(QUOTE \UNBOXFLOAT1))
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA UFMIN UFMAX)
)
(PUTPROPS UNBOXEDOPS COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (5977 8935 (UFABS 5987 . 6107) (UFEQP 6109 . 6231) (UFGEQ 6233 . 6354) (UFGREATERP 6356
. 6488) (UFIX 6490 . 6608) (UFLEQ 6610 . 6731) (UFLESSP 6733 . 6859) (UFMAX 6861 . 7202) (UFMIN 7204
. 7539) (UFMINUS 7541 . 7665) (UFREMAINDER 7667 . 7801) (\UNBOXFLOAT1.PATCH 7803 . 8933)))))
STOP