Working on module loading in mem manager.

Platform/Apple/tools/PackPartitions/src/org/demo/PackPartitions.groovy

@@ -632,7 +632,7 @@ class PackPartitions
             assert fixup[sp++] == 2 // code table fixup
             def addr = fixup[sp++] & 0xFF
             addr |= (fixup[sp++] & 0xFF) << 8
-            invDefs[addr] = it*5 + 2  // account for initial placeholder
+            invDefs[addr] = it*5
             addr -= 0x1000
             addr -= byteCodeStart
             assert addr >= 0 && addr < byteCode.size
@@ -644,8 +644,6 @@ class PackPartitions
         def dp = 0
         def stubsSize = defCount * 5
         def newAsmCode = new byte[stubsSize + asmCode.size + 2]
-        newAsmCode[dp++] = 0  // placeholders for aux addr...
-        newAsmCode[dp++] = 0  // ...that fixups were applied to
         (0..<defCount).each {
             newAsmCode[dp++] = 0x20 // JSR
             newAsmCode[dp++] = 0xDC // Aux mem interp ($3DC)
@@ -692,7 +690,7 @@ class PackPartitions
                 target += stubsSize   // account for the stubs we prepended to the asm code
                 println String.format("...adjusted to target offset 0x%04x", target)
             }
-            assert target >= 7 && target < newAsmCode.length
+            assert target >= 5 && target < newAsmCode.length
             
             // Put the adjusted target back in the code
             codeBuf[addr] = (byte)(target & 0xFF)

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

@@ -83,6 +83,7 @@ segNum:		!byte 0
 nextLdVec:	jmp diskLoader
 curPartition:	!byte 0
 partFileRef: 	!byte 0
+fixupHint:	!word 0
 
 ;------------------------------------------------------------------------------
 !source "../include/debug.i"
@@ -118,9 +119,11 @@ releaseSegment: !zone
 
 ;------------------------------------------------------------------------------
 scanForAddr: !zone
-; Input:  pTmp - address to scan for
+; Input:  X(lo)/Y(hi) - address to scan for
 ; Output: X-reg - segment found (zero if not found), N and Z set for X-reg
 ;         carry clear if addr == seg start, set if addr != seg start
+	stx pTmp	; save target addr
+	sty pTmp+1
 	ldx isAuxCmd	; grab correct starting segment (0=main mem, 1=aux)
 .loop:	ldy tSegLink,x	; grab link to next segment, which we'll need regardless
 	lda pTmp	; compare pTmp
@@ -582,7 +585,11 @@ reset: !zone
 .next:	lda tSegLink,x		; get link to next seg
 	tax			; to X reg, and test if end of chain (x=0)
 	bne .inactivate		; no, not end of chain, so loop again
-	rts			; yes, end of chain: done
+	lda #0			; default to putting fixups at $8000, to avoid fragmentation
+	sta fixupHint
+	lda #$80		
+	sta fixupHint+1
+	rts
 
 ;------------------------------------------------------------------------------
 outOfMemErr: !zone
@@ -608,9 +615,10 @@ shared_request:
 	sta isAuxCmd		; save whether we're working on main or aux mem
 	stx reqLen		; save requested length
 	sty reqLen+1		; all 16 bits
-shared_alloc:	lda #1
+shared_alloc:
+	lda #1
 	sta .reclaimFlg		; we will try to reclaim once
-.try:	lda targetAddr+1	; see if SET_MEM_TARGET was called
+.try:	ldy targetAddr+1	; see if SET_MEM_TARGET was called
 	bne .gotTarget		; no, we need to choose location
 ; no target address has been specified, we need to choose one
 .chooseAddr:
@@ -625,9 +633,7 @@ shared_alloc:	lda #1
 	jmp invalAddr
 ; target addr was specified. See if we can fulfill the request.
 .gotTarget:
-	sta pTmp+1		; save target addr
-	lda targetAddr		; all 16 bits
-	sta pTmp
+	ldx targetAddr		; all 16 bits
 	jsr scanForAddr		; locate block containing target addr
 	beq .notFound		; fail if we couldn't find it
 	lda tSegType,x		; check flags
@@ -692,17 +698,46 @@ shared_alloc:	lda #1
 .reclaimFlg: !byte 0
 
 ;------------------------------------------------------------------------------
+; Free everything that's inactive
 reclaim: !zone
-	ldx #<+
-	ldy #>+
-	jmp fatalError
-+	!text "Reclaim not impl yet", 0
+	ldx isAuxCmd	; grab correct starting segment (0=main mem, 1=aux)
+.loop:	ldy tSegLink,x	; grab link to next segment, which we'll need regardless
+	lda tSegType,x	; check flag and type of this seg
+	bmi .next
+	lda #0
+	sta tSegType,x
+.next:	tya		; next in chain
+	tax		; to X reg index
+	bne .loop	; non-zero = not end of chain - loop again
+	; fall through to coalesce...
+; Join adjacent free blocks of memory, where "free" is defined as having 
+; resource type zero and no flags. Note that it will not join inactive blocks
+; that still have a resource type.
+coalesce: !zone
+	ldx isAuxCmd	; grab correct starting segment (0=main mem, 1=aux)
+.loop:	ldy tSegLink,x	; grab link to next segment, which we'll need regardless
+	beq .done	; no next segment, nothing to join to ==> done
+	lda tSegType,x	; check flag and type of this seg
+	ora tSegType,y	; and next seg
+	bmi .next	; if either is active or has a type, can't combine
+	; we can combine the next segment into this one.
+	stx tmp
+	tya
+	tax
+	jsr releaseSegment
+	lda tSegLink,x	; link to what the combined segment was linked to
+	ldx tmp
+	sta tSegLink,x
+	jmp .loop	; we may be able to combine even more
+.next:	tya		; next in chain
+	tax		; to X reg index
+	bne .loop	; non-zero = not end of chain - loop again
+.done	rts		; all done
+
 
 ;------------------------------------------------------------------------------
 shared_scan: !zone
 	sta isAuxCmd	; save whether main or aux mem
-	stx pTmp	; save addr lo...
-	sty pTmp+1	; ... and hi
 	jsr scanForAddr	; scan for block that matches
 	beq invalAddr	; if not found, invalid
 	bcs invalAddr	; if addr not exactly equal, invalid
@@ -799,7 +834,9 @@ shared_queueLoad:
 	sta isAuxCmd 		; save whether main or aux
 	stx resType		; save resource type
 	sty resNum		; save resource number
-	jsr scanForResource	; scan to see if we already have this resource in mem
+	cpx #RES_TYPE_MODULE	; loading a module?
+	beq .module		; extra work for modules
+.notMod	jsr scanForResource	; scan to see if we already have this resource in mem
 	beq .notFound		; nope, pass to next loader
 	stx segNum		; save seg num for later
 	lda tSegType,x		; get flags
@@ -830,6 +867,54 @@ shared_queueLoad:
 	ldy resNum		; and number
 	lda #QUEUE_LOAD		; set to re-try same operation
 	jmp nextLdVec		; pass to next loader
+; extra work for modules
+.module	lda #RES_TYPE_BYTECODE
+	sta resType
+	lda #1
+	sta isAuxCmd
+	jsr scanForResource	; do we have the aux mem part?
+	beq .reload
+	lda #RES_TYPE_MODULE
+	sta resType
+	lda #0
+	sta isAuxCmd
+	jsr scanForResource	; do we have the main mem part?
+	beq .reload	
+	rts			; we have both parts already -- no need for fixups
+.reload	lda #RES_TYPE_MODULE
+	sta resType
+	lda #0
+	sta isAuxCmd
+	jsr .notMod		; queue the main memory part of the module
+	stx .modRet+1		; save address of main load for eventual return
+	sty .modRet+3		; yes, self-modifying
+	ldx #RES_TYPE_BYTECODE
+	ldy resNum
+	jsr aux_queueLoad	; load the aux mem part (the bytecode)
+	; try to pick a location for the fixups that we can free without fragmenting everything.
+	ldx fixupHint
+	ldy fixupHint+1
+	jsr scanForAddr		; locate block containing target addr
+	beq .frag
+	lda tSegType,x		; check flags
+	bmi .frag		; if already active, can't re-allocate it
+	lda fixupHint		; Okay, found a good place to put it
+	sta targetAddr
+	lda fixupHint+1
+	sta targetAddr+1
+.frag	ldx #RES_TYPE_FIXUP	; queue loading of the fixup resource
+	ldy resNum
+	jsr aux_queueLoad
+	lda fixupHint		; advance hint for next fixup by the size of this fixup
+	clc
+	adc reqLen
+	sta fixupHint
+	lda fixupHint+1
+	adc reqLen+1
+	sta fixupHint+1
+.modRet ldx #11			; all done; return address of the main memory block.
+	ldy #22
+	rts
 
 ;------------------------------------------------------------------------------
 diskLoader: !zone

Platform/Apple/virtual/src/include/mem.i

@@ -83,13 +83,16 @@ auxLoader	= $806
 ;------------------------------------------------------------------------------
 ; Resource types
 
-RES_TYPE_CODE	= 1
-RES_TYPE_2D_MAP	= 2
-RES_TYPE_3D_MAP	= 3
-RES_TYPE_TILE	= 4
-RES_TYPE_TEXTURE= 5
-RES_TYPE_SCREEN	= 6
-RES_TYPE_FONT	= 7
+RES_TYPE_CODE	  = 1
+RES_TYPE_2D_MAP	  = 2
+RES_TYPE_3D_MAP	  = 3
+RES_TYPE_TILE	  = 4
+RES_TYPE_TEXTURE  = 5
+RES_TYPE_SCREEN	  = 6
+RES_TYPE_FONT	  = 7
+RES_TYPE_MODULE   = 8
+RES_TYPE_BYTECODE = 9
+RES_TYPE_FIXUP    = 10
 
 ;------------------------------------------------------------------------------
 ; Command codes