; E05-S02: class descriptor and object-header test in x128. ; ; The fixture checks the packed descriptor ABI and its runtime accessors: ; EMPTY: size 7, no destructor, no interfaces ; BOX: size 35, destructor, one interface-directory entry ; It then writes CLASSTEST.PRG/MAP through the real output writer. MB_DATA ; flags 0..7 report descriptor, size, destructor, interface, and MAP success. .setcpu "6502" .include "../../src/common/c128.inc" .include "../../src/common/mailbox.inc" .include "../../src/common/formats.inc" .include "../../src/common/class.inc" .import mmu_init, mmu_bank0, mmu_shutdown .import out_begin, out_startup, out_finish, out_abort .import out_load, out_entry, out_err .import out_class, out_class_addr, out_class_size, out_class_destroy .import out_method, out_method_addr .import out_class_ifaces, out_class_ifdir .import obj_class, obj_size, obj_destroy, obj_iface_dir .export desc_empty, desc_box, destroy_b, iface_dir, method_stub .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 "STARTUP" .export test_entry 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 fail_mask sta MB_CODE sta MB_CODE+1 ldx #$07 @flags: sta MB_DATA,x dex bpl @flags jsr mmu_init jsr mmu_bank0 ; ------------------------------------------------ descriptor: EMPTY lda #obj_empty jsr obj_class bcs @p0_fail cmp #desc_empty bne @p0_fail lda #$00 ; null object and null descriptor pointer ldx #$00 jsr obj_class bcc @p0_fail lda #$01 sta MB_DATA+0 jmp @p1 @p0_fail: lda #$01 jsr fail @p1: ; ------------------------------------------------------ size: EMPTY lda #obj_empty jsr obj_size bcs @p1_fail cmp #7 bne @p1_fail cpx #$00 bne @p1_fail lda #$01 sta MB_DATA+1 jmp @p2 @p1_fail: lda #$02 jsr fail @p2: ; -------------------------------------------------- destructor: EMPTY lda #obj_empty jsr obj_destroy bcs @p2_fail cmp #$00 bne @p2_fail cpx #$00 bne @p2_fail lda #$01 sta MB_DATA+2 jmp @p3 @p2_fail: lda #$04 jsr fail @p3: ; ------------------------------------------------- descriptor: BOX lda #obj_box jsr obj_class bcs @p3_fail cmp #desc_box bne @p3_fail lda #$01 sta MB_DATA+3 jmp @p4 @p3_fail: lda #$08 jsr fail @p4: ; ------------------------------------------------------ size: BOX lda #obj_box jsr obj_size bcs @p4_fail cmp #35 bne @p4_fail cpx #$00 bne @p4_fail lda #$01 sta MB_DATA+4 jmp @p5 @p4_fail: lda #$10 jsr fail @p5: ; ------------------------------------------------- destructor: BOX lda #obj_box jsr obj_destroy bcs @p5_fail cmp #destroy_b bne @p5_fail lda #$01 sta MB_DATA+5 jmp @p6 @p5_fail: lda #$20 jsr fail @p6: ; ------------------------------------------------ interface directory lda #obj_box jsr obj_iface_dir bcs @p6_fail cmp #iface_dir bne @p6_fail cpy #1 bne @p6_fail lda #$01 sta MB_DATA+6 jmp @p7 @p6_fail: lda #$40 jsr fail @p7: ; -------------------------------------------------------- MAP output lda #PRG_LOAD_ADDR sta out_load+1 lda #PRG_ENTRY_ADDR sta out_entry+1 lda #name_source ldy #name_source_len jsr out_begin bcc :+ jmp @p7_abort : jsr out_startup bcc :+ jmp @p7_abort : lda #desc_empty sta out_class_addr+1 lda #7 ; EMPTY: size 7, no destructor/interface sta out_class_size lda #$00 sta out_class_size+1 sta out_class_destroy sta out_class_destroy+1 sta out_class_ifaces sta out_class_ifdir sta out_class_ifdir+1 lda #name_empty ldy #name_empty_len jsr out_class bcs @p7_abort lda #desc_box sta out_class_addr+1 lda #35 ; BOX: destructor and one interface sta out_class_size lda #$00 sta out_class_size+1 lda #destroy_b sta out_class_destroy+1 lda #1 sta out_class_ifaces lda #iface_dir sta out_class_ifdir+1 lda #name_box ldy #name_box_len jsr out_class bcs @p7_abort lda #destroy_b sta out_method_addr+1 lda #name_destroy ldy #name_destroy_len jsr out_method bcs @p7_abort lda #method_stub sta out_method_addr+1 lda #name_stub ldy #name_stub_len jsr out_method bcs @p7_abort jsr out_finish bcs @p7_fail lda #$01 sta MB_DATA+7 jmp @done @p7_abort: lda out_err sta MB_ADDR jsr out_abort @p7_fail: lda out_err sta MB_ADDR lda #$80 jsr fail @done: jsr mmu_shutdown lda fail_mask sta MB_CODE lda #$00 sta MB_CODE+1 lda #MB_ST_FAIL ldx fail_mask bne @status lda #MB_ST_PASS @status: sta MB_STATUS lda fail_mask beq @ok_message ldy #fail_message - messages bne @print @ok_message: ldy #ok_message - messages @print: lda messages,y beq @end sty print_y jsr CHROUT ldy print_y iny bne @print @end: rts .segment "CODE" fail: ora fail_mask sta fail_mask rts destroy_b: rts method_stub: rts .segment "DATA" desc_empty: .word 7 .word 0 .byte 0 .word 0 .byte 0 .assert * - desc_empty = CLASS_DESC_SIZE, error, "EMPTY descriptor size" desc_box: .word 35 .word destroy_b .byte 1 .word iface_dir .byte 0 .assert * - desc_box = CLASS_DESC_SIZE, error, "BOX descriptor size" iface_dir: .word iface_stub .word iface_table iface_stub: .word 0 iface_table: .word method_stub obj_empty: .word desc_empty .res 5 obj_box: .word desc_box .res 33 .assert obj_box - obj_empty = 7, error, "EMPTY object size" .assert * - obj_box = 35, error, "BOX object size" .segment "RODATA" name_source: .byte "CLASSTEST.N8" name_source_len = * - name_source name_empty: .byte "EMPTY" name_empty_len = * - name_empty name_box: .byte "BOX" name_box_len = * - name_box name_destroy: .byte "DESTROY" name_destroy_len = * - name_destroy name_stub: .byte "STUB" name_stub_len = * - name_stub messages: ok_message: .byte "NOVA128 CLASS TEST OK", $0D, $00 fail_message: .byte "NOVA128 CLASS TEST FAIL", $0D, $00 .segment "BSS" fail_mask: .res 1 print_y: .res 1