mirror of
https://github.com/dschmenk/PLASMA.git
synced 2026-03-15 07:16:53 +00:00
907 lines
22 KiB
Plaintext
907 lines
22 KiB
Plaintext
//
|
|
// Symbol table
|
|
//
|
|
//def dumpsym(idptr, idcnt)#0
|
|
// while idcnt
|
|
// prword(idptr=>idval)
|
|
// cout(' ')
|
|
// prbyte(idptr->idtype)
|
|
// cout(' ')
|
|
// prstr(@idptr->idname)
|
|
// cout('=')
|
|
// if idptr->idtype & ADDR_TYPE
|
|
// if idptr=>idval & IS_CTAG
|
|
// prword((ctag_tbl=>[idptr=>idval & MASK_CTAG] & MASK_CTAG) + codebuff)
|
|
// else
|
|
// prword(idptr=>idval + codebuff)
|
|
// fin
|
|
// else
|
|
// prword(idptr=>idval)
|
|
// fin
|
|
// crout
|
|
// idptr = idptr + idptr->idname + t_id
|
|
// idcnt--
|
|
// loop
|
|
//end
|
|
//
|
|
// New/release sequence ops
|
|
//
|
|
def new_op
|
|
word op
|
|
op = freeop_lst
|
|
if not op
|
|
puts("Compiler out of sequence ops!")
|
|
return NULL
|
|
fin
|
|
freeop_lst = freeop_lst=>opnext
|
|
op=>opnext = NULL
|
|
return op
|
|
end
|
|
def release_op(op)#0
|
|
if op
|
|
op=>opnext = freeop_lst
|
|
freeop_lst = op
|
|
fin
|
|
end
|
|
def release_seq(seq)#0
|
|
word op
|
|
|
|
while seq
|
|
op = seq
|
|
seq = seq=>opnext
|
|
//
|
|
//Free this op
|
|
//
|
|
op=>opnext = freeop_lst
|
|
freeop_lst = op
|
|
loop
|
|
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=>opnext; op = op=>opnext; loop
|
|
op=>opnext = seq2
|
|
return seq1
|
|
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
|
|
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
|
|
else
|
|
//
|
|
// Add to list of tags needing resolution
|
|
//
|
|
updtptr = ctag_tbl=>[tag] & MASK_CTAG
|
|
ctag_tbl=>[tag] = codeptr - codebuff
|
|
fin
|
|
emit_word(updtptr)
|
|
else
|
|
emit_word(tag + codebuff)
|
|
fin
|
|
end
|
|
def emit_reladdr(tag)#0
|
|
word updtptr
|
|
|
|
if tag & IS_CTAG
|
|
tag = tag & MASK_CTAG
|
|
if ctag_tbl=>[tag] & IS_RESOLVED
|
|
updtptr = ((ctag_tbl=>[tag] & MASK_CTAG) + codebuff) - codeptr
|
|
else
|
|
//
|
|
// Add to list of tags needing resolution
|
|
//
|
|
updtptr = ctag_tbl=>[tag] | IS_RELATIVE
|
|
ctag_tbl=>[tag] = codeptr - codebuff
|
|
fin
|
|
emit_word(updtptr)
|
|
else
|
|
emit_word(tag - (codeptr - codebuff))
|
|
fin
|
|
end
|
|
def emit_data(vartype, consttype, constval, constsize)
|
|
byte i
|
|
word size, chrptr
|
|
|
|
if consttype == 0
|
|
size = constsize
|
|
emit_fill(constsize)
|
|
elsif consttype == STR_TYPE
|
|
constsize = ^constval
|
|
size = constsize + 1
|
|
chrptr = constval + 1
|
|
emit_byte(constsize)
|
|
while constsize > 0
|
|
emit_byte(^chrptr)
|
|
chrptr++
|
|
constsize--
|
|
loop
|
|
else
|
|
if vartype & BYTE_TYPE
|
|
size = 1
|
|
emit_byte(constval)
|
|
else
|
|
size = 2
|
|
if consttype == CONSTADDR_TYPE
|
|
emit_addr(constval)
|
|
else
|
|
emit_word(constval)
|
|
fin
|
|
fin
|
|
fin
|
|
return size
|
|
end
|
|
def emit_const(cval)#0
|
|
emit_pending_seq
|
|
if cval == $0000 // ZERO
|
|
emit_byte($00)
|
|
elsif cval & $FF00 == $0000 // Constant BYTE
|
|
emit_byte($2A)
|
|
emit_byte(cval)
|
|
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_dlb(offset)#0
|
|
emit_pending_seq
|
|
emit_byte($6C)
|
|
emit_byte(offset)
|
|
end
|
|
def emit_dlw(offset)#0
|
|
emit_pending_seq
|
|
emit_byte($6E)
|
|
emit_byte(offset)
|
|
end
|
|
def emit_dab(tag, offset)#0
|
|
emit_pending_seq
|
|
if tag & IS_CTAG and offset
|
|
exit_err(ERR_INVAL|ERR_CODE|ERR_CONST)
|
|
else
|
|
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(ERR_INVAL|ERR_CODE|ERR_CONST)
|
|
else
|
|
emit_byte($7E)
|
|
emit_addr(tag+offset)
|
|
fin
|
|
end
|
|
def emit_brgt(tag)#0
|
|
emit_pending_seq
|
|
emit_byte($38)
|
|
emit_reladdr(tag)
|
|
end
|
|
def emit_brlt(tag)#0
|
|
emit_pending_seq
|
|
emit_byte($3A)
|
|
emit_reladdr(tag)
|
|
end
|
|
def emit_brne(tag)#0
|
|
emit_pending_seq
|
|
emit_byte($3E)
|
|
emit_reladdr(tag)
|
|
end
|
|
def emit_branch(tag)#0
|
|
emit_pending_seq
|
|
emit_byte($50)
|
|
emit_reladdr(tag)
|
|
end
|
|
def emit_leave#0
|
|
emit_pending_seq
|
|
if framesize
|
|
emit_byte($5A)
|
|
else
|
|
emit_byte($5C)
|
|
fin
|
|
end
|
|
def emit_enter(cparms)#0
|
|
if framesize
|
|
emit_byte($58)
|
|
emit_byte(framesize)
|
|
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
|
|
//
|
|
// Emit the pending sequence
|
|
//
|
|
def emit_pending_seq#0
|
|
word lcl_pending, op
|
|
//
|
|
// This is called by some of the emit_*() functions to ensure that any
|
|
// pending ops are emitted before they emit their own op when they are
|
|
// called from the parser. However, this function itself calls some of those
|
|
// emit_*() functions to emit instructions from the pending sequence, which
|
|
// would cause an infinite loop if we weren't careful. We therefore set
|
|
// pending_seq to null on entry and work with a local copy, so if this
|
|
// function calls back into itself it is a no-op.
|
|
//
|
|
if not pending_seq; return; fin
|
|
lcl_pending = pending_seq
|
|
pending_seq = NULL
|
|
if outflags & OPTIMIZE
|
|
while optimize_seq(@lcl_pending, 0); loop
|
|
if outflags & OPTIMIZE2
|
|
while optimize_seq(@lcl_pending, 1); loop
|
|
fin
|
|
fin
|
|
while lcl_pending
|
|
op = lcl_pending
|
|
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
|
|
//
|
|
// Constant string
|
|
//
|
|
is CONSTR_GROUP
|
|
emit_byte($2E)
|
|
emit_data(0, STR_TYPE, op=>opval, 0)
|
|
break
|
|
//
|
|
// Single op codes
|
|
//
|
|
is STACK_GROUP
|
|
emit_byte(op->opcode)
|
|
break
|
|
//
|
|
// Local address codes
|
|
//
|
|
is LOCAL_GROUP
|
|
emit_byte(op->opcode)
|
|
emit_byte(op->opoffset)
|
|
break
|
|
//
|
|
// 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
|
|
//
|
|
// Relative address codes
|
|
//
|
|
is RELATIVE_GROUP
|
|
emit_byte(op->opcode)
|
|
emit_reladdr(op=>optag)
|
|
break
|
|
//
|
|
// Code tags
|
|
//
|
|
is CODETAG_GROUP
|
|
emit_ctag(op=>optag)
|
|
break
|
|
otherwise
|
|
return
|
|
wend
|
|
lcl_pending = lcl_pending=>opnext;
|
|
//
|
|
// Free this op
|
|
//
|
|
op=>opnext = freeop_lst
|
|
freeop_lst = op
|
|
loop
|
|
end
|
|
//
|
|
// Emit a sequence of ops (into the pending sequence)
|
|
//
|
|
def emit_seq(seq)#0
|
|
word op
|
|
byte string
|
|
string = FALSE
|
|
op = seq
|
|
while op
|
|
if op->opgroup == CONSTR_GROUP; string = TRUE; break; fin
|
|
op = op=>opnext
|
|
loop
|
|
pending_seq = cat_seq(pending_seq, seq)
|
|
//
|
|
// The source code comments in the output are much more logical if we don't
|
|
// merge multiple sequences together. There's no value in doing this merging
|
|
// if we're not optimizing, and we optionally allow it to be prevented even
|
|
// when we are optimizing by specifing the -N (NO_COMBINE) flag.
|
|
//
|
|
// We must also force output if the sequence includes a CS opcode, as the
|
|
// associated 'constant' is only temporarily valid.
|
|
//
|
|
if not (outflags & (OPTIMIZE|OPTIMIZE2)) or (outflags & NO_COMBINE) or string
|
|
emit_pending_seq
|
|
fin
|
|
end
|
|
//
|
|
// Emit lambda function
|
|
//
|
|
def emit_lambdafunc(tag, cparms, lambda_seq)#0
|
|
emit_ctag(tag)
|
|
framesize = cparms * 2
|
|
emit_enter(cparms)
|
|
emit_seq(lambda_seq)
|
|
emit_pending_seq
|
|
emit_leave
|
|
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)
|
|
fin
|
|
return idptr
|
|
end
|
|
def idglobal_lookup(nameptr, len)
|
|
word idptr
|
|
|
|
idptr = idmatch(nameptr, len, idglobal_tbl, globals)
|
|
return idptr
|
|
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)
|
|
def_cnt++
|
|
end
|
|
def idfunc_set(namestr, len, tag, cparms, cvals)#0
|
|
word idptr
|
|
|
|
idptr = idglobal_lookup(namestr, len)
|
|
if idptr
|
|
if not idptr=>idtype & FUNC_TYPE; exit_err(ERR_UNDECL|ERR_CODE); fin
|
|
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
|
|
//
|
|
// Generate/add to a sequence of code
|
|
//
|
|
def gen_op(seq, 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
|
|
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
|
|
//
|
|
// A DCI string is one that has the high bit set for every character except the last.
|
|
// More efficient than C or Pascal strings.
|
|
//
|
|
def dcitos(dci, str)
|
|
byte len, c
|
|
len = 0
|
|
repeat
|
|
c = ^(dci + len)
|
|
len++
|
|
^(str + len) = c & $7F
|
|
until not c & $80
|
|
^str = len
|
|
return len
|
|
end
|
|
def stodci(str, dci)
|
|
byte len, c
|
|
len = ^str
|
|
if not len; return 0; fin
|
|
c = toupper(^(str + len)) & $7F
|
|
len--
|
|
^(dci + len) = c
|
|
while len
|
|
c = toupper(^(str + len)) | $80
|
|
len--
|
|
^(dci + len) = c
|
|
loop
|
|
return ^str
|
|
end
|
|
//
|
|
// Write Extended REL header
|
|
//
|
|
def writeheader(refnum)#0
|
|
word moddep
|
|
byte header[128]
|
|
|
|
moddep = @header:12 // Beginning of module dependency list
|
|
while moddep_cnt
|
|
moddep_cnt--
|
|
moddep = moddep + stodci(@moddep_tbl[moddep_cnt*16], moddep)
|
|
loop
|
|
^moddep = 0 // Terminate dependency list
|
|
moddep++
|
|
header:0 = moddep - @header + codeptr - codebuff // sizeof header+data+bytecode
|
|
header:2 = $DA7F // Magic #
|
|
header:4 = modsysflags // Module SYSFLAGS
|
|
header:6 = datasize + MODADDR // Byte code offset
|
|
header:8 = def_cnt // DEFinition count
|
|
header:10 = entrypoint - codebuff + MODADDR // Init entrypoint
|
|
fileio:write(refnum, @header, moddep - @header)
|
|
end
|
|
//
|
|
// Write DeFinition Directory
|
|
//
|
|
def writeDFD(refnum)#0
|
|
word dirptr, idptr, idcnt
|
|
byte defdir[128]
|
|
|
|
dirptr, idptr, idcnt = @defdir, idglobal_tbl, globals
|
|
while idcnt
|
|
if idptr=>idtype & FUNC_TYPE and not idptr=>idtype & EXTERN_TYPE
|
|
dirptr->0 = $02
|
|
dirptr=>1 = (ctag_tbl=>[idptr=>idval] & MASK_CTAG) + MODADDR
|
|
dirptr = dirptr + 4
|
|
fin
|
|
idptr = idptr + idptr->idname + t_id
|
|
idcnt--
|
|
loop
|
|
fileio:write(refnum, @defdir, dirptr - @defdir)
|
|
end
|
|
//
|
|
// Build External Symbol Directory on heap
|
|
//
|
|
def buildESD#2
|
|
byte symnum
|
|
word dirptr, idptr, idcnt, dirlen
|
|
|
|
symnum, dirptr, idptr, idcnt = 0, heapmark, idglobal_tbl, globals
|
|
while idcnt
|
|
if idptr=>idtype & EXPORT_TYPE
|
|
dirptr = dirptr + stodci(idptr=>idname, dirptr)
|
|
dirptr->0 = $08
|
|
dirptr=>1 = (ctag_tbl[idptr=>idval] & MASK_CTAG) + MODADDR
|
|
dirptr = dirptr + 3
|
|
elsif idptr=>idtype & EXTERN_TYPE
|
|
dirptr = dirptr + stodci(idptr=>idname, dirptr)
|
|
dirptr->0 = $10
|
|
dirptr->1 = symnum
|
|
dirptr = dirptr + 3
|
|
idptr->extnum = symnum
|
|
symnum++
|
|
fin
|
|
idptr = idptr + idptr->idname + t_id
|
|
idcnt--
|
|
loop
|
|
^dirptr = 0
|
|
dirlen = dirptr - heapmark + 1
|
|
dirptr = heapalloc(dirlen)
|
|
return dirptr, dirlen
|
|
end
|
|
//
|
|
// Write ReLocation Directory
|
|
//
|
|
def writeRLD(refnum)#0
|
|
word rld, i
|
|
|
|
rld = heapmark
|
|
for i = 0 to fixup_cnt
|
|
if i & $7F == $40 // Write out blocks of entries
|
|
fileio:write(refnum, heapmark, rld - heapmark)
|
|
rld = heapmark
|
|
fin
|
|
rld->0 = $01
|
|
rld = rld + 4
|
|
next
|
|
^rld = 0
|
|
fileio:write(refnum, heapmark, rld - heapmark + 1)
|
|
end
|
|
//
|
|
// Write Extended REL file
|
|
//
|
|
def writemodule(refnum)#0
|
|
word esd, esdlen
|
|
//
|
|
// Write module header
|
|
//
|
|
writeheader(refnum)
|
|
//
|
|
// Write data/code buffer
|
|
//
|
|
fileio:write(refnum, codebuff, codeptr - codebuff)
|
|
//
|
|
// Write bytecode definition directory
|
|
//
|
|
writeDFD(refnum)
|
|
//
|
|
// Build EXERN/ENTRY directory
|
|
//
|
|
esd, esdlen = buildESD
|
|
//
|
|
// Write relocation directory
|
|
//
|
|
writeRLD(refnum)
|
|
//
|
|
// Write EXTERN/EBTRY directory
|
|
//
|
|
fileio:write(refnum, esd, esdlen)
|
|
heaprelease(esd)
|
|
end
|