shell/cell.mu

   1 type cell {
   2   type: int
   3   # type 0: pair; the unit of lists, trees, DAGS or graphs
   4   left: (handle cell)
   5   right: (handle cell)
   6   # type 1: number
   7   number-data: float
   8   # type 2: symbol
   9   # type 3: stream
  10   text-data: (handle stream byte)
  11   # type 4: primitive function
  12   index-data: int
  13   # type 5: screen
  14   screen-data: (handle screen)
  15   # type 6: keyboard
  16   keyboard-data: (handle gap-buffer)
  17   # type 7: array
  18   array-data: (handle array handle cell)
  19   # type 8: image
  20   image-data: (handle image)
  21   # TODO: (associative) table
  22   # if you add types here, don't forget to update cell-isomorphic?
  23 }
  24
  25 fn allocate-symbol _out: (addr handle cell) {
  26   var out/eax: (addr handle cell) <- copy _out
  27   allocate out
  28   var out-addr/eax: (addr cell) <- lookup *out
  29   var type/ecx: (addr int) <- get out-addr, type
  30   copy-to *type, 2/symbol
  31   var dest-ah/eax: (addr handle stream byte) <- get out-addr, text-data
  32   populate-stream dest-ah, 0x40/max-symbol-size
  33 }
  34
  35 fn initialize-symbol _out: (addr handle cell), val: (addr array byte) {
  36   var out/eax: (addr handle cell) <- copy _out
  37   var out-addr/eax: (addr cell) <- lookup *out
  38   var dest-ah/eax: (addr handle stream byte) <- get out-addr, text-data
  39   var dest/eax: (addr stream byte) <- lookup *dest-ah
  40   write dest, val
  41 }
  42
  43 fn new-symbol out: (addr handle cell), val: (addr array byte) {
  44   allocate-symbol out
  45   initialize-symbol out, val
  46 }
  47
  48 fn symbol? _x: (addr cell) -> _/eax: boolean {
  49   var x/esi: (addr cell) <- copy _x
  50   var type/eax: (addr int) <- get x, type
  51   compare *type, 2/symbol
  52   {
  53     break-if-=
  54     return 0/false
  55   }
  56   return 1/true
  57 }
  58
  59 fn symbol-equal? _in: (addr cell), name: (addr array byte) -> _/eax: boolean {
  60   var in/esi: (addr cell) <- copy _in
  61   var in-type/eax: (addr int) <- get in, type
  62   compare *in-type, 2/symbol
  63   {
  64     break-if-=
  65     return 0/false
  66   }
  67   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
  68   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
  69   var result/eax: boolean <- stream-data-equal? in-data, name
  70   return result
  71 }
  72
  73 fn allocate-stream _out: (addr handle cell) {
  74   var out/eax: (addr handle cell) <- copy _out
  75   allocate out
  76   var out-addr/eax: (addr cell) <- lookup *out
  77   var type/ecx: (addr int) <- get out-addr, type
  78   copy-to *type, 3/stream
  79   var dest-ah/eax: (addr handle stream byte) <- get out-addr, text-data
  80   populate-stream dest-ah, 0x40/max-stream-size
  81 }
  82
  83 fn allocate-number _out: (addr handle cell) {
  84   var out/eax: (addr handle cell) <- copy _out
  85   allocate out
  86   var out-addr/eax: (addr cell) <- lookup *out
  87   var type/ecx: (addr int) <- get out-addr, type
  88   copy-to *type, 1/number
  89 }
  90
  91 fn initialize-integer _out: (addr handle cell), n: int {
  92   var out/eax: (addr handle cell) <- copy _out
  93   var out-addr/eax: (addr cell) <- lookup *out
  94   var dest-addr/eax: (addr float) <- get out-addr, number-data
  95   var src/xmm0: float <- convert n
  96   copy-to *dest-addr, src
  97 }
  98
  99 fn new-integer out: (addr handle cell), n: int {
 100   allocate-number out
 101   initialize-integer out, n
 102 }
 103
 104 fn initialize-float _out: (addr handle cell), n: float {
 105   var out/eax: (addr handle cell) <- copy _out
 106   var out-addr/eax: (addr cell) <- lookup *out
 107   var dest-ah/eax: (addr float) <- get out-addr, number-data
 108   var src/xmm0: float <- copy n
 109   copy-to *dest-ah, src
 110 }
 111
 112 fn new-float out: (addr handle cell), n: float {
 113   allocate-number out
 114   initialize-float out, n
 115 }
 116
 117 fn number? _x: (addr cell) -> _/eax: boolean {
 118   var x/esi: (addr cell) <- copy _x
 119   var type/eax: (addr int) <- get x, type
 120   compare *type, 1/number
 121   {
 122     break-if-=
 123     return 0/false
 124   }
 125   return 1/true
 126 }
 127
 128 fn allocate-pair out: (addr handle cell) {
 129   allocate out
 130   # new cells have type pair by default
 131 }
 132
 133 fn initialize-pair _out: (addr handle cell), left: (handle cell), right: (handle cell) {
 134   var out/eax: (addr handle cell) <- copy _out
 135   var out-addr/eax: (addr cell) <- lookup *out
 136   var dest-ah/ecx: (addr handle cell) <- get out-addr, left
 137   copy-handle left, dest-ah
 138   dest-ah <- get out-addr, right
 139   copy-handle right, dest-ah
 140 }
 141
 142 fn new-pair out: (addr handle cell), left: (handle cell), right: (handle cell) {
 143   allocate-pair out
 144   initialize-pair out, left, right
 145 }
 146
 147 fn nil out: (addr handle cell) {
 148   allocate-pair out
 149 }
 150
 151 fn pair? _x: (addr cell) -> _/eax: boolean {
 152   var x/esi: (addr cell) <- copy _x
 153   var type/eax: (addr int) <- get x, type
 154   compare *type, 0/pair
 155   {
 156     break-if-=
 157     return 0/false
 158   }
 159   return 1/true
 160 }
 161
 162 fn allocate-primitive-function _out: (addr handle cell) {
 163   var out/eax: (addr handle cell) <- copy _out
 164   allocate out
 165   var out-addr/eax: (addr cell) <- lookup *out
 166   var type/ecx: (addr int) <- get out-addr, type
 167   copy-to *type, 4/primitive-function
 168 }
 169
 170 fn initialize-primitive-function _out: (addr handle cell), n: int {
 171   var out/eax: (addr handle cell) <- copy _out
 172   var out-addr/eax: (addr cell) <- lookup *out
 173   var type/ecx: (addr int) <- get out-addr, type
 174   copy-to *type, 4/primitive
 175   var dest-addr/eax: (addr int) <- get out-addr, index-data
 176   var src/ecx: int <- copy n
 177   copy-to *dest-addr, src
 178 }
 179
 180 fn new-primitive-function out: (addr handle cell), n: int {
 181   allocate-primitive-function out
 182   initialize-primitive-function out, n
 183 }
 184
 185 fn primitive? _x: (addr cell) -> _/eax: boolean {
 186   var x/esi: (addr cell) <- copy _x
 187   var type/eax: (addr int) <- get x, type
 188   compare *type, 4/primitive
 189   {
 190     break-if-=
 191     return 0/false
 192   }
 193   return 1/true
 194 }
 195
 196 fn allocate-screen _out: (addr handle cell) {
 197   var out/eax: (addr handle cell) <- copy _out
 198   allocate out
 199   var out-addr/eax: (addr cell) <- lookup *out
 200   var type/ecx: (addr int) <- get out-addr, type
 201   copy-to *type, 5/screen
 202 }
 203
 204 fn new-fake-screen _out: (addr handle cell), width: int, height: int, pixel-graphics?: boolean {
 205   var out/eax: (addr handle cell) <- copy _out
 206   allocate-screen out
 207   var out-addr/eax: (addr cell) <- lookup *out
 208   var dest-ah/eax: (addr handle screen) <- get out-addr, screen-data
 209   allocate dest-ah
 210   var dest-addr/eax: (addr screen) <- lookup *dest-ah
 211   initialize-screen dest-addr, width, height, pixel-graphics?
 212 }
 213
 214 fn screen? _x: (addr cell) -> _/eax: boolean {
 215   var x/esi: (addr cell) <- copy _x
 216   var type/eax: (addr int) <- get x, type
 217   compare *type, 5/screen
 218   {
 219     break-if-=
 220     return 0/false
 221   }
 222   return 1/true
 223 }
 224
 225 fn clear-screen-var _self-ah: (addr handle cell) {
 226   var self-ah/eax: (addr handle cell) <- copy _self-ah
 227   var self/eax: (addr cell) <- lookup *self-ah
 228   compare self, 0
 229   {
 230     break-if-!=
 231     return
 232   }
 233   var screen-ah/eax: (addr handle screen) <- get self, screen-data
 234   var screen/eax: (addr screen) <- lookup *screen-ah
 235   clear-screen screen
 236 }
 237
 238 fn allocate-keyboard _out: (addr handle cell) {
 239   var out/eax: (addr handle cell) <- copy _out
 240   allocate out
 241   var out-addr/eax: (addr cell) <- lookup *out
 242   var type/ecx: (addr int) <- get out-addr, type
 243   copy-to *type, 6/keyboard
 244 }
 245
 246 fn new-fake-keyboard _out: (addr handle cell), capacity: int {
 247   var out/eax: (addr handle cell) <- copy _out
 248   allocate-keyboard out
 249   var out-addr/eax: (addr cell) <- lookup *out
 250   var dest-ah/eax: (addr handle gap-buffer) <- get out-addr, keyboard-data
 251   allocate dest-ah
 252   var dest-addr/eax: (addr gap-buffer) <- lookup *dest-ah
 253   initialize-gap-buffer dest-addr, capacity
 254 }
 255
 256 fn keyboard? _x: (addr cell) -> _/eax: boolean {
 257   var x/esi: (addr cell) <- copy _x
 258   var type/eax: (addr int) <- get x, type
 259   compare *type, 6/keyboard
 260   {
 261     break-if-=
 262     return 0/false
 263   }
 264   return 1/true
 265 }
 266
 267 fn rewind-keyboard-var _self-ah: (addr handle cell) {
 268   var self-ah/eax: (addr handle cell) <- copy _self-ah
 269   var self/eax: (addr cell) <- lookup *self-ah
 270   compare self, 0
 271   {
 272     break-if-!=
 273     return
 274   }
 275   var keyboard-ah/eax: (addr handle gap-buffer) <- get self, keyboard-data
 276   var keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
 277   rewind-gap-buffer keyboard
 278 }
 279
 280 fn new-array _out: (addr handle cell), capacity: int {
 281   var out/eax: (addr handle cell) <- copy _out
 282   allocate out
 283   var out-addr/eax: (addr cell) <- lookup *out
 284   var type/ecx: (addr int) <- get out-addr, type
 285   copy-to *type, 7/array
 286   var dest-ah/eax: (addr handle array handle cell) <- get out-addr, array-data
 287   populate dest-ah, capacity
 288 }
 289
 290 fn array? _x: (addr cell) -> _/eax: boolean {
 291   var x/esi: (addr cell) <- copy _x
 292   var type/eax: (addr int) <- get x, type
 293   compare *type, 7/array
 294   {
 295     break-if-=
 296     return 0/false
 297   }
 298   return 1/true
 299 }
 300
 301 fn new-image _out-ah: (addr handle cell), in: (addr stream byte) {
 302   rewind-stream in
 303   var out-ah/eax: (addr handle cell) <- copy _out-ah
 304   allocate out-ah
 305   var out/eax: (addr cell) <- lookup *out-ah
 306   var type/ecx: (addr int) <- get out, type
 307   copy-to *type, 8/image
 308   var dest-ah/eax: (addr handle image) <- get out, image-data
 309   allocate dest-ah
 310   var dest/eax: (addr image) <- lookup *dest-ah
 311   initialize-image dest, in
 312 }
 313
 314 fn image? _x: (addr cell) -> _/eax: boolean {
 315   var x/esi: (addr cell) <- copy _x
 316   var type/eax: (addr int) <- get x, type
 317   compare *type, 8/image
 318   {
 319     break-if-=
 320     return 0/false
 321   }
 322   return 1/true
 323 }