shell: literal images
This commit is contained in:
parent
e2f6e9011e
commit
e2f18e8866
|
@ -81,11 +81,8 @@ load-debug-symbols: # labels: (addr stream {start-address, label-slice})
|
||||||
c7 0/subop/copy *ecx 0/imm32 # write index
|
c7 0/subop/copy *ecx 0/imm32 # write index
|
||||||
c7 0/subop/copy *(ecx+4) 0/imm32 # read index
|
c7 0/subop/copy *(ecx+4) 0/imm32 # read index
|
||||||
c7 0/subop/copy *(ecx+8) 0x01000000/imm32 # stream capacity = 16MB
|
c7 0/subop/copy *(ecx+8) 0x01000000/imm32 # stream capacity = 16MB
|
||||||
# load 0x400 sectors starting from sector 10080 = 0x2760
|
# load sectors starting from sector 10080 = 0x2760
|
||||||
(read-ata-disk Primary-bus-primary-drive 0x2760 0x100 %ecx)
|
(load-sectors Primary-bus-primary-drive 0x2760 0x800 %ecx) # 0x800 sectors = 1MB
|
||||||
(read-ata-disk Primary-bus-primary-drive 0x2860 0x100 %ecx)
|
|
||||||
(read-ata-disk Primary-bus-primary-drive 0x2960 0x100 %ecx)
|
|
||||||
(read-ata-disk Primary-bus-primary-drive 0x2a60 0x100 %ecx)
|
|
||||||
# - parse pointers to portions of this stream into labels
|
# - parse pointers to portions of this stream into labels
|
||||||
# var curr/ecx: (addr byte) = s->data
|
# var curr/ecx: (addr byte) = s->data
|
||||||
81 0/subop/add %ecx 0xc/imm32
|
81 0/subop/add %ecx 0xc/imm32
|
||||||
|
|
|
@ -171,6 +171,20 @@ fn evaluate _in-ah: (addr handle cell), _out-ah: (addr handle cell), env-h: (han
|
||||||
trace-higher trace
|
trace-higher trace
|
||||||
return
|
return
|
||||||
}
|
}
|
||||||
|
$evaluate:literal-image: {
|
||||||
|
# trees starting with "litimg" are literals
|
||||||
|
var expr/esi: (addr cell) <- copy in
|
||||||
|
var in/edx: (addr cell) <- copy in
|
||||||
|
var first-ah/ecx: (addr handle cell) <- get in, left
|
||||||
|
var first/eax: (addr cell) <- lookup *first-ah
|
||||||
|
var litimg?/eax: boolean <- litimg? first
|
||||||
|
compare litimg?, 0/false
|
||||||
|
break-if-=
|
||||||
|
trace-text trace, "eval", "literal image"
|
||||||
|
copy-object _in-ah, _out-ah
|
||||||
|
trace-higher trace
|
||||||
|
return
|
||||||
|
}
|
||||||
$evaluate:anonymous-function: {
|
$evaluate:anonymous-function: {
|
||||||
# trees starting with "fn" are anonymous functions
|
# trees starting with "fn" are anonymous functions
|
||||||
var expr/esi: (addr cell) <- copy in
|
var expr/esi: (addr cell) <- copy in
|
||||||
|
@ -1546,6 +1560,20 @@ fn litmac? _x: (addr cell) -> _/eax: boolean {
|
||||||
return result
|
return result
|
||||||
}
|
}
|
||||||
|
|
||||||
|
fn litimg? _x: (addr cell) -> _/eax: boolean {
|
||||||
|
var x/esi: (addr cell) <- copy _x
|
||||||
|
var type/eax: (addr int) <- get x, type
|
||||||
|
compare *type, 2/symbol
|
||||||
|
{
|
||||||
|
break-if-=
|
||||||
|
return 0/false
|
||||||
|
}
|
||||||
|
var contents-ah/eax: (addr handle stream byte) <- get x, text-data
|
||||||
|
var contents/eax: (addr stream byte) <- lookup *contents-ah
|
||||||
|
var result/eax: boolean <- stream-data-equal? contents, "litimg"
|
||||||
|
return result
|
||||||
|
}
|
||||||
|
|
||||||
fn test-evaluate-is-well-behaved {
|
fn test-evaluate-is-well-behaved {
|
||||||
var t-storage: trace
|
var t-storage: trace
|
||||||
var t/esi: (addr trace) <- address t-storage
|
var t/esi: (addr trace) <- address t-storage
|
||||||
|
|
|
@ -103,6 +103,15 @@ fn macroexpand-iter _expr-ah: (addr handle cell), globals: (addr global-table),
|
||||||
trace-higher trace
|
trace-higher trace
|
||||||
return 0/false
|
return 0/false
|
||||||
}
|
}
|
||||||
|
{
|
||||||
|
var litimg?/eax: boolean <- litimg? first
|
||||||
|
compare litimg?, 0/false
|
||||||
|
break-if-=
|
||||||
|
# litimg is a literal
|
||||||
|
trace-text trace, "mac", "literal image"
|
||||||
|
trace-higher trace
|
||||||
|
return 0/false
|
||||||
|
}
|
||||||
var result/edi: boolean <- copy 0/false
|
var result/edi: boolean <- copy 0/false
|
||||||
# for each builtin, expand only what will later be evaluated
|
# for each builtin, expand only what will later be evaluated
|
||||||
$macroexpand-iter:anonymous-function: {
|
$macroexpand-iter:anonymous-function: {
|
||||||
|
|
|
@ -235,7 +235,7 @@ fn print-stream _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
|
||||||
compare should-trace?, 0/false
|
compare should-trace?, 0/false
|
||||||
break-if-=
|
break-if-=
|
||||||
rewind-stream data
|
rewind-stream data
|
||||||
var stream-storage: (stream byte 0x40)
|
var stream-storage: (stream byte 0x400)
|
||||||
var stream/ecx: (addr stream byte) <- address stream-storage
|
var stream/ecx: (addr stream byte) <- address stream-storage
|
||||||
write stream, "=> stream "
|
write stream, "=> stream "
|
||||||
write-stream-immutable stream, data
|
write-stream-immutable stream, data
|
||||||
|
|
|
@ -49,7 +49,7 @@ fi
|
||||||
|
|
||||||
# Latter half of disk is for debug info.
|
# Latter half of disk is for debug info.
|
||||||
dd if=labels of=code.img seek=10080 conv=notrunc # keep this sync'd with abort.subx
|
dd if=labels of=code.img seek=10080 conv=notrunc # keep this sync'd with abort.subx
|
||||||
if [ `stat --printf="%s" labels` -ge 524288 ] # 4 reads * 256 sectors * 512 bytes per sector
|
if [ `stat --printf="%s" labels` -ge 1048576 ] # 8 reads * 256 sectors * 512 bytes per sector
|
||||||
then
|
then
|
||||||
echo "labels won't all be loaded on abort"
|
echo "labels won't all be loaded on abort"
|
||||||
exit 1
|
exit 1
|
||||||
|
|
|
@ -53,7 +53,7 @@ fi
|
||||||
|
|
||||||
# Latter half of disk is for debug info.
|
# Latter half of disk is for debug info.
|
||||||
dd if=labels of=code.img seek=10080 conv=notrunc # keep this sync'd with abort.subx
|
dd if=labels of=code.img seek=10080 conv=notrunc # keep this sync'd with abort.subx
|
||||||
if [ `stat --printf="%s" labels` -ge 524288 ] # 4 reads * 256 sectors * 512 bytes per sector
|
if [ `stat --printf="%s" labels` -ge 1048576 ] # 8 reads * 256 sectors * 512 bytes per sector
|
||||||
then
|
then
|
||||||
echo "labels won't all be loaded on abort"
|
echo "labels won't all be loaded on abort"
|
||||||
exit 1
|
exit 1
|
||||||
|
|
Loading…
Reference in New Issue