Redim Preserve

by Richard Russell, May 2014

Liberty BASIC does not have the REDIM PRESERVE statement, available in some other BASIC dialects, which is used to change the dimensions of an array without destroying the data it contains. Fortunately in LB Booster it is possible to simulate this statement by means of a user-defined subroutine:

  SUB RedimPreserve BYREF A(), newsize
      !N% = 5+10*(newsize+1)
      !O% = 5+10*(DIM(A(),1)+1)
      !SYS "GlobalAlloc", 64, N% TO A%
      !IF A%=0 ERROR 9, "No room for array"
      !IF N%>O% SWAP N%,O%
      !SYS "RtlMoveMemory", A%, !^A(), N%
      !A%!1 = newsize+1
      !IF !^A()<LOMEM OR !^A()>HIMEM SYS "GlobalFree", !^A()
      !!^A() = A%
  END SUB
 
  SUB RedimPreserve$ BYREF A$(), newsize
      !N% = 5+8*(newsize+1)
      !O% = 5+8*(DIM(A$(),1)+1)
      !SYS "GlobalAlloc", 64, N% TO A%
      !IF A%=0 ERROR 9, "No room for array"
      !IF N%>O% SWAP N%,O%
      !SYS "RtlMoveMemory", A%, !^A$(), N%
      !A%!1 = newsize+1
      !IF !^A$()<LOMEM OR !^A$()>HIMEM SYS "GlobalFree", !^A$()
      !!^A$() = A%
  END SUB

The first routine listed is suitable for use with a 1-dimensional numeric array and the second with a 1-dimensional string array. Note that the routines consist of BBC BASIC code, hence the presence of an exclamation mark (!) at the start of each line to force the LBB translator to pass the code unmodified.

Here is an example program:

      DIM array(100)
      FOR i = 0 TO 100
        array(i) = SQR(i)
      NEXT
      CALL RedimPreserve array(), 200
      FOR i = 101 TO 200
        array(i) = SQR(i)
      NEXT
      FOR i = 0 TO 200
        IF array(i) <> SQR(i) THEN PRINT "Error!" : END
      NEXT
      PRINT "Test completed"
      END
 
  SUB RedimPreserve BYREF A(), newsize
      !N% = 5+10*(newsize+1)
      !O% = 5+10*(DIM(A(),1)+1)
      !SYS "GlobalAlloc", 64, N% TO A%
      !IF A%=0 ERROR 9, "No room for array"
      !IF N%>O% SWAP N%,O%
      !SYS "RtlMoveMemory", A%, !^A(), N%
      !A%!1 = newsize+1
      !IF !^A()<LOMEM OR !^A()>HIMEM SYS "GlobalFree", !^A()
      !!^A() = A%
  END SUB