mirror of https://github.com/dschmenk/VM02.git
3383 lines
69 KiB
Plaintext
Executable File
3383 lines
69 KiB
Plaintext
Executable File
;
|
|
; 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 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 keyctrlz = $9A
|
|
const keydelete = $FF
|
|
const getbuff = $01FF
|
|
const argbuff = $2006
|
|
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
|
|
;
|
|
; 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 = $70 ; = memory@16 bytes per bit map, 128 bytes per 8 bit map, 1K bytes per 8 byte map
|
|
const maxlnlen = 79
|
|
const strheap = $7000
|
|
const strheasz = $3800
|
|
const codebuff = $A800
|
|
const codebuffsz = $1000
|
|
const pgjmp = 16
|
|
const changed = 1
|
|
const insmode = 2
|
|
const showcurs = 4
|
|
const uppercase = 8
|
|
const shiftlock = 128
|
|
;
|
|
; Editor variables
|
|
;
|
|
byte nullstr[] = ""
|
|
byte version[] = "PLASMA VERSION 0.3 "
|
|
byte errorstr[] = "ERROR: $"
|
|
byte okstr[] = "OK"
|
|
byte perr
|
|
byte outofmem[] = "OUT OF MEMORY!"
|
|
byte losechng[] = "LOSE CHANGES TO FILE (Y/N)?"
|
|
;byte emiterr[] = "EMIT CODE/DATA MISMATCH"
|
|
byte untitled[] = "UNTITLED"
|
|
byte txtfile[64] = "UNTITLED.PLA"
|
|
byte flags = 0
|
|
byte flash = 0
|
|
byte cursx, cursy, scrnleft, curscol, underchr, curschr
|
|
word cursrow, scrntop, cursptr
|
|
word numlines = 0
|
|
word cutbuf = 0
|
|
word keyin
|
|
;
|
|
; Predeclared functions
|
|
;
|
|
func cmdmode
|
|
;
|
|
; Compiler variables
|
|
;
|
|
;
|
|
; Tokens
|
|
;
|
|
const ID_TKN = $D6 ; V
|
|
const CHR_TKN = $C3 ; C
|
|
const INT_TKN = $C9 ; I
|
|
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 = $BF ; ?
|
|
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 = $A1 ; !
|
|
const BPTR_TKN = $DE ; ^
|
|
const WPTR_TKN = $AA ; *
|
|
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 IFUNC_TKN = $95
|
|
const TFUNC_TKN = $96
|
|
const NFUNC_TKN = $97
|
|
const DONE_TKN = $98
|
|
const RETURN_TKN = $99
|
|
const BREAK_TKN = $9A
|
|
const START_TKN = $9B
|
|
const EXIT_TKN = $9C
|
|
const EVAL_TKN = $9D
|
|
const FUNC_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 STR_TYPE = $80
|
|
;
|
|
; Keywords
|
|
;
|
|
byte keywrds[]
|
|
byte = "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", IFUNC_TKN
|
|
byte = "END", END_TKN
|
|
byte = "AND", LOGIC_AND_TKN
|
|
byte = "NOT", LOGIC_NOT_TKN
|
|
byte = "BYTE", BYTE_TKN
|
|
byte = "WORD", WORD_TKN
|
|
byte = "DEFT", TFUNC_TKN
|
|
byte = "DEFN", NFUNC_TKN
|
|
byte = "ELSE", ELSE_TKN
|
|
byte = "NEXT", NEXT_TKN
|
|
byte = "WHEN", CASE_TKN
|
|
byte = "LOOP", LOOP_TKN
|
|
byte = "FUNC", FUNC_TKN
|
|
byte = "STEP", STEP_TKN
|
|
byte = "EXIT", EXIT_TKN
|
|
byte = "DONE", DONE_TKN
|
|
byte = "WEND", ENDCASE_TKN
|
|
byte = "CONST", CONST_TKN
|
|
byte = "ELSIF", ELSEIF_TKN
|
|
byte = "WHILE", WHILE_TKN
|
|
byte = "UNTIL", UNTIL_TKN
|
|
byte = "BREAK", BREAK_TKN
|
|
byte = "OTHER", DEFAULT_TKN
|
|
byte = "DOWNTO",DOWNTO_TKN
|
|
byte = "REPEAT",REPEAT_TKN
|
|
byte = "RETURN",RETURN_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 opstack[16]
|
|
byte precstack[16]
|
|
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 = 640
|
|
const ctag_value = $800
|
|
const ctag_flags = $D80
|
|
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 resolved = 1
|
|
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
|
|
byte token, tknlen
|
|
byte parserrpos, parserr = 0
|
|
word scanptr, tknptr, parserrln
|
|
word constval
|
|
word lineno = 0
|
|
;
|
|
; Compiler output messages
|
|
;
|
|
byte entrypt_str[] = "START: "
|
|
byte comp_ok_msg[] = "COMPILATION COMPLETE"
|
|
byte dup_id[] = "DUPLICATE IDENTIFIER"
|
|
byte undecl_id[] = "UNDECLARED IDENTIFIER"
|
|
byte bad_cnst[] = "BAD CONSTANT"
|
|
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_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[] = "romcall"
|
|
byte RUNTIME0[] = "ROMCALL"
|
|
byte runtime1[] = "syscall"
|
|
byte RUNTIME1[] = "SYSCALL"
|
|
byte runtime2[] = "memset"
|
|
byte RUNTIME2[] = "MEMSET"
|
|
byte runtime3[] = "memcpy"
|
|
byte RUNTIME3[] = "MEMCPY"
|
|
byte runtime4[] = "cout"
|
|
byte RUNTIME4[] = "COUT"
|
|
byte runtime5[] = "cin"
|
|
byte RUNTIME5[] = "CIN"
|
|
byte runtime6[] = "prstr"
|
|
byte RUNTIME6[] = "PRSTR"
|
|
byte runtime7[] = "rdstr"
|
|
byte RUNTIME7[] = "RDSTR"
|
|
;
|
|
; Parser variables
|
|
;
|
|
byte infunc = 0
|
|
byte stack_loop = 0
|
|
byte prevstmnt = 0
|
|
word retfunc_tag = 0
|
|
word break_tag = 0
|
|
func parse_expr, parse_module
|
|
;
|
|
; 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
|
|
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
|
|
return cout ($0D)
|
|
end
|
|
def bell
|
|
return romcall(0, 0, 0, 0, $FBDD)
|
|
end
|
|
;
|
|
; Memory management routines
|
|
;
|
|
def strcpy(srcstr, dststr)
|
|
byte strlen
|
|
|
|
strlen = ^srcstr
|
|
while (srcstr).[strlen] == $8D or (srcstr).[strlen] == $A0
|
|
strlen = strlen - 1
|
|
loop
|
|
^dststr = strlen
|
|
return memcpy(srcstr + 1, dststr + 1, strlen)
|
|
end
|
|
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
|
|
end
|
|
deft 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)
|
|
end
|
|
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(strptr, newptr, strlen + 1)
|
|
^newptr = strlen
|
|
return newptr
|
|
fin
|
|
return @nullstr
|
|
end
|
|
def inittxtbuf
|
|
word i
|
|
|
|
memset(0, strheapmap, strheapmsz)
|
|
memset(@nullstr, strlinbuf, maxfill * 2)
|
|
entrypoint = 0
|
|
numlines = 0
|
|
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('$')
|
|
romcall(h, 0, 0, 0, $FDDA)
|
|
end
|
|
def prword(h)
|
|
cout('$')
|
|
romcall(h >> 8, h, 0, 0, $F941)
|
|
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
|
|
prstr(@numstr[place])
|
|
end
|
|
def nametostr(namestr, len, strptr)
|
|
^strptr = len
|
|
memcpy(namestr, strptr + 1, len)
|
|
end
|
|
;def toupper(c)
|
|
; if c >= 'a'
|
|
; if c <= 'z'
|
|
; return c - $20
|
|
; fin
|
|
; fin
|
|
; return c
|
|
;end
|
|
asm toupper
|
|
LDA ESTKL,X
|
|
CMP #'a'
|
|
BCC :+
|
|
CMP #'z'+1
|
|
BCS :+
|
|
SEC
|
|
SBC #$20
|
|
STA ESTKL,X
|
|
: RTS
|
|
end
|
|
asm clrhibit(strptr)
|
|
LDY #$02 ; strptr
|
|
LDA (FP),Y
|
|
STA TMPL
|
|
INY
|
|
LDA (FP),Y
|
|
STA TMPH
|
|
LDY #$00
|
|
LDA (TMP),Y
|
|
BEQ :+
|
|
TAY
|
|
CLHILP: LDA (TMP),Y
|
|
AND #$7F
|
|
STA (TMP),Y
|
|
DEY
|
|
BNE CLHILP
|
|
:
|
|
end
|
|
asm sethibit(strptr)
|
|
LDY #$02 ; strptr
|
|
LDA (FP),Y
|
|
STA TMPL
|
|
INY
|
|
LDA (FP),Y
|
|
STA TMPH
|
|
LDY #$00
|
|
LDA (TMP),Y
|
|
BEQ :+
|
|
TAY
|
|
STHILP: LDA (TMP),Y
|
|
ORA #$80
|
|
STA (TMP),Y
|
|
DEY
|
|
BNE STHILP
|
|
:
|
|
end
|
|
asm cpyln(srcstr, dststr)
|
|
LDY #$02 ; srcstr
|
|
LDA (FP),Y
|
|
STA TMPL
|
|
INY
|
|
LDA (FP),Y
|
|
STA TMPH
|
|
INY ; dststr
|
|
LDA (FP),Y
|
|
STA $06
|
|
INY
|
|
LDA (FP),Y
|
|
STA $07
|
|
LDY #$00
|
|
LDA (TMP),Y
|
|
TAY
|
|
LDA #$00
|
|
INY
|
|
STA ($06),Y
|
|
DEY
|
|
BEQ :++
|
|
CPLNLP: LDA (TMP),Y
|
|
CMP #$20
|
|
BCS :+
|
|
ADC #$60
|
|
: AND #$7F
|
|
STA ($06),Y
|
|
DEY
|
|
BNE CPLNLP
|
|
LDA (TMP),Y
|
|
: STA ($06),Y
|
|
end
|
|
;
|
|
; File routines
|
|
;
|
|
def readtxt(filename)
|
|
byte txtbuf[81], refnum, i, j
|
|
|
|
refnum = open(filename, iobuffer)
|
|
if refnum == 0
|
|
return 0
|
|
fin
|
|
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)
|
|
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 0
|
|
fin
|
|
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
|
|
close(refnum)
|
|
end
|
|
;
|
|
; Screen routines
|
|
;
|
|
def drawrow(row, ofst, strptr)
|
|
byte numchars
|
|
word scrnptr
|
|
|
|
scrnptr = txtscrn[row]
|
|
if ^strptr <= ofst
|
|
numchars = 0
|
|
else
|
|
numchars = ^strptr - ofst
|
|
fin
|
|
if numchars >= 40
|
|
numchars = 40
|
|
else
|
|
memset($A0A0, scrnptr + numchars, 40 - numchars)
|
|
fin
|
|
memcpy(strptr + ofst + 1, scrnptr, numchars)
|
|
end
|
|
deft drawscrn(toprow, ofst)
|
|
byte row, numchars
|
|
word strptr, scrnptr
|
|
|
|
for row = 0 to 23
|
|
strptr = strlinbuf:[toprow + row]
|
|
scrnptr = txtscrn[row]
|
|
if ^strptr <= ofst
|
|
numchars = 0
|
|
else
|
|
numchars = ^strptr - ofst
|
|
fin
|
|
if numchars >= 40
|
|
numchars = 40
|
|
else
|
|
memset($A0A0, scrnptr + numchars, 40 - numchars)
|
|
fin
|
|
memcpy(strptr + ofst + 1, scrnptr, 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)
|
|
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)
|
|
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
|
|
repeat
|
|
cursflash
|
|
until ^keyboard >= 128
|
|
return ^keystrobe
|
|
end
|
|
def keyin2
|
|
byte key, flash
|
|
|
|
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 = $DC ; \
|
|
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], @strlinbuf:[row + 1], (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 + 1], @strlinbuf:[cursrow], (numlines - cursrow) * 2)
|
|
if numlines > 1
|
|
numlines = numlines - 1
|
|
fin
|
|
flags = flags ? changed
|
|
if cursrow == numlines
|
|
cursup
|
|
fin
|
|
redraw
|
|
end
|
|
def pasteline
|
|
if cutbuf and numlines < maxlines
|
|
memcpy(@strlinbuf:[cursrow], @strlinbuf:[cursrow + 1], (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(strlinbuf:[cursrow], @joinstr)
|
|
joinlen = joinstr + ^(strlinbuf:[cursrow + 1])
|
|
if joinlen < 80
|
|
memcpy(strlinbuf:[cursrow + 1] + 1, @joinstr + joinstr + 1, ^(strlinbuf:[cursrow + 1]))
|
|
joinstr = joinlen
|
|
freestr(strlinbuf:[cursrow])
|
|
strlinbuf:[cursrow] = newstr(@joinstr)
|
|
freestr(strlinbuf:[cursrow + 1])
|
|
numlines = numlines - 1
|
|
memcpy(@strlinbuf:[cursrow + 2], @strlinbuf:[cursrow + 1], (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(strlinbuf:[cursrow] + curscol + 1, @splitstr + 1, splitlen - curscol)
|
|
splitstr = splitlen - curscol
|
|
strlinbuf:[cursrow + 1] = newstr(@splitstr)
|
|
memcpy(strlinbuf:[cursrow] + 1, @splitstr + 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 1
|
|
elsif key == keydelete
|
|
return 1
|
|
elsif key == keyctrld
|
|
return 1
|
|
elsif key == keyctrlr
|
|
return 1
|
|
fin
|
|
end
|
|
def editline(key)
|
|
byte editstr[80]
|
|
word undoline
|
|
|
|
if (editkey(key))
|
|
flags = flags ? changed
|
|
memset($A0A0, @editstr, 80)
|
|
strcpy(strlinbuf:[cursrow], @editstr)
|
|
undoline = strlinbuf:[cursrow]
|
|
strlinbuf:[cursrow] = @editstr
|
|
repeat
|
|
if key >= keyspace
|
|
if key == keydelete
|
|
if curscol > 0
|
|
if curscol <= editstr
|
|
memcpy(@editstr[curscol + 1], @editstr[curscol], 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], @editstr[curscol + 1], 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
|
|
memcpy(@editstr[curscol + 2], @editstr[curscol + 1], editstr - curscol)
|
|
editstr = editstr - 1
|
|
cursoff
|
|
drawrow(cursy, scrnleft, @editstr)
|
|
curson
|
|
fin
|
|
elsif key == keyctrlr
|
|
strcpy(undoline, @editstr)
|
|
cursoff
|
|
drawrow(cursy, scrnleft, @editstr)
|
|
curson
|
|
fin
|
|
key = keyin()
|
|
until !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
|
|
is keyarrowdown
|
|
cursdown
|
|
is keyarrowleft
|
|
cursleft
|
|
is keyarrowright
|
|
cursright
|
|
is keyctrlw
|
|
pgup
|
|
is keyctrlz
|
|
pgdown
|
|
is keyctrla
|
|
pgleft
|
|
is keyctrls
|
|
pgright
|
|
is keyctrlq
|
|
curshome
|
|
is keyctrle
|
|
cursend
|
|
is keyctrlx
|
|
cutline
|
|
is keyctrlv
|
|
pasteline
|
|
is keyctrlo
|
|
openline(cursrow)
|
|
redraw
|
|
is keyenter
|
|
if flags & insmode
|
|
splitline
|
|
else
|
|
openline(cursrow + 1)
|
|
cursdown
|
|
redraw
|
|
fin
|
|
is keyctrlt
|
|
joinline
|
|
is keyctrli
|
|
if flags & insmode
|
|
flags = flags & #insmode
|
|
curschr = ' '
|
|
else
|
|
flags = flags ? insmode
|
|
curschr = '+'
|
|
fin
|
|
is keyctrlc
|
|
if flags & uppercase
|
|
txtlower
|
|
else
|
|
txtupper
|
|
fin
|
|
redraw
|
|
is keyescape
|
|
cursoff
|
|
cmdmode
|
|
redraw
|
|
otherwise
|
|
bell
|
|
wend
|
|
until 0
|
|
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(optpath, @path)
|
|
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 + 2, strptr + 1, ^strptr)
|
|
^strptr = ^strptr - 1
|
|
loop
|
|
end
|
|
def parsecmd(strptr)
|
|
byte cmd
|
|
|
|
cmd = 0
|
|
striplead(strptr, $A0)
|
|
if ^strptr
|
|
cmd = ^(strptr + 1)
|
|
striplead(strptr, cmd)
|
|
fin
|
|
if ^strptr
|
|
striplead(strptr, $A0)
|
|
fin
|
|
return cmd & $7F
|
|
end
|
|
def upcase(chr)
|
|
if chr >= 'a' and chr <= 'z'
|
|
chr = chr - 'a' + 'A'
|
|
fin
|
|
return chr
|
|
end
|
|
def chkchng
|
|
if flags & changed
|
|
prstr(@losechng)
|
|
if upcase(keyin() & $7F) == 'N'
|
|
crout
|
|
return 0
|
|
fin
|
|
crout
|
|
fin
|
|
return 1
|
|
end
|
|
def quit
|
|
if chkchng
|
|
exit
|
|
fin
|
|
end
|
|
def cmdmode
|
|
byte slot
|
|
word cmdptr
|
|
|
|
romcall(0, 0, 0, 0, $FC58)
|
|
crout
|
|
while 1
|
|
prstr(@txtfile)
|
|
cmdptr = rdstr($BA)
|
|
when upcase(parsecmd(cmdptr))
|
|
is 'A'
|
|
readtxt(cmdptr)
|
|
flags = flags ? changed
|
|
is 'R'
|
|
if chkchng
|
|
inittxtbuf
|
|
strcpy(cmdptr, @txtfile)
|
|
readtxt(@txtfile)
|
|
entrypoint = 0
|
|
flags = flags & #changed
|
|
fin
|
|
is 'W'
|
|
if ^cmdptr
|
|
strcpy(cmdptr, @txtfile)
|
|
fin
|
|
writetxt(@txtfile)
|
|
if flags & changed
|
|
entrypoint = 0
|
|
fin
|
|
flags = flags & #changed
|
|
is 'Q'
|
|
quit
|
|
is 'C'
|
|
prfiles(cmdptr)
|
|
is 'P'
|
|
setpfx(cmdptr)
|
|
is 'H'
|
|
if ^cmdptr
|
|
slot = cmdptr.1 & $7F - '0'
|
|
else
|
|
slot = 1
|
|
fin
|
|
printtxt(slot)
|
|
is 'E'
|
|
return
|
|
is 0
|
|
return
|
|
is 'N'
|
|
if chkchng
|
|
inittxtbuf
|
|
numlines = 1
|
|
strcpy(@untitled, @txtfile)
|
|
fin
|
|
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
|
|
else
|
|
crout
|
|
(entrypoint)()
|
|
fin
|
|
else
|
|
(entrypoint)()
|
|
fin
|
|
crout
|
|
is 'V'
|
|
prstr(@version)
|
|
wend
|
|
if perr
|
|
prstr(@errorstr)
|
|
romcall(perr, 0, 0, 0, $FDDA)
|
|
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
|
|
;
|
|
; Emit bytecode
|
|
;
|
|
def ctag_new
|
|
if codetag >= ctag_max
|
|
return parse_err(@ctag_full)
|
|
fin
|
|
codetag = codetag + 1
|
|
ctag_value:[codetag] = 0
|
|
ctag_flags.[codetag] = 0
|
|
return codetag ? is_ctag
|
|
end
|
|
def ctag_resolve(tag, addr)
|
|
word updtptr, nextptr
|
|
|
|
tag = tag & mask_ctag
|
|
if ctag_flags.[tag] & resolved
|
|
return parse_err(@dup_id)
|
|
fin
|
|
updtptr = ctag_value:[tag]
|
|
while updtptr
|
|
;
|
|
; Update list of addresses needing resolution
|
|
;
|
|
nextptr = *updtptr
|
|
*updtptr = addr
|
|
updtptr = nextptr
|
|
loop
|
|
ctag_value:[tag] = addr
|
|
ctag_flags.[tag] = ctag_flags.[tag] ? resolved
|
|
end
|
|
defn emit_byte(bval)
|
|
^codeptr = bval
|
|
codeptr = codeptr + 1
|
|
end
|
|
defn emit_word(wval)
|
|
*codeptr = wval
|
|
codeptr = codeptr + 2
|
|
end
|
|
def emit_fill(size)
|
|
memset(0, codeptr, size)
|
|
codeptr = codeptr + size
|
|
end
|
|
def emit_codetag(tag)
|
|
return ctag_resolve(tag, codeptr)
|
|
end
|
|
deft emit_op(op)
|
|
lastop = op
|
|
return emit_byte(op)
|
|
end
|
|
def emit_tag(tag)
|
|
word updtptr
|
|
|
|
if tag & is_ctag
|
|
tag = tag & mask_ctag
|
|
updtptr = ctag_value:[tag]
|
|
if !(ctag_flags.[tag] & resolved)
|
|
;
|
|
; Add to list of tags needing resolution
|
|
;
|
|
ctag_value:[tag] = codeptr
|
|
fin
|
|
emit_word(updtptr)
|
|
else
|
|
emit_word(tag + 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 == WORD_TYPE
|
|
size = 2
|
|
emit_word(constval)
|
|
else
|
|
size = 1
|
|
emit_byte(constval)
|
|
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(index)
|
|
emit_op($64)
|
|
return emit_byte(index)
|
|
end
|
|
def emit_llw(index)
|
|
emit_op($66)
|
|
return emit_byte(index)
|
|
end
|
|
def emit_lab(tag)
|
|
emit_op($68)
|
|
return emit_tag(tag)
|
|
end
|
|
def emit_law(tag)
|
|
emit_op($6A)
|
|
return emit_tag(tag)
|
|
end
|
|
def emit_sb
|
|
return emit_op($70)
|
|
end
|
|
def emit_sw
|
|
return emit_op($72)
|
|
end
|
|
def emit_slb(index)
|
|
emit_op($74)
|
|
return emit_byte(index)
|
|
end
|
|
def emit_slw(index)
|
|
emit_op($76)
|
|
return emit_byte(index)
|
|
end
|
|
def emit_dlb(index)
|
|
emit_op($6C)
|
|
return emit_byte(index)
|
|
end
|
|
def emit_dlw(index)
|
|
emit_op($6E)
|
|
return emit_byte(index)
|
|
end
|
|
def emit_sab(tag)
|
|
emit_op($78)
|
|
return emit_tag(tag)
|
|
end
|
|
def emit_saw(tag)
|
|
emit_op($7A)
|
|
return emit_tag(tag)
|
|
end
|
|
def emit_dab(tag)
|
|
emit_op($7C)
|
|
return emit_tag(tag)
|
|
end
|
|
def emit_daw(tag)
|
|
emit_op($7E)
|
|
return emit_tag(tag)
|
|
end
|
|
def emit_call(tag, cparams)
|
|
emit_op($54)
|
|
return emit_tag(tag)
|
|
end
|
|
def emit_ical(cparams)
|
|
emit_op($56)
|
|
return emit_byte(cparams)
|
|
end
|
|
def emit_push
|
|
emit_op($34)
|
|
end
|
|
def emit_pull
|
|
;
|
|
; Skip if last op was push
|
|
;
|
|
if lastop == $34
|
|
codeptr = codeptr - 1
|
|
lastop = $FF
|
|
else
|
|
emit_op($36)
|
|
fin
|
|
end
|
|
def emit_localaddr(index)
|
|
emit_op($28)
|
|
return emit_byte(index)
|
|
end
|
|
def emit_globaladdr(tag)
|
|
emit_op($26)
|
|
return emit_tag(tag)
|
|
end
|
|
def emit_indexbyte
|
|
return emit_op($2E)
|
|
end
|
|
def emit_indexword
|
|
return emit_op($1E)
|
|
end
|
|
def emit_unaryop(op)
|
|
when op
|
|
is NEG_TKN
|
|
emit_op($10)
|
|
is COMP_TKN
|
|
emit_op($12)
|
|
is LOGIC_NOT_TKN
|
|
emit_op($20)
|
|
is INC_TKN
|
|
emit_op($0C)
|
|
is DEC_TKN
|
|
emit_op($0E)
|
|
is BPTR_TKN
|
|
emit_op($60)
|
|
is WPTR_TKN
|
|
emit_op($62)
|
|
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
|
|
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
|
|
is MOD_TKN
|
|
emit_op($0A)
|
|
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
|
|
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
|
|
is SHL_TKN
|
|
emit_op($1A)
|
|
is SHR_TKN
|
|
emit_op($1C)
|
|
is AND_TKN
|
|
emit_op($14)
|
|
is OR_TKN
|
|
emit_op($16)
|
|
is EOR_TKN
|
|
emit_op($18)
|
|
is EQ_TKN
|
|
emit_op($40)
|
|
is NE_TKN
|
|
emit_op($42)
|
|
is GE_TKN
|
|
emit_op($48)
|
|
is LT_TKN
|
|
emit_op($46)
|
|
is GT_TKN
|
|
emit_op($44)
|
|
is LE_TKN
|
|
emit_op($4A)
|
|
is LOGIC_OR_TKN
|
|
emit_op($22)
|
|
is LOGIC_AND_TKN
|
|
emit_op($24)
|
|
otherwise
|
|
return FALSE
|
|
wend
|
|
return TRUE
|
|
end
|
|
def emit_brtru(tag)
|
|
emit_op($4E)
|
|
return emit_tag(tag)
|
|
end
|
|
def emit_brfls(tag)
|
|
emit_op($4C)
|
|
return emit_tag(tag)
|
|
end
|
|
def emit_brgt(tag)
|
|
emit_op($3A)
|
|
return emit_tag(tag)
|
|
end
|
|
def emit_brlt(tag)
|
|
emit_op($38)
|
|
return emit_tag(tag)
|
|
end
|
|
def emit_brne(tag)
|
|
emit_op($3E)
|
|
return emit_tag(tag)
|
|
end
|
|
def emit_jump(tag)
|
|
emit_op($50)
|
|
return emit_tag(tag)
|
|
end
|
|
def emit_drop
|
|
return emit_op($30)
|
|
end
|
|
def emit_leave(framesize)
|
|
if framesize > 2
|
|
emit_op($5A)
|
|
else
|
|
emit_op($5C)
|
|
fin
|
|
end
|
|
def emit_enter(framesize, cparams)
|
|
emit_byte(emit_enter.[0])
|
|
emit_byte(emit_enter.[1])
|
|
emit_byte(emit_enter.[2])
|
|
if framesize > 2
|
|
emit_op($58)
|
|
emit_byte(framesize)
|
|
emit_byte(cparams)
|
|
fin
|
|
end
|
|
def emit_start
|
|
;
|
|
; Save address
|
|
;
|
|
entrypoint = codeptr
|
|
emit_byte(emit_start.[0])
|
|
emit_byte(emit_start.[1])
|
|
return emit_op(emit_start.[2])
|
|
end
|
|
def emit_exit
|
|
emit_op($00)
|
|
return emit_op($5C)
|
|
end
|
|
;
|
|
; Lexical anaylzer
|
|
;
|
|
;defn 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 #'A'
|
|
BCC ISALRET
|
|
CMP #'Z'+1
|
|
BCS :+
|
|
DEY
|
|
BNE ISALRET
|
|
: CMP #'a'
|
|
BCC ISALRET
|
|
CMP #'z'+1
|
|
BCS :+
|
|
DEY
|
|
BNE ISALRET
|
|
: CMP #'_'
|
|
BNE ISALRET
|
|
DEY
|
|
ISALRET:
|
|
STY ESTKL,X
|
|
STY ESTKH,X
|
|
RTS
|
|
end
|
|
;defn 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
|
|
;defn 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 #'0'
|
|
BCC ISANRET
|
|
CMP #'9'+1
|
|
BCS :+
|
|
DEY
|
|
BNE ISANRET
|
|
: CMP #'A'
|
|
BCC ISANRET
|
|
CMP #'Z'+1
|
|
BCS :+
|
|
DEY
|
|
BNE ISANRET
|
|
: CMP #'a'
|
|
BCC ISANRET
|
|
CMP #'z'+1
|
|
BCS :+
|
|
DEY
|
|
BNE ISANRET
|
|
: CMP #'_'
|
|
BNE ISANRET
|
|
DEY
|
|
ISANRET:
|
|
STY ESTKL,X
|
|
STY ESTKH,X
|
|
RTS
|
|
end
|
|
deft keymatch(chrptr, len)
|
|
byte i, keypos
|
|
|
|
keypos = 0
|
|
while keywrds[keypos] < len
|
|
keypos = keypos + keywrds[keypos] + 2
|
|
loop
|
|
while keywrds[keypos] == len
|
|
for i = 1 to len
|
|
if toupper((chrptr).[i - 1]) <> keywrds[keypos + i]
|
|
break
|
|
fin
|
|
next
|
|
if i > len
|
|
return keywrds[keypos + keywrds[keypos] + 1]
|
|
fin
|
|
keypos = keypos + keywrds[keypos] + 2
|
|
loop
|
|
return ID_TKN
|
|
end
|
|
def skipspace
|
|
;
|
|
; Skip whitespace
|
|
;
|
|
while ^scanptr and ^scanptr <= ' '
|
|
scanptr = scanptr + 1
|
|
loop
|
|
tknptr = scanptr
|
|
return !^scanptr or ^scanptr == ';'
|
|
end
|
|
deft scan
|
|
;
|
|
; Scan for token based on first character
|
|
;
|
|
if skipspace
|
|
if token <> EOF_TKN
|
|
token = EOL_TKN
|
|
fin
|
|
elsif isalpha(^scanptr)
|
|
;
|
|
; ID, either variable name or reserved word
|
|
;
|
|
repeat
|
|
scanptr = scanptr + 1
|
|
until !isalphanum(^scanptr)
|
|
tknlen = scanptr - tknptr;
|
|
token = keymatch(tknptr, tknlen)
|
|
elsif isnum(^scanptr)
|
|
;
|
|
; Number constant
|
|
;
|
|
token = INT_TKN
|
|
constval = 0
|
|
repeat
|
|
constval = constval * 10 + ^scanptr - '0'
|
|
scanptr = scanptr + 1
|
|
until !isnum(^scanptr)
|
|
elsif ^scanptr == '$'
|
|
;
|
|
; 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
|
|
elsif ^scanptr == $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
|
|
is 'r'
|
|
constval = $0A
|
|
is 't'
|
|
constval = $09
|
|
otherwise
|
|
constval = ^(scanptr + 2)
|
|
wend
|
|
if ^(scanptr + 3) <> $27 ; '
|
|
return parse_err(@bad_cnst)
|
|
fin
|
|
scanptr = scanptr + 4
|
|
fin
|
|
elsif ^scanptr == '"'
|
|
;
|
|
; 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
|
|
else
|
|
;
|
|
; Potential two and three character tokens
|
|
;
|
|
when ^scanptr
|
|
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
|
|
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
|
|
is '='
|
|
if ^(scanptr + 1) == '='
|
|
token = EQ_TKN
|
|
scanptr = scanptr + 2;
|
|
else
|
|
token = SET_TKN;
|
|
scanptr = scanptr + 1
|
|
fin
|
|
otherwise
|
|
;
|
|
; Simple single character tokens
|
|
;
|
|
token = ^scanptr ? $80
|
|
scanptr = scanptr + 1
|
|
wend
|
|
fin
|
|
tknlen = scanptr - tknptr
|
|
return token
|
|
end
|
|
def rewind(ptr)
|
|
scanptr = ptr
|
|
end
|
|
;
|
|
; Get next line of input
|
|
;
|
|
def nextln
|
|
; if ^keyboard == $A0
|
|
; ^keystrobe
|
|
; while ^keyboard < 128
|
|
; loop
|
|
; ^keystrobe
|
|
; elsif ^keyboard == $82
|
|
; lineno = numlines
|
|
; ^keystrobe
|
|
; fin
|
|
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 = $00
|
|
token = DONE_TKN
|
|
fin
|
|
return ^instr
|
|
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
|
|
;
|
|
; Symbol table
|
|
;
|
|
deft 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_value:[(idptr):idval & mask_ctag])
|
|
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 + emit_data(0, 0, 0, varsize - initsize)
|
|
else
|
|
datasize = datasize + initsize
|
|
fin
|
|
; if datasize <> codeptr - codebuff
|
|
; prstr(@emiterr)
|
|
; keyin()
|
|
; 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
|
|
datasize = 0
|
|
globals = 0
|
|
lastglobal = idglobal_tbl
|
|
codetag = -1
|
|
ctag = ctag_new
|
|
idfunc_add(@runtime0 + 1, runtime0, ctag)
|
|
idfunc_add(@RUNTIME0 + 1, RUNTIME0, ctag)
|
|
ctag_resolve(ctag, @romcall)
|
|
ctag = ctag_new
|
|
idfunc_add(@runtime1 + 1, runtime1, ctag)
|
|
idfunc_add(@RUNTIME1 + 1, RUNTIME1, ctag)
|
|
ctag_resolve(ctag, @syscall)
|
|
ctag = ctag_new
|
|
idfunc_add(@runtime2 + 1, runtime2, ctag)
|
|
idfunc_add(@RUNTIME2 + 1, RUNTIME2, ctag)
|
|
ctag_resolve(ctag, @memset)
|
|
ctag = ctag_new
|
|
idfunc_add(@runtime3 + 1, runtime3, ctag)
|
|
idfunc_add(@RUNTIME3 + 1, RUNTIME3, ctag)
|
|
ctag_resolve(ctag, @memcpy)
|
|
ctag = ctag_new
|
|
idfunc_add(@runtime4 + 1, runtime4, ctag)
|
|
idfunc_add(@RUNTIME4 + 1, RUNTIME4, ctag)
|
|
ctag_resolve(ctag, @cout)
|
|
ctag = ctag_new
|
|
idfunc_add(@runtime5 + 1, runtime5, ctag)
|
|
idfunc_add(@RUNTIME5 + 1, RUNTIME5, ctag)
|
|
ctag_resolve(ctag, @cin)
|
|
ctag = ctag_new
|
|
idfunc_add(@runtime6 + 1, runtime6, ctag)
|
|
idfunc_add(@RUNTIME6 + 1, RUNTIME6, ctag)
|
|
ctag_resolve(ctag, @prstr)
|
|
ctag = ctag_new
|
|
idfunc_add(@runtime7 + 1, runtime7, ctag)
|
|
idfunc_add(@RUNTIME7 + 1, RUNTIME7, ctag)
|
|
ctag_resolve(ctag, @rdstr)
|
|
end
|
|
def idlocal_init
|
|
locals = 0
|
|
framesize = 2
|
|
lastlocal = idlocal_tbl
|
|
end
|
|
;
|
|
; Parser
|
|
;
|
|
def parse_term
|
|
when scan
|
|
is ID_TKN
|
|
return TRUE
|
|
is INT_TKN
|
|
return TRUE
|
|
is CHR_TKN
|
|
return TRUE
|
|
is STR_TKN
|
|
return TRUE
|
|
is OPEN_PAREN_TKN
|
|
if !parse_expr
|
|
return FALSE
|
|
fin
|
|
if token <> CLOSE_PAREN_TKN
|
|
return parse_err(@no_close_paren)
|
|
fin
|
|
return TRUE
|
|
wend
|
|
return FALSE
|
|
end
|
|
def parse_constval(valptr, sizeptr)
|
|
byte mod, type
|
|
word idptr
|
|
|
|
mod = 0
|
|
type = 0
|
|
*valptr = 0
|
|
while !parse_term
|
|
when token
|
|
is SUB_TKN
|
|
mod = mod ? 1
|
|
is COMP_TKN
|
|
mod = mod ? 2
|
|
is LOGIC_NOT_TKN
|
|
mod = mod ? 4
|
|
is AT_TKN
|
|
mod = mod ? 8
|
|
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
|
|
is CHR_TKN
|
|
*valptr = constval
|
|
^sizeptr = 1
|
|
type = BYTE_TYPE
|
|
is INT_TKN
|
|
*valptr = constval
|
|
^sizeptr = 2
|
|
type = WORD_TYPE
|
|
is ID_TKN
|
|
^sizeptr = 2
|
|
idptr = id_lookup(tknptr, tknlen)
|
|
if !idptr
|
|
return parse_err(@bad_cnst)
|
|
fin
|
|
type = (idptr).idtype
|
|
*valptr = (idptr):idval
|
|
if type & VAR_TYPE and !(mod & 8)
|
|
return parse_err(@bad_cnst)
|
|
fin
|
|
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
|
|
deft ispostop
|
|
scan
|
|
when token
|
|
is OPEN_PAREN_TKN
|
|
return TRUE
|
|
is OPEN_BRACKET_TKN
|
|
return TRUE
|
|
is DOT_TKN
|
|
return TRUE
|
|
is COLON_TKN
|
|
return TRUE
|
|
wend
|
|
return FALSE
|
|
end
|
|
def parse_value(rvalue)
|
|
byte cparams, deref, type, emit_val
|
|
word optos, idptr, value
|
|
byte elem_type, elem_size
|
|
word elem_offset
|
|
|
|
deref = rvalue
|
|
optos = opsp
|
|
type = 0
|
|
emit_val = FALSE
|
|
value = 0
|
|
|
|
;
|
|
; Parse pre-ops
|
|
;
|
|
while !parse_term
|
|
when token
|
|
is ADD_TKN
|
|
is BPTR_TKN
|
|
if deref
|
|
push_op(token, 0)
|
|
else
|
|
type = type ? BPTR_TYPE
|
|
deref = deref + 1
|
|
fin
|
|
is WPTR_TKN
|
|
if deref
|
|
push_op(token, 0)
|
|
else
|
|
type = type ? WPTR_TYPE
|
|
deref = deref + 1
|
|
fin
|
|
is AT_TKN
|
|
deref = deref - 1
|
|
is SUB_TKN
|
|
push_op(token, 0)
|
|
is COMP_TKN
|
|
push_op(token, 0)
|
|
is LOGIC_NOT_TKN
|
|
push_op(token, 0)
|
|
otherwise
|
|
return 0
|
|
wend
|
|
loop
|
|
;
|
|
; Determine terminal type
|
|
;
|
|
when token
|
|
is INT_TKN
|
|
type = type ? CONST_TYPE
|
|
value = constval
|
|
is CHR_TKN
|
|
type = type ? CONST_TYPE
|
|
value = constval
|
|
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
|
|
is CLOSE_PAREN_TKN
|
|
type = type ? WORD_TYPE
|
|
emit_val = TRUE
|
|
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
|
|
is COMP_TKN
|
|
pop_op
|
|
value = #value
|
|
is LOGIC_NOT_TKN
|
|
pop_op
|
|
value = !value
|
|
otherwise
|
|
cparams = FALSE
|
|
wend
|
|
loop
|
|
fin
|
|
;
|
|
; Parse post-ops
|
|
;
|
|
while ispostop
|
|
if token == OPEN_BRACKET_TKN
|
|
;
|
|
; Array
|
|
;
|
|
if !emit_val
|
|
if type & ADDR_TYPE
|
|
if type & LOCAL_TYPE
|
|
emit_localaddr(value)
|
|
else
|
|
emit_globaladdr(value)
|
|
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
|
|
elsif token == DOT_TKN or token == 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 type & LOCAL_TYPE
|
|
emit_localaddr(value + elem_offset)
|
|
else
|
|
; emit_globaladdr(value + elem_offset)
|
|
emit_globaladdr(value)
|
|
emit_const(elem_offset)
|
|
emit_binaryop(ADD_TKN)
|
|
fin
|
|
elsif type & CONST_TYPE
|
|
value = value + elem_offset
|
|
emit_const(value)
|
|
else ; FUNC_TYPE
|
|
emit_globaladdr(value)
|
|
emit_const(elem_offset)
|
|
emit_binaryop(ADD_TKN)
|
|
fin
|
|
emit_val = TRUE
|
|
else
|
|
if elem_offset <> 0
|
|
emit_const(elem_offset)
|
|
emit_binaryop(ADD_TKN)
|
|
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)
|
|
else
|
|
emit_globaladdr(value)
|
|
fin
|
|
elsif type & CONST_TYPE
|
|
emit_const(value)
|
|
fin
|
|
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
|
|
elsif token == OPEN_PAREN_TKN
|
|
;
|
|
; Function call
|
|
;
|
|
if !emit_val and type & VAR_TYPE
|
|
if type & LOCAL_TYPE
|
|
emit_localaddr(value)
|
|
else
|
|
emit_globaladdr(value)
|
|
fin
|
|
fin
|
|
if !(type & FUNC_CONST_TYPE)
|
|
emit_push
|
|
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, cparams)
|
|
else
|
|
emit_pull
|
|
emit_ical(cparams)
|
|
fin
|
|
emit_val = TRUE
|
|
type = WORD_TYPE
|
|
fin
|
|
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, 0)
|
|
elsif type & VAR_TYPE
|
|
if type & LOCAL_TYPE
|
|
if type & BYTE_TYPE
|
|
emit_llb(value)
|
|
else
|
|
emit_llw(value)
|
|
fin
|
|
else
|
|
if type & BYTE_TYPE
|
|
emit_lab(value)
|
|
else
|
|
emit_law(value)
|
|
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)
|
|
else
|
|
emit_globaladdr(value)
|
|
fin
|
|
fin
|
|
fin ; emit_val
|
|
while optos < opsp
|
|
if !emit_unaryop(pop_op)
|
|
return parse_err(@bad_op)
|
|
fin
|
|
loop
|
|
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
|
|
is SUB_TKN
|
|
type = parse_constval(@val2, @size2)
|
|
if !type
|
|
return 0
|
|
fin
|
|
*valptr = val1 - val2
|
|
is MUL_TKN
|
|
type = parse_constval(@val2, @size2)
|
|
if !type
|
|
return 0
|
|
fin
|
|
*valptr = val1 * val2
|
|
is DIV_TKN
|
|
type = parse_constval(@val2, @size2)
|
|
if !type
|
|
return 0
|
|
fin
|
|
*valptr = val1 + val2
|
|
is MOD_TKN
|
|
type = parse_constval(@val2, @size2)
|
|
if !type
|
|
return 0
|
|
fin
|
|
*valptr = val1 % val2
|
|
is AND_TKN
|
|
type = parse_constval(@val2, @size2)
|
|
if !type
|
|
return 0
|
|
fin
|
|
*valptr = val1 & val2
|
|
is OR_TKN
|
|
type = parse_constval(@val2, @size2)
|
|
if !type
|
|
return 0
|
|
fin
|
|
*valptr = val1 ? val2
|
|
is EOR_TKN
|
|
type = parse_constval(@val2, @size2)
|
|
if !type
|
|
return 0
|
|
fin
|
|
*valptr = val1 ^ val2
|
|
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, i
|
|
word tag_prevbrk, tag_else, tag_endif, tag_while, tag_wend
|
|
word tag_repeat, tag_for, tag_choice, idptr, saveptr, addr, stepdir
|
|
|
|
if token <> END_TKN and token <> DONE_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_jump(tag_endif)
|
|
emit_codetag(tag_else)
|
|
if !parse_expr
|
|
return 0
|
|
fin
|
|
tag_else = ctag_new
|
|
emit_brfls(tag_else)
|
|
until FALSE
|
|
if token == ELSE_TKN
|
|
emit_jump(tag_endif)
|
|
emit_codetag(tag_else)
|
|
scan
|
|
while parse_stmnt
|
|
nextln
|
|
loop
|
|
emit_codetag(tag_endif)
|
|
else
|
|
emit_codetag(tag_else)
|
|
emit_codetag(tag_endif)
|
|
fin
|
|
if token <> FIN_TKN
|
|
return parse_err(@no_fin)
|
|
fin
|
|
is FOR_TKN
|
|
stack_loop = stack_loop + 1
|
|
tag_for = ctag_new
|
|
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
|
|
emit_codetag(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)
|
|
else
|
|
emit_daw(addr)
|
|
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_jump(tag_for)
|
|
emit_codetag(break_tag)
|
|
emit_drop
|
|
break_tag = tag_prevbrk
|
|
stack_loop = stack_loop - 1
|
|
is WHILE_TKN
|
|
tag_while = ctag_new
|
|
tag_wend = ctag_new
|
|
tag_prevbrk = break_tag
|
|
break_tag = tag_wend
|
|
emit_codetag(tag_while)
|
|
if !parse_expr
|
|
return 0
|
|
fin
|
|
emit_brfls(tag_wend)
|
|
while parse_stmnt
|
|
nextln
|
|
loop
|
|
if token <> LOOP_TKN
|
|
return parse_err(@no_loop)
|
|
fin
|
|
emit_jump(tag_while)
|
|
emit_codetag(tag_wend)
|
|
break_tag = tag_prevbrk
|
|
is REPEAT_TKN
|
|
tag_repeat = ctag_new
|
|
tag_prevbrk = break_tag
|
|
break_tag = ctag_new
|
|
emit_codetag(tag_repeat)
|
|
scan
|
|
while parse_stmnt
|
|
nextln
|
|
loop
|
|
if token <> UNTIL_TKN
|
|
return parse_err(@no_until)
|
|
fin
|
|
if !parse_expr
|
|
return 0
|
|
fin
|
|
emit_brfls(tag_repeat)
|
|
emit_codetag(break_tag)
|
|
break_tag = tag_prevbrk
|
|
is CASE_TKN
|
|
stack_loop = stack_loop + 1
|
|
tag_choice = ctag_new
|
|
tag_prevbrk = break_tag
|
|
break_tag = ctag_new
|
|
if !parse_expr
|
|
return parse_err(@bad_stmnt)
|
|
fin
|
|
nextln
|
|
while token <> ENDCASE_TKN
|
|
when token
|
|
is OF_TKN
|
|
if !parse_expr
|
|
return parse_err(@bad_stmnt)
|
|
fin
|
|
emit_brne(tag_choice)
|
|
while parse_stmnt
|
|
nextln
|
|
loop
|
|
emit_jump(break_tag)
|
|
emit_codetag(tag_choice)
|
|
tag_choice = ctag_new
|
|
is DEFAULT_TKN
|
|
scan
|
|
while parse_stmnt
|
|
nextln
|
|
loop
|
|
if token <> ENDCASE_TKN
|
|
return parse_err(@bad_stmnt)
|
|
fin
|
|
otherwise
|
|
return parse_err(@bad_stmnt)
|
|
wend
|
|
loop
|
|
emit_codetag(break_tag)
|
|
emit_drop
|
|
break_tag = tag_prevbrk
|
|
stack_loop = stack_loop - 1
|
|
is BREAK_TKN
|
|
if break_tag
|
|
emit_jump(break_tag)
|
|
else
|
|
return parse_err(@bad_stmnt)
|
|
fin
|
|
is RETURN_TKN
|
|
if infunc
|
|
for i = 1 to stack_loop
|
|
emit_drop
|
|
next
|
|
if !parse_expr
|
|
emit_const(0)
|
|
fin
|
|
emit_leave(framesize)
|
|
else
|
|
return parse_err(@bad_stmnt)
|
|
fin
|
|
is EXIT_TKN
|
|
if !parse_expr
|
|
emit_const(0)
|
|
fin
|
|
emit_exit
|
|
is ELSE_TKN
|
|
return FALSE
|
|
is ELSEIF_TKN
|
|
return FALSE
|
|
is FIN_TKN
|
|
return FALSE
|
|
is LOOP_TKN
|
|
return FALSE
|
|
is UNTIL_TKN
|
|
return FALSE
|
|
is NEXT_TKN
|
|
return FALSE
|
|
is OF_TKN
|
|
return FALSE
|
|
is DEFAULT_TKN
|
|
return FALSE
|
|
is ENDCASE_TKN
|
|
return FALSE
|
|
is END_TKN
|
|
return FALSE
|
|
is DONE_TKN
|
|
return FALSE
|
|
is IFUNC_TKN
|
|
return FALSE
|
|
is TFUNC_TKN
|
|
return FALSE
|
|
is NFUNC_TKN
|
|
return FALSE
|
|
is EOF_TKN
|
|
return FALSE
|
|
is EOL_TKN
|
|
return TRUE
|
|
otherwise
|
|
if token == ID_TKN
|
|
saveptr = tknptr
|
|
idptr = id_lookup(tknptr, tknlen)
|
|
if !idptr
|
|
return FALSE
|
|
fin
|
|
type = (idptr).idtype
|
|
if type & ADDR_TYPE
|
|
addr = (idptr):idval
|
|
if scan == SET_TKN
|
|
if type & VAR_TYPE
|
|
if !parse_expr
|
|
return parse_err(@bad_expr)
|
|
fin
|
|
if type & LOCAL_TYPE
|
|
if type & BYTE_TYPE
|
|
emit_slb(addr)
|
|
else
|
|
emit_slw(addr)
|
|
fin
|
|
else
|
|
if type & BYTE_TYPE
|
|
emit_sab(addr)
|
|
else
|
|
emit_saw(addr)
|
|
fin
|
|
fin
|
|
return TRUE
|
|
fin
|
|
elsif token == EOL_TKN and type & FUNC_TYPE
|
|
emit_call(addr, 0)
|
|
emit_drop
|
|
return TRUE
|
|
fin
|
|
fin
|
|
tknptr = saveptr
|
|
fin
|
|
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 == 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
|
|
if token <> EOL_TKN
|
|
return parse_err(@no_close_bracket)
|
|
fin
|
|
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_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)
|
|
is BYTE_TKN
|
|
type = BYTE_TYPE
|
|
repeat
|
|
if !parse_var(type)
|
|
return FALSE
|
|
fin
|
|
until token <> COMMA_TKN
|
|
is WORD_TKN
|
|
type = WORD_TYPE
|
|
repeat
|
|
if !parse_var(type)
|
|
return FALSE
|
|
fin
|
|
until token <> COMMA_TKN
|
|
is FUNC_TKN
|
|
repeat
|
|
if scan == ID_TKN
|
|
idfunc_add(tknptr, tknlen, ctag_new)
|
|
else
|
|
return parse_err(@bad_decl)
|
|
fin
|
|
until scan <> COMMA_TKN
|
|
is EOL_TKN
|
|
return TRUE
|
|
otherwise
|
|
return FALSE
|
|
wend
|
|
return TRUE
|
|
end
|
|
def parse_func
|
|
byte defopt, cfnparms
|
|
word func_tag, idptr
|
|
|
|
if token == IFUNC_TKN or token == TFUNC_TKN or token == NFUNC_TKN
|
|
defopt = token - IFUNC_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
|
|
emit_codetag(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(framesize, 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(framesize)
|
|
fin
|
|
return TRUE
|
|
elsif token == EOL_TKN
|
|
return TRUE
|
|
fin
|
|
return FALSE
|
|
end
|
|
def parse_module
|
|
entrypoint = 0
|
|
idglobal_init
|
|
idlocal_init
|
|
if nextln
|
|
while parse_vars
|
|
nextln
|
|
loop
|
|
while parse_func
|
|
nextln
|
|
loop
|
|
if token <> DONE_TKN
|
|
emit_start
|
|
prevstmnt = 0
|
|
while parse_stmnt
|
|
nextln
|
|
loop
|
|
if token <> DONE_TKN
|
|
parse_err(@no_done)
|
|
fin
|
|
if prevstmnt <> EXIT_TKN
|
|
emit_const(0)
|
|
emit_exit
|
|
fin
|
|
fin
|
|
; dumpsym(idglobal_tbl, globals)
|
|
; prstr(@entrypt_str)
|
|
; prword(entrypoint)
|
|
; crout
|
|
; keyin()
|
|
return TRUE
|
|
fin
|
|
return FALSE
|
|
end
|
|
;
|
|
; Init editor
|
|
;
|
|
if !(^machid & $80)
|
|
flags = uppercase ? shiftlock
|
|
keyin = @keyin2
|
|
else
|
|
keyin = @keyin2e
|
|
fin
|
|
inittxtbuf
|
|
if ^argbuff
|
|
strcpy(argbuff, @txtfile)
|
|
prstr(@txtfile)
|
|
readtxt(@txtfile)
|
|
else
|
|
numlines = 1
|
|
fin
|
|
curschr = '+'
|
|
flags = flags ? insmode
|
|
drawscrn(scrntop, scrnleft)
|
|
curson
|
|
editmode
|
|
done
|