source: branches/qres/ccl/lib/ffi-darwinppc64.lisp @ 14259

Last change on this file since 14259 was 13070, checked in by gz, 10 years ago

r13066, r13067 from trunk: copyrights etc

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 29.0 KB
Line 
1;;;-*- Mode: Lisp; Package: CCL -*-
2;;;
3;;;   Copyright (C) 2007-2009 Clozure Associates and contributors
4;;;   This file is part of Clozure CL. 
5;;;
6;;;   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
7;;;   License , known as the LLGPL and distributed with Clozure CL as the
8;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9;;;   which is distributed with Clozure CL as the file "LGPL".  Where these
10;;;   conflict, the preamble takes precedence. 
11;;;
12;;;   Clozure CL 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
19;;; On DarwinPPC64:
20;;; Structures whose size is exactly 16 bytes are passed in 2 GPRs,
21;;; regardless of the types of their elements, when they are passed
22;;; by value.
23;;; Structures which contain unions are passed in N GPRs when passed
24;;; by value.
25;;; All other structures passed by value are passed by passing their
26;;; constituent elements as scalars.  (Sort of.)  GPR's are "consumed"
27;;; for and possibly/partly loaded with the contents of each 64-bit
28;;; word; FPRs (and vector registers) are consumed/loaded for each
29;;; field of the indicated type.
30;;; Structures whose size is exactly 16 bytes are returned in GPR3
31;;; and GPR4.
32;;; Structures which contain unions are "returned" by passing a pointer
33;;; to a structure instance in the first argument.
34;;; All other structures are returned by returning their constituent
35;;; elements as scalars.  (Note that - in some cases - we may need
36;;; to reserve space in the foreign stack frame to handle scalar
37;;; return values that don't fit in registers.  Need a way to tell
38;;; %ff-call about this, as well as runtime support.)
39
40
41(defun darwin64::record-type-contains-union (rtype)
42  ;;; RTYPE is a FOREIGN-RECORD-TYPE object.
43  ;;; If it, any of its fields, or any fields in an
44  ;;; embedded structure or array field is a union,
45  ;;; return true.
46  ;;; (If this function returns true, we can't
47  ;;; pass a structure of type RTYPE - or return one -
48  ;;; by passing or returning the values of all of
49  ;;; its fields, since some fields are aliased.
50  ;;; However, if the record's size is exactly 128
51  ;;; bits, we can pass/return  it in two GPRs.)
52  (ensure-foreign-type-bits rtype)
53  (or (eq (foreign-record-type-kind rtype) :union)
54      (dolist (f (foreign-record-type-fields rtype))
55        (let* ((fieldtype (foreign-record-field-type f)))
56          (if (and (typep fieldtype 'foreign-record-type)
57                   (darwin64::record-type-contains-union fieldtype))
58            (return t))
59          (if (typep fieldtype 'foreign-array-type)
60            (let* ((atype (foreign-array-type-element-type fieldtype)))
61              (if (and (typep atype 'foreign-record-type)
62                       (darwin64::record-type-contains-union atype))
63                (return t))))))))
64
65;;; On DarwinPPC64, we only have to pass a structure as a first
66;;; argument if the type contains a union
67(defun darwin64::record-type-returns-structure-as-first-arg (rtype)
68  (when (and rtype
69             (not (typep rtype 'unsigned-byte))
70             (not (member rtype *foreign-representation-type-keywords*
71                          :test #'eq)))
72    (let* ((ftype (if (typep rtype 'foreign-type)
73                    rtype
74                    (parse-foreign-type rtype))))
75      (and (typep ftype 'foreign-record-type)
76           (not (= (ensure-foreign-type-bits ftype) 128))
77           (darwin64::record-type-contains-union ftype)))))
78
79
80
81
82
83;;; Generate code to set the fields in a structure R of record-type
84;;; RTYPE, based on the register values in REGBUF (8 64-bit GPRs,
85;;; followed by 13 64-bit GPRs.)
86;;; This also handles the 16-byte structure case.
87;;; (It doesn't yet handle embedded arrays or bitfields.)
88(defun darwin64::struct-from-regbuf-values (r rtype regbuf)
89  (let* ((bits (ccl::ensure-foreign-type-bits rtype)))
90    (collect ((forms))
91      (cond ((= bits 128)               ;(and (eql day 'tuesday) ...)
92             (forms `(setf (ccl::%get-signed-long ,r 0)
93                      (ccl::%get-signed-long ,regbuf 0)
94                      (ccl::%get-signed-long ,r 4)
95                      (ccl::%get-signed-long ,regbuf 4)
96                      (ccl::%get-signed-long ,r 8)
97                      (ccl::%get-signed-long ,regbuf 8)
98                      (ccl::%get-signed-long ,r 12)
99                      (ccl::%get-signed-long ,regbuf 12))))
100            ;;; One (slightly naive) way to do this is to just
101            ;;; copy GPRs into the structure until it's full,
102            ;;; then go back and overwrite float-typed fields
103            ;;; with FPRs.  That'd be very naive if all fields
104            ;;; were float-typed, slightly naive if some fields
105            ;;; were properly-aligned DOUBLE-FLOATs or if two
106            ;;; SINGLE-FLOATs were packed inro a 64-bit word,
107            ;;; and not that bad if a SINGLE-FLOAT shared a
108            ;;; 64-bit word with a non-FP field.
109            (t
110             (let* ((fpr-offset (* 8 8))
111                    (fields (foreign-record-type-fields rtype)))
112               (flet ((next-fpr-offset ()
113                        (prog1 fpr-offset
114                          (incf fpr-offset 8))))
115                 (unless (all-floats-in-field-list fields)
116                   (do* ((b 0 (+ b 32))
117                         (w 0 (+ w 4)))
118                        ((>= b bits))
119                     (declare (fixnum b w))
120                     (forms `(setf (%get-unsigned-long ,r ,w)
121                              (%get-unsigned-long ,regbuf ,w)))))
122                 (when (some-floats-in-field-list fields)
123                   (labels ((do-fp-fields (fields accessors)
124                              (dolist (field fields)
125                                (let* ((field-type (foreign-record-field-type field))
126                                       (field-accessor-list (append accessors (list (foreign-record-field-name field))))
127                                       (valform ()))
128                                  (etypecase field-type
129                                    (foreign-record-type
130                                     (do-fp-fields (foreign-record-type-fields field-type)
131                                       field-accessor-list))
132                                    (foreign-double-float-type
133                                     (setq valform
134                                           `(%get-double-float  ,regbuf ,(next-fpr-offset))))
135                                    (foreign-single-float-type
136                                     (setq valform
137                                           `(%get-single-float-from-double-ptr
138                                             ,regbuf ,(next-fpr-offset))))
139                                    (foreign-array-type
140                                     (error "Embedded array-type."))
141                                    )
142                                  (when valform
143                                    (forms `(setf ,(%foreign-access-form
144                                                    r
145                                                    rtype
146                                                    0
147                                                    field-accessor-list)
148                                             ,valform)))))))
149                     (do-fp-fields (foreign-record-type-fields rtype) nil )))))))
150      `(progn ,@(forms) nil))))
151
152;;; "Return" the structure R of foreign type RTYPE, by storing the
153;;; values of its fields in STACK-PTR and FP-ARG-PTR
154(defun darwin64::return-struct-to-registers (r rtype stack-ptr fp-args-ptr)
155  (let* ((bits (require-foreign-type-bits rtype)))
156    (collect ((forms))
157      (cond ((= bits 128)               ;(and (eql day 'tuesday) ...)
158             (forms `(setf (ccl::%get-unsigned-long ,stack-ptr 0)
159                      (ccl::%get-unsigned-long ,r 0)
160                      (ccl::%get-unsigned-long ,stack-ptr 4)
161                      (ccl::%get-unsigned-long ,r 4)
162                      (ccl::%get-unsigned-long ,stack-ptr 8)
163                      (ccl::%get-unsigned-long ,r 8)
164                      (ccl::%get-unsigned-long ,stack-ptr 12)
165                      (ccl::%get-unsigned-long ,r 12))))
166            (t
167             (let* ((fpr-offset 0)
168                    (fields (foreign-record-type-fields rtype)))
169               (unless (all-floats-in-field-list fields)
170                   (do* ((b 0 (+ b 32))
171                         (w 0 (+ w 4)))
172                        ((>= b bits))
173                     (declare (fixnum b w))
174                     (forms `(setf (%get-unsigned-long ,stack-ptr ,w)
175                              (%get-unsigned-long ,r ,w)))))
176               (when (some-floats-in-field-list fields)
177               (flet ((next-fpr-offset ()
178                        (prog1 fpr-offset
179                          (incf fpr-offset 8))))
180                 (labels ((do-fp-fields (fields accessors)
181                            (dolist (field fields)
182                              (let* ((field-type (foreign-record-field-type field))
183                                     (field-accessor-list (append accessors (list (foreign-record-field-name field))))
184                                     (valform ()))
185                                (etypecase field-type
186                                  (foreign-record-type
187                                   (do-fp-fields (foreign-record-type-fields field-type)
188                                     field-accessor-list))
189                                  (foreign-double-float-type
190                                   (setq valform
191                                         `(%get-double-float  ,fp-args-ptr ,(next-fpr-offset))))
192                                  (foreign-single-float-type
193                                   (setq valform
194                                         `(%get-double-float  ,fp-args-ptr ,(next-fpr-offset))))
195
196                                  (foreign-array-type
197                                   (error "Embedded array-type."))
198                                  )
199                                (when valform
200                                  (let* ((field-form (%foreign-access-form
201                                                      r
202                                                      rtype
203                                                      0
204                                                      field-accessor-list)))
205                                    (when (typep field-type 'foreign-single-float-type)
206                                      (setq field-form `(float ,field-form 0.0d0)))
207                                    (forms `(setf ,valform ,field-form))))))))
208                   (do-fp-fields fields nil )))))))
209      `(progn ,@(forms) nil))))
210
211;;; Return an ordered list of all scalar fields in the record type FTYPE.
212(defun darwin64::flatten-fields (ftype)
213  (if (darwin64::record-type-contains-union ftype)
214    (error "Can't flatten fields in ~s: contains union" ftype))
215  (collect ((fields))
216    (labels ((flatten (field-list bit-offset)
217               (dolist (field field-list)
218                 (let* ((field-type (foreign-record-field-type field))
219                        (next-offset (+ bit-offset (foreign-record-field-offset field))))
220                   (typecase field-type
221                     (foreign-record-type
222                      (flatten (foreign-record-type-fields field-type) next-offset))
223                     (foreign-array-type
224                      (let* ((element-type (foreign-array-type-element-type field-type))
225                             (nbits (foreign-type-bits element-type))
226                             (align (foreign-type-alignment  element-type))
227                             (dims (foreign-array-type-dimensions field-type))
228                             (n (or (and (null (cdr dims)) (car dims))
229                                    (error "Can't handle multidimensional foreign arrays")))
230                             (pos next-offset))
231                        (dotimes (i n)
232                          (fields (make-foreign-record-field :type element-type
233                                                             :bits nbits
234                                                             :offset pos))
235                          (setq pos (align-offset (+ pos nbits) align)))))
236                     (t
237                      (fields (make-foreign-record-field :type field-type
238                                                         :bits (foreign-record-field-bits field)
239                                                         :offset next-offset))))))))
240      (flatten (foreign-record-type-fields ftype) 0)
241      (fields))))
242
243               
244             
245
246(defun darwin64::expand-ff-call (callform args &key (arg-coerce #'null-coerce-foreign-arg) (result-coerce #'null-coerce-foreign-result))
247  (let* ((result-type-spec (or (car (last args)) :void))
248         (regbuf nil)
249         (result-temp nil)
250         (result-form nil)
251         (struct-result-type nil)
252         (structure-arg-temp nil))
253    (multiple-value-bind (result-type error)
254        (ignore-errors (parse-foreign-type result-type-spec))
255      (if error
256        (setq result-type-spec :void result-type *void-foreign-type*)
257        (setq args (butlast args)))
258      (collect ((argforms))
259        (when (eq (car args) :monitor-exception-ports)
260          (argforms (pop args)))
261        (when (typep result-type 'foreign-record-type)
262          (setq result-form (pop args)
263                struct-result-type result-type
264                result-type *void-foreign-type*
265                result-type-spec :void)
266          (if (darwin64::record-type-returns-structure-as-first-arg struct-result-type)
267            (progn
268              (argforms :address)
269              (argforms result-form))
270            (progn
271              (setq regbuf (gensym)
272                    result-temp (gensym))
273              (argforms :registers)
274              (argforms regbuf))))
275        (let* ((valform nil))
276          (unless (evenp (length args))
277            (error "~s should be an even-length list of alternating foreign types and values" args))
278          (do* ((args args (cddr args)))
279               ((null args))
280            (let* ((arg-type-spec (car args))
281                   (arg-value-form (cadr args)))
282              (if (or (member arg-type-spec *foreign-representation-type-keywords*
283                              :test #'eq)
284                      (typep arg-type-spec 'unsigned-byte))
285                (progn
286                  (argforms arg-type-spec)
287                  (argforms arg-value-form))
288                (let* ((ftype (parse-foreign-type arg-type-spec))
289                       (bits (foreign-type-bits ftype)))
290                  (if (typep ftype 'foreign-record-type)
291                    (if (or (darwin64::record-type-contains-union ftype)
292                            (= bits 128))
293                      (progn
294                        (argforms (ceiling (foreign-record-type-bits ftype) 64))
295                        (argforms arg-value-form))
296                      (let* ((flattened-fields (darwin64::flatten-fields ftype)))
297
298                        (flet ((single-float-at-offset (offset)
299                                 (dolist (field flattened-fields)
300                                   (let* ((field-offset (foreign-record-field-offset field)))
301                                     (when (> field-offset offset)
302                                       (return nil))
303                                     (if (and (= field-offset offset)
304                                              (typep (foreign-record-field-type field)
305                                                     'foreign-single-float-type))
306                                       (return t)))))
307                               (double-float-at-offset (offset)
308                                 (dolist (field flattened-fields)
309                                   (let* ((field-offset (foreign-record-field-offset field)))
310                                     (when (> field-offset offset)
311                                       (return nil))
312                                     (if (and (= field-offset offset)
313                                              (typep (foreign-record-field-type field)
314                                                     'foreign-double-float-type))
315                                       (return t))))))
316                        (unless structure-arg-temp
317                          (setq structure-arg-temp (gensym)))
318                        (setq valform `(%setf-macptr ,structure-arg-temp ,arg-value-form))
319                        (do* ((bit-offset 0 (+ bit-offset 64))
320                              (byte-offset 0 (+ byte-offset 8)))
321                             ((>= bit-offset bits))
322                          (if (double-float-at-offset bit-offset)
323                            (progn
324                              (argforms :double-float)
325                              (argforms `(%get-double-float ,valform ,byte-offset)))
326                            (let* ((high-single (single-float-at-offset bit-offset))
327                                   (low-single (single-float-at-offset (+ bit-offset 32))))
328                              (if high-single
329                                (if low-single
330                                  (argforms :hybrid-float-float)
331                                  (argforms :hybrid-float-int))
332                                (if low-single
333                                  (argforms :hybrid-int-float)
334                                  (argforms :unsigned-doubleword)))
335                              (argforms `(%%get-unsigned-longlong ,valform ,byte-offset))))
336                          (setq valform structure-arg-temp)))))
337                    (progn
338                      (argforms (foreign-type-to-representation-type ftype))
339                      (argforms (funcall arg-coerce arg-type-spec arg-value-form))))))))
340          (argforms (foreign-type-to-representation-type result-type))
341          (let* ((call (funcall result-coerce result-type-spec `(,@callform ,@(argforms)))))
342            (when structure-arg-temp
343              (setq call `(let* ((,structure-arg-temp (%null-ptr)))
344                           (declare (dynamic-extent ,structure-arg-temp)
345                                    (type macptr ,structure-arg-temp))
346                           ,call)))
347            (if regbuf
348              `(let* ((,result-temp (%null-ptr)))
349                (declare (dynamic-extent ,result-temp)
350                         (type macptr ,result-temp))
351                (%setf-macptr ,result-temp ,result-form)
352                (%stack-block ((,regbuf (+ (* 8 8) (* 8 13))))
353                  ,call
354                  ,(darwin64::struct-from-regbuf-values result-temp struct-result-type regbuf)))
355              call)))))))
356           
357           
358;;; Return 7 values:
359;;; A list of RLET bindings
360;;; A list of LET* bindings
361;;; A list of DYNAMIC-EXTENT declarations for the LET* bindings
362;;; A list of initializaton forms for (some) structure args
363;;; A FOREIGN-TYPE representing the "actual" return type.
364;;; A form which can be used to initialize FP-ARGS-PTR, relative
365;;;  to STACK-PTR.  (This is unused on linuxppc32.)
366;;; The byte offset of the foreign return address, relative to STACK-PTR
367
368(defun darwin64::generate-callback-bindings (stack-ptr fp-args-ptr argvars argspecs result-spec struct-result-name)
369  (collect ((lets)
370            (rlets)
371            (inits)
372            (dynamic-extent-names))
373    (let* ((rtype (parse-foreign-type result-spec))
374           (fp-regs-form nil))
375      (flet ((set-fp-regs-form ()
376               (unless fp-regs-form
377                 (setq fp-regs-form `(%get-ptr ,stack-ptr ,(- ppc64::c-frame.unused-1 ppc64::c-frame.param0))))))
378        (when (typep rtype 'foreign-record-type)
379          (if (darwin64::record-type-contains-union rtype)
380            (setq argvars (cons struct-result-name argvars)
381                  argspecs (cons :address argspecs)
382                  rtype *void-foreign-type*)
383            (rlets (list struct-result-name (or (foreign-record-type-name rtype)
384                                                result-spec)))))
385        (when (typep rtype 'foreign-float-type)
386          (set-fp-regs-form))
387        (do* ((argvars argvars (cdr argvars))
388              (argspecs argspecs (cdr argspecs))
389              (fp-arg-num 0)
390              (offset 0)
391              (delta 0)
392              (bias 0)
393              (use-fp-args nil nil))
394             ((null argvars)
395              (values (rlets) (lets) (dynamic-extent-names) (inits) rtype fp-regs-form (- ppc64::c-frame.savelr ppc64::c-frame.param0)))
396          (flet ((next-scalar-arg (argtype)
397                   (setq delta 8 bias 0)
398                   (prog1
399                       `(,(cond
400                           ((typep argtype 'foreign-single-float-type)
401                            (if (< (incf fp-arg-num) 14)
402                              (progn
403                                (setq use-fp-args t)
404                                '%get-single-float-from-double-ptr)
405                              (progn
406                                '%get-single-float)))
407                           ((typep argtype 'foreign-double-float-type)
408                            (if (< (incf fp-arg-num) 14)
409                              (setq use-fp-args t))
410                            '%get-double-float)
411                           ((and (typep argtype 'foreign-integer-type)
412                                 (= (foreign-integer-type-bits argtype) 64)
413                                 (foreign-integer-type-signed argtype))
414                            (setq delta 8)
415                            '%%get-signed-longlong)
416                           ((and (typep argtype 'foreign-integer-type)
417                                 (= (foreign-integer-type-bits argtype) 64)
418                                 (not (foreign-integer-type-signed argtype)))
419                            (setq delta 8)
420                            '%%get-unsigned-longlong)
421                           ((or (typep argtype 'foreign-pointer-type)
422                                (typep argtype 'foreign-array-type))
423                            '%get-ptr)
424                           (t
425                            (cond ((typep argtype 'foreign-integer-type)
426                                   (let* ((bits (foreign-integer-type-bits argtype))
427                                          (signed (foreign-integer-type-signed argtype)))
428                                     (cond ((<= bits 8)
429                                            (setq bias 7)
430                                            (if signed
431                                              '%get-signed-byte '
432                                              '%get-unsigned-byte))
433                                           ((<= bits 16)
434                                            (setq bias 6)
435                                            (if signed
436                                              '%get-signed-word 
437                                              '%get-unsigned-word))
438                                           ((<= bits 32)
439                                            (setq bias 4)
440                                            (if signed
441                                              '%get-signed-long 
442                                              '%get-unsigned-long))
443                                           (t
444                                            (error "Don't know how to access foreign argument of type ~s" (unparse-foreign-type argtype))))))
445                                  (t
446                                   (error "Don't know how to access foreign argument of type ~s" (unparse-foreign-type argtype))))))
447                         ,(if use-fp-args fp-args-ptr stack-ptr)
448                         ,(if use-fp-args (* 8 (1- fp-arg-num))
449                              (+ offset bias)))
450                     (incf offset delta))))
451            (let* ((name (car argvars))
452                   (spec (car argspecs))
453                   (argtype (parse-foreign-type spec))
454                   (bits (foreign-type-bits argtype)))
455              (if (typep argtype 'foreign-record-type)
456                (if (or (darwin64::record-type-contains-union argtype)
457                        (= bits 128))
458                  (progn (setq delta (* (ceiling bits 64) 8))
459                         (when name (lets (list name `(%inc-ptr ,stack-ptr ,offset ))))
460                         (incf offset delta))
461
462                  (let* ((flattened-fields (darwin64::flatten-fields argtype)))
463                    (flet ((double-float-at-offset (offset)
464                             (dolist (field flattened-fields)
465                               (let* ((field-offset (foreign-record-field-offset field)))
466                                 (when (> field-offset offset) (return))
467                                 (if (and (= field-offset offset)
468                                          (typep (foreign-record-field-type field)
469                                                 'foreign-double-float-type))
470                                   (return t)))))
471                           (single-float-at-offset (offset)
472                             (dolist (field flattened-fields)
473                               (let* ((field-offset (foreign-record-field-offset field)))
474                                 (when (> field-offset offset) (return))
475                                 (if (and (= field-offset offset)
476                                          (typep (foreign-record-field-type field)
477                                                 'foreign-single-float-type))
478                                   (return t))))))
479                      (when name (rlets (list name (or (foreign-record-type-name argtype)
480                                            spec))))
481                      (do* ((bit-offset 0 (+ bit-offset 64))
482                            (byte-offset 0 (+ byte-offset 8)))
483                           ((>= bit-offset bits))
484                        (if (double-float-at-offset bit-offset)
485                          (let* ((init `(setf (%get-double-float ,name ,byte-offset)
486                                   ,(next-scalar-arg (parse-foreign-type :double-float)))))
487                            (when name
488                              (inits init)))
489                          (let* ((high-single (single-float-at-offset bit-offset))
490                                 (low-single (single-float-at-offset (+ bit-offset 32)))
491                                 (init `(setf (%%get-unsigned-longlong ,name ,byte-offset)
492                                     ,(next-scalar-arg (parse-foreign-type '(:unsigned 64))))))
493                            (when name (inits init))
494                            (when high-single
495                              (when (< (incf fp-arg-num) 14)
496                                (set-fp-regs-form)
497                                (when name
498                                  (inits `(setf (%get-single-float ,name ,byte-offset)
499                                         (%get-single-float-from-double-ptr
500                                          ,fp-args-ptr
501                                          ,(* 8 (1- fp-arg-num))))))))
502                            (when low-single
503                              (when (< (incf fp-arg-num) 14)
504                                (set-fp-regs-form)
505                                (when name
506                                  (inits `(setf (%get-single-float ,name ,(+ 4 byte-offset))
507                                         (%get-single-float-from-double-ptr
508                                          ,fp-args-ptr
509                                          ,(* 8 (1- fp-arg-num))))))))))))))
510                (let* ((form (next-scalar-arg argtype)))
511                  (when name 
512                    (lets (list name form)))))
513              #+nil
514              (when (or (typep argtype 'foreign-pointer-type)
515                        (typep argtype 'foreign-array-type))
516                (dynamic-extent-names name))
517              (when use-fp-args (set-fp-regs-form)))))))))
518
519(defun darwin64::generate-callback-return-value (stack-ptr fp-args-ptr result return-type struct-return-arg)
520  (unless (eq return-type *void-foreign-type*)
521    (when (typep return-type 'foreign-single-float-type)
522      (setq result `(float ,result 0.0d0)))   
523    (if (typep return-type 'foreign-record-type)
524      ;;; Would have been mapped to :VOID unless record-type contained
525      ;;; a single scalar field.
526      (darwin64::return-struct-to-registers struct-return-arg return-type stack-ptr fp-args-ptr)
527      (let* ((return-type-keyword (foreign-type-to-representation-type return-type))
528           (result-ptr (case return-type-keyword
529                   ((:single-float :double-float)
530                    fp-args-ptr)
531                   (t stack-ptr))))
532      `(setf (,
533              (case return-type-keyword
534                                 (:address '%get-ptr)
535                                 (:signed-doubleword '%%get-signed-longlong)
536                                 (:unsigned-doubleword '%%get-unsigned-longlong)
537                                 ((:double-float :single-float)
538                                  '%get-double-float)
539                                 (:unsigned-fullword '%get-unsigned-long)
540                                 (t '%%get-signed-longlong )
541                                 ) ,result-ptr 0) ,result)))))
542
543
Note: See TracBrowser for help on using the repository browser.