diff --git a/src/inc/fileio.plh b/src/inc/fileio.plh index 51da5b8..e65c1f2 100644 --- a/src/inc/fileio.plh +++ b/src/inc/fileio.plh @@ -38,6 +38,7 @@ import fileio word setpfx word getfileinfo word geteof + word openbuf word open word close word read diff --git a/src/libsrc/fileio.pla b/src/libsrc/fileio.pla index 4765fcd..f6bdfcc 100644 --- a/src/libsrc/fileio.pla +++ b/src/libsrc/fileio.pla @@ -27,6 +27,7 @@ struc t_fileio word setpfx word getfileinfo word geteof + word openbuf word open word close word read @@ -37,7 +38,7 @@ struc t_fileio word readblock word writeblock end -predef a2getpfx(path), a23setpfx(path), a2getfileinfo(path, fileinfo), a23geteof(refnum), a2open(path), a23close(refnum) +predef a2getpfx(path), a23setpfx(path), a2getfileinfo(path, fileinfo), a23geteof(refnum), a2openbuf(path, iobuf), a2open(path), a23close(refnum) predef a23read(refnum, buf, len), a2write(refnum, buf, len), a2create(path, type, aux), a23destroy(path) predef a23newline(refnum, emask, nlchar), a2readblock(unit, buf, block), a2writeblock(unit, buf, block) // @@ -126,6 +127,15 @@ def a1open(path) *CFFA1FileName = path return 0 end +def a2openbuf(path, iobuf) + byte params[6] + params.0 = 3 + params:1 = path + params:3 = iobuf + params.5 = 0 + perr = syscall($C8, @params) + return params.5 +end def a2open(path) byte params[6] params.0 = 3 @@ -135,6 +145,17 @@ def a2open(path) perr = syscall($C8, @params) return params.5 end +def a3openbuf(path, iobuf) + byte params[7] + + params.0 = 4 + params:1 = path + params.3 = 0 + params:4 = iobuf + params.6 = 0 + perr = syscall($C8, @params) + return params.3 +end def a3open(path) byte params[7] diff --git a/src/makefile b/src/makefile index 8320042..75ca097 100755 --- a/src/makefile +++ b/src/makefile @@ -71,7 +71,7 @@ TXTTYPE = .TXT #SYSTYPE = \#FF2000 #TXTTYPE = \#040000 -all: $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM802) $(PLVM03) $(CMD) $(ARGS) $(MEMMGR) $(MEMTEST) $(FIBER) $(LONGJMP) $(ED) $(MON) $(ROD) $(SIEVE) $(UTHERNET2) $(UTHERNET) $(ETHERIP) $(INET) $(DHCP) $(HTTPD) $(ROGUE) $(ROGUEMAP) $(ROGUECOMBAT) $(ROGUEIO) $(HGR1) $(TONE) $(DGR) $(DGRTEST) $(FILEIO) $(CONIO) $(PORTIO) $(SPIPORT) $(SDFAT) $(FATCAT) $(FATGET) $(FATPUT) $(FATWDSK) $(FATRDSK) $(SANE) $(FPSTR) $(FPU) $(SANITY) $(RPNCALC) +all: $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM802) $(PLVM03) $(CMD) $(PLASMAPLASM) $(ARGS) $(MEMMGR) $(MEMTEST) $(FIBER) $(LONGJMP) $(ED) $(MON) $(ROD) $(SIEVE) $(UTHERNET2) $(UTHERNET) $(ETHERIP) $(INET) $(DHCP) $(HTTPD) $(ROGUE) $(ROGUEMAP) $(ROGUECOMBAT) $(ROGUEIO) $(HGR1) $(TONE) $(DGR) $(DGRTEST) $(FILEIO) $(CONIO) $(PORTIO) $(SPIPORT) $(SDFAT) $(FATCAT) $(FATGET) $(FATPUT) $(FATWDSK) $(FATRDSK) $(SANE) $(FPSTR) $(FPU) $(SANITY) $(RPNCALC) clean: -rm *FE1000 *FF2000 $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM03) diff --git a/src/toolsrc/codegen.c b/src/toolsrc/codegen.c index 3f7aeae..6e91dfa 100755 --- a/src/toolsrc/codegen.c +++ b/src/toolsrc/codegen.c @@ -750,6 +750,7 @@ void emit_brnch(int tag) } void emit_breq(int tag) { + emit_pending_seq(); printf("\t%s\t$3C\t\t\t; BREQ\t_B%03d\n", DB, tag); printf("\t%s\t_B%03d-*\n", DW, tag); } diff --git a/src/toolsrc/codegen.pla b/src/toolsrc/codegen.pla index ebaf0b4..610a0d4 100644 --- a/src/toolsrc/codegen.pla +++ b/src/toolsrc/codegen.pla @@ -11,7 +11,7 @@ // cout('=') // if idptr->idtype & ADDR_TYPE // if idptr=>idval & IS_CTAG -// prword((ctag_tbl:[idptr=>idval & MASK_CTAG] & MASK_CTAG) + codebuff) +// prword((ctag_tbl=>[idptr=>idval & MASK_CTAG] & MASK_CTAG) + codebuff) // else // prword(idptr=>idval + codebuff) // fin @@ -19,183 +19,41 @@ // prword(idptr=>idval) // fin // crout -// idptr = idptr + idptr->idname + idrecsz +// idptr = idptr + idptr->idname + t_id // idcnt-- // loop //end -def idmatch(nameptr, len, idptr, idcnt) - byte i - - while idcnt - if len == idptr->idname - for i = 1 to len - if nameptr->[i - 1] <> idptr->idname.[i]; break; fin - next - if i > len; return idptr; fin - fin - idptr = idptr + idptr->idname + t_id - idcnt-- - loop - return NULL -end -def id_lookup(nameptr, len) - word idptr - - idptr = idmatch(nameptr, len, idlocal_tbl, locals) - if not idptr - idptr = idmatch(nameptr, len, idglobal_tbl, globals) - if not idptr; exit_err(@undecl_id); fin - fin - return idptr -end -def idglobal_lookup(nameptr, len) - word idptr - idptr idmatch(nameptr, len, idglobal_tbl, globals) - if not idptr; exit_err(@undecl_id); fin - return idptr -end -def idlocal_add(namestr, len, type, size) - if idmatch(namestr, len, @idlocal_tbl, locals); exit_err(@dup_id); fin - lastlocal=>idval = framesize - lastlocal->idtype = type | LOCAL_TYPE - nametostr(namestr, len, lastlocal + idname) - locals++ - lastlocal = lastlocal + idrecsz + len - if lastlocal > idlocal_tbl + idlocal_tblsz; exit_err(@local_sym_overflw); fin - framesize = framesize + size - if framesize > 255; exit_err(@local_overflw); fin - return TRUE -end -def iddata_add(namestr, len, type, size) - if idmatch(namestr, len, idglobal_tbl, globals); exit_err(@dup_id); fin - lastglobal=>idval = datasize - lastglobal->idtype = type - nametostr(namestr, len, lastglobal + idname) - emit_iddata(datasize, size, lastglobal + idname) - globals++ - lastglobal = lastglobal + idrecsz + len - if lastglobal > idglobal_tbl + idglobal_tblsz; exit_err((@global_sym_overflw); fin - datasize = datasize + size - return TRUE -end -def iddata_size(type, varsize, initsize)#0 - if varsize > initsize - datasize = datasize + varsize - emit_data(0, 0, 0, varsize - initsize) - else - datasize = datasize + initsize - fin -end -def idglobal_add(namestr, len, type, value) - if idmatch(namestr, len, idglobal_tbl, globals); exit_err(@dup_id); fin - lastglobal=>idval = value - lastglobal->idtype = type - nametostr(namestr, len, lastglobal + idname) - globals++ - 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#0 - word op - byte i - - idglobal_tbl = heapalloc(IDGLOBALSZ) - idlocal_tbl = heapalloc(IDLOCALSZ) - codebuff = heapalloc(CODEBUFSZ) - codeptr = codebuff - entrypoint = 0 - globals = 0 - lastglobal = idglobal_tbl - codetag = -1 - // - //Init free op sequence list - // - freeop_lst = heapalloc(OPSEQNUM*t_opseq) - op = freeop_lst - for i = OPSEQNUM-1 downto 0 - op=>nextop = op + t_opseq - op = op + t_opseq - next - op=>nextop = NULL -end -def idlocal_init#0 - locals = 0 - framesize = 0 - lastlocal = idlocal_tbl -end -// -// Code tags. Upper bit is IS_RESOLVED flag, lower 15 is offset into codebuff -// Flags are: -// -def ctag_new - if codetag >= ctag_max; exit_err(@ctag_full); fin - codetag = codetag + 1 - ctag_tbl:[codetag] = 0 // Unresolved, nothing to update yet - return codetag | IS_CTAG -end -def ctag_resolve(ctag)#0 - word updtptr, nextptr - - ctag = ctag & MASK_CTAG // Better be a ctag! - if ctag_tbl:[ctag] & IS_RESOLVED;exit_err(@dup_id); fin - updtptr = ctag_tbl:[ctag] & MASK_CTAG - while updtptr - // - // Update list of addresses needing resolution - // - updtptr = updtptr + codebuff - nextptr = *updtptr & MASK_CTAG - if *updtptr & IS_RELATIVE - *updtptr = codeptr - updtptr - else - *updtptr = codeptr - fin - updtptr = nextptr - loop - ctag_tbl:[ctag] = (codeptr - codebuff) | IS_RESOLVED -end // // Emit data/bytecode // def emit_byte(bval)#0 ^codeptr = bval codeptr++ + if codeptr - codebuff > codebufsz; exit_err(ERR_OVER|ERR_CODE|ERR_TABLE); fin end def emit_word(wval)#0 *codeptr = wval codeptr = codeptr + 2 + if codeptr - codebuff > codebufsz; exit_err(ERR_OVER|ERR_CODE|ERR_TABLE); fin end def emit_fill(size)#0 memset(codeptr, 0, size) codeptr = codeptr + size -end -def emit_op(op)#0 - lastop = op - emit_byte(op) + if codeptr - codebuff > codebufsz; exit_err(ERR_OVER|ERR_CODE|ERR_TABLE); fin end def emit_addr(tag)#0 word updtptr if tag & IS_CTAG tag = tag & MASK_CTAG - if ctag_tbl:[tag] & IS_RESOLVED - updtptr = (ctag_tbl:[tag] & MASK_CTAG) + codebuff + if ctag_tbl=>[tag] & IS_RESOLVED + updtptr = (ctag_tbl=>[tag] & MASK_CTAG) + codebuff else // // Add to list of tags needing resolution // - updtptr = ctag_tbl:[tag] & MASK_CTAG - ctag_tbl:[tag] = codeptr - codebuff + updtptr = ctag_tbl=>[tag] & MASK_CTAG + ctag_tbl=>[tag] = codeptr - codebuff fin emit_word(updtptr) else @@ -207,23 +65,20 @@ def emit_reladdr(tag)#0 if tag & IS_CTAG tag = tag & MASK_CTAG - if ctag_tbl:[tag] & IS_RESOLVED - updtptr = ((ctag_tbl:[tag] & MASK_CTAG) + codebuff) - codeptr + if ctag_tbl=>[tag] & IS_RESOLVED + updtptr = ((ctag_tbl=>[tag] & MASK_CTAG) + codebuff) - codeptr else // // Add to list of tags needing resolution // - updtptr = ctag_tbl:[tag] | IS_RELATIVE - ctag_tbl:[tag] = codeptr - codebuff + updtptr = ctag_tbl=>[tag] | IS_RELATIVE + ctag_tbl=>[tag] = codeptr - codebuff fin emit_word(updtptr) else emit_word(tag - (codeptr - codebuff)) fin end -def emit_iddata(value, size, namestr)#0 - emit_fill(size) -end def emit_data(vartype, consttype, constval, constsize) byte i word size, chrptr @@ -232,9 +87,9 @@ def emit_data(vartype, consttype, constval, constsize) size = constsize emit_fill(constsize) elsif consttype == STR_TYPE - size = constsize - chrptr = constval - constsize-- + constsize = ^constval + size = constsize + 1 + chrptr = constval + 1 emit_byte(constsize) while constsize > 0 emit_byte(^chrptr) @@ -257,235 +112,260 @@ def emit_data(vartype, consttype, constval, constsize) return size end def emit_const(cval)#0 - if cval == 0 - emit_op($00) - elsif cval > 0 and cval < 256 - emit_op($2A) + emit_pending_seq + if cval == $0000 // ZERO + emit_byte($00) + elsif cval & $FF00 == $0000 // Constant BYTE + emit_byte($2A) emit_byte(cval) - else - emit_op($2C) + elsif cval & $FF00 == $FF00 // Constant $FF00 | BYTE + emit_byte($5E) + emit_byte(cval) + else // Constant WORD + emit_byte($2C) emit_word(cval) fin end -def emit_constr(str, size)#0 - emit_op($2E) - emit_data(0, STR_TYPE, str, size) -end -def emit_lb#0 - emit_op($60) -end -def emit_lw#0 - emit_op($62) -end -def emit_llb(offset)#0 - emit_op($64) - emit_byte(offset) -end -def emit_llw(offset)#0 - emit_op($66) - emit_byte(offset) -end -def emit_lab(tag, offset)#0 - if tag & IS_CTAG and offset - exit_err(@no_ctag_offst) - else - emit_op($68) - emit_addr(tag+offset) - fin -end -def emit_law(tag, offset)#0 - if tag & IS_CTAG and offset - exit_err(@no_ctag_offst) - else - emit_op($6A) - emit_addr(tag+offset) - fin -end -def emit_sb#0 - emit_op($70) -end -def emit_sw#0 - emit_op($72) -end -def emit_slb(offset)#0 - emit_op($74) - emit_byte(offset) -end -def emit_slw(offset)#0 - emit_op($76) - emit_byte(offset) -end def emit_dlb(offset)#0 - emit_op($6C) + emit_pending_seq + emit_byte($6C) emit_byte(offset) end def emit_dlw(offset)#0 - emit_op($6E) + emit_pending_seq + emit_byte($6E) emit_byte(offset) end -def emit_sab(tag, offset)#0 - if tag & IS_CTAG and offset - exit_err(@no_ctag_offst) - else - emit_op($78) - emit_addr(tag+offset) - fin -end -def emit_saw(tag, offset)#0 - if tag & IS_CTAG and offset - exit_err(@no_ctag_offst) - else - emit_op($7A) - emit_addr(tag+offset) - fin -end def emit_dab(tag, offset)#0 + emit_pending_seq if tag & IS_CTAG and offset - exit_err(@no_ctag_offst) + exit_err(ERR_INVAL|ERR_CODE|ERR_CONST) else - emit_op($7C) + emit_byte($7C) emit_addr(tag+offset) fin end def emit_daw(tag, offset)#0 + emit_pending_seq if tag & IS_CTAG and offset - exit_err(@no_ctag_offst) + exit_err(ERR_INVAL|ERR_CODE|ERR_CONST) else - emit_op($7E) + emit_byte($7E) emit_addr(tag+offset) fin end -def emit_call(tag)#0 - emit_op($54) - emit_addr(tag) -end -def emit_ical#0 - emit_op($56) -end -def emit_localaddr(offset)#0 - emit_op($28) - emit_byte(offset) -end -def emit_globaladdr(tag, offset)#0 - if tag & IS_CTAG and offset - exit_err(@no_ctag_offst) - else - emit_op($26) - emit_addr(tag+offset) - fin -end -def emit_indexbyte#0 - emit_op($02) -end -def emit_indexword#0 - emit_op($1E) -end -def emit_unaryop(op)#0 - when op - is NEG_TKN - emit_op($10); break - is COMP_TKN - emit_op($12); break - is LOGIC_NOT_TKN - emit_op($20); break - is INC_TKN - emit_op($0C); break - is DEC_TKN - emit_op($0E); break - is BPTR_TKN - emit_op($60); break - is WPTR_TKN - emit_op($62); break - otherwise - exit_err("Invalid unary operation") - wend -end -def emit_binaryop(op)#0 - when op - is MUL_TKN - emit_op($06); break - is DIV_TKN - emit_op($08); break - is MOD_TKN - emit_op($0A); break - is ADD_TKN - emit_op($02); break - is SUB_TKN - emit_op($04); break - is SHL_TKN - emit_op($1A); break - is SHR_TKN - emit_op($1C); break - is AND_TKN - emit_op($14); break - is OR_TKN - emit_op($16); break - is EOR_TKN - emit_op($18); break - is EQ_TKN - emit_op($40); break - is NE_TKN - emit_op($42); break - is GE_TKN - emit_op($48); break - is LT_TKN - emit_op($46); break - is GT_TKN - emit_op($44); break - is LE_TKN - emit_op($4A); break - is LOGIC_OR_TKN - emit_op($22); break - is LOGIC_AND_TKN - emit_op($24); break - otherwise - exit_err("Invalid operation") - wend -end -def emit_brtru(tag)#0 - emit_op($4E) - emit_reladdr(tag) -end -def emit_brfls(tag)#0 - emit_op($4C) - emit_reladdr(tag) -end def emit_brgt(tag)#0 - emit_op($38) + emit_pending_seq + emit_byte($38) emit_reladdr(tag) end def emit_brlt(tag)#0 - emit_op($3A) + emit_pending_seq + emit_byte($3A) emit_reladdr(tag) end def emit_brne(tag)#0 - emit_op($3E) + emit_pending_seq + emit_byte($3E) emit_reladdr(tag) end def emit_branch(tag)#0 - emit_op($50) + emit_pending_seq + emit_byte($50) emit_reladdr(tag) end -def emit_drop#0 - emit_op($30) -end def emit_leave#0 + emit_pending_seq if framesize - emit_op($5A) + emit_byte($5A) else - emit_op($5C) + emit_byte($5C) fin end -def emit_enter(cparams)#0 - emit_byte(emit_enter.[0]) - emit_byte(emit_enter.[1]) - emit_byte(emit_enter.[2]) +def emit_enter(cparms)#0 if framesize - emit_op($58) + emit_byte($58) emit_byte(framesize) - emit_byte(cparams) + emit_byte(cparms) fin end +def emit_ctag(ctag)#0 + word updtptr, nextptr + + emit_pending_seq + ctag = ctag & MASK_CTAG // Better be a ctag! + if ctag_tbl=>[ctag] & IS_RESOLVED;exit_err(ERR_DUP|ERR_ID); fin + updtptr = ctag_tbl=>[ctag] & MASK_CTAG + while updtptr + // + // Update list of addresses needing resolution + // + updtptr = updtptr + codebuff + nextptr = *updtptr & MASK_CTAG + if *updtptr & IS_RELATIVE + *updtptr = codeptr - updtptr + else + *updtptr = codeptr + fin + updtptr = nextptr + loop + ctag_tbl=>[ctag] = (codeptr - codebuff) | IS_RESOLVED +end +// +// ID manager +// +def idmatch(nameptr, len, idptr, idcnt) + byte i + + while idcnt + if len == idptr->idname + for i = 1 to len + if nameptr->[i - 1] <> idptr->idname.[i]; break; fin + next + if i > len; return idptr; fin + fin + idptr = idptr + idptr->idname + t_id + idcnt-- + loop + return NULL +end +def id_lookup(nameptr, len) + word idptr + + idptr = idmatch(nameptr, len, idlocal_tbl, locals) + if not idptr + idptr = idmatch(nameptr, len, idglobal_tbl, globals) + if not idptr; exit_err(ERR_UNDECL|ERR_ID); fin + fin + return idptr +end +def idglobal_lookup(nameptr, len) + word idptr + + idptr = idmatch(nameptr, len, idglobal_tbl, globals) + if not idptr; exit_err(ERR_UNDECL|ERR_ID); fin + return idptr +end +def emit_iddata(value, size, namestr)#0 + emit_fill(size) +end +def iddata_add(namestr, len, type, size)#0 + if idmatch(namestr, len, idglobal_tbl, globals); exit_err(ERR_DUP|ERR_ID); fin + lastglobal=>idval = datasize + lastglobal=>idtype = type + nametostr(namestr, len, lastglobal + idname) + emit_fill(size) + globals++ + lastglobal = lastglobal + t_id + len + if lastglobal - idglobal_tbl > IDGLOBALSZ; exit_err(ERR_OVER|ERR_GLOBAL|ERR_ID|ERR_TABLE); fin + datasize = datasize + size +end +def iddata_size(type, varsize, initsize)#0 + if varsize > initsize + datasize = datasize + varsize + emit_data(0, 0, 0, varsize - initsize) + else + datasize = datasize + initsize + fin +end +def idglobal_add(namestr, len, type, value, cparms, cvals)#0 + if idmatch(namestr, len, idglobal_tbl, globals); exit_err(ERR_DUP|ERR_ID); fin + lastglobal=>idval = value + lastglobal=>idtype = type + lastglobal->funcparms = cparms + lastglobal->funcvals = cvals + nametostr(namestr, len, lastglobal + idname) + globals++ + lastglobal = lastglobal + t_id + len + if lastglobal - idglobal_tbl > IDGLOBALSZ; exit_err(ERR_OVER|ERR_GLOBAL|ERR_ID|ERR_TABLE); fin +end +def idconst_add(namestr, len, value)#0 + idglobal_add(namestr, len, CONST_TYPE, value, 0, 0) +end +def idfunc_add(namestr, len, type, tag, cfnparms, cfnvals)#0 + idglobal_add(namestr, len, type|FUNC_TYPE, tag, cfnparms, cfnvals) +end +def idfunc_set(namestr, len, tag, cparms, cvals)#0 + word idptr + + idptr = idglobal_lookup(namestr, len) + if idptr + idptr=>idtype = FUNC_TYPE + idptr=>idval = tag + idptr->funcparms = cparms + idptr->funcvals = cvals + else + exit_err(ERR_UNDECL|ERR_ID) + fin +end +def idglobal_init#0 + word op, codebuffsz + byte i + + ctag_tbl = heapalloc(CTAGNUM*2) + idglobal_tbl = heapalloc(IDGLOBALSZ) + idlocal_tbl = heapalloc(IDLOCALSZ) + codebufsz = heapavail - 4096 + codebuff = heapalloc(codebufsz) + codeptr = codebuff + lastglobal = idglobal_tbl + // + //Init free op sequence list + // + freeop_lst = heapalloc(OPSEQNUM*t_opseq) + op = freeop_lst + for i = OPSEQNUM-1 downto 0 + op=>opnext = op + t_opseq + op = op + t_opseq + next + op=>opnext = NULL +end +def idlocal_add(namestr, len, type, size)#0 + if idmatch(namestr, len, @idlocal_tbl, locals); exit_err(ERR_DUP|ERR_ID); fin + lastlocal=>idval = framesize + lastlocal=>idtype = type | LOCAL_TYPE + nametostr(namestr, len, lastlocal + idname) + locals++ + lastlocal = lastlocal + t_id + len + if lastlocal - idlocal_tbl > IDLOCALSZ; exit_err(ERR_OVER|ERR_LOCAL|ERR_TABLE); fin + framesize = framesize + size + if framesize > 255; exit_err(ERR_OVER|ERR_LOCAL|ERR_FRAME); fin +end +def idlocal_init#0 + locals = 0 + framesize = 0 + lastlocal = idlocal_tbl +end +def idlocal_save#0 + savelocals = locals + savesize = framesize + savelast = lastlocal + idlocal_init +end +def idlocal_restore#0 + locals = savelocals + framesize = savesize + lastlocal = savelast +end +// +// Module dependency list +// +def moddep_add(strptr, strlen)#0 + if strlen > 15; strlen = 15; fin + memcpy(@moddep_tbl[moddep_cnt*16] + 1, strptr, strlen) + moddep_tbl[moddep_cnt*16] = strlen + moddep_cnt++ + if moddep_cnt > 8; parse_warn("Module dependency overflow"); fin +end +// +// Code tags. Upper bit is IS_RESOLVED flag, lower 15 is offset into codebuff +// +def ctag_new + codetag++ + if codetag >= CTAGNUM; exit_err(ERR_OVER|ERR_CODE|ERR_TABLE); fin + ctag_tbl=>[codetag] = 0 // Unresolved, nothing to update yet + return codetag | IS_CTAG +end // // New/release sequence ops // @@ -496,26 +376,26 @@ def new_op puts("Compiler out of sequence ops!") return NULL fin - freeop_lst = freeop_lst=>nextop - op=>nextop = NULL + freeop_lst = freeop_lst=>opnext + op=>opnext = NULL return op end def release_op(op)#0 if op - op=>nextop = freeop_lst + op=>opnext = freeop_lst freeop_lst = op fin end def release_seq(seq)#0 -{ word op + while seq op = seq - seq = seq=>nextop + seq = seq=>opnext // //Free this op // - op=>nextop = freeop_lst + op=>opnext = freeop_lst freeop_lst = op loop end @@ -527,267 +407,281 @@ end // def try_dupify(op) byte crunched - word opnext - - crunched = 0 - opnext = op=>nextop - while opnext - if op->code <> opn->code - return crunched - when op->code + word nextop + + crunched = FALSE + nextop = op=>opnext + while nextop + if op->opcode <> nextop->opcode; return crunched; fin + when op->opcode is CONST_CODE - if op->val <> opnext->val; return crunched; fin + if op=>opval <> nextop=>opval; return crunched; fin break is LADDR_CODE is LLB_CODE is LLW_CODE - if op=>offsz <> opnext=>offsz; return crunched; fin + if op=>opoffset <> nextop=>opoffset; return crunched; fin break is GADDR_CODE is LAB_CODE is LAW_CODE - if (op=>tag <> opnext=>tag) or (op=>offsz <> opnext=>offsz) or (op->type <> opnext->type); return crunched; fin + if (op=>optag <> nextop=>optag) or (op=>opoffset <> nextop=>opoffset); return crunched; fin break otherwise return crunched wend - opnext->code = DUP_CODE - opnext = opnext=>nextop - crunched = 1 + nextop->opcode = DUP_CODE + nextop->opgroup = STACK_GROUP + nextop = nextop=>opnext + crunched = TRUE loop return crunched end +def is_hardware_address(addr) + return isuge(addr, $C000) and isult(addr, $D000) +end // // Crunch sequence (peephole optimize) // def crunch_seq(seq, pass) - word opnext opnextnext opprev, op + word nextop, nextopnext, opprev, op byte crunched, freeops, shiftcnt + opprev = NULL op = *seq - opnext = op=>nextop + nextop = op=>opnext crunched = FALSE freeops = 0 - while op and opnext - when op->code + while op and nextop + when op->opcode is CONST_CODE - if op=>val == 1 - { - if opnext->code == BINARY_CODE|ADD_TOKEN - op->code = INC_CODE - freeops = 1 + if op=>opval == 1 + if nextop>opcode == ADD_CODE + op->opcode = INC_CODE + freeops = 1 break fin - if opnext->code == BINARY_CODE|SUB_TOKEN - op->code = DEC_CODE - freeops = 1 + if nextop->opcode == SUB_CODE + op->opcode = DEC_CODE + freeops = 1 break fin - if opnext->code == BINARY_CODE|SHL_TOKEN - op->code = DUP_CODE - opnext->code = BINARY_CODE|ADD_TOKEN - crunched = 1 + if nextop->opcode == SHL_CODE + op->opcode = DUP_CODE + nextop->opcode = ADD_CODE + crunched = 1 break fin fin - when opnext->code + when nextop->opcode is NEG_CODE - op=>val = -(op=>val) - freeops = 1 + op=>opval = -(op=>opval) + freeops = 1 break is COMP_CODE - op->val = ~(op=>val) - freeops = 1 + op=>opval = ~(op=>opval) + freeops = 1 break is LOGIC_NOT_CODE - op=>val = op=>val ?? FALSE :: TRUE - freeops = 1 - break - is UNARY_CODE|BPTR_TOKEN - is LB_CODE - op=>offsz = op=>val - op->code = LAB_CODE + op=>opval = op=>opval ?? FALSE :: TRUE freeops = 1 break - is UNARY_CODE|WPTR_TOKEN - is LW_CODE - op=>offsz = op=>val - op->code = LAW_CODE - freeops = 1 + is LB_CODE // BPTR_CODE + op=>opoffset = op=>opval + op->opcode = LAB_CODE + op->opgroup = GLOBAL_GROUP + freeops = 1 + break + is LW_CODE // WPTR_CODE + op=>opoffset = op=>opval + op->opcode = LAW_CODE + op->opgroup = LOCAL_GROUP + freeops = 1 break is SB_CODE - op=>offsz = op=>val - op->code = SAB_CODE - freeops = 1 + op=>opoffset = op=>opval + op->opcode = SAB_CODE + op->opgroup = GLOBAL_GROUP + freeops = 1 break is SW_CODE - op=>offsz = op=>val - op->code = SAW_CODE - freeops = 1 + op=>opoffset = op=>opval + op->opcode = SAW_CODE + op->opgroup = GLOBAL_GROUP + freeops = 1 break is BRFALSE_CODE - if op=>val + if op=>opval freeops = -2 // Remove constant and never taken branch else - op->code = BRNCH_CODE // Always taken branch - op=>tag = opnext=>tag - freeops = 1 + op->opcode = BRNCH_CODE // Always taken branch + op->opgroup = RELATIVE_GROUP + op=>optag = nextop=>optag + freeops = 1 fin break is BRTRUE_CODE - if not op=>val + if not op=>opval freeops = -2 // Remove constant never taken branch else - op->code = BRNCH_CODE // Always taken branch - op=>tag = opnext=>tag - freeops = 1 + op->opcode = BRNCH_CODE // Always taken branch + op->opgroup = RELATIVE_GROUP + op=>optag = nextop=>optag + freeops = 1 fin break is NE_CODE - if not op=>val + if not op=>opval freeops = -2 // Remove ZERO:ISNE fin break is EQ_CODE - if not op=>val - op->code = LOGIC_NOT_CODE - freeops = 1 + if not op=>opval + op->opcode = LOGIC_NOT_CODE + freeops = 1 fin break is CONST_CODE // Collapse constant operation - opnextnext = opnext->nextop - if opnextnext - when opnextnext->code - is BINARY_CODE|MUL_TOKEN - op=>val = op=>val * opnext=>val - freeops = 2 + nextopnext = nextop->nextop + if nextopnext + when nextopnext->opcode + is MUL_CODE + op=>opval = op=>opval * nextop=>opval + freeops = 2 break - is BINARY_CODE|DIV_TOKEN - op=>val = op=>val / opnext=>val - freeops = 2 + is DIV_CODE + op=>opval = op=>opval / nextop=>opval + freeops = 2 break - is BINARY_CODE|MOD_TOKEN - op=>val = op=>val % opnext=>val - freeop = 2 + is MOD_CODE + op=>opval = op=>opval % nextop=>opval + freeops = 2 break - is BINARY_CODE|ADD_TOKEN - op=>val = op=>val + opnext=>val - freeops = 2 + is ADD_CODE + op=>opval = op=>opval + nextop=>opval + freeops = 2 break - is BINARY_CODE|SUB_TOKEN - op=>val = op=>val - opnext=>val - freeops = 2 + is SUB_CODE + op=>opval = op=>opval - nextop=>opval + freeops = 2 break - is BINARY_CODE|SHL_TOKEN - op=>val = op=>val << opnext=>val - freeops = 2 + is SHL_CODE + op=>opval = op=>opval << nextop=>opval + freeops = 2 break - is BINARY_CODE|SHR_TOKEN - op=>val = op=>val >> opnext=>val - freeops = 2 + is SHR_CODE + op=>opval = op=>opval >> nextop=>opval + freeops = 2 break - is BINARY_CODE|AND_TOKEN - op=>val = op=>val & opnext=>val - freeops = 2 + is AND_CODE + op=>opval = op=>opval & nextop=>opval + freeops = 2 break - is BINARY_CODE|OR_TOKEN - op=>val = op=>val | opnext=>val - freeops = 2 + is OR_CODE + op=>opval = op=>opval | nextop=>opval + freeops = 2 break - is BINARY_CODE|EOR_TOKEN - op=>val = op=>val ^ opnext=>val - freeops = 2 + is EOR_CODE + op=>opval = op=>opval ^ nextop=>opval + freeops = 2 break - is BINARY_CODE|EQ_TOKEN - op=>val = op=>val == opnext=>val - freeops = 2 + is EQ_CODE + op=>opval = op=>opval == nextop=>opval + freeops = 2 break - is BINARY_CODE|NE_TOKEN - op=>val = op=>val <> opnext=>val - freeops = 2 + is NE_CODE + op=>opval = op=>opval <> nextop=>opval + freeops = 2 break - is BINARY_CODE|GE_TOKEN - op=>val = op=>val >= opnext=>val - freeops = 2 + is GE_CODE + op=>opval = op=>opval >= nextop=>opval + freeops = 2 break - is BINARY_CODE|LT_TOKEN - op=>val = op=>val < opnext=>val - freeops = 2 + is LT_CODE + op=>opval = op=>opval < nextop=>opval + freeops = 2 break - is BINARY_CODE|GT_TOKEN - op=>val = op=>val > opnext=>val - freeops = 2 + is GT_CODE + op=>opval = op=>opval > nextop=>opval + freeops = 2 break - is BINARY_CODE|LE_TOKEN - op=>val = op=>val <= opnext=>val - freeops = 2 + is LE_CODE + op=>opval = op=>opval <= nextop=>opval + freeops = 2 break - is BINARY_CODE|LOGIC_OR_TOKEN - op=>val = op=>val or opnext=>val - freeops = 2 + is LOGIC_OR_CODE + op=>opval = op=>opval or nextop=>opval + freeops = 2 break - is BINARY_CODE|LOGIC_AND_TOKEN - op=>val = op=>val and opnext=>val - freeops = 2 + is LOGIC_AND_CODE + op=>opval = op=>opval and nextop=>opval + freeops = 2 break wend // End of collapse constant operation - if pass > 0 and freeops == 0 and op=>val + fin + if pass > 0 and freeops == 0 and op=>opval crunched = try_dupify(op) fin break // CONST_CODE - is BINARY_CODE|MUL_TOKEN + is MUL_CODE for shiftcnt = 0 to 15 - if op=>val == 1 << shiftcnt - op=>val = shiftcnt - opnext->code = BINARY_CODE|SHL_TOKEN + if op=>opval == 1 << shiftcnt + op=>opval = shiftcnt + nextop->opcode = SHL_CODE + nextop->opgroup = STACK_GROUP break fin next break - is BINARY_CODE|DIV_TOKEN + is DIV_CODE for shiftcnt = 0 to 15 - if op=>val == 1 << shiftcnt - op=>val = shiftcnt - opnext->code = BINARY_CODE|SHR_TOKEN + if op=>opval == 1 << shiftcnt + op=>opval = shiftcnt + nextop->opcode = SHR_CODE + nextop->opcode = STACK_GROUP break fin next break - } + wend break // CONST_CODE is LADDR_CODE - when opnext->code + when nextop->opcode is CONST_CODE - if opnext=>nextop - opnextnext = opnext=>nextop - when opnextnext->code + if nextop=>opnext + nextopnext = nextop=>opnext + when nextopnext->opcode is ADD_CODE is INDEXB_CODE - op=>offsz = op=>offsz + opnext=>val - freeops = 2 + op=>opoffset = op=>opoffset + nextop=>opval + freeops = 2 break is INDEXW_CODE - op=>offsz = op=>offsz + opnext=>val * 2 - freeops = 2 + op=>opoffset = op=>opoffset + nextop=>opval * 2 + freeops = 2 break wend fin break is LB_CODE - op->code = LLB_CODE - freeops = 1 + op->opcode = LLB_CODE + op->opgroup = LOCAL_GROUP + freeops = 1 break is LW_CODE - op->code = LLW_CODE - freeops = 1 + op->opcode = LLW_CODE + op->opgroup = LOCAL_GROUP + freeops = 1 break is SB_CODE - op->code = SLB_CODE - freeops = 1 + op->opcode = SLB_CODE + op->opgroup = LOCAL_GROUP + freeops = 1 break is SW_CODE - op->code = SLW_CODE - freeops = 1 + op->opcode = SLW_CODE + op->opgroup = LOCAL_GROUP + freeops = 1 break wend if pass > 0 and not freeops @@ -795,126 +689,135 @@ def crunch_seq(seq, pass) fin break // LADDR_CODE is GADDR_CODE - when opnext->code + when nextop->opcode is CONST_CODE - if opnext=>nextop - opnextnext = opnext=>nextop - when opnextnext->code + if nextop=>opnext + nextopnext = nextop=>opnext + when nextopnext->opcode is ADD_CODE is INDEXB_CODE - op=>offsz = op=>offsz + opnext=>val - freeops = 2 + op=>opoffset = op=>opoffset + nextop=>opval + freeops = 2 break is INDEXW_CODE - op=>offsz = op=>offsz + opnext=>val * 2 - freeops = 2 + op=>opoffset = op=>opoffset + nextop=>opval * 2 + freeops = 2 break wend fin break - is LB_CODE: - op->code = LAB_CODE - freeops = 1 + is LB_CODE + op->opcode = LAB_CODE + op->opgroup = GLOBAL_GROUP + freeops = 1 break is LW_CODE - op->code = LAW_CODE - freeops = 1 + op->opcode = LAW_CODE + op->opgroup = GLOBAL_GROUP + freeops = 1 break is SB_CODE - op->code = SAB_CODE - freeops = 1 + op->opcode = SAB_CODE + op->opgroup = GLOBAL_GROUP + freeops = 1 break is SW_CODE - op->code = SAW_CODE - freeops = 1 + op->opcode = SAW_CODE + op->opgroup = GLOBAL_GROUP + freeops = 1 break is ICAL_CODE - op->code = CALL_CODE - freeops = 1 + op->opcode = CALL_CODE + op->opgroup = GLOBAL_GROUP + freeops = 1 break wend if pass > 0 and not freeops crunched = try_dupify(op) fin break // GADDR_CODE - is LLB_CODE: + is LLB_CODE if pass > 0 crunched = try_dupify(op) + fin break // LLB_CODE is LLW_CODE // LLW [n]:CB 8:SHR -> LLB [n+1] - if opnext->code == CONST_CODE and opnext=>val == 8 - if opnext=>nextop - opnextnext = opnext=>nextop - if opnextnext->code == SHR_CODE - op->code = LLB_CODE - op=>offsz++ + if nextop->opcode == CONST_CODE and nextop=>opval == 8 + if nextop=>opnext + nextopnext = nextop=>opnext + if nextopnext->opcode == SHR_CODE + op->opcode = LLB_CODE + op=>opoffset++ freeops = 2 break fin fin fin - if pass > 0 and not freeops + if pass and not freeops crunched = try_dupify(op) fin break // LLW_CODE is LAB_CODE - if pass > 0 and (op->type) // || !is_hardware_address(op->offsz))) + if pass and not is_hardware_address(op=>opoffset) crunched = try_dupify(op) + fin break // LAB_CODE is LAW_CODE // LAW x:CB 8:SHR -> LAB x+1 - if opnext->code == CONST_CODE and opnext=>val == 8 - if opnext=>nextop - opnextnext = opnext=>nextop - if opnextnext->code == SHR_CODE - op->code = LAB_CODE - op=>offsz++ + if nextop->opcode == CONST_CODE and nextop=>opval == 8 + if nextop=>opnext + nextopnext = nextop=>opnext + if nextopnext->opcode == SHR_CODE + op->opcode = LAB_CODE + op=>opoffset++ freeops = 2 break fin fin fin - if pass > 0 and not freeops and (op->type) // || !is_hardware_address(op->offsz))) + if pass and not freeops and not is_hardware_address(op=>opoffset) crunched = try_dupify(op) fin break // LAW_CODE is LOGIC_NOT_CODE - when opnext->code + when nextop->opcode is BRFALSE_CODE - op->code = BRTRUE_CODE - op=>tag = opnext=>tag - freeops = 1 + op->opcode = BRTRUE_CODE + op->opgroup = RELATIVE_GROUP + op=>optag = nextop=>optag + freeops = 1 break is BRTRUE_CODE - op->code = BRFALSE_CODE - op=>tag = opnext=>tag - freeops = 1 + op->opcode = BRFALSE_CODE + op->opgroup = RELATIVE_GROUP + op=>optag = nextop=>optag + freeops = 1 break wend break // LOGIC_NOT_CODE is SLB_CODE - if opnext->code == LLB_CODE and op=>offsz == opnext=>offsz - op->code = DLB_CODE - freeops = 1 + if nextop->opcode == LLB_CODE and op=>opoffset == nextop=>opoffset + op->opcode = DLB_CODE + freeops = 1 fin break // SLB_CODE is SLW_CODE - if opnext->code == LLW_CODE and op=>offsz == opnext=>offsz - op->code = DLW_CODE - freeops = 1 + if nextop->opcode == LLW_CODE and op=>opoffset == nextop=>opoffset + op->opcode = DLW_CODE + freeops = 1 fin break // SLW_CODE is SAB_CODE - if opnext->code == LAB_CODE and op=>tag == opnext=>tag and op=>offsz == opnext=>offsz and op->type == opnext->type - op->code = DAB_CODE - freeops = 1 + if nextop->opcode == LAB_CODE and op=>optag == nextop=>optag and op=>opoffset == nextop=>opoffset + op->opcode = DAB_CODE + freeops = 1 fin break // SAB_CODE is SAW_CODE - if opnext->code == LAW_CODE and op=>tag == opnext=>tag and op=>offsz == opnext=>offsz and op->type == opnext->type - op->code = DAW_CODE - freeops = 1 + if nextop->opcode == LAW_CODE and op=>optag == nextop=>optag and op=>opoffset == nextop=>opoffset + op->opcode = DAW_CODE + freeops = 1 fin break // SAW_CODE wend @@ -930,10 +833,10 @@ def crunch_seq(seq, pass) // If op is at the start of the sequence, we treat this as a special case. // while freeops > 0 - opnext = op=>nextop + nextop = op=>opnext release_op(op) - *seq = opnext - op = opnext + *seq = nextop + op = nextop freeops-- loop crunched = TRUE @@ -943,28 +846,27 @@ def crunch_seq(seq, pass) // let the following loop remove the required number of ops. // op = opprev - opnext = op=>nextop + nextop = op=>opnext fin fin while freeops - op=>nextop = opnext=>nextop - opnext=>nextop = freeop_lst - freeop_lst = opnext - opnext = op=>nextop + op=>opnext = nextop=>opnext + nextop=>opnext = freeop_lst + freeop_lst = nextop + nextop = op=>opnext crunched = TRUE freeops-- loop opprev = op - op = opnext - opnext = op=>nextop + op = nextop + nextop = op=>opnext loop return crunched end // -// Generate a sequence of code +// Generate/add to a sequence of code // -def gen_seq(seq, opcode, cval, tag, offsz, type) -{ +def gen_op(seq, code) word op if not seq @@ -972,30 +874,220 @@ def gen_seq(seq, opcode, cval, tag, offsz, type) op = seq else op = seq - while op=>nextop; op = op=>nextop; loop - op=>nextop = new_op - op = op=>nextop + while op=>opnext; op = op=>opnext; loop + op=>opnext = new_op + op = op=>opnext fin - op->code = opcode - op=>val = cval - op=>tag = tag - op=>offsz = offsz - op->type = type + op->opcode = code + op->opgroup = STACK_GROUP + return seq +end +def gen_const(seq, cval) + word op + + if not seq + seq = new_op + op = seq + else + op = seq + while op=>opnext; op = op=>opnext; loop + op=>opnext = new_op + op = op=>opnext + fin + op->opcode = CONST_CODE + op->opgroup = CONST_GROUP + op=>opval = cval + return seq +end +def gen_str(seq, cval) + word op + + if not seq + seq = new_op + op = seq + else + op = seq + while op=>opnext; op = op=>opnext; loop + op=>opnext = new_op + op = op=>opnext + fin + op->opcode = CONSTR_CODE + op->opgroup = CONSTR_GROUP + op=>opval = cval + return seq +end +def gen_oplcl(seq, code, offsz) + word op + + if not seq + seq = new_op + op = seq + else + op = seq + while op=>opnext; op = op=>opnext; loop + op=>opnext = new_op + op = op=>opnext + fin + op->opcode = code + op->opgroup = LOCAL_GROUP + op=>opoffset = offsz + return seq +end +def gen_opglbl(seq, code, tag, offsz) + word op + + if not seq + seq = new_op + op = seq + else + op = seq + while op=>opnext; op = op=>opnext; loop + op=>opnext = new_op + op = op=>opnext + fin + op->opcode = code + op->opgroup = GLOBAL_GROUP + op=>optag = tag + op=>opoffset = offsz + return seq +end +def gen_oprel(seq, code, tag) + word op + + if not seq + seq = new_op + op = seq + else + op = seq + while op=>opnext; op = op=>opnext; loop + op=>opnext = new_op + op = op=>opnext + fin + op->opcode = code + op->opgroup = RELATIVE_GROUP + op=>optag = tag + return seq +end +def gen_ctag(seq, tag) + word op + + if not seq + seq = new_op + op = seq + else + op = seq + while op=>opnext; op = op=>opnext; loop + op=>opnext = new_op + op = op=>opnext + fin + op->opgroup = CODETAG_GROUP + op=>optag = IS_CTAG | tag + return seq +end +def gen_uop(tkn, seq) + byte code + word op + + if not seq + seq = new_op + op = seq + else + op = seq + while op=>opnext; op = op=>opnext; loop + op=>opnext = new_op + op = op=>opnext + fin + when tkn + is NEG_TKN + code = $10; break + is COMP_TKN + code = $12; break + is LOGIC_NOT_TKN + code = $20; break + is INC_TKN + code = $0C; break + is DEC_TKN + code = $0E; break + is BPTR_TKN + code = $60; break + is WPTR_TKN + code = $62; break + otherwise + exit_err(ERR_INVAL|ERR_SYNTAX) + wend + op->opcode = code + op->opgroup = STACK_GROUP + return seq +end +def gen_bop(tkn, seq) + byte code + word op + + if not seq + seq = new_op + op = seq + else + op = seq + while op=>opnext; op = op=>opnext; loop + op=>opnext = new_op + op = op=>opnext + fin + when tkn + is MUL_TKN + code = $06; break + is DIV_TKN + code = $08; break + is MOD_TKN + code = $0A; break + is ADD_TKN + code = $02; break + is SUB_TKN + code = $04; break + is SHL_TKN + code = $1A; break + is SHR_TKN + code = $1C; break + is AND_TKN + code = $14; break + is OR_TKN + code = $16; break + is EOR_TKN + code = $18; break + is EQ_TKN + code = $40; break + is NE_TKN + code = $42; break + is GE_TKN + code = $48; break + is LT_TKN + code = $46; break + is GT_TKN + code = $44; break + is LE_TKN + code = $4A; break + is LOGIC_OR_TKN + code = $22; break + is LOGIC_AND_TKN + code = $24; break + otherwise + exit_err(ERR_INVAL|ERR_SYNTAX) + wend + op->opcode = code + op->opgroup = STACK_GROUP return seq end // // Append one sequence to the end of another // def cat_seq(seq1, seq2) -{ word op if not seq1; return seq2; fin op = seq1 - while op=>nextop; op = op=>nextop; loop - op=>nextop = seq2 + while op=>opnext; op = op=>opnext; loop + op=>opnext = seq2 return seq1 -fin +end // // Emit the pending sequence // @@ -1021,175 +1113,81 @@ def emit_pending_seq#0 fin while lcl_pending op = lcl_pending - when op->code - is CONST_CODE - emit_const(op=>val) + when op->opgroup + // + // Constant value + // + is CONST_GROUP + if op=>opval == $0000 // ZERO + emit_byte($00) + elsif op=>opval & $FF00 == $0000 // Constant BYTE + emit_byte($2A) + emit_byte(op->opval) + elsif op=>opval & $FF00 == $FF00 // Constant $FF00 | BYTE + emit_byte($5E) + emit_byte(op->opval) + else // Constant WORD + emit_byte($2C) + emit_word(op=>opval) + fin break - is STR_CODE - emit_conststr(op=>val) + // + // Constant string + // + is CONSTR_GROUP + emit_byte($2E) + emit_data(0, STR_TYPE, op=>opval, 0) break - is LB_CODE - emit_lb() + // + // Single op codes + // + is STACK_GROUP + emit_byte(op->opcode) break - is LW_CODE - emit_lw() + // + // Local address codes + // + is LOCAL_GROUP + emit_byte(op->opcode) + emit_byte(op->opoffset) break - is LLB_CODE - emit_llb(op=>offsz) + // + // Global address codes + // + is GLOBAL_GROUP + if op=>optag & IS_CTAG and op=>opoffset + exit_err(ERR_INVAL|ERR_CODE|ERR_CONST) + else + emit_byte(op->opcode) + emit_addr(op=>optag+op=>opoffset) + fin break - is LLW_CODE - emit_llw(op=>offsz) + // + // Relative address codes + // + is RELATIVE_GROUP + emit_byte(op->opcode) + emit_reladdr(op=>optag) break - is LAB_CODE - emit_lab(op=>tag, op=>offsz, op->type) - break - is LAW_CODE - emit_law(op=>tag, op=>offsz, op->type) - break - is SB_CODE - emit_sb() - break - is SW_CODE - emit_sw() - break - is SLB_CODE - emit_slb(op-=>offsz) - break - is SLW_CODE - emit_slw(op=>offsz) - break - is DLB_CODE - emit_dlb(op=>offsz) - break - is DLW_CODE - emit_dlw(op=>offsz) - break - is SAB_CODE - emit_sab(op=>tag, op=>offsz, op->type) - break - is SAW_CODE - emit_saw(op=>tag, op=>offsz, op->type) - break - is DAB_CODE - emit_dab(op=>tag, op=>offsz, op->type) - break - is DAW_CODE - emit_daw(op=>tag, op=>offsz, op->type) - break - is CALL_CODE - emit_call(op=>tag, op->type) - break - is ICAL_CODE - emit_ical() - break - is LADDR_CODE - emit_localaddr(op=>offsz) - break - is GADDR_CODE - emit_globaladdr(op=>tag, op=>offsz, op->type) - break - is INDEXB_CODE - emit_indexbyte - break - is INDEXW_CODE - emit_indexword - break - is DROP_CODE - emit_drop - break - is DUP_CODE - emit_dup - break - is PUSH_EXP_CODE - emit_push_exp - break - is PULL_EXP_CODE - emit_pull_exp - break - is BRNCH_CODE - emit_brnch(op=>tag) - break - is BRFALSE_CODE - emit_brfls(op=>tag) - break - is BRTRUE_CODE - emit_brtru(op=>tag) - break - is CODETAG_CODE - printf("_B%03d%c\n", op->tag, LBL); - break - is NEG_CODE - is COMP_CODE - is LOGIC_NOT_CODE - is INC_CODE - is DEC_CODE - is BPTR_CODE - is WPTR_CODE - emit_unaryop(op->code) - break - is MUL_CODE - is DIV_CODE - is MOD_CODE - is ADD_CODE - is SUB_CODE - is SHL_CODE - is SHR_CODE - is AND_CODE - is OR_CODE - is EOR_CODE - is EQ_CODE - is NE_CODE - is GE_CODE - is LT_CODE - is GT_CODE - is LE_CODE - is LOGIC_OR_CODE - is LOGIC_AND_CODE - emit_op(op->code) - break - is MUL_CODE - is DIV_CODE - is MOD_CODE - is ADD_CODE - is SUB_CODE - is SHL_CODE - is SHR_CODE - is AND_CODE - is OR_CODE - is EOR_CODE - is EQ_CODE - is NE_CODE - is GE_CODE - is LT_CODE - is GT_CODE - is LE_CODE - is LOGIC_OR_CODE - is LOGIC_AND_CODE - emit_op(op->code) - break - is NEG_CODE - is COMP_CODE - is LOGIC_NOT_CODE - is INC_CODE - is DEC_CODE - is BPTR_CODE - is WPTR_CODE - emit_unaryop(op->code) - is NOP_CODE + // + // Code tags + // + is CODETAG_GROUP + emit_ctag(op=>optag) break otherwise return wend - lcl_pending = lcl_pending=>nextop; + lcl_pending = lcl_pending=>opnext; // - //Free this op + // Free this op // - op=>nextop = freeop_lst + op=>opnext = freeop_lst freeop_lst = op loop end // -//Emit a sequence of ops (into the pending sequence) +// Emit a sequence of ops (into the pending sequence) // def emit_seq(seq)#0 word op @@ -1197,8 +1195,8 @@ def emit_seq(seq)#0 string = FALSE op = seq while op - if op->code == STR_CODE; string = TRUE; break; fin - op = op=>nextop + if op->opgroup == CONSTR_GROUP; string = TRUE; break; fin + op = op=>opnext loop pending_seq = cat_seq(pending_seq, seq) // @@ -1214,3 +1212,14 @@ def emit_seq(seq)#0 emit_pending_seq fin end +// +// Emit lambda function +// +def emit_lambdafunc(tag, namestr, cparms, lambda_seq)#0 + emit_ctag(tag) + framesize = cparms * 2 + emit_enter(cparms) + emit_seq(lambda_seq) + emit_pending_seq + emit_leave +end diff --git a/src/toolsrc/lex.pla b/src/toolsrc/lex.pla index 776bb7c..0f78d10 100644 --- a/src/toolsrc/lex.pla +++ b/src/toolsrc/lex.pla @@ -124,7 +124,7 @@ def scan constval = ^scanptr wend fin - if ^(scanptr + 1) <> '\''; exit_err(@bad_cnst); fin + if ^(scanptr + 1) <> '\''; exit_err(ERR_INVAL|ERR_CONST); fin scanptr = scanptr + 2 break is '"' @@ -155,7 +155,7 @@ def scan strconst++ scanptr++ loop - if !^scanptr; exit_err(@bad_cnst); fin + if !^scanptr; exit_err(ERR_INVAL|ERR_CONST); fin constval = @strconst scanptr++ break @@ -228,7 +228,7 @@ def scan scanptr++ fin break - is ': + is ':' if ^(scanptr + 1) == ':' token = TRIELSE_TKN; scanptr = scanptr + 2 @@ -290,18 +290,18 @@ def nextln else if token <> EOL_TKN or token <> EOF_TKN; exit_err("Extraneous characters"); fin scanptr = inbuff - instr = fileio:read(refnum, inbuff, 127) + ^instr = fileio:read(refnum, inbuff, 127) if instr ^(inbuff + instr + 1) = 0 // NULL terminate string lineno++ if !(lineno & $0F); putc('.'); fin if scan == INCLUDE_TKN if incref; exit_err("Nested INCLUDEs not allowed"); fin - if scan <> STRING_TKN; exit_err("Missing INCLUDE file"); fin + if scan <> STR_TKN; exit_err("Missing INCLUDE file"); fin incfile = scanptr - constval memcpy(@incfile + 1, constval, incfile) - sysincbuf = heapallocalign(1024, 256) - incref = fileio:opensys(@incfile, sysincbuf) + sysincbuf = heapallocalign(1024, 8, @sysincfre) + incref = fileio:openbuf(@incfile, sysincbuf) if not incref; exit_err("Unable to open INCLUDE file"); fin fileio:newline(incref, $7F, $0D) refnum = incref @@ -312,8 +312,8 @@ def nextln fin else if refnum == incref - fileio:close(incnum) - heaprelease(sysincbuf) + fileio:close(incref) + heaprelease(sysincfre) incref = 0 refnum = srcref parsefile = srcfile diff --git a/src/toolsrc/parse.pla b/src/toolsrc/parse.pla index 97ef649..19f6758 100644 --- a/src/toolsrc/parse.pla +++ b/src/toolsrc/parse.pla @@ -2,14 +2,14 @@ // Alebraic op to stack op // def push_op(op, prec)#0 - if opsp == 16; exit_err("Op stack overflow"); fin + if opsp == 16; exit_err(ERR_OVER|ERR_CODE|ERR_FRAME); fin opstack[opsp] = op precstack[opsp] = prec opsp++ end def pop_op opsp-- - if opsp < 0; exit_err("Op stack underflow"); fin + if opsp < 0; exit_err(ERR_INVAL|ERR_CODE|ERR_FRAME); fin return opstack[opsp] end def tos_op @@ -25,7 +25,7 @@ def tos_op_prec(tos) return precstack[opsp] end def push_val(value, size, type)#0 - if valsp == 16; exit_err("Eval stack overflow"); fin + if valsp == 16; exit_err(ERR_OVER|ERR_CODE|ERR_FRAME); fin valstack[valsp] = value sizestack[valsp] = size typestack[valsp] = type @@ -33,7 +33,7 @@ def push_val(value, size, type)#0 end def pop_val#3 valsp-- - if valsp < 0; exit_err("Eval stack underflow"); fin + if valsp < 0; exit_err(ERR_INVAL|ERR_CODE|ERR_FRAME); fin return valstack[valsp], sizestack[valsp], typestack[valsp] end // @@ -45,7 +45,7 @@ def calc_binaryop(op)#0 val2, size2, type2 = pop_val val1, size1, type1 = pop_val - if type1 <> CONST_TYPE and type2 <> CONST_TYPE; exit_err(@bad_cnst); fin + if type1 <> CONST_TYPE and type2 <> CONST_TYPE; exit_err(ERR_INVAL|ERR_CONST); fin when op is MUL_TKN val1 = val1 * val2 @@ -78,7 +78,7 @@ def calc_binaryop(op)#0 val1 = val1 ^ val2 break otherwise - exit_err(@bad_cnst) + exit_err(ERR_INVAL|ERR_CONST) wend if size2 > size1; size1 = size2; fin push_val(val1, size1, type1) @@ -87,7 +87,7 @@ def parse_constterm when scan is OPEN_PAREN_TKN parse_constexpr - if token <> CLOSE_PAREN_TKN; exit_err(@no_close_paren); fin + if token <> CLOSE_PAREN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin return TRUE is ID_TKN is INT_TKN @@ -98,8 +98,8 @@ def parse_constterm return FALSE end def parse_constval - byte mod, type, size - word idptr, ctag, value + byte mod, size + word type, idptr, ctag, value mod = 0 while not parse_constterm @@ -125,7 +125,7 @@ def parse_constval size = tknlen - 1 value = constval type = STR_TYPE - if mod; exit_err(@bad_op); fin + if mod; exit_err(ERR_INVAL|ERR_CONST); fin break is CHR_TKN size = 1 @@ -140,9 +140,9 @@ def parse_constval is ID_TKN size = 2 idptr = id_lookup(tknptr, tknlen) - type = idptr->idtype + type = idptr=>idtype if type & ADDR_TYPE - if mod <> 8; exit_err(@bad_cnst); fin + if mod <> 8; exit_err(ERR_INVAL|ERR_CONST); fin type = CONSTADDR_TYPE fin value = idptr=>idval @@ -186,8 +186,8 @@ def parse_constexpr#3 next fin until matchop <> 2 - if matchop == 0 and prevmatch == 0; return 0; fin - if matchop == 0 and prevmatch == 2; exit_err(@missing_op); fin + if matchop == 0 and prevmatch == 0; return 0, 0, 0; fin + if matchop == 0 and prevmatch == 2; exit_err(ERR_INVAL|ERR_SYNTAX); fin while optos < opsp calc_binaryop(pop_op) loop @@ -203,7 +203,7 @@ def parse_const(valptr) break is ID_TKN idptr = id_lookup(tknptr, tknlen) - if idptr->idtype & CONST_TYPE + if idptr=>idtype & CONST_TYPE *valptr = idptr=>idval break fin @@ -224,7 +224,7 @@ def parse_list#2 repeat listseq, stackdepth = parse_expr(listseq) listdepth = listdepth + stackdepth - until not listseq or token <> COMMA_TOKEN + until not listseq or token <> COMMA_TKN return listseq, listdepth end def parse_value(codeseq, rvalue)#2 @@ -253,7 +253,7 @@ def parse_value(codeseq, rvalue)#2 is LOGIC_NOT_TKN uopseq = gen_uop(uopseq, token); is ADD_TKN - if not rvalue; exit_err("Invalid op for LVALUE"); fin + if not rvalue; exit_err(ERR_INVAL|ERR_SYNTAX); fin break is BPTR_TKN deref++ @@ -265,7 +265,7 @@ def parse_value(codeseq, rvalue)#2 break is AT_TKN deref-- - if not deref; exit_err("Invalid ADDRESS-OF"); fin + if not deref; exit_err(ERR_INVAL|ERR_SYNTAX); fin break otherwise operation = FALSE @@ -278,13 +278,13 @@ def parse_value(codeseq, rvalue)#2 is ID_TKN idptr = id_lookup(tknptr, tknlen) if !idptr; return NULL, 0; fin - if !(idptr->idtype); return NULL, 0; fin - type = type | idptr->idtype + if !(idptr=>idtype); return NULL, 0; fin + type = type | idptr=>idtype value = idptr=>idval if type & CONST_TYPE valseq = gen_const(NULL, value) else - valseq = type & LOCAL_TYPE ?? gen_lcladr(NULL, value) :: gen_gbladr(NULL, value, type) + valseq = type & LOCAL_TYPE ?? gen_oplcl(NULL, LADDR_CODE, value) :: gen_opglbl(NULL, GADDR_CODE, value, type) fin if type & FUNC_TYPE cfnparms = idptr->funcparms @@ -304,18 +304,18 @@ def parse_value(codeseq, rvalue)#2 break is OPEN_PAREN_TKN valseq, stackdepth = parse_expr(NULL) - if scantoken <> CLOSE_PAREN_TOKEN; exit_err("Missing closing parenthesis"); fin + if token <> CLOSE_PAREN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin break - is DROP_TOKEN - if rvalue; exit_err("DROP is LVALUE only"); fin - codeseq = gen_drop(codeseq) + is DROP_TKN + if rvalue; exit_err(ERR_INVAL|ERR_STATE); fin + codeseq = gen_op(codeseq, DROP_CODE) scan return codeseq, 0 // Special case return - is LAMBDA_TOKEN + is LAMBDA_TKN if not rvalue; return codeseq, 0; fin // Lambdas can't be LVALUES type = type | CONST_TYPE value = parse_lambda - valseq = gen_gbladr(NULL, value, FUNC_TYPE) + valseq = gen_opglbl(NULL, GADDR_CODE, value, 0) break otherwise if uopseq; release_seq(uopseq); fin @@ -332,25 +332,25 @@ def parse_value(codeseq, rvalue)#2 // // Function call - parameters generate before call address // - idxseq, value = parse_list(NULL) + idxseq, value = parse_list valseq = cat_seq(idxseq, valseq) - if token <> CLOSE_PAREN_TKN; exit_err("Missing function closing parenthesis"); fin + if token <> CLOSE_PAREN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin if type & FUNC_TYPE - if cfnparms <> value; exit_err("Parameter count mismatch"); fin + if cfnparms <> value; exit_err(ERR_MISS|ERR_ID); fin else // Can't check parm count on function pointers cfnparms = value fin if scan == POUND_TKN // Set function pointer return vals count - can't do this to regular function call - if type & FUNC_TYPE; exit_err("Overriding function return count"); fin - if not parse_const(@cfnvals); exit_err("Invalid def return value count"); fin + if type & FUNC_TYPE; exit_err(ERR_INVAL|ERR_SYNTAX); fin + if not parse_const(@cfnvals); exit_err(ERR_INVAL|ERR_CONST); fin else - scan_rewind(tokenstr) + rewind(tknptr) fin if type & (VAR_TYPE | PTR_TYPE) // !(type & (FUNC_TYPE | CONST_TYPE))) - valseq = gen_lw(valseq) + valseq = gen_op(valseq, LW_CODE) if deref; deref--; fin fin - valseq = gen_icall(valseq) + valseq = gen_op(valseq, ICAL_CODE) stackdepth = stackdepth + cfnvals + cfnparms - value - 1 cfnparms = 0 cfnvals = 1 @@ -361,7 +361,7 @@ def parse_value(codeseq, rvalue)#2 // Array of arrays // if type & FUNC_TYPE // Function call dereference - valseq = gen_icall(valseq) + valseq = gen_op(valseq, ICAL_CODE) stackdepth = stackdepth + cfnvals + cfnparms - 1 cfnparms = 0 cfnvals = 1 @@ -370,15 +370,15 @@ def parse_value(codeseq, rvalue)#2 repeat valseq, drop = parse_expr(valseq) if token <> COMMA_TKN; break; fin - valseq = gen_idxw(valseq); - valseq = gen_lw(valseq); + valseq = gen_op(valseq, INDEXW_CODE) + valseq = gen_op(valseq, LW_CODE) until FALSE - if token <> CLOSE_BRACKET_TOKEN; exit_err("Missing closing bracket"); fin + if token <> CLOSE_BRACKET_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin if type & (WPTR_TYPE | WORD_TYPE) - valseq = gen_idxw(valseq) + valseq = gen_op(valseq, INDEXW_CODE) type = (type & PTR_TYPE) | WORD_TYPE else - valseq = gen_idxb(valseq) + valseq = gen_op(valseq, INDEXB_CODE) type = (type & PTR_TYPE) | BYTE_TYPE fin break @@ -388,21 +388,21 @@ def parse_value(codeseq, rvalue)#2 // Structure member pointer // if type & FUNC_TYPE // Function call dereference - valseq = gen_icall(valseq) + valseq = gen_op(valseq, ICAL_CODE) stackdepth = stackdepth + cfnvals + cfnparms - 1 cfnparms = 0 cfnvals = 1 type = type & ~FUNC_TYPE elsif type & (VAR_TYPE | PTR_TYPE) - valseq = gen_lw(valseq) // Pointer dereference + valseq = gen_op(valseq, LW_CODE) // Pointer dereference fin type = token == PTRB_TKN ?? BPTR_TYPE :: WPTR_TYPE if not parse_const(@const_offset) - if token == EOL_TKN or token == CLOSE_PAREN_TKN; exit_err("Syntax"); fin - scan_rewind(tokenstr) // Setting type override for following operations + if token == EOL_TKN or token == CLOSE_PAREN_TKN; exit_err(ERR_SYNTAX); fin + rewind(tknptr) // Setting type override for following operations elsif const_offset <> 0 valseq = gen_const(valseq, const_offset) // Structure member pointer - valseq = gen_op(valseq, ADD_TOKEN) + valseq = gen_op(valseq, ADD_TKN) fin break is DOT_TKN @@ -411,20 +411,20 @@ def parse_value(codeseq, rvalue)#2 // Structure member offset // if type & FUNC_TYPE // Function call dereference - valseq = gen_icall(valseq) + valseq = gen_op(valseq, ICAL_CODE) stackdepth = stackdepth + cfnvals + cfnparms - 1 cfnparms = 0 cfnvals = 1 type = type & ~FUNC_TYPE fin if type & (VAR_TYPE | CONST_TYPE) - type = token == DOT_TOKEN ?? BYTE_TYPE :: WORD_TYPE + type = token == DOT_TKN ?? BYTE_TYPE :: WORD_TYPE else - type = token == DOT_TOKEN ?? BPTR_TYPE : :WPTR_TYPE + type = token == DOT_TKN ?? BPTR_TYPE :: WPTR_TYPE fin if not parse_const(@const_offset) - if token == EOL_TOKEN or token == CLOSE_PAREN_TOKEN; exit_err("Syntax"); fin - scan_rewind(tokenstr) // Setting type override for following operations + if token == EOL_TKN or token == CLOSE_PAREN_TKN; exit_err(ERR_SYNTAX); fin + rewind(tknptr) // Setting type override for following operations elsif const_offset <> 0 valseq = gen_const(valseq, const_offset) // Structure member offset valseq = gen_op(valseq, ADD_TKN) @@ -440,24 +440,24 @@ def parse_value(codeseq, rvalue)#2 while deref > rvalue deref-- if type & FUNC_TYPE - valseq = gen_icall(valseq) + valseq = gen_op(valseq, ICAL_CODE) stackdepth = stackdepth + cfnvals + cfnparms - 1 cfnparms = 0 cfnvals = 1 type = type & ~FUNC_TYPE; elsif type & VAR_TYPE - valseq = gen_lw(valseq) + valseq = gen_op(valseq, LW_CODE) fin loop if deref if type & FUNC_TYPE - valseq = gen_icall(valseq) + valseq = gen_op(valseq, ICAL_CODE) stackdepth = stackdepth + cfnvals + cfnparms - 1 type = type & ~FUNC_TYPE elsif type & (BYTE_TYPE | BPTR_TYPE) - valseq = gen_lb(valseq) + valseq = gen_op(valseq, LB_CODE) elsif type & (WORD_TYPE | WPTR_TYPE) - valseq = gen_lw(valseq) + valseq = gen_op(valseq, LW_CODE) fin fin // @@ -470,9 +470,9 @@ def parse_value(codeseq, rvalue)#2 if not rvalue stackdepth-- if type & (BYTE_TYPE | BPTR_TYPE) - valseq = gen_sb(valseq) + valseq = gen_op(valseq, SB_CODE) elsif type & (WORD_TYPE | WPTR_TYPE) - valseq = gen_sw(valseq) + valseq = gen_op(valseq, SW_CODE) else release_seq(valseq) return NULL, 0 // Function or const cannot be LVALUE, must be RVALUE @@ -508,7 +508,7 @@ def parse_expr(codeseq)#2 next fin until matchop <> 2 - if matchop == 0 and prevmatch == 2; exit_err(@missing_op); fin + if matchop == 0 and prevmatch == 2; exit_err(ERR_SYNTAX); fin while optos < opsp codeseq = gen_op(codeseq, pop_op) stackdepth-- @@ -516,18 +516,18 @@ def parse_expr(codeseq)#2 // // Look for ternary operator // - if token == TERNARY_TOKEN - if stackdepth <> 1; exit_err("Ternary op must evaluate to single value"); fin - tag_else = tag_new(BRANCH_TYPE) - tag_endtri = tag_new(BRANCH_TYPE) - codeseq = gen_brfls(codeseq, tag_else) + if token == TERNARY_TKN + if stackdepth <> 1; exit_err(ERR_OVER|ERR_SYNTAX); fin + tag_else = ctag_new + tag_endtri = ctag_new + codeseq = gen_oprel(codeseq, BRFALSE_CODE, tag_else) codeseq, stkdepth1 = parse_expr(codeseq) - if token <> TRIELSE_TOKEN; exit_err("Missing '::' in ternary op"); fin - codeseq = gen_brnch(codeseq, tag_endtri) - codeseq = gen_codetag(codeseq, tag_else) + if token <> TRIELSE_TKN; exit_err(ERR_MISS|ERR_SYNTAX); fin + codeseq = gen_oprel(codeseq, BRNCH_CODE, tag_endtri) + codeseq = gen_ctag(codeseq, tag_else) codeseq, stackdepth = parse_expr(codeseq) - if stkdepth1 <> stackdepth; exit_err("Inconsistent value counts in ternary op"); fin - codeseq = gen_codetag(codeseq, tag_endtri) + if stkdepth1 <> stackdepth; exit_err(ERR_INVAL|ERR_CODE); fin + codeseq = gen_ctag(codeseq, tag_endtri) fin return codeseq, stackdepth end @@ -550,7 +550,7 @@ def parse_set(codeseq) // Not a set list - free everything up // tknptr = setptr - scan_rewind(tknptr) + rewind(tknptr) while lparms lparms-- release_seq(setseq[lparms]) @@ -562,13 +562,13 @@ def parse_set(codeseq) loop return NULL fin - rseq, rparms = parse_list(NULL) - if lparms > rparms; exit_err("Set value list underflow"); fin + rseq, rparms = parse_list + if lparms > rparms; exit_err(ERR_MISS|ERR_CODE|ERR_FRAME); fin codeseq = cat_seq(codeseq, rseq) if lparms < rparms parse_warn("Silently dropping extra set values") for i = rparms - lparms downto 1 - codeseq = gen_drop(codeseq) + codeseq = gen_op(codeseq, DROP_CODE) next fin for i = lparms downto 1 @@ -587,14 +587,14 @@ def parse_stmnt when token is IF_TKN seq, cfnvals = parse_expr(NULL) - if !seq; exit_err(@bad_expr); fin + if !seq; exit_err(ERR_INVAL|ERR_STATE); fin if cfnvals > 1 parse_warn("Expression value overflow") - while cfnvals > 1; cfnvals--; seq = gen_drop(seq); loop + while cfnvals > 1; cfnvals--; seq = gen_op(seq, DROP_CODE); loop fin tag_else = ctag_new tag_endif = ctag_new - seq = gen_brfls(seq, tag_else) + seq = gen_oprel(seq, BRFALSE_CODE, tag_else) emit_seq(seq) repeat while parse_stmnt @@ -606,18 +606,18 @@ def parse_stmnt emit_branch(tag_endif) emit_ctag(tag_else) seq, cfnvals = parse_expr(NULL) - if !seq; exit_err(@bad_expr); fin + if !seq; exit_err(ERR_INVAL|ERR_STATE); fin if cfnvals > 1 parse_warn("Expression value overflow") - while cfnvals > 1; cfnvals--; seq = gen_drop(seq); loop + while cfnvals > 1; cfnvals--; seq = gen_op(seq, DROP_CODE); loop fin tag_else = ctag_new - seq = gen_brfls(seq, tag_else) + seq = gen_oprel(seq, BRFALSE_CODE, tag_else) emit_seq(seq) until FALSE if token == ELSE_TKN emit_branch(tag_endif) - emit_ctag_(tag_else) + emit_ctag(tag_else) scan while parse_stmnt nextln @@ -627,7 +627,7 @@ def parse_stmnt emit_ctag(tag_else) emit_ctag(tag_endif) fin - if token <> FIN_TKN; exit_err("Missing IF/FIN"); fin + if token <> FIN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin break is WHILE_TKN tag_while = ctag_new @@ -638,17 +638,17 @@ def parse_stmnt break_tag = tag_wend emit_ctag(tag_while) seq, cfnvals = parse_expr(NULL) - if !seq; exit_err(@bad_expr); fin + if !seq; exit_err(ERR_INVAL|ERR_STATE); fin if cfnvals > 1 parse_warn("Expression value overflow") - while cfnvals > 1;cfnvals--; seq = gen_drop(seq); loop + while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop fin - seq = gen_brfls(seq, tag_wend) + seq = gen_oprel(seq, BRFALSE_CODE, tag_wend) emit_seq(seq) while parse_stmnt nextln loop - if token <> LOOP_TKN; exit_err("Missing WHILE/LOOP"); fin + if token <> LOOP_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin emit_branch(tag_while) emit_ctag(tag_wend) break_tag = tag_prevbrk @@ -665,16 +665,16 @@ def parse_stmnt while parse_stmnt nextln loop - if token <> UNTIL_TKN; exit_err("Mising REPEAT/UNTIL"); fin + if token <> UNTIL_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin emit_ctag(cont_tag) cont_tag = tag_prevcnt seq, cfnvals = parse_expr(NULL) - if !seq; exit_err(@bad_expr); fin + if !seq; exit_err(ERR_INVAL|ERR_STATE); fin if cfnvals > 1 parse_warn("Expression value overflow") - while cfnvals > 1; cfnvals--; seq = gen_drop(seq); loop + while cfnvals > 1; cfnvals--; seq = gen_op(seq, DROP_CODE); loop fin - seq = gen_brfls(seq, tag_repeat) + seq = gen_oprel(seq, BRFALSE_CODE, tag_repeat) emit_seq(seq) emit_ctag(break_tag) break_tag = tag_prevbrk @@ -686,62 +686,61 @@ def parse_stmnt cont_tag = tag_for tag_prevbrk = break_tag break_tag = ctag_new - if scan <> ID_TKN; exit_err("Missing FOR variable"); fin + if scan <> ID_TKN; exit_err(ERR_MISS|ERR_ID); fin idptr = id_lookup(tknptr, tknlen) if idptr - type = idptr->idtype + type = idptr=>idtype addr = idptr=>idval else - exit_err("Bad FOR variable") + exit_err(ERR_INVAL|ERR_ID) fin - if scan <> SET_TKN; exit_err("Missing FOR ="); fin + if scan <> SET_TKN; exit_err(ERR_INVAL|ERR_STATE); fin seq, cfnvals = parse_expr(NULL) - if !seq; exit_err(@bad_expr); fin + if !seq; exit_err(ERR_INVAL|ERR_STATE); fin if cfnvals > 1 parse_warn("Expression value overflow") - while cfnvals > 1;cfnvals--; seq = gen_drop(seq); loop + while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop fin emit_ctag(tag_for) if type & LOCAL_TYPE - type & BYTE_TYPE ?? emit_dlb(addr) :: emit_dlw(addr) + if type & BYTE_TYPE; emit_dlb(addr); else; emit_dlw(addr); fin else - type & BYTE_TYPE ?? emit_dab(addr, 0) :: emit_daw(addr, 0) + if type & BYTE_TYPE; emit_dab(addr, 0); else; emit_daw(addr, 0); fin fin if token == TO_TKN stepdir = 1 elsif token == DOWNTO_TKN stepdir = -1 else - exit_err("Missing FOR TO") + exit_err(ERR_INVAL|ERR_STATE) fin seq, cfnvals = parse_expr(NULL) - if !seq; exit_err("Bad FOR TO expression"); fin + if !seq; exit_err(ERR_INVAL|ERR_STATE); fin if cfnvals > 1 parse_warn("Expression value overflow") - while cfnvals > 1;cfnvals--; seq = gen_drop(seq); loop + while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop fin emit_seq(seq) - stepdir > 0 ?? emit_brgt(break_tag) :: emit_brlt(break_tag) - fin + if stepdir > 0; emit_brgt(break_tag); else; emit_brlt(break_tag); fin if token == STEP_TKN seq, cfnvals = parse_expr(NULL) - if !seq; exit_err("Bad FOR STEP expression"); fin + if !seq; exit_err(ERR_INVAL|ERR_STATE); fin if cfnvals > 1 parse_warn("Expression value overflow") - while cfnvals > 1;cfnvals--; seq = gen_drop(seq); loop + while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop fin - emit_binaryop(stepdir > 0 ?? ADD_TKN :: SUB_TKN) + emit_byte(stepdir > 0 ?? ADD_CODE :: SUB_CODE) else - emit_unaryop(stepdir > 0 ?? INC_TKN :: DEC_TKN) + emit_byte(stepdir > 0 ?? INC_CODE :: DEC_CODE) fin while parse_stmnt nextln loop - if token <> NEXT_TKN; exit_err("Missing FOR/NEXT"); fin + if token <> NEXT_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin emit_branch(tag_for) cont_tag = tag_prevcnt emit_ctag(break_tag) - emit_drop + emit_byte(DROP_CODE) break_tag = tag_prevbrk stack_loop-- break @@ -752,20 +751,20 @@ def parse_stmnt tag_choice = ctag_new tag_of = ctag_new seq, cfnvals = parse_expr(NULL) - if !seq; exit_err("Bad CASE expression"); fin + if !seq; exit_err(ERR_INVAL|ERR_STATE); fin if cfnvals > 1 parse_warn("Expression value overflow") - while cfnvals > 1;cfnvals--; seq = gen_drop(seq); loop + while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop fin nextln while token <> ENDCASE_TKN when token is OF_TKN seq, cfnvals = parse_expr(NULL) - if !seq; exit_err("Bad FOR TO expression"); fin + if !seq; exit_err(ERR_INVAL|ERR_STATE); fin if cfnvals > 1 parse_warn("Expression value overflow") - while cfnvals > 1;cfnvals--; seq = gen_drop(seq); loop + while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop fin emit_brne(tag_choice) emit_ctag(tag_of) @@ -786,20 +785,20 @@ def parse_stmnt while parse_stmnt nextln loop - if token <> ENDCASE_TKN; exit_err("Bad WHEN OTHERWISE"); fin + if token <> ENDCASE_TKN; exit_err(ERR_INVAL|ERR_STATE); fin break is EOL_TKN nextln break otherwise - exit_err("Bad WHEN") + exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE) wend loop if (tag_of) emit_ctag(tag_of) fin emit_ctag(break_tag) - emit_drop + emit_byte(DROP_CODE) break_tag = tag_prevbrk stack_loop-- break @@ -807,25 +806,25 @@ def parse_stmnt if break_tag emit_branch(break_tag) else - exit_err("BREAK outside FOR or WHEN") + exit_err(ERR_INVAL|ERR_STATE) fin break is CONT_TKN if cont_tag emit_branch(cont_tag) else - exit_err("CONTINUE outside FOR or WHEN") + exit_err(ERR_INVAL|ERR_STATE) fin break is RETURN_TKN if infunc for i = 1 to stack_loop - emit_drop + emit_byte(DROP_CODE) next seq, cfnvals = parse_expr(NULL) - if !seq; exit_err("Bad CASE expression"); fin + if !seq; exit_err(ERR_INVAL|ERR_STATE); fin if cfnvals > infuncvals - exit_err("Too many return values") + exit_err(ERR_OVER|ERR_CLOSE|ERR_STATE) elsif cfnvals < infuncvals parse_warn("Too few return values") while cfnvals < infuncvals @@ -839,10 +838,11 @@ def parse_stmnt if !seq emit_const(0) elsif cfnvals > 1 - parse_warn("Expression value overflow") - while cfnvals > 1;cfnvals--; seq = gen_drop(seq); loop + exit_err(ERR_OVER|ERR_CLOSE|ERR_STATE) + while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop fin - emit_ret + emit_byte(RET_CODE) + fin break is EOL_TKN return TRUE @@ -865,26 +865,26 @@ def parse_stmnt if seq emit_seq(seq) else - idptr = tokenptr + idptr = tknptr seq, cfnvals = parse_value(NULL, RVALUE) if seq if token == INC_TKN or token == DEC_TKN emit_seq(seq) - emit_unaryop(token) - scanrewind(idptr) + emit_byte(token == INC_TKN ?? INC_CODE :: DEC_CODE) + rewind(idptr) seq, drop = parse_value(NULL, LVALUE) emit_seq(seq) elsif token <> SET_TKN while cfnvals > 1 - seq = cat_seq(seg, gen_drop(NULL)) + seq = cat_seq(seq, gen_op(NULL, DROP_CODE)) cfnvals-- loop emit_seq(seq) else - exit_err("Invalid LVALUE") + exit_err(ERR_INVAL|ERR_STATE) fin else - exit_err("Syntax") + exit_err(ERR_SYNTAX) fin fin wend @@ -901,13 +901,13 @@ def parse_var(type, basesize)#0 idlen = tknlen if scan == OPEN_BRACKET_TKN size, constsize, consttype = parse_constexpr - if token <> CLOSE_BRACKET_TKN; exit_err(@no_close_bracket); fin + if token <> CLOSE_BRACKET_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin scan fin fin size = size * basesize if token == SET_TKN - if type & (EXTERN_TYPE | LOCAL_TYPE); exit_err(@no_local_init); fin + if type & (EXTERN_TYPE|LOCAL_TYPE); exit_err(ERR_INVAL|ERR_LOCAL|ERR_INIT); fin if idlen iddata_add(idptr, idlen, type, 0) fin @@ -928,8 +928,8 @@ def parse_var(type, basesize)#0 end def parse_struc#0 byte strucid[16] - byte type, idlen, struclen, constsize, consttype - word size, offset, idstr + byte idlen, struclen, constsize, consttype + word type, size, offset, idstr struclen = 0 if scan == ID_TKN @@ -948,7 +948,7 @@ def parse_struc#0 type = token == BYTE_TKN ?? BYTE_TYPE :: WORD_TYPE if scan == OPEN_BRACKET_TKN size, constsize, consttype = parse_constexpr - if token <> CLOSE_BRACKET_TKN; exit_err(@no_close_bracket); fin + if token <> CLOSE_BRACKET_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin scan fin repeat @@ -958,7 +958,7 @@ def parse_struc#0 idlen = tknlen if scan == OPEN_BRACKET_TKN size, constsize, consttype = parse_constexpr - if token <> CLOSE_BRACKET_TKN; exit_err(@no_close_bracket); fin + if token <> CLOSE_BRACKET_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin scan fin fin @@ -975,24 +975,23 @@ def parse_struc#0 if struclen idconst_add(@strucid, struclen, offset) fin - if token <> END_TKN; exit_err("Missing STRUC/END"); fin + if token <> END_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin scan end def parse_vars(type) - byte idlen, size + byte idlen, size, cfnparms, cfnvals word value, idptr when token is SYSFLAGS_TKN - if type & (EXTERN_TYPE | LOCAL_TYPE); exit_err("SYSFLAGS must be global"); fin - value, drop, drop = parse_constexpr - emit_sysflags(value) + if type & (EXTERN_TYPE | LOCAL_TYPE); exit_err(ERR_INVAL|ERR_GLOBAL|ERR_INIT); fin + modsysflags, drop, drop = parse_constexpr break is CONST_TKN - if scan <> ID_TKN; exit_err(@bad_cnst); fin + if scan <> ID_TKN; exit_err(ERR_INVAL|ERR_CONST); fin idptr = tknptr idlen = tknlen - if scan <> SET_TKN; exit_err(@bad_cnst); fin + if scan <> SET_TKN; exit_err(ERR_INVAL|ERR_CONST); fin value, size, type = parse_constexpr idconst_add(idptr, idlen, value) break @@ -1000,13 +999,13 @@ def parse_vars(type) parse_struc break is EXPORT_TKN - if type & (EXTERN_TYPE | LOCAL_TYPE); exit_err("Cannot export local/imported variables"); fin + if type & (EXTERN_TYPE|LOCAL_TYPE); exit_err(ERR_INVAL|ERR_LOCAL|ERR_SYNTAX); fin type = EXPORT_TYPE - idstr = tokenptr + idptr = tknptr if scan <> BYTE_TKN and token <> WORD_TKN // This could be an exported definition - scan_rewind(idstr) + rewind(idptr) scan - return + return FALSE fin // Fall through to BYTE or WORD declaration is BYTE_TKN @@ -1015,9 +1014,9 @@ def parse_vars(type) size = 1 if scan == OPEN_BRACKET_TKN // Get basesize for data elements size, drop, drop = parse_constexpr - if token <> CLOSE_BRACKET_TKN; exit_err(@no_close_bracket); fin + if token <> CLOSE_BRACKET_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin else - scan_rewind(tokenptr) + rewind(tknptr) fin if type & WORD_TYPE; size = size * 2; fin repeat; parse_var(type, size); until token <> COMMA_TKN @@ -1026,8 +1025,8 @@ def parse_vars(type) repeat if scan == ID_TKN type = type | PREDEF_TYPE - idstr = tokenptr - idlen = tokenlen + idptr = tknptr + idlen = tknlen cfnparms = 0 cfnvals = 1 // Default to one return value for compatibility if scan == OPEN_PAREN_TKN @@ -1036,17 +1035,17 @@ def parse_vars(type) cfnparms++ scan fin - until token <> COMMA_TOKEN - if token <> CLOSE_PAREN_TKN; exit_err("Bad function parameter list"); fin + until token <> COMMA_TKN + if token <> CLOSE_PAREN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin scan fin if token == POUND_TKN - if not parse_const(@cfnvals); exit_err("Invalid def return value count"); fin + if not parse_const(@cfnvals); exit_err(ERR_INVAL|ERR_CONST); fin scan fin - idfunc_add(idstr, idlen, type, tag_new(type), cfnparms, cfnvals) + idfunc_add(idptr, idlen, type, ctag_new, cfnparms, cfnvals) else - exit_err("Bad function pre-declaration") + exit_err(ERR_MISS|ERR_ID) fin until token <> COMMA_TKN break @@ -1059,22 +1058,20 @@ def parse_vars(type) end def parse_mods if token == IMPORT_TKN - if scan <> ID_TKN; exit_err("Bad import definition"); fin - emit_moddep(tokenstr, tokenlen) + if scan <> ID_TKN; exit_err(ERR_MISS|ERR_ID); fin + moddep_add(tknptr, tknlen) scan - while parse_vars(EXTERN_TYPE); next_line(); loop - if token <> END_TKN; exit_err("Missing IMPORT/END"); fin + while parse_vars(EXTERN_TYPE); nextln; loop + if token <> END_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin scan fin - if token == EOL_TOKEN; return TRUE; fin - emit_moddep(0, 0) - return FALSE + return token == EOL_TKN end def parse_lambda word func_tag byte cfnparms - if not infunc; exit_err("Lambda functions only allowed inside definitions"); fin + if not infunc; exit_err(ERR_INVAL|ERR_STATE); fin idlocal_save // // Parse parameters and return value count @@ -1084,58 +1081,59 @@ def parse_lambda repeat if scan == ID_TKN cfnparms++ - idlocal_add(tokenstr, tokenlen, WORD_TYPE, 2) + idlocal_add(tknptr, tknlen, WORD_TYPE, 2) scan fin until token <> COMMA_TKN - if token <> CLOSE_PAREN_TKN; exit_err("Bad function parameter list"); fin + if token <> CLOSE_PAREN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin else - exit_err("Missing parameter list in lambda function"); + exit_err(ERR_MISS|ERR_ID) fin - expr = scanptr - if scan_lookahead == OPEN_PAREN_TKN + if lookahead == OPEN_PAREN_TKN scan - lambda_seq[lambda_cnt], drop = parse_list(NULL) - if token <> CLOSE_PAREN_TKN; exit_error("Missing closing lambda function parenthesis"); fin + lambda_seq[lambda_cnt], drop = parse_list + if token <> CLOSE_PAREN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin else lambda_seq[lambda_cnt], drop = parse_expr(NULL) - scan_rewind(tknptr) + rewind(tknptr) fin // // Build an anonymous ID string for the Lambda function // - strcpy(lambda_id + lambda_cnt * 8, "_LAMB__") - ^(lambda_id + lambda_cnt * 8 + 6) = (lambda_num >> 3) & 0x07 + '0' - ^(lambda_id + lambda_cnt * 8 + 7) = lambda_num & 0x07 + '0' - if idglobal_lookup(lambda_id + lambda_cnt * 8, 7) >= 0 + strcpy(@lambda_id[lambda_cnt * 8], "_LAMB__") + lambda_id[lambda_cnt * 8 + 6] = (lambda_num >> 3) & $07 + '0' + lambda_id[lambda_cnt * 8 + 7] = lambda_num & $07 + '0' + if idglobal_lookup(@lambda_id[lambda_cnt * 8], 7) >= 0 // // Lambda ID already exists (from failed scanning for '=') // - func_tag = lambda_tag=>[lambda_cnt] - idfunc_set(lambda_id + lambda_cnt * 8 + 1, 7, func_tag, 0, 0) // Override any predef type & tag + func_tag = lambda_tag[lambda_cnt] + idfunc_set(@lambda_id[lambda_cnt * 8 + 1], 7, func_tag, cfnparms, 1) // Override any predef type & tag else // // Creat new Lambda ID // - func_tag = ctag_new - lambda_tag=>[lambda_cnt] = func_tag - idfunc_add(lambda_id + lambda_cnt * 8 + 1, 7, func_tag, 0, 0) + func_tag = ctag_new + lambda_tag[lambda_cnt] = func_tag + lambda_cparms[lambda_cnt] = cfnparms + idfunc_add(@lambda_id[lambda_cnt * 8 + 1], 7, FUNC_TYPE, func_tag, cfnparms, 1) fin lambda_cnt++ + if lambda_cnt >= LAMBDANUM; parse_warn("Lambda function overflow"); fin idlocal_restore return func_tag end def parse_defs - byte cfnparms, cfnvals, type - word func_tag, idptr + byte cfnparms, cfnvals + word type, func_tag, idptr - type = DEF_TYPE + type = FUNC_TYPE if token == EXPORT_TKN - if scan <> DEF_TKN; exit_err("Bad export definition"); fin + if scan <> DEF_TKN; exit_err(ERR_INVAL|ERR_STATE); fin type = type | EXPORT_TYPE fin if token == DEF_TKN - if scan <> ID_TKN; exit_err(@bad_decl); fin + if scan <> ID_TKN; exit_err(ERR_INVAL|ERR_ID); fin lambda_cnt = 0 cfnparms = 0 infuncvals = 1 @@ -1149,22 +1147,21 @@ def parse_defs scan fin until token <> COMMA_TKN - if token <> CLOSE_PAREN_TKN; exit_err(@bad_decl); fin + if token <> CLOSE_PAREN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin scan fin if token == POUND_TKN - if not parse_const(@infuncvals); parse_error("Invalid def return value count"); fin + if not parse_const(@infuncvals); exit_err(ERR_INVAL|ERR_CONST); fin scan fin idptr = idglobal_lookup(tknptr, tknlen) if idptr - if not idptr->type & PREDEF_TYPE; exit_err("Mismatch function type"); fin - if idptr->funcparms <> cfnparms or idptr->funcvals <> infuncvals; exit_err("Mismatch function params/return values"); fin - emit_idfunc(idptr) + if not idptr=>idtype & PREDEF_TYPE; exit_err(ERR_DUP|ERR_ID); fin + if idptr->funcparms <> cfnparms or idptr->funcvals <> infuncvals; exit_err(ERR_DUP|ERR_CODE|ERR_ID); fin func_tag = idptr=>idval else func_tag = ctag_new - idfunc_add(tknptr, tknlen, func_tag, 0, 0, cfnparms, infuncvals) + idfunc_add(tknptr, tknlen, type, func_tag, cfnparms, infuncvals) fin emit_ctag(func_tag) retfunc_tag = ctag_new @@ -1177,59 +1174,43 @@ def parse_defs nextln loop infunc = FALSE - if token <> END_TKN; exit_err("Missing DEF/END"); fin + if token <> END_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin scan if prevstmnt <> RETURN_TKN if infuncvals; parse_warn("No return values"); fin for cfnvals = infuncvals - 1 downto 0 emit_const(0) + next emit_leave fin return TRUE while lambda_cnt lambda_cnt-- - emit_lambdafunc(lambda_tag[lambda_cnt], lambda_id + lambda_cnt * 8, lambda_cparams[lambda_cnt], lambda_seq[lambda_cnt]) + emit_lambdafunc(lambda_tag[lambda_cnt], @lambda_id[lambda_cnt * 8], lambda_cparms[lambda_cnt], lambda_seq[lambda_cnt]) loop fin return token == EOL_TKN ?? TRUE :: FALSE end -def parse_module +def parse_module#0 idglobal_init idlocal_init - srcref = fileio:open(@srcfile) - if srcref - fileio:newline(srcref, $7F, $0D) - refnum = srcref - parsefile = @srcfile - if nextln - // - // Compile module - // - while parse_vars - nextln - loop - while parse_defs - nextln - loop - framesize = 0 - entrypoint = codeptr - prevstmnt = 0 - emit_enter(0) - if token <> DONE_TKN - while parse_stmnt - nextln - loop - fin - if prevstmnt <> RETURN_TKN - emit_const(0) - emit_leave - fin - fileio:close(srcref) - //dumpsym(idglobal_tbl, globals) - return not parserr + if nextln + // + // Compile module + // + while parse_vars(GLOBAL_TYPE); nextln; loop + while parse_defs; nextln; loop + entrypoint = codeptr + prevstmnt = 0 + idlocal_init + emit_enter(0) + if token <> DONE_TKN + while parse_stmnt; nextln; loop fin - else - puts("Error opening: "); puts(@srcfile); putln + if prevstmnt <> RETURN_TKN + emit_const(0) + emit_leave + fin + //dumpsym(idglobal_tbl, globals) fin - return FALSE end diff --git a/src/toolsrc/plasm.pla b/src/toolsrc/plasm.pla index f42337c..b45da97 100644 --- a/src/toolsrc/plasm.pla +++ b/src/toolsrc/plasm.pla @@ -1,165 +1,171 @@ include "inc/cmdsys.plh" +include "inc/args.plh" include "inc/fileio.plh" include "inc/longjmp.plh" // // 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 +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 // //Ternary operand operators // -const TERNARY_TOKEN = $BF // ? -const TRIELSE_TOKEN = $DF // _ +const TERNARY_TKN = $BF // ? +const TRIELSE_TKN = $DF // _ // // Binary operand operators // -const SET_TKN = $BD // = -const ADD_TKN = $AB // + -const SUB_TKN = $AD // - -const MUL_TKN = $AA // * -const DIV_TKN = $AF // / -const MOD_TKN = $A5 // % -const OR_TKN = $FC // | -const EOR_TKN = $DE // ^ -const AND_TKN = $A6 // & -const SHR_TKN = $D2 // R -const SHL_TKN = $CC // L -const GT_TKN = $BE // > -const GE_TKN = $C8 // H -const LT_TKN = $BC // < -const LE_TKN = $C2 // B -const NE_TKN = $D5 // U -const EQ_TKN = $C5 // E -const LOGIC_AND_TKN = $CE // N -const LOGIC_OR_TKN = $CF // O +const SET_TKN = $BD // = +const ADD_TKN = $AB // + +const SUB_TKN = $AD // - +const MUL_TKN = $AA // * +const DIV_TKN = $AF // / +const MOD_TKN = $A5 // % +const OR_TKN = $FC // | +const EOR_TKN = $DE // ^ +const AND_TKN = $A6 // & +const SHR_TKN = $D2 // R +const SHL_TKN = $CC // L +const GT_TKN = $BE // > +const GE_TKN = $C8 // H +const LT_TKN = $BC // < +const LE_TKN = $C2 // B +const NE_TKN = $D5 // U +const EQ_TKN = $C5 // E +const LOGIC_AND_TKN = $CE // N +const LOGIC_OR_TKN = $CF // O // // Unary operand operators // -const AT_TKN = $C0 // @ -const DOT_TKN = $AE // . -const COLON_TKN = $BA // : -const NEG_TKN = $AD // - -const POUND_TKN = $A3 // # -const COMP_TKN = $FE // ~ -const LOGIC_NOT_TKN = $A1 // ! -const BPTR_TKN = $DE // ^ -const WPTR_TKN = $AA // * -const PTRB_TKN = $D8 // X -const PTRW_TKN = $D7 // W -const INC_TKN = $C1 // A -const DEC_TKN = $C4 // D +const AT_TKN = $C0 // @ +const DOT_TKN = $AE // . +const COLON_TKN = $BA // : +const NEG_TKN = $AD // - +const POUND_TKN = $A3 // # +const COMP_TKN = $FE // ~ +const LOGIC_NOT_TKN = $A1 // ! +const BPTR_TKN = $DE // ^ +const WPTR_TKN = $AA // * +const PTRB_TKN = $D8 // X +const PTRW_TKN = $D7 // W +const INC_TKN = $C1 // A +const DEC_TKN = $C4 // D +const LAMBDA_TKN = $A6 // & // // Enclosure tokens // -const OPEN_PAREN_TKN = $A8 // ( -const CLOSE_PAREN_TKN = $A9 // ) -const OPEN_BRACKET_TKN = $DB // [ -const CLOSE_BRACKET_TKN = $DD // ] +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 // // -const DROP_TKN = $BB +const COMMA_TKN = $AC // , +//const COMMENT_TKN = $BB // // +const DROP_TKN = $BB // // Keyword tokens // -const CONST_TKN = $80 -const BYTE_TKN = $81 -const WORD_TKN = $82 -const IF_TKN = $83 -const ELSEIF_TKN = $84 -const ELSE_TKN = $85 -const FIN_TKN = $86 -const END_TKN = $87 -const WHILE_TKN = $88 -const LOOP_TKN = $89 -const CASE_TKN = $8A -const OF_TKN = $8B -const DEFAULT_TKN = $8C -const ENDCASE_TKN = $8D -const FOR_TKN = $8E -const TO_TKN = $8F -const DOWNTO_TKN = $90 -const STEP_TKN = $91 -const NEXT_TKN = $92 -const REPEAT_TKN = $93 -const UNTIL_TKN = $94 -const DEF_TKN = $95 -const STRUC_TKN = $96 -const SYSFLAGS_TKN = $97 -const DONE_TKN = $98 -const RETURN_TKN = $99 -const BREAK_TKN = $9A -const CONT_TKN = $9B -const PREDEF_TKN = $9C -const IMPORT_TKN = $9D -const EXPORT_TKN = $9E -const INCLUDE_TKN = $9F +const CONST_TKN = $80 +const BYTE_TKN = $81 +const WORD_TKN = $82 +const IF_TKN = $83 +const ELSEIF_TKN = $84 +const ELSE_TKN = $85 +const FIN_TKN = $86 +const END_TKN = $87 +const WHILE_TKN = $88 +const LOOP_TKN = $89 +const CASE_TKN = $8A +const OF_TKN = $8B +const DEFAULT_TKN = $8C +const ENDCASE_TKN = $8D +const FOR_TKN = $8E +const TO_TKN = $8F +const DOWNTO_TKN = $90 +const STEP_TKN = $91 +const NEXT_TKN = $92 +const REPEAT_TKN = $93 +const UNTIL_TKN = $94 +const DEF_TKN = $95 +const STRUC_TKN = $96 +const SYSFLAGS_TKN = $97 +const DONE_TKN = $98 +const RETURN_TKN = $99 +const BREAK_TKN = $9A +const CONT_TKN = $9B +const PREDEF_TKN = $9C +const IMPORT_TKN = $9D +const EXPORT_TKN = $9E +const INCLUDE_TKN = $9F // // Types // -const CONST_TYPE = $01 -const BYTE_TYPE = $02 -const WORD_TYPE = $04 -const VAR_TYPE = $06 // (WORD_TYPE | BYTE_TYPE) -const FUNC_TYPE = $08 -const FUNC_CONST_TYPE = $09 -const ADDR_TYPE = $0E // (VAR_TYPE | FUNC_TYPE) -const LOCAL_TYPE = $10 -const BPTR_TYPE = $20 -const WPTR_TYPE = $40 -const PTR_TYPE = $60 // (BPTR_TYPE | WPTR_TYPE) -const XBYTE_TYPE = $22 // (BPTR_TYPE | BYTE_TYPE) -const XWORD_TYPE = $44 // (WPTR_TYPE | WORD_TYPE) -const CONSTADDR_TYPE = $61 // (CONST_TYPE | PTR_TYPE) -const STR_TYPE = $80 +const GLOBAL_TYPE = $0000 +const CONST_TYPE = $0001 +const BYTE_TYPE = $0002 +const WORD_TYPE = $0004 +const VAR_TYPE = $0006 // (WORD_TYPE | BYTE_TYPE) +const FUNC_TYPE = $0008 +const FUNC_CONST_TYPE = $0009 +const ADDR_TYPE = $000E // (VAR_TYPE | FUNC_TYPE) +const LOCAL_TYPE = $0010 +const BPTR_TYPE = $0020 +const WPTR_TYPE = $0040 +const PTR_TYPE = $0060 // (BPTR_TYPE | WPTR_TYPE) +const XBYTE_TYPE = $0022 // (BPTR_TYPE | BYTE_TYPE) +const XWORD_TYPE = $0044 // (WPTR_TYPE | WORD_TYPE) +const CONSTADDR_TYPE = $0061 // (CONST_TYPE | PTR_TYPE) +const STR_TYPE = $0080 +const PREDEF_TYPE = $0100 +const EXTERN_TYPE = $0200 +const EXPORT_TYPE = $0400 // // Keywords // -byte keywrds = "IF", IF_TKN -byte = "TO", TO_TKN -byte = "IS", OF_TKN -byte = "OR", LOGIC_OR_TKN -byte = "FOR", FOR_TKN -byte = "FIN", FIN_TKN -byte = "DEF", DEF_TKN -byte = "END", END_TKN -byte = "AND", LOGIC_AND_TKN -byte = "NOT", LOGIC_NOT_TKN -byte = "BYTE", BYTE_TKN -byte = "WORD", WORD_TKN -byte = "ELSE", ELSE_TKN -byte = "NEXT", NEXT_TKN -byte = "WHEN", CASE_TKN -byte = "LOOP", LOOP_TKN -byte = "STEP", STEP_TKN -byte = "DONE", DONE_TKN -byte = "WEND", ENDCASE_TKN -byte = "DROP", DROP_TKN -byte = "CONST", CONST_TKN -byte = "STRUC", STRUC_TKN -byte = "ELSIF", ELSEIF_TKN -byte = "WHILE", WHILE_TKN -byte = "UNTIL", UNTIL_TKN -byte = "BREAK", BREAK_TKN -byte = "IMPORT", IMPORT_TKN -byte = "EXPORT", EXPORT_TKN -byte = "DOWNTO", DOWNTO_TKN -byte = "REPEAT", REPEAT_TKN -byte = "RETURN", RETURN_TKN -byte = "PREDEF", PREDEF_TKN -byte = "INCLUDE", INCLUDE_TKN -byte = "CONTINUE", CONT_TKN -byte = "SYSFLAGS", SYSFLAGS_TKN -byte = "OTHERWISE",DEFAULT_TKN -byte = $FF +byte keywrds = "IF", IF_TKN +byte = "TO", TO_TKN +byte = "IS", OF_TKN +byte = "OR", LOGIC_OR_TKN +byte = "FOR", FOR_TKN +byte = "FIN", FIN_TKN +byte = "DEF", DEF_TKN +byte = "END", END_TKN +byte = "AND", LOGIC_AND_TKN +byte = "NOT", LOGIC_NOT_TKN +byte = "BYTE", BYTE_TKN +byte = "WORD", WORD_TKN +byte = "ELSE", ELSE_TKN +byte = "NEXT", NEXT_TKN +byte = "WHEN", CASE_TKN +byte = "LOOP", LOOP_TKN +byte = "STEP", STEP_TKN +byte = "DONE", DONE_TKN +byte = "WEND", ENDCASE_TKN +byte = "DROP", DROP_TKN +byte = "CONST", CONST_TKN +byte = "STRUC", STRUC_TKN +byte = "ELSIF", ELSEIF_TKN +byte = "WHILE", WHILE_TKN +byte = "UNTIL", UNTIL_TKN +byte = "BREAK", BREAK_TKN +byte = "IMPORT", IMPORT_TKN +byte = "EXPORT", EXPORT_TKN +byte = "DOWNTO", DOWNTO_TKN +byte = "REPEAT", REPEAT_TKN +byte = "RETURN", RETURN_TKN +byte = "PREDEF", PREDEF_TKN +byte = "INCLUDE", INCLUDE_TKN +byte = "CONTINUE", CONT_TKN +byte = "SYSFLAGS", SYSFLAGS_TKN +byte = "OTHERWISE",DEFAULT_TKN +byte = $FF // // Mathematical ops // @@ -196,92 +202,132 @@ byte[16] sizestack byte[16] typestack word valsp = 0 // -// Generated code buffers +// Constant code group // -const databuff = $0C00 -const codebuff = $A900 -const codebuffsz = $1000 +const CONST_GROUP = $00 +const CONST_CODE = $2C +const CONSTR_GROUP = $01 +const CONSTR_CODE = $2E +// +// Stack code group +// +const STACK_GROUP = $02 +const INDEXB_CODE = $02 +const ADD_CODE = $02 +const SUB_CODE = $04 +const MUL_CODE = $06 +const DIV_CODE = $08 +const MOD_CODE = $0A +const INC_CODE = $0C +const DEC_CODE = $0E +const NEG_CODE = $10 +const COMP_CODE = $12 +const AND_CODE = $14 +const OR_CODE = $16 +const EOR_CODE = $18 +const SHL_CODE = $1A +const SHR_CODE = $1C +const INDEXW_CODE = $1E +const LOGIC_NOT_CODE = $20 +const LOGIC_OR_CODE = $22 +const LOGIC_AND_CODE = $24 +const DROP_CODE = $30 +const DUP_CODE = $32 +const EQ_CODE = $40 +const NE_CODE = $42 +const GT_CODE = $44 +const LT_CODE = $46 +const GE_CODE = $48 +const LE_CODE = $4A +const ICAL_CODE = $56 +const RET_CODE = $5C +const LB_CODE = $60 +const BPTR_CODE = $60 +const LW_CODE = $62 +const WPTR_CODE = $62 +const SB_CODE = $70 +const SW_CODE = $72 +// +// Local address code group +// +const LOCAL_GROUP = $03 +const LADDR_CODE = $28 +const LLB_CODE = $64 +const LLW_CODE = $66 +const DLB_CODE = $6C +const DLW_CODE = $6E +const SLB_CODE = $74 +const SLW_CODE = $76 +// +// Global address code group +// +const GLOBAL_GROUP = $04 +const GADDR_CODE = $26 +const LAB_CODE = $68 +const LAW_CODE = $6A +const SAB_CODE = $78 +const SAW_CODE = $7A +const DAB_CODE = $7C +const DAW_CODE = $7E +const CALL_CODE = $54 +// +// Relative address code group +// +const RELATIVE_GROUP = $05 +const BRFALSE_CODE = $4C +const BRTRUE_CODE = $4E +const BRNCH_CODE = $50 +// +// Code tag address group +// +const CODETAG_GROUP = $06 // // Symbol table variables // struc t_opseq byte opcode - word opval + byte opgroup + word opval[] word optag - word opoffsz - byte optype + word opoffset word opnext end -const OPSEQNUM = 200 struc t_id word idval - byte idtype - byte idname + word idtype byte funcparms byte funcvals + byte idname end -const idglobal_tblsz = 2048 -const idlocal_tblsz = 512 -const idglobal_tbl = $1600 -const idlocal_tbl = $1E00 -const ctag_max = 1024 -const ctag_tbl = $800 -word globals = 0 -word datasize = 0 -word lastglobal -byte locals = 0 -word framesize = 0 -word lastlocal -byte lastop = $FF +// +// Generated code buffers +// const IS_RESOLVED = $8000 const IS_RELATIVE = $8000 const IS_CTAG = $8000 const MASK_CTAG = $7FFF +const OPSEQNUM = 256 +const CTAGNUM = 1024 +const IDGLOBALSZ = 2048 +const IDLOCALSZ = 512 word codetag = -1 -word codeptr, entrypoint -word modsysflags = 0 +word idglobal_tbl, idlocal_tbl, ctag_tbl +word freeop_lst, pending_seq +word globals, lastglobal, lastlocal, savelast +word codebufsz, datasize, framesize, savesize +byte locals, savelocals +word codebuff, codeptr, entrypoint +word modsysflags +byte[16] moddep_tbl[8] +byte moddep_cnt +predef emit_pending_seq#0 // -// Scanner variables +// Compiler flags // -const inbuff = $0200 -const instr = $01FF -word scanptr = @nullstr -byte scanchr, token, tknlen -byte parserrpos, parserr = 0 -word tknptr, parserrln -word constval -word lineno = 0 -// -// Compiler output messages -// -byte dup_id[] = "DUPLICATE IDENTIFIER" -byte undecl_id[] = "UNDECLARED IDENTIFIER" -byte bad_cnst[] = "BAD CONSTANT" -byte bad_struc[] = "BAD STRUCTURE" -byte bad_offset[] = "BAD STRUCT OFFSET" -byte bad_decl[] = "BAD DECLARATION" -byte bad_op[] = "BAD OPERATION" -byte bad_stmnt[] = "BAD STATMENT" -byte bad_expr[] = "BAD EXPRESSION" -byte bad_syntax[] = "BAD SYNTAX" -byte local_overflw[] = "LOCAL FRAME OVERFLOW" -byte global_sym_overflw[] = "GLOBAL SYMBOL TABLE OVERFLOW" -byte local_sym_overflw[] = "LOCAL SYMBOL TABLE OVERFLOW" -byte ctag_full[] = "CODE LABEL OVERFLOW" -byte no_ctag_offst[] = "CODE OFFSET NOT SUPPORTED" -byte no_close_paren[] = "MISSING CLOSING PAREN" -byte no_close_bracket[] = "MISSING CLOSING BRACKET" -byte missing_op[] = "MISSING OPERAND" -byte no_loop[] = "MISSING LOOP" -byte no_until[] = "MISSING UNTIL" -byte no_done[] = "MISSING DONE" -byte no_local_init[] = "NO INITIALIZED LOCALS" -// -// Compiler optimizer flags -// -const OPTIMIZE = 1 -const OPTIMIZE2 = 2 -const NO_COMBINE = 4 +const OPTIMIZE = 1 +const OPTIMIZE2 = 2 +const NO_COMBINE = 4 +const WARNINGS = 8 byte outflags // // ProDOS/SOS file references @@ -290,25 +336,65 @@ byte refnum, srcref, incref byte[32] srcfile byte[32] incfile byte[32] relfile -word parsefile // Pointer to current file -word sysincbuf // System I/O buffer for include files -word srcline // Saved source line number +word parsefile // Pointer to current file +word sysincbuf, sysincfre // System I/O buffer for include files +word srcline // Saved source line number +// +// Scanner variables +// +const inbuff = $0200 +const instr = $01FF +word scanptr = inbuff +byte scanchr, token, tknlen +word tknptr, parserrln +word constval +word lineno = 0 // // Parser variables // +const LVALUE = 0 +const RVALUE = 1 +const LAMBDANUM = 16 byte[128] strconst -byte infunc = 0 -byte stack_loop = 0 -byte prevstmnt = 0 -word infunvals = 0 -word retfunc_tag = 0 -word break_tag = 0 -word cont_tag = 0 -predef parse_constexpr#3, parse_expr(codeseq), parse_lambda +byte infunc +byte stack_loop +byte prevstmnt +word infuncvals +word retfunc_tag +word break_tag +word cont_tag +byte lambda_cnt, lambda_num +byte[LAMBDANUM] lambda_id[8], lambda_cparms +word[LAMBDANUM] lambda_seq +word[LAMBDANUM] lambda_tag +predef parse_constexpr#3, parse_expr(codeseq)#2, parse_lambda +// +// Arg pointer - overlay setjmp pointer +// +word[] arg // // Long jump environment // word exit +// +// Error string flags +// +const ERR_DUP = $0001 +const ERR_UNDECL = $0002 +const ERR_INVAL = $0004 +const ERR_MISS = $0008 +const ERR_OVER = $0010 +const ERR_CLOSE = $0020 +const ERR_LOCAL = $0040 +const ERR_GLOBAL = $0080 +const ERR_CODE = $0100 +const ERR_ID = $0200 +const ERR_CONST = $0400 +const ERR_INIT = $0800 +const ERR_STATE = $1000 +const ERR_FRAME = $2000 +const ERR_TABLE = $4000 +const ERR_SYNTAX = $8000 //===================================== // @@ -327,20 +413,61 @@ def strcpy(dst, src) fin return ^dst end -// -// Error handler -// -def exit_err(errstr)#0 +def nametostr(namestr, len, strptr)#0 + ^strptr = len + memcpy(strptr + 1, namestr, len) +end +def putcurln#0 + puts(parsefile); putc('['); puti(lineno); puts("] ") +end +def putmrkr#0 byte i - puts(parsefile); putc('['); puti(lineno); putc(']'); putc(':'); puts(errstr); putln + putln puts(instr) - for i = tknptr - inbuff - 1 downto 0 + for i = tknptr - inbuff downto 1 putc(' ') next puts("^\n") +end +// +// Error handler +// +def exit_err(err)#0 + byte i + + putcurln + puts("Error:") + if err & ERR_DUP; puts("duplicate "); fin + if err & ERR_UNDECL; puts("undeclared "); fin + if err & ERR_INVAL; puts("invalid "); fin + if err & ERR_MISS; puts("missing "); fin + if err & ERR_OVER; puts("overflowed "); fin + if err & ERR_CLOSE; puts("closing "); fin + if err & ERR_LOCAL; puts("local "); fin + if err & ERR_GLOBAL; puts("global "); fin + if err & ERR_CODE; puts("code "); fin + if err & ERR_ID; puts("identifier "); fin + if err & ERR_CONST; puts("constant"); fin + if err & ERR_INIT; puts("initializer"); fin + if err & ERR_STATE; puts("statement"); fin + if err * ERR_FRAME; puts("frame"); fin + if err & ERR_TABLE; puts("table"); fin + if err & ERR_SYNTAX; puts("syntax"); fin + putmrkr fileio:close(0) // Close all open files - longjump(exit, TRUE) + longjmp(exit, TRUE) +end +// +// Warning +// +def parse_warn(msg)#0 + if outflags & WARNINGS + putcurln + puts("Warning:") + puts(msg) + putmrkr + fin end // // Include code to reduce size of this file @@ -359,11 +486,13 @@ if ^arg and ^(arg + 1) == '-' outflags = outflags | OPTIMIZE arg++ if ^arg == '2' - outflags = outflags | OPTIMIZE + outflags = outflags | OPTIMIZE2 arg++ fin elsif toupper(^arg) == 'N' outflags = outflags | NO_COMBINE + elsif toupper(^arg) == 'W' + outflags = outflags | WARNINGS else break fin @@ -378,19 +507,36 @@ if arg fin fin if srcfile and relfile - exit = heapalloc(t_longjmp) - if not setjmp(exit) - // - // Parse source code module - // - parsemodule - puts("Bytes compiled: "); puti(codeptr - codebuff); putln - // - // Write REL file - // - writerel + srcref = fileio:open(@srcfile) + if srcref + fileio:newline(srcref, $7F, $0D) + refnum = srcref + parsefile = @srcfile + exit = heapalloc(t_longjmp) + if not setjmp(exit) + // + // Parse source code module + // + parse_module + fileio:close(srcref) + puts("Bytes compiled: "); puti(codeptr - codebuff); putln + // + // Write REL file + // + fileio:destroy(@relfile) + fileio:create(@relfile, $FE, $1000) // full access, REL file + srcref = fileio:open(@relfile) + if srcref + //writerel(srcref) + fileio:close(srcref) + else + puts("Error opening: "); puts(@relfile); putln + fin + fin + else + puts("Error opening: "); puts(@srcfile); putln fin else - puts("Usage: +PLASM [-O[2]] \n") + puts("Usage: +PLASM [-[W][O[2]][N]] \n") fin done