Fixed bug in tape_resize.

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
 
@@ -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(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
      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 "
+         then "NIL"
-                             , int_to_string(insn.opcode)
-                             , " in insn_to_string!\n"
-                             , "", ""))
-              ; "???" )
      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(": ")
+           ; if tape[ip] <> nil
-           ; print(insn_to_string(tape[ip]))
+             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!" )