'===========================================================================
' Subject: LINKED LIST                        Date: 05-01-96 (19:14)       
'  Author: Damond Walker                      Code: PB                     
'  Origin: dwalker@miworld1.miworld.net     Packet: PB.ABC
'===========================================================================
rem *****************************************************
rem *** linklist.bas                                  ***
rem *** An example of Linked Lists in PowerBasic v3.x ***
rem *** By Damond Walker (c2mxwalk@fre.fsu.umd.edu)   ***
rem *****************************************************
rem *** Copyright (C) 1995 by Damond Walker.          ***
rem *** All rights reserved.                          ***
rem ***                                               ***
rem *** You may use the code below in any fashion for ***
rem *** any purpose.  Would be nice if you mentioned  ***
rem *** this source in your documentation, but other  ***
rem *** than that, don't worry about it!              ***
rem *****************************************************
rem *** Warnings:                                     ***
rem ***   1) There is no error checking after memory  ***
rem ***      allocation.  To make this code more      ***
rem ***      robust, you would have to check the      ***
rem ***      carry flag after the memory allocation.  ***
rem ***   2) This program can only be compiled under  ***
rem ***      PowerBasic v3.x.  Some serious mods will ***
rem ***      have to be done in order to get this     ***
rem ***      code to work under PDS or QB (any ver).  ***
rem *****************************************************

$include "regnames.inc"

$dim all
$compile exe

rem ***************************************************************
rem *** our basic linked list element type (singly linked list) ***
rem ***************************************************************
type ListElement
   Data1 as long             ' *** our data...can be as large as you want
   NextPtr as word           ' *** segment ptr to NEXT element
end type

dim TestArray(1 to 200) as shared word   ' *** used to verify linked list
dim TheList as shared word               ' *** current position in list
dim ListHead as shared word              ' *** head of list
dim dummy as long                        ' *** temp. variable


rem ***************************
rem *** Program starts here ***
rem ***************************

dummy = setmem(-10000)       ' *** lets release memory for system heap
ListHead = TheList = 0       ' *** List to NULL
call FillTestArray(TestArray(), 200)   ' *** test data for comparison...
call GenerateList            ' *** generate sample data for our list
call PrintList               ' *** print out the data
call FreeList                ' *** release resources
call Byebye
end

rem *******************************************************
rem *** memory allocation/deallocation functions follow ***
rem *******************************************************

rem *******************************************************************
rem *** Function ComputeParagraphs??                                ***
rem *** --- As we are using INT 0x21/Func 0x48, we have to specify  ***
rem ***     the number of paragraphs we want from dos.  A paragraph ***
rem ***     is 16 bytes.                                            ***
rem *******************************************************************
function ComputeParagraphs??(MemorySize as word)
   dim ReturnValue as word

   ReturnValue = MemorySize / 16
   if (MemorySize mod 16) > 0 then ReturnValue = ReturnValue + 1
   ComputeParagraphs?? = ReturnValue
end function

rem *******************************************************************
rem *** function AllocateMemory??                                   ***
rem *** --- This function uses DOS to allocate a section of memory. ***
rem ***     This function returns the pointer to where the memory   ***
rem ***     resides.                                                ***
rem *******************************************************************
function AllocateMemory??(MemorySize as word)
   reg %AX, &h4800
   reg %BX, ComputeParagraphs??(MemorySize)
   call interrupt &h21
   AllocateMemory?? = reg(%AX)
end function

rem *******************************************************************
rem *** sub ReleaseMemory                                           ***
rem *** --- Complement to AllocateMemory??.  Given a segment value, ***
rem ***     this routine will call dos and release the memory back  ***
rem ***     to the system.                                          ***
rem *******************************************************************
sub ReleaseMemory(TheSegment as word)
   reg %AX, &h4900
   reg %ES, TheSegment
   call interrupt &h21
end sub


rem **********************************************
rem *** code which implements the demo follows ***
rem **********************************************


rem ********************************************************
rem *** sub GenerateList                                 ***
rem *** --- This routine creates the initial linked list ***
rem ********************************************************
sub GenerateList
   dim le as ListElement
   dim iter as integer
   dim MemSegment as word

   print "MSG: Copying test data to linked list..."
   for iter = 1 to 200
      if TheList = 0 then                        '*** first element in list
	 MemSegment = AllocateMemory??(len(le))  '*** allocate memory
	 le.Data1 = TestArray(iter)              '*** store data in temp.
						 '*** element
	 le.NextPtr = 0                          '*** nothing following.

	 '*** copy data element to proper place in memory
	 call CopyMem(MemSegment, 0, varseg(le), varptr(le), len(le))

	 TheList = MemSegment    '*** update list...
	 ListHead = MemSegment   '*** ...pointers
      else                                       '*** otherwise, add to end
	 '*** load current pointer, set next pointer...
	 call CopyMem(varseg(le), varptr(le), TheList, 0, len(le))
	 le.NextPtr = AllocateMemory??(len(le))   '*** allocate memory
	 '*** save current element back...
	 call CopyMem(TheList, 0, varseg(le), varptr(le), len(le))

	 '*** set new data element
	 TheList = le.NextPtr
	 le.Data1 = TestArray(iter)
	 le.NextPtr = 0

	 '*** and commit to memory
	 call CopyMem(TheList, 0, varseg(le), varptr(le), len(le))
      end if
   next iter
end sub

rem ***************************************
rem *** sub PrintList                   ***
rem *** --- Just prints the linked list ***
rem ***************************************
sub PrintList
   dim index as integer
   dim le as ListElement

   TheList = ListHead

   le.NextPtr = 0
   le.Data1 = 0
   index = 1

Topper:
      call CopyMem(varseg(le), varptr(le), TheList, 0, len(le))
      print using "Element ### ===> #,### <=> #,### ";index,_
	      TestArray(index),le.Data1;
      if TestArray(index) = le.Data1 then
	 print "Match"
      else
	 print "No Match"
      end if
      if index mod 20 = 0 then
	 print "Press enter to continue."
	 while inkey$ = "":wend
	 cls
      end if
      TheList = le.NextPtr
      index = index + 1
      if TheList <> 0 then Topper:
end sub

sub FreeList
   print "MSG: Release resources..."
end sub

rem ***************************************************************
rem *** nice little bye-bye routine... Isn't it just a beauty?! ***
rem ***************************************************************
sub ByeBye
   print
   print "All done!  See, Basic CAN do anything!!!"
   print
   print "So there!"
   print
end sub

rem ********************************************
rem *** fill test array with our sample data ***
rem ********************************************
sub FillTestArray(a() as word, l as word)
   dim iter as word

   print "MSG: Filling array of test data..."
   randomize timer
   for iter = 1 to l
      a(iter) = int(rnd(1) * 1000) + 1
   next iter
end sub

rem *************************************************************
rem *** sub CopyMem(...)                                      ***
rem *** --- The unlimited 64K copy routine.  Copies data from ***
rem ***     SSEG:SOFF to DSEG:DOFF.                           ***
rem *************************************************************
sub CopyMem(dseg as word, doff as word, _
	    sseg as word, soff as word, _
	    amount as word)
   dim t as byte
   dim iter as word

   for iter = 0 to amount - 1
      def seg = sseg
      t = peek(soff+iter)
      def seg = dseg
      poke doff+iter, t
   next iter
   def seg
end sub