Merged in GC code.

This commit is contained in:
Martin Haye 2015-08-18 07:11:59 -07:00
commit a6c2b46a92
2 changed files with 571 additions and 305 deletions

View File

@ -42,6 +42,18 @@ DISK_BUF_SIZE = $800
diskBufEnd = $4C00 diskBufEnd = $4C00
headerBuf = $4C00 ; len $1400 headerBuf = $4C00 ; len $1400
; Memory used only during garbage collection
gcHash_first = $5000 ; index is srcLo ^ srcHi; result points into remaining gcHash tables.
gcHash_srcLo = $5100
gcHash_srcHi = $5200
gcHash_link = $5300
gcHash_dstLo = $5400
gcHash_dstHi = $5500
; Heap area
heapStart = $F000 ; must be page aligned
heapEnd = $F800 ; must be page aligned
; Other equates ; Other equates
prodosMemMap = $BF58 prodosMemMap = $BF58
@ -56,10 +68,24 @@ relocate:
sta $900,y sta $900,y
iny iny
bne - bne -
; copy the ProDOS code from main memory to aux ; set up to copy the ProDOS code from main memory to aux
bit setLcRW+lcBank1 ; only copy bank 1, because bank 2 is PLASMA runtime bit setLcRW+lcBank1 ; only copy bank 1, because bank 2 is PLASMA runtime
bit setLcRW+lcBank1 ; write to it bit setLcRW+lcBank1 ; write to it
ldy #0 ; verify that aux mem exists
ldx #1
stx $D000
sta setAuxZP
inx
stx $D000
lda $D000
cmp #2
bne .noaux
sta clrAuxZP
lda $D000
cmp #1
beq .gotaux
.noaux jsr inlineFatal : !text "Aux mem required",0
.gotaux ldy #0
ldx #$D0 ldx #$D0
.pglup stx .ld+2 .pglup stx .ld+2
stx .st+2 stx .st+2
@ -125,13 +151,171 @@ relocate:
inx inx
cpx #>(hiMemEnd+$100) cpx #>(hiMemEnd+$100)
bne .cpmm bne .cpmm
; Ready to actually init the memory manager in its final location. lda .st4+2
; fall through to j_init... cmp #$E0
bcc init
lda #"b"
jsr cout
brk ; mem mgr got too big!
;------------------------------------------------------------------------------
init: !zone
bit setLcRW+lcBank1 ; switch in mem mgr
bit setLcRW+lcBank1
; put something interesting on the screen :)
jsr home
+prStr : !text "Welcome to Mythos.",0
; close all files
lda #0
jsr closeFile
; clear ProDOS mem map so it lets us load stuff anywhere we want
ldx #$18
lda #0
.clr: sta prodosMemMap-1,x
dex
bne .clr
; clear the segment tables
- sta tSegLink,x
sta tSegAdrLo,x
sta tSegAdrHi,x
sta tSegType,x
sta tSegRes,x
inx
cpx #MAX_SEGS
bne -
; clear other pointers
sta targetAddr+1
sta scanStart
sta partFileRef
sta curPartition
lda #<diskLoader
sta nextLdVec+1
lda #>diskLoader
sta nextLdVec+2
lda #1
sta scanStart+1
; make reset go to monitor
lda #<monitor
sta resetVec
lda #>monitor
sta resetVec+1
eor #$A5
sta resetVec+2
; We'll set up 8 initial segments:
; 0: main $0000 -> 4, active + locked
; 1: aux $0000 -> 2, active + locked
; 2: aux $0200 -> 3, inactive
; 3: aux $C000 -> 0, active + locked
; 4: main $0xxx -> 5, inactive (xxx = end of mem mgr tables)
; 5: main $2000 -> 6, active + locked
; 6: main $6000 -> 7, inactive
; 7: main $BF00 -> 8, active + locked
; 8: main $E000 -> 9, inactive
; 9: main $F000 -> 0, active + locked
; First, the flags
lda #$C0 ; flags for active + locked (with no resource)
sta tSegType+0
sta tSegType+1
sta tSegType+3
sta tSegType+5
sta tSegType+7
sta tSegType+9
; Next the links
ldx #2
stx tSegLink+1
inx
stx tSegLink+2
ldx #4
stx tSegLink+0
inx
stx tSegLink+4
inx
stx tSegLink+5
inx
stx tSegLink+6
inx
stx tSegLink+7
inx
stx tSegLink+8
; Then the addresses
lda #2
sta tSegAdrHi+2
ldy #$C0
sty tSegAdrHi+3
dey
sty tSegAdrHi+7
lda #<paramsEnd
sta tSegAdrLo+4
lda #>paramsEnd
sta tSegAdrHi+4
lda #$40
sta tSegAdrHi+5
lda #$60
sta tSegAdrHi+6
lda #$E0
sta tSegAdrHi+8
lda #$F0
sta tSegAdrHi+9
; Finally, form a long list of the remaining unused segments.
ldx #10
stx unusedSeg ; that's the first unused seg
ldy #11
.loop: tya
sta tSegLink,x
inx
iny
cpy #MAX_SEGS ; did all segments yet?
bne .loop ; no, loop again
; Allocate space for the PLASMA frame stack
!if SANITY_CHECK {
lda #$20
sta framePtr+1 ; because sanity check verifies it's not $BE or $BF
}
ldx #0
ldy #2 ; 2 pages
lda #REQUEST_MEMORY
jsr main_dispatch
stx framePtr
stx outerFramePtr
iny ; twice for 2 pages: initial pointer at top of new space
iny
sty framePtr+1
sty outerFramePtr+1
dey
dey
lda #LOCK_MEMORY ; lock it in place forever
jsr main_dispatch
; Reserve hi-res page 1
lda #SET_MEM_TARGET
ldx #0
ldy #$20 ; at $2000
jsr main_dispatch
lda #REQUEST_MEMORY
ldx #0
ldy #$20 ; length $2000
jsr main_dispatch
; Load PLASMA module #1
ldx #0
lda #START_LOAD
jsr main_dispatch
ldx #RES_TYPE_MODULE
ldy #1
lda #QUEUE_LOAD
jsr main_dispatch
stx .gomod+1
sty .gomod+2
lda #LOCK_MEMORY ; lock it in forever
jsr main_dispatch
ldx #1 ; keep open for efficiency's sake
lda #FINISH_LOAD
jsr main_dispatch
ldx #$10 ; initial eval stack index
.gomod: jmp $1111 ; jump to module for further bootstrapping
;------------------------------------------------------------------------------ ;------------------------------------------------------------------------------
; Vectors and debug support code - these go in low memory at $800 ; Vectors and debug support code - these go in low memory at $800
loMemBegin: !pseudopc $800 { loMemBegin: !pseudopc $800 {
jmp j_init
jmp j_main_dispatch jmp j_main_dispatch
jmp j_aux_dispatch jmp j_aux_dispatch
jmp __asmPlasm jmp __asmPlasm
@ -168,6 +352,41 @@ j_aux_dispatch:
bit setLcRW+lcBank2 ; back to PLASMA bit setLcRW+lcBank2 ; back to PLASMA
rts rts
;------------------------------------------------------------------------------
; Print fatal error message then halt.
inlineFatal:
pla
tax
pla
tay
inx
bne fatalError
iny
fatalError: !zone
sty pTmp+1 ; save message ptr hi...
stx pTmp ; ...and lo
jsr setnorm ; set up text mode and vectors
bit setText
jsr setvid
jsr setkbd
lda $24 ; check if we're already at start of screen line
beq + ; no, no need for CR
jsr crout ; carriage return to get to start of screen line
+ ldy #40 ; set up to print 40 dashes
lda #'-'
.dash: jsr cout
dey
bne .dash
+prStr : !text "FATAL ERROR: ",0
.msg2 lda (pTmp),y
beq .msg3
jsr cout
iny
bne .msg2
.msg3: jsr bell ; beep
.inf: jmp .inf ; and loop forever
;------------------------------------------------------------------------------ ;------------------------------------------------------------------------------
; Normal entry point for ProDOS MLI calls. This patches the code at $BFBB. ; Normal entry point for ProDOS MLI calls. This patches the code at $BFBB.
enterProDOS1: !zone enterProDOS1: !zone
@ -243,7 +462,7 @@ __asmPlasm: !zone
adc #0 adc #0
sta .jsr+2 sta .jsr+2
; adjust PLASMA stack pointer to skip over params ; adjust PLASMA stack pointer to skip over params
dey dey ; leave 1 slot for ret value
sty tmp sty tmp
txa txa
cpx #$11 cpx #$11
@ -266,10 +485,7 @@ __asmPlasm: !zone
.badx ; X reg ran outside valid range. Print and abort. .badx ; X reg ran outside valid range. Print and abort.
+prStr : !text $8D,"X=",0 +prStr : !text $8D,"X=",0
+prX +prX
ldx #<+ jsr inlineFatal : !text "PlasmXRng", 0
ldy #>+
jmp fatalError
+ !text $8D, "PLASMA x-reg out of range", 0
;------------------------------------------------------------------------------ ;------------------------------------------------------------------------------
; Debug code to support macros ; Debug code to support macros
@ -425,6 +641,325 @@ closeParams: !byte 1 ; param count
closeFileRef: !byte 0 ; file ref to close closeFileRef: !byte 0 ; file ref to close
paramsEnd = * paramsEnd = *
;------------------------------------------------------------------------------
; Heap management variables
MAX_TYPES = 16
nTypes !byte 0
typeTblL !fill MAX_TYPES
typeTblH !fill MAX_TYPES
typeLen !fill MAX_TYPES ; length does not include type byte
heapTop !word 0
gcHash_top !byte 0
nHeapBlks !byte 0
;------------------------------------------------------------------------------
; Heap management routines
; Set the table for the next type in order. Starts with type 0, then 1, etc.
; By convention, type 0 is used for the Global object, from which all others
; valid objects are reachable (and invalid garbage if not reachable from there).
;
; x=ptr lo, y = ptr hi.
; Tbl: type size 01-7F, then (byte) offsets of ptrs within type, then 0.
setTypeTbl: !zone
tya ; save addr hi
ldy nTypes
cpy #MAX_TYPES
bmi +
+prChr 'T'
brk
+ sta typeTblL,y ; addr hi
sta .ld+2
txa ; addr lo
sta typeTblH,y
.ld lda $1000,x ; self-modified above: fetch length byte
sta typeLen,y ; save that too
inc nTypes ; bump type count
rts
; Clear the heap
heapReset: !zone
lda #<heapStart
sta heapTop
lda #>heapStart
sta heapTop
lda #0
sta nHeapBlks
; fall through to:
; Zero memory heapTop.heapEnd
heapClr: !zone
lda #0
ldx heapTop
ldy heapTop+1
.pg sty .st+2
.st sta $1000,x ; self-modified above
inx
bne .st
iny
cpy #>heapEnd
bne .pg
rts
; Allocate a block on the heap. X = $00.7F for string block, $80.FF for type $00.7F.
; and yes, type $00 is valid (conventionally used for the Global Object).
heapAlloc: !zone
lda heapTop
sta pTmp
lda heapTop+1
sta pTmp+1
txa
ldy #0
sta (pTmp),y ; save obj type on heap
bpl .gotlen
and #$7F
tay
lda typeLen,y
.gotlen ldy pTmp+1
sec ; add 1 for type byte
adc pTmp
bcc +
iny
cpy #>heapEnd
bcs .needgc
+ sta heapTop
sty heapTop+1
rts
.needgc jsr inlineFatal : !text "GcNotImpl",0
; Input : Carry set = add if not found, clear = check only, don't add
; Output: Y-reg = index
; Carry clear = not found (added if requested), set = found
gcHash_chk: !zone
lda pSrc
eor pSrc+1
tax
lda gcHash_first,x
beq .notfnd
- tay
lda gcHash_srcLo,y
eor pSrc
beq .found
lda gcHash_link,y
bne -
.notfnd bcc .ret
inc gcHash_top
beq .corrup ; too many blks, or infinite loop? barf out
ldy gcHash_top
lda pSrc
sta gcHash_srcLo,y
lda pSrc+1
sta gcHash_srcHi,y
lda #0
sta gcHash_dstHi,y
lda gcHash_first,x
sta gcHash_link,y
tya
sta gcHash_first,x
.ret clc
rts
.found sec
rts
.corrup jmp heapCorrupt
; Verify the integrity of the heap
heapCheck: !zone
lda heapTop
sta pTmp
lda heapTop+1
sta pTmp+1
ldy #0
.blklup lda (pTmp),y
bmi .isobj
; it's a string; check its characters
pha ; save length
beq .nxtblk ; handle zero-length string
tax
.stlup lda (pTmp),y
beq heapCorrupt
bmi heapCorrupt
iny
dex
bne .stlup
.nxtblk pla ; get length back
sec
adc pTmp
sta pTmp
bcc .blklup
inc pTmp+1
lda pTmp+1
cmp #>heapEnd
bcc .blklup
bcs heapCorrupt
.isobj and #$7F
tax
cpx #MAX_TYPES
bcs heapCorrupt
lda typeLen,x
pha ; save length for later
lda typeTblL,x
sta .getoff+1
lda typeTblH,x
sta .getoff+2
ldx #0 ; type entry starts at len byte, which we immediately skip
.tscan inx
.getoff lda $1000,x ; self-modified above: get next pointer offset for type
beq .nxtblk ; zero marks end of offset table
tay
iny ; not much we can do to validate lo byte, so skip it
cpy tmp ; ensure offset is within type length
beq + ; the very end is ok because len doesn't include type byte
bcs heapCorrupt ; but beyond end is not ok
+ lda (pTmp),y ; get hi byte of ptr
beq .tscan ; null is ok
cmp #>heapStart ; else check if < start of heap
bcc heapCorrupt
cmp #>heapEnd ; or >= than end of heap
bcc .tscan
heapCorrupt:
ldx pTmp
lda pTmp+1
jsr prntax
jsr inlineFatal : !text "HeapCorrupt",0
; Phase 1 of Garbage Collection: mark accessible heap blocks starting from the root block
gc1_mark: !zone
ldx #0 ; clear the hash table
stx gcHash_top
txa
- sta gcHash_first,x
inx
bne -
lda #<heapStart ; global block is at very start of heap
sta pSrc
lda #>heapEnd
sta pSrc+1
sec ; sec means add if not found
jsr gcHash_chk ; seed the hash, and thus our queue, with the global block
clv ; clear V flag to mark phase 1
bvc .start
; Phase 3 of Garbage Collection: fix all pointers
gc3_fix:
bit .rts ; set V flag to mark phase 3
.start lda #0
sta resNum ; initialize block counter (note: blk #0 in hash is not used)
.outer inc resNum ; advance to next block in hash
ldx resNum
cpx gcHash_top ; finished all blocks?
beq .trav ; last blk? if so still need to trav it
bcs .rts ; or if past last blk, we're done
.trav ldy gcHash_srcLo,x ; get pointer to block, lo byte first
lda gcHash_srcHi,x ; then hi byte
bvc +
ldy gcHash_dstLo,x ; in pointer fix mode, use the block's final location
lda gcHash_dstHi,x
+ sty pTmp ; store object pointer so we can dereference it
sta pTmp+1
ldy #0 ; first byte
lda (pTmp),y ; is the type
bpl .outer ; or, if not hi bit, just a string so skip (no ptrs)
and #$7F ; mask off hi bit to get type number
tax
lda typeTblL,x ; get pointer to type table
sta .ldof+1
lda typeTblH,x
sta .ldof+2
ldx #1 ; skip size byte, access first ptr offset
.ldof lda $1111,x ; self-modified above: get offset entry
beq .outer ; zero marks end of list -> go to next block
tay
lda (pTmp),y ; grab pointer at that offset
sta pSrc
sty .fix+1 ; save pointer offset for use if fixing pointers in phase 3
iny
lda (pTmp),y
sta pSrc+1
stx tmp+1 ; save index into type entry
sec ; sec = we want to add to hash if it's not there
bvc +
clc ; in phase 3, we don't want to add to hash
+ jsr gcHash_chk ; go add it to the hash; ignore return flag
bvc + ; skip pointer fixing in phase 1
bcc .corrup ; in phase 3, pointer must be in hash!
.fix ldy #11 ; restore pointer offset
lda gcHash_dstLo,x ; get new location
sta (pTmp),y ; update the pointer
iny
lda gcHash_dstHi,x ; hi byte too
sta (pTmp),y
+ ldx tmp+1 ; restore type entry index
inx ; next offset entry
bne .ldof ; always taken
.rts rts ; this needs to be an RTS instruction - used to set V flag
.corrup jmp heapCorrupt
; Phase 2 of Garbage Collection: sweep all accessible blocks together
gc2_sweep: !zone
lda #<heapStart
sta pSrc
sta pDst
lda #>heapStart
sta pSrc+1
sta pDst+1
.outer clc ; clc = do not add to hash
jsr gcHash_chk ; is this block in hash?
; note: next 20 lines or so *must* preserve the carry flag
bcc +
lda pDst
sta gcHash_dstLo,x ; record new address
eor pSrc
sta tmp
lda pDst+1
sta gcHash_dstHi,x ; in hash table
eor pSrc+1
ora tmp
sta tmp ; this will be zero iff all 16 bits of pSrc == pDst
+ ldy #0 ; index of type byte in heap block
lda (pSrc),y ; ...still need to preserve carry flag...
bpl .gotlen
and #$7F
tax
lda typeLen,x
.gotlen sta reqLen ; save len for later
bcc .advSrc ; finally act on carry (hash check flg): if block not in hash, skip block
tax ; and in index for copying
lda tmp ; check for pSrc == pDst
beq .advDst ; if equal, no need to copy
+ inx ; set up to copy type byte as well
.cplup lda (pSrc),y
sta (pDst),y
iny
dex
bne .cplup
.advDst lda pDst ; advance dest
sec ; +1 for type byte
adc reqLen
sta pDst
bcc .advSrc
inc pDst+1
.advSrc lda pSrc ; advance source
sec ; +1 for type byte
adc reqLen
sta pSrc
bcc +
inc pSrc+1
+ cmp heapTop ; end of heap yet? (lo byte check)
lda pSrc+1
sbc heapTop+1 ; (hi byte check)
bcc .outer ; if not, loop again
rts
doGC: !zone
lda nHeapBlks
bne + ; edge case: if nothing on heap, skip collection
rts
+ jsr gc1_mark ; mark reachable blocks
jsr gc2_sweep ; sweep them into one place
jsr gc3_fix ; adjust all pointers
jmp heapClr ; and clear newly freed space
} ; end of !pseodupc $800 } ; end of !pseodupc $800
loMemEnd = * loMemEnd = *
@ -453,10 +988,7 @@ grabSegment: !zone
lda tSegLink,y ; no, grab next segment in list lda tSegLink,y ; no, grab next segment in list
sta unusedSeg ; that is now first unused sta unusedSeg ; that is now first unused
rts ; return with Y = the segment grabbed rts ; return with Y = the segment grabbed
.fail: ldx #<+ .fail: jsr inlineFatal : !text "MaxSegs", 0
ldy #>+
jmp fatalError
+ !text "No more segments", 0
;------------------------------------------------------------------------------ ;------------------------------------------------------------------------------
releaseSegment: !zone releaseSegment: !zone
@ -694,246 +1226,6 @@ saneEnd: !zone {
} }
} }
;------------------------------------------------------------------------------
; Print fatal error message (custom or predefined) and print the
; call stack, then halt.
fatalError: !zone
sty pTmp+1 ; save message ptr hi...
stx pTmp ; ...and lo
jsr setnorm ; set up text mode and vectors
bit setText
jsr setvid
jsr setkbd
lda $24 ; check if we're already at start of screen line
beq + ; no, no need for CR
jsr crout ; carriage return to get to start of screen line
+ ldy #40 ; set up to print 40 dashes
lda #'-'
.dash: jsr cout
dey
bne .dash
.msg1: lda .prefix,y ; print out prefix message
beq +
jsr cout
iny
bne .msg1
+ tay ; start at first byte of user message
.msg2 lda (pTmp),y
beq .msg3
jsr cout
iny
bne .msg2
.msg3:
!if DEBUG {
; Print call stack
ldy #0
.msg4 lda .stkMsg,y
beq +
jsr cout
iny
bne .msg4
+ tsx ; start at current stack pointer
.stackLoop:
lda $101,x ; JSR increments PC twice before pushing it
sec
sbc #2
tay
lda $102,x
sbc #0
sta .load+2
and #$F0 ; avoid accidentally grabbing data from the IO area
cmp #$C0
beq .next
.load: lda $1000,y ; is there a JSR there?
cmp #$20
bne .next ; no, it's probably not an actual call
lda .load+2
jsr prbyte
tya
jsr prbyte
lda #' '
jsr cout
.next: inx ; work up to...
cpx #$FF ; ...top of stack
bcc .stackLoop
}
jsr crout
jsr bell ; beep
.inf: jmp .inf ; and loop forever
.prefix:!text "FATAL ERROR: ", 0
.stkMsg:!text $8D,"Call stk: ", 0
;------------------------------------------------------------------------------
init: !zone
; put something interesting on the screen :)
jsr home
+prStr : !text "Welcome to Mythos.",0
; verify that aux mem exists
sta clrAuxWr
lda #1
sta $2000
sta setAuxWr
lda #2
sta $2000
sta clrAuxWr
sta setAuxRd
lda $2000
sta clrAuxRd
cmp #2
beq +
ldx #<.auxMsg
ldy #>.auxMsg
jmp fatalError
.auxMsg !text "Aux mem required",0
+
; close all files
lda #0
jsr closeFile
; clear ProDOS mem map so it lets us load stuff anywhere we want
ldx #$18
lda #0
.clr: sta prodosMemMap-1,x
dex
bne .clr
; clear the segment tables
- sta tSegLink,x
sta tSegAdrLo,x
sta tSegAdrHi,x
sta tSegType,x
sta tSegRes,x
inx
cpx #MAX_SEGS
bne -
; clear other pointers
sta targetAddr+1
sta scanStart
sta partFileRef
sta curPartition
lda #<diskLoader
sta nextLdVec+1
lda #>diskLoader
sta nextLdVec+2
lda #1
sta scanStart+1
; make reset go to monitor
lda #<monitor
sta resetVec
lda #>monitor
sta resetVec+1
eor #$A5
sta resetVec+2
; We'll set up 8 initial segments:
; 0: main $0000 -> 4, active + locked
; 1: aux $0000 -> 2, active + locked
; 2: aux $0200 -> 3, inactive
; 3: aux $C000 -> 0, active + locked
; 4: main $0xxx -> 5, inactive (xxx = end of mem mgr tables)
; 5: main $2000 -> 6, active + locked
; 6: main $6000 -> 7, inactive
; 7: main $BF00 -> 8, active + locked
; 8: main $E000 -> 9, inactive
; 9: main $F800 -> 0, active + locked
; First, the flags
lda #$C0 ; flags for active + locked (with no resource)
sta tSegType+0
sta tSegType+1
sta tSegType+3
sta tSegType+5
sta tSegType+7
sta tSegType+9
; Next the links
ldx #2
stx tSegLink+1
inx
stx tSegLink+2
ldx #4
stx tSegLink+0
inx
stx tSegLink+4
inx
stx tSegLink+5
inx
stx tSegLink+6
inx
stx tSegLink+7
inx
stx tSegLink+8
; Then the addresses
lda #2
sta tSegAdrHi+2
ldy #$C0
sty tSegAdrHi+3
dey
sty tSegAdrHi+7
lda #<paramsEnd
sta tSegAdrLo+4
lda #>paramsEnd
sta tSegAdrHi+4
lda #$40
sta tSegAdrHi+5
lda #$60
sta tSegAdrHi+6
lda #$E0
sta tSegAdrHi+8
lda #$F8
sta tSegAdrHi+9
; Finally, form a long list of the remaining unused segments.
ldx #10
stx unusedSeg ; that's the first unused seg
ldy #11
.loop: tya
sta tSegLink,x
inx
iny
cpy #MAX_SEGS ; did all segments yet?
bne .loop ; no, loop again
; Allocate space for the PLASMA frame stack
!if SANITY_CHECK {
lda #$20
sta framePtr+1 ; because sanity check verifies it's not $BE or $BF
}
ldx #0
ldy #2 ; 2 pages
lda #REQUEST_MEMORY
jsr main_dispatch
stx framePtr
stx outerFramePtr
iny ; twice for 2 pages: initial pointer at top of new space
iny
sty framePtr+1
sty outerFramePtr+1
dey
dey
lda #LOCK_MEMORY ; lock it in place forever
jsr main_dispatch
; Reserve hi-res page 1
lda #SET_MEM_TARGET
ldx #0
ldy #$20 ; at $2000
jsr main_dispatch
lda #REQUEST_MEMORY
ldx #0
ldy #$20 ; length $2000
jsr main_dispatch
; Load PLASMA module #1
ldx #0
lda #START_LOAD
jsr main_dispatch
ldx #RES_TYPE_MODULE
ldy #1
lda #QUEUE_LOAD
jsr main_dispatch
stx .gomod+1
sty .gomod+2
lda #LOCK_MEMORY ; lock it in forever
jsr main_dispatch
ldx #1 ; keep open for efficiency's sake
lda #FINISH_LOAD
jsr main_dispatch
ldx #$10 ; initial eval stack index
.gomod: jmp $1111 ; jump to module for further bootstrapping
;------------------------------------------------------------------------------ ;------------------------------------------------------------------------------
!if DEBUG { !if DEBUG {
printMem: !zone printMem: !zone
@ -1007,17 +1299,11 @@ reset: !zone
;------------------------------------------------------------------------------ ;------------------------------------------------------------------------------
outOfMemErr: !zone outOfMemErr: !zone
!if DEBUG { jsr main_debug } !if DEBUG { jsr main_debug }
ldx #<+ jsr inlineFatal : !text "OutOfMem", 0
ldy #>+
jmp fatalError
+ !text "Out of mem", 0
;------------------------------------------------------------------------------ ;------------------------------------------------------------------------------
reservedErr: !zone reservedErr: !zone
ldx #<+ jsr inlineFatal : !text "DblAlloc", 0
ldy #>+
jmp fatalError
+ !text "Mem already alloc'd", 0
;------------------------------------------------------------------------------ ;------------------------------------------------------------------------------
main_request: !zone main_request: !zone
@ -1194,10 +1480,7 @@ shared_scan: !zone
+ rts + rts
invalAddr: !zone invalAddr: !zone
ldx #<+ jsr inlineFatal : !text "InvalAdr", 0
ldy #>+
jmp fatalError
+ !text "Invalid addr", 0
;------------------------------------------------------------------------------ ;------------------------------------------------------------------------------
; If the resource is a module, this will locate the corresponding bytecode ; If the resource is a module, this will locate the corresponding bytecode
@ -1282,10 +1565,7 @@ shared_free:
and #$3F ; remove the 'active' and 'locked' flags and #$3F ; remove the 'active' and 'locked' flags
sta tSegType,x ; store flags back sta tSegType,x ; store flags back
.done rts ; all done .done rts ; all done
.fatal ldx #<+ .fatal jsr inlineFatal : !text "NoFreeBcode", 0
ldy #>+
jmp fatalError
+ !text "Don't free bytecode.", 0
;------------------------------------------------------------------------------ ;------------------------------------------------------------------------------
main_calcFree: !zone main_calcFree: !zone
@ -1437,10 +1717,7 @@ diskLoader: !zone
+ cmp #RESET_MEMORY + cmp #RESET_MEMORY
bne + bne +
rts ; do nothing rts ; do nothing
+ ldx #<+ + jsr inlineFatal : !text "InvalCmd", 0
ldy #>+
jmp fatalError
+ !text "Invalid command", 0
;------------------------------------------------------------------------------ ;------------------------------------------------------------------------------
openPartition: !zone openPartition: !zone
@ -1488,18 +1765,16 @@ prodosError: !zone
pla pla
jsr .digit jsr .digit
sta .num+1 sta .num+1
ldx #<.msg jsr inlineFatal
ldy #>.msg .msg: !text "ProDOSErr $"
jmp fatalError .num: !text "xx"
!byte 0
.digit: and #$F .digit: and #$F
ora #$B0 ora #$B0
cmp #$BA cmp #$BA
bcc + bcc +
adc #6 adc #6
+ rts + rts
.msg: !text "ProDOS error $"
.num: !text "xx"
!byte 0
;------------------------------------------------------------------------------ ;------------------------------------------------------------------------------
disk_startLoad: !zone disk_startLoad: !zone
@ -1513,10 +1788,7 @@ disk_startLoad: !zone
;------------------------------------------------------------------------------ ;------------------------------------------------------------------------------
sequenceError: !zone sequenceError: !zone
ldx #<+ jsr inlineFatal : !text "BadSeq", 0
ldy #>+
jmp fatalError
+ !text "Bad sequence", 0
;------------------------------------------------------------------------------ ;------------------------------------------------------------------------------
startHeaderScan: !zone startHeaderScan: !zone
@ -1588,10 +1860,7 @@ disk_queueLoad: !zone
jsr adjYpTmp ; keep it small jsr adjYpTmp ; keep it small
jmp .scan ; go for more jmp .scan ; go for more
.notFound: .notFound:
ldx #<+ jsr inlineFatal : !text "ResNotFnd", 0
ldy #>+
jmp fatalError
+ !text "Resource not found", 0
.resLen: !byte 0 .resLen: !byte 0
;------------------------------------------------------------------------------ ;------------------------------------------------------------------------------
@ -2237,11 +2506,11 @@ doAllFixups: !zone
!if DEBUG { !align 255,0 } !if DEBUG { !align 255,0 }
tSegLink = * : !fill MAX_SEGS tSegLink !fill MAX_SEGS
tSegType = * : !fill MAX_SEGS tSegType !fill MAX_SEGS
tSegRes = * : !fill MAX_SEGS tSegRes !fill MAX_SEGS
tSegAdrLo = * : !fill MAX_SEGS tSegAdrLo !fill MAX_SEGS
tSegAdrHi = * : !fill MAX_SEGS tSegAdrHi !fill MAX_SEGS
;------------------------------------------------------------------------------ ;------------------------------------------------------------------------------
; Marker for end of the tables, so we can compute its length ; Marker for end of the tables, so we can compute its length

View File

@ -76,9 +76,8 @@
; The remainder of the file is the data for the resources, in order of their ; The remainder of the file is the data for the resources, in order of their
; table appearance. ; table appearance.
; ;
startMemMgr = $800 mainLoader = $800
mainLoader = $803 auxLoader = mainLoader+3
auxLoader = $806
;------------------------------------------------------------------------------ ;------------------------------------------------------------------------------
; Resource types ; Resource types
@ -280,21 +279,19 @@ FATAL_ERROR = $1F
; Macro param: number of parameters passed from PLASMA to the asm routine ; Macro param: number of parameters passed from PLASMA to the asm routine
; 1. Save PLASMA's X register index to evalStk ; 1. Save PLASMA's X register index to evalStk
; 2. Verify X register is in the range 0-$10 ; 2. Verify X register is in the range 0-$10
; 3. Switch to ROM ; 3. Load the *last* parameter into A=lo, Y=hi
; 4. Load the *last* parameter into A=lo, Y=hi ; 4. Run the calling routine (X still points into evalStk for add'l params if needed)
; 5. Run the calling routine (X still points into evalStk for add'l params if needed) ; 5. Restore PLASMA's X register, and advance it over the parameter(s)
; 6. Switch back to LC RAM ; 6. Store A=lo/Y=hi into PLASMA return value
; 7. Restore PLASMA's X register, and advance it over the parameter(s) ; 7. Return to PLASMA
; 8. Store A=lo/Y=hi into PLASMA return value
; 9. Return to PLASMA
!macro asmPlasm nArgs { !macro asmPlasm nArgs {
ldy #nArgs ldy #nArgs
jsr _asmPlasm jsr _asmPlasm
} }
_asmPlasm = $809 _asmPlasm = auxLoader+3
; Debug support routines (defined in core/mem.s) ; Debug support routines (defined in core/mem.s)
_writeStr = $80C _writeStr = _asmPlasm+3
_prByte = _writeStr+3 _prByte = _writeStr+3
_prSpace = _prByte+3 _prSpace = _prByte+3
_prWord = _prSpace+3 _prWord = _prSpace+3