Ignore:
Timestamp:
Jan 6, 2004, 1:52:30 AM (16 years ago)
Author:
gb
Message:

Back in the ARCH package, but there's a lot less stuff here.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/compiler/arch.lisp

    r189 r195  
    1 ;;;-*- Mode: Lisp; Package: (PPC32 :use CL) -*-
     1;;;-*- Mode: Lisp; Package: (ARCH :use CL) -*-
    22;;;
    33;;;   Copyright (C) 1994-2001 Digitool, Inc
     
    1414;;;   The LLGPL is also available online at
    1515;;;   http://opensource.franz.com/preamble.html
    16 (defpackage "PPC32"
    17   (:nicknames "ARCH32" "ARCH" "PPC")
     16
     17(defpackage "ARCH"
    1818  (:use "CL"))
    1919
    20 (in-package "PPC32")
     20(in-package "ARCH")
    2121
    2222
    2323
    24 ;; PPC-32 stuff and tags.
    2524(eval-when (:compile-toplevel :load-toplevel :execute)
    2625
    2726
    2827
    29 
    30 
    31 
    32 
    33 
    34 
    35 ; The objects themselves look something like this:
    36 
    37 
    38 
    39 
    40  
    41 
    42 
    4328(defconstant tcr-flag-bit-foreign 0)
    4429(defconstant tcr-flag-bit-awaiting-preset 1)
    45 
    46 
    47 
    48 
    49 
    50 
    51 
    5230
    5331
     
    5836  `(logior ,subtag (ash ,element-count 8)))
    5937
    60 (defmacro ppc-fixnum (val)
    61   `(ash ,val fixnum-shift))
    62 
    63 (defmacro unbox-ppc-fixnum (f)
    64   `(ash ,f (- fixnum-shift)))
    65 
    66 
    67 ; Kernel globals are allocated "below" nil.  This list (used to map symbolic names to
    68 ; rnil-relative offsets) must (of course) exactly match the kernel's notion of where
    69 ; things are.
    70 ; The order here matches "ccl:pmcl;lisp_globals.h" & the lisp_globals record
    71 ; in "ccl:pmcl;constants.s"
    72 (defparameter *ppc-kernel-globals*
    73   '(get-tcr                             ; callback to obtain (real) tcr
    74     tcr-count
    75     interrupt-signal                    ; used by PROCESS-INTERRUPT
    76     kernel-imports                      ; some things we need to have imported for us.
    77     tcr-lock
    78     emulator-registers                  ; Where the 68K registers are kept.
    79     appmain                             ; application's (c-runtime) main() function
    80     subprims-base                       ; start of dynamic subprims jump table
    81     ret1valaddr                         ; magic multiple-values return address.
    82     tcr-key                             ; tsd key for thread's tcr
    83     gc-lock                             ; serialize access to gc
    84     exception-lock                      ; serialize exception handling
    85     go-tag-counter                      ; counter for (immediate) go tag
    86     block-tag-counter                   ; counter for (immediate) block tag
    87     intflag                             ; interrupt-pending flag
    88     gc-inhibit-count                    ; for gc locking
    89     os-trap-call                        ; callostrapunivesalproc's descriptor
    90     tb-trap-call                        ; CallUniversalProc's descriptor
    91     qd-globals                          ; (untagged) pointer to QD globals.
    92     fwdnum                              ; fixnum: GC "forwarder" call count.
    93     gc-count                            ; fixnum: GC call count.
    94     gcable-pointers                     ; linked-list of weak macptrs.
    95     heap-start                          ; start of lisp heap
    96     heap-end                            ; end of lisp heap
    97     bad-current-cs                      ; current control-stack area
    98     bad-current-vs                      ; current value-stack area
    99     bad-current-ts                      ; current temp-stack area
    100     bad-cs-overflow-limit               ; limit for control-stack overflow check
    101     all-areas                           ; doubly-linked area list
    102     lexpr-return                        ; multiple-value lexpr return address
    103     lexpr-return1v                      ; single-value lexpr return address
    104     in-gc                               ; non-zero when GC-ish thing active
    105     metering-info                       ; kernel metering structure
    106     doh-head                            ; creole
    107     short-float-zero                    ; low half of 1.0d0
    108     double-float-one                    ; high half of 1.0d0
    109     ffi-exception                       ; ffi fpscr[fex] bit
    110     exception-saved-registers           ; saved registers from exception frame
    111     oldest-ephemeral                    ; doubleword address of oldest ephemeral object or 0
    112     tenured-area                        ; the tenured_area.
    113     errno                               ; address of C lib errno
    114     argv                                ; address of C lib argv
    115     host-platform                       ; 0 on MacOS, 1 on PPC Linux, 2 on VxWorks ...
    116     batch-flag                          ; non-zero if --batch specified
    117     fpscr-save                          ; lisp's fpscr when in FFI-land
    118     fpscr-save-high                     ; high word of FP reg used to save FPSCR
    119     image-name                          ; current image name
    120     initial-tcr                         ; initial thread's context record
    121     ))
    122 
    123 (defun %kernel-global (sym)
    124   (let* ((pos (position sym *ppc-kernel-globals* :test #'string=)))
    125     (if pos
    126       (- (+ fulltag-nil (* (1+ pos) 4)))
    127       (error "Unknown kernel global : ~s ." sym))))
    128 
    129 (defmacro kernel-global (sym)
    130   (let* ((pos (position sym *ppc-kernel-globals* :test #'string=)))
    131     (if pos
    132       (- (+ fulltag-nil (* (1+ pos) 4)))
    133       (error "Unknown kernel global : ~s ." sym))))
    134 
    135 
    136 ; The kernel imports things that are defined in various other libraries for us.
    137 ; The objects in question are generally fixnum-tagged; the entries in the
    138 ; "kernel-imports" vector are 4 bytes apart.
    139 (ccl::defenum (:prefix "KERNEL-IMPORT-" :start 0 :step 4)
    140   fd-setsize-bytes
    141   do-fd-set
    142   do-fd-clr
    143   do-fd-is-set
    144   do-fd-zero
    145   MakeDataExecutable
    146   GetSharedLibrary
    147   FindSymbol
    148   malloc
    149   free
    150   allocate_tstack
    151   allocate_vstack
    152   register_cstack
    153   condemn-area
    154   metering-control
    155   restore-soft-stack-limit
    156   egc-control
    157   lisp-bug
    158   NewThread
    159   YieldToThread
    160   DisposeThread
    161   ThreadCurrentStackSpace
    162   usage-exit
    163   save-fp-context
    164   restore-fp-context
    165   put-altivec-registers
    166   get-altivec-registers
    167   new-semaphore
    168   wait-on-semaphore
    169   signal-semaphore
    170   destroy-semaphore
    171   new-recursive-lock
    172   lock-recursive-lock
    173   unlock-recursive-lock
    174   destroy-recursive-lock
    175   suspend-other-threads
    176   resume-other-threads
    177   suspend-tcr
    178   resume-tcr
    179   rwlock-new
    180   rwlock-destroy
    181   rwlock-rlock
    182   rwlock-wlock
    183   rwlock-unlock
    184   recursive-lock-trylock
    185   foreign-name-and-offset
    186 )
    187 
    188 (defmacro define-header (name element-count subtag)
    189   `(defconstant ,name (logior (ash ,element-count num-subtag-bits) ,subtag)))
    190 
    191 (define-header single-float-header single-float.element-count subtag-single-float)
    192 (define-header double-float-header double-float.element-count subtag-double-float)
    193 (define-header one-digit-bignum-header 1 subtag-bignum)
    194 (define-header two-digit-bignum-header 2 subtag-bignum)
    195 (define-header symbol-header symbol.element-count subtag-symbol)
    196 (define-header value-cell-header value-cell.element-count subtag-value-cell)
    197 (define-header macptr-header macptr.element-count subtag-macptr)
    19838
    19939
     
    263103  )
    264104
    265 ; The order here matches "ccl:pmcl;lisp_globals.h" and the nrs record
    266 ; in "ccl:pmcl;constants.s".
    267 (defparameter *ppc-nilreg-relative-symbols*
    268   '(t
    269     nil
    270     ccl::%err-disp
    271     ccl::cmain
    272     eval
    273     ccl::apply-evaluated-function
    274     error   
    275     ccl::%defun
    276     ccl::%defvar
    277     ccl::%defconstant
    278     ccl::%macro
    279     ccl::%kernel-restart
    280     *package*
    281     ccl::*total-bytes-freed*
    282     :allow-other-keys   
    283     ccl::%toplevel-catch%
    284     ccl::%toplevel-function%
    285     ccl::%pascal-functions%   
    286     ccl::*all-metered-functions*
    287     ccl::*total-gc-microseconds*
    288     ccl::%builtin-functions%
    289     ccl::%unbound-function%
    290     ccl::%init-misc
    291     ccl::%macro-code%
    292     ccl::%closure-code%
    293     ccl::%new-gcable-ptr
    294     ccl::*gc-event-status-bits*
    295     ccl::*post-gc-hook*
    296     ccl::%handlers%
    297     ccl::%all-packages%
    298     ccl::*keyword-package*
    299     ccl::%finalization-alist%
    300     ccl::%foreign-thread-control
    301     ))
    302105
    303 (defmacro nrs-offset (name)
    304   (let* ((pos (position name *ppc-nilreg-relative-symbols* :test #'eq)))
    305     (if pos (+ t-offset (* pos symbol.size)))))
     106
     107
    306108
    307109(defun builtin-function-name-offset (name)
     
    368170(defconstant operand-fake 28)
    369171
    370 (defconstant reservation-discharge #x1004)
    371172
    372173(ccl::provide "ARCH")
Note: See TracChangeset for help on using the changeset viewer.