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