module/language/tree-il/compile-glil.scm

   1 ;;; TREE-IL -> GLIL compiler
   2
   3 ;; Copyright (C) 2001,2008,2009 Free Software Foundation, Inc.
   4
   5 ;;;; This library is free software; you can redistribute it and/or
   6 ;;;; modify it under the terms of the GNU Lesser General Public
   7 ;;;; License as published by the Free Software Foundation; either
   8 ;;;; version 3 of the License, or (at your option) any later version.
   9 ;;;;
  10 ;;;; This library is distributed in the hope that it will be useful,
  11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ;;;; Lesser General Public License for more details.
  14 ;;;;
  15 ;;;; You should have received a copy of the GNU Lesser General Public
  16 ;;;; License along with this library; if not, write to the Free Software
  17 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18
  19 ;;; Code:
  20
  21 (define-module (language tree-il compile-glil)
  22   #:use-module (system base syntax)
  23   #:use-module (system base pmatch)
  24   #:use-module (ice-9 receive)
  25   #:use-module (language glil)
  26   #:use-module (system vm instruction)
  27   #:use-module (language tree-il)
  28   #:use-module (language tree-il optimize)
  29   #:use-module (language tree-il analyze)
  30   #:export (compile-glil))
  31
  32 ;;; TODO:
  33 ;;
  34 ;; call-with-values -> mv-bind
  35 ;; basic degenerate-case reduction
  36
  37 ;; allocation:
  38 ;;  sym -> {lambda -> address}
  39 ;;  lambda -> (nlocs . closure-vars)
  40 ;;
  41 ;; address := (local? boxed? . index)
  42 ;; free-locs ::= ((sym0 . address0) (sym1 . address1) ...)
  43 ;; free variable addresses are relative to parent proc.
  44
  45 (define *comp-module* (make-fluid))
  46
  47 (define (compile-glil x e opts)
  48   (let* ((x (make-lambda (tree-il-src x) '() '() '() x))
  49          (x (optimize! x e opts))
  50          (allocation (analyze-lexicals x)))
  51     (with-fluid* *comp-module* (or (and e (car e)) (current-module))
  52       (lambda ()
  53         (values (flatten-lambda x allocation)
  54                 (and e (cons (car e) (cddr e)))
  55                 e)))))
  56
  57 \f
  58
  59 (define *primcall-ops* (make-hash-table))
  60 (for-each
  61  (lambda (x) (hash-set! *primcall-ops* (car x) (cdr x)))
  62  '(((eq? . 2) . eq?)
  63    ((eqv? . 2) . eqv?)
  64    ((equal? . 2) . equal?)
  65    ((= . 2) . ee?)
  66    ((< . 2) . lt?)
  67    ((> . 2) . gt?)
  68    ((<= . 2) . le?)
  69    ((>= . 2) . ge?)
  70    ((+ . 2) . add)
  71    ((- . 2) . sub)
  72    ((* . 2) . mul)
  73    ((/ . 2) . div)
  74    ((quotient . 2) . quo)
  75    ((remainder . 2) . rem)
  76    ((modulo . 2) . mod)
  77    ((not . 1) . not)
  78    ((pair? . 1) . pair?)
  79    ((cons . 2) . cons)
  80    ((car . 1) . car)
  81    ((cdr . 1) . cdr)
  82    ((set-car! . 2) . set-car!)
  83    ((set-cdr! . 2) . set-cdr!)
  84    ((null? . 1) . null?)
  85    ((list? . 1) . list?)
  86    (list . list)
  87    (vector . vector)
  88    ((@slot-ref . 2) . slot-ref)
  89    ((@slot-set! . 3) . slot-set)
  90    ((vector-ref . 2) . vector-ref)
  91    ((vector-set! . 3) . vector-set)
  92
  93    ((bytevector-u8-ref . 2) . bv-u8-ref)
  94    ((bytevector-u8-set! . 3) . bv-u8-set)
  95    ((bytevector-s8-ref . 2) . bv-s8-ref)
  96    ((bytevector-s8-set! . 3) . bv-s8-set)
  97
  98    ((bytevector-u16-ref . 3) . bv-u16-ref)
  99    ((bytevector-u16-set! . 4) . bv-u16-set)
 100    ((bytevector-u16-native-ref . 2) . bv-u16-native-ref)
 101    ((bytevector-u16-native-set! . 3) . bv-u16-native-set)
 102    ((bytevector-s16-ref . 3) . bv-s16-ref)
 103    ((bytevector-s16-set! . 4) . bv-s16-set)
 104    ((bytevector-s16-native-ref . 2) . bv-s16-native-ref)
 105    ((bytevector-s16-native-set! . 3) . bv-s16-native-set)
 106
 107    ((bytevector-u32-ref . 3) . bv-u32-ref)
 108    ((bytevector-u32-set! . 4) . bv-u32-set)
 109    ((bytevector-u32-native-ref . 2) . bv-u32-native-ref)
 110    ((bytevector-u32-native-set! . 3) . bv-u32-native-set)
 111    ((bytevector-s32-ref . 3) . bv-s32-ref)
 112    ((bytevector-s32-set! . 4) . bv-s32-set)
 113    ((bytevector-s32-native-ref . 2) . bv-s32-native-ref)
 114    ((bytevector-s32-native-set! . 3) . bv-s32-native-set)
 115
 116    ((bytevector-u64-ref . 3) . bv-u64-ref)
 117    ((bytevector-u64-set! . 4) . bv-u64-set)
 118    ((bytevector-u64-native-ref . 2) . bv-u64-native-ref)
 119    ((bytevector-u64-native-set! . 3) . bv-u64-native-set)
 120    ((bytevector-s64-ref . 3) . bv-s64-ref)
 121    ((bytevector-s64-set! . 4) . bv-s64-set)
 122    ((bytevector-s64-native-ref . 2) . bv-s64-native-ref)
 123    ((bytevector-s64-native-set! . 3) . bv-s64-native-set)
 124
 125    ((bytevector-ieee-single-ref . 3) . bv-f32-ref)
 126    ((bytevector-ieee-single-set! . 4) . bv-f32-set)
 127    ((bytevector-ieee-single-native-ref . 2) . bv-f32-native-ref)
 128    ((bytevector-ieee-single-native-set! . 3) . bv-f32-native-set)
 129    ((bytevector-ieee-double-ref . 3) . bv-f64-ref)
 130    ((bytevector-ieee-double-set! . 4) . bv-f64-set)
 131    ((bytevector-ieee-double-native-ref . 2) . bv-f64-native-ref)
 132    ((bytevector-ieee-double-native-set! . 3) . bv-f64-native-set)))
 133
 134
 135 \f
 136
 137 (define (make-label) (gensym ":L"))
 138
 139 (define (vars->bind-list ids vars allocation proc)
 140   (map (lambda (id v)
 141          (pmatch (hashq-ref (hashq-ref allocation v) proc)
 142            ((#t ,boxed? . ,n)
 143             (list id boxed? n))
 144            (,x (error "badness" x))))
 145        ids
 146        vars))
 147
 148 (define (emit-bindings src ids vars allocation proc emit-code)
 149   (if (pair? vars)
 150       (emit-code src (make-glil-bind
 151                       (vars->bind-list ids vars allocation proc)))))
 152
 153 (define (with-output-to-code proc)
 154   (let ((out '()))
 155     (define (emit-code src x)
 156       (set! out (cons x out))
 157       (if src
 158           (set! out (cons (make-glil-source src) out))))
 159     (proc emit-code)
 160     (reverse out)))
 161
 162 (define (flatten-lambda x allocation)
 163   (receive (ids vars nargs nrest)
 164       (let lp ((ids (lambda-names x)) (vars (lambda-vars x))
 165                (oids '()) (ovars '()) (n 0))
 166           (cond ((null? vars) (values (reverse oids) (reverse ovars) n 0))
 167                 ((pair? vars) (lp (cdr ids) (cdr vars)
 168                                   (cons (car ids) oids) (cons (car vars) ovars)
 169                                   (1+ n)))
 170                 (else (values (reverse (cons ids oids))
 171                               (reverse (cons vars ovars))
 172                               (1+ n) 1))))
 173     (let ((nlocs (car (hashq-ref allocation x))))
 174       (make-glil-program
 175        nargs nrest nlocs 0 (lambda-meta x)
 176        (with-output-to-code
 177         (lambda (emit-code)
 178           ;; write bindings and source debugging info
 179           (emit-bindings #f ids vars allocation x emit-code)
 180           (if (lambda-src x)
 181               (emit-code #f (make-glil-source (lambda-src x))))
 182           ;; box args if necessary
 183           (for-each
 184            (lambda (v)
 185              (pmatch (hashq-ref (hashq-ref allocation v) x)
 186                ((#t #t . ,n)
 187                 (emit-code #f (make-glil-lexical #t #f 'ref n))
 188                 (emit-code #f (make-glil-lexical #t #t 'box n)))))
 189            vars)
 190           ;; and here, here, dear reader: we compile.
 191           (flatten (lambda-body x) allocation x emit-code)))))))
 192
 193 (define (flatten x allocation proc emit-code)
 194   (define (emit-label label)
 195     (emit-code #f (make-glil-label label)))
 196   (define (emit-branch src inst label)
 197     (emit-code src (make-glil-branch inst label)))
 198
 199   ;; LMVRA == "let-values MV return address"
 200   (let comp ((x x) (context 'tail) (LMVRA #f))
 201     (define (comp-tail tree) (comp tree context LMVRA))
 202     (define (comp-push tree) (comp tree 'push #f))
 203     (define (comp-drop tree) (comp tree 'drop #f))
 204     (define (comp-vals tree LMVRA) (comp tree 'vals LMVRA))
 205
 206     (record-case x
 207       ((<void>)
 208        (case context
 209          ((push vals) (emit-code #f (make-glil-void)))
 210          ((tail)
 211           (emit-code #f (make-glil-void))
 212           (emit-code #f (make-glil-call 'return 1)))))
 213
 214       ((<const> src exp)
 215        (case context
 216          ((push vals) (emit-code src (make-glil-const exp)))
 217          ((tail)
 218           (emit-code src (make-glil-const exp))
 219           (emit-code #f (make-glil-call 'return 1)))))
 220
 221       ;; FIXME: should represent sequence as exps tail
 222       ((<sequence> src exps)
 223        (let lp ((exps exps))
 224          (if (null? (cdr exps))
 225              (comp-tail (car exps))
 226              (begin
 227                (comp-drop (car exps))
 228                (lp (cdr exps))))))
 229
 230       ((<application> src proc args)
 231        ;; FIXME: need a better pattern-matcher here
 232        (cond
 233         ((and (primitive-ref? proc)
 234               (eq? (primitive-ref-name proc) '@apply)
 235               (>= (length args) 1))
 236          (let ((proc (car args))
 237                (args (cdr args)))
 238            (cond
 239             ((and (primitive-ref? proc) (eq? (primitive-ref-name proc) 'values)
 240                   (not (eq? context 'push)) (not (eq? context 'vals)))
 241              ;; tail: (lambda () (apply values '(1 2)))
 242              ;; drop: (lambda () (apply values '(1 2)) 3)
 243              ;; push: (lambda () (list (apply values '(10 12)) 1))
 244              (case context
 245                ((drop) (for-each comp-drop args))
 246                ((tail)
 247                 (for-each comp-push args)
 248                 (emit-code src (make-glil-call 'return/values* (length args))))))
 249
 250             (else
 251              (case context
 252                ((tail)
 253                 (comp-push proc)
 254                 (for-each comp-push args)
 255                 (emit-code src (make-glil-call 'goto/apply (1+ (length args)))))
 256                ((push)
 257                 (comp-push proc)
 258                 (for-each comp-push args)
 259                 (emit-code src (make-glil-call 'apply (1+ (length args)))))
 260                ((vals)
 261                 (comp-vals
 262                  (make-application src (make-primitive-ref #f 'apply)
 263                                    (cons proc args))
 264                  LMVRA))
 265                ((drop)
 266                 ;; Well, shit. The proc might return any number of
 267                 ;; values (including 0), since it's in a drop context,
 268                 ;; yet apply does not create a MV continuation. So we
 269                 ;; mv-call out to our trampoline instead.
 270                 (comp-drop
 271                  (make-application src (make-primitive-ref #f 'apply)
 272                                    (cons proc args)))))))))
 273
 274         ((and (primitive-ref? proc) (eq? (primitive-ref-name proc) 'values)
 275               (not (eq? context 'push)))
 276          ;; tail: (lambda () (values '(1 2)))
 277          ;; drop: (lambda () (values '(1 2)) 3)
 278          ;; push: (lambda () (list (values '(10 12)) 1))
 279          ;; vals: (let-values (((a b ...) (values 1 2 ...))) ...)
 280          (case context
 281            ((drop) (for-each comp-drop args))
 282            ((vals)
 283             (for-each comp-push args)
 284             (emit-code #f (make-glil-const (length args)))
 285             (emit-branch src 'br LMVRA))
 286            ((tail)
 287             (for-each comp-push args)
 288             (emit-code src (make-glil-call 'return/values (length args))))))
 289
 290         ((and (primitive-ref? proc)
 291               (eq? (primitive-ref-name proc) '@call-with-values)
 292               (= (length args) 2))
 293          ;; CONSUMER
 294          ;; PRODUCER
 295          ;; (mv-call MV)
 296          ;; ([tail]-call 1)
 297          ;; goto POST
 298          ;; MV: [tail-]call/nargs
 299          ;; POST: (maybe-drop)
 300          (case context
 301            ((vals)
 302             ;; Fall back.
 303             (comp-vals
 304              (make-application src (make-primitive-ref #f 'call-with-values)
 305                                args)
 306              LMVRA))
 307            (else
 308             (let ((MV (make-label)) (POST (make-label))
 309                   (producer (car args)) (consumer (cadr args)))
 310               (comp-push consumer)
 311               (comp-push producer)
 312               (emit-code src (make-glil-mv-call 0 MV))
 313               (case context
 314                 ((tail) (emit-code src (make-glil-call 'goto/args 1)))
 315                 (else   (emit-code src (make-glil-call 'call 1))
 316                         (emit-branch #f 'br POST)))
 317               (emit-label MV)
 318               (case context
 319                 ((tail) (emit-code src (make-glil-call 'goto/nargs 0)))
 320                 (else   (emit-code src (make-glil-call 'call/nargs 0))
 321                         (emit-label POST)
 322                         (if (eq? context 'drop)
 323                             (emit-code #f (make-glil-call 'drop 1)))))))))
 324
 325         ((and (primitive-ref? proc)
 326               (eq? (primitive-ref-name proc) '@call-with-current-continuation)
 327               (= (length args) 1))
 328          (case context
 329            ((tail)
 330             (comp-push (car args))
 331             (emit-code src (make-glil-call 'goto/cc 1)))
 332            ((vals)
 333             (comp-vals
 334              (make-application
 335               src (make-primitive-ref #f 'call-with-current-continuation)
 336               args)
 337              LMVRA))
 338            ((push)
 339             (comp-push (car args))
 340             (emit-code src (make-glil-call 'call/cc 1)))
 341            ((drop)
 342             ;; Crap. Just like `apply' in drop context.
 343             (comp-drop
 344              (make-application
 345               src (make-primitive-ref #f 'call-with-current-continuation)
 346               args)))))
 347
 348         ((and (primitive-ref? proc)
 349               (or (hash-ref *primcall-ops*
 350                             (cons (primitive-ref-name proc) (length args)))
 351                   (hash-ref *primcall-ops* (primitive-ref-name proc))))
 352          => (lambda (op)
 353               (for-each comp-push args)
 354               (emit-code src (make-glil-call op (length args)))
 355               (case (instruction-pushes op)
 356                 ((0)
 357                  (case context
 358                    ((tail) (emit-code #f (make-glil-void))
 359                            (emit-code #f (make-glil-call 'return 1)))
 360                    ((push vals) (emit-code #f (make-glil-void)))))
 361                 ((1)
 362                  (case context
 363                    ((tail) (emit-code #f (make-glil-call 'return 1)))
 364                    ((drop) (emit-code #f (make-glil-call 'drop 1)))))
 365                 (else
 366                  (error "bad primitive op: too many pushes"
 367                         op (instruction-pushes op))))))
 368
 369         (else
 370          (comp-push proc)
 371          (for-each comp-push args)
 372          (let ((len (length args)))
 373            (case context
 374              ((tail) (emit-code src (make-glil-call 'goto/args len)))
 375              ((push) (emit-code src (make-glil-call 'call len)))
 376              ((vals) (emit-code src (make-glil-call 'mv-call len LMVRA)))
 377              ((drop)
 378               (let ((MV (make-label)) (POST (make-label)))
 379                 (emit-code src (make-glil-mv-call len MV))
 380                 (emit-code #f (make-glil-call 'drop 1))
 381                 (emit-branch #f 'br POST)
 382                 (emit-label MV)
 383                 (emit-code #f (make-glil-mv-bind '() #f))
 384                 (emit-code #f (make-glil-unbind))
 385                 (emit-label POST))))))))
 386
 387       ((<conditional> src test then else)
 388        ;;     TEST
 389        ;;     (br-if-not L1)
 390        ;;     THEN
 391        ;;     (br L2)
 392        ;; L1: ELSE
 393        ;; L2:
 394        (let ((L1 (make-label)) (L2 (make-label)))
 395          (comp-push test)
 396          (emit-branch src 'br-if-not L1)
 397          (comp-tail then)
 398          (if (not (eq? context 'tail))
 399              (emit-branch #f 'br L2))
 400          (emit-label L1)
 401          (comp-tail else)
 402          (if (not (eq? context 'tail))
 403              (emit-label L2))))
 404
 405       ((<primitive-ref> src name)
 406        (cond
 407         ((eq? (module-variable (fluid-ref *comp-module*) name)
 408               (module-variable the-root-module name))
 409          (case context
 410            ((push vals)
 411             (emit-code src (make-glil-toplevel 'ref name)))
 412            ((tail)
 413             (emit-code src (make-glil-toplevel 'ref name))
 414             (emit-code #f (make-glil-call 'return 1)))))
 415         (else
 416          (pk 'ew-the-badness x (current-module) (fluid-ref *comp-module*))
 417          (case context
 418            ((push vals)
 419             (emit-code src (make-glil-module 'ref '(guile) name #f)))
 420            ((tail)
 421             (emit-code src (make-glil-module 'ref '(guile) name #f))
 422             (emit-code #f (make-glil-call 'return 1)))))))
 423
 424       ((<lexical-ref> src name gensym)
 425        (case context
 426          ((push vals tail)
 427           (pmatch (hashq-ref (hashq-ref allocation gensym) proc)
 428             ((,local? ,boxed? . ,index)
 429              (emit-code src (make-glil-lexical local? boxed? 'ref index)))
 430             (,loc
 431              (error "badness" x loc)))))
 432        (case context
 433          ((tail) (emit-code #f (make-glil-call 'return 1)))))
 434
 435       ((<lexical-set> src name gensym exp)
 436        (comp-push exp)
 437        (pmatch (hashq-ref (hashq-ref allocation gensym) proc)
 438          ((,local? ,boxed? . ,index)
 439           (emit-code src (make-glil-lexical local? boxed? 'set index)))
 440          (,loc
 441           (error "badness" x loc)))
 442        (case context
 443          ((push vals)
 444           (emit-code #f (make-glil-void)))
 445          ((tail)
 446           (emit-code #f (make-glil-void))
 447           (emit-code #f (make-glil-call 'return 1)))))
 448
 449       ((<module-ref> src mod name public?)
 450        (emit-code src (make-glil-module 'ref mod name public?))
 451        (case context
 452          ((drop) (emit-code #f (make-glil-call 'drop 1)))
 453          ((tail) (emit-code #f (make-glil-call 'return 1)))))
 454
 455       ((<module-set> src mod name public? exp)
 456        (comp-push exp)
 457        (emit-code src (make-glil-module 'set mod name public?))
 458        (case context
 459          ((push vals)
 460           (emit-code #f (make-glil-void)))
 461          ((tail)
 462           (emit-code #f (make-glil-void))
 463           (emit-code #f (make-glil-call 'return 1)))))
 464
 465       ((<toplevel-ref> src name)
 466        (emit-code src (make-glil-toplevel 'ref name))
 467        (case context
 468          ((drop) (emit-code #f (make-glil-call 'drop 1)))
 469          ((tail) (emit-code #f (make-glil-call 'return 1)))))
 470
 471       ((<toplevel-set> src name exp)
 472        (comp-push exp)
 473        (emit-code src (make-glil-toplevel 'set name))
 474        (case context
 475          ((push vals)
 476           (emit-code #f (make-glil-void)))
 477          ((tail)
 478           (emit-code #f (make-glil-void))
 479           (emit-code #f (make-glil-call 'return 1)))))
 480
 481       ((<toplevel-define> src name exp)
 482        (comp-push exp)
 483        (emit-code src (make-glil-toplevel 'define name))
 484        (case context
 485          ((push vals)
 486           (emit-code #f (make-glil-void)))
 487          ((tail)
 488           (emit-code #f (make-glil-void))
 489           (emit-code #f (make-glil-call 'return 1)))))
 490
 491       ((<lambda>)
 492        (let ((free-locs (cdr (hashq-ref allocation x))))
 493          (case context
 494            ((push vals tail)
 495             (emit-code #f (flatten-lambda x allocation))
 496             (if (not (null? free-locs))
 497                 (begin
 498                   (for-each
 499                    (lambda (loc)
 500                      (pmatch loc
 501                        ((,local? ,boxed? . ,n)
 502                         (emit-code #f (make-glil-lexical local? #f 'ref n)))
 503                        (else (error "what" x loc))))
 504                    free-locs)
 505                   (emit-code #f (make-glil-call 'vector (length free-locs)))
 506                   (emit-code #f (make-glil-call 'make-closure2 2))))
 507             (if (eq? context 'tail)
 508                 (emit-code #f (make-glil-call 'return 1)))))))
 509
 510       ((<let> src names vars vals body)
 511        (for-each comp-push vals)
 512        (emit-bindings src names vars allocation proc emit-code)
 513        (for-each (lambda (v)
 514                    (pmatch (hashq-ref (hashq-ref allocation v) proc)
 515                      ((#t #f . ,n)
 516                       (emit-code src (make-glil-lexical #t #f 'set n)))
 517                      ((#t #t . ,n)
 518                       (emit-code src (make-glil-lexical #t #t 'box n)))
 519                      (,loc (error "badness" x loc))))
 520                  (reverse vars))
 521        (comp-tail body)
 522        (emit-code #f (make-glil-unbind)))
 523
 524       ((<letrec> src names vars vals body)
 525        (for-each (lambda (v)
 526                    (pmatch (hashq-ref (hashq-ref allocation v) proc)
 527                      ((#t #t . ,n)
 528                       (emit-code src (make-glil-lexical #t #t 'empty-box n)))
 529                      (,loc (error "badness" x loc))))
 530                  vars)
 531        (for-each comp-push vals)
 532        (emit-bindings src names vars allocation proc emit-code)
 533        (for-each (lambda (v)
 534                    (pmatch (hashq-ref (hashq-ref allocation v) proc)
 535                      ((#t #t . ,n)
 536                       (emit-code src (make-glil-lexical #t #t 'set n)))
 537                      (,loc (error "badness" x loc))))
 538                  (reverse vars))
 539        (comp-tail body)
 540        (emit-code #f (make-glil-unbind)))
 541
 542       ((<let-values> src names vars exp body)
 543        (let lp ((names '()) (vars '()) (inames names) (ivars vars) (rest? #f))
 544          (cond
 545           ((pair? inames)
 546            (lp (cons (car inames) names) (cons (car ivars) vars)
 547                (cdr inames) (cdr ivars) #f))
 548           ((not (null? inames))
 549            (lp (cons inames names) (cons ivars vars) '() '() #t))
 550           (else
 551            (let ((names (reverse! names))
 552                  (vars (reverse! vars))
 553                  (MV (make-label)))
 554              (comp-vals exp MV)
 555              (emit-code #f (make-glil-const 1))
 556              (emit-label MV)
 557              (emit-code src (make-glil-mv-bind
 558                              (vars->bind-list names vars allocation proc)
 559                              rest?))
 560              (for-each (lambda (v)
 561                          (pmatch (hashq-ref (hashq-ref allocation v) proc)
 562                            ((#t #f . ,n)
 563                             (emit-code src (make-glil-lexical #t #f 'set n)))
 564                            ((#t #t . ,n)
 565                             (emit-code src (make-glil-lexical #t #t 'box n)))
 566                            (,loc (error "badness" x loc))))
 567                        (reverse vars))
 568              (comp-tail body)
 569              (emit-code #f (make-glil-unbind))))))))))