source: trunk/ccl/compiler/X86/X8664/x8664-backend.lisp @ 5876

Last change on this file since 5876 was 5876, checked in by gb, 14 years ago

Fix some typos; do struct return 32 bits at a time, to avoid consing
little bignums.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 25.0 KB
Line 
1;;;-*- Mode: Lisp; Package: CCL -*-
2;;;
3;;;   Copyright (C) 2005 Clozure Associates
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(in-package "CCL")
18(eval-when (:compile-toplevel :load-toplevel :execute)
19  (require "BACKEND"))
20
21(eval-when (:compile-toplevel :execute)
22  (require "NXENV")
23  (require "X8664ENV"))
24
25
26(defvar *x8664-vinsn-templates* (make-hash-table :test #'eq))
27
28
29
30(defvar *known-x8664-backends* ())
31
32
33#+(or linuxx86-target (not x86-target))
34(defvar *linuxx8664-backend*
35  (make-backend :lookup-opcode 'lookup-x86-opcode
36                :lookup-macro #'false
37                :lap-opcodes x86::*x8664-opcode-templates*
38                :define-vinsn 'define-x86-vinsn
39                :platform-syscall-mask (logior platform-os-linux platform-cpu-x86 platform-word-size-64) 
40                :p2-dispatch *x862-specials*
41                :p2-vinsn-templates *x8664-vinsn-templates*
42                :p2-template-hash-name '*x8664-vinsn-templates*
43                :p2-compile 'x862-compile
44                :target-specific-features
45                '(:x8664 :x86-target :linux-target :linuxx86-target :x8664-target
46                  :linuxx8664-target
47                  :little-endian-target
48                  :64-bit-target)
49                :target-fasl-pathname (make-pathname :type "lx64fsl")
50                :target-platform (logior platform-cpu-x86
51                                         platform-os-linux
52                                         platform-word-size-64)
53                :target-os :linuxx86
54                :name :linuxx8664
55                :target-arch-name :x8664
56                :target-foreign-type-data nil
57
58
59                :target-arch x8664::*x8664-target-arch*
60                :lisp-context-register x8664::gs
61                ))
62
63
64#+darwinx86-target
65(defvar *darwinx8664-backend*
66  (make-backend :lookup-opcode 'lookup-x86-opcode
67                :lookup-macro #'false
68                :lap-opcodes x86::*x8664-opcode-templates*
69                :define-vinsn 'define-x86-vinsn
70                :p2-dispatch *x862-specials*
71                :p2-vinsn-templates *x8664-vinsn-templates*
72                :p2-template-hash-name '*x8664-vinsn-templates*
73                :p2-compile 'x862-compile
74                :platform-syscall-mask (logior platform-os-darwin platform-cpu-x86 platform-word-size-64) 
75                :target-specific-features
76                '(:x8664 :x86-target :darwin-target :darwinx86-target :x8664-target
77                  :darwinx8664-target
78                  :little-endian-target
79                  :64-bit-target)
80                :target-fasl-pathname (make-pathname :type "dx64fsl")
81                :target-platform (logior platform-cpu-x86
82                                         platform-os-darwin
83                                         platform-word-size-64)
84                :target-os :darwinx86
85                :name :darwinx8664
86                :target-arch-name :x8664
87                :target-foreign-type-data nil
88                :target-arch x8664::*x8664-target-arch*
89                ;; Overload %gs until Apple straightens things out.
90                :lisp-context-register x8664::gs
91                ))
92
93#+freebsdx86-target
94(defvar *freebsdx8664-backend*
95  (make-backend :lookup-opcode 'lookup-x86-opcode
96                :lookup-macro #'false
97                :lap-opcodes x86::*x8664-opcode-templates*
98                :define-vinsn 'define-x86-vinsn
99                :p2-dispatch *x862-specials*
100                :p2-vinsn-templates *x8664-vinsn-templates*
101                :p2-template-hash-name '*x8664-vinsn-templates*
102                :p2-compile 'x862-compile
103                :target-specific-features
104                '(:x8664 :x86-target :freebsd-target :freebsdx86-target :x8664-target
105                  :freebsdx8664-target                 
106                  :little-endian-target
107                  :64-bit-target)
108                :target-fasl-pathname (make-pathname :type "fx64fsl")
109                :target-platform (logior platform-cpu-x86
110                                         platform-os-freebsd
111                                         platform-word-size-64)
112                :target-os :freebsdx86
113                :name :freebsdx8664
114                :target-arch-name :x8664
115                :target-foreign-type-data nil
116                :target-arch x8664::*x8664-target-arch*
117                :platform-syscall-mask (logior platform-os-freebsd platform-cpu-x86 platform-word-size-64)
118                :lisp-context-register x8664::gs
119                ))
120
121#+(or linuxx86-target (not x86-target))
122(pushnew *linuxx8664-backend* *known-x8664-backends* :key #'backend-name)
123
124
125#+darwinx86-target
126(pushnew *darwinx8664-backend* *known-x8664-backends* :key #'backend-name)
127
128#+freebsdx86-target
129(pushnew *freebsdx8664-backend* *known-x8664-backends* :key #'backend-name)
130
131(defvar *x8664-backend* (car *known-x8664-backends*))
132
133(defun fixup-x8664-backend ()
134  (dolist (b *known-x8664-backends*)
135    (setf #| (backend-lap-opcodes b) x86::*x86-opcodes* |#
136          (backend-p2-dispatch b) *x862-specials*
137          (backend-p2-vinsn-templates b)  *x8664-vinsn-templates*)
138    (or (backend-lap-macros b) (setf (backend-lap-macros b)
139                                     (make-hash-table :test #'equalp)))))
140
141
142
143(fixup-x8664-backend)
144
145#+x8664-target
146(setq *host-backend* *x8664-backend* *target-backend* *x8664-backend*)
147
148(defun setup-x8664-ftd (backend)
149  (or (backend-target-foreign-type-data backend)
150      (let* ((name (backend-name backend))
151             (ftd
152              (case name
153                (:linuxx8664
154                 (make-ftd :interface-db-directory "ccl:x86-headers64;"
155                           :interface-package-name "X86-LINUX64"
156                           :attributes '(:bits-per-word  64
157                                         :struct-by-value t)
158                           :ff-call-expand-function
159                           (intern "EXPAND-FF-CALL" "X86-LINUX64")
160                           :ff-call-struct-return-by-implicit-arg-function
161                           (intern "RECORD-TYPE-RETURNS-STRUCTURE-AS-FIRST-ARG"
162                                   "X86-LINUX64")
163                           :callback-bindings-function
164                           (intern "GENERATE-CALLBACK-BINDINGS" "X86-LINUX64")
165                           :callback-return-value-function
166                           (intern "GENERATE-CALLBACK-RETURN-VALUE" "X86-LINUX64")))
167                (:darwinx8664
168                 (make-ftd :interface-db-directory "ccl:darwin-x86-headers64;"
169                           :interface-package-name "X86-DARWIN64"
170                           :attributes '(:bits-per-word  64
171                                         :signed-char t
172                                         :struct-by-value t
173                                         :prepend-underscore t)
174                           :ff-call-expand-function
175                           (intern "EXPAND-FF-CALL" "X86-DARWIN64")
176                           :ff-call-struct-return-by-implicit-arg-function
177                           (intern "RECORD-TYPE-RETURNS-STRUCTURE-AS-FIRST-ARG"
178                                   "X86-DARWIN64")
179                           :callback-bindings-function
180                           (intern "GENERATE-CALLBACK-BINDINGS" "X86-DARWIN64")
181                           :callback-return-value-function
182                           (intern "GENERATE-CALLBACK-RETURN-VALUE" "X86-DARWIN64")))
183                (:freebsdx8664
184                 (make-ftd :interface-db-directory "ccl:freebsd-headers64;"
185                           :interface-package-name "X86-FREEBSD64"
186                           :attributes '(:bits-per-word  64
187                                         :struct-by-value t)
188                           :ff-call-expand-function
189                           (intern "EXPAND-FF-CALL" "X86-FREEBSD64")
190                           :ff-call-struct-return-by-implicit-arg-function
191                           (intern "RECORD-TYPE-RETURNS-STRUCTURE-AS-FIRST-ARG"
192                                   "X86-FREEBSD64")
193                           :callback-bindings-function
194                           (intern "GENERATE-CALLBACK-BINDINGS" "X86-FREEBS64")
195                           :callback-return-value-function
196                           (intern "GENERATE-CALLBACK-RETURN-VALUE" "X86-FREEBSD64"))))))
197        (install-standard-foreign-types ftd)
198        (use-interface-dir :libc ftd)
199        (setf (backend-target-foreign-type-data backend) ftd))))
200
201#-x8664-target
202(setup-x8664-ftd *x8664-backend*)
203
204(pushnew *x8664-backend* *known-backends* :key #'backend-name)
205
206;;; FFI stuff.  Seems to be shared by Darwin/Linux/FreeBSD.
207
208;;; A returned structure is passed as an invisible first argument if
209;;; it's more than 2 doublewords long or if it contains unaligned fields.
210;;; Not clear how the latter case can happen, so this just checks for
211;;; the first.
212(defun x8664::record-type-returns-structure-as-first-arg (rtype)
213  (when (and rtype
214             (not (typep rtype 'unsigned-byte))
215             (not (member rtype *foreign-representation-type-keywords*
216                          :test #'eq)))
217    (let* ((ftype (if (typep rtype 'foreign-type)
218                    rtype
219                    (parse-foreign-type rtype))))
220      (> (ensure-foreign-type-bits ftype) 128))))
221
222;;; On x8664, structures can be passed by value:
223;;;  a) in memory, if they're more than 128 bits in size or if there aren't
224;;;     enough of the right kind of register to pass them entirely in registers.
225;;;  b) as a series of 64-bit chunks, passed in GPRs if any component of the
226;;;     chunk is a non FLOAT or in FPRs otherwise.
227;;; Note that this means that a chunk consisting of two SINGLE-FLOATs would
228;;; be passed in the low 64 bit of an SSE (xmm) register.
229
230(defun x8664::field-is-of-class-integer (field)
231  ;; Return true if field is of "class" integer or if it's a record
232  ;; type of class integer.  (See the System V AMD64 ABI document for
233  ;; a convoluted definition of field "classes".)
234  (let* ((ftype (foreign-record-field-type field)))
235    (typecase ftype
236      ((or foreign-integer-type foreign-pointer-type) t)
237      (foreign-record-type (dolist (f (foreign-record-type-fields ftype))
238                             (when (x8664::field-is-of-class-integer f)
239                               (return t))))
240      (otherwise nil))))
241
242(defun x8664::classify-8byte (field-list bit-limit)
243  ;; CDR down the fields in FIELD-LIST until we find a field of class integer,
244  ;; hit the end of the list, or find a field whose offset is >= BIT-LIMIT.
245  ;; In the first case, return :INTEGER.  In other cases, return :FLOAT.
246  (dolist (field field-list :float)
247    (if (<= bit-limit (foreign-record-field-offset field))
248      (return :float)
249      (if (x8664::field-is-of-class-integer field)
250        (return :integer)))))
251
252;;; Return a first value :memory, :integer, or::float and a second
253;;; value of NIL, :integer, or :float according to how the structure
254;;; RTYPE should ideally be passed or returned.  Note that the caller
255;;; may decide to turn this to :memory if there aren't enough
256;;; available registers of the right class when passing an instance of
257;;; this structure type.
258(defun x8664::classify-record-type (rtype)
259  (let* ((nbits (ensure-foreign-type-bits rtype))
260         (fields (foreign-record-type-fields rtype)))
261    (cond ((> nbits 128) (values :memory nil))
262          ((<= nbits 64) (values (x8664::classify-8byte fields 64) nil))
263          (t (values (x8664::classify-8byte fields 64)
264               (do* ()
265                    ((>= (foreign-record-field-offset (car fields)) 64)
266                     (x8664::classify-8byte fields 128))
267                 (setq fields (cdr fields))))))))
268
269(defun x8664::struct-from-regbuf-values (r rtype regbuf)
270  (multiple-value-bind (first second)
271      (x8664::classify-record-type rtype)
272    (let* ((gpr-offset 0)
273           (fpr-offset 16))
274      ;; Do this 32 bits at a time, to avoid consing.
275      (collect ((forms))
276        (case first
277          (:integer (forms `(setf (%get-unsigned-long ,r 0)
278                             (%get-unsigned-long ,regbuf 0)))
279                    (forms `(setf (%get-unsigned-long ,r 4)
280                             (%get-unsigned-long ,regbuf 4)))
281                    (setq gpr-offset 8))
282          (:float (forms `(setf (%get-unsigned-long ,r 0)
283                             (%get-unsigned-long ,regbuf 16)))
284                  (forms `(setf (%get-unsigned-long ,r 4)
285                             (%get-unsigned-long ,regbuf 20)))
286                  (setf fpr-offset 24)))
287        (case second
288          (:integer (forms `(setf (%get-unsigned-long ,r 8)
289                             (%get-unsigned-long ,regbuf ,gpr-offset)))
290                    (forms `(setf (%get-unsigned-long ,r 12)
291                             (%get-unsigned-long ,regbuf ,(+ gpr-offset 4)))))
292          (:float (forms `(setf (%get-unsigned-long ,r 8)
293                             (%get-unsigned-long ,regbuf ,fpr-offset)))
294                  (forms `(setf (%get-unsigned-long ,r 12)
295                             (%get-unsigned-long ,regbuf ,(+ fpr-offset 4))))))
296        `(progn ,@(forms))))))
297
298(defun x8664::expand-ff-call (callform args &key (arg-coerce #'null-coerce-foreign-arg) (result-coerce #'null-coerce-foreign-result))
299  (let* ((result-type-spec (or (car (last args)) :void))
300         (regbuf nil)
301         (result-temp nil)
302         (result-form nil)
303         (struct-result-type nil)
304         (structure-arg-temp nil))
305    (multiple-value-bind (result-type error)
306        (ignore-errors (parse-foreign-type result-type-spec))
307      (if error
308        (setq result-type-spec :void result-type *void-foreign-type*)
309        (setq args (butlast args)))
310      (collect ((argforms))
311        (when (eq (car args) :monitor-exception-ports)
312          (argforms (pop args)))
313        (when (typep result-type 'foreign-record-type)
314          (setq result-form (pop args)
315                struct-result-type result-type
316                result-type *void-foreign-type*
317                result-type-spec :void)
318          (if (x8664::record-type-returns-structure-as-first-arg struct-result-type)
319            (progn
320              (argforms :address)
321              (argforms result-form))
322            (progn
323              (setq regbuf (gensym)
324                    result-temp (gensym))
325              (argforms :registers)
326              (argforms regbuf))))
327        (let* ((valform nil))
328                      (unless (evenp (length args))
329              (error "~s should be an even-length list of alternating foreign types and values" args))
330            (do* ((args args (cddr args))
331                  (remaining-gprs 6)
332                  (remaining-fprs 8))
333                 ((null args))
334              (let* ((arg-type-spec (car args))
335                     (arg-value-form (cadr args)))
336                (if (or (member arg-type-spec *foreign-representation-type-keywords*
337                                :test #'eq)
338                        (typep arg-type-spec 'unsigned-byte))
339                  (progn
340                    (argforms arg-type-spec)
341                    (argforms arg-value-form))
342                  (let* ((ftype (parse-foreign-type arg-type-spec)))
343                    (if (typep ftype 'foreign-record-type)
344                      (multiple-value-bind (first8 second8)
345                          (x8664::classify-record-type ftype)
346                        (let* ((gprs remaining-gprs)
347                               (fprs remaining-fprs))
348                          (case first8
349                            (:integer (if (< (decf gprs) 0) (setq first8 :memory)))
350                            (:float (if (< (decf fprs) 0) (setq first8 :memory))))
351                          (case second8
352                            (:integer (if (< (decf gprs) 0) (setq first8 :memory)))
353                            (:float (if (< (decf fprs) 0) (setq first8 :memory)))))
354                        (if (eq first8 :memory)
355                          (progn
356                            (argforms (ceiling (foreign-record-type-bits ftype) 64))
357                            (argforms arg-value-form))
358                          (progn
359                            (if second8
360                              (progn
361                                (unless structure-arg-temp
362                                  (setq structure-arg-temp (gensym)))
363                                (setq valform `(%setf-macptr ,structure-arg-temp ,arg-value-form)))
364                              (setq valform arg-value-form))
365                            (if (eq first8 :float)
366                              (progn
367                                (decf remaining-fprs)
368                                (argforms :double-float)
369                                (argforms `(%get-double-float ,valform 0)))
370                              (progn
371                                (decf remaining-gprs)
372                                (argforms :unsigned-doubleword)
373                                (argforms `(%%get-unsigned-longlong ,valform 0))))
374                            (when second8
375                              (if (eq second8 :float)
376                                (progn
377                                (decf remaining-fprs)
378                                (argforms :double-float)
379                                (argforms `(%get-double-float ,valform 8)))
380                              (progn
381                                (decf remaining-gprs)
382                                (argforms :unsigned-doubleword)
383                                (argforms `(%%get-unsigned-longlong ,valform 8))))))))
384                      (let* ((rtype (foreign-type-to-representation-type ftype)))
385                        (if (or (eq rtype :singlefloat) (eq rtype :double-float))
386                          (decf remaining-fprs)
387                          (decf remaining-gprs))
388                        (argforms rtype)
389                        (argforms (funcall arg-coerce arg-type-spec arg-value-form))))))))
390            (argforms (foreign-type-to-representation-type result-type))
391            (let* ((call (funcall result-coerce result-type-spec `(,@callform ,@(argforms)))))
392              (when structure-arg-temp
393                (setq call `(let* ((,structure-arg-temp (%null-ptr)))
394                             (declare (dynamic-extent ,structure-arg-temp)
395                                      (type macptr ,structure-arg-temp))
396                             ,call)))
397              (if regbuf
398                `(let* ((,result-temp (%null-ptr)))
399                  (declare (dynamic-extent ,result-temp)
400                           (type macptr ,result-temp))
401                  (%setf-macptr ,result-temp ,result-form)
402                  (%stack-block ((,regbuf (+ (* 2 8) (* 2 8))))
403                    ,call
404                    ,(x8664::struct-from-regbuf-values result-temp struct-result-type regbuf)))
405                call)))))))
406
407
408;;; Return 7 values:
409;;; A list of RLET bindings
410;;; A list of LET* bindings
411;;; A list of DYNAMIC-EXTENT declarations for the LET* bindings
412;;; A list of initializaton forms for (some) structure args
413;;; A FOREIGN-TYPE representing the "actual" return type.
414;;; A form which can be used to initialize FP-ARGS-PTR, relative
415;;;  to STACK-PTR.  (This is unused on linuxppc32.)
416;;; The byte offset of the foreign return address, relative to STACK-PTR
417
418(defun x8664::generate-callback-bindings (stack-ptr fp-args-ptr argvars argspecs result-spec struct-result-name)
419  (declare (ignore fp-args-ptr))
420  (collect ((lets)
421            (rlets)
422            (inits)
423            (dynamic-extent-names))
424    (let* ((rtype (parse-foreign-type result-spec)))
425      (when (typep rtype 'foreign-record-type)
426        (if (x8664::record-type-returns-structure-as-first-arg rtype)
427          (setq argvars (cons struct-result-name argvars)
428                argspecs (cons :address argspecs)
429                rtype *void-foreign-type*)
430          (rlets (list struct-result-name (foreign-record-type-name rtype)))))
431      (do* ((argvars argvars (cdr argvars))
432            (argspecs argspecs (cdr argspecs))
433            (gpr-arg-num 0)
434            (gpr-arg-offset -8)
435            (fpr-arg-num 0)
436            (fpr-arg-offset -56)
437            (memory-arg-offset 16)
438            (fp nil nil))
439           ((null argvars)
440            (values (rlets) (lets) (dynamic-extent-names) (inits) rtype nil 8))
441        (flet ((next-gpr ()
442                 (if (<= (incf gpr-arg-num) 6)
443                   (prog1
444                       gpr-arg-offset
445                     (decf gpr-arg-offset 8))
446                   (prog1
447                       memory-arg-offset
448                     (incf memory-arg-offset 8))))
449               (next-fpr ()
450                 (if (<= (incf fpr-arg-num) 8)
451                   (prog1
452                       fpr-arg-offset
453                     (decf fpr-arg-offset 8))
454                   (prog1
455                       memory-arg-offset
456                     (incf memory-arg-offset 8)))))
457          (let* ((name (car argvars))
458                 (spec (car argspecs))
459                 (argtype (parse-foreign-type spec))
460                 (bits (require-foreign-type-bits argtype)))
461            (if (typep argtype 'foreign-record-type)
462              (multiple-value-bind (first8 second8)
463                  (x8664::classify-record-type argtype)
464                (let* ((gprs (- 6 gpr-arg-num))
465                       (fprs (- 8 fpr-arg-num)))
466                  (case first8
467                    (:integer (if (< (decf gprs) 0) (setq first8 :memory)))
468                    (:float (if (< (decf fprs) 0) (setq first8 :memory))))
469                  (case second8
470                    (:integer (if (< (decf gprs) 0) (setq first8 :memory)))
471                    (:float (if (< (decf fprs) 0) (setq first8 :memory)))))
472                (if (eq first8 :memory)
473                  (progn
474                    (lets (list name `(%inc-ptr ,stack-ptr ,(prog1 memory-arg-offset
475                                                                   (incf memory-arg-offset (* 8 (ceiling bits 64)))))))
476                         (dynamic-extent-names name))
477                  (progn
478                    (rlets (list name (foreign-record-type-name argtype)))
479                    (inits `(setf (%%get-unsigned-longlong ,name 0)
480                             (%%get-unsigned-longlong ,stack-ptr ,(if (eq first8 :integer) (next-gpr) (next-fpr)))))
481                    (if second8
482                      (inits `(setf (%%get-unsigned-longlong ,name 8)
483                             (%%get-unsigned-longlong ,stack-ptr ,(if (eq second8 :integer) (next-gpr) (next-fpr)))))))))
484                (lets (list name
485                            `(,
486                             (ecase (foreign-type-to-representation-type argtype)
487                               (:single-float (setq fp t) '%get-single-float)
488                               (:double-float (setq fp t) '%get-double-float)
489                               (:signed-doubleword  '%%get-signed-longlong)
490                               (:signed-fullword '%get-signed-long)
491                               (:signed-halfword '%get-signed-word)
492                               (:signed-byte '%get-signed-byte)
493                               (:unsigned-doubleword '%%get-unsigned-longlong)
494                               (:unsigned-fullword '%get-unsigned-long)
495                               (:unsigned-halfword '%get-unsigned-word)
496                               (:unsigned-byte '%get-unsigned-byte)
497                               (:address
498                                (dynamic-extent-names name)
499                                '%get-ptr))
500                             ,stack-ptr
501                             ,(if fp (next-fpr) (next-gpr))))))))))))
502
503(defun x8664::generate-callback-return-value (stack-ptr fp-args-ptr result return-type struct-return-arg)
504  (declare (ignore fp-args-ptr))
505  (unless (eq return-type *void-foreign-type*)
506    (let* ((gpr-offset -8)
507           (fpr-offset -24))
508      (if (typep return-type 'foreign-record-type)
509      ;;; Would have been mapped to :VOID unless record-type was <= 128 bits.
510        (collect ((forms))
511          (multiple-value-bind (first8 second8)
512              (x8664::classify-record-type return-type)
513            (forms `(setf (%%get-signed-longlong ,stack-ptr ,(if (eq first8 :integer) gpr-offset fpr-offset))
514                     (%%get-signed-longlong ,struct-return-arg 0)))
515            (when second8
516              (if (eq first8 :integer) (decf gpr-offset 8) (decf fpr-offset 8))
517              (forms `(setf (%%get-signed-longlong ,stack-ptr ,(if (eq first8 :integer) gpr-offset fpr-offset))
518                       (%%get-signed-longlong ,struct-return-arg 8))))
519            `(progn ,@(forms))))
520        (let* ((return-type-keyword (foreign-type-to-representation-type return-type))
521               (offset (case return-type-keyword
522                         ((:single-float :double-float) fpr-offset)
523                         (t gpr-offset))))
524          `(setf (,
525                  (case return-type-keyword
526                    (:address '%get-ptr)
527                    (:signed-doubleword '%%get-signed-longlong)
528                    (:unsigned-doubleword '%%get-unsigned-longlong)
529                    ((:double-float :single-float)
530                     '%get-double-float)
531                    (:unsigned-fullword '%get-unsigned-long)
532                    (t '%%get-signed-longlong )
533                    ) ,stack-ptr ,offset) ,result))))))
534
535
536
537#+x8664-target
538(require "X8664-VINSNS")
539
540(provide "X8664-BACKEND")
Note: See TracBrowser for help on using the repository browser.