diff --git a/src/toolsrc/swyftcode.pla b/src/toolsrc/swyftcode.pla
new file mode 100644
index 0000000..f61b31f
--- /dev/null
+++ b/src/toolsrc/swyftcode.pla
@@ -0,0 +1,4213 @@
+//
+// Global constants
+//
+const FALSE = 0
+const TRUE = 1
+//
+// Hardware constants
+//
+const csw = $0036
+const speaker = $C030
+const showgraphics = $C050
+const showtext = $C051
+const showfull = $C052
+const showmix = $C053
+const showpage1 = $C054
+const showpage2 = $C055
+const showlores = $C056
+const showhires = $C057
+const pushbttn1 = $C061
+const pushbttn2 = $C062
+const pushbttn3 = $C063
+const keyboard = $C000
+const keystrobe = $C010
+const keyenter = $8D
+const keyspace = $A0
+const keyarrowup = $8B
+const keyarrowdown = $8A
+const keyarrowleft = $88
+const keyarrowright = $95
+const keyescape = $9B
+const keyctrla = $81
+const keyctrlb = $82
+const keyctrlc = $83
+const keyctrld = $84
+const keyctrle = $85
+const keyctrlf = $86
+const keyctrli = $89
+const keyctrlk = $8B
+const keyctrll = $8C
+const keyctrln = $8E
+const keyctrlo = $8F
+const keyctrlp = $90
+const keyctrlq = $91
+const keyctrlr = $92
+const keyctrls = $93
+const keyctrlt = $94
+const keyctrlu = $95
+const keyctrlv = $96
+const keyctrlw = $97
+const keyctrlx = $98
+const keyctrly = $99
+const keyctrlz = $9A
+const keydelete = $FF
+const getbuff = $01FF
+//
+// Data and text buffer constants
+//
+const machid = $BF98
+const maxlines = 626
+const maxfill = 640
+const iobuffer = $0800
+const databuff = $0C00
+const strlinbuf = $1000
+const strheapmap = $1500
+const strheapmsz = $80 // = memory@16 bytes per bit map, 128 bytes per 8 bit map, 1K bytes per 8 byte map
+const maxlnlen = 79
+const strheap = $6800
+const strheasz = $4000
+const codebuff = $A800
+const codebuffsz = $1000
+const pgjmp = 16
+const changed = 1
+const insmode = 2
+const showcurs = 4
+const uppercase = 8
+const shiftlock = 128
+//
+// Argument buffer (must be first declared variables)
+//
+word signature = $EEEE // buffer signature
+byte = 32 // buffer length
+byte[32] argbuff = "" // buffer
+//
+// Text screen row address array
+//
+word txtscrn = $0400,$0480,$0500,$0580,$0600,$0680,$0700,$0780
+word = $0428,$04A8,$0528,$05A8,$0628,$06A8,$0728,$07A8
+word = $0450,$04D0,$0550,$05D0,$0650,$06D0,$0750,$07D0
+//
+// Editor variables
+//
+byte nullstr = ""
+byte version = "PLASMA ][ SWYFTCODE VERSION 00.11 "
+byte errorstr = "ERROR: $"
+byte okstr = "OK"
+byte outofmem = "OUT OF MEMORY!"
+byte losechng = "LOSE CHANGES TO FILE (Y/N)?"
+byte untitled = "UNTITLED.PLA"
+byte[64] txtfile = "UNTITLED.PLA"
+byte flags = 0
+byte flash = 0
+word numlines = 0
+word cutbuf = 0
+byte perr, cursx, cursy, scrnleft, curscol, underchr, curschr
+word keyin, cursrow, scrntop, cursptr
+//
+// Predeclared functions
+//
+predef cmdmode
+//
+// Compiler variables
+//
+//
+// Tokens
+//
+const ID_TKN = $D6 // V
+const CHR_TKN = $C3 // C
+const INT_TKN = $C9 // I
+const HEX_TKN = $9D
+const STR_TKN = $D3 // S
+const EOL_TKN = $02
+const EOF_TKN = $01
+const ERR_TKN = $00
+//
+// Binary operand operators
+//
+const SET_TKN = $BD // =
+const ADD_TKN = $AB // +
+const SUB_TKN = $AD // -
+const MUL_TKN = $AA // *
+const DIV_TKN = $AF // /
+const MOD_TKN = $A5 // %
+const OR_TKN = $FC // |
+const EOR_TKN = $DE // ^
+const AND_TKN = $A6 // &
+const SHR_TKN = $D2 // R
+const SHL_TKN = $CC // L
+const GT_TKN = $BE // >
+const GE_TKN = $C8 // H
+const LT_TKN = $BC // <
+const LE_TKN = $C2 // B
+const NE_TKN = $D5 // U
+const EQ_TKN = $C5 // E
+const LOGIC_AND_TKN = $CE // N
+const LOGIC_OR_TKN = $CF // O
+//
+// Unary operand operators
+//
+const AT_TKN = $C0 // @
+const DOT_TKN = $AE // .
+const COLON_TKN = $BA // :
+const NEG_TKN = $AD // -
+const COMP_TKN = $A3 // #
+const LOGIC_NOT_TKN = $FE // ~
+const BPTR_TKN = $DE // ^
+const WPTR_TKN = $AA // *
+const PTRB_TKN = $D8 // X
+const PTRW_TKN = $D7 // W
+const INC_TKN = $C1 // A
+const DEC_TKN = $C4 // D
+//
+// Enclosure tokens
+//
+const OPEN_PAREN_TKN = $A8 // (
+const CLOSE_PAREN_TKN = $A9 // )
+const OPEN_BRACKET_TKN = $DB // [
+const CLOSE_BRACKET_TKN = $DD // ]
+//
+// Misc. tokens
+//
+const COMMA_TKN = $AC // ,
+//const COMMENT_TKN = $BB // //
+//
+// Keyword tokens
+//
+const CONST_TKN = $80
+const BYTE_TKN = $81
+const WORD_TKN = $82
+const IF_TKN = $83
+const ELSEIF_TKN = $84
+const ELSE_TKN = $85
+const FIN_TKN = $86
+const END_TKN = $87
+const WHILE_TKN = $88
+const LOOP_TKN = $89
+const CASE_TKN = $8A
+const OF_TKN = $8B
+const DEFAULT_TKN = $8C
+const ENDCASE_TKN = $8D
+const FOR_TKN = $8E
+const TO_TKN = $8F
+const DOWNTO_TKN = $90
+const STEP_TKN = $91
+const NEXT_TKN = $92
+const REPEAT_TKN = $93
+const UNTIL_TKN = $94
+const DEF_TKN = $95
+const STRUC_TKN = $96
+const DONE_TKN = $98
+const RETURN_TKN = $99
+const BREAK_TKN = $9A
+const CONT_TKN = $9B
+const EXIT_TKN = $9C
+const PREDEF_TKN = $9E
+//
+// Types
+//
+const CONST_TYPE = $01
+const BYTE_TYPE = $02
+const WORD_TYPE = $04
+const VAR_TYPE = $06 // (WORD_TYPE | BYTE_TYPE)
+const FUNC_TYPE = $08
+const FUNC_CONST_TYPE = $09
+const ADDR_TYPE = $0E // (VAR_TYPE | FUNC_TYPE)
+const LOCAL_TYPE = $10
+const BPTR_TYPE = $20
+const WPTR_TYPE = $40
+const PTR_TYPE = $60 // (BPTR_TYPE | WPTR_TYPE)
+const XBYTE_TYPE = $22 // (BPTR_TYPE | BYTE_TYPE)
+const XWORD_TYPE = $44 // (WPTR_TYPE | WORD_TYPE)
+const CONSTADDR_TYPE = $61 // (CONST_TYPE | PTR_TYPE)
+const STR_TYPE = $80
+//
+// Keywords
+//
+byte keywrds = "IF", IF_TKN
+byte = "TO", TO_TKN
+byte = "IS", OF_TKN
+byte = "OR", LOGIC_OR_TKN
+byte = "FOR", FOR_TKN
+byte = "FIN", FIN_TKN
+byte = "DEF", DEF_TKN
+byte = "END", END_TKN
+byte = "AND", LOGIC_AND_TKN
+byte = "NOT", LOGIC_NOT_TKN
+byte = "BYTE", BYTE_TKN
+byte = "WORD", WORD_TKN
+byte = "ELSE", ELSE_TKN
+byte = "NEXT", NEXT_TKN
+byte = "WHEN", CASE_TKN
+byte = "LOOP", LOOP_TKN
+byte = "STEP", STEP_TKN
+byte = "DONE", DONE_TKN
+byte = "WEND", ENDCASE_TKN
+byte = "CONST", CONST_TKN
+byte = "STRUC", STRUC_TKN
+byte = "ELSIF", ELSEIF_TKN
+byte = "WHILE", WHILE_TKN
+byte = "UNTIL", UNTIL_TKN
+byte = "BREAK", BREAK_TKN
+byte = "DOWNTO", DOWNTO_TKN
+byte = "REPEAT", REPEAT_TKN
+byte = "RETURN", RETURN_TKN
+byte = "PREDEF", PREDEF_TKN
+byte = "CONTINUE", CONT_TKN
+byte = "OTHERWISE",DEFAULT_TKN
+byte = $FF
+//
+// Mathematical ops
+//
+const bops_tblsz = 17 // minus 1
+byte[] bops_tbl // Highest precedence
+byte = MUL_TKN, DIV_TKN, MOD_TKN
+byte = ADD_TKN, SUB_TKN
+byte = SHR_TKN, SHL_TKN
+byte = AND_TKN
+byte = EOR_TKN
+byte = OR_TKN
+byte = GT_TKN, GE_TKN, LT_TKN, LE_TKN
+byte = EQ_TKN, NE_TKN
+byte = LOGIC_AND_TKN
+byte = LOGIC_OR_TKN
+ // Lowest precedence
+byte[] bops_prec // Highest precedence
+byte = 1, 1, 1
+byte = 2, 2
+byte = 3, 3
+byte = 4
+byte = 5
+byte = 6
+byte = 7, 7, 7, 7
+byte = 8, 8
+byte = 9
+byte = 10
+ // Lowest precedence
+byte[16] opstack
+byte[16] precstack
+word opsp = -1
+//
+// Symbol table variables
+//
+const idglobal_tblsz = 2048
+const idlocal_tblsz = 512
+const idglobal_tbl = $1600
+const idlocal_tbl = $1E00
+const ctag_max = 1024
+const ctag_tbl = $800
+const idval = 0
+const idtype = 2
+const idname = 3
+const idrecsz = 4
+word globals = 0
+word datasize = 0
+word lastglobal
+byte locals = 0
+word framesize = 0
+word lastlocal
+const IS_RESOLVED = $8000
+const IS_RELATIVE = $8000
+const IS_CTAG = $8000
+const MASK_CTAG = $7FFF
+word codetag = -1
+word codeptr, entrypoint = 0
+byte lastop = $FF
+//
+// Scanner variables
+//
+const inbuff = $0200
+const instr = $01FF
+word scanptr = @nullstr
+byte scanchr, token, tknlen
+byte parserrpos, parserr = 0
+word tknptr, parserrln
+word constval
+word lineno = 0
+//
+// Compiler output messages
+//
+//byte entrypt_str[] = "START: "
+byte bytes_compiled_str[] = "\nBYTES COMPILED: "
+//byte comp_ok_msg[] = "COMPILATION COMPLETE"
+byte dup_id[] = "DUPLICATE IDENTIFIER"
+byte undecl_id[] = "UNDECLARED IDENTIFIER"
+byte bad_cnst[] = "BAD CONSTANT"
+byte bad_struc[] = "BAD STRUCTURE"
+byte bad_offset[] = "BAD STRUCT OFFSET"
+byte bad_decl[] = "BAD DECLARATION"
+byte bad_op[] = "BAD OPERATION"
+byte bad_stmnt[] = "BAD STATMENT"
+byte bad_expr[] = "BAD EXPRESSION"
+byte bad_syntax[] = "BAD SYNTAX"
+byte estk_overflw[] = "EVAL STACK OVERFLOW"
+byte estk_underflw[] = "EVAL STACK UNDERFLOW"
+byte local_overflw[] = "LOCAL FRAME OVERFLOW"
+byte global_sym_overflw[] = "GLOBAL SYMBOL TABLE OVERFLOW"
+byte local_sym_overflw[] = "LOCAL SYMBOL TABLE OVERFLOW"
+byte ctag_full[] = "CODE LABEL OVERFLOW"
+byte no_ctag_offst[] = "CODE OFFSET NOT SUPPORTED"
+byte no_close_paren[] = "MISSING CLOSING PAREN"
+byte no_close_bracket[] = "MISSING CLOSING BRACKET"
+byte missing_op[] = "MISSING OPERAND"
+byte no_fin[] = "MISSING FIN"
+byte no_loop[] = "MISSING LOOP"
+byte no_until[] = "MISSING UNTIL"
+byte no_done[] = "MISSING DONE"
+byte no_local_init[] = "NO INITIALIZED LOCALS"
+//
+// Runtime functions
+//
+byte runtime0[] = "call"
+byte RUNTIME0[] = "CALL"
+byte runtime1[] = "syscall"
+byte RUNTIME1[] = "SYSCALL"
+byte runtime2[] = "memset"
+byte RUNTIME2[] = "MEMSET"
+byte runtime3[] = "memcpy"
+byte RUNTIME3[] = "MEMCPY"
+byte runtime4[] = "putc"
+byte RUNTIME4[] = "PUTC"
+byte runtime5[] = "getc"
+byte RUNTIME5[] = "GETC"
+byte runtime6[] = "puts"
+byte RUNTIME6[] = "PUTS"
+byte runtime7[] = "gets"
+byte RUNTIME7[] = "GETS"
+byte runtime8[] = "puti"
+byte RUNTIME8[] = "PUTI"
+byte runtime9[] = "home"
+byte RUNTIME9[] = "HOME"
+byte runtime10[] = "gotoxy"
+byte RUNTIME10[] = "GOTOXY"
+//
+// Parser variables
+//
+byte infunc = 0
+byte stack_loop = 0
+byte prevstmnt = 0
+word retfunc_tag = 0
+word break_tag = 0
+word cont_tag = 0
+predef parse_expr, parse_module
+//
+// ASM utility functions
+//
+// Defines for ASM routines
+//
+asm equates
+INTERP = $03D0
+LCRDEN = $C080
+LCWTEN = $C081
+ROMEN = $C082
+LCRWEN = $C083
+LCBNK2 = $00
+LCBNK1 = $08
+ !SOURCE "vmsrc/plvmzp.inc"
+end
+//
+// SAVE VM STATE
+//
+asm save_vmstate
+ LDA $03F2
+ STA VMRESET
+ LDA $03F3
+ STA VMRESET+1
+ LDA $03F4
+ STA VMRESET+2
+ LDA #<RESETENTRY
+ STA $03F2
+ LDA #>RESETENTRY
+ STA $03F3
+ EOR #$A5
+ STA $03F4
+ DEX
+ RTS
+end
+//
+// RESTORE VM STATE
+//
+asm restore_vmstate
+RESETENTRY
+ LDA VMRESET
+ STA $03F2
+ LDA VMRESET+1
+ STA $03F3
+ LDA VMRESET+2
+ STA $03F4
+ LDX #$00
+ STX IFPL
+ LDA #$BF
+ STA IFPH
+ LDX #$FE
+ TXS
+ LDX #ESTKSZ/2
+ BIT ROMEN
+ JMP $2000
+VMRESET !FILL 3
+end
+//
+// CALL 6502 ROUTINE
+// CALL(ADDR, AREG, XREG, YREG, STATUS)
+//
+asm call
+REGVALS = SRC
+ PHP
+ LDA ESTKL+4,X
+ STA TMPL
+ LDA ESTKH+4,X
+ STA TMPH
+ LDA ESTKL,X
+ PHA
+ LDA ESTKL+1,X
+ TAY
+ LDA ESTKL+3,X
+ PHA
+ LDA ESTKL+2,X
+ INX
+ INX
+ INX
+ INX
+ STX ESP
+ TAX
+ PLA
+ BIT ROMEN
+ PLP
+ JSR JMPTMP
+ PHP
+ BIT LCRDEN+LCBNK2
+ STA REGVALS+0
+ STX REGVALS+1
+ STY REGVALS+2
+ PLA
+ STA REGVALS+3
+ LDX ESP
+ LDA #<REGVALS
+ LDY #>REGVALS
+ STA ESTKL,X
+ STY ESTKH,X
+ PLP
+ RTS
+JMPTMP JMP (TMP)
+end
+//
+// CALL PRODOS
+// SYSCALL(CMD, PARAMS)
+//
+asm syscall
+ LDA ESTKL,X
+ LDY ESTKH,X
+ STA PARAMS
+ STY PARAMS+1
+ INX
+ LDA ESTKL,X
+ STA CMD
+ JSR $BF00
+CMD: !BYTE 00
+PARAMS: !WORD 0000
+ LDY #$00
+ STA ESTKL,X
+ STY ESTKH,X
+ RTS
+end
+// SET MEMORY TO VALUE
+// MEMSET(ADDR, SIZE, VALUE)
+// With optimizations from Peter Ferrie
+//
+asm memset
+ LDY #$00
+ LDA ESTKL+2,X
+ STA DSTL
+ LDA ESTKH+2,X
+ STA DSTH
+ INC ESTKL+1,X
+ INC ESTKH+1,X
+SETMLPL CLC
+ LDA ESTKL,X
+SETMLPH DEC ESTKL+1,X
+ BNE +
+ DEC ESTKH+1,X
+ BEQ SETMEX
++ STA (DST),Y
+ INY
+ BNE +
+ INC DSTH
++ BCS SETMLPL
+ SEC
+ LDA ESTKH,X
+ BCS SETMLPH
+SETMEX INX
+ INX
+ RTS
+end
+//
+// COPY MEMORY
+// MEMCPY(DSTADDR, SRCADDR, SIZE)
+//
+asm memcpy
+ INX
+ INX
+ LDA ESTKL-2,X
+ ORA ESTKH-2,X
+ BEQ CPYMEX
+ LDA ESTKL-1,X
+ CMP ESTKL,X
+ LDA ESTKH-1,X
+ SBC ESTKH,X
+ BCC REVCPY
+;
+; FORWARD COPY
+;
+ LDA ESTKL,X
+ STA DSTL
+ LDA ESTKH,X
+ STA DSTH
+ LDA ESTKL-1,X
+ STA SRCL
+ LDA ESTKH-1,X
+ STA SRCH
+ INC ESTKH-2,X
+ LDY #$00
+FORCPYLP LDA (SRC),Y
+ STA (DST),Y
+ INY
+ BNE +
+ INC DSTH
+ INC SRCH
++ DEC ESTKL-2,X
+ BNE FORCPYLP
+ DEC ESTKH-2,X
+ BNE FORCPYLP
+ RTS
+;
+; REVERSE COPY
+;
+REVCPY ;CLC
+ LDA ESTKL-2,X
+ ADC ESTKL,X
+ STA DSTL
+ LDA ESTKH-2,X
+ ADC ESTKH,X
+ STA DSTH
+ CLC
+ LDA ESTKL-2,X
+ ADC ESTKL-1,X
+ STA SRCL
+ LDA ESTKH-2,X
+ ADC ESTKH-1,X
+ STA SRCH
+ DEC DSTH
+ DEC SRCH
+ LDY #$FF
+ LDA ESTKL-2,X
+ BEQ REVCPYLP
+ INC ESTKH-2,X
+REVCPYLP LDA (SRC),Y
+ STA (DST),Y
+ DEY
+ CPY #$FF
+ BNE +
+ DEC DSTH
+ DEC SRCH
++ DEC ESTKL-2,X
+ BNE REVCPYLP
+ DEC ESTKH-2,X
+ BNE REVCPYLP
+CPYMEX RTS
+end
+//
+// CHAR OUT
+// COUT(CHAR)
+//
+asm cout
+ LDA ESTKL,X
+ BIT $BF98
+ BMI +
+ JSR TOUPR
++ ORA #$80
+ BIT ROMEN
+ JSR $FDED
+ BIT LCRDEN+LCBNK2
+ RTS
+end
+//
+// CHAR IN
+// RDKEY()
+//
+asm cin
+ BIT ROMEN
+ JSR $FD0C
+ BIT LCRDEN+LCBNK2
+ DEX
+ LDY #$00
+ AND #$7F
+ STA ESTKL,X
+ STY ESTKH,X
+ RTS
+end
+//
+// PRINT STRING
+// PRSTR(STR)
+//
+asm prstr
+ LDY #$00
+ LDA ESTKL,X
+ STA SRCL
+ LDA ESTKH,X
+ STA SRCH
+ LDA (SRC),Y
+ STA TMP
+ BEQ ++
+ BIT ROMEN
+- INY
+ LDA (SRC),Y
+ BIT $BF98
+ BMI +
+ JSR TOUPR
++ ORA #$80
+ JSR $FDED
+ CPY TMP
+ BNE -
+ BIT LCRDEN+LCBNK2
+++ RTS
+end
+//
+// READ STRING
+// STR = RDSTR(PROMPTCHAR)
+//
+asm rdstr
+ LDA ESTKL,X
+ STA $33
+ STX ESP
+ BIT ROMEN
+ JSR $FD6A
+ BIT LCRDEN+LCBNK2
+ STX $01FF
+- LDA $01FF,X
+ AND #$7F
+ STA $01FF,X
+ DEX
+ BPL -
+ LDX ESP
+ LDA #$FF
+ STA ESTKL,X
+ LDA #$01
+ STA ESTKH,X
+ RTS
+end
+//
+// EXIT
+//
+asm exit
+ JSR $BF00
+ !BYTE $65
+ !WORD EXITTBL
+EXITTBL:
+ !BYTE 4
+ !BYTE 0
+end
+//def toupper_11(c)
+// if c >= 'a'
+// if c <= 'z'
+// return c - $20
+// fin
+// fin
+// return c
+//end
+asm toupper
+ LDA ESTKL,X
+TOUPR AND #$7F
+ CMP #'z'+1
+ BCS +
+ CMP #'a'
+ BCC +
+ SBC #$20
++ STA ESTKL,X
+ RTS
+end
+asm clrhibit(strptr)
+ LDA ESTKL,X
+ STA SRCL
+ LDA ESTKH,X
+ STA SRCH
+ LDY #$00
+ LDA (SRC),Y
+ BEQ +
+ TAY
+CLHILP LDA (SRC),Y
+ AND #$7F
+ STA (SRC),Y
+ DEY
+ BNE CLHILP
++ RTS
+end
+asm sethibit(strptr)
+ LDA ESTKL,X
+ STA SRCL
+ LDA ESTKH,X
+ STA SRCH
+ LDY #$00
+ LDA (SRC),Y
+ BEQ +
+ TAY
+STHILP LDA (SRC),Y
+ ORA #$80
+ STA (SRC),Y
+ DEY
+ BNE STHILP
++ RTS
+end
+asm cpyln(srcstr, dststr)
+ LDA ESTKL,X
+ STA DSTL
+ LDA ESTKH,X
+ STA DSTH
+ INX
+ LDA ESTKL,X
+ STA SRCL
+ LDA ESTKH,X
+ STA SRCH
+ LDY #$00
+ LDA (SRC),Y
+ TAY
+ LDA #$00
+ INY
+ STA (DST),Y
+ DEY
+ BEQ ++
+CPLNLP LDA (SRC),Y
+ CMP #$20
+ BCS +
+ ADC #$60
++ AND #$7F
+ STA (DST),Y
+ DEY
+ BNE CPLNLP
+ LDA (SRC),Y
+++ STA (DST),Y
+ RTS
+end
+//
+//def skipspace(scanptr)
+// while ^scanptr == ' '
+// scanptr = scanptr + 1
+// loop
+// return scanptr
+//end
+asm skipspace(scanptr)
+ LDA #$00
+ STA SRCL
+ LDA ESTKH,X
+ STA SRCH
+ LDY ESTKL,X
+- LDA (SRC),Y
+ CMP #' '
+ BNE +
+ INY
+ BNE -
+ INC SRCH
+ BNE -
++ STY ESTKL,X
+ LDA SRCH
+ STA ESTKH,X
+ RTS
+end
+//def isalpha(c)
+// if c >= 'A' and c <= 'Z'
+// return TRUE
+// elsif c >= 'a' and c <= 'z'
+// return TRUE
+// elsif c == '_'
+// return TRUE
+// fin
+// return FALSE
+//end
+asm isalpha
+ LDY #$00
+ LDA ESTKL,X
+ CMP #'_'
+ BEQ ISALTRU
+ CMP #'A'
+ BCC ISALRET
+ CMP #'Z'+1
+ BCC ISALTRU
+ CMP #'a'
+ BCC ISALRET
+ CMP #'z'+1
+ BCS ISALRET
+ISALTRU DEY
+ISALRET STY ESTKL,X
+ STY ESTKH,X
+ RTS
+end
+//def isnum(c)
+// if c >= '0' and c <= '9'
+// return TRUE
+// fin
+// return FALSE
+//end
+asm isnum
+ LDY #$00
+ LDA ESTKL,X
+ CMP #'0'
+ BCC +
+ CMP #'9'+1
+ BCS +
+ DEY
++ STY ESTKL,X
+ STY ESTKH,X
+ RTS
+end
+//def isalphanum(c)
+// if c >= 'A' and c <= 'Z'
+// return TRUE
+// elsif c >= '0' and c <= '9'
+// return TRUE
+// elsif c >= 'a' and c <= 'z'
+// return TRUE
+// elsif c == '_'
+// return TRUE
+// fin
+// return FALSE
+//end
+asm isalphanum
+ LDY #$00
+ LDA ESTKL,X
+ CMP #'_'
+ BEQ ISANTRU
+ CMP #'0'
+ BCC ISANRET
+ CMP #'9'+1
+ BCC ISANTRU
+ CMP #'A'
+ BCC ISANRET
+ CMP #'Z'+1
+ BCC ISANTRU
+ CMP #'a'
+ BCC ISANRET
+ CMP #'z'+1
+ BCS ISANRET
+ISANTRU DEY
+ISANRET STY ESTKL,X
+ STY ESTKH,X
+ RTS
+end
+//
+// Runtime routines
+//
+def home
+ return call($FC58, 0, 0, 0, 0)
+end
+def gotoxy(x, y)
+ ^$24 = x + ^$20
+ return call($FB5B, y + ^$22, 0, 0, 0)
+end
+//
+// ProDOS routines
+//
+def getpfx(path)
+ byte params[3]
+
+ ^path = 0
+ params.0 = 1
+ params:1 = path
+ perr = syscall($C7, @params)
+ return path
+end
+def setpfx(path)
+ byte params[3]
+
+ params.0 = 1
+ params:1 = path
+ perr = syscall($C6, @params)
+ return path
+end
+def open(path, buff)
+ byte params[6]
+
+ params.0 = 3
+ params:1 = path
+ params:3 = buff
+ params.5 = 0
+ perr = syscall($C8, @params)
+ return params.5
+end
+def close(refnum)
+ byte params[2]
+
+ params.0 = 1
+ params.1 = refnum
+ perr = syscall($CC, @params)
+ return perr
+end
+def read(refnum, buff, len)
+ byte params[8]
+
+ params.0 = 4
+ params.1 = refnum
+ params:2 = buff
+ params:4 = len
+ params:6 = 0
+ perr = syscall($CA, @params)
+ return params:6
+end
+def write(refnum, buff, len)
+ byte params[8]
+
+ params.0 = 4
+ params.1 = refnum
+ params:2 = buff
+ params:4 = len
+ params:6 = 0
+ perr = syscall($CB, @params)
+ return params:6
+end
+def create(path, access, type, aux)
+ byte params[12]
+
+ params.0 = 7
+ params:1 = path
+ params.3 = access
+ params.4 = type
+ params:5 = aux
+ params.7 = $1
+ params:8 = 0
+ params:10 = 0
+ perr = syscall($C0, @params)
+ return perr
+end
+def destroy(path)
+ byte params[12]
+
+ params.0 = 1
+ params:1 = path
+ perr = syscall($C1, @params)
+ return perr
+end
+def newline(refnum, emask, nlchar)
+ byte params[4]
+
+ params.0 = 3
+ params.1 = refnum
+ params.2 = emask
+ params.3 = nlchar
+ perr = syscall($C9, @params)
+ return perr
+end
+
+//=====================================
+//
+// Editor
+//
+//=====================================
+
+def crout
+ cout($0D)
+end
+def bell
+ return call($FBDD, 0, 0, 0, 0)
+end
+//
+// Memory management routines
+//
+def heapaddr(ofst, mask)
+ word addr
+
+ addr = (ofst << 7) + strheap
+ while !(mask & 1)
+ addr = addr + 16
+ mask = mask >> 1
+ loop
+ return addr
+end
+def sizemask(size)
+ if size <= 16
+ return $01
+ elsif size <= 32
+ return $03
+ elsif size <= 48
+ return $07
+ elsif size <= 64
+ return $0F
+ elsif size <= 80
+ return $1F
+ fin
+ return 0
+end
+def heapalloc(size)
+ byte szmask, i
+ word mapmask
+
+ szmask = sizemask(size)
+ for i = strheapmsz - 1 downto 0
+ if strheapmap.[i] <> $FF
+ mapmask = szmask
+ repeat
+ if strheapmap.[i] & mapmask
+ mapmask = mapmask << 1
+ else
+ strheapmap.[i] = strheapmap.[i] | mapmask
+ return heapaddr(i, mapmask)
+ fin
+ until mapmask & $100
+ fin
+ next
+ bell()
+ prstr(@outofmem)
+ return 0
+end
+//
+// Tokenizer
+//
+def keymatch(tknptr, tknlen)
+ byte i, keypos
+ word chrptr
+
+ keypos = 0
+ while keywrds[keypos] < tknlen
+ keypos = keypos + keywrds[keypos] + 2
+ loop
+ chrptr = tknptr - 1
+ while keywrds[keypos] == tknlen
+ for i = 1 to tknlen
+ if toupper(^(chrptr + i)) <> keywrds[keypos + i]
+ break
+ fin
+ next
+ if i > tknlen
+ return keywrds[keypos + keywrds[keypos] + 1]
+ fin
+ keypos = keypos + keywrds[keypos] + 2
+ loop
+ return ID_TKN
+end
+def strtotkn(str, strlen)
+ word charptr, tknptr, strptr
+ byte[128] tknize
+
+ //
+ // Skip whitespace
+ //
+ charptr = skipspace(str)
+ tknptr = @tknize.1
+ //
+ // Save indentation amount
+ //
+ ^tknptr = charptr - str
+ //
+ // Beginning of token.
+ //
+ strptr = charptr
+ while (charptr - str) < strlen
+ //
+ // Scan for token based on first character
+ //
+ tknlen = 1
+ if isalpha(^charptr)
+ //
+ // ID, either variable name or reserved word
+ //
+ repeat
+ charptr = charptr + 1
+ until !isalphanum(^charptr)
+ tknlen = charptr - strptr
+ token = keymatch(strptr, tknlen)
+ if token == ID_TKN
+ //
+ // Copy ID string to tokenized stream
+ //
+ ^(tknptr + 1) = tknlen
+ while strptr < charptr
+ ^(tknptr = ^strptr
+ strptr = strptr + 1
+ loop
+ fin
+ elsif isnum(scanchr)
+ //
+ // Decimal constant
+ //
+ constval = 0
+ repeat
+ constval = constval * 10 + ^scanptr - '0'
+ scanptr = scanptr + 1
+ until !isnum(^scanptr)
+ //
+ // Copy constant value to tokenized stream
+ //
+ token = INT_TKN
+ *(tknptr + 1) = constval
+ tknlen = 3
+ else
+ //
+ // Potential multiple character tokens
+ //
+ when charptr
+ is '/'
+ if ^(charptr + 1) == '/'
+ token = COMMENT_TKN
+ charptr = charptr + 2
+ //
+ // Copy comment string to tokenized stream
+ //
+ while (charptr - strptr) < strlen
+ ^(tknptr + tknlen + 2) = ^charptr
+ strptr = strptr + 1
+ tknlen = tknlen + 1
+ loop
+ ^(tknptr + 1) = tknlen
+ else
+ token = DIV_TKN
+ fin
+ break
+ is '='
+ if ^(charptr + 1) == '='
+ token = EQ_TKN
+ charptr = charptr + 2
+ elsif ^(charptr + 1) == '>'
+ token = PTRW_TKN
+ charptr = charptr + 2
+ else
+ token = SET_TKN
+ charptr = charptr + 1
+ fin
+ break
+ is '-'
+ if ^(charptr + 1) == '>'
+ token = PTRB_TKN
+ charptr = charptr + 2
+ else
+ token = SUB_TKN
+ charptr = charptr + 1
+ fin
+ break
+ is '>'
+ if ^(charptr + 1) == '>'
+ token = SHR_TKN
+ charptr = charptr + 2
+ elsif ^(charptr + 1) == '='
+ token = GE_TKN
+ charptr = charptr + 2
+ else
+ token = GT_TKN
+ charptr = charptr + 1
+ fin
+ break
+ is '<'
+ if ^(charptr + 1) == '<'
+ token = SHL_TKN
+ charptr = charptr + 2
+ elsif ^(charptr + 1) == '='
+ token = LE_TKN
+ charptr = charptr + 2
+ elsif ^(charptr + 1) == '>'
+ token = NE_TKN
+ charptr = charptr + 2
+ else
+ token = LT_TKN
+ charptr = charptr + 1
+ fin
+ break
+ is '$'
+ //
+ // Hexadecimal constant
+ //
+ token = HEX_TKN
+ tknlen = 3
+ constval = 0
+ repeat
+ charptr = charptr + 1
+ if ^charptr >= '0' and ^charptr <= '9'
+ constval = (constval << 4) + ^charptr - '0'
+ elsif ^charptr >= 'A' and ^charptr <= 'F'
+ constval = (constval << 4) + ^charptr - '7'// 'A'-10
+ elsif ^charptr >= 'a' and ^charptr <= 'f'
+ constval = (constval << 4) + ^charptr - 'W'// 'a'-10
+ else
+ *(tknptr + 1) = constval
+ break
+ fin
+ until !^charptr
+ *(tknptr + 1) = constval
+ break
+ is $27 // '
+ //
+ // Character constant
+ //
+ token = CHR_TKN
+ if ^(charptr + 1) <> $5C // \
+ constval = ^(charptr + 1)
+ if ^(charptr + 2) <> $27 // '
+ return parse_err(@bad_cnst)
+ fin
+ charptr = charptr + 3
+ else
+ when ^(charptr + 2)
+ is 'n'
+ constval = $0D; break
+ is 'r'
+ constval = $0A; break
+ is 't'
+ constval = $09; break
+ otherwise
+ constval = ^(charptr + 2)
+ wend
+ if ^(charptr + 3) <> $27 // '
+ return parse_err(@bad_cnst)
+ fin
+ charptr = charptr + 4
+ fin
+ ^(tknptr + 1 = constval
+ tknlen = 2
+ break
+ is '"'
+ //
+ // String constant
+ //
+ token = STR_TKN
+ charptr = charptr + 1
+ constval = scanptr
+ while ^charptr and ^charptr <> '"'
+ charptr = charptr + 1
+ loop
+ if !^charptr
+ return parse_err(@bad_cnst)
+ fin
+ charptr = charptr + 1
+ break
+ is 0
+ is ';'
+ if token <> EOF_TKN
+ token = EOL_TKN
+ fin
+ break
+ otherwise
+ //
+ // Simple single character tokens
+ //
+ token = scanchr | $80
+ charptr = charptr + 1
+ wend
+ fin
+ ^tknptr = token
+ tknptr = tknptr + tknlen
+ loop
+ return token
+end
+def tkntostr(tknptr, strptr)
+ byte strlen
+
+ return strlen
+end
+//
+// String utilities
+//
+def freestr(strptr)
+ byte mask, ofst
+
+ if strptr and strptr <> @nullstr
+ mask = sizemask(^strptr + 1)
+ ofst = (strptr - strheap) >> 4
+ mask = mask << (ofst & $07)
+ ofst = ofst >> 3
+ strheapmap.[ofst] = strheapmap.[ofst] & ~mask
+ fin
+end
+def newstr(strptr)
+ byte strlen
+ word newptr
+
+ strlen = ^strptr
+ while ^(strptr + strlen) == $8D or ^(strptr + strlen) == $A0
+ strlen = strlen - 1
+ loop
+ if strlen == 0
+ return @nullstr
+ fin
+ newptr = heapalloc(strlen + 1)
+ if newptr
+ memcpy(newptr, strptr, strlen + 1)
+ ^newptr = strlen
+ return newptr
+ fin
+ return @nullstr
+end
+def strcpy(dststr, srcstr)
+ byte strlen
+
+ strlen = ^srcstr
+ while ^(srcstr + strlen) == $8D or ^(srcstr + strlen) == $A0
+ strlen = strlen - 1
+ loop
+ ^dststr = strlen
+ memcpy(dststr + 1, srcstr + 1, strlen)
+end
+def inittxtbuf
+ word i
+
+ memset(strheapmap, strheapmsz, 0)
+ memset(strlinbuf, maxfill * 2, @nullstr)
+ numlines = 1
+ cursrow = 0
+ curscol = 0
+ cursx = 0
+ cursy = 0
+ scrnleft = 0
+ scrntop = 0
+ cutbuf = 0
+end
+//
+// Case conversion/printing routines
+//
+def caseconv(chr)
+ if flags & uppercase
+ if chr & $E0 == $E0
+ chr = chr - $E0
+ fin
+ fin
+ return chr
+end
+def strupper(strptr)
+ byte i, chr
+
+ for i = ^strptr downto 1
+ chr = ^(strptr + i)
+ if chr & $E0 == $E0
+ ^(strptr + i) = chr - $E0
+ fin
+ next
+end
+def strlower(strptr)
+ byte i, chr
+
+ for i = ^strptr downto 1
+ chr = ^(strptr + i)
+ if chr & $E0 == $00
+ ^(strptr + i) = chr + $E0
+ fin
+ next
+end
+def txtupper
+ word i, strptr
+
+ flags = flags | uppercase
+ for i = numlines - 1 downto 0
+ strupper(strlinbuf:[i])
+ next
+end
+def txtlower
+ word i, strptr
+
+ flags = flags & ~uppercase
+ for i = numlines - 1 downto 0
+ strlower(strlinbuf:[i])
+ next
+end
+def prbyte(h)
+ cout('$')
+ return call($FDDA, h, 0, 0, 0)
+end
+def prword(h)
+ cout('$')
+ return call($F941, h >> 8, h, 0, 0)
+end
+def print(i)
+ byte numstr[7]
+ byte place, sign
+
+ place = 6
+ if i < 0
+ sign = 1
+ i = -i
+ else
+ sign = 0
+ fin
+ while i >= 10
+ numstr[place] = i % 10 + '0'
+ i = i / 10
+ place = place - 1
+ loop
+ numstr[place] = i + '0'
+ place = place - 1
+ if sign
+ numstr[place] = '-'
+ place = place - 1
+ fin
+ numstr[place] = 6 - place
+ return prstr(@numstr[place])
+end
+def nametostr(namestr, len, strptr)
+ ^strptr = len
+ return memcpy(strptr + 1, namestr, len)
+end
+//
+// File routines
+//
+def readtxt(filename)
+ byte txtbuf[81], refnum, i, j
+
+ refnum = open(filename, iobuffer)
+ if refnum
+ newline(refnum, $7F, $0D)
+ repeat
+ txtbuf = read(refnum, @txtbuf + 1, maxlnlen)
+ if txtbuf
+ sethibit(@txtbuf)
+ if flags & uppercase; strupper(@txtbuf); fin
+ strlinbuf:[numlines] = newstr(@txtbuf)
+ numlines = numlines + 1
+ fin
+ if !(numlines & $0F); cout('.'); fin
+ until txtbuf == 0 or numlines == maxlines
+ close(refnum)
+ //
+ // Make sure there is a blank line at the end of the buffer
+ //
+ if numlines < maxlines and strlinbuf:[numlines - 1] <> @nullstr
+ strlinbuf:[numlines] = @nullstr
+ numlines = numlines + 1
+ fin
+ fin
+end
+def writetxt(filename)
+ byte txtbuf[81], refnum
+ byte j, chr
+ word i, strptr
+
+ destroy(filename)
+ create(filename, $C3, $04, $00) // full access, TXT file
+ refnum = open(filename, iobuffer)
+ if refnum == 0
+ return
+ fin
+ //
+ // Remove blank lines at end of text.
+ //
+ while numlines > 1 and strlinbuf:[numlines - 1] == @nullstr; numlines = numlines - 1; loop
+ //
+ // Write all the text line to the file.
+ //
+ for i = 0 to numlines - 1
+ cpyln(strlinbuf:[i], @txtbuf)
+ txtbuf = txtbuf + 1
+ txtbuf[txtbuf] = $0D
+ write(refnum, @txtbuf + 1, txtbuf)
+ if !(i & $0F); cout('.'); fin
+ next
+ return close(refnum)
+end
+//
+// Screen routines
+//
+def clrscrn
+ return call($FC58, 0, 0, 0, 0)
+end
+def drawrow(row, ofst, strptr)
+ byte numchars
+ word scrnptr
+
+ scrnptr = txtscrn[row]
+ if ofst >= ^strptr
+ numchars = 0
+ else
+ numchars = ^strptr - ofst
+ fin
+ if numchars >= 40
+ numchars = 40
+ else
+ memset(scrnptr + numchars, 40 - numchars, $A0A0)
+ fin
+ return memcpy(scrnptr, strptr + ofst + 1, numchars)
+end
+def drawscrn(toprow, ofst)
+ byte row, numchars
+ word strptr, scrnptr
+
+ for row = 0 to 23
+ strptr = strlinbuf:[toprow + row]
+ scrnptr = txtscrn[row]
+ if ofst >= ^strptr
+ numchars = 0
+ else
+ numchars = ^strptr - ofst
+ fin
+ if numchars >= 40
+ numchars = 40
+ else
+ memset(scrnptr + numchars, 40 - numchars, $A0A0)
+ fin
+ memcpy(scrnptr, strptr + ofst + 1, numchars)
+ next
+end
+def cursoff
+ if flags & showcurs
+ ^cursptr = underchr
+ flags = flags & ~showcurs
+ fin
+end
+def curson
+ if !(flags & showcurs)
+ cursptr = txtscrn[cursy] + cursx
+ underchr = ^cursptr
+ ^cursptr = curschr
+ flags = flags | showcurs
+ fin
+end
+def cursflash
+ if flags & showcurs
+ if flash == 0
+ ^cursptr = curschr
+ elsif flash == 128
+ ^cursptr = underchr
+ fin
+ flash = flash + 1
+ fin
+end
+def redraw
+ cursoff
+ drawscrn(scrntop, scrnleft)
+ curson
+end
+def curshome
+ cursoff
+ cursrow = 0
+ curscol = 0
+ cursx = 0
+ cursy = 0
+ scrnleft = 0
+ scrntop = 0
+ drawscrn(scrntop, scrnleft)
+ return curson
+end
+def cursend
+ cursoff
+ if numlines > 23
+ cursrow = numlines - 1
+ cursy = 23
+ scrntop = cursrow - 23
+ else
+ cursrow = numlines - 1
+ cursy = numlines - 1
+ scrntop = 0
+ fin
+ curscol = 0
+ cursx = 0
+ scrnleft = 0
+ drawscrn(scrntop, scrnleft)
+ return curson
+end
+def cursup
+ if cursrow > 0
+ cursoff
+ cursrow = cursrow - 1
+ if cursy > 0
+ cursy = cursy - 1
+ else
+ scrntop = cursrow
+ drawscrn(scrntop, scrnleft)
+ fin
+ curson
+ fin
+end
+def pgup
+ byte i
+
+ for i = pgjmp downto 0
+ cursup
+ next
+end
+def cursdown
+ if cursrow < numlines - 1
+ cursoff
+ cursrow = cursrow + 1
+ if cursy < 23
+ cursy = cursy + 1
+ else
+ scrntop = cursrow - 23
+ drawscrn(scrntop, scrnleft)
+ fin
+ curson
+ fin
+end
+def pgdown
+ byte i
+
+ for i = pgjmp downto 0
+ cursdown
+ next
+end
+def cursleft
+ if curscol > 0
+ cursoff
+ curscol = curscol - 1
+ if cursx > 0
+ cursx = cursx - 1
+ else
+ scrnleft = curscol
+ drawscrn(scrntop, scrnleft)
+ fin
+ curson
+ fin
+end
+def pgleft
+ byte i
+
+ for i = 7 downto 0
+ cursleft
+ next
+end
+def cursright
+ if curscol < 80
+ cursoff
+ curscol = curscol + 1
+ if cursx < 39
+ cursx = cursx + 1
+ else
+ scrnleft = curscol - 39
+ drawscrn(scrntop, scrnleft)
+ fin
+ curson
+ fin
+end
+def pgright
+ byte i
+
+ for i = 7 downto 0
+ cursright
+ next
+end
+//
+// Keyboard routines
+//
+def keyin2e
+ byte key
+ repeat
+ cursflash
+ until ^keyboard >= 128
+ key = ^keystrobe
+ if ^$C062 & 128 // Closed Apple pressed
+ when key
+ is keyarrowleft
+ key = keyctrla
+ break
+ is keyarrowright
+ key = keyctrls
+ break
+ is keyarrowup
+ key = keyctrlw
+ break
+ is keyarrowdown
+ key = keyctrlz
+ break
+ is keyenter
+ key = keyctrlo
+ break
+ wend
+ fin
+ return key
+end
+def keyin2
+ byte key
+
+ repeat
+ cursflash
+ key = ^keyboard
+ if key == keyctrll
+ ^keystrobe
+ flags = flags ^ shiftlock
+ key = 0
+ fin
+ until key >= 128
+ ^keystrobe
+ if key == keyctrln
+ key = $DB // [
+ elsif key == keyctrlp
+ key = $DF // _
+ elsif key == keyctrlb
+ key = $FC // |
+ elsif key == keyctrly
+ key = $FE // ~
+ elsif key == keyarrowleft
+ if ^pushbttn3 < 128
+ key = $FF
+ fin
+ elsif key >= $C0 and flags < shiftlock
+ if ^pushbttn3 < 128
+ if key == $C0
+ key = $D0 // P
+ elsif key == $DD
+ key = $CD // M
+ elsif key == $DE
+ key = $CE // N
+ fin
+ else
+ key = key | $E0
+ fin
+ fin
+ return key
+end
+//
+// Printer routines
+//
+def printtxt(slot)
+ byte txtbuf[80]
+ word i, scrncsw
+
+ scrncsw = *(csw)
+ *(csw) = $C000 | (slot << 8)
+ for i = 0 to numlines - 1
+ cpyln(strlinbuf:[i], @txtbuf)
+ prstr(@txtbuf)
+ crout
+ next
+ *(csw) = scrncsw
+end
+def openline(row)
+ if numlines < maxlines
+ memcpy(@strlinbuf:[row + 1], @strlinbuf:[row], (numlines - row) * 2)
+ strlinbuf:[row] = @nullstr
+ numlines = numlines + 1
+ flags = flags | changed
+ return 1
+ fin
+ bell
+ return 0
+end
+def cutline
+ freestr(cutbuf)
+ cutbuf = strlinbuf:[cursrow]
+ memcpy(@strlinbuf:[cursrow], @strlinbuf:[cursrow + 1], (numlines - cursrow) * 2)
+ if numlines > 1
+ numlines = numlines - 1
+ fin
+ flags = flags | changed
+ if cursrow == numlines
+ cursup
+ fin
+ return redraw
+end
+def pasteline
+ if cutbuf and numlines < maxlines
+ memcpy(@strlinbuf:[cursrow + 1], @strlinbuf:[cursrow], (numlines - cursrow) * 2)
+ strlinbuf:[cursrow] = newstr(cutbuf)
+ numlines = numlines + 1
+ flags = flags | changed
+ redraw
+ else
+ bell
+ fin
+end
+def joinline
+ byte joinstr[80], joinlen
+
+ if cursrow < numlines - 1
+ strcpy(@joinstr, strlinbuf:[cursrow])
+ joinlen = joinstr + ^(strlinbuf:[cursrow + 1])
+ if joinlen < 80
+ memcpy(@joinstr + joinstr + 1, strlinbuf:[cursrow + 1] + 1, ^(strlinbuf:[cursrow + 1]))
+ joinstr = joinlen
+ freestr(strlinbuf:[cursrow])
+ strlinbuf:[cursrow] = newstr(@joinstr)
+ freestr(strlinbuf:[cursrow + 1])
+ numlines = numlines - 1
+ memcpy(@strlinbuf:[cursrow + 1], @strlinbuf:[cursrow + 2], (numlines - cursrow) * 2)
+ flags = flags | changed
+ redraw
+ else
+ bell
+ fin
+ fin
+end
+def splitline
+ byte splitstr[80], splitlen
+
+ if openline(cursrow + 1)
+ if curscol
+ splitlen = ^(strlinbuf:[cursrow])
+ if curscol < splitlen - 1
+ memcpy(@splitstr + 1, strlinbuf:[cursrow] + curscol + 1, splitlen - curscol)
+ splitstr = splitlen - curscol
+ strlinbuf:[cursrow + 1] = newstr(@splitstr)
+ memcpy(@splitstr + 1, strlinbuf:[cursrow] + 1, curscol)
+ splitstr = curscol
+ freestr(strlinbuf:[cursrow])
+ strlinbuf:[cursrow] = newstr(@splitstr)
+ fin
+ else
+ strlinbuf:[cursrow + 1] = strlinbuf:[cursrow]
+ strlinbuf:[cursrow] = @nullstr
+ fin
+ curscol = 0
+ cursx = 0
+ scrnleft = 0
+ redraw
+ cursdown
+ fin
+end
+def editkey(key)
+ if key >= keyspace
+ return TRUE
+ elsif key == keydelete
+ return TRUE
+ elsif key == keyctrld
+ return TRUE
+ elsif key == keyctrlr
+ return TRUE
+ fin
+ return FALSE
+end
+def editline(key)
+ byte editstr[80]
+ word undoline
+
+ if (editkey(key))
+ flags = flags | changed
+ memset(@editstr, 80, $A0A0)
+ strcpy(@editstr, strlinbuf:[cursrow])
+ undoline = strlinbuf:[cursrow]
+ strlinbuf:[cursrow] = @editstr
+ repeat
+ if key >= keyspace
+ if key == keydelete
+ if curscol > 0
+ if curscol <= editstr
+ memcpy(@editstr[curscol], @editstr[curscol + 1], editstr - curscol)
+ editstr = editstr - 1
+ fin
+ curscol = curscol - 1
+ cursoff
+ if cursx > 0
+ cursx = cursx - 1
+ drawrow(cursy, scrnleft, @editstr)
+ else
+ scrnleft = scrnleft - 1
+ drawscrn(scrntop, scrnleft)
+ fin
+ curson
+ fin
+ elsif curscol < maxlnlen
+ curscol = curscol + 1
+ cursx = cursx + 1
+ if flags & insmode
+ if editstr < maxlnlen or editstr.maxlnlen == $A0
+ editstr = editstr + 1
+ if curscol >= editstr
+ editstr = curscol
+ else
+ memcpy(@editstr[curscol + 1], @editstr[curscol], editstr - curscol)
+ fin
+ else
+ curscol = curscol - 1
+ cursx = cursx - 1
+ key = editstr[curscol]
+ bell
+ fin
+ else
+ if curscol > editstr
+ editstr = curscol
+ fin
+ fin
+ editstr[curscol] = caseconv(key)
+ cursoff
+ if cursx <= 39
+ drawrow(cursy, scrnleft, @editstr)
+ else
+ scrnleft = scrnleft + 1
+ cursx = 39
+ drawscrn(scrntop, scrnleft)
+ fin
+ curson
+ else
+ bell
+ fin
+ elsif key == keyctrld
+ if curscol < editstr
+ strcpy(undoline, @editstr)
+ memcpy(@editstr[curscol + 1], @editstr[curscol + 2], editstr - curscol)
+ editstr = editstr - 1
+ cursoff
+ drawrow(cursy, scrnleft, @editstr)
+ curson
+ fin
+ elsif key == keyctrlr
+ strcpy(@editstr, undoline)
+ cursoff
+ drawrow(cursy, scrnleft, @editstr)
+ curson
+ fin
+ key = keyin()
+ until not editkey(key)
+ if editstr
+ strlinbuf:[cursrow] = newstr(@editstr)
+ else
+ strlinbuf:[cursrow] = @nullstr
+ fin
+ freestr(undoline)
+ fin
+ return key
+end
+def editmode
+ repeat
+ when editline(keyin())
+ is keyarrowup
+ cursup; break
+ is keyarrowdown
+ cursdown; break
+ is keyarrowleft
+ cursleft; break
+ is keyarrowright
+ cursright; break
+ is keyctrlw
+ pgup; break
+ is keyctrlz
+ pgdown; break
+ is keyctrla
+ pgleft; break
+ is keyctrls
+ pgright; break
+ is keyctrlq
+ curshome; break
+ is keyctrle
+ cursend; break
+ is keyctrlx
+ cutline; break
+ is keyctrlv
+ pasteline; break
+ is keyctrlf
+ if numlines < maxlines and cursrow == numlines - 1
+ strlinbuf:[numlines] = @nullstr
+ numlines = numlines + 1
+ fin
+ cursdown
+ is keyctrlo
+ openline(cursrow)
+ curscol = 0
+ cursx = 0
+ scrnleft = 0
+ redraw
+ break
+ is keyenter
+ if flags & insmode
+ splitline
+ else
+ openline(cursrow + 1)
+ cursdown
+ redraw
+ fin
+ break
+ is keyctrlt
+ joinline; break
+ is keyctrli
+ if flags & insmode
+ flags = flags & ~insmode
+ curschr = ' '
+ else
+ flags = flags | insmode
+ curschr = '+'
+ fin
+ break
+ is keyctrlc
+ if flags & uppercase
+ txtlower
+ else
+ txtupper
+ fin
+ redraw
+ break
+ is keyescape
+ cursoff
+ cmdmode(TRUE)
+ redraw
+ break
+ wend
+ until FALSE
+end
+//
+// Command mode
+//
+def prfiles(optpath)
+ byte path[64]
+ byte refnum
+ byte firstblk
+ byte entrylen, entriesblk
+ byte i, type, len
+ word entry, filecnt
+
+ if ^optpath
+ strcpy(@path, optpath)
+ else
+ getpfx(@path)
+ prstr(@path)
+ crout
+ fin
+ refnum = open(@path, iobuffer)
+ if perr
+ return perr
+ fin
+ firstblk = 1
+ repeat
+ if read(refnum, databuff, 512) == 512
+ entry = databuff + 4
+ if firstblk
+ entrylen = databuff.$23
+ entriesblk = databuff.$24
+ filecnt = databuff:$25
+ entry = entry + entrylen
+ fin
+ for i = firstblk to entriesblk
+ type = ^entry
+ if type <> 0
+ len = type & $0F
+ ^entry = len
+ prstr(entry)
+ if type & $F0 == $D0 // Is it a directory?
+ cout('/')
+ len = len + 1
+ fin
+ for len = 20 - len downto 1
+ cout(' ')
+ next
+ filecnt = filecnt - 1
+ fin
+ entry = entry + entrylen
+ next
+ firstblk = 0
+ else
+ filecnt = 0
+ fin
+ until filecnt == 0
+ close(refnum)
+ crout
+ return 0
+end
+def striplead(strptr, chr)
+ while ^strptr and ^(strptr + 1) == chr
+ memcpy(strptr + 1, strptr + 2, ^strptr)
+ ^strptr = ^strptr - 1
+ loop
+end
+def parsecmd(strptr)
+ byte cmd
+
+ cmd = 0
+ striplead(strptr, ' ')
+ if ^strptr
+ cmd = ^(strptr + 1)
+ memcpy(strptr + 1, strptr + 2, ^strptr)
+ ^strptr = ^strptr - 1
+ fin
+ if ^strptr
+ striplead(strptr, ' ')
+ fin
+ return cmd
+end
+def chkchng
+ if flags & changed
+ prstr(@losechng)
+ if toupper(keyin()) == 'N'
+ crout
+ return FALSE
+ fin
+ crout
+ fin
+ return TRUE
+end
+def quit
+ if chkchng
+ exit
+ fin
+end
+def cmdmode(clearscr)
+ byte slot
+ word cmdptr
+
+ if (clearscr)
+ clrscrn
+ prstr(@version)
+ fin
+ crout
+ while TRUE
+ prstr(@txtfile)
+ cmdptr = rdstr($BA)
+ when toupper(parsecmd(cmdptr))
+ is 'A'
+ readtxt(cmdptr)
+ flags = flags | changed
+ break
+ is 'R'
+ if chkchng
+ inittxtbuf
+ numlines = 0
+ entrypoint = 0
+ strcpy(@txtfile, cmdptr)
+ readtxt(@txtfile)
+ if numlines == 0; numlines = 1; fin
+ flags = flags & ~changed
+ fin
+ break
+ is 'W'
+ if ^cmdptr
+ strcpy(@txtfile, cmdptr)
+ fin
+ writetxt(@txtfile)
+ if flags & changed; entrypoint = 0; fin
+ flags = flags & ~changed
+ break
+ is 'C'
+ prfiles(cmdptr); break
+ is 'P'
+ setpfx(cmdptr); break
+ is 'H'
+ if ^cmdptr
+ slot = cmdptr.1 - '0'
+ else
+ slot = 1
+ fin
+ printtxt(slot)
+ break
+ is 'Q'
+ quit
+ is 'E'
+ is 0
+ return
+ is 'N'
+ if chkchng
+ inittxtbuf
+ strcpy(@txtfile, @untitled)
+ entrypoint = 0
+ fin
+ break
+ is 'X'
+ if flags & changed or !entrypoint
+ parse_module
+ if parserr
+ bell
+ cursrow = parserrln
+ scrntop = cursrow & $FFF8
+ cursy = cursrow - scrntop
+ curscol = parserrpos
+ scrnleft = curscol & $FFE0
+ cursx = curscol - scrnleft
+ entrypoint = 0
+ else
+ crout
+ fin
+ fin
+ if entrypoint
+ save_vmstate
+ entrypoint()
+ restore_vmstate
+ fin
+ crout
+ break
+ otherwise
+ bell
+ cout('?')
+ crout
+ wend
+ if perr
+ prstr(@errorstr)
+ call($FDDA, perr, 0, 0, 0)
+ else
+ prstr(@okstr)
+ fin
+ crout
+ loop
+end
+
+//=====================================
+//
+// PLASMA Compiler
+//
+//=====================================
+
+//
+// Error handler
+//
+def parse_err(err)
+ if !parserr
+ parserr = TRUE
+ parserrln = lineno - 1
+ parserrpos = tknptr - inbuff
+ print(lineno)
+ cout(':')
+ prstr(err)
+ crout
+ fin
+ return ERR_TKN
+end
+//
+// Code tags. Upper bit is IS_RESOLVED flag, lower 15 is offset into codebuff
+// Flags are:
+//
+def ctag_new
+ if codetag >= ctag_max; return parse_err(@ctag_full); fin
+ codetag = codetag + 1
+ ctag_tbl:[codetag] = 0 // Unresolved, nothing to update yet
+ return codetag | IS_CTAG
+end
+def ctag_resolve(ctag)
+ word updtptr, nextptr
+
+ ctag = ctag & MASK_CTAG // Better be a ctag!
+ if ctag_tbl:[ctag] & IS_RESOLVED; return parse_err(@dup_id); fin
+ updtptr = ctag_tbl:[ctag] & MASK_CTAG
+ while updtptr
+ //
+ // Update list of addresses needing resolution
+ //
+ updtptr = updtptr + codebuff
+ nextptr = *updtptr & MASK_CTAG
+ if *updtptr & IS_RELATIVE
+ *updtptr = codeptr - updtptr
+ else
+ *updtptr = codeptr
+ fin
+ updtptr = nextptr
+ loop
+ ctag_tbl:[ctag] = (codeptr - codebuff) | IS_RESOLVED
+end
+//
+// Emit data/bytecode
+//
+def emit_byte(bval)
+ ^codeptr = bval
+ codeptr = codeptr + 1
+end
+def emit_word(wval)
+ *codeptr = wval
+ codeptr = codeptr + 2
+end
+def emit_fill(size)
+ memset(codeptr, size, 0)
+ codeptr = codeptr + size
+end
+def emit_op(op)
+ lastop = op
+ return emit_byte(op)
+end
+def emit_addr(tag)
+ word updtptr
+
+ if tag & IS_CTAG
+ tag = tag & MASK_CTAG
+ if ctag_tbl:[tag] & IS_RESOLVED
+ updtptr = (ctag_tbl:[tag] & MASK_CTAG) + codebuff
+ else
+ //
+ // Add to list of tags needing resolution
+ //
+ updtptr = ctag_tbl:[tag] & MASK_CTAG
+ ctag_tbl:[tag] = codeptr - codebuff
+ fin
+ emit_word(updtptr)
+ else
+ emit_word(tag + codebuff)
+ fin
+end
+def emit_reladdr(tag)
+ word updtptr
+
+ if tag & IS_CTAG
+ tag = tag & MASK_CTAG
+ if ctag_tbl:[tag] & IS_RESOLVED
+ updtptr = ((ctag_tbl:[tag] & MASK_CTAG) + codebuff) - codeptr
+ else
+ //
+ // Add to list of tags needing resolution
+ //
+ updtptr = ctag_tbl:[tag] | IS_RELATIVE
+ ctag_tbl:[tag] = codeptr - codebuff
+ fin
+ emit_word(updtptr)
+ else
+ emit_word(tag - (codeptr - codebuff))
+ fin
+end
+def emit_iddata(value, size, namestr)
+ return emit_fill(size)
+end
+def emit_data(vartype, consttype, constval, constsize)
+ byte i
+ word size, chrptr
+
+ if consttype == 0
+ size = constsize
+ emit_fill(constsize)
+ elsif consttype == STR_TYPE
+ size = constsize
+ chrptr = constval
+ constsize = constsize - 1
+ emit_byte(constsize)
+ while constsize > 0
+ emit_byte(^chrptr)
+ chrptr = chrptr + 1
+ constsize = constsize - 1
+ loop
+ else
+ if vartype & BYTE_TYPE
+ size = 1
+ emit_byte(constval)
+ else
+ size = 2
+ if consttype == CONSTADDR_TYPE
+ emit_addr(constval)
+ else
+ emit_word(constval)
+ fin
+ fin
+ fin
+ return size
+end
+def emit_const(cval)
+ if cval == 0
+ emit_op($00)
+ elsif cval > 0 and cval < 256
+ emit_op($2A)
+ emit_byte(cval)
+ else
+ emit_op($2C)
+ emit_word(cval)
+ fin
+end
+def emit_lb
+ return emit_op($60)
+end
+def emit_lw
+ return emit_op($62)
+end
+def emit_llb(offset)
+ emit_op($64)
+ return emit_byte(offset)
+end
+def emit_llw(offset)
+ emit_op($66)
+ return emit_byte(offset)
+end
+def emit_lab(tag, offset)
+ if tag & IS_CTAG and offset; return parse_err(@no_ctag_offst); fin
+ emit_op($68)
+ return emit_addr(tag+offset)
+end
+def emit_law(tag, offset)
+ if tag & IS_CTAG and offset; return parse_err(@no_ctag_offst); fin
+ emit_op($6A)
+ return emit_addr(tag+offset)
+end
+def emit_sb
+ return emit_op($70)
+end
+def emit_sw
+ return emit_op($72)
+end
+def emit_slb(offset)
+ emit_op($74)
+ return emit_byte(offset)
+end
+def emit_slw(offset)
+ emit_op($76)
+ return emit_byte(offset)
+end
+def emit_dlb(offset)
+ emit_op($6C)
+ return emit_byte(offset)
+end
+def emit_dlw(offset)
+ emit_op($6E)
+ return emit_byte(offset)
+end
+def emit_sab(tag, offset)
+ if tag & IS_CTAG and offset; return parse_err(@no_ctag_offst); fin
+ emit_op($78)
+ return emit_addr(tag+offset)
+end
+def emit_saw(tag, offset)
+ if tag & IS_CTAG and offset; return parse_err(@no_ctag_offst); fin
+ emit_op($7A)
+ return emit_addr(tag+offset)
+end
+def emit_dab(tag, offset)
+ if tag & IS_CTAG and offset; return parse_err(@no_ctag_offst); fin
+ emit_op($7C)
+ return emit_addr(tag+offset)
+end
+def emit_daw(tag, offset)
+ if tag & IS_CTAG and offset; return parse_err(@no_ctag_offst); fin
+ emit_op($7E)
+ return emit_addr(tag+offset)
+end
+def emit_call(tag)
+ emit_op($54)
+ return emit_addr(tag)
+end
+def emit_ical
+ return emit_op($56)
+end
+def emit_push
+ emit_op($34)
+end
+def emit_pull
+ emit_op($36)
+end
+def emit_localaddr(offset)
+ emit_op($28)
+ return emit_byte(offset)
+end
+def emit_globaladdr(tag, offset)
+ if tag & IS_CTAG and offset; return parse_err(@no_ctag_offst); fin
+ emit_op($26)
+ return emit_addr(tag+offset)
+end
+def emit_indexbyte
+ return emit_op($02)
+end
+def emit_indexword
+ return emit_op($1E)
+end
+def emit_unaryop(op)
+ when op
+ is NEG_TKN
+ emit_op($10); break
+ is COMP_TKN
+ emit_op($12); break
+ is LOGIC_NOT_TKN
+ emit_op($20); break
+ is INC_TKN
+ emit_op($0C); break
+ is DEC_TKN
+ emit_op($0E); break
+ is BPTR_TKN
+ emit_op($60); break
+ is WPTR_TKN
+ emit_op($62); break
+ otherwise
+ return FALSE
+ wend
+ return TRUE
+end
+def emit_binaryop(op)
+ when op
+ is MUL_TKN
+ //
+ // Replace MUL 2 with SHL 1
+ //
+ if lastop == $2A and ^(codeptr - 1) == 2 // CB 2
+ codeptr = codeptr - 1
+ emit_byte(1) // CB 1
+ emit_op($1A) // SHL
+ else
+ emit_op($06)
+ fin
+ break
+ is DIV_TKN
+ //
+ // Replace DIV 2 with SHR 1
+ //
+ if lastop == $2A and ^(codeptr - 1) == 2 // CB 2
+ codeptr = codeptr - 1
+ emit_byte(1) // CB 1
+ emit_op($1C) // SHR
+ else
+ emit_op($08)
+ fin
+ break
+ is MOD_TKN
+ emit_op($0A); break
+ is ADD_TKN
+ //
+ // Replace ADD 1 with INCR
+ //
+ if lastop == $2A and ^(codeptr - 1) == 1 // CB 1
+ codeptr = codeptr - 2
+ emit_op($0C) // INC_OP
+ else
+ emit_op($02)
+ fin
+ break
+ is SUB_TKN
+ //
+ // Replace SUB 1 with DECR
+ //
+ if lastop == $2A and ^(codeptr - 1) == 1 // CB 1
+ codeptr = codeptr - 2
+ emit_op($0E) // DEC_OP
+ else
+ emit_op($04)
+ fin
+ break
+ is SHL_TKN
+ emit_op($1A); break
+ is SHR_TKN
+ emit_op($1C); break
+ is AND_TKN
+ emit_op($14); break
+ is OR_TKN
+ emit_op($16); break
+ is EOR_TKN
+ emit_op($18); break
+ is EQ_TKN
+ emit_op($40); break
+ is NE_TKN
+ emit_op($42); break
+ is GE_TKN
+ emit_op($48); break
+ is LT_TKN
+ emit_op($46); break
+ is GT_TKN
+ emit_op($44); break
+ is LE_TKN
+ emit_op($4A); break
+ is LOGIC_OR_TKN
+ emit_op($22); break
+ is LOGIC_AND_TKN
+ emit_op($24); break
+ otherwise
+ return FALSE
+ wend
+ return TRUE
+end
+def emit_brtru(tag)
+ emit_op($4E)
+ return emit_reladdr(tag)
+end
+def emit_brfls(tag)
+ emit_op($4C)
+ return emit_reladdr(tag)
+end
+def emit_brgt(tag)
+ emit_op($38)
+ return emit_reladdr(tag)
+end
+def emit_brlt(tag)
+ emit_op($3A)
+ return emit_reladdr(tag)
+end
+def emit_brne(tag)
+ emit_op($3E)
+ return emit_reladdr(tag)
+end
+def emit_branch(tag)
+ emit_op($50)
+ return emit_reladdr(tag)
+end
+def emit_drop
+ return emit_op($30)
+end
+def emit_leave
+ if framesize
+ emit_op($5A)
+ else
+ emit_op($5C)
+ fin
+end
+def emit_enter(cparams)
+ emit_byte(emit_enter.[0])
+ emit_byte(emit_enter.[1])
+ emit_byte(emit_enter.[2])
+ if framesize
+ emit_op($58)
+ emit_byte(framesize)
+ emit_byte(cparams)
+ fin
+end
+//
+// Symbol table
+//
+def idmatch(nameptr, len, idptr, idcnt)
+ byte i
+
+ while idcnt
+ if len == idptr->idname
+ for i = 1 to len
+ if nameptr->[i - 1] <> idptr->idname.[i]
+ break
+ fin
+ next
+ if i > len
+ return idptr
+ fin
+ fin
+ idptr = idptr + idptr->idname + idrecsz
+ idcnt = idcnt - 1
+ loop
+ return 0
+end
+def dumpsym(idptr, idcnt)
+ while idcnt
+ prword(idptr=>idval)
+ cout(' ')
+ prbyte(idptr->idtype)
+ cout(' ')
+ prstr(@idptr->idname)
+ cout('=')
+ if idptr->idtype & ADDR_TYPE
+ if idptr=>idval & IS_CTAG
+ prword((ctag_tbl:[idptr=>idval & MASK_CTAG] & MASK_CTAG) + codebuff)
+ else
+ prword(idptr=>idval + codebuff)
+ fin
+ else
+ prword(idptr=>idval)
+ fin
+ crout
+ idptr = idptr + idptr->idname + idrecsz
+ idcnt = idcnt - 1
+ loop
+end
+def id_lookup(nameptr, len)
+ word idptr
+
+ idptr = idmatch(nameptr, len, idlocal_tbl, locals)
+ if idptr
+ return idptr
+ fin
+ idptr = idmatch(nameptr, len, idglobal_tbl, globals)
+ if idptr
+ return idptr
+ fin
+ return parse_err(@undecl_id)
+end
+def idglobal_lookup(nameptr, len)
+ return idmatch(nameptr, len, idglobal_tbl, globals)
+end
+def idlocal_add(namestr, len, type, size)
+ if idmatch(namestr, len, @idlocal_tbl, locals); return parse_err(@dup_id); fin
+ lastlocal=>idval = framesize
+ lastlocal->idtype = type | LOCAL_TYPE
+ nametostr(namestr, len, lastlocal + idname)
+ locals = locals + 1
+ lastlocal = lastlocal + idrecsz + len
+ if lastlocal > idlocal_tbl + idlocal_tblsz
+ prstr(@local_sym_overflw)
+ exit
+ fin
+ framesize = framesize + size
+ if framesize > 255
+ prstr(@local_overflw)
+ return FALSE
+ fin
+ return TRUE
+end
+def iddata_add(namestr, len, type, size)
+ if idmatch(namestr, len, idglobal_tbl, globals); return parse_err(@dup_id); fin
+ lastglobal=>idval = datasize
+ lastglobal->idtype = type
+ nametostr(namestr, len, lastglobal + idname)
+ emit_iddata(datasize, size, lastglobal + idname)
+ globals = globals + 1
+ lastglobal = lastglobal + idrecsz + len
+ if lastglobal > idglobal_tbl + idglobal_tblsz
+ prstr(@global_sym_overflw)
+ exit
+ fin
+ datasize = datasize + size
+ return TRUE
+end
+def iddata_size(type, varsize, initsize)
+ if varsize > initsize
+ datasize = datasize + varsize
+ emit_data(0, 0, 0, varsize - initsize)
+ else
+ datasize = datasize + initsize
+ fin
+end
+def idglobal_add(namestr, len, type, value)
+ if idmatch(namestr, len, idglobal_tbl, globals); return parse_err(@dup_id); fin
+ lastglobal=>idval = value
+ lastglobal->idtype = type
+ nametostr(namestr, len, lastglobal + idname)
+ globals = globals + 1
+ lastglobal = lastglobal + idrecsz + len
+ if lastglobal > idglobal_tbl + idglobal_tblsz
+ prstr(@global_sym_overflw)
+ exit
+ fin
+ return TRUE
+end
+def idfunc_add(namestr, len, tag)
+ return idglobal_add(namestr, len, FUNC_TYPE, tag)
+end
+def idconst_add(namestr, len, value)
+ return idglobal_add(namestr, len, CONST_TYPE, value)
+end
+def idglobal_init
+ word ctag
+
+ lineno = 0
+ parserr = 0
+ codeptr = codebuff
+ lastop = $FF
+ entrypoint = 0
+ globals = 0
+ lastglobal = idglobal_tbl
+ codetag = -1
+ //
+ // Create local jump table to some library functions
+ //
+ ctag = ctag_new
+ idfunc_add(@runtime0 + 1, runtime0, ctag)
+ idfunc_add(@RUNTIME0 + 1, RUNTIME0, ctag)
+ ctag_resolve(ctag)
+ emit_byte($4C)
+ emit_word(@call)
+ ctag = ctag_new
+ idfunc_add(@runtime1 + 1, runtime1, ctag)
+ idfunc_add(@RUNTIME1 + 1, RUNTIME1, ctag)
+ ctag_resolve(ctag)
+ emit_byte($4C)
+ emit_word(@syscall)
+ ctag = ctag_new
+ idfunc_add(@runtime2 + 1, runtime2, ctag)
+ idfunc_add(@RUNTIME2 + 1, RUNTIME2, ctag)
+ ctag_resolve(ctag)
+ emit_byte($4C)
+ emit_word(@memset)
+ ctag = ctag_new
+ idfunc_add(@runtime3 + 1, runtime3, ctag)
+ idfunc_add(@RUNTIME3 + 1, RUNTIME3, ctag)
+ ctag_resolve(ctag)
+ emit_byte($4C)
+ emit_word(@memcpy)
+ ctag = ctag_new
+ idfunc_add(@runtime4 + 1, runtime4, ctag)
+ idfunc_add(@RUNTIME4 + 1, RUNTIME4, ctag)
+ ctag_resolve(ctag)
+ emit_byte($4C)
+ emit_word(@cout)
+ ctag = ctag_new
+ idfunc_add(@runtime5 + 1, runtime5, ctag)
+ idfunc_add(@RUNTIME5 + 1, RUNTIME5, ctag)
+ ctag_resolve(ctag)
+ emit_byte($4C)
+ emit_word(@cin)
+ ctag = ctag_new
+ idfunc_add(@runtime6 + 1, runtime6, ctag)
+ idfunc_add(@RUNTIME6 + 1, RUNTIME6, ctag)
+ ctag_resolve(ctag)
+ emit_byte($4C)
+ emit_word(@prstr)
+ ctag = ctag_new
+ idfunc_add(@runtime7 + 1, runtime7, ctag)
+ idfunc_add(@RUNTIME7 + 1, RUNTIME7, ctag)
+ ctag_resolve(ctag)
+ emit_byte($4C)
+ emit_word(@rdstr)
+ ctag = ctag_new
+ idfunc_add(@runtime8 + 1, runtime8, ctag)
+ idfunc_add(@RUNTIME8 + 1, RUNTIME8, ctag)
+ ctag_resolve(ctag)
+ emit_byte($4C)
+ emit_word(@print)
+ ctag = ctag_new
+ idfunc_add(@runtime9 + 1, runtime9, ctag)
+ idfunc_add(@RUNTIME9 + 1, RUNTIME9, ctag)
+ ctag_resolve(ctag)
+ emit_byte($4C)
+ emit_word(@home)
+ ctag = ctag_new
+ idfunc_add(@runtime10 + 1, runtime10, ctag)
+ idfunc_add(@RUNTIME10 + 1, RUNTIME10, ctag)
+ ctag_resolve(ctag)
+ emit_byte($4C)
+ emit_word(@gotoxy)
+ //
+ // Start data after jump table
+ //
+ datasize = codeptr - codebuff
+end
+def idlocal_init
+ locals = 0
+ framesize = 0
+ lastlocal = idlocal_tbl
+end
+//
+// Alebraic op to stack op
+//
+def push_op(op, prec)
+ opsp = opsp + 1
+ if opsp == 16
+ return parse_err(@estk_overflw)
+ fin
+ opstack[opsp] = op
+ precstack[opsp] = prec
+end
+def pop_op
+ if opsp < 0
+ return parse_err(@estk_underflw)
+ fin
+ opsp = opsp - 1
+ return opstack[opsp + 1]
+end
+def tos_op
+ if opsp < 0
+ return 0
+ fin
+ return opstack[opsp]
+end
+def tos_op_prec(tos)
+ if opsp <= tos
+ return 100
+ fin
+ return precstack[opsp]
+end
+//
+// Lexical anaylzer
+//
+def keymatch
+ byte i, keypos
+ word chrptr
+
+ keypos = 0
+ while keywrds[keypos] < tknlen
+ keypos = keypos + keywrds[keypos] + 2
+ loop
+ chrptr = tknptr - 1
+ while keywrds[keypos] == tknlen
+ for i = 1 to tknlen
+ if toupper(^(chrptr + i)) <> keywrds[keypos + i]
+ break
+ fin
+ next
+ if i > tknlen
+ return keywrds[keypos + keywrds[keypos] + 1]
+ fin
+ keypos = keypos + keywrds[keypos] + 2
+ loop
+ return ID_TKN
+end
+def scan
+ //
+ // Skip whitespace
+ //
+ scanptr = skipspace(scanptr)
+ tknptr = scanptr
+ scanchr = ^scanptr
+ //
+ // Scan for token based on first character
+ //
+ if isalpha(scanchr)
+ //
+ // ID, either variable name or reserved word
+ //
+ repeat
+ scanptr = scanptr + 1
+ until !isalphanum(^scanptr)
+ tknlen = scanptr - tknptr
+ token = keymatch
+ elsif isnum(scanchr)
+ //
+ // Decimal constant
+ //
+ token = INT_TKN
+ constval = 0
+ repeat
+ constval = constval * 10 + ^scanptr - '0'
+ scanptr = scanptr + 1
+ until !isnum(^scanptr)
+ else
+ //
+ // Potential multiple character tokens
+ //
+ when scanchr
+ is '/'
+ if ^(scanptr + 1) == '/'
+ token = EOL_TKN
+ ^scanptr = $00
+ else
+ token = DIV_TKN
+ scanptr = scanptr + 1
+ fin
+ break
+ is '='
+ if ^(scanptr + 1) == '='
+ token = EQ_TKN
+ scanptr = scanptr + 2
+ elsif ^(scanptr + 1) == '>'
+ token = PTRW_TKN
+ scanptr = scanptr + 2
+ else
+ token = SET_TKN
+ scanptr = scanptr + 1
+ fin
+ break
+ is '-'
+ if ^(scanptr + 1) == '>'
+ token = PTRB_TKN
+ scanptr = scanptr + 2
+ else
+ token = SUB_TKN
+ scanptr = scanptr + 1
+ fin
+ break
+ is '>'
+ if ^(scanptr + 1) == '>'
+ token = SHR_TKN
+ scanptr = scanptr + 2
+ elsif ^(scanptr + 1) == '='
+ token = GE_TKN
+ scanptr = scanptr + 2
+ else
+ token = GT_TKN
+ scanptr = scanptr + 1
+ fin
+ break
+ is '<'
+ if ^(scanptr + 1) == '<'
+ token = SHL_TKN
+ scanptr = scanptr + 2
+ elsif ^(scanptr + 1) == '='
+ token = LE_TKN
+ scanptr = scanptr + 2
+ elsif ^(scanptr + 1) == '>'
+ token = NE_TKN
+ scanptr = scanptr + 2
+ else
+ token = LT_TKN
+ scanptr = scanptr + 1
+ fin
+ break
+ is '$'
+ //
+ // Hexadecimal constant
+ //
+ token = INT_TKN
+ constval = 0
+ repeat
+ scanptr = scanptr + 1
+ if ^scanptr >= '0' and ^scanptr <= '9'
+ constval = (constval << 4) + ^scanptr - '0'
+ elsif ^scanptr >= 'A' and ^scanptr <= 'F'
+ constval = (constval << 4) + ^scanptr - '7'// 'A'-10
+ elsif ^scanptr >= 'a' and ^scanptr <= 'f'
+ constval = (constval << 4) + ^scanptr - 'W'// 'a'-10
+ else
+ break
+ fin
+ until !^scanptr
+ break
+ is $27 // '
+ //
+ // Character constant
+ //
+ token = CHR_TKN
+ if ^(scanptr + 1) <> $5C // \
+ constval = ^(scanptr + 1)
+ if ^(scanptr + 2) <> $27 // '
+ return parse_err(@bad_cnst)
+ fin
+ scanptr = scanptr + 3
+ else
+ when ^(scanptr + 2)
+ is 'n'
+ constval = $0D; break
+ is 'r'
+ constval = $0A; break
+ is 't'
+ constval = $09; break
+ otherwise
+ constval = ^(scanptr + 2)
+ wend
+ if ^(scanptr + 3) <> $27 // '
+ return parse_err(@bad_cnst)
+ fin
+ scanptr = scanptr + 4
+ fin
+ break
+ is '"'
+ //
+ // String constant
+ //
+ token = STR_TKN
+ scanptr = scanptr + 1
+ constval = scanptr
+ while ^scanptr and ^scanptr <> '"'
+ scanptr = scanptr + 1
+ loop
+ if !^scanptr
+ return parse_err(@bad_cnst)
+ fin
+ scanptr = scanptr + 1
+ break
+ is 0
+ is ';'
+ if token <> EOF_TKN
+ token = EOL_TKN
+ fin
+ break
+ otherwise
+ //
+ // Simple single character tokens
+ //
+ token = scanchr | $80
+ scanptr = scanptr + 1
+ wend
+ fin
+ tknlen = scanptr - tknptr
+ return token
+end
+def rewind(ptr)
+ scanptr = ptr
+end
+def lookahead
+ word backptr, backtkn
+ byte prevtkn, prevlen, look
+ backptr = scanptr
+ backtkn = tknptr
+ prevtkn = token
+ prevlen = tknlen
+ look = scan
+ scanptr = backptr
+ tknptr = backtkn
+ token = prevtkn
+ tknlen = prevlen
+ return look
+end
+//
+// Get next line of input
+//
+def nextln
+ if ^scanptr == ';'
+ scanptr = scanptr + 1
+ scan
+ else
+ scanptr = inbuff
+ if lineno < numlines
+ cpyln(strlinbuf:[lineno], instr)
+ lineno = lineno + 1
+ if !(lineno & $0F); cout('.'); fin
+ //cout('>')
+ //prstr(instr)
+ //crout
+ scan
+ else
+ ^instr = 0
+ ^inbuff = 0
+ token = DONE_TKN
+ fin
+ fin
+ return token
+end
+//
+// Parser
+//
+def parse_term
+ when scan
+ is OPEN_PAREN_TKN
+ if !parse_expr
+ return FALSE
+ fin
+ if token <> CLOSE_PAREN_TKN; return parse_err(@no_close_paren); fin
+ is ID_TKN
+ is INT_TKN
+ is CHR_TKN
+ is STR_TKN
+ return TRUE
+ wend
+ return FALSE
+end
+def parse_constval(valptr, sizeptr)
+ byte mod, type
+ word idptr, ctag
+
+ mod = 0
+ type = 0
+ while !parse_term
+ when token
+ is SUB_TKN
+ mod = mod | 1; break
+ is COMP_TKN
+ mod = mod | 2; break
+ is LOGIC_NOT_TKN
+ mod = mod | 4; break
+ is AT_TKN
+ mod = mod | 8; break
+ is ADD_TKN
+ break
+ otherwise
+ return 0
+ wend
+ loop
+ when token
+ is STR_TKN
+ *valptr = constval
+ ^sizeptr = tknlen - 1
+ type = STR_TYPE
+ if mod; return parse_err(@bad_op); fin
+ break
+ is CHR_TKN
+ *valptr = constval
+ ^sizeptr = 1
+ type = BYTE_TYPE
+ break
+ is INT_TKN
+ *valptr = constval
+ ^sizeptr = 2
+ type = WORD_TYPE
+ break
+ is ID_TKN
+ ^sizeptr = 2
+ idptr = id_lookup(tknptr, tknlen)
+ if !idptr; return parse_err(@bad_cnst); fin
+ type = idptr->idtype
+ if type & ADDR_TYPE
+ if mod <> 8; return parse_err(@bad_cnst); fin
+ type = CONSTADDR_TYPE
+ fin
+ *valptr = idptr=>idval
+ break
+ otherwise
+ return parse_err(@bad_cnst)
+ wend
+ if mod & 1
+ *valptr = -*valptr
+ fin
+ if mod & 2
+ *valptr = ~*valptr
+ fin
+ if mod & 4
+ *valptr = !*valptr
+ fin
+ return type
+end
+def ispostop
+ when scan
+ is OPEN_PAREN_TKN
+ is OPEN_BRACKET_TKN
+ is DOT_TKN
+ is COLON_TKN
+ is PTRB_TKN
+ is PTRW_TKN
+ return TRUE
+ wend
+ return FALSE
+end
+def parse_value(rvalue)
+ byte cparams, deref, type, emit_val
+ word optos, idptr, value
+ byte elem_size, elem_type
+ word elem_offset
+
+ deref = rvalue
+ optos = opsp
+ type = 0
+ elem_offset = 0
+ emit_val = FALSE
+ value = 0
+
+ //
+ // Parse pre-ops
+ //
+ while !parse_term
+ when token
+ is ADD_TKN
+ break
+ is BPTR_TKN
+ if deref
+ push_op(token, 0)
+ else
+ type = type | BPTR_TYPE
+ deref = deref + 1
+ fin
+ break
+ is WPTR_TKN
+ if deref
+ push_op(token, 0)
+ else
+ type = type | WPTR_TYPE
+ deref = deref + 1
+ fin
+ break
+ is AT_TKN
+ deref = deref - 1
+ break
+ is SUB_TKN
+ is COMP_TKN
+ is LOGIC_NOT_TKN
+ push_op(token, 0)
+ break
+ otherwise
+ return 0
+ wend
+ loop
+ //
+ // Determine terminal type
+ //
+ when token
+ is INT_TKN
+ is CHR_TKN
+ value = constval
+ type = type | CONST_TYPE
+ break
+ is ID_TKN
+ idptr = id_lookup(tknptr, tknlen)
+ if !idptr; return 0; fin
+ if !(idptr->idtype); return 0; fin
+ type = type | idptr->idtype
+ value = idptr=>idval
+ break
+ is CLOSE_PAREN_TKN
+ // type = type | WORD_TYPE
+ emit_val = TRUE
+ break
+ otherwise
+ return 0
+ wend
+ //
+ // Constant optimizations
+ //
+ if type & CONST_TYPE
+ cparams = TRUE
+ while optos < opsp and cparams
+ when tos_op
+ is NEG_TKN
+ pop_op
+ value = -value
+ break
+ is COMP_TKN
+ pop_op
+ value = ~value
+ break
+ is LOGIC_NOT_TKN
+ pop_op
+ value = !value
+ break
+ otherwise
+ cparams = FALSE
+ wend
+ loop
+ fin
+ //
+ // Parse post-ops
+ //
+ while ispostop
+ when token
+ is OPEN_BRACKET_TKN
+ //
+ // Array
+ //
+ if !emit_val
+ if type & ADDR_TYPE
+ if type & LOCAL_TYPE
+ emit_localaddr(value)
+ else
+ emit_globaladdr(value, 0)
+ fin
+ elsif type & CONST_TYPE
+ emit_const(value)
+ fin
+ emit_val = TRUE
+ fin // !emit_val
+ if type & PTR_TYPE
+ emit_lw
+ fin
+ if !parse_expr
+ return 0
+ fin
+ if token <> CLOSE_BRACKET_TKN
+ return parse_err(@no_close_bracket)
+ fin
+ if type & WORD_TYPE
+ type = WPTR_TYPE
+ emit_indexword
+ else
+ type = BPTR_TYPE
+ emit_indexbyte
+ fin
+ break
+ is PTRB_TKN
+ is PTRW_TKN
+ if !emit_val
+ if type & FUNC_TYPE
+ emit_call(value)
+ elsif type & VAR_TYPE
+ if type & LOCAL_TYPE
+ if type & BYTE_TYPE
+ emit_llb(value + elem_offset)
+ else
+ emit_llw(value + elem_offset)
+ fin
+ else
+ if type & BYTE_TYPE
+ emit_lab(value, elem_offset)
+ else
+ emit_law(value, elem_offset)
+ fin
+ fin
+ else
+ if type & BPTR_TYPE
+ emit_lb
+ else
+ emit_lw
+ fin
+ fin
+ emit_val = 1;
+ else
+ if type & BYTE_TYPE
+ emit_lab(value, elem_offset)
+ else
+ emit_law(value, elem_offset)
+ fin
+ fin
+ type = type & ~(VAR_TYPE | ADDR_TYPE)
+ type = type | WORD_TYPE
+ if token == PTRB_TKN
+ token = DOT_TKN
+ else
+ token = COLON_TKN
+ fin
+ //
+ // Fall through
+ //
+ is DOT_TKN
+ is COLON_TKN
+ //
+ // Dot and Colon
+ //
+ if token == DOT_TKN
+ elem_type = BPTR_TYPE
+ else
+ elem_type = WPTR_TYPE
+ fin
+ if parse_constval(@elem_offset, @elem_size)
+ //
+ // Constant structure offset
+ //
+ if !emit_val
+ if type & VAR_TYPE
+ if elem_type & BPTR_TYPE
+ elem_type = (type & ~VAR_TYPE) | BYTE_TYPE
+ else
+ elem_type = (type & ~VAR_TYPE) | WORD_TYPE
+ fin
+ elsif type & CONST_TYPE
+ value = value + elem_offset
+ emit_const(value)
+ elem_offset = 0
+ emit_val = TRUE
+ else // FUNC_TYPE
+ emit_globaladdr(value, 0)
+ emit_const(elem_offset)
+ emit_binaryop(ADD_TKN)
+ elem_offset = 0
+ emit_val = TRUE
+ fin
+ else
+ if elem_offset <> 0
+ emit_const(elem_offset)
+ emit_binaryop(ADD_TKN)
+ elem_offset = 0
+ fin
+ fin // !emit_val
+ elsif token == OPEN_BRACKET_TKN
+ //
+ // Array of arrays
+ //
+ if !emit_val
+ if type & ADDR_TYPE
+ if type & LOCAL_TYPE
+ emit_localaddr(value + elem_offset)
+ else
+ emit_globaladdr(value, elem_offset)
+ fin
+ elsif type & CONST_TYPE
+ emit_const(value + elem_offset)
+ fin
+ elem_offset = 0
+ emit_val = TRUE
+ fin // !emit_val
+ while parse_expr
+ if token <> COMMA_TKN
+ break
+ fin
+ emit_indexword
+ emit_lw
+ loop
+ if token <> CLOSE_BRACKET_TKN
+ return parse_err(@no_close_bracket)
+ fin
+ if elem_type & WPTR_TYPE
+ emit_indexword
+ else
+ emit_indexbyte
+ fin
+ else
+ return parse_err(@bad_offset)
+ fin
+ type = elem_type
+ break
+ is OPEN_PAREN_TKN
+ //
+ // Function call
+ //
+ if emit_val and type & VAR_TYPE
+ if lookahead <> CLOSE_PAREN_TKN
+ emit_push
+ fin
+ fin
+ cparams = 0
+ while parse_expr
+ cparams = cparams + 1
+ if token <> COMMA_TKN
+ break
+ fin
+ loop
+ if token <> CLOSE_PAREN_TKN
+ return parse_err(@no_close_paren)
+ fin
+ if type & FUNC_CONST_TYPE
+ emit_call(value)
+ else
+ if !emit_val
+ if type & VAR_TYPE
+ if type & LOCAL_TYPE
+ emit_llw(value + elem_offset)
+ else
+ emit_law(value, elem_offset)
+ fin
+ elsif type & PTR_TYPE
+ emit_lw
+ fin
+ else
+ if cparams
+ emit_pull
+ fin
+ fin
+ emit_ical
+ fin
+ emit_val = TRUE
+ type = WORD_TYPE
+ wend
+ loop
+ if emit_val
+ if rvalue
+ if deref and type & PTR_TYPE
+ if type & BPTR_TYPE
+ emit_lb
+ else
+ emit_lw
+ fin
+ fin
+ fin
+ else // emit_val
+ if type & CONST_TYPE
+ emit_const(value)
+ elsif deref
+ if type & FUNC_TYPE
+ emit_call(value)
+ elsif type & VAR_TYPE
+ if type & LOCAL_TYPE
+ if type & BYTE_TYPE
+ emit_llb(value + elem_offset)
+ else
+ emit_llw(value + elem_offset)
+ fin
+ else
+ if type & BYTE_TYPE
+ emit_lab(value, elem_offset)
+ else
+ emit_law(value, elem_offset)
+ fin
+ fin
+ elsif type & PTR_TYPE
+ if type & BPTR_TYPE
+ emit_lb
+ else
+ emit_lw
+ fin
+ fin
+ else
+ if type & LOCAL_TYPE
+ emit_localaddr(value + elem_offset)
+ else
+ emit_globaladdr(value, elem_offset)
+ fin
+ fin
+ fin // emit_val
+ while optos < opsp
+ if !emit_unaryop(pop_op); return parse_err(@bad_op); fin
+ loop
+ if !type
+ type = WORD_TYPE
+ fin
+ return type
+end
+def parse_constexpr(valptr, sizeptr)
+ byte type, size1, size2
+ word val1, val2
+
+ type = parse_constval(@val1, @size1)
+ if !type; return 0; fin
+ size2 = 0
+ when scan
+ is ADD_TKN
+ type = parse_constval(@val2, @size2)
+ if !type; return 0; fin
+ *valptr = val1 + val2
+ break
+ is SUB_TKN
+ type = parse_constval(@val2, @size2)
+ if !type; return 0; fin
+ *valptr = val1 - val2
+ break
+ is MUL_TKN
+ type = parse_constval(@val2, @size2)
+ if !type; return 0; fin
+ *valptr = val1 * val2
+ break
+ is DIV_TKN
+ type = parse_constval(@val2, @size2)
+ if !type; return 0; fin
+ *valptr = val1 / val2
+ break
+ is MOD_TKN
+ type = parse_constval(@val2, @size2)
+ if !type; return 0; fin
+ *valptr = val1 % val2
+ break
+ is AND_TKN
+ type = parse_constval(@val2, @size2)
+ if !type; return 0; fin
+ *valptr = val1 & val2
+ break
+ is OR_TKN
+ type = parse_constval(@val2, @size2)
+ if !type; return 0; fin
+ *valptr = val1 | val2
+ break
+ is EOR_TKN
+ type = parse_constval(@val2, @size2)
+ if !type; return 0; fin
+ *valptr = val1 ^ val2
+ break
+ otherwise
+ *valptr = val1
+ wend
+ if size1 > size2
+ ^sizeptr = size1
+ else
+ ^sizeptr = size2
+ fin
+ return type
+end
+def parse_expr
+ byte prevmatch, matchop, i
+ word optos
+
+ matchop = 0
+ optos = opsp
+ repeat
+ prevmatch = matchop
+ matchop = 0
+ if parse_value(1)
+ matchop = 1
+ for i = 0 to bops_tblsz
+ if token == bops_tbl[i]
+ matchop = 2
+ if bops_prec[i] >= tos_op_prec(optos)
+ if !emit_binaryop(pop_op); return parse_err(@bad_op); fin
+ fin
+ push_op(token, bops_prec[i])
+ break
+ fin
+ next
+ fin
+ until matchop <> 2
+ if matchop == 0 and prevmatch == 2; return parse_err(@missing_op); fin
+ while optos < opsp
+ if !emit_binaryop(pop_op); return parse_err(@bad_op); fin
+ loop
+ return matchop or prevmatch
+end
+def parse_stmnt
+ byte type, elem_type, elem_size, i
+ word elem_offset, tag_prevbrk, tag_prevcnt, tag_else, tag_endif, tag_while, tag_wend
+ word tag_repeat, tag_for, tag_choice, tag_of, idptr, saveptr, addr, stepdir
+
+ if token <> END_TKN and token <> DONE_TKN and token <> OF_TKN and token <> DEFAULT_TKN
+ prevstmnt = token
+ fin
+ when token
+ is IF_TKN
+ if !parse_expr; return 0; fin
+ tag_else = ctag_new
+ tag_endif = ctag_new
+ emit_brfls(tag_else)
+ scan
+ repeat
+ while parse_stmnt
+ nextln
+ loop
+ if token <> ELSEIF_TKN
+ break
+ fin
+ emit_branch(tag_endif)
+ ctag_resolve(tag_else)
+ if !parse_expr; return FALSE; fin
+ tag_else = ctag_new
+ emit_brfls(tag_else)
+ until FALSE
+ if token == ELSE_TKN
+ emit_branch(tag_endif)
+ ctag_resolve(tag_else)
+ scan
+ while parse_stmnt
+ nextln
+ loop
+ ctag_resolve(tag_endif)
+ else
+ ctag_resolve(tag_else)
+ ctag_resolve(tag_endif)
+ fin
+ if token <> FIN_TKN; return parse_err(@no_fin); fin
+ break
+ is WHILE_TKN
+ tag_while = ctag_new
+ tag_wend = ctag_new
+ tag_prevcnt = cont_tag
+ cont_tag = tag_while
+ tag_prevbrk = break_tag
+ break_tag = tag_wend
+ ctag_resolve(tag_while)
+ if !parse_expr; return FALSE; fin
+ emit_brfls(tag_wend)
+ while parse_stmnt
+ nextln
+ loop
+ if token <> LOOP_TKN; return parse_err(@no_loop); fin
+ emit_branch(tag_while)
+ ctag_resolve(tag_wend)
+ break_tag = tag_prevbrk
+ cont_tag = tag_prevcnt
+ break
+ is REPEAT_TKN
+ tag_repeat = ctag_new
+ tag_prevbrk = break_tag
+ break_tag = ctag_new
+ tag_prevcnt = cont_tag
+ cont_tag = ctag_new
+ ctag_resolve(tag_repeat)
+ scan
+ while parse_stmnt
+ nextln
+ loop
+ if token <> UNTIL_TKN; return parse_err(@no_until); fin
+ ctag_resolve(cont_tag)
+ cont_tag = tag_prevcnt
+ if !parse_expr; return FALSE; fin
+ emit_brfls(tag_repeat)
+ ctag_resolve(break_tag)
+ break_tag = tag_prevbrk
+ break
+ is FOR_TKN
+ stack_loop = stack_loop + 1
+ tag_for = ctag_new
+ tag_prevcnt = cont_tag
+ cont_tag = tag_for
+ tag_prevbrk = break_tag
+ break_tag = ctag_new
+ if scan <> ID_TKN; return parse_err(@bad_stmnt); fin
+ idptr = id_lookup(tknptr, tknlen)
+ if idptr
+ type = idptr->idtype
+ addr = idptr=>idval
+ else
+ return FALSE
+ fin
+ if scan <> SET_TKN; return parse_err(@bad_stmnt); fin
+ if !parse_expr; return parse_err(@bad_stmnt); fin
+ ctag_resolve(tag_for)
+ if type & LOCAL_TYPE
+ if type & BYTE_TYPE
+ emit_dlb(addr)
+ else
+ emit_dlw(addr)
+ fin
+ else
+ if type & BYTE_TYPE
+ emit_dab(addr, 0)
+ else
+ emit_daw(addr, 0)
+ fin
+ fin
+ if token == TO_TKN
+ stepdir = 1
+ elsif token == DOWNTO_TKN
+ stepdir = -1
+ else
+ return parse_err(@bad_stmnt)
+ fin
+ if !parse_expr; return parse_err(@bad_stmnt); fin
+ if stepdir > 0
+ emit_brgt(break_tag)
+ else
+ emit_brlt(break_tag)
+ fin
+ if token == STEP_TKN
+ if !parse_expr; return parse_err(@bad_stmnt); fin
+ if stepdir > 0
+ emit_binaryop(ADD_TKN)
+ else
+ emit_binaryop(SUB_TKN)
+ fin
+ else
+ if stepdir > 0
+ emit_unaryop(INC_TKN)
+ else
+ emit_unaryop(DEC_TKN)
+ fin
+ fin
+ while parse_stmnt
+ nextln
+ loop
+ if token <> NEXT_TKN; return parse_err(@bad_stmnt); fin
+ emit_branch(tag_for)
+ cont_tag = tag_prevcnt
+ ctag_resolve(break_tag)
+ emit_drop
+ break_tag = tag_prevbrk
+ stack_loop = stack_loop - 1
+ break
+ is CASE_TKN
+ stack_loop = stack_loop + 1
+ tag_prevbrk = break_tag
+ break_tag = ctag_new
+ tag_choice = ctag_new
+ tag_of = ctag_new
+ if !parse_expr; return parse_err(@bad_stmnt); fin
+ nextln
+ while token <> ENDCASE_TKN
+ if token == OF_TKN
+ if !parse_expr; return parse_err(@bad_stmnt); fin
+ emit_brne(tag_choice)
+ ctag_resolve(tag_of)
+ while parse_stmnt
+ nextln
+ loop
+ tag_of = ctag_new
+ if prevstmnt <> BREAK_TKN // Fall through to next OF if no break
+ emit_branch(tag_of)
+ fin
+ ctag_resolve(tag_choice)
+ tag_choice = ctag_new
+ elsif token == DEFAULT_TKN
+ ctag_resolve(tag_of)
+ tag_of = 0
+ scan
+ while parse_stmnt
+ nextln
+ loop
+ if token <> ENDCASE_TKN; return parse_err(@bad_stmnt); fin
+ else
+ return parse_err(@bad_stmnt)
+ fin
+ loop
+ if (tag_of)
+ ctag_resolve(tag_of)
+ fin
+ ctag_resolve(break_tag)
+ emit_drop
+ break_tag = tag_prevbrk
+ stack_loop = stack_loop - 1
+ break
+ is BREAK_TKN
+ if break_tag
+ emit_branch(break_tag)
+ else
+ return parse_err(@bad_stmnt)
+ fin
+ break
+ is CONT_TKN
+ if cont_tag
+ emit_branch(cont_tag)
+ else
+ return parse_err(@bad_stmnt)
+ fin
+ break
+ is RETURN_TKN
+ if infunc
+ for i = 1 to stack_loop
+ emit_drop
+ next
+ fin
+ if !parse_expr
+ emit_const(0)
+ fin
+ emit_leave
+ break
+ is EOL_TKN
+ return TRUE
+ is ELSE_TKN
+ is ELSEIF_TKN
+ is FIN_TKN
+ is LOOP_TKN
+ is UNTIL_TKN
+ is NEXT_TKN
+ is OF_TKN
+ is DEFAULT_TKN
+ is ENDCASE_TKN
+ is END_TKN
+ is DONE_TKN
+ is DEF_TKN
+ return FALSE
+ is ID_TKN
+ saveptr = tknptr
+ idptr = id_lookup(tknptr, tknlen)
+ if !idptr; return FALSE; fin
+ type = idptr->idtype
+ addr = idptr=>idval
+ if type & VAR_TYPE
+ elem_type = type
+ elem_offset = 0
+ if scan == DOT_TKN or token == COLON_TKN
+ //
+ // Structure member offset
+ //
+ if token == DOT_TKN
+ elem_type = BYTE_TYPE
+ else
+ elem_type = WORD_TYPE
+ fin
+ if !parse_constval(@elem_offset, @elem_size)
+ token = ID_TKN
+ else
+ scan
+ fin
+ fin
+ if token == SET_TKN
+ if !parse_expr; return parse_err(@bad_expr); fin
+ if type & LOCAL_TYPE
+ if elem_type & BYTE_TYPE
+ emit_slb(addr + elem_offset)
+ else
+ emit_slw(addr + elem_offset)
+ fin
+ else
+ if elem_type & BYTE_TYPE
+ emit_sab(addr, elem_offset)
+ else
+ emit_saw(addr, elem_offset)
+ fin
+ fin
+ break
+ fin
+ elsif type & FUNC_TYPE
+ if scan == EOL_TKN
+ emit_call(addr)
+ emit_drop
+ break
+ fin
+ fin
+ tknptr = saveptr
+ otherwise
+ rewind(tknptr)
+ type = parse_value(0)
+ if type
+ if token == SET_TKN
+ if !parse_expr; return parse_err(@bad_expr); fin
+ if type & XBYTE_TYPE
+ emit_sb
+ else
+ emit_sw
+ fin
+ else
+ if type & BPTR_TYPE
+ emit_lb
+ elsif type & WPTR_TYPE
+ emit_lw
+ fin
+ emit_drop
+ fin
+ else
+ return parse_err(@bad_syntax)
+ fin
+ wend
+ if scan <> EOL_TKN
+ return parse_err(@bad_syntax)
+ fin
+ return TRUE
+end
+def parse_var(type)
+ byte consttype, constsize, idlen
+ word idptr, constval, arraysize, size
+
+ idlen = 0
+ size = 1
+ if scan == OPEN_BRACKET_TKN
+ size = 0
+ parse_constexpr(@size, @constsize)
+ if token <> CLOSE_BRACKET_TKN; return parse_err(@no_close_bracket); fin
+ scan
+ fin
+ if token == ID_TKN
+ idptr = tknptr
+ idlen = tknlen
+ if scan == OPEN_BRACKET_TKN
+ size = 0
+ parse_constexpr(@size, @constsize)
+ if token <> CLOSE_BRACKET_TKN; return parse_err(@no_close_bracket); fin
+ scan
+ fin
+ fin
+ if type == WORD_TYPE
+ size = size * 2
+ fin
+ if token == SET_TKN
+ if infunc; return parse_err(@no_local_init); fin
+ if idlen
+ iddata_add(idptr, idlen, type, 0)
+ fin
+ consttype = parse_constexpr(@constval, @constsize)
+ if consttype
+ arraysize = emit_data(type, consttype, constval, constsize)
+ while token == COMMA_TKN
+ consttype = parse_constexpr(@constval, @constsize)
+ if consttype
+ arraysize = arraysize + emit_data(type, consttype, constval, constsize)
+ else
+ return parse_err(@bad_decl)
+ fin
+ loop
+ iddata_size(PTR_TYPE, size, arraysize)
+ else
+ return parse_err(@bad_decl)
+ fin
+ elsif idlen
+ if infunc
+ idlocal_add(idptr, idlen, type, size)
+ else
+ iddata_add(idptr, idlen, type, size)
+ fin
+ fin
+ return TRUE
+end
+def parse_struc
+ byte strucid[16]
+ byte type, idlen, struclen, constsize
+ word size, offset, idstr
+
+ struclen = 0
+ if scan == ID_TKN
+ struclen = tknlen
+ if struclen > 16
+ struclen = 16
+ fin
+ for idlen = 0 to struclen
+ strucid[idlen] = ^(tknptr + idlen)
+ next
+ fin
+ offset = 0
+ while nextln == BYTE_TKN or token == WORD_TKN
+ size = 1
+ if token == BYTE_TKN
+ type = BYTE_TYPE
+ else
+ type = WORD_TYPE
+ fin
+ if scan == OPEN_BRACKET_TKN
+ size = 0
+ parse_constexpr(@size, @constsize)
+ if token <> CLOSE_BRACKET_TKN; return parse_err(@no_close_bracket); fin
+ scan
+ fin
+ repeat
+ idlen = 0;
+ if token == ID_TKN
+ idstr = tknptr
+ idlen = tknlen
+ if scan == OPEN_BRACKET_TKN
+ size = 0
+ parse_constexpr(@size, @constsize)
+ if token <> CLOSE_BRACKET_TKN; return parse_err(@no_close_bracket); fin
+ scan
+ fin
+ fin
+ if type & WORD_TYPE
+ size = size * 2
+ fin
+ if idlen
+ idconst_add(idstr, idlen, offset)
+ fin
+ offset = offset + size
+ until token <> COMMA_TKN
+ if token <> EOL_TKN; return FALSE; fin
+ loop
+ if struclen
+ idconst_add(@strucid, struclen, offset)
+ fin
+ return token == END_TKN
+end
+def parse_vars
+ byte idlen, type, size
+ word value, idptr
+
+ when token
+ is CONST_TKN
+ if scan <> ID_TKN
+ return parse_err(@bad_cnst)
+ fin
+ idptr = tknptr
+ idlen = tknlen
+ if scan <> SET_TKN
+ return parse_err(@bad_cnst)
+ fin
+ if !parse_constexpr(@value, @size)
+ return parse_err(@bad_cnst)
+ fin
+ idconst_add(idptr, idlen, value)
+ break
+ is STRUC_TKN
+ if !parse_struc; parse_err(@bad_struc); fin
+ break
+ is BYTE_TKN
+ is WORD_TKN
+ if token == BYTE_TKN
+ type = BYTE_TYPE
+ else
+ type = WORD_TYPE
+ fin
+ repeat
+ if !parse_var(type)
+ return FALSE
+ fin
+ until token <> COMMA_TKN
+ break
+ is PREDEF_TKN
+ repeat
+ if scan == ID_TKN
+ idfunc_add(tknptr, tknlen, ctag_new)
+ else
+ return parse_err(@bad_decl)
+ fin
+ until scan <> COMMA_TKN
+ break
+ is EOL_TKN
+ break
+ otherwise
+ return FALSE
+ wend
+ return TRUE
+end
+def parse_defs
+ byte cfnparms
+ word func_tag, idptr
+
+ if token == DEF_TKN
+ if scan <> ID_TKN; return parse_err(@bad_decl); fin
+ cfnparms = 0
+ infunc = TRUE
+ idptr = idglobal_lookup(tknptr, tknlen)
+ if idptr
+ func_tag = idptr=>idval
+ else
+ func_tag = ctag_new
+ idfunc_add(tknptr, tknlen, func_tag)
+ fin
+ ctag_resolve(func_tag)
+ retfunc_tag = ctag_new
+ idlocal_init
+ if scan == OPEN_PAREN_TKN
+ repeat
+ if scan == ID_TKN
+ cfnparms = cfnparms + 1
+ idlocal_add(tknptr, tknlen, WORD_TYPE, 2)
+ scan
+ fin
+ until token <> COMMA_TKN
+ if token <> CLOSE_PAREN_TKN
+ return parse_err(@bad_decl)
+ fin
+ scan
+ fin
+ while parse_vars
+ nextln
+ loop
+ emit_enter(cfnparms)
+ prevstmnt = 0
+ while parse_stmnt
+ nextln
+ loop
+ infunc = FALSE
+ if token <> END_TKN; return parse_err(@bad_syntax); fin
+ if scan <> EOL_TKN; return parse_err(@bad_syntax); fin
+ if prevstmnt <> RETURN_TKN
+ emit_const(0)
+ emit_leave
+ fin
+ return TRUE
+ elsif token == EOL_TKN
+ return TRUE
+ fin
+ return FALSE
+end
+def parse_module
+ idglobal_init
+ idlocal_init
+ if nextln
+ while parse_vars
+ nextln
+ loop
+ while parse_defs
+ nextln
+ loop
+ framesize = 0
+ entrypoint = codeptr
+ emit_enter(0)
+ prevstmnt = 0
+ if token <> DONE_TKN
+ while parse_stmnt
+ nextln
+ loop
+ fin
+ if prevstmnt <> RETURN_TKN
+ emit_const(0)
+ emit_leave
+ fin
+ if not parserr
+ //dumpsym(idglobal_tbl, globals)
+ //prstr(@entrypt_str)
+ //prword(entrypoint)
+ prstr(@bytes_compiled_str)
+ prword(codeptr - codebuff)
+ crout
+ keyin()
+ fin
+ return not parserr
+ fin
+ return FALSE
+end
+//
+// Close all files
+//
+^$BFD8 = 0
+close(0)
+//
+// Set memory bitmap
+//
+memset($BF58, 24, 0)
+^$BF58 = $CF
+^$BF6F = $01
+//
+// Init editor
+//
+if !(^machid & $80)
+ flags = uppercase | shiftlock
+ keyin = @keyin2
+else
+ keyin = @keyin2e
+fin
+if signature == $EEEE
+ inittxtbuf
+ if argbuff
+ strcpy(@txtfile, @argbuff)
+ prstr(@txtfile)
+ numlines = 0
+ readtxt(@txtfile)
+ fin
+ signature = 0
+else
+ cmdmode(FALSE)
+fin
+curschr = '+'
+flags = flags | insmode
+drawscrn(scrntop, scrnleft)
+curson
+editmode
+done