; interfaces.s - interface slot order and class conformance (E03-S06). ; ; Runs once after pass 1, when every interface, class, member, parameter, and ; implements row is recorded: ; assign_slots numbers each interface method in declaration order and ; stores it in C_MEM_SLOT, so later method tables and the MAP ; writer can use a stable slot without re-reading the source; ; check_interfaces ; verifies each class against every interface it implements. ; A satisfying method is public and has the same parameter ; count, parameter types, and return type. One method may ; satisfy identical requirements from several interfaces. ; ; Diagnostics are reported at the class declaration line, column 1: ; E130 no public method with a required name (missing, field, or private) ; E131 a public method with that name differs in its signature ; E132 the differing method matches the same-named requirement of another ; implemented interface, so the interfaces conflict ; E133 an implements entry names a class or program, not an interface ; An implements entry that names no declared type is left to pass 2, which ; already reports the unknown name at the source position. ; ; Everything is read through tb_get/tb_set, so this module runs in the normal ; bank-0 compiler state. .setcpu "6502" .include "../common/errors.inc" .include "../common/parser.inc" .import tb_get, tb_set, names_count .import diag_report, diag_line, diag_col, diag_arg1, diag_arg1_len .import name_get, name_out, name_out_len .export assign_slots, check_interfaces, find_method .segment "CODE" ; ------------------------------------------------------------- slot order ; Every interface method gets its declaration index: 0, 1, ... in source ; order. Interfaces cannot declare fields, so member rows are signatures. assign_slots: lda #$01 sta as_id @next: lda as_id cmp names_count bcc :+ rts : ldy as_id lda #C_TYPE_KIND jsr tb_get cmp #TYPE_INTERFACE beq :+ jmp @skip : ldy as_id lda #C_TYPE_MFIRST jsr tb_get sta as_row ldy as_id lda #C_TYPE_MCOUNT jsr tb_get sta as_n lda #$00 sta as_slot @slot: lda as_n beq @skip ldy as_row ldx as_slot lda #C_MEM_SLOT jsr tb_set inc as_row inc as_slot dec as_n bne @slot @skip: inc as_id bne @next rts ; ----------------------------------------------------------- conformance ; For each class in declaration order, walk its implements list in source ; order and each interface's signatures in slot order. check_interfaces: lda #$01 sta cf_class @class: lda cf_class cmp names_count bcc :+ jmp @done : ldy cf_class lda #C_TYPE_KIND jsr tb_get cmp #TYPE_CLASS beq :+ jmp @cnext : ldy cf_class lda #C_TYPE_ICOUNT jsr tb_get bne :+ jmp @cnext ; no implements list : sta cf_count ldy cf_class lda #C_TYPE_IFIRST jsr tb_get sta cf_row lda #$00 sta cf_i @impl: lda cf_i cmp cf_count bcc :+ jmp @cnext : ldy cf_row lda #C_IMPL_IFACE jsr tb_get sta cf_iface ldy cf_iface lda #C_TYPE_KIND jsr tb_get cmp #TYPE_INTERFACE beq @conform cmp #$00 bne :+ ; unknown: pass 2 reports it jmp @inext : ldx cf_iface lda #E_IFC_NOT_INTERFACE jsr iface_err bcc :+ jmp @stop : jmp @inext @conform: ldy cf_iface lda #C_TYPE_MFIRST jsr tb_get sta cf_req ldy cf_iface lda #C_TYPE_MCOUNT jsr tb_get sta cf_n @req: lda cf_n bne :+ jmp @inext : ldy cf_req lda #C_MEM_NAME jsr tb_get sta cf_name lda cf_class ldx cf_name jsr find_method bcc @missing sty cf_method lda #C_MEM_FLAGS jsr tb_get and #MF_PRIVATE beq @sig jmp @missing ; private methods do not implement @sig: lda cf_req ldx cf_method jsr same_sig bcs @satisfied lda cf_method ldx cf_name jsr conflicting bcs @conflict ldx cf_name lda #E_IFC_SIGNATURE_MISMATCH jsr iface_err bcc :+ jmp @stop : jmp @satisfied @conflict: ldx cf_name lda #E_IFC_SIGNATURE_CONFLICT jsr iface_err bcc :+ jmp @stop : jmp @satisfied @missing: ldx cf_name lda #E_IFC_METHOD_MISSING jsr iface_err bcc :+ jmp @stop : @satisfied: inc cf_req dec cf_n jmp @req @inext: inc cf_row inc cf_i jmp @impl @cnext: inc cf_class beq @done jmp @class @stop: sec rts @done: clc rts ; A = class ID, X = method name ID. C=1 and Y=row when the class declares a ; method with that name; C=0 otherwise. A field with the name does not count. find_method: sta fmc_class stx fmc_name ldy fmc_class lda #C_TYPE_MFIRST jsr tb_get sta fmc_row ldy fmc_class lda #C_TYPE_MCOUNT jsr tb_get sta fmc_n @row: lda fmc_n beq @no ldy fmc_row lda #C_MEM_FLAGS jsr tb_get and #MF_METHOD beq @next ldy fmc_row lda #C_MEM_NAME jsr tb_get cmp fmc_name beq @yes @next: inc fmc_row dec fmc_n bne @row @no: clc rts @yes: ldy fmc_row sec rts ; C=1 when the class method A matches a same-named requirement (X) of an ; implemented interface other than the one being checked. That means the ; interfaces themselves disagree, not that the class method is wrong. conflicting: sta cn_method stx cn_name ldy cf_class lda #C_TYPE_IFIRST jsr tb_get sta cn_row ldy cf_class lda #C_TYPE_ICOUNT jsr tb_get sta cn_n @iface: lda cn_n beq @no ldy cn_row lda #C_IMPL_IFACE jsr tb_get sta cn_iface cmp cf_iface beq @next_iface ldy cn_iface lda #C_TYPE_KIND jsr tb_get cmp #TYPE_INTERFACE bne @next_iface ldy cn_iface lda #C_TYPE_MFIRST jsr tb_get sta cn_req ldy cn_iface lda #C_TYPE_MCOUNT jsr tb_get sta cn_req_n @req: lda cn_req_n beq @next_iface ldy cn_req lda #C_MEM_NAME jsr tb_get cmp cn_name bne @next_req lda cn_method ldx cn_req jsr same_sig bcs @yes @next_req: inc cn_req dec cn_req_n bne @req @next_iface: inc cn_row dec cn_n bne @iface @no: clc rts @yes: sec rts ; C=1 when member rows A and X have equal signatures: result type, parameter ; count, and each parameter type. same_sig: sta sg_a stx sg_b ldy sg_a lda #C_MEM_PCOUNT jsr tb_get sta sg_n ldy sg_b lda #C_MEM_PCOUNT jsr tb_get cmp sg_n bne @no lda sg_a ldx sg_b jsr same_result bcc @no ldy sg_a lda #C_MEM_PFIRST jsr tb_get sta sg_pa ldy sg_b lda #C_MEM_PFIRST jsr tb_get sta sg_pb lda #$00 sta sg_i @param: lda sg_i cmp sg_n beq @yes lda sg_pa clc adc sg_i sta sg_ra lda sg_pb clc adc sg_i sta sg_rb lda sg_ra ldx sg_rb jsr same_param bcc @no inc sg_i bne @param @yes: sec rts @no: clc rts same_result: ldy #C_MEM_TBASE jmp same_cells same_param: ldy #C_PAR_TBASE jmp same_cells ; C=1 when four consecutive type columns starting at Y are equal for rows A ; and X (base, name, length lo, length hi). same_cells: sta sg_a stx sg_b sty sg_col lda #$00 sta sg_ci @col: ldy sg_a lda sg_col clc adc sg_ci jsr tb_get sta sg_v ldy sg_b lda sg_col clc adc sg_ci jsr tb_get cmp sg_v bne @no inc sg_ci lda sg_ci cmp #$04 bne @col sec rts @no: clc rts ; Report A at class cf_class's declaration line, column 1, with name X as ; argument 1. C=1 when the diagnostic limit stopped compilation. iface_err: sta ie_code stx ie_name ldy cf_class lda #C_TYPE_LINE_LO jsr tb_get sta diag_line ldy cf_class lda #C_TYPE_LINE_HI jsr tb_get sta diag_line+1 lda #$01 sta diag_col lda ie_name jsr name_get lda #name_out sta diag_arg1+1 lda name_out_len sta diag_arg1_len lda ie_code jsr diag_report bcc @ok sec rts @ok: clc rts .segment "BSS" ; slot assignment as_id: .res 1 as_row: .res 1 as_n: .res 1 as_slot: .res 1 ; conformance cf_class: .res 1 cf_iface: .res 1 cf_count: .res 1 cf_row: .res 1 cf_i: .res 1 cf_req: .res 1 cf_n: .res 1 cf_name: .res 1 cf_method: .res 1 fmc_class: .res 1 fmc_name: .res 1 fmc_row: .res 1 fmc_n: .res 1 cn_method: .res 1 cn_name: .res 1 cn_row: .res 1 cn_n: .res 1 cn_iface: .res 1 cn_req: .res 1 cn_req_n: .res 1 sg_a: .res 1 sg_b: .res 1 sg_n: .res 1 sg_i: .res 1 sg_pa: .res 1 sg_pb: .res 1 sg_col: .res 1 sg_ci: .res 1 sg_v: .res 1 sg_ra: .res 1 sg_rb: .res 1 ie_code: .res 1 ie_name: .res 1