home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / sources.lha / sources / comp / back_end / unvaxgen.t < prev    next >
Encoding:
Text File  |  1988-02-05  |  1.8 KB  |  41 lines
  1. (herald unvaxgen)
  2.                              
  3. ;;; we can do unsafe things here once we set the foreign call cont
  4.  
  5. (define (generate-foreign-call node)
  6.   (destructure (((#f foreign rep-list value-rep . args) (call-args node)))
  7.     (emit vax/movl SP (reg-offset TASK task/foreign-call-cont))
  8.     (emit vax/movl TASK (reg-offset nil-reg slink/current-task))
  9.     (iterate loop ((args (reverse args)) 
  10.                    (reps (map cadr (leaf-value rep-list)))
  11.                    (count 0))
  12.       (cond ((null? args)
  13.              (walk (lambda (node) (kill (leaf-value node))) args)
  14.              (let ((reg (->register 'pointer node (leaf-value foreign) '*)))
  15.                (emit vax/movl (reg-offset reg 6) reg)
  16.                (emit vax/calls (machine-num count) (reg-offset reg 0))))
  17.              ((eq? (car reps) 'rep/double) 
  18.               (->register 'scratch node (leaf-value (car args)) S0) 
  19.               (generate-push (reg-offset S0 6))
  20.               (generate-push (reg-offset S0 2))
  21.               (loop (cdr args) (cdr reps) (fx+ count 2)))
  22.              (else
  23.               (rep-push node (leaf-value (car args)) (car reps))
  24.               (loop (cdr args) (cdr reps) (fx+ count 1)))))
  25.     (case (leaf-value value-rep)
  26.       ((rep/undefined ignore))
  27.       ((rep/double)
  28.        (emit vax/movl S1 S3)                            ; save high longword
  29.        (emit vax/movl (machine-num 8) S1)            ; 2 words for double
  30.        (emit vax/movl (machine-num header/double-float) AN)
  31.        (generate-slink-jump slink/make-extend)
  32.        (emit vax/movl S3 (reg-offset AN 6))
  33.        (emit vax/movl S0 (reg-offset AN 2))
  34.        (emit vax/movl AN A1))                         ; return consed flonum
  35.       (else
  36.        (really-rep-convert node S0 (leaf-value value-rep) A1 'rep/pointer)))
  37.     (emit vax/clrl (reg-offset TASK task/foreign-call-cont))))
  38.  
  39.  
  40.  
  41.