(;; SCCS : @(#)ARITH.LSP 3.14 2/4/86
;;; File : $xerox/arith.lsp
;;; Author : Richard A. O'Keefe
;;; Purpose: Define the arithmetic instructions.
PROGN
;;; ------------------------------------------------------------------------
;;
;; WARNING: This material is CONFIDENTIAL and proprietary to Quintus
;; Computer Systems Inc. This notice is protection against inadvertent
;; disclosure and does not constitute publication or reflect any intent
;; to publish.
;;
;; Copyright (C) 1985, by Quintus Computer Systems, Inc.
;; All rights reserved.
;;
;; CAVEAT LECTOR: This software is under development. No warrantee is
;; made that it is any use for anything at all.
;;
;;; ------------------------------------------------------------------------
;;; ------------------------------------------------------------------------
;;
;; The D-machine version of the arithmetic instructions differs from
;; the VAX and Sun emulators. Instead of holding unboxed numbers, T0
;; and T1 hold ordinary Lisp pointers to SMALLPs, FIXPs, FLOATPs, or
;; whatever. There are several reasons for this. One is that it is
;; easiest to do it this way. Another important one is that in JAZZ
;; I am told there will be BIGNUMs, so that the two-fold distinction
;; which that VAX and Sun emulators assume will not be adequate. As
;; a consequence of this change, there is no distinction between the
;; two modes here as there is in the VAX/Sun versions: we always stay
;; in whatever mode we happened to be in when we started.
;;
;; A difference between the Lisp emulator and the existing emulators
;; is the way that division by zero is handled. The existing
;; emulators check for zero and simply fail. Arithmetic overflow
;; is handling by taking whatever the hardware gives you for integers,
;; and infinities for floating point numbers. Allowing infinities
;; was a glaringly stupid mistake, we cannot possibly make that work
;; on the VAX nor on the 1108, and we may change the SUN version to
;; trap floating point overflows as well. The Koto version of Lisp
;; supports bignums, so integer overflow isn't a problem. But we
;; want to do something sensible with floating pointer overflow and
;; all kinds of integer division as well, so we run with
(OVERFLOW T)
;; enabled. Floating overflow is supposed to be caught; for some
;; reason zero divide is slipping through.
;; (raw.float)
;; Takes the floating point number in T0 and turns it into a FIXP
;; with the same bits. T0 is first floated, if necessary.
(def.both.mode raw.float (extend)
(LET ((Ptr (FLOAT (get.nb T0)) ))
(put.nb T0 (\MAKENUMBER (\GETBASE Ptr 0) (\GETBASE Ptr 1)))
)
(continue 0)
)
;; (float)
;; ensures that T0 is a floating point number.
(def.both.mode float (extend)
(if (NOT (FLOATP (get.nb T0))) then
(put.nb T0 (FLOAT (get.nb T0)) ))
(continue 0)
)
;; (fix)
;; ensures that T0 is a fixed point number.
;; Note that this can cause an overflow trap.
(def.both.mode fix (extend)
(if (FLOATP (get.nb T0)) then
(put.nb T0 (FIX (get.nb T0)) ))
(continue 0)
)
;; (minus)
;; negates a number.
;; does (IMINUS -2↑31) cause an integer overflow trap? It should.
(def.both.mode minus (extend)
(put.nb T0 (MINUS (get.nb T0)))
(continue 0)
)
;; (boolean.not)
;; takes the complement of a number.
(def.both.mode boolean.not (extend)
(put.nb T0 (LOGNOT (get.nb T0)))
(continue 0)
)
;; All the two-argument arithmetic operations follow a common pattern.
;; They just apply a Lisp function to T0 and T1, and put the result in
;; T0. So, to save my effort, they are defined via a macro.
(def.macro def.binop (Op Fn)
`(def.both.mode ,Op (extend)
(put.nb T0 (,Fn (get.nb T1) (get.nb T0)) )
(continue 0)
)
)
(def.binop add PLUS)
(def.binop subtract DIFFERENCE)
(def.binop multiply TIMES)
(def.binop divide FQUOTIENT)
(def.binop integer.divide IQUOTIENT)
(def.binop modulus REMAINDER)
(def.binop boolean.and LOGAND)
(def.binop boolean.or LOGOR)
(def.binop boolean.xor LOGXOR)
(def.binop left.shift LSH) ; *NOT* LLSH
(def.binop right.shift RSH) ; *NOT* LRSH
;; There are two versions of each arithmetic relation.
;; <foo> succeeds if the relation holds, fails otherwise.
;; <foo.else L> falls through if the relation holds, or
;; jumps to L if the relation fails to hold. For convenience,
;; the jump instructions are like other jumps, [opcode:8|addr:24]
;; and the other ones are [extend:8|opcode:8]. As a matter of
;; fact, these instructions can only appear at the end of a
;; block of arithmetic instructions, so if we arranged for load
;; instructions to set read mode, we could double up the other
;; arithmetic instructions, particularly the jumps and stores.
(def.macro def.relop (Fn Op1 Op2)
`(PROGN
(def.both.mode ,Op1 (extend)
(if (,Fn (get.nb T1) (get.nb T0)) then
(continue 0)
else
(fast.fail)
)
)
(def.both.mode ,Op2 (address)
(if (,Fn (get.nb T1) (get.nb T0)) then
(continue 1)
else
(continue.at (address.operand))
)
)
)
)
(def.relop EQP equal.to equal.to.else)
(def.relop (LAMBDA (X Y) (NOT (EQP X Y)))
not.equal.to not.equal.to.else)
(def.relop LESSP less.than less.than.else)
(def.relop GEQ not.less.than not.less.than.else)
(def.relop GREATERP greater.than greater.than.else)
(def.relop LEQ not.greater.than not.greater.than.else)
;; (store.variable.Xn n)
;; stores the number in T0 in the previously uninitialised variable Xn.
;; We set the tag of T0, but it is safe to continue in arithmetic mode,
;; because the arithmetic operations ignore that tag. We have to use
;; tag.other here rather than tag.number because, thanks to the new
;; improved choice point code, T0 might be a Prolog choice point handle.
(def.macro store.variable (store)
`(LET ((Ptr (get.nb T0)))
(if (AND (NOT (SMALLP Ptr)) (NUMBERP Ptr)) then
(QP.ADD.REF Ptr) ; FIXP, BIGNUM, FLOATP
)
(,store N (tag.other Ptr))
)
)
(def.both.mode store.variable.Xn (areg)
(store.variable put.Aval)
(continue 0)
)
;; (store.variable.XnM n)
;; is for the X registers stored in memory.
(def.both.mode store.variable.XnM (amem)
(store.variable put.Amem)
(continue 0)
)
;; (store.variable.Yn n)
;; is much the same.
(def.both.mode store.variable.Yn (yreg)
(store.variable put.Yval)
(continue 0)
)
;; (store.value.Xn n) and
;; (store.value.Yn n)
;; are really a form of unification. For the moment, the simplest
;; thing to do is to set up T0 and T1 and go ahead with a call to
;; the general unifier. We could save some time by making a special
;; case unify.constant routine, but it wouldn't save all that much
;; effort, as we still have to check for boxed numbers. Because
;; maintaining Lisp reference counts is so expensive, we want to
;; avoid calling QP.ADD.REF if we possibly can. The same criteria
;; apply to all flavours of store value, even store.value.Xn, as
;; Xn might hold an unbound variable. So the store.value macro
;; packages up the reference count maintenance and tag repair for
;; all flavours of store.value. We use tag.other because gettopval
;; is sometimes used to load procedure record addresses!
(def.open store.value ()
(LET ((Ptr (get.nb T0)))
(if (AND (EQ (tag.of T1) ref.tag.8) ; might store into memory
(NOT (SMALLP Ptr)) ; might need a ref count
(NUMBERP Ptr)) then ; filter out BLOCKDATAPs
(QP.ADD.REF Ptr)
)
(put.32 T0 (tag.other Ptr))
)
(unify.and.continue 0)
)
(def.both.mode store.value.Xn (areg)
(put.32 T1 (get.Aval N))
(store.value)
)
(def.both.mode store.value.XnM (amem)
(put.32 T1 (get.Amem N))
(store.value)
)
(def.both.mode store.value.Yn (yreg)
(put.32 T1 (get.Yval N))
(store.value)
)
;; (store.integer cell) and
;; (store.float cell)
;; could be done the same way, by just going off to the general unifier.
;; Indeed, the whole of the "store" family could be handled by just the
;; store.variable.An instruction, followed by unification against that
;; A register. store.integer can check immediately for a FIXP, and
;; store.float can check immediately for a FLOATP; this is no real gain
;; as these instructions are vanishingly rare.
(def.both.mode store.integer (extend cell)
(put.32 T1 (cell.operand))
(if (AND (FIXP (get.nb T0)) (EQP (get.nb T0) (get.nb T1)) ) then
(continue 2)
else
(fast.fail)
)
)
(def.both.mode store.float (extend cell)
(put.32 T1 (cell.operand))
(if (AND (FLOATP (get.nb T0)) (EQP (get.nb T0) (get.nb T1)) ) then
(continue 2)
else
(fast.fail)
)
)
;; In an earlier version of this file, the load instructions used to
;; demand that an integer or float be yielded. But now that BIGNUMS
;; are available, this is no longer right, and more importantly, the
;; pseudo-Prolog code that maintains dynamic clauses expects X =\= 0
;; to work correctly for any "address" X. So now we accept any kind
;; of constant. If we do arithmetic on a non-numeric value, Inter-
;; LOSS is perfectly capable of spotting the error and reporting it.
;; As we don't check, "Y = a, X is Y" will succeed in compiled code,
;; and it isn't supposed to (and won't in interpreted code). We can
;; live with that. When we find a constant, we leave the tag in T0.
;; It doesn't matter, nothing is going to look at it. The final (?)
;; idea is to reject atoms but accept "others".
(def.subr load.value.error () ; print an error message
;; Check whether we can change (MKATOM &) -> &
(QP.PUT.TOKEN.SYMBOL QP.CURRENT.OUTPUT (MKATOM "%
[Warning: Arithmetic predicate has failed - tried to evaluate a non number]%
[ Use the interpreter and debugger to locate this error]%
" ) 0)
(fast.fail)
)
(def.open load.value ()
(PROG (Tag)
(while (EQ (SETQ Tag (tag.of T0)) ref.tag.8)
;; variable. Dereference, see if unbound.
(put.24 R (untag.ref T0))
(put.32 T0 (get.cell R 0))
(if (EQ (get.nb T0) (get.24 R)) then
(load.value.error) ; unbound variable, never ok
)
)
(if (ILESSP Tag immed.tag.8) then
(load.value.error) ; not a constant
)
)
;; T0 is a smallp, fixp, floatp, or "other"
(continue 0)
)
(def.both.mode load.value.Xn (areg)
(put.32 T1 (get.32 T0)) ; "push" T0
(put.32 T0 (get.Aval N))
(load.value)
)
(def.both.mode load.value.XnM (amem)
(put.32 T1 (get.32 T0)) ; "push" T0
(put.32 T0 (get.Amem N)) ; #TAIL
(load.value)
)
(def.both.mode load.value.Yn (yreg)
(put.32 T1 (get.32 T0)) ; "push" T0
(put.32 T0 (get.Yval N))
(load.value)
)
;; When it comes to loading a constant, we don't need to have separate
;; load.integer and load.float instructions. The Sun/VAX emulators use
;; them so that (1) they can work out fast what mode they are supposed
;; to be in, and (2) they can put 32-bit boxed numbers in line in the
;; code. We don't use the mode that way, and there isn't any advantage
;; to having in-line constants. Indeed, it'd cost us more boxing.
;; So there is only the
;; (load.constant cell)
;; instruction, which copies the pointer part of the cell to T0. (The
;; tag is copied too, but nobody cares about that.)
(def.both.mode load.constant (extend cell)
(put.32 T1 (get.32 T0)) ; "push" T0
(put.32 T0 (cell.operand))
(continue 2)
)
;; There are four instructions which take 16-bit integer arguments.
;; load.{pos/neg}.word are there for compactness; they are one word
;; shorter than load.cell. All things considered, I wonder if I am
;; wise to keep them?
(def.both.mode load.pos.word (extend word)
(put.32 T1 (get.32 T0))
(put.nb T0 (get.code P 0))
(continue 1)
)
(def.both.mode load.neg.word (extend word)
(put.32 T1 (get.32 T0))
(put.nb T0 (\VAG2 (CONSTANT (\HILOC -1)) (get.code P 0)))
(continue 1)
)
;; add.{pos/neg}.word add a 17-bit integer to T0. They have to do
;; this without disturbing T1, so we use R as a scratch register.
;; This really needs some thought. add.constant would be one word
;; longer, and would not be all that much slower.
(def.both.mode add.pos.word (extend word)
(put.nb T0 (PLUS (get.nb T0) (get.code P 0)))
(continue 1)
)
(def.both.mode add.neg.word (extend word)
(put.nb T0 (PLUS (get.nb T0)
(\VAG2 (CONSTANT (\HILOC -1)) (get.code P 0))))
(continue 1)
)
) STOP