Fixed bug in tape_resize.
This commit is contained in:
parent
0303bcbeaa
commit
e1f72a08ba
|
|
@ -12,6 +12,7 @@ let /* Booleans */
|
||||||
var DEBUG_PRINT_STACK : bool := false
|
var DEBUG_PRINT_STACK : bool := false
|
||||||
var DEBUG_PRINT_TAPE : bool := false
|
var DEBUG_PRINT_TAPE : bool := false
|
||||||
var DEBUG_PRINT_PARSED : bool := false
|
var DEBUG_PRINT_PARSED : bool := false
|
||||||
|
var DEBUG_PRINT_JUMPS : bool := false
|
||||||
|
|
||||||
var ALLOW_TAPE_RESIZE : bool := true
|
var ALLOW_TAPE_RESIZE : bool := true
|
||||||
|
|
||||||
|
|
@ -886,14 +887,24 @@ let /* Booleans */
|
||||||
|
|
||||||
function tape_new (init_size: int): vm_tape =
|
function tape_new (init_size: int): vm_tape =
|
||||||
vm_tape { capacity = init_size
|
vm_tape { capacity = init_size
|
||||||
, filled = 0
|
, filled = 0
|
||||||
, tape = vm_tape_tape [init_size] of nil }
|
, tape = vm_tape_tape [init_size] of nil }
|
||||||
|
|
||||||
function tape_resize(tape: vm_tape, new_size: int) =
|
function tape_resize(tape: vm_tape, new_size: int) =
|
||||||
let var new_tape_tape := vm_tape_tape [new_size] of nil
|
let var new_tape_tape := vm_tape_tape [new_size] of nil
|
||||||
in for i := 0 to tape.filled - 1
|
in if DEBUG_PRINT_TAPE
|
||||||
|
then ( print("Resizing tape with ratio ")
|
||||||
|
; print(int_to_string(tape.filled))
|
||||||
|
; print("/")
|
||||||
|
; print(int_to_string(tape.capacity))
|
||||||
|
; print(" to new capacity of ")
|
||||||
|
; print(int_to_string(new_size))
|
||||||
|
; print("\n")
|
||||||
|
)
|
||||||
|
; for i := 0 to tape.filled - 1
|
||||||
do new_tape_tape[i] := tape.tape[i]
|
do new_tape_tape[i] := tape.tape[i]
|
||||||
; tape.tape := new_tape_tape
|
; tape.tape := new_tape_tape
|
||||||
|
; tape.capacity := new_size
|
||||||
end
|
end
|
||||||
|
|
||||||
function tape_append(tape: vm_tape, new_insns: vm_insn_list): int =
|
function tape_append(tape: vm_tape, new_insns: vm_insn_list): int =
|
||||||
|
|
@ -920,17 +931,28 @@ let /* Booleans */
|
||||||
; print(int_to_string(new_insns))
|
; print(int_to_string(new_insns))
|
||||||
; print(" new instructions is impossible.\n"))
|
; print(" new instructions is impossible.\n"))
|
||||||
|
|
||||||
; while head <> nil
|
; while head <> nil & head.insn <> nil
|
||||||
do ( tape.tape[index] := head.insn
|
do ( tape.tape[index] := head.insn
|
||||||
; index := index + 1
|
; index := index + 1
|
||||||
; head := head.next )
|
; head := head.next )
|
||||||
; tape.filled := index
|
; tape.filled := index
|
||||||
|
|
||||||
|
/* Report if debug enabled */
|
||||||
; if DEBUG_PRINT_TAPE
|
; if DEBUG_PRINT_TAPE
|
||||||
then ( print("Appended new to tape: ")
|
then ( print("Appended ")
|
||||||
|
; print(int_to_string(new_insns))
|
||||||
|
; print(" new instructions to tape,\n\tIn range: ")
|
||||||
; print(int_to_string(index_start))
|
; print(int_to_string(index_start))
|
||||||
; print(" to ")
|
; print(" to ")
|
||||||
; print(int_to_string(index))
|
; print(int_to_string(index-1))
|
||||||
; print("\n") )
|
; print("\n\tTape ratio: ")
|
||||||
|
; print(int_to_string(tape.filled))
|
||||||
|
; print("/")
|
||||||
|
; print(int_to_string(tape.capacity))
|
||||||
|
; print("\n")
|
||||||
|
)
|
||||||
|
|
||||||
|
/* Return start of new appendings */
|
||||||
; index_start
|
; index_start
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
@ -1052,7 +1074,6 @@ let /* Booleans */
|
||||||
; app(OPCODE_EQV, 0, "")
|
; app(OPCODE_EQV, 0, "")
|
||||||
; app(OPCODE_RET, 1, "")
|
; app(OPCODE_RET, 1, "")
|
||||||
|
|
||||||
|
|
||||||
/* R5RS: Pairs and Lists */
|
/* R5RS: Pairs and Lists */
|
||||||
|
|
||||||
; stdfun("pair?")
|
; stdfun("pair?")
|
||||||
|
|
@ -1955,11 +1976,7 @@ let /* Booleans */
|
||||||
| vm_insn_num_opcodes <= insn.opcode
|
| vm_insn_num_opcodes <= insn.opcode
|
||||||
| vm_insn_info[insn.opcode] = nil
|
| vm_insn_info[insn.opcode] = nil
|
||||||
|
|
||||||
then ( print(concat5( "Encountered unknown opcode "
|
then "NIL"
|
||||||
, int_to_string(insn.opcode)
|
|
||||||
, " in insn_to_string!\n"
|
|
||||||
, "", ""))
|
|
||||||
; "???" )
|
|
||||||
else if insn.opcode = OPCODE_DGOTO & insn.arg1 = 1
|
else if insn.opcode = OPCODE_DGOTO & insn.arg1 = 1
|
||||||
then "NOOP"
|
then "NOOP"
|
||||||
else
|
else
|
||||||
|
|
@ -1997,7 +2014,7 @@ let /* Booleans */
|
||||||
in concat(repeat(" ", ln_width-size(num_str)), num_str)
|
in concat(repeat(" ", ln_width-size(num_str)), num_str)
|
||||||
end
|
end
|
||||||
|
|
||||||
in while index <= last
|
in while index <= last & real_tape[index] <> nil
|
||||||
do ( str := concat5( str
|
do ( str := concat5( str
|
||||||
, line_number(index)
|
, line_number(index)
|
||||||
, " "
|
, " "
|
||||||
|
|
@ -2043,10 +2060,10 @@ let /* Booleans */
|
||||||
if value = nil
|
if value = nil
|
||||||
then run_error(concat("stack underflow: ", name))
|
then run_error(concat("stack underflow: ", name))
|
||||||
|
|
||||||
function vm_update () =
|
function vm_update (insn: vm_insn) =
|
||||||
if not(continue)
|
if not(continue)
|
||||||
then ()
|
then ()
|
||||||
else if tape[ip] = nil
|
else if insn = nil
|
||||||
then run_error("Missing instruction in tape")
|
then run_error("Missing instruction in tape")
|
||||||
else if not (0 <= ip & ip < tape_info.filled)
|
else if not (0 <= ip & ip < tape_info.filled)
|
||||||
then run_error("Instruction pointer out of bounds")
|
then run_error("Instruction pointer out of bounds")
|
||||||
|
|
@ -2085,17 +2102,21 @@ let /* Booleans */
|
||||||
; ip := ip + 1 )
|
; ip := ip + 1 )
|
||||||
|
|
||||||
else if tape[ip].opcode = OPCODE_CSKIP
|
else if tape[ip].opcode = OPCODE_CSKIP
|
||||||
then let var arg1 := stack_pop(stack)
|
then let var arg1 := stack_pop(stack)
|
||||||
in ip := ip + if is_truthy(arg1)
|
in ip := ip + if is_truthy(arg1)
|
||||||
then 1
|
then 1
|
||||||
else tape[ip].arg1
|
else tape[ip].arg1
|
||||||
end
|
end
|
||||||
|
|
||||||
else if tape[ip].opcode = OPCODE_GOTO
|
else if tape[ip].opcode = OPCODE_GOTO
|
||||||
then ip := tape[ip].arg1
|
then let
|
||||||
|
in ip := tape[ip].arg1
|
||||||
|
end
|
||||||
|
|
||||||
else if tape[ip].opcode = OPCODE_DGOTO
|
else if tape[ip].opcode = OPCODE_DGOTO
|
||||||
then ip := ip + tape[ip].arg1
|
then let
|
||||||
|
in ip := ip + tape[ip].arg1
|
||||||
|
end
|
||||||
|
|
||||||
else if tape[ip].opcode = OPCODE_DUPL
|
else if tape[ip].opcode = OPCODE_DUPL
|
||||||
then let var arg1 := stack_seek_elem(stack, tape[ip].arg1)
|
then let var arg1 := stack_seek_elem(stack, tape[ip].arg1)
|
||||||
|
|
@ -2363,8 +2384,9 @@ let /* Booleans */
|
||||||
/* Instruction position */
|
/* Instruction position */
|
||||||
; print(" At instruction ")
|
; print(" At instruction ")
|
||||||
; print(int_to_string(ip))
|
; print(int_to_string(ip))
|
||||||
; print(": ")
|
; if tape[ip] <> nil
|
||||||
; print(insn_to_string(tape[ip]))
|
then ( print(": ")
|
||||||
|
; print(insn_to_string(tape[ip])))
|
||||||
; print("\n")
|
; print("\n")
|
||||||
|
|
||||||
/* Tape information? */
|
/* Tape information? */
|
||||||
|
|
@ -2389,13 +2411,26 @@ let /* Booleans */
|
||||||
end
|
end
|
||||||
|
|
||||||
in while continue & ip < tape_info.filled & not(TRIGGERED_EXIT)
|
in while continue & ip < tape_info.filled & not(TRIGGERED_EXIT)
|
||||||
do ( vm_update()
|
do let var old_ip := ip
|
||||||
; if DEBUG_PRINT_STACK
|
var insn := tape[ip]
|
||||||
then ( print("[")
|
in vm_update(insn)
|
||||||
; print(int_to_string(ip))
|
; if DEBUG_PRINT_STACK
|
||||||
; print("]: ")
|
then ( print("[")
|
||||||
; print(stack_to_string(stack))
|
; print(int_to_string(old_ip))
|
||||||
; print("\n") ))
|
; print("]: ")
|
||||||
|
; print(stack_to_string(stack))
|
||||||
|
; print("\n") )
|
||||||
|
; if DEBUG_PRINT_JUMPS
|
||||||
|
& (old_ip + 1 <> ip)
|
||||||
|
then ( print("Jump from ")
|
||||||
|
; print(insn_to_string(insn))
|
||||||
|
; print(" at ")
|
||||||
|
; print(int_to_string(old_ip))
|
||||||
|
; print(" to ")
|
||||||
|
; print(int_to_string(ip))
|
||||||
|
; print("\n")
|
||||||
|
)
|
||||||
|
end
|
||||||
|
|
||||||
; if DEBUG_PRINT_STACK
|
; if DEBUG_PRINT_STACK
|
||||||
then print("Exit VM instance\n")
|
then print("Exit VM instance\n")
|
||||||
|
|
@ -2403,7 +2438,7 @@ let /* Booleans */
|
||||||
|
|
||||||
/* Ready for running toplevel */
|
/* Ready for running toplevel */
|
||||||
|
|
||||||
var tape := tape_new(1000)
|
var tape := tape_new(0)
|
||||||
var ignore := ( tape_append(tape, STD_LIB)
|
var ignore := ( tape_append(tape, STD_LIB)
|
||||||
; "Ignore!" )
|
; "Ignore!" )
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue
Block a user