; E05-S03: construction/deletion fixture in x128. ; ; Runs under CR=$0E with a 4K heap at $4000. It checks: ; - object header and zeroed fields, then init called once with two args; ; - delete null is a no-op; ; - delete calls destroy once with self/fields intact and frees the object; ; - failed allocation does not call init; ; - a class without a destructor still frees correctly. ; ; MB_DATA flags 0..4 report the five phases. .setcpu "6502" .include "../../src/common/c128.inc" .include "../../src/common/mailbox.inc" .include "../../src/common/print.inc" .include "../../src/common/heap.inc" .include "../../src/common/class.inc" .include "../../src/common/frames.inc" .import pr_char, pr_cr, pr_text .import heap_init, heap_alloc, heap_free, heap_free_total, heap_error .import frame_init, frame_enter, frame_leave, frame_push_byte, frame_push_word, frame_discard .import obj_class .import obj_new, obj_delete, obj_init_ptr, obj_error HEAP_BASE = $4000 HEAP_PAGES = 16 .macro TEXT src, len lda #src ldy #len jsr pr_text .endmacro .macro PHASE n lda #n sta MB_CODE lda #$00 sta MB_CODE+1 .endmacro .macro FAIL_CS bcc :+ jmp @fail : .endmacro .macro FAIL_CC bcs :+ jmp @fail : .endmacro .macro FAIL_NE beq :+ jmp @fail : .endmacro .macro FAIL_EQ bne :+ jmp @fail : .endmacro .segment "LOADADDR" .word $1C01 .segment "EXEHDR" .word basic_end .word 10 .byte $9E .byte "7181" .byte $00 basic_end: .word $0000 .segment "MAILBOX" .res MB_SIZE .segment "ZEROPAGE" tptr: .res 2 .segment "STARTUP" .export test_entry, test_end test_entry: php sei ldx #MB_SIZE - 1 lda #$00 @clr: sta MB_BASE,x dex bpl @clr lda #MB_MAGIC0_VALUE sta MB_MAGIC0 lda #MB_MAGIC1_VALUE sta MB_MAGIC1 lda #MB_PROD_PROGRAM sta MB_PRODUCER lda #MB_ST_RUNNING sta MB_STATUS lda #$00 sta MB_CODE sta MB_CODE+1 lda MMU_CR sta saved_cr lda #CR_RAM0_KERNAL sta MMU_CR lda #PR_CLEAR jsr pr_char TEXT title, 18 jsr pr_cr PHASE 1 lda #$00 ldx #>HEAP_BASE ldy #HEAP_PAGES jsr heap_init FAIL_CS jsr frame_init lda #$00 sta init_count sta destroy_count sta init_error ; Construct Res(value=$1234, tag=$2A). lda #$2A jsr frame_push_byte ; right-to-left: tag first lda #$34 ldx #$12 jsr frame_push_word ; then value lda #init_res sta obj_init_ptr+1 lda #desc_res jsr obj_new FAIL_CS sta new_obj stx new_obj+1 lda #3 ldx #$00 jsr frame_discard lda init_error FAIL_NE lda init_count cmp #1 FAIL_NE lda init_self cmp new_obj FAIL_NE lda init_self+1 cmp new_obj+1 FAIL_NE lda init_tag cmp #$2A FAIL_NE lda init_word cmp #$34 FAIL_NE lda init_word+1 cmp #$12 FAIL_NE lda init_tag_before FAIL_NE lda init_word_before ora init_word_before+1 FAIL_NE lda new_obj ldx new_obj+1 jsr obj_class FAIL_CS cmp #desc_res FAIL_NE lda #$01 sta MB_DATA+0 ; delete null must not call destroy. PHASE 2 lda #$00 ldx #$00 jsr obj_delete FAIL_CS lda obj_error cmp #OBJ_OK FAIL_NE lda destroy_count FAIL_NE lda #$01 sta MB_DATA+1 ; Deleting the object calls destroy once, with self and fields intact. PHASE 3 lda new_obj ldx new_obj+1 jsr obj_delete FAIL_CS lda obj_error cmp #OBJ_OK FAIL_NE lda destroy_count cmp #1 FAIL_NE lda destroy_self cmp new_obj FAIL_NE lda destroy_self+1 cmp new_obj+1 FAIL_NE lda destroy_tag cmp #$2A FAIL_NE lda destroy_word cmp #$34 FAIL_NE lda destroy_word+1 cmp #$12 FAIL_NE lda heap_free_total cmp #$00 FAIL_NE lda heap_free_total+1 cmp #$10 FAIL_NE lda #$01 sta MB_DATA+2 ; Allocation failure must not call init. PHASE 4 lda #init_res sta obj_init_ptr+1 lda #desc_huge jsr obj_new FAIL_CC lda obj_error cmp #OBJ_ERR_HEAP FAIL_NE lda init_count cmp #1 FAIL_NE lda #$01 sta MB_DATA+3 ; A class with no destructor still frees its complete object. PHASE 5 lda #$00 sta obj_init_ptr sta obj_init_ptr+1 lda #desc_plain jsr obj_new FAIL_CS sta plain_obj stx plain_obj+1 lda plain_obj ldx plain_obj+1 jsr obj_delete FAIL_CS lda obj_error cmp #OBJ_OK FAIL_NE lda destroy_count cmp #1 FAIL_NE lda heap_free_total cmp #$00 FAIL_NE lda heap_free_total+1 cmp #$10 FAIL_NE lda #$01 sta MB_DATA+4 TEXT object_ok, 9 jsr pr_cr lda #MB_ST_PASS sta MB_STATUS lda #$00 sta MB_CODE sta MB_CODE+1 jmp @restore @fail: lda #MB_ST_FAIL sta MB_STATUS TEXT object_fail, 11 jsr pr_cr @restore: lda saved_cr sta MMU_CR plp rts ; init(value as word, tag as byte), arguments at FP+2..FP+4. init_res: sta init_self stx init_self+1 lda #$00 ldx #$00 jsr frame_enter bcc @entered lda #1 sta init_error rts @entered: ldy #2 lda (FRAME_FP),y sta init_word iny lda (FRAME_FP),y sta init_word+1 iny lda (FRAME_FP),y sta init_tag lda init_self sta tptr lda init_self+1 sta tptr+1 ldy #2 lda (tptr),y sta init_tag_before ldy #3 lda (tptr),y sta init_word_before iny lda (tptr),y sta init_word_before+1 ldy #2 lda init_tag sta (tptr),y ldy #3 lda init_word sta (tptr),y iny lda init_word+1 sta (tptr),y inc init_count jsr frame_leave clc rts ; No-argument destructor; it records self and the fields left by init. destroy_res: sta destroy_self stx destroy_self+1 inc destroy_count lda destroy_self sta tptr lda destroy_self+1 sta tptr+1 ldy #2 lda (tptr),y sta destroy_tag ldy #3 lda (tptr),y sta destroy_word iny lda (tptr),y sta destroy_word+1 rts .segment "DATA" desc_res: .word 5 ; header + tag + word .word destroy_res .byte 0 .word 0 .byte 0 .assert * - desc_res = CLASS_DESC_SIZE, error, "Res descriptor size" desc_plain: .word 2 ; header only .word 0 .byte 0 .word 0 .byte 0 .assert * - desc_plain = CLASS_DESC_SIZE, error, "plain descriptor size" desc_huge: .word $FFFF .word 0 .byte 0 .word 0 .byte 0 .assert * - desc_huge = CLASS_DESC_SIZE, error, "huge descriptor size" .segment "RODATA" title: .byte "NOVA128 OBJECT TEST" object_ok: .byte "OBJECT OK" object_fail: .byte "OBJECT FAIL" .segment "BSS" saved_cr: .res 1 new_obj: .res 2 plain_obj: .res 2 init_count: .res 1 init_error: .res 1 init_self: .res 2 init_word: .res 2 init_tag: .res 1 init_tag_before: .res 1 init_word_before: .res 2 destroy_count: .res 1 destroy_self: .res 2 destroy_tag: .res 1 destroy_word: .res 2 test_end: