1 type sandbox {
  2   setup: (handle line)
  3   data: (handle line)
  4   # display data
  5   cursor-call-path: (handle call-path-element)
  6   expanded-words: (handle call-path)
  7   partial-name-for-cursor-word: (handle word)  # only when renaming word
  8   partial-name-for-function: (handle word)  # only when defining function
  9   #
 10   next: (handle sandbox)
 11   prev: (handle sandbox)
 12 }
 13 
 14 type function {
 15   name: (handle array byte)
 16   args: (handle word)  # in reverse order
 17   body: (handle line)
 18   # some sort of indication of spatial location
 19   next: (handle function)
 20 }
 21 
 22 type line {
 23   name: (handle array byte)
 24   data: (handle word)
 25   result: (handle result)  # might be cached
 26   next: (handle line)
 27   prev: (handle line)
 28 }
 29 
 30 type word {
 31   scalar-data: (handle gap-buffer)
 32   next: (handle word)
 33   prev: (handle word)
 34 }
 35 
 36 # todo: turn this into a sum type
 37 type value {
 38   type: int
 39   number-data: float  # if type = 0
 40   text-data: (handle array byte)  # if type = 1
 41   array-data: (handle array value)  # if type = 2
 42   file-data: (handle buffered-file)  # if type = 3
 43   filename: (handle array byte)  # if type = 3
 44   screen-data: (handle screen)  # if type = 4
 45 }
 46 
 47 type table {
 48   data: (handle array bind)
 49   next: (handle table)
 50 }
 51 
 52 type bind {
 53   key: (handle array byte)
 54   value: (handle value)  # I'd inline this but we sometimes want to return a specific value from a table
 55 }
 56 
 57 # A call-path is a data structure that can unambiguously refer to any specific
 58 # call arbitrarily deep inside the call hierarchy of a program.
 59 type call-path {
 60   data: (handle call-path-element)
 61   next: (handle call-path)
 62 }
 63 
 64 # A call-path element is a list of elements, each of which corresponds to some call.
 65 type call-path-element {
 66   word: (handle word)
 67   next: (handle call-path-element)
 68 }
 69 
 70 type result {
 71   data: value-stack
 72   error: (handle array byte)  # single error message for now
 73 }
 74 
 75 fn initialize-sandbox _sandbox: (addr sandbox) {
 76   var sandbox/esi: (addr sandbox) <- copy _sandbox
 77   var line-ah/eax: (addr handle line) <- get sandbox, data
 78   allocate line-ah
 79   var line/eax: (addr line) <- lookup *line-ah
 80   initialize-line line
 81   var word-ah/ecx: (addr handle word) <- get line, data
 82   var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 83   allocate cursor-call-path-ah
 84   var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 85   var dest/eax: (addr handle word) <- get cursor-call-path, word
 86   copy-object word-ah, dest
 87 }
 88 
 89 # initialize line with a single empty word
 90 fn initialize-line _line: (addr line) {
 91   var line/esi: (addr line) <- copy _line
 92   var word-ah/eax: (addr handle word) <- get line, data
 93   allocate word-ah
 94   var word/eax: (addr word) <- lookup *word-ah
 95   initialize-word word
 96 }
 97 
 98 fn create-primitive-functions _self: (addr handle function) {
 99   # x 2* = x 2 *
100   var self/esi: (addr handle function) <- copy _self
101   allocate self
102   var _f/eax: (addr function) <- lookup *self
103   var f/esi: (addr function) <- copy _f
104   var name-ah/eax: (addr handle array byte) <- get f, name
105   populate-text-with name-ah, "2*"
106   var args-ah/eax: (addr handle word) <- get f, args
107   allocate args-ah
108   var args/eax: (addr word) <- lookup *args-ah
109   initialize-word-with args, "x"
110   var body-ah/eax: (addr handle line) <- get f, body
111   allocate body-ah
112   var body/eax: (addr line) <- lookup *body-ah
113   initialize-line body
114   var curr-word-ah/ecx: (addr handle word) <- get body, data
115   parse-words "x 2 *", curr-word-ah
116   # x 1+ = x 1 +
117   var next/esi: (addr handle function) <- get f, next
118   allocate next
119   var _f/eax: (addr function) <- lookup *next
120   var f/esi: (addr function) <- copy _f
121   var name-ah/eax: (addr handle array byte) <- get f, name
122   populate-text-with name-ah, "1+"
123   var args-ah/eax: (addr handle word) <- get f, args
124   allocate args-ah
125   var args/eax: (addr word) <- lookup *args-ah
126   initialize-word-with args, "x"
127   var body-ah/eax: (addr handle line) <- get f, body
128   allocate body-ah
129   var body/eax: (addr line) <- lookup *body-ah
130   initialize-line body
131   curr-word-ah <- get body, data
132   parse-words "x 1 +", curr-word-ah
133   # x 2+ = x 1+ 1+
134   var next/esi: (addr handle function) <- get f, next
135   allocate next
136   var _f/eax: (addr function) <- lookup *next
137   var f/esi: (addr function) <- copy _f
138   var name-ah/eax: (addr handle array byte) <- get f, name
139   populate-text-with name-ah, "2+"
140   var args-ah/eax: (addr handle word) <- get f, args
141   allocate args-ah
142   var args/eax: (addr word) <- lookup *args-ah
143   initialize-word-with args, "x"
144   var body-ah/eax: (addr handle line) <- get f, body
145   allocate body-ah
146   var body/eax: (addr line) <- lookup *body-ah
147   initialize-line body
148   curr-word-ah <- get body, data
149   parse-words "x 1+ 1+", curr-word-ah
150   # x square = x x *
151   var next/esi: (addr handle function) <- get f, next
152   allocate next
153   var _f/eax: (addr function) <- lookup *next
154   var f/esi: (addr function) <- copy _f
155   var name-ah/eax: (addr handle array byte) <- get f, name
156   populate-text-with name-ah, "square"
157   var args-ah/eax: (addr handle word) <- get f, args
158   allocate args-ah
159   var args/eax: (addr word) <- lookup *args-ah
160   initialize-word-with args, "x"
161   var body-ah/eax: (addr handle line) <- get f, body
162   allocate body-ah
163   var body/eax: (addr line) <- lookup *body-ah
164   initialize-line body
165   curr-word-ah <- get body, data
166   parse-words "x x *", curr-word-ah
167   # x 1- = x 1 -
168   var next/esi: (addr handle function) <- get f, next
169   allocate next
170   var _f/eax: (addr function) <- lookup *next
171   var f/esi: (addr function) <- copy _f
172   var name-ah/eax: (addr handle array byte) <- get f, name
173   populate-text-with name-ah, "1-"
174   var args-ah/eax: (addr handle word) <- get f, args
175   allocate args-ah
176   var args/eax: (addr word) <- lookup *args-ah
177   initialize-word-with args, "x"
178   var body-ah/eax: (addr handle line) <- get f, body
179   allocate body-ah
180   var body/eax: (addr line) <- lookup *body-ah
181   initialize-line body
182   curr-word-ah <- get body, data
183   parse-words "x 1 -", curr-word-ah
184   # x y sub = x y -
185   var next/esi: (addr handle function) <- get f, next
186   allocate next
187   var _f/eax: (addr function) <- lookup *next
188   var f/esi: (addr function) <- copy _f
189   var name-ah/eax: (addr handle array byte) <- get f, name
190   populate-text-with name-ah, "sub"
191   # critical lesson: args are stored in reverse order
192   var args-ah/eax: (addr handle word) <- get f, args
193   allocate args-ah
194   var args/eax: (addr word) <- lookup *args-ah
195   initialize-word-with args, "y"
196   var next-arg-ah/eax: (addr handle word) <- get args, next
197   allocate next-arg-ah
198   var next-arg/eax: (addr word) <- lookup *next-arg-ah
199   initialize-word-with next-arg, "x"
200   var body-ah/eax: (addr handle line) <- get f, body
201   allocate body-ah
202   var body/eax: (addr line) <- lookup *body-ah
203   initialize-line body
204   curr-word-ah <- get body, data
205   parse-words "x y -", curr-word-ah
206 }
207 
208 fn function-body functions: (addr handle function), _word: (addr handle word), out: (addr handle line) {
209   var function-name-storage: (handle array byte)
210   var function-name-ah/ecx: (addr handle array byte) <- address function-name-storage
211   var word-ah/esi: (addr handle word) <- copy _word
212   var word/eax: (addr word) <- lookup *word-ah
213   var gap-ah/eax: (addr handle gap-buffer) <- get word, scalar-data
214   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
215   gap-buffer-to-string gap, function-name-ah
216   var _function-name/eax: (addr array byte) <- lookup *function-name-ah
217   var function-name/esi: (addr array byte) <- copy _function-name
218   var curr-ah/ecx: (addr handle function) <- copy functions
219   $function-body:loop: {
220     var _curr/eax: (addr function) <- lookup *curr-ah
221     var curr/edx: (addr function) <- copy _curr
222     compare curr, 0
223     break-if-=
224     var curr-name-ah/eax: (addr handle array byte) <- get curr, name
225     var curr-name/eax: (addr array byte) <- lookup *curr-name-ah
226     var found?/eax: boolean <- string-equal? curr-name, function-name
227     compare found?, 0  # false
228     {
229       break-if-=
230       var src/eax: (addr handle line) <- get curr, body
231       copy-object src, out
232       break $function-body:loop
233     }
234     curr-ah <- get curr, next
235     loop
236   }
237 }
238 
239 fn body-length functions: (addr handle function), function-name: (addr handle word) -> _/eax: int {
240   var body-storage: (handle line)
241   var body-ah/edi: (addr handle line) <- address body-storage
242   function-body functions, function-name, body-ah
243   var body/eax: (addr line) <- lookup *body-ah
244   var result/eax: int <- num-words-in-line body
245   return result
246 }
247 
248 fn num-words-in-line _in: (addr line) -> _/eax: int {
249   var in/esi: (addr line) <- copy _in
250   var curr-ah/ecx: (addr handle word) <- get in, data
251   var result/edi: int <- copy 0
252   {
253     var curr/eax: (addr word) <- lookup *curr-ah
254     compare curr, 0
255     break-if-=
256     curr-ah <- get curr, next
257     result <- increment
258     loop
259   }
260   return result
261 }
262 
263 fn populate-text-with _out: (addr handle array byte), _in: (addr array byte) {
264   var in/esi: (addr array byte) <- copy _in
265   var n/ecx: int <- length in
266   var out/edx: (addr handle array byte) <- copy _out
267   populate out, n
268   var _out-addr/eax: (addr array byte) <- lookup *out
269   var out-addr/edx: (addr array byte) <- copy _out-addr
270   var i/eax: int <- copy 0
271   {
272     compare i, n
273     break-if->=
274     var src/esi: (addr byte) <- index in, i
275     var val/ecx: byte <- copy-byte *src
276     var dest/edi: (addr byte) <- index out-addr, i
277     copy-byte-to *dest, val
278     i <- increment
279     loop
280   }
281 }
282 
283 fn initialize-path-from-sandbox _in: (addr sandbox), _out: (addr handle call-path-element) {
284   var sandbox/esi: (addr sandbox) <- copy _in
285   var line-ah/eax: (addr handle line) <- get sandbox, data
286   var line/eax: (addr line) <- lookup *line-ah
287   var src/esi: (addr handle word) <- get line, data
288   var out-ah/edi: (addr handle call-path-element) <- copy _out
289   var out/eax: (addr call-path-element) <- lookup *out-ah
290   var dest/edi: (addr handle word) <- get out, word
291   copy-object src, dest
292 }
293 
294 fn initialize-path-from-line _line: (addr line), _out: (addr handle call-path-element) {
295   var line/eax: (addr line) <- copy _line
296   var src/esi: (addr handle word) <- get line, data
297   var out-ah/edi: (addr handle call-path-element) <- copy _out
298   var out/eax: (addr call-path-element) <- lookup *out-ah
299   var dest/edi: (addr handle word) <- get out, word
300   copy-object src, dest
301 }
302 
303 fn find-in-call-paths call-paths: (addr handle call-path), needle: (addr handle call-path-element) -> _/eax: boolean {
304   var curr-ah/esi: (addr handle call-path) <- copy call-paths
305   $find-in-call-path:loop: {
306     var curr/eax: (addr call-path) <- lookup *curr-ah
307     compare curr, 0
308     break-if-=
309     {
310       var curr-data/eax: (addr handle call-path-element) <- get curr, data
311       var match?/eax: boolean <- call-path-element-match? curr-data, needle
312       compare match?, 0  # false
313       {
314         break-if-=
315         return 1  # true
316       }
317     }
318     curr-ah <- get curr, next
319     loop
320   }
321   return 0  # false
322 }
323 
324 fn call-path-element-match? _x: (addr handle call-path-element), _y: (addr handle call-path-element) -> _/eax: boolean {
325   var x-ah/eax: (addr handle call-path-element) <- copy _x
326   var x-a/eax: (addr call-path-element) <- lookup *x-ah
327   var x/esi: (addr call-path-element) <- copy x-a
328   var y-ah/eax: (addr handle call-path-element) <- copy _y
329   var y-a/eax: (addr call-path-element) <- lookup *y-ah
330   var y/edi: (addr call-path-element) <- copy y-a
331   compare x, y
332   {
333     break-if-!=
334     return 1  # true
335   }
336   compare x, 0
337   {
338     break-if-!=
339     return 0  # false
340   }
341   compare y, 0
342   {
343     break-if-!=
344     return 0  # false
345   }
346   # compare word addresses, not contents
347   var x-data-ah/ecx: (addr handle word) <- get x, word
348   var x-data-a/eax: (addr word) <- lookup *x-data-ah
349   var x-data/ecx: int <- copy x-data-a
350   var y-data-ah/eax: (addr handle word) <- get y, word
351   var y-data-a/eax: (addr word) <- lookup *y-data-ah
352   var y-data/eax: int <- copy y-data-a
353 #?   print-string 0, "match? "
354 #?   print-int32-hex 0, x-data
355 #?   print-string 0, " vs "
356 #?   print-int32-hex 0, y-data
357 #?   print-string 0, "\n"
358   compare x-data, y-data
359   {
360     break-if-=
361     return 0  # false
362   }
363   var x-next/ecx: (addr handle call-path-element) <- get x, next
364   var y-next/eax: (addr handle call-path-element) <- get y, next
365   var result/eax: boolean <- call-path-element-match? x-next, y-next
366   return result
367 }
368 
369 # order is irrelevant
370 fn insert-in-call-path list: (addr handle call-path), new: (addr handle call-path-element) {
371   var new-path-storage: (handle call-path)
372   var new-path-ah/edi: (addr handle call-path) <- address new-path-storage
373   allocate new-path-ah
374   var new-path/eax: (addr call-path) <- lookup *new-path-ah
375   var next/ecx: (addr handle call-path) <- get new-path, next
376   copy-object list, next
377   var dest/ecx: (addr handle call-path-element) <- get new-path, data
378   deep-copy-call-path-element new, dest
379   copy-object new-path-ah, list
380 }
381 
382 # assumes dest is initially clear
383 fn deep-copy-call-path-element _src: (addr handle call-path-element), _dest: (addr handle call-path-element) {
384   var src/esi: (addr handle call-path-element) <- copy _src
385   # if src is null, return
386   var _src-addr/eax: (addr call-path-element) <- lookup *src
387   compare _src-addr, 0
388   break-if-=
389   # allocate
390   var src-addr/esi: (addr call-path-element) <- copy _src-addr
391   var dest/eax: (addr handle call-path-element) <- copy _dest
392   allocate dest
393   # copy data
394   var dest-addr/eax: (addr call-path-element) <- lookup *dest
395   {
396     var dest-data-addr/ecx: (addr handle word) <- get dest-addr, word
397     var src-data-addr/eax: (addr handle word) <- get src-addr, word
398     copy-object src-data-addr, dest-data-addr
399   }
400   # recurse
401   var src-next/esi: (addr handle call-path-element) <- get src-addr, next
402   var dest-next/eax: (addr handle call-path-element) <- get dest-addr, next
403   deep-copy-call-path-element src-next, dest-next
404 }
405 
406 fn delete-in-call-path list: (addr handle call-path), needle: (addr handle call-path-element) {
407   var curr-ah/esi: (addr handle call-path) <- copy list
408   $delete-in-call-path:loop: {
409     var _curr/eax: (addr call-path) <- lookup *curr-ah
410     var curr/ecx: (addr call-path) <- copy _curr
411     compare curr, 0
412     break-if-=
413     {
414       var curr-data/eax: (addr handle call-path-element) <- get curr, data
415       var match?/eax: boolean <- call-path-element-match? curr-data, needle
416       compare match?, 0  # false
417       {
418         break-if-=
419         var next-ah/ecx: (addr handle call-path) <- get curr, next
420         copy-object next-ah, curr-ah
421         loop $delete-in-call-path:loop
422       }
423     }
424     curr-ah <- get curr, next
425     loop
426   }
427 }
428 
429 fn increment-final-element list: (addr handle call-path-element) {
430   var final-ah/eax: (addr handle call-path-element) <- copy list
431   var final/eax: (addr call-path-element) <- lookup *final-ah
432   var val-ah/ecx: (addr handle word) <- get final, word
433   var val/eax: (addr word) <- lookup *val-ah
434   var new-ah/edx: (addr handle word) <- get val, next
435   var target/eax: (addr word) <- lookup *new-ah
436   compare target, 0
437   break-if-=
438   copy-object new-ah, val-ah
439 }
440 
441 fn decrement-final-element list: (addr handle call-path-element) {
442   var final-ah/eax: (addr handle call-path-element) <- copy list
443   var final/eax: (addr call-path-element) <- lookup *final-ah
444   var val-ah/ecx: (addr handle word) <- get final, word
445   var val/eax: (addr word) <- lookup *val-ah
446 #?   print-string 0, "replacing "
447 #?   {
448 #?     var foo/eax: int <- copy val
449 #?     print-int32-hex 0, foo
450 #?   }
451   var new-ah/edx: (addr handle word) <- get val, prev
452   var target/eax: (addr word) <- lookup *new-ah
453   compare target, 0
454   break-if-=
455   # val = val->prev
456 #?   print-string 0, " with "
457 #?   {
458 #?     var foo/eax: int <- copy target
459 #?     print-int32-hex 0, foo
460 #?   }
461 #?   print-string 0, "\n"
462   copy-object new-ah, val-ah
463 }
464 
465 fn move-final-element-to-start-of-line list: (addr handle call-path-element) {
466   var final-ah/eax: (addr handle call-path-element) <- copy list
467   var final/eax: (addr call-path-element) <- lookup *final-ah
468   var val-ah/ecx: (addr handle word) <- get final, word
469   var val/eax: (addr word) <- lookup *val-ah
470   var new-ah/edx: (addr handle word) <- get val, prev
471   var target/eax: (addr word) <- lookup *new-ah
472   compare target, 0
473   break-if-=
474   copy-object new-ah, val-ah
475   move-final-element-to-start-of-line list
476 }
477 
478 fn move-final-element-to-end-of-line list: (addr handle call-path-element) {
479   var final-ah/eax: (addr handle call-path-element) <- copy list
480   var final/eax: (addr call-path-element) <- lookup *final-ah
481   var val-ah/ecx: (addr handle word) <- get final, word
482   var val/eax: (addr word) <- lookup *val-ah
483   var new-ah/edx: (addr handle word) <- get val, next
484   var target/eax: (addr word) <- lookup *new-ah
485   compare target, 0
486   break-if-=
487   copy-object new-ah, val-ah
488   move-final-element-to-end-of-line list
489 }
490 
491 fn push-to-call-path-element list: (addr handle call-path-element), new: (addr handle word) {
492   var new-element-storage: (handle call-path-element)
493   var new-element-ah/edi: (addr handle call-path-element) <- address new-element-storage
494   allocate new-element-ah
495   var new-element/eax: (addr call-path-element) <- lookup *new-element-ah
496   # save word
497   var dest/ecx: (addr handle word) <- get new-element, word
498   copy-object new, dest
499   # save next
500   var dest2/ecx: (addr handle call-path-element) <- get new-element, next
501   copy-object list, dest2
502   # return
503   copy-object new-element-ah, list
504 }
505 
506 fn drop-from-call-path-element _list: (addr handle call-path-element) {
507   var list-ah/esi: (addr handle call-path-element) <- copy _list
508   var list/eax: (addr call-path-element) <- lookup *list-ah
509   var next/eax: (addr handle call-path-element) <- get list, next
510   copy-object next, _list
511 }
512 
513 fn drop-nested-calls _list: (addr handle call-path-element) {
514   var list-ah/esi: (addr handle call-path-element) <- copy _list
515   var list/eax: (addr call-path-element) <- lookup *list-ah
516   var next-ah/edi: (addr handle call-path-element) <- get list, next
517   var next/eax: (addr call-path-element) <- lookup *next-ah
518   compare next, 0
519   break-if-=
520   copy-object next-ah, _list
521   drop-nested-calls _list
522 }
523 
524 fn dump-call-path-element screen: (addr screen), _x-ah: (addr handle call-path-element) {
525   var x-ah/ecx: (addr handle call-path-element) <- copy _x-ah
526   var _x/eax: (addr call-path-element) <- lookup *x-ah
527   var x/esi: (addr call-path-element) <- copy _x
528   var word-ah/eax: (addr handle word) <- get x, word
529   var word/eax: (addr word) <- lookup *word-ah
530   print-word screen, word
531   var next-ah/ecx: (addr handle call-path-element) <- get x, next
532   var next/eax: (addr call-path-element) <- lookup *next-ah
533   compare next, 0
534   {
535     break-if-=
536     print-string screen, " "
537     dump-call-path-element screen, next-ah
538     return
539   }
540   print-string screen, "\n"
541 }
542 
543 fn dump-call-paths screen: (addr screen), _x-ah: (addr handle call-path) {
544   var x-ah/ecx: (addr handle call-path) <- copy _x-ah
545   var x/eax: (addr call-path) <- lookup *x-ah
546   compare x, 0
547   break-if-=
548   var src/ecx: (addr handle call-path-element) <- get x, data
549   dump-call-path-element screen, src
550   var next-ah/ecx: (addr handle call-path) <- get x, next
551   var next/eax: (addr call-path) <- lookup *next-ah
552   compare next, 0
553   {
554     break-if-=
555     dump-call-paths screen, next-ah
556   }
557 }
558 
559 fn function-width _self: (addr function) -> _/eax: int {
560   var self/esi: (addr function) <- copy _self
561   var args/ecx: (addr handle word) <- get self, args
562   var arg-width/eax: int <- word-list-length args
563   var result/edi: int <- copy arg-width
564   result <- add 4  # function-header-indent + body-indent
565   var body-ah/eax: (addr handle line) <- get self, body
566   var body-width/eax: int <- body-width body-ah
567   body-width <- add 1  # right margin
568   body-width <- add 2  # body-indent for "≡ "
569   compare result, body-width
570   {
571     break-if->=
572     result <- copy body-width
573   }
574   return result
575 }
576 
577 fn body-width lines: (addr handle line) -> _/eax: int {
578   var curr-ah/esi: (addr handle line) <- copy lines
579   var result/edi: int <- copy 0
580   {
581     var curr/eax: (addr line) <- lookup *curr-ah
582     compare curr, 0
583     break-if-=
584     {
585       var words/ecx: (addr handle word) <- get curr, data
586       var curr-len/eax: int <- word-list-length words
587       compare curr-len, result
588       break-if-<=
589       result <- copy curr-len
590     }
591     curr-ah <- get curr, next
592     loop
593   }
594   return result
595 }
596 
597 fn function-height _self: (addr function) -> _/eax: int {
598   var self/esi: (addr function) <- copy _self
599   var body-ah/eax: (addr handle line) <- get self, body
600   var result/eax: int <- line-list-length body-ah
601   result <- increment  # for function header
602   return result
603 }
604 
605 fn line-list-length lines: (addr handle line) -> _/eax: int {
606   var curr-ah/esi: (addr handle line) <- copy lines
607   var result/edi: int <- copy 0
608   {
609     var curr/eax: (addr line) <- lookup *curr-ah
610     compare curr, 0
611     break-if-=
612     curr-ah <- get curr, next
613     result <- increment
614     loop
615   }
616   return result
617 }