(FILECREATED "14-Feb-86 15:33:48" {QV}<IDL>SOURCES>DMACROS.;10 2182
changes to: (MACROS SETRELT GETRELT SETRELTD GETRELTD RELTPTR)
(VARS DMACROSCOMS)
(FNS GETRELTDECL IJKCOMPILE LITFIXP)
previous date: " 7-Oct-85 23:36:12" {QV}<IDL>SOURCES>DMACROS.;8)
(* Copyright (c) 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT DMACROSCOMS)
(RPAQQ DMACROSCOMS ((* (MACROS GETRELT GETAELT GETRELTD SETRELT SETRELTD))
(* (MACROS OFFSET))
(MACROS GETRELT GETRELTD RELTPTR SETRELT SETRELTD)))
(* (MACROS GETRELT GETAELT GETRELTD SETRELT SETRELTD))
(* (MACROS OFFSET))
(DECLARE: EVAL@COMPILE
[PUTPROPS GETRELT DMACRO (OPENLAMBDA (R N)
(LET ((PTR (RELTPTR R N)))
(SELECTQ (fetch RELTTYPE of R)
(INTEGER (if (AND (fetch MAYHAVENIL of R)
(TESTMISSING (fetch I of PTR)))
then NIL else (fetch I of PTR)))
(FLOATING (if (AND (fetch MAYHAVENIL of R)
(TESTMISSING (fetch I of PTR)))
then NIL else (fetch F of PTR)))
(POINTER (\GETBASEPTR PTR 0))
NIL]
[PUTPROPS GETRELTD DMACRO (OPENLAMBDA (R N)
(\GETBASEPTR (fetch ROWBLKD of R)
(LLSH (SUB1 N)
1]
[PUTPROPS RELTPTR DMACRO (OPENLAMBDA (R N)
(\ADDBASE (fetch ROWBLK of R)
(LLSH (SUB1 N)
1]
(PUTPROPS SETRELT DMACRO (OPENLAMBDA (R N V)
(if V then (SELECTQ (fetch RELTTYPE of R)
(INTEGER (replace I of (RELTPTR R N)
with V))
(FLOATING (replace F of (RELTPTR R N)
with
(FLOAT V)))
(POINTER (\RPLPTR (RELTPTR R N)
0 V))
NIL)
elseif
(type? ROWPTR R)
then
(\RPLPTR (RELTPTR R N)
0 NIL)
else
(replace MAYHAVENIL of R with T)
(replace I of (RELTPTR R N)
with
(CONSTANT MIN.FIXP)))
V))
(PUTPROPS SETRELTD DMACRO (OPENLAMBDA (R N V)
(\RPLPTR (fetch ROWBLKD of R)
(LLSH (SUB1 N)
1)
V)
V))
)
(PUTPROPS DMACROS COPYRIGHT ("Xerox Corporation" 1983 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL)))
STOP