library/platform/native/cross-compiler.factor

   1 ! :folding=none:collapseFolds=1:
   2
   3 ! $Id$
   4 !
   5 ! Copyright (C) 2004 Slava Pestov.
   6 !
   7 ! Redistribution and use in source and binary forms, with or without
   8 ! modification, are permitted provided that the following conditions are met:
   9 !
  10 ! 1. Redistributions of source code must retain the above copyright notice,
  11 !    this list of conditions and the following disclaimer.
  12 !
  13 ! 2. Redistributions in binary form must reproduce the above copyright notice,
  14 !    this list of conditions and the following disclaimer in the documentation
  15 !    and/or other materials provided with the distribution.
  16 !
  17 ! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
  18 ! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
  19 ! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  20 ! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  21 ! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
  22 ! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
  23 ! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  24 ! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
  25 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
  26 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  27
  28 IN: cross-compiler
  29 USE: arithmetic
  30 USE: kernel
  31 USE: lists
  32 USE: parser
  33 USE: stack
  34 USE: stdio
  35 USE: streams
  36 USE: strings
  37 USE: vectors
  38 USE: vectors
  39 USE: vocabularies
  40 USE: words
  41
  42 IN: kernel
  43 DEFER: getenv
  44 DEFER: setenv
  45 DEFER: save-image
  46 DEFER: handle?
  47 DEFER: room
  48
  49 IN: strings
  50 DEFER: str=
  51 DEFER: str-hashcode
  52
  53 IN: io-internals
  54 DEFER: open-file
  55 DEFER: server-socket
  56 DEFER: close-fd
  57 DEFER: accept-fd
  58 DEFER: read-line-fd-8
  59 DEFER: write-fd-8
  60 DEFER: flush-fd
  61 DEFER: shutdown-fd
  62
  63 IN: words
  64 DEFER: <word>
  65 DEFER: word-primitive
  66 DEFER: set-word-primitive
  67 DEFER: word-parameter
  68 DEFER: set-word-parameter
  69 DEFER: word-plist
  70 DEFER: set-word-plist
  71
  72 IN: cross-compiler
  73
  74 : primitives, ( -- )
  75     1 [
  76         execute
  77         call
  78         ifte
  79         cons?
  80         cons
  81         car
  82         cdr
  83         rplaca
  84         rplacd
  85         vector?
  86         <vector>
  87         vector-length
  88         set-vector-length
  89         vector-nth
  90         set-vector-nth
  91         string?
  92         str-length
  93         str-nth
  94         str-compare
  95         str=
  96         str-hashcode
  97         index-of*
  98         substring
  99         sbuf?
 100         <sbuf>
 101         sbuf-length
 102         set-sbuf-length
 103         sbuf-nth
 104         set-sbuf-nth
 105         sbuf-append
 106         sbuf>str
 107         fixnum?
 108         bignum?
 109         +
 110         -
 111         *
 112         /
 113         mod
 114         /mod
 115         bitand
 116         bitor
 117         bitxor
 118         bitnot
 119         shift<
 120         shift>
 121         <
 122         <=
 123         >
 124         >=
 125         word?
 126         <word>
 127         word-primitive
 128         set-word-primitive
 129         word-parameter
 130         set-word-parameter
 131         word-plist
 132         set-word-plist
 133         drop
 134         dup
 135         swap
 136         over
 137         pick
 138         nip
 139         tuck
 140         rot
 141         >r
 142         r>
 143         eq?
 144         getenv
 145         setenv
 146         open-file
 147         garbage-collection
 148         save-image
 149         datastack
 150         callstack
 151         set-datastack
 152         set-callstack
 153         handle?
 154         exit*
 155         server-socket
 156         close-fd
 157         accept-fd
 158         read-line-fd-8
 159         write-fd-8
 160         flush-fd
 161         shutdown-fd
 162         room
 163     ] [
 164         swap succ tuck primitive,
 165     ] each drop ;
 166
 167 : worddef, ( word -- )
 168     dup compound-or-compiled? [
 169         dup word-of-worddef swap compound>list compound,
 170     ] [
 171         drop
 172     ] ifte ;
 173
 174 : version, ( -- )
 175     "version" [ "kernel" ] search
 176     version unit
 177     <compound>
 178     worddef, ;
 179
 180 : cross-compile ( quot -- )
 181     [ dup worddef? [ worddef, ] [ drop ] ifte ] each ;
 182
 183 : cross-compile-resource ( resource -- )
 184     parse-resource cross-compile ;
 185
 186 : make-image ( -- )
 187     #! Make an image for the C interpreter.
 188     [
 189         "/library/platform/native/boot.factor" run-resource
 190     ] with-image
 191
 192     ! Uncomment this on sparc and powerpc.
 193     ! "big-endian" on
 194     "factor.image" write-image ;