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