~ubuntu-branches/ubuntu/intrepid/ecl/intrepid

« back to all changes in this revision

Viewing changes to src/cmp/cmpffi.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Peter Van Eynde
  • Date: 2006-06-21 09:21:21 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20060621092121-txz1f21lj0wh0f67
Tags: 0.9h-20060617-1
* New upstream version
* Updated standards version without real changes. 

Show diffs side-by-side

added added

removed removed

Lines of Context:
209
209
           ((:char :unsigned-char)
210
210
            (wt "CODE_CHAR(" loc ")"))
211
211
           ((:cstring)
212
 
            (wt "ecl_cstring_to_string_or_nil(" loc ")"))
 
212
            (wt "ecl_cstring_to_base_string_or_nil(" loc ")"))
213
213
           ((:pointer-void)
214
214
            (wt "ecl_make_foreign_data(Cnil, 0, " loc ")"))
215
215
           (otherwise
228
228
        ((:char*)
229
229
         (case loc-rep-type
230
230
           ((:object)
231
 
            (wt "ecl_string_pointer_safe(" loc ")"))
 
231
            (wt "ecl_base_string_pointer_safe(" loc ")"))
232
232
           ((:pointer-void)
233
233
            (wt "(char *)(" loc ")"))
234
234
           (otherwise
275
275
      (cond ((eq output-type ':void)
276
276
             (setf output-rep-type '()
277
277
                   output-type 'NIL))
 
278
            ((equal output-type '(VALUES &REST t))
 
279
             (setf output-rep-type '(VALUES &REST t)))
278
280
            ((and (consp output-type) (eql (first output-type) 'VALUES))
279
281
             (when one-liner
280
282
               (cmpwarn "A FFI:C-INLINE form cannot be :ONE-LINER and output more than one value: ~A"
325
327
    (when (null output-rep-type)
326
328
      (if side-effects
327
329
          (progn
 
330
            (wt-nl)
328
331
            (wt-c-inline-loc output-rep-type c-expression coerced-arguments t nil)
329
 
            (wt ";"))
 
332
            (when one-liner (wt ";")))
330
333
          (cmpwarn "Ignoring form ~S" c-expression))
331
334
      (return-from produce-inline-loc NIL))
332
335
 
336
339
      (return-from produce-inline-loc
337
340
        `(C-INLINE ,output-rep-type ,c-expression ,coerced-arguments ,side-effects NIL)))
338
341
 
 
342
    ;; If the output is a in the VALUES vector, just write down the form and output
 
343
    ;; the location of the data.
 
344
    (when (equalp output-rep-type '(VALUES &REST T))
 
345
      (wt-c-inline-loc output-rep-type c-expression coerced-arguments side-effects 'VALUES)
 
346
      (return-from produce-inline-loc 'VALUES))
 
347
 
339
348
    ;; Otherwise we have to set up variables for holding the output.
340
349
    (flet ((make-output-var (type)
341
350
             (let ((var (make-lcl-var :rep-type type)))
405
414
        (#\@
406
415
         (let ((object (read s)))
407
416
           (cond ((and (consp object) (equal (first object) 'RETURN))
408
 
                  (let ((ndx (or (second object) 0))
409
 
                        (l (length output-vars)))
410
 
                    (if (< ndx l)
411
 
                        (wt (nth ndx output-vars))
412
 
                        (cmperr "Used @(RETURN ~D) in a C-INLINE form with ~D output values"
413
 
                                ndx l))))
 
417
                  (if (eq output-vars 'VALUES)
 
418
                      (cmperr "User @(RETURN ...) in a C-INLINE form with no output values")
 
419
                      (let ((ndx (or (second object) 0))
 
420
                            (l (length output-vars)))
 
421
                        (if (< ndx l)
 
422
                            (wt (nth ndx output-vars))
 
423
                          (cmperr "Used @(RETURN ~D) in a C-INLINE form with ~D output values"
 
424
                                  ndx l)))))
414
425
                 (t
415
426
                  (when (and (consp object) (eq (first object) 'QUOTE))
416
427
                    (setq object (second object)))