First time free-and-collect works right.

Platform/Apple/virtual/src/core/mem.s

@@ -19,7 +19,7 @@ MAX_SEGS	= 96
 
 DO_COMP_CHECKSUMS = 0		; during compression debugging
 DEBUG_DECOMP 	= 0
-DEBUG		= 0
+DEBUG		= 1
 SANITY_CHECK	= 0		; also prints out request data
 
 ; Zero page temporary variables
@@ -943,8 +943,15 @@ gcHash_chk: !zone
 	rts
 .corrup	jmp heapCorrupt
 
+!if DEBUG = 0 {
+debugOnly:
+	jsr inlineFatal : !text "DebugOnly",0	
+}
+
 ; Verify integrity of memory manager structures
 memCheck: !zone
+!if DEBUG = 0 { jmp debugOnly }
+!if DEBUG {
 	jsr heapCheck	; heap check (if there is one)
 	ldx #0		; check main bank
 	jsr .chk
@@ -1017,13 +1024,16 @@ heapCheck: !zone
 	tay
 	iny		; not much we can do to validate lo byte, so skip it
 	cpy tmp		; ensure offset is within type length
-	bcs heapCorrupt	;	beyond end is not ok
+	beq +		; 	very end is ok
+	bcs heapCorrupt	;		beyond end is not ok
 +	lda (pTmp),y	; get hi byte of ptr
 	beq .tscan	; null is ok
 	cmp heapStartPg	; else check if < start of heap
 	bcc heapCorrupt
 	cmp heapEndPg	; or >= than end of heap
 	bcc .tscan
+}
+
 heapCorrupt:
 	ldx pTmp
 	lda pTmp+1
@@ -1117,12 +1127,6 @@ gc2_sweep: !zone
 	jsr gcHash_chk		; is this block in hash?
 	; note: next 20 lines or so *must* preserve the carry flag
 	bcc +			; if not in hash, don't set any dest addr
-	
-	+prWord pSrc
-	+prStr : !text "->",0
-	+prWord pDst
-	+crout
-
 	lda pDst
 	sta gcHash_dstLo,y	; record new address
 	eor pSrc
@@ -1143,6 +1147,12 @@ gc2_sweep: !zone
 	tax			; and in index for byte-copy count
 	lda tmp			; check for pSrc == pDst
 	beq .advDst		; if equal, no need to copy
+	
+	+prWord pSrc
+	+prStr : !text "->",0
+	+prWord pDst
+	+crout
+
 	inx			; set up to copy type/len byte as well
 .cplup	lda (pSrc),y
 	sta (pDst),y

Platform/Apple/virtual/src/plasma/gameloop.pla

@@ -808,7 +808,10 @@ end
 // Get a keystroke and convert it to upper case
 def getUpperKey()
   byte key
+  word oldSeed
+  oldSeed = *seed  // for now, make the seed stay consistent, for randomized heap testing
   key = rdkey()
+  *seed = oldSeed
   if key >= $60
     key = key - $20
   fin
@@ -1500,23 +1503,27 @@ end
 ///////////////////////////////////////////////////////////////////////////////////////////////////
 def freeObj(ptr)
   byte typeNum
-  printf2("  freeObj ptr=$%x", ptr)
   if ptr == NULL; return; fin
   typeNum = ^ptr
   typeCounts[typeNum] = typeCounts[typeNum] - 1
-  when type
+  printf3("  freeObj p=$%x t=$%x newCt=%d\n", ptr, typeNum, typeCounts[typeNum])
-    is TYPE_GLOBAL
+  if typeNum >= $80
-      fatal("can't free global obj")
+    when typeNum
-    is TYPE_PLAYER
+      is TYPE_GLOBAL
-      freeObj(ptr=>nextObj)
+        fatal("can't free global obj")
-      freeObj(ptr=>name)
+      is TYPE_PLAYER
-      freeObj(ptr=>items)
+        freeObj(ptr=>nextObj)
-      break
+        freeObj(ptr=>name)
-    is TYPE_ITEM
+        freeObj(ptr=>items)
-      freeObj(ptr=>nextObj)
+        break
-      freeObj(ptr=>name)
+      is TYPE_ITEM
-      break
+        freeObj(ptr=>nextObj)
-  wend
+        freeObj(ptr=>name)
+        break
+      otherwise
+        fatal("unknown obj type encountered in heap")
+    wend
+  fin
 end
 
 ///////////////////////////////////////////////////////////////////////////////////////////////////
@@ -1551,6 +1558,7 @@ def findTestString(len)
   while *p
     t = ^p
     if t == len
+      printf2("    re-use len %d str @ %x\n", len, p)
       return p
     elsif t < $80
       p = p + t + 1
@@ -1607,7 +1615,13 @@ def checkHeapCounts()
 
   // Then verify the counts
   bad = 0
-  for t = 0 to 255
+  for t = 0 to 127
+    if (typeCounts[t] > 0) and (checkCounts[t] <> 1)
+      printf3("Count for type $%x should be 1, got %d\n", t, checkCounts[t])
+      bad = bad+1
+    fin
+  next
+  for t = 128 to 255
     if typeCounts[t] <> checkCounts[t]
       printf3("Count for type $%x should be %d, got %d\n", t, typeCounts[t], checkCounts[t])
       bad = bad+1
@@ -1662,56 +1676,77 @@ def addPlayer()
   return p
 end
 
+def countList(p)
+  word n
+  n = 0
+  while p
+    n = n+1
+    p = p=>nextObj
+  loop
+  return n
+end
+
 def unlinkPlayer(toRemove)
   word p
   word prev
+  word n, n2
+    
+  // Count number of players before
+  n = countList(global=>players)
+
+  // Now unlink
   prev = NULL
   p = global=>players
   if p == toRemove
     global=>players = p=>nextObj
-    p=>nextObj = NULL
+  else
-    return
+    while p
+      if p == toRemove
+        prev=>nextObj = p=>nextObj
+        break
+      fin
+      prev = p
+      p = p=>nextObj
+    loop
+  fin
+
+  if !p
+    fatal("Obj to unlink not in list")
+  fin
+
+  p=>nextObj = NULL
+
+  // Check count after
+  n2 = countList(global=>players)
+  if n-1 <> n2
+    printf2("Info: n before=%d after=%d\n", n, n2)
+    fatal("Unlink didn't work")
   fin
-  while p
-    if p == toRemove
-      prev=>nextObj = p=>nextObj
-      p=>nextObj = NULL
-      return
-    fin
-    p = p=>nextObj
-  loop
-  fatal("Obj to unlink not in list")
 end
 
 def collect()
   word nFree
-  puts("*** NEED TO DO MEM CHECK SOON\n")
+  mmgr(CHECK_MEM, 0)
-  // memMgr(MEM_CHECK, 0)
   puts("Collecting garbage.\n")
   nFree = mmgr(HEAP_COLLECT, 0)
   printf1("  heap avail=$%x\n", nFree)
   getUpperKey()
   puts("Checking heap counts.\n")
   checkHeapCounts()
-  puts("*** NEED TO DO MEM CHECK SOON\n")
+  mmgr(CHECK_MEM, 0)
-  // memMgr(MEM_CHECK, 0)
 end
 
 ///////////////////////////////////////////////////////////////////////////////////////////////////
 // Test out the heap
 def testHeap()
   word p
+  *seed = 0
   collect()
   addPlayer()
   collect()
   addPlayer()
   collect()
   p = global=>players
-  while p
-    printf1("A player: $%x\n", p)
-    p = p=>nextObj
-  loop
-  p = global=>players
   p = p=>nextObj
   printf1("Unlinking player $%x\n", p)
   unlinkPlayer(p)