From 5a3f9a31850d6da72dff7211c9760cd4a8e1090b Mon Sep 17 00:00:00 2001 From: Kartik Agaram Date: Tue, 13 Apr 2021 21:11:26 -0700 Subject: . --- html/shell/global.mu.html | 849 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 849 insertions(+) create mode 100644 html/shell/global.mu.html (limited to 'html/shell/global.mu.html') diff --git a/html/shell/global.mu.html b/html/shell/global.mu.html new file mode 100644 index 00000000..ce11b5f0 --- /dev/null +++ b/html/shell/global.mu.html @@ -0,0 +1,849 @@ + + + + +Mu - shell/global.mu + + + + + + + + + + +https://github.com/akkartik/mu/blob/main/shell/global.mu +
+  1 type global {
+  2   name: (handle array byte)
+  3   value: (handle cell)
+  4 }
+  5 
+  6 type global-table {
+  7   data: (handle array global)
+  8   final-index: int
+  9 }
+ 10 
+ 11 fn initialize-globals _self: (addr global-table) {
+ 12   var self/esi: (addr global-table) <- copy _self
+ 13   var data-ah/eax: (addr handle array global) <- get self, data
+ 14   populate data-ah, 0x10
+ 15   # generic
+ 16   append-primitive self, "="
+ 17   # for numbers
+ 18   append-primitive self, "+"
+ 19   append-primitive self, "-"
+ 20   append-primitive self, "*"
+ 21   append-primitive self, "/"
+ 22   append-primitive self, "sqrt"
+ 23   # for pairs
+ 24   append-primitive self, "car"
+ 25   append-primitive self, "cdr"
+ 26   append-primitive self, "cons"
+ 27   # for screens
+ 28   append-primitive self, "print"
+ 29   # for keyboards
+ 30   append-primitive self, "key"
+ 31   # for streams
+ 32   append-primitive self, "stream"
+ 33   append-primitive self, "write"
+ 34 }
+ 35 
+ 36 fn render-globals screen: (addr screen), _self: (addr global-table), xmin: int, ymin: int, xmax: int, ymax: int {
+ 37   clear-rect screen, xmin, ymin, xmax, ymax, 0x12/bg=almost-black
+ 38   var self/esi: (addr global-table) <- copy _self
+ 39   # render primitives
+ 40   var bottom-line/ecx: int <- copy ymax
+ 41   bottom-line <- decrement
+ 42   var data-ah/eax: (addr handle array global) <- get self, data
+ 43   var data/eax: (addr array global) <- lookup *data-ah
+ 44   var curr-index/edx: int <- copy 1
+ 45   var x/edi: int <- copy xmin
+ 46   {
+ 47     var curr-offset/ebx: (offset global) <- compute-offset data, curr-index
+ 48     var curr/ebx: (addr global) <- index data, curr-offset
+ 49     var continue?/eax: boolean <- primitive-global? curr
+ 50     compare continue?, 0/false
+ 51     break-if-=
+ 52     var curr-name-ah/eax: (addr handle array byte) <- get curr, name
+ 53     var _curr-name/eax: (addr array byte) <- lookup *curr-name-ah
+ 54     var curr-name/ebx: (addr array byte) <- copy _curr-name
+ 55     var tmpx/eax: int <- copy x
+ 56     tmpx <- draw-text-rightward screen, curr-name, tmpx, xmax, bottom-line, 0x2a/fg=orange, 0x12/bg=almost-black
+ 57     tmpx <- draw-text-rightward screen, " ", tmpx, xmax, bottom-line, 7/fg=grey, 0x12/bg=almost-black
+ 58     x <- copy tmpx
+ 59     curr-index <- increment
+ 60     loop
+ 61   }
+ 62   var lowest-index/edi: int <- copy curr-index
+ 63   var y/ecx: int <- copy ymin
+ 64   var data-ah/eax: (addr handle array global) <- get self, data
+ 65   var data/eax: (addr array global) <- lookup *data-ah
+ 66   var final-index/edx: (addr int) <- get self, final-index
+ 67   var curr-index/edx: int <- copy *final-index
+ 68   {
+ 69     compare curr-index, lowest-index
+ 70     break-if-<
+ 71     compare y, ymax
+ 72     break-if->=
+ 73     {
+ 74       var curr-offset/ebx: (offset global) <- compute-offset data, curr-index
+ 75       var curr/ebx: (addr global) <- index data, curr-offset
+ 76       var curr-name-ah/eax: (addr handle array byte) <- get curr, name
+ 77       var _curr-name/eax: (addr array byte) <- lookup *curr-name-ah
+ 78       var curr-name/edx: (addr array byte) <- copy _curr-name
+ 79       var x/eax: int <- copy xmin
+ 80       x, y <- draw-text-wrapping-right-then-down screen, curr-name, xmin, ymin, xmax, ymax, x, y, 0x2a/fg=orange, 0x12/bg=almost-black
+ 81       x, y <- draw-text-wrapping-right-then-down screen, " <- ", xmin, ymin, xmax, ymax, x, y, 7/fg=grey, 0x12/bg=almost-black
+ 82       var curr-value/edx: (addr handle cell) <- get curr, value
+ 83       var s-storage: (stream byte 0x100)
+ 84       var s/ebx: (addr stream byte) <- address s-storage
+ 85       print-cell curr-value, s, 0/no-trace
+ 86       x, y <- draw-stream-wrapping-right-then-down screen, s, xmin, ymin, xmax, ymax, x, y, 0x3/fg=cyan, 0x12/bg=almost-black
+ 87     }
+ 88     curr-index <- decrement
+ 89     y <- increment
+ 90     loop
+ 91   }
+ 92 }
+ 93 
+ 94 fn primitive-global? _x: (addr global) -> _/eax: boolean {
+ 95   var x/eax: (addr global) <- copy _x
+ 96   var value-ah/eax: (addr handle cell) <- get x, value
+ 97   var value/eax: (addr cell) <- lookup *value-ah
+ 98   compare value, 0/null
+ 99   {
+100     break-if-!=
+101     return 0/false
+102   }
+103   var value-type/eax: (addr int) <- get value, type
+104   compare *value-type, 4/primitive
+105   {
+106     break-if-=
+107     return 0/false
+108   }
+109   return 1/true
+110 }
+111 
+112 fn append-primitive _self: (addr global-table), name: (addr array byte) {
+113   var self/esi: (addr global-table) <- copy _self
+114   var final-index-addr/ecx: (addr int) <- get self, final-index
+115   increment *final-index-addr
+116   var curr-index/ecx: int <- copy *final-index-addr
+117   var data-ah/eax: (addr handle array global) <- get self, data
+118   var data/eax: (addr array global) <- lookup *data-ah
+119   var curr-offset/esi: (offset global) <- compute-offset data, curr-index
+120   var curr/esi: (addr global) <- index data, curr-offset
+121   var curr-name-ah/eax: (addr handle array byte) <- get curr, name
+122   copy-array-object name, curr-name-ah
+123   var curr-value-ah/eax: (addr handle cell) <- get curr, value
+124   new-primitive-function curr-value-ah, curr-index
+125 }
+126 
+127 fn append-global _self: (addr global-table), name: (addr array byte), value: (handle cell) {
+128   var self/esi: (addr global-table) <- copy _self
+129   var final-index-addr/ecx: (addr int) <- get self, final-index
+130   increment *final-index-addr
+131   var curr-index/ecx: int <- copy *final-index-addr
+132   var data-ah/eax: (addr handle array global) <- get self, data
+133   var data/eax: (addr array global) <- lookup *data-ah
+134   var curr-offset/esi: (offset global) <- compute-offset data, curr-index
+135   var curr/esi: (addr global) <- index data, curr-offset
+136   var curr-name-ah/eax: (addr handle array byte) <- get curr, name
+137   copy-array-object name, curr-name-ah
+138   var curr-value-ah/eax: (addr handle cell) <- get curr, value
+139   copy-handle value, curr-value-ah
+140 }
+141 
+142 fn lookup-symbol-in-globals _sym: (addr cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) {
+143   var sym/eax: (addr cell) <- copy _sym
+144   var sym-name-ah/eax: (addr handle stream byte) <- get sym, text-data
+145   var _sym-name/eax: (addr stream byte) <- lookup *sym-name-ah
+146   var sym-name/edx: (addr stream byte) <- copy _sym-name
+147   var globals/esi: (addr global-table) <- copy _globals
+148   {
+149     compare globals, 0
+150     break-if-=
+151     var curr-index/ecx: int <- find-symbol-in-globals globals, sym-name
+152     compare curr-index, -1/not-found
+153     break-if-=
+154     var global-data-ah/eax: (addr handle array global) <- get globals, data
+155     var global-data/eax: (addr array global) <- lookup *global-data-ah
+156     var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index
+157     var curr/ebx: (addr global) <- index global-data, curr-offset
+158     var curr-value/eax: (addr handle cell) <- get curr, value
+159     copy-object curr-value, out
+160     return
+161   }
+162   # if sym is "screen" and screen-cell exists, return it
+163   {
+164     var sym-is-screen?/eax: boolean <- stream-data-equal? sym-name, "screen"
+165     compare sym-is-screen?, 0/false
+166     break-if-=
+167     compare screen-cell, 0
+168     break-if-=
+169     copy-object screen-cell, out
+170     return
+171   }
+172   # if sym is "keyboard" and keyboard-cell exists, return it
+173   {
+174     var sym-is-keyboard?/eax: boolean <- stream-data-equal? sym-name, "keyboard"
+175     compare sym-is-keyboard?, 0/false
+176     break-if-=
+177     compare keyboard-cell, 0
+178     break-if-=
+179     copy-object keyboard-cell, out
+180     return
+181   }
+182   # otherwise error "unbound symbol: ", sym
+183   var stream-storage: (stream byte 0x40)
+184   var stream/ecx: (addr stream byte) <- address stream-storage
+185   write stream, "unbound symbol: "
+186   rewind-stream sym-name
+187   write-stream stream, sym-name
+188   trace trace, "error", stream
+189 }
+190 
+191 # return the index in globals containing 'sym'
+192 # or -1 if not found
+193 fn find-symbol-in-globals _globals: (addr global-table), sym-name: (addr stream byte) -> _/ecx: int {
+194   var globals/esi: (addr global-table) <- copy _globals
+195   compare globals, 0
+196   {
+197     break-if-!=
+198     return -1/not-found
+199   }
+200   var global-data-ah/eax: (addr handle array global) <- get globals, data
+201   var global-data/eax: (addr array global) <- lookup *global-data-ah
+202   var final-index/ecx: (addr int) <- get globals, final-index
+203   var curr-index/ecx: int <- copy *final-index
+204   {
+205     compare curr-index, 0
+206     break-if-<
+207     var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index
+208     var curr/ebx: (addr global) <- index global-data, curr-offset
+209     var curr-name-ah/eax: (addr handle array byte) <- get curr, name
+210     var curr-name/eax: (addr array byte) <- lookup *curr-name-ah
+211     var found?/eax: boolean <- stream-data-equal? sym-name, curr-name
+212     compare found?, 0/false
+213     {
+214       break-if-=
+215       return curr-index
+216     }
+217     curr-index <- decrement
+218     loop
+219   }
+220   return -1/not-found
+221 }
+222 
+223 # a little strange; goes from value to name and selects primitive based on name
+224 fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace) {
+225   var f/esi: (addr cell) <- copy _f
+226   var f-index-a/ecx: (addr int) <- get f, index-data
+227   var f-index/ecx: int <- copy *f-index-a
+228   var globals/eax: (addr global-table) <- copy _globals
+229   var global-data-ah/eax: (addr handle array global) <- get globals, data
+230   var global-data/eax: (addr array global) <- lookup *global-data-ah
+231   var f-offset/ecx: (offset global) <- compute-offset global-data, f-index
+232   var f-value/ecx: (addr global) <- index global-data, f-offset
+233   var f-name-ah/ecx: (addr handle array byte) <- get f-value, name
+234   var f-name/eax: (addr array byte) <- lookup *f-name-ah
+235   {
+236     var is-add?/eax: boolean <- string-equal? f-name, "+"
+237     compare is-add?, 0/false
+238     break-if-=
+239     apply-add args-ah, out, trace
+240     return
+241   }
+242   {
+243     var is-subtract?/eax: boolean <- string-equal? f-name, "-"
+244     compare is-subtract?, 0/false
+245     break-if-=
+246     apply-subtract args-ah, out, trace
+247     return
+248   }
+249   {
+250     var is-multiply?/eax: boolean <- string-equal? f-name, "*"
+251     compare is-multiply?, 0/false
+252     break-if-=
+253     apply-multiply args-ah, out, trace
+254     return
+255   }
+256   {
+257     var is-divide?/eax: boolean <- string-equal? f-name, "/"
+258     compare is-divide?, 0/false
+259     break-if-=
+260     apply-divide args-ah, out, trace
+261     return
+262   }
+263   {
+264     var is-square-root?/eax: boolean <- string-equal? f-name, "sqrt"
+265     compare is-square-root?, 0/false
+266     break-if-=
+267     apply-square-root args-ah, out, trace
+268     return
+269   }
+270   {
+271     var is-car?/eax: boolean <- string-equal? f-name, "car"
+272     compare is-car?, 0/false
+273     break-if-=
+274     apply-car args-ah, out, trace
+275     return
+276   }
+277   {
+278     var is-cdr?/eax: boolean <- string-equal? f-name, "cdr"
+279     compare is-cdr?, 0/false
+280     break-if-=
+281     apply-cdr args-ah, out, trace
+282     return
+283   }
+284   {
+285     var is-cons?/eax: boolean <- string-equal? f-name, "cons"
+286     compare is-cons?, 0/false
+287     break-if-=
+288     apply-cons args-ah, out, trace
+289     return
+290   }
+291   {
+292     var is-compare?/eax: boolean <- string-equal? f-name, "="
+293     compare is-compare?, 0/false
+294     break-if-=
+295     apply-compare args-ah, out, trace
+296     return
+297   }
+298   {
+299     var is-print?/eax: boolean <- string-equal? f-name, "print"
+300     compare is-print?, 0/false
+301     break-if-=
+302     apply-print args-ah, out, trace
+303     return
+304   }
+305   {
+306     var wait-for-key?/eax: boolean <- string-equal? f-name, "key"
+307     compare wait-for-key?, 0/false
+308     break-if-=
+309     apply-wait-for-key args-ah, out, trace
+310     return
+311   }
+312   {
+313     var is-stream?/eax: boolean <- string-equal? f-name, "stream"
+314     compare is-stream?, 0/false
+315     break-if-=
+316     apply-stream args-ah, out, trace
+317     return
+318   }
+319   {
+320     var write?/eax: boolean <- string-equal? f-name, "write"
+321     compare write?, 0/false
+322     break-if-=
+323     apply-write args-ah, out, trace
+324     return
+325   }
+326   abort "unknown primitive function"
+327 }
+328 
+329 fn apply-add _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+330   trace-text trace, "eval", "apply +"
+331   var args-ah/eax: (addr handle cell) <- copy _args-ah
+332   var _args/eax: (addr cell) <- lookup *args-ah
+333   var args/esi: (addr cell) <- copy _args
+334   # TODO: check that args is a pair
+335   var empty-args?/eax: boolean <- nil? args
+336   compare empty-args?, 0/false
+337   {
+338     break-if-=
+339     error trace, "+ needs 2 args but got 0"
+340     return
+341   }
+342   # args->left->value
+343   var first-ah/eax: (addr handle cell) <- get args, left
+344   var first/eax: (addr cell) <- lookup *first-ah
+345   var first-type/ecx: (addr int) <- get first, type
+346   compare *first-type, 1/number
+347   {
+348     break-if-=
+349     error trace, "first arg for + is not a number"
+350     return
+351   }
+352   var first-value/ecx: (addr float) <- get first, number-data
+353   # args->right->left->value
+354   var right-ah/eax: (addr handle cell) <- get args, right
+355 #?   dump-cell right-ah
+356 #?   abort "aaa"
+357   var right/eax: (addr cell) <- lookup *right-ah
+358   # TODO: check that right is a pair
+359   var second-ah/eax: (addr handle cell) <- get right, left
+360   var second/eax: (addr cell) <- lookup *second-ah
+361   var second-type/edx: (addr int) <- get second, type
+362   compare *second-type, 1/number
+363   {
+364     break-if-=
+365     error trace, "second arg for + is not a number"
+366     return
+367   }
+368   var second-value/edx: (addr float) <- get second, number-data
+369   # add
+370   var result/xmm0: float <- copy *first-value
+371   result <- add *second-value
+372   new-float out, result
+373 }
+374 
+375 fn apply-subtract _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+376   trace-text trace, "eval", "apply -"
+377   var args-ah/eax: (addr handle cell) <- copy _args-ah
+378   var _args/eax: (addr cell) <- lookup *args-ah
+379   var args/esi: (addr cell) <- copy _args
+380   # TODO: check that args is a pair
+381   var empty-args?/eax: boolean <- nil? args
+382   compare empty-args?, 0/false
+383   {
+384     break-if-=
+385     error trace, "- needs 2 args but got 0"
+386     return
+387   }
+388   # args->left->value
+389   var first-ah/eax: (addr handle cell) <- get args, left
+390   var first/eax: (addr cell) <- lookup *first-ah
+391   var first-type/ecx: (addr int) <- get first, type
+392   compare *first-type, 1/number
+393   {
+394     break-if-=
+395     error trace, "first arg for - is not a number"
+396     return
+397   }
+398   var first-value/ecx: (addr float) <- get first, number-data
+399   # args->right->left->value
+400   var right-ah/eax: (addr handle cell) <- get args, right
+401   var right/eax: (addr cell) <- lookup *right-ah
+402   # TODO: check that right is a pair
+403   var second-ah/eax: (addr handle cell) <- get right, left
+404   var second/eax: (addr cell) <- lookup *second-ah
+405   var second-type/edx: (addr int) <- get second, type
+406   compare *second-type, 1/number
+407   {
+408     break-if-=
+409     error trace, "second arg for - is not a number"
+410     return
+411   }
+412   var second-value/edx: (addr float) <- get second, number-data
+413   # subtract
+414   var result/xmm0: float <- copy *first-value
+415   result <- subtract *second-value
+416   new-float out, result
+417 }
+418 
+419 fn apply-multiply _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+420   trace-text trace, "eval", "apply *"
+421   var args-ah/eax: (addr handle cell) <- copy _args-ah
+422   var _args/eax: (addr cell) <- lookup *args-ah
+423   var args/esi: (addr cell) <- copy _args
+424   # TODO: check that args is a pair
+425   var empty-args?/eax: boolean <- nil? args
+426   compare empty-args?, 0/false
+427   {
+428     break-if-=
+429     error trace, "* needs 2 args but got 0"
+430     return
+431   }
+432   # args->left->value
+433   var first-ah/eax: (addr handle cell) <- get args, left
+434   var first/eax: (addr cell) <- lookup *first-ah
+435   var first-type/ecx: (addr int) <- get first, type
+436   compare *first-type, 1/number
+437   {
+438     break-if-=
+439     error trace, "first arg for * is not a number"
+440     return
+441   }
+442   var first-value/ecx: (addr float) <- get first, number-data
+443   # args->right->left->value
+444   var right-ah/eax: (addr handle cell) <- get args, right
+445   var right/eax: (addr cell) <- lookup *right-ah
+446   # TODO: check that right is a pair
+447   var second-ah/eax: (addr handle cell) <- get right, left
+448   var second/eax: (addr cell) <- lookup *second-ah
+449   var second-type/edx: (addr int) <- get second, type
+450   compare *second-type, 1/number
+451   {
+452     break-if-=
+453     error trace, "second arg for * is not a number"
+454     return
+455   }
+456   var second-value/edx: (addr float) <- get second, number-data
+457   # multiply
+458   var result/xmm0: float <- copy *first-value
+459   result <- multiply *second-value
+460   new-float out, result
+461 }
+462 
+463 fn apply-divide _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+464   trace-text trace, "eval", "apply /"
+465   var args-ah/eax: (addr handle cell) <- copy _args-ah
+466   var _args/eax: (addr cell) <- lookup *args-ah
+467   var args/esi: (addr cell) <- copy _args
+468   # TODO: check that args is a pair
+469   var empty-args?/eax: boolean <- nil? args
+470   compare empty-args?, 0/false
+471   {
+472     break-if-=
+473     error trace, "/ needs 2 args but got 0"
+474     return
+475   }
+476   # args->left->value
+477   var first-ah/eax: (addr handle cell) <- get args, left
+478   var first/eax: (addr cell) <- lookup *first-ah
+479   var first-type/ecx: (addr int) <- get first, type
+480   compare *first-type, 1/number
+481   {
+482     break-if-=
+483     error trace, "first arg for / is not a number"
+484     return
+485   }
+486   var first-value/ecx: (addr float) <- get first, number-data
+487   # args->right->left->value
+488   var right-ah/eax: (addr handle cell) <- get args, right
+489   var right/eax: (addr cell) <- lookup *right-ah
+490   # TODO: check that right is a pair
+491   var second-ah/eax: (addr handle cell) <- get right, left
+492   var second/eax: (addr cell) <- lookup *second-ah
+493   var second-type/edx: (addr int) <- get second, type
+494   compare *second-type, 1/number
+495   {
+496     break-if-=
+497     error trace, "second arg for / is not a number"
+498     return
+499   }
+500   var second-value/edx: (addr float) <- get second, number-data
+501   # divide
+502   var result/xmm0: float <- copy *first-value
+503   result <- divide *second-value
+504   new-float out, result
+505 }
+506 
+507 fn apply-square-root _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+508   trace-text trace, "eval", "apply sqrt"
+509   var args-ah/eax: (addr handle cell) <- copy _args-ah
+510   var _args/eax: (addr cell) <- lookup *args-ah
+511   var args/esi: (addr cell) <- copy _args
+512   # TODO: check that args is a pair
+513   var empty-args?/eax: boolean <- nil? args
+514   compare empty-args?, 0/false
+515   {
+516     break-if-=
+517     error trace, "sqrt needs 1 args but got 0"
+518     return
+519   }
+520   # args->left->value
+521   var first-ah/eax: (addr handle cell) <- get args, left
+522   var first/eax: (addr cell) <- lookup *first-ah
+523   var first-type/ecx: (addr int) <- get first, type
+524   compare *first-type, 1/number
+525   {
+526     break-if-=
+527     error trace, "arg for sqrt is not a number"
+528     return
+529   }
+530   var first-value/ecx: (addr float) <- get first, number-data
+531   # square-root
+532   var result/xmm0: float <- square-root *first-value
+533   new-float out, result
+534 }
+535 
+536 fn apply-car _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+537   trace-text trace, "eval", "apply car"
+538   var args-ah/eax: (addr handle cell) <- copy _args-ah
+539   var _args/eax: (addr cell) <- lookup *args-ah
+540   var args/esi: (addr cell) <- copy _args
+541   # TODO: check that args is a pair
+542   var empty-args?/eax: boolean <- nil? args
+543   compare empty-args?, 0/false
+544   {
+545     break-if-=
+546     error trace, "car needs 1 args but got 0"
+547     return
+548   }
+549   # args->left
+550   var first-ah/eax: (addr handle cell) <- get args, left
+551   var first/eax: (addr cell) <- lookup *first-ah
+552   var first-type/ecx: (addr int) <- get first, type
+553   compare *first-type, 0/pair
+554   {
+555     break-if-=
+556     error trace, "arg for car is not a pair"
+557     return
+558   }
+559   # car
+560   var result/eax: (addr handle cell) <- get first, left
+561   copy-object result, out
+562 }
+563 
+564 fn apply-cdr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+565   trace-text trace, "eval", "apply cdr"
+566   var args-ah/eax: (addr handle cell) <- copy _args-ah
+567   var _args/eax: (addr cell) <- lookup *args-ah
+568   var args/esi: (addr cell) <- copy _args
+569   # TODO: check that args is a pair
+570   var empty-args?/eax: boolean <- nil? args
+571   compare empty-args?, 0/false
+572   {
+573     break-if-=
+574     error trace, "cdr needs 1 args but got 0"
+575     return
+576   }
+577   # args->left
+578   var first-ah/eax: (addr handle cell) <- get args, left
+579   var first/eax: (addr cell) <- lookup *first-ah
+580   var first-type/ecx: (addr int) <- get first, type
+581   compare *first-type, 0/pair
+582   {
+583     break-if-=
+584     error trace, "arg for cdr is not a pair"
+585     return
+586   }
+587   # cdr
+588   var result/eax: (addr handle cell) <- get first, right
+589   copy-object result, out
+590 }
+591 
+592 fn apply-cons _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+593   trace-text trace, "eval", "apply cons"
+594   var args-ah/eax: (addr handle cell) <- copy _args-ah
+595   var _args/eax: (addr cell) <- lookup *args-ah
+596   var args/esi: (addr cell) <- copy _args
+597   # TODO: check that args is a pair
+598   var empty-args?/eax: boolean <- nil? args
+599   compare empty-args?, 0/false
+600   {
+601     break-if-=
+602     error trace, "cons needs 2 args but got 0"
+603     return
+604   }
+605   # args->left
+606   var first-ah/ecx: (addr handle cell) <- get args, left
+607   # args->right->left
+608   var right-ah/eax: (addr handle cell) <- get args, right
+609   var right/eax: (addr cell) <- lookup *right-ah
+610   # TODO: check that right is a pair
+611   var second-ah/eax: (addr handle cell) <- get right, left
+612   # cons
+613   new-pair out, *first-ah, *second-ah
+614 }
+615 
+616 fn apply-compare _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+617   trace-text trace, "eval", "apply ="
+618   var args-ah/eax: (addr handle cell) <- copy _args-ah
+619   var _args/eax: (addr cell) <- lookup *args-ah
+620   var args/esi: (addr cell) <- copy _args
+621   # TODO: check that args is a pair
+622   var empty-args?/eax: boolean <- nil? args
+623   compare empty-args?, 0/false
+624   {
+625     break-if-=
+626     error trace, "cons needs 2 args but got 0"
+627     return
+628   }
+629   # args->left
+630   var first-ah/ecx: (addr handle cell) <- get args, left
+631   # args->right->left
+632   var right-ah/eax: (addr handle cell) <- get args, right
+633   var right/eax: (addr cell) <- lookup *right-ah
+634   # TODO: check that right is a pair
+635   var second-ah/edx: (addr handle cell) <- get right, left
+636   # compare
+637   var _first/eax: (addr cell) <- lookup *first-ah
+638   var first/ecx: (addr cell) <- copy _first
+639   var second/eax: (addr cell) <- lookup *second-ah
+640   var match?/eax: boolean <- cell-isomorphic? first, second, trace
+641   compare match?, 0/false
+642   {
+643     break-if-!=
+644     nil out
+645     return
+646   }
+647   new-integer out, 1/true
+648 }
+649 
+650 fn apply-print _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+651   trace-text trace, "eval", "apply print"
+652   var args-ah/eax: (addr handle cell) <- copy _args-ah
+653   var _args/eax: (addr cell) <- lookup *args-ah
+654   var args/esi: (addr cell) <- copy _args
+655   # TODO: check that args is a pair
+656   var empty-args?/eax: boolean <- nil? args
+657   compare empty-args?, 0/false
+658   {
+659     break-if-=
+660     error trace, "print needs 2 args but got 0"
+661     return
+662   }
+663   # screen = args->left
+664   var first-ah/eax: (addr handle cell) <- get args, left
+665   var first/eax: (addr cell) <- lookup *first-ah
+666   var first-type/ecx: (addr int) <- get first, type
+667   compare *first-type, 5/screen
+668   {
+669     break-if-=
+670     error trace, "first arg for 'print' is not a screen"
+671     return
+672   }
+673   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+674   var _screen/eax: (addr screen) <- lookup *screen-ah
+675   var screen/ecx: (addr screen) <- copy _screen
+676   # args->right->left
+677   var right-ah/eax: (addr handle cell) <- get args, right
+678   var right/eax: (addr cell) <- lookup *right-ah
+679   # TODO: check that right is a pair
+680   var second-ah/eax: (addr handle cell) <- get right, left
+681   var stream-storage: (stream byte 0x100)
+682   var stream/edi: (addr stream byte) <- address stream-storage
+683   print-cell second-ah, stream, trace
+684   draw-stream-wrapping-right-then-down-from-cursor-over-full-screen screen, stream, 7/fg, 0/bg
+685   # return what was printed
+686   copy-object second-ah, out
+687 }
+688 
+689 fn apply-wait-for-key _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+690   trace-text trace, "eval", "apply key"
+691   var args-ah/eax: (addr handle cell) <- copy _args-ah
+692   var _args/eax: (addr cell) <- lookup *args-ah
+693   var args/esi: (addr cell) <- copy _args
+694   # TODO: check that args is a pair
+695   var empty-args?/eax: boolean <- nil? args
+696   compare empty-args?, 0/false
+697   {
+698     break-if-=
+699     error trace, "key needs 1 arg but got 0"
+700     return
+701   }
+702   # keyboard = args->left
+703   var first-ah/eax: (addr handle cell) <- get args, left
+704   var first/eax: (addr cell) <- lookup *first-ah
+705   var first-type/ecx: (addr int) <- get first, type
+706   compare *first-type, 6/keyboard
+707   {
+708     break-if-=
+709     error trace, "first arg for 'key' is not a keyboard"
+710     return
+711   }
+712   var keyboard-ah/eax: (addr handle gap-buffer) <- get first, keyboard-data
+713   var _keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
+714   var keyboard/ecx: (addr gap-buffer) <- copy _keyboard
+715   var result/eax: int <- wait-for-key keyboard
+716   # return key typed
+717   new-integer out, result
+718 }
+719 
+720 fn wait-for-key keyboard: (addr gap-buffer) -> _/eax: int {
+721   # if keyboard is 0, use real keyboard
+722   {
+723     compare keyboard, 0/real-keyboard
+724     break-if-!=
+725     var key/eax: byte <- read-key 0/real-keyboard
+726     var result/eax: int <- copy key
+727     return result
+728   }
+729   # otherwise read from fake keyboard
+730   var g/eax: grapheme <- read-from-gap-buffer keyboard
+731   var result/eax: int <- copy g
+732   return result
+733 }
+734 
+735 fn apply-stream _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+736   trace-text trace, "eval", "apply stream"
+737   allocate-stream out
+738 }
+739 
+740 fn apply-write _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+741   trace-text trace, "eval", "apply write"
+742   var args-ah/eax: (addr handle cell) <- copy _args-ah
+743   var _args/eax: (addr cell) <- lookup *args-ah
+744   var args/esi: (addr cell) <- copy _args
+745   # TODO: check that args is a pair
+746   var empty-args?/eax: boolean <- nil? args
+747   compare empty-args?, 0/false
+748   {
+749     break-if-=
+750     error trace, "write needs 2 args but got 0"
+751     return
+752   }
+753   # stream = args->left
+754   var first-ah/edx: (addr handle cell) <- get args, left
+755   var first/eax: (addr cell) <- lookup *first-ah
+756   var first-type/ecx: (addr int) <- get first, type
+757   compare *first-type, 3/stream
+758   {
+759     break-if-=
+760     error trace, "first arg for 'write' is not a stream"
+761     return
+762   }
+763   var stream-data-ah/eax: (addr handle stream byte) <- get first, text-data
+764   var _stream-data/eax: (addr stream byte) <- lookup *stream-data-ah
+765   var stream-data/ebx: (addr stream byte) <- copy _stream-data
+766   # args->right->left
+767   var right-ah/eax: (addr handle cell) <- get args, right
+768   var right/eax: (addr cell) <- lookup *right-ah
+769   # TODO: check that right is a pair
+770   var second-ah/eax: (addr handle cell) <- get right, left
+771   var second/eax: (addr cell) <- lookup *second-ah
+772   var second-type/ecx: (addr int) <- get second, type
+773   compare *second-type, 1/number
+774   {
+775     break-if-=
+776     error trace, "second arg for stream is not a number/grapheme"
+777     return
+778   }
+779   var second-value/eax: (addr float) <- get second, number-data
+780   var x-float/xmm0: float <- copy *second-value
+781   var x/eax: int <- convert x-float
+782   var x-grapheme/eax: grapheme <- copy x
+783   write-grapheme stream-data, x-grapheme
+784   # return the stream
+785   copy-object first-ah, out
+786 }
+
+ + + -- cgit 1.4.1-2-gfad0