; Macro library for OF816. Contains macros for hand-compiled Forth code and common ; ops used within primitives. Also contains macros for building dictionaries. ; Config/build macros .macro PLATFORM_INCLUDE file .if .strlen(PLATFORM) > 0 .out .sprintf("Including text platforms/%s/%s", PLATFORM, file) .include .sprintf("platforms/%s/%s", PLATFORM, file) .endif .endmacro .macro PLATFORM_INCBIN file .if .strlen(PLATFORM) > 0 .out .sprintf("Including binary platforms/%s/%s", PLATFORM, file) .incbin .sprintf("platforms/%s/%s", PLATFORM, file) .endif .endmacro ; General macros & defs .define SHORT_A %00100000 .define SHORT_I %00010000 ;.macro LDAY val ; ldy .loword(val) ; lda .hiword(val) ;.endmacro ; Forth macros ; Enter inner interpreter with 32-bit absolute addresses .macro ENTER jsl _enter .endmacro .macro EXIT .dword _exit_next-1 .endmacro .macro CODE .dword _exit_code-1 .endmacro .macro NEXT jmp _next .endmacro .macro LNEXT jml f:_next .endmacro .macro PUSHNEXT jmp _next::fast_num .endmacro .macro LPUSHNEXT jml f:_next::fast_num .endmacro .macro RUN jmp _next::run .endmacro .macro LRUN jml f:_next::run .endmacro ; This version always stores one or two cell-sized objects .macro NLIT num .if .const(num) .if .hiword(num) > 0 || no_fast_lits .dword _LIT .endif .word .loword(num) .word .hiword(num) .else .dword _LIT .dword num .endif .endmacro ; This version will use the most optimal ; storage for the literal in question .macro ONLIT num .if .const(num) .if .hiword(num) > 0 ; big numbers are always expensive .dword _LIT .word .loword(num) .word .hiword(num) .elseif no_fast_lits ; if no fast literals, right-size it .if .hibyte(num) > 0 .dword _WLIT .word num .else .dword _CLIT .byte num .endif .else ; fast literals are the cheapest when available .word .loword(num) .word .hiword(num) .endif .else NLIT num ; non-const expressions get a cell .endif .endmacro .macro JUMP target .dword _JUMP .dword target .endmacro .macro BRANCH target .dword _BRANCH .addr target-* .endmacro .if 0 ; Macro for a string literal ( -- c-addr u ) .macro OLDSLIT str .local target,addr JUMP target addr: .byte str target: NLIT addr NLIT .strlen(str) .endmacro .endif .macro SLIT str .dword _SLIT .dword .strlen(str) .byte str .endmacro ; Macro for a counted string literal ( -- c-addr ) .macro CSLIT str .local target,addr JUMP target addr: .byte .strlen(str) .byte str target: NLIT addr .endmacro .macro FCONSTANT value ldy #.loword(value) lda #.hiword(value) PUSHNEXT .endmacro ; Can't be used in ROMable code .macro FVARIABLE value jsl _pushda val: .dword value .endmacro ; Can't be used in ROMable code .macro FVALUE value jsl _pushconst val: .dword value .endmacro ; Can't be used in ROMable code .macro DEFER adr jsl _deferred val: .ifblank adr .dword _unimpl .else .dword adr .endif .endmacro .macro FFIELD offset jsl _field .dword offset .endmacro NUM_SYSVARS .set 0 .macro DEF_SYSVAR num,name .assert num=NUM_SYSVARS, error, "System variable defined out-of-order" name = num*4 NUM_SYSVARS .set NUM_SYSVARS+1 .endmacro .macro SYSVAR num jsl _sysvar .dword num .endmacro .macro SYSVAR_INIT name .assert .sizeof(name)=NUM_SYSVARS*4,error,.sprintf("SYSVAR_INIT: size incorrect, should be %i dwords",NUM_SYSVARS) .endmacro .macro FSTR str .local target,thestr ldy #<.loword(thestr) lda #>.hiword(thestr) jsr _pushay ldy #<.strlen(str) lda #>.strlen(str) jsr _pushay bra target thestr: .byte str target: .endmacro .macro TRACE name .ifblank name jsr _named_trace .byte name .else jsr _word_trace .endif .endmacro ; Dictionary structure macros ; Dictionary format: ; Bytes Purpose ; Header (scope H_) ; 4 Link to previous (0=end of dictionary), not present for "headerless" words ; 1 Name Length, high bit always set (max=127) ; n Name (high bits clear), if present ; 1 Flags ; b7 - Immediate ; b6 - Compile-only ; b0 - Smudge ; Code (scope ) .define F_IMMED %10000000 ; immediate .define F_CONLY %01000000 ; compile-only .define F_PROT %00100000 ; begin system protection (from FORGET, etc.) .define F_TEMPD %00010000 ; word initiates or finishes temporary definition .define F_SMUDG %00001000 ; smudged, invisible in search .define NAMEMSK %01111111 ; name length mask .macro dstart dictname .ifdef c_dict .error "%s dictionary not closed",.string(c_dict) .endif .define c_dict dictname .ifndef __dstart __dstart = 0 .endif .define l_dword __dstart ; last defined word .endmacro .macro dhead link,dname,fname .if print_dict && .strlen(fname) > 0 .if .const(*) .out .concat(fname, .sprintf(" def at $%x", *)) .else .out .concat(fname, " def starts") .endif .elseif print_dict .if .const(*) .out .concat(.string(dname), .sprintf(" def at $%x", *)) .else .out .concat(.string(dname), " def starts") .endif .endif .proc .ident(.sprintf("H_%s",.string(dname))) .if .strlen(fname) > 0 .dword link .byte .strlen(fname)|$80 .byte fname .else .byte $80 .endif .endproc .endmacro .macro dword dname,fname,flags .ifdef c_dword .error .sprintf("%s def not closed",.string(c_dword)) .endif .if .strlen(fname) > 0 .define c_dword .ident(.sprintf("H_%s",.string(dname))) .endif dhead l_dword,dname,fname .proc dname .if print_dict && .const(*) .out .sprintf(" xt at $%x", *) .endif ; flag byte here so that XT is code addr - 1 .ifblank flags .byte F_PROT .else .byte flags|F_PROT .endif code: .if trace wdm $80 ; for emulator debugger .endif .endmacro .macro hword dname,fname,flags .if no_headerless .ifblank flags dword dname,fname .else dword dname,fname,flags .endif .else .ifblank flags dword dname,"" .else dword dname,"",flags .endif .endif .endmacro .macro dwordq dname,fname,flags .charmap $27,$22 ; temporarily map single quote to double quote .ifblank flags dword dname,fname .else dword dname,fname,flags .endif .charmap $27,$27 ; unmap .endmacro .macro dchain dname .ifdef l_dword .undefine l_dword .endif .define l_dword dname .endmacro .macro eword .endproc .ifdef c_dword dchain c_dword .undefine c_dword .endif .endmacro .macro denvq dname,fname,value,value2 dword dname,fname .ifblank value2 jsl _pushvalue .dword value .else jsl _push2value .dword value2 .dword value .endif eword .endmacro .macro dend .ident(.sprintf("LAST_%s",c_dict)) = l_dword .undef c_dict .undef l_dword .endmacro ; outside-of-dictionary headerless words ; mainly to support FCode features .macro xdword dname,flags .proc .ident(.sprintf("H_%s",.string(dname))) .byte $80 .endproc .proc dname .ifblank flags .byte F_PROT .else .byte flags|F_PROT .endif code: .endmacro .macro exdword .endproc .endmacro ; FCode macros .define FC_ROMFLAG $80000000 .define FC_IMMFLAG $80000000 ; These get around stupid address size calculation probs in the linker .macro FCROM addr .faraddr addr .byte .hibyte(.hiword(FC_ROMFLAG)) .endmacro .macro FCIMM addr .faraddr addr .byte .hibyte(.hiword(FC_IMMFLAG)) .endmacro