unmaintained/arm/bootstrap.factor

   1 ! Copyright (C) 2007 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: bootstrap.image.private kernel namespaces system
   4 cpu.arm.assembler math layouts words compiler.units ;
   5 IN: bootstrap.arm
   6
   7 ! We generate ARM3 code
   8 f have-BX? set
   9
  10 4 \ cell set
  11 big-endian off
  12
  13 4 jit-code-format set
  14
  15 : ds-reg R5 ;
  16
  17 : word-reg R0 ;
  18 : quot-reg R0 ;
  19 : scan-reg R2 ;
  20 : temp-reg R3 ;
  21 : xt-reg R12 ;
  22
  23 : stack-frame 16 bootstrap-cells ;
  24
  25 : next-save stack-frame 2 bootstrap-cells - ;
  26 : xt-save stack-frame 3 bootstrap-cells - ;
  27 : array-save stack-frame 4 bootstrap-cells - ;
  28 : scan-save stack-frame 5 bootstrap-cells - ;
  29
  30 [
  31     temp-reg quot-reg quot-array@ <+> LDR      ! load array
  32     scan-reg temp-reg scan@ ADD                ! initialize scan pointer
  33 ] { } make jit-setup set
  34
  35 [
  36     LR SP 4 <-> STR                            ! save return address
  37     SP SP stack-frame SUB
  38     xt-reg SP xt-save <+> STR                  ! save XT
  39     xt-reg stack-frame MOV
  40     xt-reg SP next-save <+> STR                ! save frame size
  41     temp-reg SP array-save <+> STR             ! save array
  42 ] { } make jit-prolog set
  43
  44 [
  45     temp-reg scan-reg 4 <!+> LDR               ! load literal and advance
  46     temp-reg ds-reg 4 <!+> STR                 ! push literal
  47 ] { } make jit-push-literal set
  48
  49 [
  50     temp-reg scan-reg 4 <!+> LDR               ! load wrapper and advance
  51     temp-reg dup wrapper@ <+> LDR              ! load wrapped object
  52     temp-reg ds-reg 4 <!+> STR                 ! push wrapped object
  53 ] { } make jit-push-wrapper set
  54
  55 [
  56     R1 SP 4 SUB                                ! pass stack pointer to primitive
  57 ] { } make jit-word-primitive-jump set
  58
  59 [
  60     R1 SP 4 SUB                                ! pass stack pointer to primitive
  61 ] { } make jit-word-primitive-call set
  62
  63 : load-word-xt ( -- )
  64     word-reg scan-reg 4 <!+> LDR               ! load word and advance
  65     xt-reg word-reg word-xt@ <+> LDR ;
  66
  67 : jit-call
  68     scan-reg SP scan-save <+> STR              ! save scan pointer
  69     LR PC MOV                                  ! save return address
  70     xt-reg BX                                  ! call
  71     scan-reg SP scan-save <+> LDR              ! restore scan pointer
  72     ;
  73
  74 : jit-jump
  75     xt-reg BX ;
  76
  77 [ load-word-xt jit-call ] { } make jit-word-call set
  78
  79 [ load-word-xt jit-jump ] { } make jit-word-jump set
  80
  81 : load-quot-xt
  82     xt-reg quot-reg quot-xt@ <+> LDR ;
  83
  84 : load-branch
  85     temp-reg ds-reg 4 <-!> LDR                 ! pop boolean
  86     temp-reg \ f tag-number CMP                ! compare it with f
  87     quot-reg scan-reg MOV                      ! point quot-reg at false branch
  88     quot-reg dup 4 EQ ADD                      ! point quot-reg at true branch
  89     quot-reg dup 4 <+> LDR                     ! load the branch
  90     scan-reg dup 12 ADD                        ! advance scan pointer
  91     load-quot-xt
  92     ;
  93
  94 [
  95     load-branch jit-jump
  96 ] { } make jit-if-jump set
  97
  98 [
  99     load-branch jit-call
 100 ] { } make jit-if-call set
 101
 102 [
 103     temp-reg ds-reg 4 <-!> LDR                 ! pop index
 104     temp-reg dup 1 <LSR> MOV                   ! turn it into an array offset
 105     scan-reg dup 4 <+> LDR                     ! load array
 106     temp-reg dup scan-reg ADD                  ! compute quotation location
 107     quot-reg temp-reg array-start <+> LDR      ! load quotation
 108     load-quot-xt
 109     jit-jump
 110 ] { } make jit-dispatch set
 111
 112 [
 113     SP SP stack-frame ADD                      ! pop stack frame
 114     LR SP 4 <-> LDR                            ! load return address
 115 ] { } make jit-epilog set
 116
 117 [ LR BX ] { } make jit-return set
 118
 119 [ "bootstrap.arm" forget-vocab ] with-compilation-unit