all noncommented rtl ops are now encoded
[aschm:aschm.git] / module / native / vm / inst.scm
1 (define-module (native vm inst)
2   #:use-module (native vm base)
3   #:use-module (native vm bit-utilities)
4   #:use-module (native vm vm)
5   #:use-module (native vm program)
6   #:use-module (native vm variable)
7   #:use-module (native vm vector)
8   #:use-module (native vm struct)
9   #:use-module (native vm c-callers)
10   #:use-module (native vm c-call)
11   #:use-module (native aschm)
12   #:use-module (native vm constants))
13 ;-------------------------------------------------------------------------------
14 ;-
15
16 (define-syntax-rule (return-block code ...)
17   (assemble ()
18     (inst mov reg1 (&& cont13:))
19     (inst mov (ret) reg1)
20     code ...
21   cont13:))
22
23
24 (define (inum reg1)
25   (assemble ()
26     (inst lea reg1 (make-ea #:qword #:disp 2 #:index rdi #:scale 4))))
27
28 #;
29 (define-vm-inst halt 0 ((U8_U24 src)))
30   
31 #;
32 (define-vm-inst halt/values 1 ((U8_U24 src)))
33
34 ;;This is a bit number magic needs to be abstracted in order to be
35 ;;more robust depends on a fixed layout of scm_i_thread
36 (define (handle-interupts reg4 . regs)
37   (assemble ()
38     (inst mov reg4 (cur_th))
39     (inst mov reg4 (Q reg4 30))
40     (inst test reg4 reg4)
41     (inst jmp #:z out:)
42     (for-each (lambda (reg) (assemble () (inst push reg))) regs)
43     (c-call scm_async_click) 
44     (for-each (lambda (reg) (assemble () (inst pop reg))) (reverse regs))
45    out:))
46
47 ;;F R E E    V A R I A B L E S
48 (define (free-variable-ref reg x) (Q reg (+ x 2)))
49 (define (check-free-variable reg1) #f)
50
51 (define (lower-adress x) (Q x -5))
52 (define (return-a     x) (Q x -2))
53 (define (mv-return-a  x) (Q x -3))
54 (define (dynamic-link x) (Q x -4))
55 (define (program-a    x) (Q x -1))
56 (define program-ref program-a)
57 (define local-ref
58   (case-lambda
59     ((n)         (Q rbp n))
60     ((rbp . l)   (apply Q rbp l))))
61
62 ;; H O O K S
63 (define vm-use-hooks             #f)
64 (define apply-hook-i             0)
65 (define push-continuation-hook-i 1)
66 (define pop-continuation-hook-i  2)
67
68
69 (define (run-hook reg1 regs h args n)
70   (when vm-use-hooks
71     (assemble ()
72       (inst mov reg1 (vm-trace-level))
73       (inst test reg1 reg1)
74       (inst jmp #:z out:)
75       (for-each (lambda (reg) (assemble () (inst push reg))) regs)
76       (c-call ???)
77       (for-each (lambda (reg) (assemble () (inst pop reg))) (reverse regs))
78      out:)))
79     
80 (define (run-hook0 reg regs h) (run-hook reg regs h '() 0))
81 (define (push-continuation-hook reg . regs) 
82   (run-hook0 reg regs push-continuation-hook-i))
83 (define (pop-continuation-hook reg . regs) 
84   (run-hook0 reg regs pop-continuation-hook-i))
85 (define (apply-hook reg . regs)      
86   (run-hook0 reg regs apply-hook-i))
87
88 (define (check-overflow reg reg2)
89   (assemble ()
90     (inst mov reg2 (vm-stack-limit reg2))
91     (inst cmp reg reg2)
92     (inst jmp #:l out:)
93     (inst mov call-1 vm)
94     (c-call g_vm_error_stack_overflow)
95    out:))
96
97 (define (alloc-frame n reg1 reg2 rbp)
98   (assemble ()
99    (inst mov reg1 rbp)
100    (inst dec reg1)
101    (inst add reg1 n)
102    (inst mov (vm-rsp) reg1)
103    (inst add reg1 24)
104    (check-overflow reg1 reg2)))
105
106
107 (define-vm-inst vm-call 2 ((U8_U24 from) 
108                            (X8_U24 proc) 
109                            (X8_R24 nargs)
110                            (Label  mvret (+ 1 nargs))
111                            (N      args nargs))
112                        
113
114   (inst mov reg2 (local-ref rbp proc))
115   (inst mov reg1 rbp)
116   (inst lea rbp  (Q rbp (+ 4 from)))
117   (inst mov (dynamic-link rbp) reg1)
118   (inst mov (mv-return-a  rbp) mvret)
119   (inst mov (return-a     rbp) (&& out:))
120   (inst mov reg1 nargs)
121   
122   (for-each 
123    (lambda (src-i dest-i)
124      (inst mov reg3 (local-ref reg1 src-i))
125      (inst mov (local-ref dest-i) reg3))
126    ret
127    (iota nargs))
128
129   (if (< nargs 20)
130       (inst jmp (call-hook jmp))
131       (call-rest))
132  out:)
133
134 (define (call-rest)
135   (assemble ()
136     #;
137     (alloc-frame reg1 call-1 call-2 rbp)
138   
139
140     (NATIVE-PROGRAM? reg2 reg1 nonative:)  
141     (inst mov (program-a rbp) reg2)
142
143     (handle-interupts       reg2 reg1)
144     (push-continuation-hook reg2 reg1)
145     (apply-hook             reg2 reg1)
146
147     (inst jmp reg1)
148   
149    nonative:
150     (handle-interupts       reg1 reg2)
151     (push-continuation-hook reg1 reg2)
152     (apply-hook             reg1 reg2)
153     
154     #;
155     (inst jmp (apply-extra jmp))))
156
157 (define-jmp-hook call-hook (call-rest))
158
159
160 (define-vm-inst vm-call/values 3 ((U8_U24 from) 
161                                   (X8_U24 proc) 
162                                   (Label  mvret 2))
163
164   (inst mov reg2 (local-ref rbp proc))
165   (inst mov reg1 rbp)
166   (inst lea rbp  (Q rbp (+ 4 from)))
167   (inst mov (dynamic-link rbp) reg1)
168   (inst mov (mv-return-a  rbp) mvret)
169   (inst mov (return-a     rbp) (&& out:))
170
171   (inst mov reg1 (vm-rsp)) 
172   (inst sub reg1 rbp)
173   (inst shr reg1 4)
174   (inst mov (vm-nargs) reg1)
175   (inst jmp (call-hook jmp))
176  out:)
177
178
179
180
181 (define-vm-inst vm-tail-call 3 ((U8_U24 nargs) 
182                                 (X8_U24 proc)
183                                 (N args nargs))
184
185   (inst mov reg2 (local-ref proc))
186
187   (inst lea reg1 (Q rbp (- nargs 1)))
188
189   (for-each 
190    (lambda (n i)
191      (inst mov reg1 (local-ref n))
192      (inst mov (local-ref i) reg1))
193    args (iota nargs))
194
195   (if (< nargs 20)      
196       (inst jmp (tail-call-hook jmp))
197       (tail-part)))
198
199 (define-jmp-hook tail-call-hook (tail-part))
200
201 (define (tail-part)
202   (assemble ()
203     (inst mov (dynamic-link rbp) reg2)
204     (inst mov (vm-rsp) reg1)
205
206     (NATIVE-PROGRAM? reg2 reg1 nonative:)  
207     
208     (handle-interupts reg2 reg1)    
209     (apply-hook reg2 reg1)
210
211     (inst jmp reg1)
212
213    nonative:
214     (handle-interupts reg1 reg2)    
215     (apply-hook       reg1 reg2)
216     #;(inst jmp (apply-hook jmp))))
217
218
219
220 (define-vm-inst vm-return 4 ((U8_U24 src))
221   (inst mov reg1 (local-ref src))
222   (inst jmp (return-hook jmp)))
223
224 (define-jmp-hook return-hook
225   (inst lea reg2 (lower-adress rbp))
226   (inst mov reg3 (return-a rbp))
227   (inst mov rbp (dynamic-link rbp))
228   (inst mov (Q reg2) reg1)
229   (inst add reg2 8)
230   (inst mov (vm-rsp) reg2)
231
232   (pop-continuation-hook reg1 reg3)
233   (handle-interupts reg1 reg3)
234
235   (inst jmp reg3))
236
237
238
239 #;
240 (define-vm-inst vm-return/values 5 ((U8_U24 src)))
241   
242 #;
243 (define-vm-inst vm-subr-call 6 ((U8_U12_U12 nargs ptr))
244   (handle-interupts reg2)
245   
246   (inst mov reg1 (local-ref ptr))
247   (inst mov reg1 (Q reg1 1))  
248   
249   (if (> nargs 0) (inst mov call-1 (Q rbp 0)))
250   (if (> nargs 1) (inst mov call-2 (Q rbp 1)))
251   (if (> nargs 2) (inst mov call-3 (Q rbp 2)))
252   (if (> nargs 3) (inst mov call-4 (Q rbp 3)))
253   (if (> nargs 4) (inst mov call-5 (Q rbp 4)))
254   (if (> nargs 5) (inst mov call-6 (Q rbp 5)))
255   (for-each 
256    (lambda (n) (assemble () (inst push (Q rbp n))))
257    (map (lambda (x) (+ x 6)) (iota (max 0 (- nargs 6)))))
258   (c-call reg1)
259   (if (> nargs 6) (inst add rsp (* (- nargs 6) 8)))
260   #;(inst mov reg3 (return-hook jmp))
261   #;(STRUCT? reg1 reg2 reg3 scm_values_vtable values:)
262   (inst mov reg2 (Q reg1 1))
263   #;...mv...)
264
265
266
267 #;
268 (define-vm-inst foreign_call 7 ())
269
270 #;
271 (define-vm-inst continuation_call 8 ())
272
273 #;
274 (define-vm-inst partial_cont_call 9 ())
275
276 #;
277 (define-vm-inst vm-apply 10 ())
278
279 #;
280 (define-vm-inst vm-call-cc 11 ())
281
282 #;
283 (define-vm-inst vm-values 12 ())
284
285
286 (define-syntax-rule (br-nargs nm n rel)
287   (define-vm-inst nm n ((U8_U24 expected) 
288                         (X8_L24 offset)
289                         (Label label offset))
290     (inst mov reg1 (vm-nargs))
291     (inst cmp reg1 expected)
292     (inst jmp rel label)))
293
294 (br-nargs br-if-nargs-ne 13 #:ne)
295 (br-nargs br-if-nargs-lt 14 #:l)
296 (br-nargs br-if-nargs-gt 15 #:g)
297
298
299
300 (define-syntax-rule (assert-narg nm n op)
301   (define-vm-inst nm n ((U8_U24 expected))
302     (inst mov reg1 (vm-nargs))
303     (inst cmp reg1 expected)
304     (inst jmp op out:)
305     (inst mov call-1 (program-a rbp))
306     (inst mov call-2 reg1)
307     (c-call scm_wrong_argument)
308    out:))
309
310 (assert-narg assert-nargs-ee 16 #:eq)
311 (assert-narg assert-nargs-ge 17 #:ge)  
312
313
314 (define-vm-inst reserve-locals 18 ((U8_U24 nlocals))
315   (return-block
316    (inst mov reg3 nlocals)
317    (inst mov reg1 (vm-nargs))
318    (inst jmp (reserve-hook jmp))))
319
320 (define-jmp-hook reserve-hook
321   (alloc-frame reg3 reg1 reg2 rbp)
322  loop:
323   (inst cmp reg3 reg1)
324   (inst jmp #:le out:)
325   (inst dec reg3)
326   (inst mov (local-ref rbp 0 reg3 8) SCM_UNDEFINED)
327   (inst jmp loop:)
328  out:
329   (inst jmp (ret)))
330
331
332 (define-vm-inst assert-nargs-ee/locals 19 ((U8_U12_U12 expected nlocals))
333   (return-block
334    (inst mov reg3 nlocals)
335    (inst mov reg1 (vm-nargs))
336    (inst cmp reg1 expected)
337    (inst jmp #:eq cont:)
338    (inst mov call-1 (program-a rbp))
339    (inst mov call-2 (vm-nargs))
340    (c-call scm_wrong_argument)
341  cont:
342    (inst jmp (reserve-hook jmp))))
343   
344
345 #;
346 (define-vm-inst bind-kwargs 20 ())
347
348 ;;TODO, check that the decreasing of nargs is not global
349 (define-vm-inst bind-rest 21 ((U8_U24 dst))
350   (return-block
351    (inst mov reg2 (vm-nargs))
352    (inst mov reg3 dst)
353    (inst jmp (bind-rest-hook jmp))))
354
355 (define-jmp-hook bind-rest-hook
356     (inst mov reg1 SCM_EOL)
357   loop:
358     (inst cmp reg2 reg3)
359     (inst jmp #:le out:)
360     (inst dec reg2)
361     (inst mov call-1 (local-ref rbp 0 reg2 8))
362     (inst mov call-2 reg1)
363     (c-call scm_cons)
364     (inst jmp loop:)
365   out:
366     (inst mov (local-ref rbp 0 reg3 8) reg1)
367     (inst inc reg2)
368     (inst mov reg1 (Q rbp 0 reg2 8))
369     (inst mov (vm-rsp) reg1)
370     (inst jmp (ret)))
371
372 (define-vm-inst br 22 ((U8_L24 offset) (Label label offset))
373   (if (< offset 0)
374       (begin
375         (handle-interupts reg1)
376         (inst jmp label))
377       (inst jmp label)))
378
379 (define (succ f)
380   (case f
381     ((#:eq) #:ne)
382     ((#:ne) #:eq)
383     ((#:z)  #:nz)
384     ((#:nz) #:z)
385     ((#:l)  #:ge)
386     ((#:le) #:g)
387     ((#:g)  #:le)
388     ((#:ge) #:l)))
389
390 (define (id x) x)
391
392 (define-syntax-rule (br-unary nm n reg (test c) out: f)
393   (define-vm-inst nm n ((U8_U24 x) 
394                         (U1_X7_L24  bit offset)
395                         (Label label offset))
396     (let ((fail (if (zero? bit) id succ)))
397       (assemble ()
398          (inst mov reg (local-ref x))
399          (inst test c reg1)
400          (inst jmp (fail f) out:)
401          (if (< offset 0) (handle-interupts reg1))
402          (inst jmp label)
403         out:))))
404
405
406 (br-unary br-if-true 23 reg1 (cmp SCM_BOOL_F    ) out: #:eq)
407 (br-unary br-if-null 24 reg1 (cmp SCM_EOL       ) out: #:ne)
408 (br-unary br-if-nil  25 reg1 (cmp SCM_ELISP_NIL ) out: #:ne)
409
410
411 (define-syntax-rule (br-unary* nm n reg tc7 (test c) out: f code ...)
412  (define-vm-inst nm n ((U8_U24 x) 
413                        (U1_X7_L24  bit offset)
414                        (Label label offset))
415   (let ((tc7 (ash (logand offset #xff) 1)))
416    (if (zero? bit)
417        (assemble ()
418          (inst mov reg (local-ref x))
419          (inst test reg 7)
420          (inst jmp #:nz out:)
421          (inst mov reg (Q reg))
422          code ...
423          (inst test c reg1)
424          (inst jmp f out:)
425          (if (< offset 0) (handle-interupts reg1))
426          (inst jmp label)
427         out:)
428        (assemble ()
429          (inst mov reg (local-ref x))
430          (inst test reg 7)
431          (inst jmp #:nz ret:)
432          (inst mov reg (Q reg))
433          code ...
434          (inst test c reg)
435          (inst jmp (succ f) out:)
436         ret:
437          (if (< offset 0) (handle-interupts reg1))
438          (inst jmp label)
439         out:)))))
440
441 (br-unary* br-if-pair   26 reg1 tc7 (test 1) out: #:nz)
442 (br-unary* br-if-struct 27 reg1 tc3 (cmp tc3_struct) out: #:ne
443   (inst and reg1 #x7))
444 (br-unary* br-if-char 28 reg1 tc8 (cmp tc8_char) out: #:ne
445   (inst and reg1 #xff))
446 (br-unary* br-if-tc7 29 reg1 tc7 (cmp tc7) out: #:ne)
447
448
449 (define-vm-inst br-if-eq 30 ((U8_U12_U12 x y) 
450                              (U1_X7_L24 neg offset)
451                              (Label label offset))
452   (let ((op (if neg #:eq #:ne)))
453     (assemble ()
454       (inst mov reg1 (local-ref x))
455       (inst mov reg2 (local-ref y))
456       (inst cmp reg1 reg2)
457       (inst jmp op out:)
458       (if (< offset 0) (handle-interupts reg1))
459       (inst jmp label)
460      out:)))
461
462
463 (define-syntax-rule (br-cmp nm n scm_eqv_p)
464   (define-vm-inst nm n ((U8_U12_U12 x y) 
465                         (U1_X7_L24 neg offset)
466                         (Label label offset))
467   (inst mov call-1 (local-ref x))
468   (inst mov call-2 (local-ref y))
469   (if (= neg 0)
470       (assemble ()
471         (inst cmp call-1 call-2)
472         (inst jmp #:eq go:)
473         (inst test call-1 7)
474         (inst jmp #:nz out:)
475         (inst test call-2 7)
476         (inst jmp #:nz out:)
477         (c-call scm_eqv_p)
478         (inst cmp reg1 SCM_BOOL_F)
479         (inst jmp #:eq out:)
480        go:
481         (if (< offset 0) (handle-interupts reg1))
482         (inst jmp label)
483        out:)
484       (assemble ()
485         (inst cmp call-1 call-2)
486         (inst jmp #:eq out:)
487         (inst test call-1 7)
488         (inst jmp #:nz go:)
489         (inst test call-2 7)
490         (inst jmp #:nz go:)
491         (c-call scm_eqv_p)
492         (inst cmp reg1 SCM_BOOL_F)
493         (inst jmp #:ne out:)
494        go:
495         (if (< offset 0) (handle-interupts reg1))
496         (inst jmp label)
497        out:))))
498
499 (br-cmp br-if-eqv   31 scm_eqv_p)
500 (br-cmp br-if-equal 32 scm_equal_p)
501
502
503
504 (define-syntax-rule (br_arithmetic nm n cmp-op C)
505   (define-vm-inst nm n ((U8_U12_U12 x y) 
506                         (X8_L24  offset)
507                         (Label label offset))
508   (inst mov call-1 (local-ref x))
509   (inst mov call-2 (local-ref y))
510   (inst test call-1 2)
511   (inst jmp #:z C:)
512   (inst test call-2 2)
513   (inst jmp #:z C:)
514   (inst cmp call-1 call-2)
515   (inst jmp (succ cmp-op) out:)
516  go:
517   (if (< offset 0) (handle-interupts reg1))
518   (inst jmp label)
519  C:
520   (c-call C)
521   (inst cmp reg1 SCM_BOOL_F)
522   (inst jmp #:ne go:)
523  out:))
524
525 (br_arithmetic br-if-=  33 #:eq  scm_num_eq_p)
526 (br_arithmetic br-if-<  34 #:l   scm_less_p)
527 (br_arithmetic br-if-<= 35 #:le  scm_leq_p)
528 (br_arithmetic br-if->  36 #:g   scm_gr_p)
529 (br_arithmetic br-if->= 37 #:ge  scm_leq_p)
530
531
532 (define-vm-inst mov 38 ((U8_U12_U12 from to))
533   (inst mov reg1 (local-ref from))
534   (inst mov (local-ref to) reg1))
535
536 (define-vm-inst long-mov 39 ((U8_U24 from) (X8_U24 to))
537   (inst mov reg1 (local-ref from))
538   (inst mov (local-ref to) reg1))
539
540 (define-vm-inst box 40 ((U8_U12_U12 to from))
541   (inst mov call-1 tc7_variable)
542   (inst mov call-2 (local-ref from))
543   (c-call scm_cell)
544   (inst mov (local-ref to) reg1))
545
546
547 (define-vm-inst empty-box 41 ((U8_U24 to))
548   (inst mov call-1 tc7_variable)
549   (inst mov call-2 SCM_UNDEFINED)
550   (c-call scm_cell)
551   (inst mov (local-ref to) reg1))
552
553 (define-vm-inst box-ref 42 ((U8_U12_U12 to from))
554   (inst mov reg1 (local-ref from))
555   (VARIABLE? reg1 reg2 abort-fkn:)
556   (inst mov reg1 (Q reg1 1))
557   (inst cmp reg1 SCM_UNDEFINED)
558   (inst jmp #:neq boundp:)
559   (inst mov call-1 reg1)
560   (inst mov call-2 (program-ref rbp))
561   (c-call g_box_not_bounded)
562  abort-fkn:
563   (c-call g_abort)
564  boundp:
565   (inst mov (local-ref to) reg1))
566
567 (define-vm-inst box-set 43 ((U8_U12_U12 to from))
568   (inst mov reg1 (local-ref to))
569   (VARIABLE? reg1 reg2 abort-fkn:)
570   (inst mov reg2 (local-ref from))
571   (inst mov (Q reg1 1) reg2)
572   (inst jmp out:)
573  abort-fkn:
574   (c-call g_abort)
575  out:)
576
577
578 (define-vm-inst free-ref 44 ((U8_U12_U12 to from))
579   (inst mov reg1 (program-ref rbp))
580   (inst mov reg1 (free-variable-ref reg1 from))
581   (check-free-variable reg1)
582   (inst mov (local-ref to) reg1))
583
584
585 (define-vm-inst make-closure 45 ((U8_U24 dst) 
586                                  (L32    offset)
587                                  (X8_R24 nfree)
588                                  (IP ip  (- offset 3))
589                                  (N      refs nfree))
590   (inst mov call-1 (logior tc7_rtl_program (ash nfree 16)))
591   (inst mov call-2 (+ nfree 2))
592   (c-call scm_words)
593   (for-each (lambda (n i)
594               (assemble ()
595                 (inst mov reg2 (local-ref n))
596                 (inst mov (free-variable-ref reg1 i) reg2)))
597     refs
598     (iota nfree))
599   (inst mov (Q reg1 1) ip)
600   (inst mov (local-ref dst) reg1))
601
602
603 (define-vm-inst fix-closure 46 ((U8_U24 dst) (X8_R24 nfree) (N refs nfree))
604   (inst mov reg1 (local-ref dst))
605   (for-each (lambda (n i)
606               (assemble ()
607                 (inst mov reg2 (local-ref n))
608                 (inst mov (free-variable-ref reg1 i) reg2)))
609      refs
610      (iota nfree)))
611
612
613 (define-vm-inst make-short-immediate 47 ((U8_U8_I16 dst val))
614   (inst mov (local-ref dst) val))
615
616 (define-vm-inst make-long-immediate 48 ((U8_U24 dst) (I32 val))
617   (inst mov (local-ref dst) val))
618
619 (define-vm-inst make-llong-immediate 49 ((U8_U24 dst) (A32 v1) (B32 v2))
620   (let ((val ((+ ash v1 32) v2)))
621     (inst mov (local-ref dst) val)))
622
623
624 (define-vm-inst make-non-immediate 50 ((U8_U24 dst) 
625                                        (S32    offset) 
626                                        (IP ip  (- offset 2)))
627   (inst mov call-1 ip)
628   (inst mov call-1 (Q call-1))
629   (inst test call-1 7)
630   (inst jmp #:z out:)
631   (c-call g_non_not_nonimmediate)
632  out:
633   (inst mov (local-ref dst) call-1))
634
635
636
637 (define-vm-inst static-ref 51 ((U8_U24 dst) 
638                                (S32 offset) 
639                                (IP ip (- offset 2)))
640   (inst mov call-1 ip)
641   (inst test call-1 15)
642   (inst jmp #:z out:)
643   (c-call g_not_scm_aligned)
644   (inst mov call-1 (Q call-1))
645   (inst mov (local-ref dst) call-1)
646  out:)
647
648
649 (define-vm-inst static-set! 52 ((U8_U24 src) 
650                                 (L32 offset) 
651                                 (IP ip (- offset 2)))
652   (inst mov call-1 ip)
653   (inst test call-1 15)
654   (inst jmp #:z out:)
655   (c-call g_not_scm_aligned)
656   (inst mov reg1 (local-ref src))
657   (inst mov (Q call-1) reg1)
658  out:)
659
660
661 (define-vm-inst link-procedure! 53 ((U8_U24 src) 
662                                     (L32    offset) 
663                                     (IP ip  (- offset 2)))
664   (inst mov reg1 (local-ref src))
665   (inst mov reg2 ip)
666   (inst mov (Q reg1 1) reg2))
667
668
669 (define-vm-inst resolve 54 ((U8_U8_U8_U8 dst mod sym))
670   (inst mov call-1 (local-ref mod))
671   (inst mov call-2 (local-ref sym))
672   (c-call scm_module_lookup)
673   (inst mov (local-ref dst) reg1))
674
675
676
677 (define-vm-inst resolve-module 55 ((U8_U8_U8_U8 dst name public))
678   (inst mov call-1 (local-ref name))
679   (c-call scm_resolve_module)
680   (if (not (= public 0))
681       (begin
682         (inst mov call-1 reg1)
683         (c-call scm_module_public_interface)))
684   (inst mov (local-ref dst) reg1))
685
686
687 (define-vm-inst vm-define 56 ((U8_U12_U12 sym val))
688   (inst mov call-1 (local-ref sym))
689   (inst mov call-2 (local-ref val))
690   (c-call scm_define))
691
692
693 (define-vm-inst toplevel-ref 57 ((U8_U24 dst) 
694                                  (S32 var-offset) 
695                                  (S32 mod-offset)
696                                  (N32 sym-offset)
697                                  (IP var-loc (- var-offset 4))
698                                  (IP mod-loc (- mod-offset 4))
699                                  (IP sym-loc (- sym-offset 4)))
700   (inst mov reg3 var-loc)
701   (inst test reg3 15)
702   (inst jmp #:nz abort:)
703   (inst mov call-1 (Q reg3))
704   (VARIABLE?-NEG call-1 reg1 out:)
705  nonvar:
706   (inst mov call-2 mod-loc)
707   (inst mov call-3 sym-loc)
708   (c-call g_toplevel_resolve)
709   (inst jmp out:)
710  abort:
711   (c-call g_not_scm_aligned)
712  out:
713   (inst mov (Q reg3) reg1)
714   (inst mov reg1 (Q reg1 1))
715   (inst mov (local-ref dst) reg1))
716
717
718
719 (define-vm-inst module-ref 58 ((U8_U24 dst) 
720                                (S32 var-offset) 
721                                (N32 mon-offset)
722                                (N32 sym-offset)
723                                (IP var-loc (- var-offset 4))
724                                (IP mod-loc (- mon-offset 4))
725                                (IP sym-loc (- sym-offset 4)))
726   (inst mov reg3 var-loc)
727   (inst test reg3 15)
728   (inst jmp #:nz abort:)
729   (inst mov call-1 (Q reg3))
730   (VARIABLE?-NEG call-1 reg1 out:)
731  nonvar:
732   (inst mov call-2 mod-loc)
733   (inst mov call-3 sym-loc)
734   (c-call g_moduleref_resolve)
735   (inst jmp out:)
736  abort:
737   (c-call g_not_scm_aligned)
738  out:
739   (inst mov (Q reg3) reg1)
740   (inst mov reg1 (Q reg1 1))
741   (inst mov (local-ref dst) reg1))
742
743
744
745 #;
746 (define-vm-inst vm-prompt 59 ((U8_U24 tag) (U32 return_loc) (U8_L24 escape-only-p offset) (IP ip offset))
747   (inst mov reg1 (cur_th))
748   (inst lea call-1 (Q reg1 th->dynstack))
749   (inst mov call-2 (if escape-only-p SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY 0))
750   (inst mov call-3 (local-ref tag))
751   (inst mov call-4 (vm-sp))
752   (inst mov call-5 ip)
753   (inst lea call-6 (vm-registers))
754   (c-call scm_dynstack_push_prompt))
755
756 (define-vm-inst wind 60 ((U8_U12_U12 winder unwinder))
757   (inst mov reg1 (cur_th))
758   (inst lea call-1 (Q reg1 th->dynstack))
759   (inst mov call-2 (local-ref winder))
760   (inst mov call-3 (local-ref unwinder))
761   (c-call scm_dynstack_push_dynwind))
762
763
764 #;
765 (define-vm-inst abort 61 ((U8_U24 tag) (X8_R24 nvalues) (N nvalues refs))
766   (for-each (lambda (x) (assemble () (inst push x))) (reverse refs))
767   (inst mov call-1 (the-vm))
768   (inst mov call-2 (local-ref tag))
769   (inst mov call-3 rsp)
770   (inst mov call-4 (vm-registers))
771   (c-call vm_abort))
772
773 (define-vm-inst unwind 62 ((U8_X24))
774   (inst mov reg1 (cur_th))
775   (inst lea call-1 (Q reg1 th->dynstack))
776   (c-call scm_dynstack_pop))
777
778
779
780 (define-vm-inst wind-fluids 63 ((U8_U24 fluid_base) (X8_R24 n) (N refs n))
781   (inst mov reg1 (cur_th))
782   (inst lea call-1 (Q reg1 th->dynstack))
783   (inst mov call-2 n)
784   (inst lea call-3 (Q rbp fluid_base))
785   (inst mov call-4 rbp)
786   (for-each (lambda (x) (assemble () (inst push x))) (reverse refs))  
787   (inst mov call-5 rsp)
788   (inst mov call-6 (Q reg1 th->dynamic_state))
789   (c-call scm_dynstack_push_fluids_shuffled))
790
791 (define-vm-inst unwind-fluids 64 ()
792   (inst mov reg1 (cur_th))
793   (inst lea call-1 (Q th->dynstack))
794   (inst mov call-2 (Q th->dynamic_state))
795   (c-call scm_dynstack_unwind_fluids))
796
797
798 (define-vm-inst fluid-ref 65 ((U8_U12_U12 dst src))
799   (inst mov call-1 (local-ref src))
800   (inst mov call-2 (cur_th))
801   (c-call g_fluid_ref)
802   (inst mov (local-ref dst) reg1))
803
804 (define-vm-inst fluid-set 66 ((U8_U12_U12 a b))
805   (inst mov call-1 (local-ref a))
806   (inst mov call-2 (local-ref b))
807   (inst mov call-3 (cur_th))
808   (c-call g_fluid_set))
809
810
811 (define-vm-inst string-length 69 ((U8_U12_U12 dst src))
812   (inst mov call-1 (local-ref src))
813   (c-call g_string_length)
814   (inst mov (local-ref dst) reg1))
815
816 (define-vm-inst string-ref 70 ((U8_U8_U8_U8 dst src n))
817   (inst mov call-1 (local-ref src))
818   (inst mov call-2 (local-ref n))
819   (c-call g_string_ref)
820   (inst mov (local-ref dst) reg1))
821
822 (define-vm-inst string->number 71 ((U8_U12_U12 dst src))
823   (inst mov call-1 (local-ref src))
824   (c-call scm_string_to_number)
825   (inst mov (local-ref dst) reg1))
826
827
828
829 (define-vm-inst string->symbol 72 ((U8_U12_U12 dst src))
830   (inst mov call-1 (local-ref src))
831   (c-call scm_string_to_symbol)
832   (inst mov (local-ref dst) reg1))
833
834 (define-vm-inst symbol->keyword 73 ((U8_U12_U12 dst src))
835   (inst mov call-1 (local-ref src))
836   (c-call scm_symbol_to_keyword)
837   (inst mov (local-ref dst) reg1))
838
839
840
841 (define-vm-inst vm-cons 74 ((U8_U8_U8_U8 dst x y))
842   (inst mov call-1 (local-ref x))
843   (inst mov call-2 (local-ref y))
844   (c-call scm_cons)
845   (inst mov (local-ref dst) reg1))
846   
847 (define-vm-inst vm-car 75 ((U8_U12_U12 dst src))
848   (inst mov reg1 (local-ref src))
849   (inst test reg1 7)
850   (inst jmp #:nz car-error:)
851   (inst mov reg1 (Q reg1))
852   (inst test reg1 1)
853   (inst jmp #:nz car-error:)
854   (inst mov (local-ref src) reg1)
855   (inst jmp out:)
856  car-error:
857   (c-call scm_car_error)
858  out:)
859
860 (define-vm-inst vm-cdr 76 ((U8_U12_U12 dst src))
861   (inst mov reg1 (local-ref src))
862   (inst test reg1 7)
863   (inst jmp #:nz cdr-error:)
864   (inst mov reg1 (Q reg1 1))
865   (inst test reg1 1)
866   (inst jmp #:nz cdr-error:)
867   (inst mov (local-ref src) reg1)
868   (inst jmp out:)
869  cdr-error:
870   (c-call scm_cdr_error)
871  out:)
872
873 (define-vm-inst vm-set-car 77 ((U8_U12_U12 src val))
874   (inst mov reg1 (local-ref src))
875   (inst mov reg2 (local-ref val))
876   (inst test reg1 7)
877   (inst jmp #:nz car-error:)
878   (inst mov reg3 (Q reg1))
879   (inst test reg3 1)
880   (inst jmp #:nz car-error:)
881   (inst mov (Q reg1) reg2 )
882   (inst jmp out:)
883  car-error:
884   (c-call scm_setcar_error)
885  out:)
886
887
888
889 (define-vm-inst vm-set-cdr 78 ((U8_U12_U12 src val))
890   (inst mov reg1 (local-ref src))
891   (inst mov reg2 (local-ref val))
892   (inst test reg1 7)
893   (inst jmp #:nz car-error:)
894   (inst mov reg3 (Q reg1))
895   (inst test reg3 1)
896   (inst jmp #:nz car-error:)
897   (inst mov (Q reg1 1) reg2)
898   (inst jmp out:)
899  car-error:
900   (c-call scm_setcdr_error)
901  out:)
902
903 (define-vm-inst vm-add 79 ((U8_U8_U8_U8 dst x y))
904   (inst mov call-1 (local-ref x))
905   (inst mov call-2 (local-ref y))
906   (inst test call-1 2)
907   (inst jmp #:z slow:)
908   (inst test call-2 2)
909   (inst jmp #:z slow:)
910   (inst add call-2 call-1)
911   (inst jmp #:o slow:)
912   (inst sub call-2 2)
913   (inst mov (local-ref dst) call-2)
914   (inst jmp out:)
915  slow:
916   (inst mov call-2 (Q rsp))
917   (c-call scm_sum call-1 call-2)
918   (inst mov (local-ref dst) rax)
919  out:)
920
921
922
923 (define-vm-inst vm-add1 80 ((U8_U12_U12 dst x))
924   (inst mov reg1 (local-ref x))
925   (inst test reg1 2)
926   (inst jmp #:z slow:)
927   (inst add reg1 4)
928   (inst jmp #:o slow:)
929   (inst jmp out:)
930  slow:
931   (inst mov call-1 (Q rsp))
932   (inst mov call-2 6)
933   (c-call scm_sum call-1 call-2)
934  out:
935   (inst mov (local-ref dst) reg1))
936
937 (define-vm-inst vm-sub 81 ((U8_U8_U8_U8 dst x y))
938   (inst mov call-1 (local-ref x))
939   (inst mov call-2 (local-ref y))
940   (inst test call-1 2)
941   (inst jmp #:z slow:)
942   (inst test call-2 2)
943   (inst jmp #:z slow:)
944   (inst sub call-2 call-1)
945   (inst jmp #:o slow:)
946   (inst add call-2 2)
947   (inst mov (local-ref dst) call-2)
948   (inst jmp out:)
949  slow:
950   (inst mov call-2 (Q rsp))
951   (c-call scm_difference call-2 call-1)
952   (inst mov (local-ref dst) rax)
953  out:)
954
955 (define-vm-inst vm-sub1 82 ((U8_U12_U12 dst x))
956   (inst mov reg1 (local-ref x))
957   (inst test reg1 2)
958   (inst jmp #:z slow:)
959   (inst sub reg1 4)
960   (inst jmp #:o slow:)
961   (inst jmp out:)
962  slow:
963   (inst mov call-1 (Q rsp))
964   (inst mov call-2 6)
965   (c-call scm_difference call-1 call-2)
966  out:
967   (inst mov (local-ref dst) reg1))
968
969
970
971 (define-syntax-rule (mk-binary nm n C)
972   (define-vm-inst nm n ((U8_U8_U8_U8 dst x y))
973     (inst mov call-1 (local-ref x))
974     (inst mov call-2 (local-ref y))
975     (c-call C)
976     (inst mov (local-ref dst) reg1)))
977
978 (mk-binary vm-mul 83 scm_product)
979 (mk-binary vm-div 84 scm_divide)
980 (mk-binary vm-quo 85 scm_quotient)
981 (mk-binary vm-rem 86 scm_remainder)
982 (mk-binary vm-mod 87 scm_modulo)
983
984
985
986 (define-vm-inst vm-ash 88 ((U8_U8_U8_U8 dst x y))
987   (inst mov  rsi (local-ref y))
988   (inst mov  rdi (local-ref x))
989   (inst test dil 2)
990   (inst jmp  #:z slow:)
991   (inst test sil 2)
992   (inst jmp  #:z slow:)
993   (inst sar  rsi 2)
994   (inst test rsi rsi)
995   (inst jmp  #:s neg:)
996   (inst cmp  rsi 60)
997   (inst jmp  #:a slow:)
998   (inst sar  rdi 2)
999   (inst mov  ecx 61)
1000   (inst sub  ecx esi)
1001   (inst mov  rdx rdi)
1002   (inst sar  rdx #:cl)
1003   (inst add  rdx 1)
1004   (inst cmp  rdx 1)
1005   (inst jmp  #:a slow:)
1006   (inst mov  ecx esi)
1007   (inst sal  rdi #:cl)
1008   (inst jmp last:)
1009  slow:
1010   (inst mov call-2 (Q rsp -1))
1011   (inst mov call-1 (Q rsp  0))
1012   (c-call scm_ash)
1013   (inst jmp  final:)
1014  neg:
1015   (inst mov  ecx esi)
1016   (inst sar  rdi 2)
1017   (inst neg  ecx)
1018   (inst sar  rdi #:cl)
1019  last:
1020   (inst lea  rax (make-ea #:qword #:disp 2 #:index rdi #:scale 4)) ;;rax <- 4*rdi + 2
1021  final:
1022   (inst mov (local-ref dst) rax))
1023
1024
1025 (define-syntax-rule (mk-logic nm n C)
1026   (define-vm-inst nm n ((U8_U8_U8_U8 dst x y))
1027     (inst mov call-2 (local-ref y))
1028     (inst mov call-1 (local-ref x))
1029     (inst test call-1 2)
1030     (inst jmp #:z slow:)
1031     (inst test call-2 2)
1032     (inst jmp #:z slow:)
1033     (inst and call-2 call-1)
1034     (inst mov (local-ref dst) call-2)
1035     (inst jmp out:)
1036    slow:
1037     (c-call scm_logand)
1038     (inst mov (local-ref dst) rax)
1039    out:))
1040
1041 (mk-logic vm-logand 89 scm_logand)
1042 (mk-logic vm-logior 90 scm_logior)
1043 (mk-logic vm-logxor 91 scm_logxor)
1044
1045 (define-vm-inst vector-length 92 ((U8_U12_U12 dst src))
1046   (inst mov call-1 (local-ref src))
1047   (VECTOR? call-1 reg1 nonvector:)
1048   (inst shr reg1 8)
1049   (inum reg1)
1050   (inst jmp out:)
1051  nonvector:
1052   (c-call scm_vector_length)
1053  out:
1054   (inst mov (local-ref dst) reg1))
1055
1056
1057 (define-vm-inst vm-vector-ref 93 ((U8_U8_U8_U8 dst ar i))
1058   (inst mov call-1 (local-ref ar))
1059   (inst mov call-2 (local-ref i))
1060   (NONWEAK-VECTOR? call-1 reg3 error:)
1061   (inst test call-2 2)
1062   (inst jmp #:z error:)
1063   (inst mov reg2 call-2)
1064   (inst sar reg2 4)
1065   (inst cmp reg2 0)
1066   (inst jmp #:l  error:)
1067   (inst shr reg3 8)
1068   (inst cmp reg3 reg2)
1069   (inst jmp #:le error:)
1070   (inst mov reg1 (Q reg1 1 reg2 8))
1071   (inst jmp out:)
1072  error:
1073   (c-call scm_vector_ref)
1074  out:
1075   (inst mov (local-ref dst) reg1))
1076
1077
1078
1079 (define-vm-inst constant-vector-ref 94 ((U8_U8_U8_U8 dst ar i))
1080   (inst mov call-1 (local-ref ar))
1081   (inst mov call-2 i)
1082   (NONWEAK-VECTOR? call-1 reg3 error:)
1083   (inst shr reg3 8)
1084   (inst cmp reg3 call-2)
1085   (inst jmp #:le error:)
1086   (inst mov reg1 (Q reg1 1 call-2 8))
1087   (inst jmp out:)
1088  error:
1089   (inum call-2)
1090   (c-call scm_vector_ref)
1091  out:
1092   (inst mov (local-ref dst) reg1))
1093
1094
1095 (define-vm-inst vm-vector-set! 95 ((U8_U8_U8_U8 ar i v))
1096   (inst mov call-1 (local-ref ar))
1097   (inst mov call-2 (local-ref i))
1098   (inst mov call-3 (local-ref v))
1099   (NONWEAK-VECTOR? call-1 reg3 error:)
1100   (inst test call-2 2)
1101   (inst jmp #:z error:)
1102   (inst mov reg2 call-2)
1103   (inst sar reg2 4)
1104   (inst cmp reg2 0)
1105   (inst jmp #:l  error:)
1106   (inst shr reg3 8)
1107   (inst cmp reg3 reg2)
1108   (inst jmp #:le error:)
1109   (inst mov (Q reg1 1 reg2 8) call-3)
1110   (inst jmp out:)
1111  error:
1112   (c-call scm_vector_set_x)
1113  out:)
1114
1115
1116   
1117 (define-vm-inst struct-vtable 96 ((U8_U12_U12 dst src))
1118   (inst mov call-1 (local-ref src))
1119   (STRUCT? call-1 reg2 error:)
1120   (inst sub reg2 tc3_struct)
1121   (inst mov reg1 (Q reg2 2))
1122   (inst jmp out:)
1123  error:
1124   (c-call g_struct_error)
1125  out:
1126   (inst mov (local-ref dst) reg1))
1127
1128
1129 (define-vm-inst make-struct 97 ((U8_U12_U12 dst vtable_r) 
1130                                 (X8_R24     n_init) 
1131                                 (N  vec     n_init))
1132   (for-each
1133    (lambda (x) 
1134      (inst mov reg1 (local-ref x))
1135      (inst push reg1))
1136    (reverse vec))
1137   (inst mov call-1 (local-ref vtable_r))
1138   (inst mov call-2 rsp)
1139   (inst mov call-3 n_init)
1140   (c-call g_make_struct)
1141   (inst mov (local-ref dst) reg1))
1142
1143
1144 (define-vm-inst struct-ref 98 ((U8_U8_U8_U8 dst src n))
1145   (inst mov call-1 (local-ref src))
1146   (inst mov call-2 (local-ref n))
1147   (STRUCT? call-1 reg1 error:)
1148   (inst sub reg1 tc3_struct)
1149   (inst mov reg2 (Q reg1 1))
1150   (inst test reg2 #b100000)
1151   (inst jmp #:z error:)
1152   (inst test call-2 2)
1153   (inst test #:z error:)
1154   (inst mov reg2 call-2)  
1155   (inst sar reg2 4)
1156   (inst mov reg3 (Q reg1 2))
1157   (inst mov reg3 (Q reg3))
1158   (inst sub reg3 tc3_struct)
1159   (inst mov reg3 (Q reg3 6))
1160   (inst cmp reg2 reg3)
1161   (inst jmp #:ge error:)
1162   (inst mov reg1 (Q reg1 1 reg2 8))
1163   (inst jmp out:)
1164  error:
1165   (c-call scm_struct_ref)
1166  out:
1167   (inst mov (local-ref dst) reg1))
1168
1169
1170 (define-vm-inst struct-set! 99 ((U8_U8_U8_U8 dst src n))
1171   (inst mov call-1 (local-ref src))
1172   (inst mov call-2 (local-ref n))
1173   (STRUCT? call-1 reg1 error:)
1174   (inst sub reg1 tc3_struct)
1175   (inst mov reg2 (Q reg1 1))
1176   (inst test reg2 #b100000)
1177   (inst jmp #:z error:)
1178   (inst test call-2 2)
1179   (inst test #:z error:)
1180   (inst mov reg2 call-2)  
1181   (inst sar reg2 4)
1182   (inst mov reg3 (Q reg1 2))
1183   (inst mov reg3 (Q reg3))
1184   (inst sub reg3 tc3_struct)
1185   (inst mov reg3 (Q reg3 6))
1186   (inst cmp reg2 reg3)
1187   (inst jmp #:ge error:)
1188   (inst mov (Q reg1 1 reg2 8) call-3)
1189   (inst jmp out:)
1190  error:
1191   (c-call scm_struct_set_x)
1192  out:
1193   (inst mov (local-ref dst) reg1))
1194
1195
1196 (define-vm-inst class-of 100 ((U8_U12_U12 dst src))
1197   (inst mov call-1 (local-ref src))
1198   (STRUCT? call-1 reg2 error:)
1199   (inst sub reg2 tc3_struct)
1200   (inst mov reg1 (Q reg2 2))
1201   (inst jmp out:)
1202  error:
1203   (c-call scm_class_of)
1204  out:
1205   (inst mov (local-ref dst) reg1))
1206
1207
1208 (define-vm-inst slot-ref 101 ((U8_U8_U8_U8 dst src idx))
1209   (inst mov reg1 (local-ref src))
1210   (inst mov reg1 (Q reg1 (+ 1 idx)))
1211   (inst mov (local-ref dst) reg1))
1212
1213 (define-vm-inst slot-set 102 ((U8_U8_U8_U8 dst src idx))
1214   (inst mov reg1 (local-ref dst))
1215   (inst mov reg2 (local-ref src))
1216   (inst mov (Q reg1 (+ 1 idx)) reg2))
1217
1218
1219 (define-vm-inst load-typed-array 103 ((U8_U8_U8_U8 dst type shape)
1220                                       (N32 offset)
1221                                       (U32 len)
1222                                       (IP ip (- offset 2)))
1223   (inst mov call-1 (local-ref type))
1224   (inst mov call-2 (local-ref shape))
1225   (inst mov call-3 ip)
1226   (inst mov call-4 len)
1227   (c-call scm_from_contiguous_typed_array)
1228   (inst mov (local-ref dst) reg1))
1229
1230
1231 (define-vm-inst make-array 104 ((U8_U12_U12 dst type)
1232                                 (X8_U12_U12 fill bounds))
1233   (inst mov call-1 (local-ref type))
1234   (inst mov call-2 (local-ref fill))
1235   (inst mov call-3 (local-ref bounds))
1236   (c-call scm_make_typed_array)
1237   (inst mov (local-ref dst) reg1))
1238
1239
1240
1241 (define-syntax-rule (bv-fixable-int-ref nm n C . l)
1242   (define-vm-inst nm n ((U8_U8_U8_U8 dst bv idx))
1243     (inst mov call-1 (local-ref bv))
1244     (inst mov call-2 (local-ref idx))
1245     (c-call C)
1246     (inst mov (local-ref dst reg1))))
1247
1248
1249 (define-syntax-rule (bv-int-ref nm n C . l)
1250   (define-vm-inst nm n ((U8_U8_U8_U8 dst bv idx))
1251     (inst mov call-1 (local-ref bv))
1252     (inst mov call-2 (local-ref idx))
1253     (c-call C)
1254     (inst mov (local-ref dst reg1))))
1255
1256 (define-syntax-rule (bv-float-ref nm n C . l)
1257   (define-vm-inst nm n ((U8_U8_U8_U8 dst bv idx))
1258     (inst mov call-1 (local-ref bv))
1259     (inst mov call-2 (local-ref idx))
1260     (c-call C)
1261     (inst mov (local-ref dst reg1))))
1262
1263 (bv-fixable-int-ref bv-u8-ref  105 scm_bytevector_u8_ref)
1264 (bv-fixable-int-ref bv-u8-ref  106 scm_bytevector_s8_ref)
1265 (bv-fixable-int-ref bv-u16-ref 107 scm_bytevector_u16_ref)
1266 (bv-fixable-int-ref bv-u16-ref 108 scm_bytevector_s16_ref)
1267 (bv-fixable-int-ref bv-u32-ref 109 scm_bytevector_u32_ref)
1268 (bv-fixable-int-ref bv-u32-ref 110 scm_bytevector_s32_ref)
1269
1270 (bv-int-ref vm-u64-ref 111 scm_bytevector_u64_native_ref)
1271 (bv-int-ref vm-u64-ref 112 scm_bytevector_s64_native_ref)
1272
1273 (bv-float-ref vm-f32-ref 113 scm_bytevector_f32_native_ref)
1274 (bv-float-ref vm-f32-ref 114 scm_bytevector_f64_native_ref)
1275
1276
1277 (define-syntax-rule (bv-fixable-int-set nm n C . l)
1278   (define-vm-inst nm n ((U8_U8_U8_U8 dst idx src))
1279     (inst mov call-1 (local-ref dst))
1280     (inst mov call-2 (local-ref idx))
1281     (inst mov call-3 (local-ref src))
1282     (c-call C)))
1283
1284 (define-syntax-rule (bv-int-set nm n C . l)
1285   (define-vm-inst nm n ((U8_U8_U8_U8 dst idx src))
1286     (inst mov call-1 (local-ref dst))
1287     (inst mov call-2 (local-ref idx))
1288     (inst mov call-3 (local-ref src))
1289     (c-call C)))
1290
1291 (define-syntax-rule (bv-float-set nm n C . l)
1292   (define-vm-inst nm n ((U8_U8_U8_U8 dst idx src))
1293     (inst mov call-1 (local-ref dst))
1294     (inst mov call-2 (local-ref idx))
1295     (inst mov call-3 (local-ref src))
1296     (c-call C)))
1297
1298 (bv-fixable-int-set bv-u8-set  115 scm_bytevector_u8_set_x)
1299 (bv-fixable-int-set bv-u8-set  116 scm_bytevector_s8_set_x)
1300 (bv-fixable-int-set bv-u16-set 117 scm_bytevector_u16_set_x)
1301 (bv-fixable-int-set bv-u16-set 118 scm_bytevector_s16_set_x)
1302 (bv-fixable-int-set bv-u32-set 119 scm_bytevector_u32_set_x)
1303 (bv-fixable-int-set bv-u32-set 120 scm_bytevector_s32_set_x)
1304
1305 (bv-int-ref vm-u64-set 121 scm_bytevector_u64_native_set_x)
1306 (bv-int-ref vm-u64-set 122 scm_bytevector_s64_native_set_x)
1307
1308 (bv-float-ref vm-f32-set 123 scm_bytevector_f32_native_set_x scm_from_float
1309             4 D 3 void)
1310 (bv-float-ref vm-f32-set 124 scm_bytevector_f64_native_set_x scm_from_double
1311             8 Q 7 void)
1312
1313