(FILECREATED " 8-Feb-86 16:09:52" {DSK}<LISPFILES2>IMPROVEDDCOMS>DONOR.;1 3090 changes to: (VARS DONORCOMS)) (* Copyright (c) 1986 by Quintus Computer Systems, Inc. All rights reserved.) (PRETTYCOMPRINT DONORCOMS) (RPAQQ DONORCOMS ((FNS R.get.addr R.get.word R.gettopval R.put.addr R.put.word R.settopval W.get.addr W.get.word W.gettopval W.put.addr W.put.word W.settopval))) (DEFINEQ (R.get.addr (LAMBDA NIL (while (EQ (tag.of A1) ref.tag.8) (put.24 R (untag.ref A1)) (put.32 A1 (get.cell R 0))) ( put.32 T1 (tag.other (\GETBASEPTR (untag.anything A1) (untag.immed A2)))) (put.32 T0 (get.Aval 3)) ( unify.and.continue 0))) (R.get.word (LAMBDA NIL (while (EQ (tag.of A1) ref.tag.8) (put.24 R (untag.ref A1)) (put.32 A1 (get.cell R 0))) ( put.32 T1 (tag.immed (\GETBASE (untag.anything A1) (untag.immed A2)))) (put.32 T0 (get.Aval 3)) ( unify.and.continue 0))) (R.gettopval (LAMBDA NIL (put.32 T1 (get.32 T0)) (put.32 T0 (tag.other (GETTOPVAL (\VAG2 0 (get.code P 0))))) ( continue 1))) (R.put.addr (LAMBDA NIL (while (EQ (tag.of A1) ref.tag.8) (put.24 R (untag.ref A1)) (put.32 A1 (get.cell R 0))) ( while (EQ (tag.of A3) ref.tag.8) (put.24 R (untag.ref A3)) (put.32 A3 (get.cell R 0))) (\PUTBASEPTR ( untag.anything A1) (untag.immed A2) (untag.anything A3)) (continue 0))) (R.put.word (LAMBDA NIL (while (EQ (tag.of A1) ref.tag.8) (put.24 R (untag.ref A1)) (put.32 A1 (get.cell R 0))) ( while (EQ (tag.of A3) ref.tag.8) (put.24 R (untag.ref A3)) (put.32 A3 (get.cell R 0))) (\PUTBASE ( untag.anything A1) (untag.immed A2) (untag.immed A3)) (continue 0))) (R.settopval (LAMBDA NIL (SETTOPVAL (\VAG2 0 (get.code P 0)) (untag.immed T0)) (continue 1))) (W.get.addr (LAMBDA NIL (while (EQ (tag.of A1) ref.tag.8) (put.24 R (untag.ref A1)) (put.32 A1 (get.cell R 0))) ( put.32 T1 (tag.other (\GETBASEPTR (untag.anything A1) (untag.immed A2)))) (put.32 T0 (get.Aval 3)) ( unify.and.continue 0))) (W.get.word (LAMBDA NIL (while (EQ (tag.of A1) ref.tag.8) (put.24 R (untag.ref A1)) (put.32 A1 (get.cell R 0))) ( put.32 T1 (tag.immed (\GETBASE (untag.anything A1) (untag.immed A2)))) (put.32 T0 (get.Aval 3)) ( unify.and.continue 0))) (W.gettopval (LAMBDA NIL (put.32 T1 (get.32 T0)) (put.32 T0 (tag.other (GETTOPVAL (\VAG2 0 (get.code P 0))))) ( continue 1))) (W.put.addr (LAMBDA NIL (while (EQ (tag.of A1) ref.tag.8) (put.24 R (untag.ref A1)) (put.32 A1 (get.cell R 0))) ( while (EQ (tag.of A3) ref.tag.8) (put.24 R (untag.ref A3)) (put.32 A3 (get.cell R 0))) (\PUTBASEPTR ( untag.anything A1) (untag.immed A2) (untag.anything A3)) (continue 0))) (W.put.word (LAMBDA NIL (while (EQ (tag.of A1) ref.tag.8) (put.24 R (untag.ref A1)) (put.32 A1 (get.cell R 0))) ( while (EQ (tag.of A3) ref.tag.8) (put.24 R (untag.ref A3)) (put.32 A3 (get.cell R 0))) (\PUTBASE ( untag.anything A1) (untag.immed A2) (untag.immed A3)) (continue 0))) (W.settopval (LAMBDA NIL (SETTOPVAL (\VAG2 0 (get.code P 0)) (untag.immed T0)) (continue 1))) ) (PUTPROPS DONOR COPYRIGHT ("Quintus Computer Systems, Inc" 1986)) (DECLARE: DONTCOPY (FILEMAP (NIL (402 3002 (R.get.addr 412 . 654) (R.get.word 656 . 895) (R.gettopval 897 . 1026) ( R.put.addr 1028 . 1319) (R.put.word 1321 . 1606) (R.settopval 1608 . 1705) (W.get.addr 1707 . 1949) ( W.get.word 1951 . 2190) (W.gettopval 2192 . 2321) (W.put.addr 2323 . 2614) (W.put.word 2616 . 2901) ( W.settopval 2903 . 3000))))) STOP