From 159f956bf7c1efd9a30e6f0c774ad08a03eb2486 Mon Sep 17 00:00:00 2001
From: Martin Haye <m1@snyder-haye.com>
Date: Fri, 28 Aug 2015 14:04:08 -0700
Subject: [PATCH] More heap testing.

---
 Platform/Apple/virtual/src/core/mem.s         |  12 +-
 .../Apple/virtual/src/plasma/gameloop.pla     | 103 +++++++++++++++++-
 2 files changed, 109 insertions(+), 6 deletions(-)

diff --git a/Platform/Apple/virtual/src/core/mem.s b/Platform/Apple/virtual/src/core/mem.s
index bba80e59..6028d3f0 100644
--- a/Platform/Apple/virtual/src/core/mem.s
+++ b/Platform/Apple/virtual/src/core/mem.s
@@ -688,6 +688,7 @@ heapSet: !zone
 	lda #0
 	sta heapTop
 	sta nHeapBlks
+	sta nTypes
 	; fall through to:
 ; Zero memory heapTop.heapEnd
 heapClr: !zone
@@ -717,10 +718,10 @@ heapAddType: !zone
 	bmi +
 	+prChr 'T'
 	brk
-+	sta typeTblL,y	; addr hi
++	sta typeTblH,y	; addr hi
 	sta .ld+2
 	txa		; addr lo
-	sta typeTblH,y
+	sta typeTblL,y
 .ld	lda $1000,x	; self-modified above: fetch length byte
 	sta typeLen,y	; save that too
 	inc nTypes	; bump type count
@@ -737,11 +738,15 @@ heapAlloc: !zone
 	txa
 	ldy #0
 	sta (pTmp),y	; save obj type or len on heap
+	tay		; test hi bit
 	bpl .gotlen
 	and #$7F
 	tay
 	lda typeLen,y
 .gotlen	ldy pTmp+1
+	+prStr : !text "heapAllocLen=", 0
+	+prA
+	+crout
 	sec		; add 1 for type byte
 	adc pTmp
 	bcc +
@@ -750,6 +755,9 @@ heapAlloc: !zone
 	bcs .needgc
 +	sta heapTop
 	sty heapTop+1
+	+prStr : !text "heapAllocRet=", 0
+	+prWord pTmp
+	+crout
 	ldx pTmp	; return ptr in X=lo/Y=hi
 	ldy pTmp+1
 	rts
diff --git a/Platform/Apple/virtual/src/plasma/gameloop.pla b/Platform/Apple/virtual/src/plasma/gameloop.pla
index 10a43ce5..5ad9d281 100644
--- a/Platform/Apple/virtual/src/plasma/gameloop.pla
+++ b/Platform/Apple/virtual/src/plasma/gameloop.pla
@@ -109,7 +109,10 @@ byte typeTbl_Global[] = Global, players, 0
 byte typeTbl_Player[] = Player, nextObj, items, 0
 byte typeTbl_Item[]   = Item, nextObj, 0
 
+byte typeLengths[10]
 byte typeCounts[256]
+byte checkCounts[256]
+word nextObjID = 0
 
 ///////////////////////////////////////////////////////////////////////////////////////////////////
 // Predefined functions, for circular calls or out-of-order calls
@@ -1473,8 +1476,14 @@ end
 
 ///////////////////////////////////////////////////////////////////////////////////////////////////
 def newObj(typeNum)
+  word ptr
   typeCounts[typeNum] = typeCounts[typeNum] + 1
-  return mmgr(HEAP_ALLOC, type)
+  ptr = mmgr(HEAP_ALLOC, typeNum)
+  if typeNum >= $80
+    nextObjID = nextObjID + 1
+    ptr=>id = nextObjID
+  fin
+  return ptr
 end
 
 ///////////////////////////////////////////////////////////////////////////////////////////////////
@@ -1507,16 +1516,102 @@ def initHeap()
   mmgr(REQUEST_MEMORY, heapSize)
   mmgr(LOCK_MEMORY,    heapStart)
   mmgr(HEAP_SET,       heapStart)
-  mmgr(HEAP_ADD_TYPE,  typeTbl_Global)
-  mmgr(HEAP_ADD_TYPE,  typeTbl_Player)
-  mmgr(HEAP_ADD_TYPE,  typeTbl_Item)
+  mmgr(HEAP_ADD_TYPE,  @typeTbl_Global)
+  typeLengths[TYPE_GLOBAL & $7F] = Global
+  mmgr(HEAP_ADD_TYPE,  @typeTbl_Player)
+  typeLengths[TYPE_PLAYER & $7F] = Global
+  mmgr(HEAP_ADD_TYPE,  @typeTbl_Item)
+  typeLengths[TYPE_ITEM & $7F] = Global
   newObj(TYPE_GLOBAL)
 end
 
+///////////////////////////////////////////////////////////////////////////////////////////////////
+def randomLetter()
+  return (rand16() % 26) + 'A'
+end
+
+///////////////////////////////////////////////////////////////////////////////////////////////////
+// Locate the heap string with the specified length. If none exists, create a new random string.
+def findTestString(len)
+  word p, t, p2
+  p = heapStart
+  while *p
+    t = ^p
+    if t == len
+      return p
+    elsif t < $80
+      p = p + t
+    elsif t < TYPE_GLOBAL or t > TYPE_ITEM
+      fatal("Unknown type in heap")
+    else
+      p = p + typeLengths[t & $7F]
+    fin
+  loop
+  p = newObj(len)
+  printf1("New string at %x\n", p)
+  p2 = p
+  for t = 1 to len
+    p2 = p2+1
+    printf1("Setting %x to 'X'\n", p2)
+    ^$c083
+    ^$c083
+    p2->0 = 'X'
+  next
+  return p
+end
+
+///////////////////////////////////////////////////////////////////////////////////////////////////
+// Check the object counts on the heap
+def checkHeapCounts()
+  word p, t
+  byte bad
+
+  // Clear the check array
+  for t = 0 to 255; checkCounts[t] = 0; next
+  
+  // Now traverse the heap, counting the number of each object type
+  p = heapStart
+  while *p
+    t = ^p
+    checkCounts[t] = checkCounts[t] + 1
+    if t < $80
+      p = p + t
+    elsif t < TYPE_GLOBAL or t > TYPE_ITEM
+      fatal("Unknown type in heap")
+    else
+      p = p + typeLengths[t & $7F]
+    fin
+  loop
+
+  // Then verify the counts
+  bad = 0
+  for t = 0 to 255
+    if typeCounts[t] <> checkCounts[t]
+      printf3("Count for type %d should be %d, got %d\n", t, checkCounts[t], typeCounts[t])
+      bad = bad+1
+    fin
+  next
+
+  if bad
+    fatal("Heap errors found.")
+  fin
+end
+
+///////////////////////////////////////////////////////////////////////////////////////////////////
+// Test out the heap
+def testHeap()
+  word p
+  checkHeapCounts()
+  p = findTestString(10)
+  printf2("Test string: %x '%s'\n", p, p)
+  getUpperKey()
+end
+
 ///////////////////////////////////////////////////////////////////////////////////////////////////
 // Main code.
 //
 initHeap()
+testHeap()
 loadTitle()
 setCallbacks()
 mapIs3D = OVERMAP_IS_3D