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   int-data: int  # 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   # *curr-word = "x"
116   allocate curr-word-ah
117   var tmp/eax: (addr word) <- lookup *curr-word-ah
118   var curr-word/edx: (addr word) <- copy tmp
119   initialize-word-with curr-word, "x"
120   # *curr-word->next = "2"
121   var next-word-ah/ebx: (addr handle word) <- get curr-word, next
122   allocate next-word-ah
123   tmp <- lookup *next-word-ah
124   initialize-word-with tmp, "2"
125   # *curr-word->next->prev = curr-word
126   var prev-word-ah/edi: (addr handle word) <- get tmp, prev
127   copy-object curr-word-ah, prev-word-ah
128   # curr-word = curr-word->next
129   curr-word-ah <- copy next-word-ah
130   curr-word <- copy tmp
131   # *curr-word->next = "*"
132   next-word-ah <- get curr-word, next
133   allocate next-word-ah
134   tmp <- lookup *next-word-ah
135   initialize-word-with tmp, "*"
136   # *curr-word->next->prev = curr-word
137   prev-word-ah <- get tmp, prev
138   copy-object curr-word-ah, prev-word-ah
139   tmp <- lookup *prev-word-ah
140   # x 1+ = x 1 +
141   var next/esi: (addr handle function) <- get f, next
142   allocate next
143   var _f/eax: (addr function) <- lookup *next
144   var f/esi: (addr function) <- copy _f
145   var name-ah/eax: (addr handle array byte) <- get f, name
146   populate-text-with name-ah, "1+"
147   var args-ah/eax: (addr handle word) <- get f, args
148   allocate args-ah
149   var args/eax: (addr word) <- lookup *args-ah
150   initialize-word-with args, "x"
151   var body-ah/eax: (addr handle line) <- get f, body
152   allocate body-ah
153   var body/eax: (addr line) <- lookup *body-ah
154   initialize-line body
155   var curr-word-ah/ecx: (addr handle word) <- get body, data
156   # *curr-word = "x"
157   allocate curr-word-ah
158   var tmp/eax: (addr word) <- lookup *curr-word-ah
159   curr-word <- copy tmp
160   initialize-word-with curr-word, "x"
161   # *curr-word->next = "1"
162   next-word-ah <- get curr-word, next
163   allocate next-word-ah
164   tmp <- lookup *next-word-ah
165   initialize-word-with tmp, "1"
166   # *curr-word->next->prev = curr-word
167   prev-word-ah <- get tmp, prev
168   copy-object curr-word-ah, prev-word-ah
169   # curr-word = curr-word->next
170   curr-word-ah <- copy next-word-ah
171   curr-word <- copy tmp
172   # *curr-word->next = "+"
173   next-word-ah <- get curr-word, next
174   allocate next-word-ah
175   tmp <- lookup *next-word-ah
176   initialize-word-with tmp, "+"
177   # *curr-word->next->prev = curr-word
178   prev-word-ah <- get tmp, prev
179   copy-object curr-word-ah, prev-word-ah
180   tmp <- lookup *prev-word-ah
181   # x 2+ = x 1+ 1+
182   var next/esi: (addr handle function) <- get f, next
183   allocate next
184   var _f/eax: (addr function) <- lookup *next
185   var f/esi: (addr function) <- copy _f
186   var name-ah/eax: (addr handle array byte) <- get f, name
187   populate-text-with name-ah, "2+"
188   var args-ah/eax: (addr handle word) <- get f, args
189   allocate args-ah
190   var args/eax: (addr word) <- lookup *args-ah
191   initialize-word-with args, "x"
192   var body-ah/eax: (addr handle line) <- get f, body
193   allocate body-ah
194   var body/eax: (addr line) <- lookup *body-ah
195   initialize-line body
196   var curr-word-ah/ecx: (addr handle word) <- get body, data
197   # *curr-word = "x"
198   allocate curr-word-ah
199   var tmp/eax: (addr word) <- lookup *curr-word-ah
200   curr-word <- copy tmp
201   initialize-word-with curr-word, "x"
202   # *curr-word->next = "1+"
203   next-word-ah <- get curr-word, next
204   allocate next-word-ah
205   tmp <- lookup *next-word-ah
206   initialize-word-with tmp, "1+"
207   # *curr-word->next->prev = curr-word
208   prev-word-ah <- get tmp, prev
209   copy-object curr-word-ah, prev-word-ah
210   # curr-word = curr-word->next
211   curr-word-ah <- copy next-word-ah
212   curr-word <- copy tmp
213   # *curr-word->next = "1+"
214   next-word-ah <- get curr-word, next
215   allocate next-word-ah
216   tmp <- lookup *next-word-ah
217   initialize-word-with tmp, "1+"
218   # *curr-word->next->prev = curr-word
219   prev-word-ah <- get tmp, prev
220   copy-object curr-word-ah, prev-word-ah
221   tmp <- lookup *prev-word-ah
222   # x square = x x *
223   var next/esi: (addr handle function) <- get f, next
224   allocate next
225   var _f/eax: (addr function) <- lookup *next
226   var f/esi: (addr function) <- copy _f
227   var name-ah/eax: (addr handle array byte) <- get f, name
228   populate-text-with name-ah, "square"
229   var args-ah/eax: (addr handle word) <- get f, args
230   allocate args-ah
231   var args/eax: (addr word) <- lookup *args-ah
232   initialize-word-with args, "x"
233   var body-ah/eax: (addr handle line) <- get f, body
234   allocate body-ah
235   var body/eax: (addr line) <- lookup *body-ah
236   initialize-line body
237   var curr-word-ah/ecx: (addr handle word) <- get body, data
238   # *curr-word = "x"
239   allocate curr-word-ah
240   var tmp/eax: (addr word) <- lookup *curr-word-ah
241   var curr-word/edx: (addr word) <- copy tmp
242   initialize-word-with curr-word, "x"
243   # *curr-word->next = "x"
244   var next-word-ah/ebx: (addr handle word) <- get curr-word, next
245   allocate next-word-ah
246   tmp <- lookup *next-word-ah
247   initialize-word-with tmp, "x"
248   # *curr-word->next->prev = curr-word
249   var prev-word-ah/edi: (addr handle word) <- get tmp, prev
250   copy-object curr-word-ah, prev-word-ah
251   # curr-word = curr-word->next
252   curr-word-ah <- copy next-word-ah
253   curr-word <- copy tmp
254   # *curr-word->next = "*"
255   next-word-ah <- get curr-word, next
256   allocate next-word-ah
257   tmp <- lookup *next-word-ah
258   initialize-word-with tmp, "*"
259   # *curr-word->next->prev = curr-word
260   prev-word-ah <- get tmp, prev
261   copy-object curr-word-ah, prev-word-ah
262   tmp <- lookup *prev-word-ah
263   # x 1- = x 1 -
264   var next/esi: (addr handle function) <- get f, next
265   allocate next
266   var _f/eax: (addr function) <- lookup *next
267   var f/esi: (addr function) <- copy _f
268   var name-ah/eax: (addr handle array byte) <- get f, name
269   populate-text-with name-ah, "1-"
270   var args-ah/eax: (addr handle word) <- get f, args
271   allocate args-ah
272   var args/eax: (addr word) <- lookup *args-ah
273   initialize-word-with args, "x"
274   var body-ah/eax: (addr handle line) <- get f, body
275   allocate body-ah
276   var body/eax: (addr line) <- lookup *body-ah
277   initialize-line body
278   var curr-word-ah/ecx: (addr handle word) <- get body, data
279   # *curr-word = "x"
280   allocate curr-word-ah
281   var tmp/eax: (addr word) <- lookup *curr-word-ah
282   curr-word <- copy tmp
283   initialize-word-with curr-word, "x"
284   # *curr-word->next = "1"
285   next-word-ah <- get curr-word, next
286   allocate next-word-ah
287   tmp <- lookup *next-word-ah
288   initialize-word-with tmp, "1"
289   # *curr-word->next->prev = curr-word
290   prev-word-ah <- get tmp, prev
291   copy-object curr-word-ah, prev-word-ah
292   # curr-word = curr-word->next
293   curr-word-ah <- copy next-word-ah
294   curr-word <- copy tmp
295   # *curr-word->next = "-"
296   next-word-ah <- get curr-word, next
297   allocate next-word-ah
298   tmp <- lookup *next-word-ah
299   initialize-word-with tmp, "-"
300   # *curr-word->next->prev = curr-word
301   prev-word-ah <- get tmp, prev
302   copy-object curr-word-ah, prev-word-ah
303   tmp <- lookup *prev-word-ah
304   # x y sub = x y -
305   var next/esi: (addr handle function) <- get f, next
306   allocate next
307   var _f/eax: (addr function) <- lookup *next
308   var f/esi: (addr function) <- copy _f
309   var name-ah/eax: (addr handle array byte) <- get f, name
310   populate-text-with name-ah, "sub"
311   # critical lesson: args are stored in reverse order
312   var args-ah/eax: (addr handle word) <- get f, args
313   allocate args-ah
314   var args/eax: (addr word) <- lookup *args-ah
315   initialize-word-with args, "y"
316   var next-arg-ah/eax: (addr handle word) <- get args, next
317   allocate next-arg-ah
318   var next-arg/eax: (addr word) <- lookup *next-arg-ah
319   initialize-word-with next-arg, "x"
320   var body-ah/eax: (addr handle line) <- get f, body
321   allocate body-ah
322   var body/eax: (addr line) <- lookup *body-ah
323   initialize-line body
324   var curr-word-ah/ecx: (addr handle word) <- get body, data
325   # *curr-word = "x"
326   allocate curr-word-ah
327   var tmp/eax: (addr word) <- lookup *curr-word-ah
328   curr-word <- copy tmp
329   initialize-word-with curr-word, "x"
330   # *curr-word->next = "y"
331   next-word-ah <- get curr-word, next
332   allocate next-word-ah
333   tmp <- lookup *next-word-ah
334   initialize-word-with tmp, "y"
335   # *curr-word->next->prev = curr-word
336   prev-word-ah <- get tmp, prev
337   copy-object curr-word-ah, prev-word-ah
338   # curr-word = curr-word->next
339   curr-word-ah <- copy next-word-ah
340   curr-word <- copy tmp
341   # *curr-word->next = "-"
342   next-word-ah <- get curr-word, next
343   allocate next-word-ah
344   tmp <- lookup *next-word-ah
345   initialize-word-with tmp, "-"
346   # *curr-word->next->prev = curr-word
347   prev-word-ah <- get tmp, prev
348   copy-object curr-word-ah, prev-word-ah
349   tmp <- lookup *prev-word-ah
350 }
351 
352 fn function-body functions: (addr handle function), _word: (addr handle word), out: (addr handle line) {
353   var function-name-storage: (handle array byte)
354   var function-name-ah/ecx: (addr handle array byte) <- address function-name-storage
355   var word-ah/esi: (addr handle word) <- copy _word
356   var word/eax: (addr word) <- lookup *word-ah
357   var gap-ah/eax: (addr handle gap-buffer) <- get word, scalar-data
358   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
359   gap-buffer-to-string gap, function-name-ah
360   var _function-name/eax: (addr array byte) <- lookup *function-name-ah
361   var function-name/esi: (addr array byte) <- copy _function-name
362   var curr-ah/ecx: (addr handle function) <- copy functions
363   $function-body:loop: {
364     var _curr/eax: (addr function) <- lookup *curr-ah
365     var curr/edx: (addr function) <- copy _curr
366     compare curr, 0
367     break-if-=
368     var curr-name-ah/eax: (addr handle array byte) <- get curr, name
369     var curr-name/eax: (addr array byte) <- lookup *curr-name-ah
370     var found?/eax: boolean <- string-equal? curr-name, function-name
371     compare found?, 0  # false
372     {
373       break-if-=
374       var src/eax: (addr handle line) <- get curr, body
375       copy-object src, out
376       break $function-body:loop
377     }
378     curr-ah <- get curr, next
379     loop
380   }
381 }
382 
383 fn body-length functions: (addr handle function), function-name: (addr handle word) -> _/eax: int {
384   var body-storage: (handle line)
385   var body-ah/edi: (addr handle line) <- address body-storage
386   function-body functions, function-name, body-ah
387   var body/eax: (addr line) <- lookup *body-ah
388   var result/eax: int <- num-words-in-line body
389   return result
390 }
391 
392 fn num-words-in-line _in: (addr line) -> _/eax: int {
393   var in/esi: (addr line) <- copy _in
394   var curr-ah/ecx: (addr handle word) <- get in, data
395   var result/edi: int <- copy 0
396   {
397     var curr/eax: (addr word) <- lookup *curr-ah
398     compare curr, 0
399     break-if-=
400     curr-ah <- get curr, next
401     result <- increment
402     loop
403   }
404   return result
405 }
406 
407 fn populate-text-with _out: (addr handle array byte), _in: (addr array byte) {
408   var in/esi: (addr array byte) <- copy _in
409   var n/ecx: int <- length in
410   var out/edx: (addr handle array byte) <- copy _out
411   populate out, n
412   var _out-addr/eax: (addr array byte) <- lookup *out
413   var out-addr/edx: (addr array byte) <- copy _out-addr
414   var i/eax: int <- copy 0
415   {
416     compare i, n
417     break-if->=
418     var src/esi: (addr byte) <- index in, i
419     var val/ecx: byte <- copy-byte *src
420     var dest/edi: (addr byte) <- index out-addr, i
421     copy-byte-to *dest, val
422     i <- increment
423     loop
424   }
425 }
426 
427 fn initialize-path-from-sandbox _in: (addr sandbox), _out: (addr handle call-path-element) {
428   var sandbox/esi: (addr sandbox) <- copy _in
429   var line-ah/eax: (addr handle line) <- get sandbox, data
430   var line/eax: (addr line) <- lookup *line-ah
431   var src/esi: (addr handle word) <- get line, data
432   var out-ah/edi: (addr handle call-path-element) <- copy _out
433   var out/eax: (addr call-path-element) <- lookup *out-ah
434   var dest/edi: (addr handle word) <- get out, word
435   copy-object src, dest
436 }
437 
438 fn initialize-path-from-line _line: (addr line), _out: (addr handle call-path-element) {
439   var line/eax: (addr line) <- copy _line
440   var src/esi: (addr handle word) <- get line, data
441   var out-ah/edi: (addr handle call-path-element) <- copy _out
442   var out/eax: (addr call-path-element) <- lookup *out-ah
443   var dest/edi: (addr handle word) <- get out, word
444   copy-object src, dest
445 }
446 
447 fn find-in-call-paths call-paths: (addr handle call-path), needle: (addr handle call-path-element) -> _/eax: boolean {
448   var curr-ah/esi: (addr handle call-path) <- copy call-paths
449   $find-in-call-path:loop: {
450     var curr/eax: (addr call-path) <- lookup *curr-ah
451     compare curr, 0
452     break-if-=
453     {
454       var curr-data/eax: (addr handle call-path-element) <- get curr, data
455       var match?/eax: boolean <- call-path-element-match? curr-data, needle
456       compare match?, 0  # false
457       {
458         break-if-=
459         return 1  # true
460       }
461     }
462     curr-ah <- get curr, next
463     loop
464   }
465   return 0  # false
466 }
467 
468 fn call-path-element-match? _x: (addr handle call-path-element), _y: (addr handle call-path-element) -> _/eax: boolean {
469   var x-ah/eax: (addr handle call-path-element) <- copy _x
470   var x-a/eax: (addr call-path-element) <- lookup *x-ah
471   var x/esi: (addr call-path-element) <- copy x-a
472   var y-ah/eax: (addr handle call-path-element) <- copy _y
473   var y-a/eax: (addr call-path-element) <- lookup *y-ah
474   var y/edi: (addr call-path-element) <- copy y-a
475   compare x, y
476   {
477     break-if-!=
478     return 1  # true
479   }
480   compare x, 0
481   {
482     break-if-!=
483     return 0  # false
484   }
485   compare y, 0
486   {
487     break-if-!=
488     return 0  # false
489   }
490   # compare word addresses, not contents
491   var x-data-ah/ecx: (addr handle word) <- get x, word
492   var x-data-a/eax: (addr word) <- lookup *x-data-ah
493   var x-data/ecx: int <- copy x-data-a
494   var y-data-ah/eax: (addr handle word) <- get y, word
495   var y-data-a/eax: (addr word) <- lookup *y-data-ah
496   var y-data/eax: int <- copy y-data-a
497 #?   print-string 0, "match? "
498 #?   print-int32-hex 0, x-data
499 #?   print-string 0, " vs "
500 #?   print-int32-hex 0, y-data
501 #?   print-string 0, "\n"
502   compare x-data, y-data
503   {
504     break-if-=
505     return 0  # false
506   }
507   var x-next/ecx: (addr handle call-path-element) <- get x, next
508   var y-next/eax: (addr handle call-path-element) <- get y, next
509   var result/eax: boolean <- call-path-element-match? x-next, y-next
510   return result
511 }
512 
513 # order is irrelevant
514 fn insert-in-call-path list: (addr handle call-path), new: (addr handle call-path-element) {
515   var new-path-storage: (handle call-path)
516   var new-path-ah/edi: (addr handle call-path) <- address new-path-storage
517   allocate new-path-ah
518   var new-path/eax: (addr call-path) <- lookup *new-path-ah
519   var next/ecx: (addr handle call-path) <- get new-path, next
520   copy-object list, next
521   var dest/ecx: (addr handle call-path-element) <- get new-path, data
522   deep-copy-call-path-element new, dest
523   copy-object new-path-ah, list
524 }
525 
526 # assumes dest is initially clear
527 fn deep-copy-call-path-element _src: (addr handle call-path-element), _dest: (addr handle call-path-element) {
528   var src/esi: (addr handle call-path-element) <- copy _src
529   # if src is null, return
530   var _src-addr/eax: (addr call-path-element) <- lookup *src
531   compare _src-addr, 0
532   break-if-=
533   # allocate
534   var src-addr/esi: (addr call-path-element) <- copy _src-addr
535   var dest/eax: (addr handle call-path-element) <- copy _dest
536   allocate dest
537   # copy data
538   var dest-addr/eax: (addr call-path-element) <- lookup *dest
539   {
540     var dest-data-addr/ecx: (addr handle word) <- get dest-addr, word
541     var src-data-addr/eax: (addr handle word) <- get src-addr, word
542     copy-object src-data-addr, dest-data-addr
543   }
544   # recurse
545   var src-next/esi: (addr handle call-path-element) <- get src-addr, next
546   var dest-next/eax: (addr handle call-path-element) <- get dest-addr, next
547   deep-copy-call-path-element src-next, dest-next
548 }
549 
550 fn delete-in-call-path list: (addr handle call-path), needle: (addr handle call-path-element) {
551   var curr-ah/esi: (addr handle call-path) <- copy list
552   $delete-in-call-path:loop: {
553     var _curr/eax: (addr call-path) <- lookup *curr-ah
554     var curr/ecx: (addr call-path) <- copy _curr
555     compare curr, 0
556     break-if-=
557     {
558       var curr-data/eax: (addr handle call-path-element) <- get curr, data
559       var match?/eax: boolean <- call-path-element-match? curr-data, needle
560       compare match?, 0  # false
561       {
562         break-if-=
563         var next-ah/ecx: (addr handle call-path) <- get curr, next
564         copy-object next-ah, curr-ah
565         loop $delete-in-call-path:loop
566       }
567     }
568     curr-ah <- get curr, next
569     loop
570   }
571 }
572 
573 fn increment-final-element list: (addr handle call-path-element) {
574   var final-ah/eax: (addr handle call-path-element) <- copy list
575   var final/eax: (addr call-path-element) <- lookup *final-ah
576   var val-ah/ecx: (addr handle word) <- get final, word
577   var val/eax: (addr word) <- lookup *val-ah
578   var new-ah/edx: (addr handle word) <- get val, next
579   var target/eax: (addr word) <- lookup *new-ah
580   compare target, 0
581   break-if-=
582   copy-object new-ah, val-ah
583 }
584 
585 fn decrement-final-element list: (addr handle call-path-element) {
586   var final-ah/eax: (addr handle call-path-element) <- copy list
587   var final/eax: (addr call-path-element) <- lookup *final-ah
588   var val-ah/ecx: (addr handle word) <- get final, word
589   var val/eax: (addr word) <- lookup *val-ah
590 #?   print-string 0, "replacing "
591 #?   {
592 #?     var foo/eax: int <- copy val
593 #?     print-int32-hex 0, foo
594 #?   }
595   var new-ah/edx: (addr handle word) <- get val, prev
596   var target/eax: (addr word) <- lookup *new-ah
597   compare target, 0
598   break-if-=
599   # val = val->prev
600 #?   print-string 0, " with "
601 #?   {
602 #?     var foo/eax: int <- copy target
603 #?     print-int32-hex 0, foo
604 #?   }
605 #?   print-string 0, "\n"
606   copy-object new-ah, val-ah
607 }
608 
609 fn move-final-element-to-start-of-line list: (addr handle call-path-element) {
610   var final-ah/eax: (addr handle call-path-element) <- copy list
611   var final/eax: (addr call-path-element) <- lookup *final-ah
612   var val-ah/ecx: (addr handle word) <- get final, word
613   var val/eax: (addr word) <- lookup *val-ah
614   var new-ah/edx: (addr handle word) <- get val, prev
615   var target/eax: (addr word) <- lookup *new-ah
616   compare target, 0
617   break-if-=
618   copy-object new-ah, val-ah
619   move-final-element-to-start-of-line list
620 }
621 
622 fn move-final-element-to-end-of-line list: (addr handle call-path-element) {
623   var final-ah/eax: (addr handle call-path-element) <- copy list
624   var final/eax: (addr call-path-element) <- lookup *final-ah
625   var val-ah/ecx: (addr handle word) <- get final, word
626   var val/eax: (addr word) <- lookup *val-ah
627   var new-ah/edx: (addr handle word) <- get val, next
628   var target/eax: (addr word) <- lookup *new-ah
629   compare target, 0
630   break-if-=
631   copy-object new-ah, val-ah
632   move-final-element-to-end-of-line list
633 }
634 
635 fn push-to-call-path-element list: (addr handle call-path-element), new: (addr handle word) {
636   var new-element-storage: (handle call-path-element)
637   var new-element-ah/edi: (addr handle call-path-element) <- address new-element-storage
638   allocate new-element-ah
639   var new-element/eax: (addr call-path-element) <- lookup *new-element-ah
640   # save word
641   var dest/ecx: (addr handle word) <- get new-element, word
642   copy-object new, dest
643   # save next
644   var dest2/ecx: (addr handle call-path-element) <- get new-element, next
645   copy-object list, dest2
646   # return
647   copy-object new-element-ah, list
648 }
649 
650 fn drop-from-call-path-element _list: (addr handle call-path-element) {
651   var list-ah/esi: (addr handle call-path-element) <- copy _list
652   var list/eax: (addr call-path-element) <- lookup *list-ah
653   var next/eax: (addr handle call-path-element) <- get list, next
654   copy-object next, _list
655 }
656 
657 fn drop-nested-calls _list: (addr handle call-path-element) {
658   var list-ah/esi: (addr handle call-path-element) <- copy _list
659   var list/eax: (addr call-path-element) <- lookup *list-ah
660   var next-ah/edi: (addr handle call-path-element) <- get list, next
661   var next/eax: (addr call-path-element) <- lookup *next-ah
662   compare next, 0
663   break-if-=
664   copy-object next-ah, _list
665   drop-nested-calls _list
666 }
667 
668 fn dump-call-path-element screen: (addr screen), _x-ah: (addr handle call-path-element) {
669   var x-ah/ecx: (addr handle call-path-element) <- copy _x-ah
670   var _x/eax: (addr call-path-element) <- lookup *x-ah
671   var x/esi: (addr call-path-element) <- copy _x
672   var word-ah/eax: (addr handle word) <- get x, word
673   var word/eax: (addr word) <- lookup *word-ah
674   print-word screen, word
675   var next-ah/ecx: (addr handle call-path-element) <- get x, next
676   var next/eax: (addr call-path-element) <- lookup *next-ah
677   compare next, 0
678   {
679     break-if-=
680     print-string screen, " "
681     dump-call-path-element screen, next-ah
682     return
683   }
684   print-string screen, "\n"
685 }
686 
687 fn dump-call-paths screen: (addr screen), _x-ah: (addr handle call-path) {
688   var x-ah/ecx: (addr handle call-path) <- copy _x-ah
689   var x/eax: (addr call-path) <- lookup *x-ah
690   compare x, 0
691   break-if-=
692   var src/ecx: (addr handle call-path-element) <- get x, data
693   dump-call-path-element screen, src
694   var next-ah/ecx: (addr handle call-path) <- get x, next
695   var next/eax: (addr call-path) <- lookup *next-ah
696   compare next, 0
697   {
698     break-if-=
699     dump-call-paths screen, next-ah
700   }
701 }
702 
703 fn function-width _self: (addr function) -> _/eax: int {
704   var self/esi: (addr function) <- copy _self
705   var args/ecx: (addr handle word) <- get self, args
706   var arg-width/eax: int <- word-list-length args
707   var result/edi: int <- copy arg-width
708   result <- add 4  # function-header-indent + body-indent
709   var body-ah/eax: (addr handle line) <- get self, body
710   var body-width/eax: int <- body-width body-ah
711   body-width <- add 1  # right margin
712   body-width <- add 2  # body-indent for "≡ "
713   compare result, body-width
714   {
715     break-if->=
716     result <- copy body-width
717   }
718   return result
719 }
720 
721 fn body-width lines: (addr handle line) -> _/eax: int {
722   var curr-ah/esi: (addr handle line) <- copy lines
723   var result/edi: int <- copy 0
724   {
725     var curr/eax: (addr line) <- lookup *curr-ah
726     compare curr, 0
727     break-if-=
728     {
729       var words/ecx: (addr handle word) <- get curr, data
730       var curr-len/eax: int <- word-list-length words
731       compare curr-len, result
732       break-if-<=
733       result <- copy curr-len
734     }
735     curr-ah <- get curr, next
736     loop
737   }
738   return result
739 }
740 
741 fn function-height _self: (addr function) -> _/eax: int {
742   var self/esi: (addr function) <- copy _self
743   var body-ah/eax: (addr handle line) <- get self, body
744   var result/eax: int <- line-list-length body-ah
745   result <- increment  # for function header
746   return result
747 }
748 
749 fn line-list-length lines: (addr handle line) -> _/eax: int {
750   var curr-ah/esi: (addr handle line) <- copy lines
751   var result/edi: int <- copy 0
752   {
753     var curr/eax: (addr line) <- lookup *curr-ah
754     compare curr, 0
755     break-if-=
756     curr-ah <- get curr, next
757     result <- increment
758     loop
759   }
760   return result
761 }