| 1 | ;;;-*- Mode: Lisp; Package: (X86 :use CL) -*-
|
|---|
| 2 | ;;;
|
|---|
| 3 | ;;; Copyright (C) 2005 Clozure Associates and contributors.
|
|---|
| 4 | ;;; This file is part of OpenMCL.
|
|---|
| 5 | ;;;
|
|---|
| 6 | ;;; OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
|
|---|
| 7 | ;;; License , known as the LLGPL and distributed with OpenMCL as the
|
|---|
| 8 | ;;; file "LICENSE". The LLGPL consists of a preamble and the LGPL,
|
|---|
| 9 | ;;; which is distributed with OpenMCL as the file "LGPL". Where these
|
|---|
| 10 | ;;; conflict, the preamble takes precedence.
|
|---|
| 11 | ;;;
|
|---|
| 12 | ;;; OpenMCL is referenced in the preamble as the "LIBRARY."
|
|---|
| 13 | ;;;
|
|---|
| 14 | ;;; The LLGPL is also available online at
|
|---|
| 15 | ;;; http://opensource.franz.com/preamble.html
|
|---|
| 16 |
|
|---|
| 17 | (defpackage "X86"
|
|---|
| 18 | (:use "CL"))
|
|---|
| 19 |
|
|---|
| 20 | (in-package "X86")
|
|---|
| 21 |
|
|---|
| 22 | (require "ARCH")
|
|---|
| 23 |
|
|---|
| 24 | ;;; Kernel globals are allocated "below" nil. This list (used to map
|
|---|
| 25 | ;;; symbolic names to rnil-relative offsets) must (of course) exactly
|
|---|
| 26 | ;;; match the kernel's notion of where things are.
|
|---|
| 27 | ;;; The order here matches "ccl:lisp-kernel;lisp_globals.h" & the
|
|---|
| 28 | ;;; lisp_globals record in "ccl:lisp-kernel;constants.s"
|
|---|
| 29 | (defparameter *x86-kernel-globals*
|
|---|
| 30 | '(get-tcr ; callback to obtain (real) tcr
|
|---|
| 31 | tcr-count
|
|---|
| 32 | interrupt-signal ; used by PROCESS-INTERRUPT
|
|---|
| 33 | kernel-imports ; some things we need to have imported for us.
|
|---|
| 34 | objc-2-personality
|
|---|
| 35 | emulator-registers ; Where the 68K registers are kept.
|
|---|
| 36 | appmain ; application's (c-runtime) main() function
|
|---|
| 37 | subprims-base ; start of dynamic subprims jump table
|
|---|
| 38 | ret1valaddr ; magic multiple-values return address.
|
|---|
| 39 | tcr-key ; tsd key for thread's tcr
|
|---|
| 40 | area-lock ; serialize access to gc
|
|---|
| 41 | exception-lock ; serialize exception handling
|
|---|
| 42 | deleted-static-pairs ; hash-consing
|
|---|
| 43 | default-allocation-quantum ; log2_heap_segment_size, as a fixnum.
|
|---|
| 44 | intflag ; interrupt-pending flag
|
|---|
| 45 | gc-inhibit-count ; for gc locking
|
|---|
| 46 | refbits ; oldspace refbits
|
|---|
| 47 | oldspace-dnode-count ; number of dnodes in dynamic space that are older than
|
|---|
| 48 | ; youngest generation
|
|---|
| 49 | altivec-present ; non-zero if cpu supports AltiVec
|
|---|
| 50 | fwdnum ; fixnum: GC "forwarder" call count.
|
|---|
| 51 | gc-count ; fixnum: GC call count.
|
|---|
| 52 | gcable-pointers ; linked-list of weak macptrs.
|
|---|
| 53 | heap-start ; start of lisp heap
|
|---|
| 54 | heap-end ; end of lisp heap
|
|---|
| 55 | statically-linked ; true if the lisp kernel is statically linked
|
|---|
| 56 | stack-size ; value of --stack-size arg
|
|---|
| 57 | objc-2-begin-catch ; objc_begin_catch
|
|---|
| 58 | bad-funcall ; pseudo-target for funcall
|
|---|
| 59 | all-areas ; doubly-linked area list
|
|---|
| 60 | lexpr-return ; multiple-value lexpr return address
|
|---|
| 61 | lexpr-return1v ; single-value lexpr return address
|
|---|
| 62 | in-gc ; non-zero when GC-ish thing active
|
|---|
| 63 | metering-info ; kernel metering structure
|
|---|
| 64 | objc-2-end-catch ; _objc_end_catch
|
|---|
| 65 | short-float-zero ; low half of 1.0d0
|
|---|
| 66 | double-float-one ; high half of 1.0d0
|
|---|
| 67 | ffi-exception ; ffi fpscr[fex] bit
|
|---|
| 68 | exception-saved-registers ; saved registers from exception frame
|
|---|
| 69 | oldest-ephemeral ; doublenode address of oldest ephemeral object or 0
|
|---|
| 70 | tenured-area ; the tenured_area.
|
|---|
| 71 | errno ; address of C lib errno
|
|---|
| 72 | argv ; address of C lib argv
|
|---|
| 73 | host-platform ; 0 on MacOS, 1 on PPC Linux, 2 on VxWorks ...
|
|---|
| 74 | batch-flag ; non-zero if --batch specified
|
|---|
| 75 | unwind-resume ; _Unwind_Resume
|
|---|
| 76 | BAD-fpscr-save-high ; high word of FP reg used to save FPSCR
|
|---|
| 77 | image-name ; current image name
|
|---|
| 78 | initial-tcr ; initial thread's context record
|
|---|
| 79 | ))
|
|---|
| 80 |
|
|---|
| 81 | ;;; The order here matches "ccl:lisp-kernel;lisp_globals.h" and the nrs record
|
|---|
| 82 | ;;; in "ccl:lisp-kernel;constants.s".
|
|---|
| 83 | (defparameter *x86-nil-relative-symbols*
|
|---|
| 84 | '(t
|
|---|
| 85 | nil
|
|---|
| 86 | ccl::%err-disp
|
|---|
| 87 | ccl::cmain
|
|---|
| 88 | eval
|
|---|
| 89 | ccl::apply-evaluated-function
|
|---|
| 90 | error
|
|---|
| 91 | ccl::%defun
|
|---|
| 92 | ccl::%defvar
|
|---|
| 93 | ccl::%defconstant
|
|---|
| 94 | ccl::%macro
|
|---|
| 95 | ccl::%kernel-restart
|
|---|
| 96 | *package*
|
|---|
| 97 | ccl::*total-bytes-freed*
|
|---|
| 98 | :allow-other-keys
|
|---|
| 99 | ccl::%toplevel-catch%
|
|---|
| 100 | ccl::%toplevel-function%
|
|---|
| 101 | ccl::%pascal-functions%
|
|---|
| 102 | ccl::*all-metered-functions*
|
|---|
| 103 | ccl::*total-gc-microseconds*
|
|---|
| 104 | ccl::%builtin-functions%
|
|---|
| 105 | ccl::%unbound-function%
|
|---|
| 106 | ccl::%init-misc
|
|---|
| 107 | ccl::%macro-code%
|
|---|
| 108 | ccl::%closure-code%
|
|---|
| 109 | ccl::%new-gcable-ptr
|
|---|
| 110 | ccl::*gc-event-status-bits*
|
|---|
| 111 | ccl::*post-gc-hook*
|
|---|
| 112 | ccl::%handlers%
|
|---|
| 113 | ccl::%all-packages%
|
|---|
| 114 | ccl::*keyword-package*
|
|---|
| 115 | ccl::%finalization-alist%
|
|---|
| 116 | ccl::%foreign-thread-control
|
|---|
| 117 | ))
|
|---|
| 118 |
|
|---|
| 119 | ;;; Old (and slightly confusing) name; NIL used to be in a register.
|
|---|
| 120 | (defparameter *x86-nilreg-relative-symbols* *x86-nil-relative-symbols*)
|
|---|
| 121 |
|
|---|
| 122 |
|
|---|
| 123 | ;;; mxcsr bits. (Unlike the convention used on the PPC, bit 0 is the
|
|---|
| 124 | ;;; least significant bit of the containing byte/word.)
|
|---|
| 125 |
|
|---|
| 126 | (ccl::defenum (:prefix "MXCSR-" :suffix "-BIT")
|
|---|
| 127 | ie ;invalid exception
|
|---|
| 128 | de ;denormal exception
|
|---|
| 129 | ze ;divide-by-zero exception
|
|---|
| 130 | oe ;overflow exception
|
|---|
| 131 | ue ;underflow exception
|
|---|
| 132 | pe ;precision exception
|
|---|
| 133 | daz ;denorms-are-zeros (not-IEEE)
|
|---|
| 134 | im ;invalid masked
|
|---|
| 135 | dm ;denormals masked
|
|---|
| 136 | zm ;divide-by-zero masked
|
|---|
| 137 | om ;overflow masked
|
|---|
| 138 | um ;underflow masked
|
|---|
| 139 | pm ;precision masked
|
|---|
| 140 | rc0 ;rounding control bit 0
|
|---|
| 141 | rc1 ;rounding control bit 1
|
|---|
| 142 | fz ;flush-to-zero (not-IEEE)
|
|---|
| 143 | )
|
|---|
| 144 |
|
|---|
| 145 | (defconstant mxcsr-status-mask
|
|---|
| 146 | (logior (ash 1 mxcsr-ie-bit)
|
|---|
| 147 | (ash 1 mxcsr-de-bit)
|
|---|
| 148 | (ash 1 mxcsr-ze-bit)
|
|---|
| 149 | (ash 1 mxcsr-oe-bit)
|
|---|
| 150 | (ash 1 mxcsr-ue-bit)
|
|---|
| 151 | (ash 1 mxcsr-pe-bit)))
|
|---|
| 152 |
|
|---|
| 153 | (defconstant mxcsr-control-and-rounding-mask
|
|---|
| 154 | (logior (ash 1 mxcsr-im-bit)
|
|---|
| 155 | (ash 1 mxcsr-dm-bit)
|
|---|
| 156 | (ash 1 mxcsr-zm-bit)
|
|---|
| 157 | (ash 1 mxcsr-om-bit)
|
|---|
| 158 | (ash 1 mxcsr-um-bit)
|
|---|
| 159 | (ash 1 mxcsr-pm-bit)
|
|---|
| 160 | (ash 1 mxcsr-rc0-bit)
|
|---|
| 161 | (ash 1 mxcsr-rc1-bit)))
|
|---|
| 162 |
|
|---|
| 163 | ;;; There's a fairly hairy method of determining which MXCSR bits are
|
|---|
| 164 | ;;; available on a given proccessor version. In practice, the bits
|
|---|
| 165 | ;;; that might not be supported are bits that select non-IEE754-compliant
|
|---|
| 166 | ;;; behavior (DenormsAreZeros and FlushtoZerop), and we don't really
|
|---|
| 167 | ;;; want to activate either of those things, anyway.
|
|---|
| 168 |
|
|---|
| 169 | (defconstant mxcsr-write-mask (lognot (logior (ash 1 mxcsr-daz-bit)
|
|---|
| 170 | (ash 1 mxcsr-fz-bit))))
|
|---|
| 171 |
|
|---|
| 172 |
|
|---|
| 173 |
|
|---|
| 174 | ;;; Condition bitfields, used in jcc, cmovcc, setcc.
|
|---|
| 175 | (defconstant x86-o-bits #x0)
|
|---|
| 176 | (defconstant x86-no-bit #x1)
|
|---|
| 177 | (defconstant x86-b-bits #x2)
|
|---|
| 178 | (defconstant x86-ae-bits #x3)
|
|---|
| 179 | (defconstant x86-e-bits #x4)
|
|---|
| 180 | (defconstant x86-ne-bits #x5)
|
|---|
| 181 | (defconstant x86-be-bits #x6)
|
|---|
| 182 | (defconstant x86-a-bits #x7)
|
|---|
| 183 | (defconstant x86-s-bits #x8)
|
|---|
| 184 | (defconstant x86-ns-bits #x9)
|
|---|
| 185 | (defconstant x86-pe-bits #xa)
|
|---|
| 186 | (defconstant x86-po-bits #xb)
|
|---|
| 187 | (defconstant x86-l-bits #xc)
|
|---|
| 188 | (defconstant x86-ge-bits #xd)
|
|---|
| 189 | (defconstant x86-le-bits #xe)
|
|---|
| 190 | (defconstant x86-g-bits #xf)
|
|---|
| 191 |
|
|---|
| 192 | ;;; Bits in the xFLAGS register
|
|---|
| 193 | (defconstant x86-carry-flag-bit 0)
|
|---|
| 194 | (defconstant x86-parity-flag-bit 2)
|
|---|
| 195 | (defconstant x86-aux-carry-flag-bit 4)
|
|---|
| 196 | (defconstant x86-zero-flag-bit 6)
|
|---|
| 197 | (defconstant x86-sign-flag-bit 7)
|
|---|
| 198 | (defconstant x86-direction-flag-bit 10)
|
|---|
| 199 | (defconstant x86-overflow-flag-bit 11)
|
|---|
| 200 |
|
|---|
| 201 |
|
|---|
| 202 | (provide "X86-ARCH")
|
|---|
