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
148
149
150
151
152
153
154
155
156
157
158
159
160
|
# Experimental Mu shell
# A Lisp with indent-sensitivity and infix.
fn main screen: (addr screen), keyboard: (addr keyboard), data-disk: (addr disk) {
var globals-storage: global-table
var globals/edi: (addr global-table) <- address globals-storage
initialize-globals globals
var sandbox-storage: sandbox
var sandbox/esi: (addr sandbox) <- address sandbox-storage
initialize-sandbox sandbox, 1/with-screen
load-state data-disk, sandbox, globals
$main:loop: {
# globals layout: 1 char padding, 41 code, 1 padding, 41 code, 1 padding = 85
# sandbox layout: 1 padding, 41 code, 1 padding = 43
# total = 128 chars
render-globals screen, globals
render-sandbox screen, sandbox, 0x55/sandbox-left-margin, 0/sandbox-top-margin, 0x80/screen-width, 0x2f/screen-height-without-menu
{
var key/eax: byte <- read-key keyboard
compare key, 0
loop-if-=
# ctrl-r
{
compare key, 0x12/ctrl-r
break-if-!=
var tmp/eax: (addr handle cell) <- copy 0
var nil: (handle cell)
tmp <- address nil
allocate-pair tmp
# (main 0/real-screen 0/real-keyboard)
# We're using the fact that 'screen' and 'keyboard' in this function are always 0.
var real-keyboard: (handle cell)
tmp <- address real-keyboard
allocate-keyboard tmp
# args = cons(real-keyboard, nil)
var args: (handle cell)
tmp <- address args
new-pair tmp, real-keyboard, nil
#
var real-screen: (handle cell)
tmp <- address real-screen
allocate-screen tmp
# args = cons(real-screen, args)
tmp <- address args
new-pair tmp, real-screen, *tmp
#
var main: (handle cell)
tmp <- address main
new-symbol tmp, "main"
# args = cons(main, args)
tmp <- address args
new-pair tmp, main, *tmp
# clear real screen
clear-screen screen
set-cursor-position screen, 0, 0
# run
var out: (handle cell)
var out-ah/ecx: (addr handle cell) <- address out
evaluate tmp, out-ah, nil, globals, 0/trace, 0/no-fake-screen, 0/no-fake-keyboard, 0/call-number
{
var tmp/eax: byte <- read-key keyboard
compare tmp, 0
loop-if-=
}
#
loop $main:loop
}
# no way to quit right now; just reboot
edit-sandbox sandbox, key, globals, data-disk, screen, 1/tweak-real-screen
}
loop
}
}
# Gotcha: some saved state may not load.
fn load-state data-disk: (addr disk), _sandbox: (addr sandbox), globals: (addr global-table) {
var sandbox/eax: (addr sandbox) <- copy _sandbox
var data-ah/eax: (addr handle gap-buffer) <- get sandbox, data
var _data/eax: (addr gap-buffer) <- lookup *data-ah
var data/esi: (addr gap-buffer) <- copy _data
# data-disk -> stream
var s-storage: (stream byte 0x1000) # space for 8/sectors
var s/ebx: (addr stream byte) <- address s-storage
draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "loading sectors from data disk", 3/fg, 0/bg
move-cursor-to-left-margin-of-next-line 0/screen
load-sectors data-disk, 0/lba, 8/sectors, s
#? draw-stream-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, s, 7/fg, 0xc5/bg=blue-bg
# stream -> gap-buffer
draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "parsing", 3/fg, 0/bg
move-cursor-to-left-margin-of-next-line 0/screen
load-gap-buffer-from-stream data, s
draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, " into gap buffer", 3/fg, 0/bg
move-cursor-to-left-margin-of-next-line 0/screen
clear-stream s
# read: gap-buffer -> cell
var initial-root-storage: (handle cell)
var initial-root/ecx: (addr handle cell) <- address initial-root-storage
read-cell data, initial-root, 0/no-trace
draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, " into s-expressions", 3/fg, 0/bg
move-cursor-to-left-margin-of-next-line 0/screen
clear-gap-buffer data
#
{
var initial-root-addr/eax: (addr cell) <- lookup *initial-root
compare initial-root-addr, 0
break-if-!=
return
}
# load globals from assoc(initial-root, 'globals)
var globals-literal-storage: (handle cell)
var globals-literal-ah/eax: (addr handle cell) <- address globals-literal-storage
new-symbol globals-literal-ah, "globals"
var globals-literal/eax: (addr cell) <- lookup *globals-literal-ah
var globals-cell-storage: (handle cell)
var globals-cell-ah/edx: (addr handle cell) <- address globals-cell-storage
lookup-symbol globals-literal, globals-cell-ah, *initial-root, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard
var globals-cell/eax: (addr cell) <- lookup *globals-cell-ah
{
compare globals-cell, 0
break-if-=
load-globals globals-cell-ah, globals
}
# sandbox = assoc(initial-root, 'sandbox)
draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "loading sandbox", 3/fg, 0/bg
var sandbox-literal-storage: (handle cell)
var sandbox-literal-ah/eax: (addr handle cell) <- address sandbox-literal-storage
new-symbol sandbox-literal-ah, "sandbox"
var sandbox-literal/eax: (addr cell) <- lookup *sandbox-literal-ah
var sandbox-cell-storage: (handle cell)
var sandbox-cell-ah/edx: (addr handle cell) <- address sandbox-cell-storage
lookup-symbol sandbox-literal, sandbox-cell-ah, *initial-root, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard
var sandbox-cell/eax: (addr cell) <- lookup *sandbox-cell-ah
{
compare sandbox-cell, 0
break-if-=
# print: cell -> stream
print-cell sandbox-cell-ah, s, 0/no-trace
# stream -> gap-buffer
load-gap-buffer-from-stream data, s
}
}
# Save state as an alist of alists:
# ((globals . ((a . (fn ...))
# ...))
# (sandbox . ...))
fn store-state data-disk: (addr disk), sandbox: (addr sandbox), globals: (addr global-table) {
compare data-disk, 0/no-disk
{
break-if-!=
return
}
var stream-storage: (stream byte 0x1000) # space enough for 8/sectors
var stream/edi: (addr stream byte) <- address stream-storage
write stream, "(\n"
write-globals stream, globals
write-sandbox stream, sandbox
write stream, ")\n"
store-sectors data-disk, 0/lba, 8/sectors, stream
}
|