C64-dev/newLang/src/runtime/construct.s

; construct.s - runtime object construction and deletion (E05-S03).
;
; This layer sits above the E05-S01 heap and the E05-S02 descriptor ABI. It
; deliberately does not depend on the compiler: generated code will call it
; after evaluating constructor arguments.
;
; API:
;   obj_new       A/X = class descriptor pointer. The caller has already
;                 pushed constructor arguments right-to-left on the software
;                 frame stack and set obj_init_ptr to the init entry (or 0).
;                 Allocates the descriptor's instance size, zeroes it (heap
;                 contract), stores the descriptor at object+0, then calls
;                 init with A/X = self. Returns A/X = object, C=0. On failure
;                 A/X=0, C=1 and obj_error is OBJ_ERR_HEAP or OBJ_ERR_BAD.
;                 init is never called on failure.
;   obj_delete    A/X = object. Null is a no-op. Reads the optional
;                 destructor from the descriptor, calls it once with A/X =
;                 self, then frees the complete object. Returns C=0 and
;                 A/X=0; C=1 with obj_error on a bad object or heap error.
;   obj_init_ptr  init entry selected by the caller; 0 = no init.
;   obj_error     OBJ_OK, OBJ_ERR_HEAP, or OBJ_ERR_BAD.
;
; Constructor arguments remain on the caller's frame stack. init uses the
; normal frame_enter/frame_leave contract and sees them at FP+2. The caller
; discards the argument bytes after obj_new returns. obj_delete and obj_new
; use obj_call, a synthetic-return indirect call, because the 8502 has no
; JSR (address). obj_call takes its entry from co_vec because A/X already
; carry the callee's self pointer; it preserves A/X and only needs one level
; of synthetic return, so E06-S02 can reuse it for interface dispatch.

.setcpu "6502"
.include "../common/class.inc"

.import heap_alloc, heap_free, obj_class
.export obj_new, obj_delete, obj_init_ptr, obj_error

.segment "ZEROPAGE"
co_vec:         .res 2             ; indirect target for obj_call
co_desc:        .res 2             ; descriptor pointer
co_ptr:         .res 2             ; object header writer
co_self:        .res 2             ; A/X passed through obj_call

.segment "CODE"

; A/X = descriptor. Allocate and construct; see the API above.
obj_new:
        sta co_desc
        stx co_desc+1
        lda #OBJ_OK
        sta obj_error

        ldy #CD_INSTANCE_SIZE
        lda (co_desc),y
        sta co_size
        iny
        lda (co_desc),y
        sta co_size+1
        ora co_size
        beq @bad

        lda co_size
        ldx co_size+1
        jsr heap_alloc
        bcs @heap_fail
        sta co_obj
        stx co_obj+1

        lda co_obj                   ; object+0 = descriptor
        sta co_ptr
        lda co_obj+1
        sta co_ptr+1
        ldy #OBJ_DESCRIPTOR
        lda co_desc
        sta (co_ptr),y
        iny
        lda co_desc+1
        sta (co_ptr),y

        lda obj_init_ptr
        ora obj_init_ptr+1
        beq @ok
        lda obj_init_ptr
        sta co_vec
        lda obj_init_ptr+1
        sta co_vec+1
        lda co_obj
        ldx co_obj+1
        jsr obj_call
@ok:
        lda co_obj
        ldx co_obj+1
        clc
        rts
@heap_fail:
        lda #OBJ_ERR_HEAP
        sta obj_error
        lda #$00
        tax
        sec
        rts
@bad:
        lda #OBJ_ERR_BAD
        sta obj_error
        lda #$00
        tax
        sec
        rts

; A/X = object. Optional destructor, then free. Null is successful.
obj_delete:
        sta co_obj
        stx co_obj+1
        lda #OBJ_OK
        sta obj_error
        lda co_obj
        ora co_obj+1
        bne :+
        jmp @null
:
        lda co_obj                   ; reload: the null test left A = low|high
        ldx co_obj+1
        jsr obj_class
        bcc :+
        jmp @bad
:
        sta co_desc
        stx co_desc+1

        ldy #CD_INSTANCE_SIZE
        lda (co_desc),y
        sta co_size
        iny
        lda (co_desc),y
        sta co_size+1
        ora co_size
        bne :+
        jmp @bad
:

        ldy #CD_DESTRUCTOR
        lda (co_desc),y
        sta co_destroy
        iny
        lda (co_desc),y
        sta co_destroy+1
        lda co_destroy
        ora co_destroy+1
        bne :+
        jmp @free
:

        lda co_destroy
        sta co_vec
        lda co_destroy+1
        sta co_vec+1
        lda co_obj
        ldx co_obj+1
        jsr obj_call

@free:
        lda co_obj
        ldx co_obj+1
        jsr heap_free
        bcs @heap_fail
@null:
        lda #$00
        tax
        clc
        rts
@heap_fail:
        lda #OBJ_ERR_HEAP
        sta obj_error
        lda #$00
        tax
        sec
        rts
@bad:
        lda #OBJ_ERR_BAD
        sta obj_error
        lda #$00
        tax
        sec
        rts

; Entry in co_vec. A/X pass through to the callee, so the caller passes self
; there. Push a synthetic return address, then JMP (co_vec): the callee's RTS
; returns to @ret, whose RTS returns to the original caller. co_vec must not
; straddle a page because of the 6502 JMP-indirect bug.
obj_call:
        sta co_self
        stx co_self+1
        lda #>(@ret - 1)
        pha
        lda #<(@ret - 1)
        pha
        lda co_self
        ldx co_self+1
        jmp (co_vec)
@ret:   rts
.assert <co_vec <> $FF, error, "co_vec must not straddle a page"

.segment "BSS"
co_obj:         .res 2
co_size:        .res 2
co_destroy:     .res 2
obj_init_ptr:   .res 2
obj_error:      .res 1