shell: ctrl-r runs on real screen without a trace
We run out of memory fairly early in the course of drawing a chessboard on the whole screen.
This commit is contained in:
parent
c11ea74442
commit
97df52bf2f
14
boot.subx
14
boot.subx
|
@ -107,6 +107,20 @@
|
|||
cd/syscall 0x13/imm8/bios-disk-services
|
||||
0f 82/jump-if-carry disk_error/disp16
|
||||
|
||||
# load two more tracks of disk into addresses [0x37000, 0x46c00)
|
||||
b4/copy-to-ah 2/imm8/read-drive
|
||||
# dl comes conveniently initialized at boot time with the index of the device being booted
|
||||
b5/copy-to-ch 0/imm8/cylinder
|
||||
b6/copy-to-dh 4/imm8/head
|
||||
b1/copy-to-cl 1/imm8/sector # 1-based
|
||||
b0/copy-to-al 0x7e/imm8/num-sectors # 2*63 = 126
|
||||
# address to write sectors to = es:bx = 0x37000, contiguous with boot segment
|
||||
bb/copy-to-bx 0x3700/imm16
|
||||
8e/->seg 3/mod/direct 3/rm32/bx 0/r32/es
|
||||
bb/copy-to-bx 0/imm16
|
||||
cd/syscall 0x13/imm8/bios-disk-services
|
||||
0f 82/jump-if-carry disk_error/disp16
|
||||
|
||||
# reset es
|
||||
bb/copy-to-bx 0/imm16
|
||||
8e/->seg 3/mod/direct 3/rm32/bx 0/r32/es
|
||||
|
|
|
@ -84,8 +84,7 @@ fn new-float out: (addr handle cell), n: float {
|
|||
initialize-float out, n
|
||||
}
|
||||
|
||||
fn allocate-pair _out: (addr handle cell) {
|
||||
var out/eax: (addr handle cell) <- copy _out
|
||||
fn allocate-pair out: (addr handle cell) {
|
||||
allocate out
|
||||
# new cells have type pair by default
|
||||
}
|
||||
|
@ -133,8 +132,6 @@ fn allocate-screen _out: (addr handle cell) {
|
|||
var out/eax: (addr handle cell) <- copy _out
|
||||
allocate out
|
||||
var out-addr/eax: (addr cell) <- lookup *out
|
||||
var dest-ah/ecx: (addr handle screen) <- get out-addr, screen-data
|
||||
allocate dest-ah
|
||||
var type/ecx: (addr int) <- get out-addr, type
|
||||
copy-to *type, 5/screen
|
||||
}
|
||||
|
@ -144,6 +141,7 @@ fn new-fake-screen _out: (addr handle cell), width: int, height: int {
|
|||
allocate-screen out
|
||||
var out-addr/eax: (addr cell) <- lookup *out
|
||||
var dest-ah/eax: (addr handle screen) <- get out-addr, screen-data
|
||||
allocate dest-ah
|
||||
var dest-addr/eax: (addr screen) <- lookup *dest-ah
|
||||
initialize-screen dest-addr, width, height
|
||||
}
|
||||
|
@ -165,8 +163,6 @@ fn allocate-keyboard _out: (addr handle cell) {
|
|||
var out/eax: (addr handle cell) <- copy _out
|
||||
allocate out
|
||||
var out-addr/eax: (addr cell) <- lookup *out
|
||||
var dest-ah/ecx: (addr handle gap-buffer) <- get out-addr, keyboard-data
|
||||
allocate dest-ah
|
||||
var type/ecx: (addr int) <- get out-addr, type
|
||||
copy-to *type, 6/keyboard
|
||||
}
|
||||
|
@ -176,6 +172,7 @@ fn new-fake-keyboard _out: (addr handle cell), capacity: int {
|
|||
allocate-keyboard out
|
||||
var out-addr/eax: (addr cell) <- lookup *out
|
||||
var dest-ah/eax: (addr handle gap-buffer) <- get out-addr, keyboard-data
|
||||
allocate dest-ah
|
||||
var dest-addr/eax: (addr gap-buffer) <- lookup *dest-ah
|
||||
initialize-gap-buffer dest-addr, capacity
|
||||
}
|
||||
|
|
|
@ -66,6 +66,22 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel
|
|||
trace-higher trace
|
||||
return
|
||||
}
|
||||
compare *in-type, 5/screen
|
||||
{
|
||||
break-if-!=
|
||||
trace-text trace, "eval", "screen"
|
||||
copy-object _in, out
|
||||
trace-higher trace
|
||||
return
|
||||
}
|
||||
compare *in-type, 6/keyboard
|
||||
{
|
||||
break-if-!=
|
||||
trace-text trace, "eval", "keyboard"
|
||||
copy-object _in, out
|
||||
trace-higher trace
|
||||
return
|
||||
}
|
||||
# in-addr is a syntax tree
|
||||
$evaluate:anonymous-function: {
|
||||
# trees starting with "fn" are anonymous functions
|
||||
|
@ -225,8 +241,6 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel
|
|||
var evaluated-list/eax: (addr cell) <- lookup *evaluated-list-ah
|
||||
var function-ah/ecx: (addr handle cell) <- get evaluated-list, left
|
||||
var args-ah/edx: (addr handle cell) <- get evaluated-list, right
|
||||
#? set-cursor-position 0/screen, 0, 0
|
||||
#? draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "a", 7/fg, 0/bg
|
||||
apply function-ah, args-ah, out, globals, trace, screen-cell, keyboard-cell
|
||||
trace-higher trace
|
||||
# trace "=> " out {{{
|
||||
|
|
|
@ -9,13 +9,59 @@ fn main screen: (addr screen), keyboard: (addr keyboard), data-disk: (addr disk)
|
|||
var sandbox/esi: (addr sandbox) <- address sandbox-storage
|
||||
initialize-sandbox sandbox, 1/with-screen
|
||||
load-state data-disk, sandbox, globals
|
||||
{
|
||||
$main:loop: {
|
||||
render-globals screen, globals, 0/x, 0/y, 0x40/xmax, 0x2f/screen-height-without-menu
|
||||
render-sandbox screen, sandbox, 0x40/x, 0/y, 0x80/screen-width, 0x2f/screen-height-without-menu, globals
|
||||
{
|
||||
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
|
||||
{
|
||||
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, screen, keyboard, data-disk
|
||||
}
|
||||
|
|
|
@ -54,14 +54,26 @@ fn print-cell _in: (addr handle cell), out: (addr stream byte), trace: (addr tra
|
|||
trace-higher trace
|
||||
return
|
||||
}
|
||||
compare *in-type, 5/primitive
|
||||
compare *in-type, 5/screen
|
||||
{
|
||||
break-if-!=
|
||||
write out, "[screen "
|
||||
var screen-ah/eax: (addr handle screen) <- get in-addr, screen-data
|
||||
var screen/eax: (addr screen) <- lookup *screen-ah
|
||||
var screen-addr/eax: int <- copy screen
|
||||
write-int32-decimal out, screen-addr
|
||||
write-int32-hex out, screen-addr
|
||||
write out, "]"
|
||||
trace-higher trace
|
||||
return
|
||||
}
|
||||
compare *in-type, 6/keyboard
|
||||
{
|
||||
break-if-!=
|
||||
write out, "[keyboard "
|
||||
var keyboard-ah/eax: (addr handle gap-buffer) <- get in-addr, keyboard-data
|
||||
var keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
|
||||
var keyboard-addr/eax: int <- copy keyboard
|
||||
write-int32-hex out, keyboard-addr
|
||||
write out, "]"
|
||||
trace-higher trace
|
||||
return
|
||||
|
|
|
@ -464,6 +464,8 @@ fn render-sandbox-menu screen: (addr screen), _self: (addr sandbox) {
|
|||
height <- increment
|
||||
clear-rect screen, 0/x, y, width, height, 0/bg=black
|
||||
set-cursor-position screen, 0/x, y
|
||||
draw-text-rightward-from-cursor screen, " ctrl-r ", width, 0/fg, 7/bg=grey
|
||||
draw-text-rightward-from-cursor screen, " run main ", width, 7/fg, 0/bg
|
||||
draw-text-rightward-from-cursor screen, " ctrl-s ", width, 0/fg, 7/bg=grey
|
||||
draw-text-rightward-from-cursor screen, " run sandbox ", width, 7/fg, 0/bg
|
||||
$render-sandbox-menu:render-tab: {
|
||||
|
@ -473,11 +475,11 @@ fn render-sandbox-menu screen: (addr screen), _self: (addr sandbox) {
|
|||
{
|
||||
break-if-=
|
||||
draw-text-rightward-from-cursor screen, " tab ", width, 0/fg, 9/bg=blue
|
||||
draw-text-rightward-from-cursor screen, " move to trace ", width, 7/fg, 0/bg
|
||||
draw-text-rightward-from-cursor screen, " to trace ", width, 7/fg, 0/bg
|
||||
break $render-sandbox-menu:render-tab
|
||||
}
|
||||
draw-text-rightward-from-cursor screen, " tab ", width, 0/fg, 0x18/bg=keyboard
|
||||
draw-text-rightward-from-cursor screen, " move to keyboard ", width, 7/fg, 0/bg
|
||||
draw-text-rightward-from-cursor screen, " to keyboard ", width, 7/fg, 0/bg
|
||||
}
|
||||
draw-text-rightward-from-cursor screen, " ctrl-a ", width, 0/fg, 7/bg=grey
|
||||
draw-text-rightward-from-cursor screen, " << ", width, 7/fg, 0/bg
|
||||
|
@ -499,24 +501,17 @@ fn render-keyboard-menu screen: (addr screen) {
|
|||
height <- increment
|
||||
clear-rect screen, 0/x, y, width, height, 0/bg=black
|
||||
set-cursor-position screen, 0/x, y
|
||||
draw-text-rightward-from-cursor screen, " ctrl-r ", width, 0/fg, 7/bg=grey
|
||||
draw-text-rightward-from-cursor screen, " run main ", width, 7/fg, 0/bg
|
||||
draw-text-rightward-from-cursor screen, " ctrl-s ", width, 0/fg, 7/bg=grey
|
||||
draw-text-rightward-from-cursor screen, " run sandbox ", width, 7/fg, 0/bg
|
||||
draw-text-rightward-from-cursor screen, " tab ", width, 0/fg, 3/bg=cyan
|
||||
draw-text-rightward-from-cursor screen, " move to sandbox ", width, 7/fg, 0/bg
|
||||
draw-text-rightward-from-cursor screen, " to sandbox ", width, 7/fg, 0/bg
|
||||
}
|
||||
|
||||
fn edit-sandbox _self: (addr sandbox), key: byte, globals: (addr global-table), real-screen: (addr screen), real-keyboard: (addr keyboard), data-disk: (addr disk) {
|
||||
var self/esi: (addr sandbox) <- copy _self
|
||||
var g/edx: grapheme <- copy key
|
||||
# ctrl-r
|
||||
{
|
||||
compare g, 0x12/ctrl-r
|
||||
break-if-!=
|
||||
# run function outside sandbox
|
||||
# required: fn (addr screen), (addr keyboard)
|
||||
# Mu will pass in the real screen and keyboard.
|
||||
return
|
||||
}
|
||||
# ctrl-s
|
||||
{
|
||||
compare g, 0x13/ctrl-s
|
||||
|
|
|
@ -678,10 +678,12 @@ fn render-trace-menu screen: (addr screen) {
|
|||
var y/ecx: int <- copy height
|
||||
y <- decrement
|
||||
set-cursor-position screen, 0/x, y
|
||||
draw-text-rightward-from-cursor screen, " ctrl-r ", width, 0/fg, 7/bg=grey
|
||||
draw-text-rightward-from-cursor screen, " run main ", width, 7/fg, 0/bg
|
||||
draw-text-rightward-from-cursor screen, " ctrl-s ", width, 0/fg, 7/bg=grey
|
||||
draw-text-rightward-from-cursor screen, " run sandbox ", width, 7/fg, 0/bg
|
||||
draw-text-rightward-from-cursor screen, " tab ", width, 0/fg, 0x18/bg=keyboard
|
||||
draw-text-rightward-from-cursor screen, " move to keyboard ", width, 7/fg, 0/bg
|
||||
draw-text-rightward-from-cursor screen, " to keyboard ", width, 7/fg, 0/bg
|
||||
draw-text-rightward-from-cursor screen, " j ", width, 0/fg, 7/bg=grey
|
||||
draw-text-rightward-from-cursor screen, " down ", width, 7/fg, 0/bg
|
||||
draw-text-rightward-from-cursor screen, " k ", width, 0/fg, 7/bg=grey
|
||||
|
|
|
@ -34,7 +34,7 @@ cat a.survey |linux/hex > a.bin
|
|||
dd if=/dev/zero of=code.img count=20160 # 512-byte sectors, so 10MB
|
||||
dd if=a.bin of=code.img conv=notrunc
|
||||
|
||||
if [ `stat --printf="%s" a.bin` -ge 193536 ] # 6 tracks * 63 sectors per track * 512 bytes per sector (keep this sync'd with boot.subx)
|
||||
if [ `stat --printf="%s" a.bin` -ge 258048 ] # 8 tracks * 63 sectors per track * 512 bytes per sector (keep this sync'd with boot.subx)
|
||||
then
|
||||
echo "a.bin won't all be loaded on boot"
|
||||
exit 1
|
||||
|
|
|
@ -29,7 +29,7 @@ cat a.survey |linux/bootstrap/bootstrap run linux/hex > a.bi
|
|||
dd if=/dev/zero of=code.img count=20160 # 512-byte sectors, so 10MB
|
||||
dd if=a.bin of=code.img conv=notrunc
|
||||
|
||||
if [ `stat --printf="%s" a.bin` -ge 193536 ] # 6 tracks * 63 sectors per track * 512 bytes per sector (keep this sync'd with boot.subx)
|
||||
if [ `stat --printf="%s" a.bin` -ge 258048 ] # 8 tracks * 63 sectors per track * 512 bytes per sector (keep this sync'd with boot.subx)
|
||||
then
|
||||
echo "a.bin won't all be loaded on boot"
|
||||
exit 1
|
||||
|
|
Loading…
Reference in New Issue