1
0

Fixed bug in tape_resize.

This commit is contained in:
Jon Michael Aanes 2018-12-30 20:52:02 +01:00
parent 0303bcbeaa
commit e1f72a08ba

View File

@ -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
@ -891,9 +892,19 @@ let /* Booleans */
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.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")
@ -2092,10 +2109,14 @@ let /* Booleans */
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()
do let var old_ip := ip
var insn := tape[ip]
in vm_update(insn)
; if DEBUG_PRINT_STACK
then ( print("[")
; print(int_to_string(ip))
; print(int_to_string(old_ip))
; print("]: ")
; print(stack_to_string(stack))
; print("\n") ))
; 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!" )