From e1f72a08ba0b3064cfab01b934b58cc6de0b66cb Mon Sep 17 00:00:00 2001 From: Jon Michael Aanes Date: Sun, 30 Dec 2018 20:52:02 +0100 Subject: [PATCH] Fixed bug in `tape_resize`. --- tigerscheme.tig | 95 +++++++++++++++++++++++++++++++++---------------- 1 file changed, 65 insertions(+), 30 deletions(-) diff --git a/tigerscheme.tig b/tigerscheme.tig index de7c3d4..d740b88 100644 --- a/tigerscheme.tig +++ b/tigerscheme.tig @@ -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!" )