Apple-2-Tools
/
VM02
mirror of https://github.com/dschmenk/VM02.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity
VM02/plasma3/pleaides.pla

3383 lines
69 KiB
Plaintext
Executable File
Raw Permalink Blame History

;
; 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
Reference in New Issue View Git Blame Copy Permalink