X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Falpha%2Fparms.lisp;h=78b7d0e5363659297d24fcb97b3c37cc13b485ab;hb=0e3c4b4db102bd204a30402d7e5a0de44aea57ce;hp=143db403dcf68d61bb4625767cdb13878e114d65;hpb=bc46c8bcdd6ac8918df8ea9e9db49808e4924fcf;p=sbcl.git diff --git a/src/compiler/alpha/parms.lisp b/src/compiler/alpha/parms.lisp index 143db40..78b7d0e 100644 --- a/src/compiler/alpha/parms.lisp +++ b/src/compiler/alpha/parms.lisp @@ -11,44 +11,39 @@ (eval-when (:compile-toplevel :load-toplevel :execute) -(defconstant n-word-bits 32 - #!+sb-doc - "Number of bits per word where a word holds one lisp descriptor.") +;;; number of bits per word where a word holds one lisp descriptor +(def!constant n-word-bits 32) -(defconstant n-byte-bits 8 - #!+sb-doc - "Number of bits per byte where a byte is the smallest addressable object.") +;;; the natural width of a machine word (as seen in e.g. register width, +;;; address space) +(def!constant n-machine-word-bits 64) -(defconstant word-shift (1- (integer-length (/ n-word-bits n-byte-bits))) - #!+sb-doc - "Number of bits to shift between word addresses and byte addresses.") +;;; number of bits per byte where a byte is the smallest addressable +;;; object +(def!constant n-byte-bits 8) -(defconstant n-word-bytes (/ n-word-bits n-byte-bits) - #!+sb-doc - "Number of bytes in a word.") +(def!constant float-sign-shift 31) -(defconstant float-sign-shift 31) - -(defconstant single-float-bias 126) +(def!constant single-float-bias 126) (defconstant-eqx single-float-exponent-byte (byte 8 23) #'equalp) (defconstant-eqx single-float-significand-byte (byte 23 0) #'equalp) -(defconstant single-float-normal-exponent-min 1) -(defconstant single-float-normal-exponent-max 254) -(defconstant single-float-hidden-bit (ash 1 23)) -(defconstant single-float-trapping-nan-bit (ash 1 22)) +(def!constant single-float-normal-exponent-min 1) +(def!constant single-float-normal-exponent-max 254) +(def!constant single-float-hidden-bit (ash 1 23)) +(def!constant single-float-trapping-nan-bit (ash 1 22)) -(defconstant double-float-bias 1022) +(def!constant double-float-bias 1022) (defconstant-eqx double-float-exponent-byte (byte 11 20) #'equalp) (defconstant-eqx double-float-significand-byte (byte 20 0) #'equalp) -(defconstant double-float-normal-exponent-min 1) -(defconstant double-float-normal-exponent-max #x7FE) -(defconstant double-float-hidden-bit (ash 1 20)) -(defconstant double-float-trapping-nan-bit (ash 1 19)) +(def!constant double-float-normal-exponent-min 1) +(def!constant double-float-normal-exponent-max #x7FE) +(def!constant double-float-hidden-bit (ash 1 20)) +(def!constant double-float-trapping-nan-bit (ash 1 19)) -(defconstant single-float-digits +(def!constant single-float-digits (+ (byte-size single-float-significand-byte) 1)) -(defconstant double-float-digits +(def!constant double-float-digits (+ (byte-size double-float-significand-byte) n-word-bits 1)) ;;; These values are originally from the DEC Assembly Language @@ -77,16 +72,16 @@ ;;; ;;; trap enables are set in software (fp_control) -(defconstant float-inexact-trap-bit (ash 1 4)) ; rw -(defconstant float-underflow-trap-bit (ash 1 3)) ; rw -(defconstant float-overflow-trap-bit (ash 1 2)) ; ro -(defconstant float-divide-by-zero-trap-bit (ash 1 1)) ; ro -(defconstant float-invalid-trap-bit (ash 1 0)) ; ro -(defconstant-eqx float-traps-byte (byte 6 1) #'equalp) +(def!constant float-inexact-trap-bit (ash 1 4)) ; rw +(def!constant float-underflow-trap-bit (ash 1 3)) ; rw +(def!constant float-overflow-trap-bit (ash 1 2)) ; ro +(def!constant float-divide-by-zero-trap-bit (ash 1 1)) ; ro +(def!constant float-invalid-trap-bit (ash 1 0)) ; ro +(defconstant-eqx float-traps-byte (byte 6 1) #'equalp) ;;; exceptions are also read/written in software (by syscalls, no less). ;;; This is kind of dumb, but has to be done -(defconstant-eqx float-sticky-bits (byte 6 17) #'equalp) ; fp_control +(defconstant-eqx float-sticky-bits (byte 6 17) #'equalp) ; fp_control ;;; (We don't actually _have_ "current exceptions" on Alpha; the ;;; hardware only ever sets bits. So, set this the same as accrued @@ -94,15 +89,15 @@ (defconstant-eqx float-exceptions-byte (byte 6 17) #'equalp) ;;; Rounding modes can only be set by frobbing the hardware fpcr directly -(defconstant float-round-to-zero 0) -(defconstant float-round-to-negative 1) -(defconstant float-round-to-nearest 2) -(defconstant float-round-to-positive 3) -(defconstant-eqx float-rounding-mode (byte 2 58) #'equalp) +(def!constant float-round-to-zero 0) +(def!constant float-round-to-negative 1) +(def!constant float-round-to-nearest 2) +(def!constant float-round-to-positive 3) +(defconstant-eqx float-rounding-mode (byte 2 58) #'equalp) ;;; Miscellaneous stuff - I think it's far to say that you deserve ;;; what you get if you ask for fast mode. -(defconstant float-fast-bit 0) +(def!constant float-fast-bit 0) ); eval-when @@ -115,45 +110,32 @@ #!+linux (progn - (defconstant read-only-space-start #x20000000) - (defconstant read-only-space-end #x24000000) - - (defconstant static-space-start #x28000000) - (defconstant static-space-end #x2c000000) - - ;; this is used in PURIFY as part of a sloppy check to see if a pointer - ;; is in dynamic space. Chocolate brownie for the first person to fix it - ;; -dan 20010502 - (defconstant dynamic-space-start #x30000000) - (defconstant dynamic-space-end #x3fff0000) + (def!constant read-only-space-start #x20000000) + (def!constant read-only-space-end #x24000000)) - (defconstant dynamic-0-space-start #x30000000) - (defconstant dynamic-0-space-end #x3fff0000) - - (defconstant dynamic-1-space-start #x40000000) - (defconstant dynamic-1-space-end #x4fff0000) +#!+osf1 +(progn + (defconstant read-only-space-start #x10000000) + (defconstant read-only-space-end #x25000000)) - (defconstant control-stack-start #x50000000) - (defconstant control-stack-end #x51000000) - (defconstant binding-stack-start #x70000000) - (defconstant binding-stack-end #x71000000)) +(def!constant static-space-start #x28000000) +(def!constant static-space-end #x2c000000) -#!+osf1 ;as if -(progn - (defparameter read-only-space-start #x10000000) - (defparameter static-space-start #x28000000) - (defparameter dynamic-space-start #x30000000)) +(def!constant dynamic-0-space-start #x30000000) +(def!constant dynamic-0-space-end #x3fff0000) +(def!constant dynamic-1-space-start #x40000000) +(def!constant dynamic-1-space-end #x4fff0000) ;;; FIXME nothing refers to either of these in alpha or x86 cmucl ;;; backend, so they could probably be removed. ;; The space-register holding the lisp heap. -(defconstant lisp-heap-space 4) +(def!constant lisp-heap-space 4) ;; The space-register holding the C text segment. -(defconstant c-text-space 4) +(def!constant c-text-space 4) ;;; the X86 port defines *nil-value* as (+ *target-static-space-start* #xB) ;;; here, but it seems to be the only port that needs to know the @@ -161,20 +143,19 @@ ;;;; other miscellaneous constants -(defenum (:suffix -trap :start 8) - halt - pending-interrupt - error - cerror - breakpoint - fun-end-breakpoint - single-step-breakpoint) - -(defenum (:prefix trace-table-) - normal - call-site - fun-prologue - fun-epilogue) +(defenum (:start 8) + halt-trap + pending-interrupt-trap + error-trap + cerror-trap + breakpoint-trap + fun-end-breakpoint-trap + single-step-breakpoint-trap + ;; Stepper actually not implemented on Alpha, but these constants + ;; are still needed to avoid undefined variable warnings during sbcl + ;; build. + single-step-around-trap + single-step-before-trap) ;;;; static symbols @@ -187,33 +168,10 @@ ;;; can be loaded directly out of them by indirecting relative to NIL. ;;; (defparameter *static-symbols* - '(t - - ;; The C startup code must fill these in. - *posix-argv* - ;;lisp::lisp-environment-list - ;;lisp::lisp-command-line-list - sb!impl::*!initial-fdefn-objects* - - ;; Functions that the C code needs to call - maybe-gc - sb!kernel::internal-error - sb!di::handle-breakpoint - sb!di::handle-fun-end-breakpoint - - ;; free Pointers - *read-only-space-free-pointer* - *static-space-free-pointer* - *initial-dynamic-space-free-pointer* - - ;; things needed for non-local exit - *current-catch-block* - *current-unwind-protect-block* - - ;; interrupt handling - *free-interrupt-context-index* - sb!unix::*interrupts-enabled* - sb!unix::*interrupt-pending*)) + (append + *common-static-symbols* + *c-callable-static-symbols* + '())) (defparameter *static-funs* '(length @@ -225,15 +183,17 @@ sb!kernel:two-arg-> sb!kernel:two-arg-= ;; FIXME: Is this - ;; probably need the following as they are defined in - ;; arith.lisp: two-arg-<= two-arg->= two-arg-/= + ;; probably need the following as they are defined in + ;; arith.lisp: two-arg-<= two-arg->= two-arg-/= ;; a comment from old CMU CL or old old CMU CL or ;; the SBCL alpha port or what? Do we need to worry about it, ;; or can we delete it? + sb!kernel:two-arg-/= eql sb!kernel:%negate sb!kernel:two-arg-and sb!kernel:two-arg-ior sb!kernel:two-arg-xor + sb!kernel:two-arg-eqv sb!kernel:two-arg-gcd sb!kernel:two-arg-lcm))