1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
//: Reclaiming memory when it's no longer used.
void test_new_reclaim() {
run(
"def main [\n"
" 10:&:num <- new number:type\n"
" 20:num <- deaddress 10:&:num\n"
" abandon 10:&:num\n"
" 30:&:num <- new number:type\n" // must be same size as abandoned memory to reuse
" 40:num <- deaddress 30:&:num\n"
" 50:bool <- equal 20:num, 40:num\n"
"]\n"
);
CHECK_TRACE_CONTENTS(
// both allocations should have returned the same address
"mem: storing 1 in location 50\n"
);
}
//: When abandoning addresses we'll save them to a 'free list', segregated by size.
//: Before, suppose variable V contains address A which points to payload P:
//: location V contains an alloc-id N
//: location V+1 contains A
//: location A contains alloc-id N
//: location A+1 onwards contains P
//: Additionally, suppose the head of the free list is initially F.
//: After abandoning:
//: location V contains invalid alloc-id -1
//: location V+1 contains 0
//: location A contains invalid alloc-id N
//: location A+1 contains the previous head of free-list F
:(before "End routine Fields")
map<int, int> free_list;
:(before "End Primitive Recipe Declarations")
ABANDON,
:(before "End Primitive Recipe Numbers")
put(Recipe_ordinal, "abandon", ABANDON);
:(before "End Primitive Recipe Checks")
case ABANDON: {
if (!inst.products.empty()) {
raise << maybe(get(Recipe, r).name) << "'abandon' shouldn't write to any products in '" << to_original_string(inst) << "'\n" << end();
break;
}
for (int i = 0; i < SIZE(inst.ingredients); ++i) {
if (!is_mu_address(inst.ingredients.at(i)))
raise << maybe(get(Recipe, r).name) << "ingredients of 'abandon' should be addresses, but ingredient " << i << " is '" << to_string(inst.ingredients.at(i)) << '\n' << end();
break;
}
break;
}
:(before "End Primitive Recipe Implementations")
case ABANDON: {
for (int i = 0; i < SIZE(current_instruction().ingredients); ++i) {
reagent/*copy*/ ingredient = current_instruction().ingredients.at(i);
canonize(ingredient);
abandon(get_or_insert(Memory, ingredientpre { line-height: 125%; }
td.linenos .normal { color: inherit; background-color: transparent; padding-left: 5px; padding-right: 5px; }
span.linenos { color: inherit; background-color: transparent; padding-left: 5px; padding-right: 5px; }
td.linenos .special { color: #000000; background-color: #ffffc0; padding-left: 5px; padding-right: 5px; }
span.linenos.special { color: #000000; background-color: #ffffc0; padding-left: 5px; padding-right: 5px; }
.highlight .hll { background-color: #ffffcc }
.highlight .c { color: #888888 } /* Comment */
.highlight .err { color: #a61717; background-color: #e3d2d2 } /* Error */
.highlight .k { color: #008800; font-weight: bold } /* Keyword */
.highlight .ch { color: #888888 } /* Comment.Hashbang */
.highlight .cm { color: #888888 } /* Comment.Multiline */
.highlight .cp { color: #cc0000; font-weight: bold } /* Comment.Preproc */
.highlight .cpf { color: #888888 } /* Comment.PreprocFile */
.highlight .c1 { color: #888888 } /* Comment.Single */
.highlight .cs { color: #cc0000; font-weight: bold; background-color: #fff0f0 } /* Comment.Special */
.highlight .gd { color: #000000; background-color: #ffdddd } /* Generic.Deleted */
.highlight .ge { font-style: italic } /* Generic.Emph */
.highlight .ges { font-weight: bold; font-style: italic } /* Generic.EmphStrong */
.highlight .gr { color: #aa0000 } /* Generic.Error */
.highlight .gh { color: #333333 } /* Generic.Heading */
.highlight .gi { color: #000000; background-color: #ddffdd } /* Generic.Inserted */
.highlight .go { color: #888888 } /* Generic.Output */
.highlight .gp { color: #555555 } /* Generic.Prompt */
.highlight .gs { font-weight: bold } /* Generic.Strong */
.highlight .gu { color: #666666 } /* Generic.Subheading */
.highlight .gt { color: #aa0000 } /* Generic.Traceback */
.highlight .kc { color: #008800; font-weight: bold } /* Keyword.Constant */
.highlight .kd { color: #008800; font-weight: bold } /* Keyword.Declaration */
.highlight .kn { color: #008800; font-weight: bold } /* Keyword.Namespace */
.highlight .kp { color: #008800 } /* Keyword.Pseudo */
.highlight .kr { color: #008800; font-weight: bold } /* Keyword.Reserved */
.highlight .kt { color: #888888; font-weight: bold } /* Keyword.Type */
.highlight .m { color: #0000DD; font-weight: bold } /* Literal.Number */
.highlight .s { color: #dd2200; background-color: #fff0f0 } /* Literal.String */
.highlight .na { color: #336699 } /* Name.Attribute */
.highlight .nb { color: #003388 } /* Name.Builtin */
.highlight .nc { color: #bb0066; font-weight: bold } /* Name.Class */
.highlight .no { color: #003366; font-weight: bold } /* Name.Constant */
.highlight .nd { color: #555555 } /* Name.Decorator */
.highlight .ne { color: #bb0066; font-weight: bold } /* Name.Exception */
.highlight .nf { color: #0066bb; font-weight: bold } /* Name.Function */
.highlight .nl { color: #336699; font-style: italic } /* Name.Label */
.highlight .nn { color: #bb0066; font-weight: bold } /* Name.Namespace */
.highlight .py { color: #336699; font-weight: bold } /* Name.Property */
.highlight .nt { color: #bb0066; font-weight: bold } /* Name.Tag */
.highlight .nv { color: #336699 } /* Name.Variable */
.highlight .ow { color: #008800 } /* Operator.Word */
.highlight .w { color: #bbbbbb } /* Text.Whitespace */
.highlight .mb { color: #0000DD; font-weight: bold } /* Literal.Number.Bin */
.highlight .mf { color: #0000DD; font-weight: bold } /* Literal.Number.Float */
.highlight .mh { color: #0000DD; font-weight: bold } /* Literal.Number.Hex */
.highlight .mi { color: #0000DD; font-weight: bold } /* Literal.Number.Integer */
.highlight .mo { color: #0000DD; font-weight: bold } /* Literal.Number.Oct */
.highlight .sa { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Affix */
.highlight .sb { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Backtick */
.highlight .sc { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Char */
.highlight .dl { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Delimiter */
.highlight .sd { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Doc */
.highlight .s2 { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Double */
.highlight .se { color: #0044dd; background-color: #fff0f0 } /* Literal.String.Escape */
.highlight .sh { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Heredoc */
.highlight .si { color: #3333bb; background-color: #fff0f0 } /* Literal.String.Interpol */
.highlight .sx { color: #22bb22; background-color: #f0fff0 } /* Literal.String.Other */
.highlight .sr { color: #008800; background-color: #fff0ff } /* Literal.String.Regex */
.highlight .s1 { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Single */
.highlight .ss { color: #aa6600; background-color: #fff0f0 } /* Literal.String.Symbol */
.highlight .bp { color: #003388 } /* Name.Builtin.Pseudo */
.highlight .fm { color: #0066bb; font-weight: bold } /* Name.Function.Magic */
.highlight .vc { color: #336699 } /* Name.Variable.Class */
.highlight .vg { color: #dd7700 } /* Name.Variable.Global */
.highlight .vi { color: #3333bb } /* Name.Variable.Instance */
.highlight .vm { color: #336699 } /* Name.Variable.Magic */
.highlight .il { color: #0000DD; font-weight: bold } /* Literal.Number.Integer.Long */type sandbox {
setup: (handle line)
data: (handle line)
# display data
cursor-call-path: (handle call-path-element)
expanded-words: (handle call-path)
partial-name-for-cursor-word: (handle word) # only when renaming word
partial-name-for-function: (handle word) # only when defining function
#
next: (handle sandbox)
prev: (handle sandbox)
}
type function {
name: (handle array byte)
args: (handle word) # in reverse order
body: (handle line)
# some sort of indication of spatial location
next: (handle function)
}
type line {
name: (handle array byte)
data: (handle word)
result: (handle result) # might be cached
next: (handle line)
prev: (handle line)
}
type word {
scalar-data: (handle gap-buffer)
next: (handle word)
prev: (handle word)
}
# todo: turn this into a sum type
type value {
type: int
number-data: float # if type = 0
text-data: (handle array byte) # if type = 1
array-data: (handle array value) # if type = 2
file-data: (handle buffered-file) # if type = 3
filename: (handle array byte) # if type = 3
screen-data: (handle screen) # if type = 4
}
type table {
data: (handle array bind)
next: (handle table)
}
type bind {
key: (handle array byte)
value: (handle value) # I'd inline this but we sometimes want to return a specific value from a table
}
# A call-path is a data structure that can unambiguously refer to any specific
# call arbitrarily deep inside the call hierarchy of a program.
type call-path {
data: (handle call-path-element)
next: (handle call-path)
}
# A call-path element is a list of elements, each of which corresponds to some call.
type call-path-element {
word: (handle word)
next: (handle call-path-element)
}
type result {
data: value-stack
error: (handle array byte) # single error message for now
}
fn initialize-sandbox _sandbox: (addr sandbox) {
var sandbox/esi: (addr sandbox) <- copy _sandbox
var line-ah/eax: (addr handle line) <- get sandbox, data
allocate line-ah
var line/eax: (addr line) <- lookup *line-ah
initialize-line line
var word-ah/ecx: (addr handle word) <- get line, data
var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
allocate cursor-call-path-ah
var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
var dest/eax: (addr handle word) <- get cursor-call-path, word
copy-object word-ah, dest
}
# initialize line with a single empty word
fn initialize-line _line: (addr line) {
var line/esi: (addr line) <- copy _line
var word-ah/eax: (addr handle word) <- get line, data
allocate word-ah
var word/eax: (addr word) <- lookup *word-ah
initialize-word word
}
fn create-primitive-functions _self: (addr handle function) {
# x 2* = x 2 *
var self/esi: (addr handle function) <- copy _self
allocate self
var _f/eax: (addr function) <- lookup *self
var f/esi: (addr function) <- copy _f
var name-ah/eax: (addr handle array byte) <- get f, name
populate-text-with name-ah, "2*"
var args-ah/eax: (addr handle word) <- get f, args
allocate args-ah
var args/eax: (addr word) <- lookup *args-ah
initialize-word-with args, "x"
var body-ah/eax: (addr handle line) <- get f, body
allocate body-ah
var body/eax: (addr line) <- lookup *body-ah
initialize-line body
var curr-word-ah/ecx: (addr handle word) <- get body, data
parse-words "x 2 *", curr-word-ah
# x 1+ = x 1 +
var next/esi: (addr handle function) <- get f, next
allocate next
var _f/eax: (addr function) <- lookup *next
var f/esi: (addr function) <- copy _f
var name-ah/eax: (addr handle array byte) <- get f, name
populate-text-with name-ah, "1+"
var args-ah/eax: (addr handle word) <- get f, args
allocate args-ah
var args/eax: (addr word) <- lookup *args-ah
initialize-word-with args, "x"
var body-ah/eax: (addr handle line) <- get f, body
allocate body-ah
var body/eax: (addr line) <- lookup *body-ah
initialize-line body
curr-word-ah <- get body, data
parse-words "x 1 +", curr-word-ah
# x 2+ = x 1+ 1+
var next/esi: (addr handle function) <- get f, next
allocate next
var _f/eax: (addr function) <- lookup *next
var f/esi: (addr function) <- copy _f
var name-ah/eax: (addr handle array byte) <- get f, name
populate-text-with name-ah, "2+"
var args-ah/eax: (addr handle word) <- get f, args
allocate args-ah
var args/eax: (addr word) <- lookup *args-ah
initialize-word-with args, "x"
var body-ah/eax: (addr handle line) <- get f, body
allocate body-ah
var body/eax: (addr line) <- lookup *body-ah
initialize-line body
curr-word-ah <- get body, data
parse-words "x 1+ 1+", curr-word-ah
# x square = x x *
var next/esi: (addr handle function) <- get f, next
allocate next
var _f/eax: (addr function) <- lookup *next
var f/esi: (addr function) <- copy _f
var name-ah/eax: (addr handle array byte) <- get f, name
populate-text-with name-ah, "square"
var args-ah/eax: (addr handle word) <- get f, args
allocate args-ah
var args/eax: (addr word) <- lookup *args-ah
initialize-word-with args, "x"
var body-ah/eax: (addr handle line) <- get f, body
allocate body-ah
var body/eax: (addr line) <- lookup *body-ah
initialize-line body
curr-word-ah <- get body, data
parse-words "x x *", curr-word-ah
# x 1- = x 1 -
var next/esi: (addr handle function) <- get f, next
allocate next
var _f/eax: (addr function) <- lookup *next
var f/esi: (addr function) <- copy _f
var name-ah/eax: (addr handle array byte) <- get f, name
populate-text-with name-ah, "1-"
var args-ah/eax: (addr handle word) <- get f, args
allocate args-ah
var args/eax: (addr word) <- lookup *args-ah
initialize-word-with args, "x"
var body-ah/eax: (addr handle line) <- get f, body
allocate body-ah
var body/eax: (addr line) <- lookup *body-ah
initialize-line body
curr-word-ah <- get body, data
parse-words "x 1 -", curr-word-ah
# x y sub = x y -
var next/esi: (addr handle function) <- get f, next
allocate next
var _f/eax: (addr function) <- lookup *next
var f/esi: (addr function) <- copy _f
var name-ah/eax: (addr handle array byte) <- get f, name
populate-text-with name-ah, "sub"
# critical lesson: args are stored in reverse order
var args-ah/eax: (addr handle word) <- get f, args
allocate args-ah
var args/eax: (addr word) <- lookup *args-ah
initialize-word-with args, "y"
var next-arg-ah/eax: (addr handle word) <- get args, next
allocate next-arg-ah
var next-arg/eax: (addr word) <- lookup *next-arg-ah
initialize-word-with next-arg, "x"
var body-ah/eax: (addr handle line) <- get f, body
allocate body-ah
var body/eax: (addr line) <- lookup *body-ah
initialize-line body
curr-word-ah <- get body, data
parse-words "x y -", curr-word-ah
}
fn function-body functions: (addr handle function), _word: (addr handle word), out: (addr handle line) {
var function-name-storage: (handle array byte)
var function-name-ah/ecx: (addr handle array byte) <- address function-name-storage
var word-ah/esi: (addr handle word) <- copy _word
var word/eax: (addr word) <- lookup *word-ah
var gap-ah/eax: (addr handle gap-buffer) <- get word, scalar-data
var gap/eax: (addr gap-buffer) <- lookup *gap-ah
gap-buffer-to-string gap, function-name-ah
var _function-name/eax: (addr array byte) <- lookup *function-name-ah
var function-name/esi: (addr array byte) <- copy _function-name
var curr-ah/ecx: (addr handle function) <- copy functions
$function-body:loop: {
var _curr/eax: (addr function) <- lookup *curr-ah
var curr/edx: (addr function) <- copy _curr
compare curr, 0
break-if-=
var curr-name-ah/eax: (addr handle array byte) <- get curr, name
var curr-name/eax: (addr array byte) <- lookup *curr-name-ah
var found?/eax: boolean <- string-equal? curr-name, function-name
compare found?, 0 # false
{
break-if-=
var src/eax: (addr handle line) <- get curr, body
copy-object src, out
break $function-body:loop
}
curr-ah <- get curr, next
loop
}
}
fn body-length functions: (addr handle function), function-name: (addr handle word) -> _/eax: int {
var body-storage: (handle line)
var body-ah/edi: (addr handle line) <- address body-storage
function-body functions, function-name, body-ah
var body/eax: (addr line) <- lookup *body-ah
var result/eax: int <- num-words-in-line body
return result
}
fn num-words-in-line _in: (addr line) -> _/eax: int {
var in/esi: (addr line) <- copy _in
var curr-ah/ecx: (addr handle word) <- get in, data
var result/edi: int <- copy 0
{
var curr/eax: (addr word) <- lookup *curr-ah
compare curr, 0
break-if-=
curr-ah <- get curr, next
result <- increment
loop
}
return result
}
fn populate-text-with _out: (addr handle array byte), _in: (addr array byte) {
var in/esi: (addr array byte) <- copy _in
var n/ecx: int <- length in
var out/edx: (addr handle array byte) <- copy _out
populate out, n
var _out-addr/eax: (addr array byte) <- lookup *out
var out-addr/edx: (addr array byte) <- copy _out-addr
var i/eax: int <- copy 0
{
compare i, n
break-if->=
var src/esi: (addr byte) <- index in, i
var val/ecx: byte <- copy-byte *src
var dest/edi: (addr byte) <- index out-addr, i
copy-byte-to *dest, val
i <- increment
loop
}
}
fn initialize-path-from-sandbox _in: (addr sandbox), _out: (addr handle call-path-element) {
var sandbox/esi: (addr sandbox) <- copy _in
var line-ah/eax: (addr handle line) <- get sandbox, data
var line/eax: (addr line) <- lookup *line-ah
var src/esi: (addr handle word) <- get line, data
var out-ah/edi: (addr handle call-path-element) <- copy _out
var out/eax: (addr call-path-element) <- lookup *out-ah
var dest/edi: (addr handle word) <- get out, word
copy-object src, dest
}
fn initialize-path-from-line _line: (addr line), _out: (addr handle call-path-element) {
var line/eax: (addr line) <- copy _line
var src/esi: (addr handle word) <- get line, data
var out-ah/edi: (addr handle call-path-element) <- copy _out
var out/eax: (addr call-path-element) <- lookup *out-ah
var dest/edi: (addr handle word) <- get out, word
copy-object src, dest
}
fn find-in-call-paths call-paths: (addr handle call-path), needle: (addr handle call-path-element) -> _/eax: boolean {
var curr-ah/esi: (addr handle call-path) <- copy call-paths
$find-in-call-path:loop: {
var curr/eax: (addr call-path) <- lookup *curr-ah
compare curr, 0
break-if-=
{
var curr-data/eax: (addr handle call-path-element) <- get curr, data
var match?/eax: boolean <- call-path-element-match? curr-data, needle
compare match?, 0 # false
{
break-if-=
return 1 # true
}
}
curr-ah <- get curr, next
loop
}
return 0 # false
}
fn call-path-element-match? _x: (addr handle call-path-element), _y: (addr handle call-path-element) -> _/eax: boolean {
var x-ah/eax: (addr handle call-path-element) <- copy _x
var x-a/eax: (addr call-path-element) <- lookup *x-ah
var x/esi: (addr call-path-element) <- copy x-a
var y-ah/eax: (addr handle call-path-element) <- copy _y
var y-a/eax: (addr call-path-element) <- lookup *y-ah
var y/edi: (addr call-path-element) <- copy y-a
compare x, y
{
break-if-!=
return 1 # true
}
compare x, 0
{
break-if-!=
return 0 # false
}
compare y, 0
{
break-if-!=
return 0 # false
}
# compare word addresses, not contents
var x-data-ah/ecx: (addr handle word) <- get x, word
var x-data-a/eax: (addr word) <- lookup *x-data-ah
var x-data/ecx: int <- copy x-data-a
var y-data-ah/eax: (addr handle word) <- get y, word
var y-data-a/eax: (addr word) <- lookup *y-data-ah
var y-data/eax: int <- copy y-data-a
#? print-string 0, "match? "
#? print-int32-hex 0, x-data
#? print-string 0, " vs "
#? print-int32-hex 0, y-data
#? print-string 0, "\n"
compare x-data, y-data
{
break-if-=
return 0 # false
}
var x-next/ecx: (addr handle call-path-element) <- get x, next
var y-next/eax: (addr handle call-path-element) <- get y, next
var result/eax: boolean <- call-path-element-match? x-next, y-next
return result
}
# order is irrelevant
fn insert-in-call-path list: (addr handle call-path), new: (addr handle call-path-element) {
var new-path-storage: (handle call-path)
var new-path-ah/edi: (addr handle call-path) <- address new-path-storage
allocate new-path-ah
var new-path/eax: (addr call-path) <- lookup *new-path-ah
var next/ecx: (addr handle call-path) <- get new-path, next
copy-object list, next
var dest/ecx: (addr handle call-path-element) <- get new-path, data
deep-copy-call-path-element new, dest
copy-object new-path-ah, list
}
# assumes dest is initially clear
fn deep-copy-call-path-element _src: (addr handle call-path-element), _dest: (addr handle call-path-element) {
var src/esi: (addr handle call-path-element) <- copy _src
# if src is null, return
var _src-addr/eax: (addr call-path-element) <- lookup *src
compare _src-addr, 0
break-if-=
# allocate
var src-addr/esi: (addr call-path-element) <- copy _src-addr
var dest/eax: (addr handle call-path-element) <- copy _dest
allocate dest
# copy data
var dest-addr/eax: (addr call-path-element) <- lookup *dest
{
var dest-data-addr/ecx: (addr handle word) <- get dest-addr, word
var src-data-addr/eax: (addr handle word) <- get src-addr, word
copy-object src-data-addr, dest-data-addr
}
# recurse
var src-next/esi: (addr handle call-path-element) <- get src-addr, next
var dest-next/eax: (addr handle call-path-element) <- get dest-addr, next
deep-copy-call-path-element src-next, dest-next
}
fn delete-in-call-path list: (addr handle call-path), needle: (addr handle call-path-element) {
var curr-ah/esi: (addr handle call-path) <- copy list
$delete-in-call-path:loop: {
var _curr/eax: (addr call-path) <- lookup *curr-ah
var curr/ecx: (addr call-path) <- copy _curr
compare curr, 0
break-if-=
{
var curr-data/eax: (addr handle call-path-element) <- get curr, data
var match?/eax: boolean <- call-path-element-match? curr-data, needle
compare match?, 0 # false
{
break-if-=
var next-ah/ecx: (addr handle call-path) <- get curr, next
copy-object next-ah, curr-ah
loop $delete-in-call-path:loop
}
}
curr-ah <- get curr, next
loop
}
}
fn increment-final-element list: (addr handle call-path-element) {
var final-ah/eax: (addr handle call-path-element) <- copy list
var final/eax: (addr call-path-element) <- lookup *final-ah
var val-ah/ecx: (addr handle word) <- get final, word
var val/eax: (addr word) <- lookup *val-ah
var new-ah/edx: (addr handle word) <- get val, next
var target/eax: (addr word) <- lookup *new-ah
compare target, 0
break-if-=
copy-object new-ah, val-ah
}
fn decrement-final-element list: (addr handle call-path-element) {
var final-ah/eax: (addr handle call-path-element) <- copy list
var final/eax: (addr call-path-element) <- lookup *final-ah
var val-ah/ecx: (addr handle word) <- get final, word
var val/eax: (addr word) <- lookup *val-ah
#? print-string 0, "replacing "
#? {
#? var foo/eax: int <- copy val
#? print-int32-hex 0, foo
#? }
var new-ah/edx: (addr handle word) <- get val, prev
var target/eax: (addr word) <- lookup *new-ah
compare target, 0
break-if-=
# val = val->prev
#? print-string 0, " with "
#? {
#? var foo/eax: int <- copy target
#? print-int32-hex 0, foo
#? }
#? print-string 0, "\n"
copy-object new-ah, val-ah
}
fn move-final-element-to-start-of-line list: (addr handle call-path-element) {
var final-ah/eax: (addr handle call-path-element) <- copy list
var final/eax: (addr call-path-element) <- lookup *final-ah
var val-ah/ecx: (addr handle word) <- get final, word
var val/eax: (addr word) <- lookup *val-ah
var new-ah/edx: (addr handle word) <- get val, prev
var target/eax: (addr word) <- lookup *new-ah
compare target, 0
break-if-=
copy-object new-ah, val-ah
move-final-element-to-start-of-line list
}
fn move-final-element-to-end-of-line list: (addr handle call-path-element) {
var final-ah/eax: (addr handle call-path-element) <- copy list
var final/eax: (addr call-path-element) <- lookup *final-ah
var val-ah/ecx: (addr handle word) <- get final, word
var val/eax: (addr word) <- lookup *val-ah
var new-ah/edx: (addr handle word) <- get val, next
var target/eax: (addr word) <- lookup *new-ah
compare target, 0
break-if-=
copy-object new-ah, val-ah
move-final-element-to-end-of-line list
}
fn push-to-call-path-element list: (addr handle call-path-element), new: (addr handle word) {
var new-element-storage: (handle call-path-element)
var new-element-ah/edi: (addr handle call-path-element) <- address new-element-storage
allocate new-element-ah
var new-element/eax: (addr call-path-element) <- lookup *new-element-ah
# save word
var dest/ecx: (addr handle word) <- get new-element, word
copy-object new, dest
# save next
var dest2/ecx: (addr handle call-path-element) <- get new-element, next
copy-object list, dest2
# return
copy-object new-element-ah, list
}
fn drop-from-call-path-element _list: (addr handle call-path-element) {
var list-ah/esi: (addr handle call-path-element) <- copy _list
var list/eax: (addr call-path-element) <- lookup *list-ah
var next/eax: (addr handle call-path-element) <- get list, next
copy-object next, _list
}
fn drop-nested-calls _list: (addr handle call-path-element) {
var list-ah/esi: (addr handle call-path-element) <- copy _list
var list/eax: (addr call-path-element) <- lookup *list-ah
var next-ah/edi: (addr handle call-path-element) <- get list, next
var next/eax: (addr call-path-element) <- lookup *next-ah
compare next, 0
break-if-=
copy-object next-ah, _list
drop-nested-calls _list
}
fn dump-call-path-element screen: (addr screen), _x-ah: (addr handle call-path-element) {
var x-ah/ecx: (addr handle call-path-element) <- copy _x-ah
var _x/eax: (addr call-path-element) <- lookup *x-ah
var x/esi: (addr call-path-element) <- copy _x
var word-ah/eax: (addr handle word) <- get x, word
var word/eax: (addr word) <- lookup *word-ah
print-word screen, word
var next-ah/ecx: (addr handle call-path-element) <- get x, next
var next/eax: (addr call-path-element) <- lookup *next-ah
compare next, 0
{
break-if-=
print-string screen, " "
dump-call-path-element screen, next-ah
return
}
print-string screen, "\n"
}
fn dump-call-paths screen: (addr screen), _x-ah: (addr handle call-path) {
var x-ah/ecx: (addr handle call-path) <- copy _x-ah
var x/eax: (addr call-path) <- lookup *x-ah
compare x, 0
break-if-=
var src/ecx: (addr handle call-path-element) <- get x, data
dump-call-path-element screen, src
var next-ah/ecx: (addr handle call-path) <- get x, next
var next/eax: (addr call-path) <- lookup *next-ah
compare next, 0
{
break-if-=
dump-call-paths screen, next-ah
}
}
fn function-width _self: (addr function) -> _/eax: int {
var self/esi: (addr function) <- copy _self
var args/ecx: (addr handle word) <- get self, args
var arg-width/eax: int <- word-list-length args
var result/edi: int <- copy arg-width
result <- add 4 # function-header-indent + body-indent
var body-ah/eax: (addr handle line) <- get self, body
var body-width/eax: int <- body-width body-ah
body-width <- add 1 # right margin
body-width <- add 2 # body-indent for "≡ "
compare result, body-width
{
break-if->=
result <- copy body-width
}
return result
}
fn body-width lines: (addr handle line) -> _/eax: int {
var curr-ah/esi: (addr handle line) <- copy lines
var result/edi: int <- copy 0
{
var curr/eax: (addr line) <- lookup *curr-ah
compare curr, 0
break-if-=
{
var words/ecx: (addr handle word) <- get curr, data
var curr-len/eax: int <- word-list-length words
compare curr-len, result
break-if-<=
result <- copy curr-len
}
curr-ah <- get curr, next
loop
}
return result
}
fn function-height _self: (addr function) -> _/eax: int {
var self/esi: (addr function) <- copy _self
var body-ah/eax: (addr handle line) <- get self, body
var result/eax: int <- line-list-length body-ah
result <- increment # for function header
return result
}
fn line-list-length lines: (addr handle line) -> _/eax: int {
var curr-ah/esi: (addr handle line) <- copy lines
var result/edi: int <- copy 0
{
var curr/eax: (addr line) <- lookup *curr-ah
compare curr, 0
break-if-=
curr-ah <- get curr, next
result <- increment
loop
}
return result
}
|