2941 lines
73 KiB
C++
2941 lines
73 KiB
C++
/* Copyright (c) Microsoft Corporation.
|
|
Licensed under the MIT License. */
|
|
|
|
/***************************************************************************
|
|
Author: ShonK
|
|
Project: Kauai
|
|
Reviewed:
|
|
Copyright (c) Microsoft Corporation
|
|
|
|
Script compiler. This supports a post-fix (RPN-style) stack base
|
|
"assembly" language and an in-fix (standard) higher level language similar
|
|
to "C" in its operator set and syntax. The only data type supported
|
|
is 32 bit signed integers. The SCCB class can also "disassemble"
|
|
a script. Compilation is case sensitive. The in-fix compiler supports
|
|
all valid "C" expressions not involving arrays, pointers or structures,
|
|
including the ternary operator (?:). Supported control structures
|
|
include While and If blocks, with the following syntax:
|
|
|
|
While (exp);
|
|
// statements
|
|
End;
|
|
|
|
If (exp);
|
|
// statements
|
|
Elif (exp);
|
|
// statements
|
|
Else;
|
|
// statements
|
|
End;
|
|
|
|
The semicolons after the keywords are required (they make compilation
|
|
easier); the Elif and Else clauses are (of course) optional. A "Break;"
|
|
primitive is also supported to exit a While loop early. The in-fix
|
|
compiler also supports "IfGoto(exp, label$);" and "Goto(label$);". These
|
|
are compiled directly to single op-codes (plus operands) so are treated
|
|
differently than the control structures. See the _rgarop array below
|
|
for other function-like primitives supported by the in-fix compiler.
|
|
|
|
Label references appear in the in-fix source as a name followed by a $ sign,
|
|
eg, "Goto(label$);". Label definitions are a name followed by an @ sign.
|
|
|
|
In the post-fix source, label references are $label and label definitions
|
|
are @label.
|
|
|
|
Local variables as well as sub-class defined "this" variables and remote
|
|
variables are supported. Variables are not declared, are case sensitive
|
|
and have 8 significant characters. During execution, if a variable is used
|
|
before being assigned to, its value is 0 and a warning is generated.
|
|
|
|
For in-fix compilation, "this" variables are preceeded by a period and
|
|
remote variables are preceeded by "exp->" where exp is a valid numeric
|
|
expression. The -> operator has very high precedence, so it's common
|
|
to have () around the expression.
|
|
|
|
For post-fix compilation, this variables are again prefixed by a period
|
|
and remote variables are preceeded by a ~. Remote variable accesses use
|
|
the top stack value for their "address". Use the < operator to push a
|
|
variable and > to pop the top stack value into a variable. Constants
|
|
in the source are automatically pushed. Here's a sample post-fix script
|
|
that computes the 10th Fibonacci number and stores it in a remote variable.
|
|
The in-fix equivalent is given in the comments. Of course, an in-fix
|
|
version of this could use a While loop.
|
|
|
|
1 Dup >a >b 10 >n // a = b = 1; n = 10;
|
|
$LTest Go // Goto (LTest$);
|
|
@LLoop // LLoop@
|
|
<a Dup <b Add >a >b // temp = a; a += b; b = temp;
|
|
@LTest // LTest@
|
|
$LLoop <n Dec Dup >n GoNz // IfGoto (--n, LLoop$);
|
|
<a 100 >~answer // 100->answer = a;
|
|
|
|
|
|
A compiled script consists of a GL of longs. Each long is one of 3 types:
|
|
|
|
1) an opcode that acts on a variable:
|
|
byte : opcode
|
|
byte : number of immediate longs that follow (at least 1)
|
|
short: 2 bytes of rtvn data, the other 4 bytes are in the next long
|
|
2) an opcode that doesn't involve a variable:
|
|
byte : 0
|
|
byte : number of immediate longs that follow
|
|
short: opcode
|
|
3) immediate data
|
|
|
|
After executing an opcode that doesn't jump, the immediate data is placed on
|
|
the execution stack en-masse. In the case of a variable opcode, the first
|
|
long is used as part of the rtvn, so isn't placed on the stack.
|
|
|
|
Label references are considered immediate data and consist of
|
|
kbLabel in the high byte and the destination index (into the gl) in
|
|
the low 3 bytes.
|
|
|
|
The first long in the GL is version number information (a dver).
|
|
|
|
***************************************************************************/
|
|
#include "util.h"
|
|
ASSERTNAME
|
|
|
|
|
|
RTCLASS(SCCB)
|
|
|
|
// common error messages
|
|
PSZ _pszOom = PszLit("Out of memory");
|
|
PSZ _pszSyntax = PszLit("Syntax error");
|
|
|
|
// name to op lookup table for post-fix compilation
|
|
SZOP _rgszop[] =
|
|
{
|
|
{ kopAdd, PszLit("Add") },
|
|
{ kopSub, PszLit("Sub") },
|
|
{ kopMul, PszLit("Mul") },
|
|
{ kopDiv, PszLit("Div") },
|
|
{ kopMod, PszLit("Mod") },
|
|
{ kopAbs, PszLit("Abs") },
|
|
{ kopNeg, PszLit("Neg") },
|
|
{ kopInc, PszLit("Inc") },
|
|
{ kopDec, PszLit("Dec") },
|
|
{ kopRnd, PszLit("Rnd") },
|
|
{ kopMulDiv, PszLit("MulDiv") },
|
|
{ kopBAnd, PszLit("BAnd") },
|
|
{ kopBOr, PszLit("BOr") },
|
|
{ kopBXor, PszLit("BXor") },
|
|
{ kopBNot, PszLit("BNot") },
|
|
{ kopLXor, PszLit("LXor") },
|
|
{ kopLNot, PszLit("LNot") },
|
|
{ kopEq, PszLit("Eq") },
|
|
{ kopNe, PszLit("Ne") },
|
|
{ kopGt, PszLit("Gt") },
|
|
{ kopLt, PszLit("Lt") },
|
|
{ kopGe, PszLit("Ge") },
|
|
{ kopLe, PszLit("Le") },
|
|
{ kopDup, PszLit("Dup") },
|
|
{ kopPop, PszLit("Pop") },
|
|
{ kopSwap, PszLit("Swap") },
|
|
{ kopRot, PszLit("Rot") },
|
|
{ kopRev, PszLit("Rev") },
|
|
{ kopDupList, PszLit("DupList") },
|
|
{ kopPopList, PszLit("PopList") },
|
|
{ kopRndList, PszLit("RndList") },
|
|
{ kopSelect, PszLit("Select") },
|
|
{ kopGoEq, PszLit("GoEq") },
|
|
{ kopGoNe, PszLit("GoNe") },
|
|
{ kopGoGt, PszLit("GoGt") },
|
|
{ kopGoLt, PszLit("GoLt") },
|
|
{ kopGoGe, PszLit("GoGe") },
|
|
{ kopGoLe, PszLit("GoLe") },
|
|
{ kopGoZ, PszLit("GoZ") },
|
|
{ kopGoNz, PszLit("GoNz") },
|
|
{ kopGo, PszLit("Go") },
|
|
{ kopExit, PszLit("Exit") },
|
|
{ kopReturn, PszLit("Return") },
|
|
{ kopSetReturn, PszLit("SetReturn") },
|
|
{ kopShuffle, PszLit("Shuffle") },
|
|
{ kopShuffleList, PszLit("ShuffleList") },
|
|
{ kopNextCard, PszLit("NextCard") },
|
|
{ kopMatch, PszLit("Match") },
|
|
{ kopPause, PszLit("Pause") },
|
|
{ kopCopyStr, PszLit("CopyStr") },
|
|
{ kopMoveStr, PszLit("MoveStr") },
|
|
{ kopNukeStr, PszLit("NukeStr") },
|
|
{ kopMergeStrs, PszLit("MergeStrs") },
|
|
{ kopScaleTime, PszLit("ScaleTime") },
|
|
{ kopNumToStr, PszLit("NumToStr") },
|
|
{ kopStrToNum, PszLit("StrToNum") },
|
|
{ kopConcatStrs, PszLit("ConcatStrs") },
|
|
{ kopLenStr, PszLit("LenStr") },
|
|
{ kopCopySubStr, PszLit("CopySubStr") },
|
|
{ opNil, pvNil },
|
|
};
|
|
|
|
|
|
// name to op look up table for in-fix compilation
|
|
AROP _rgarop[] =
|
|
{
|
|
{ kopAbs, PszLit("Abs"), 1, 0, 0, fFalse },
|
|
{ kopRnd, PszLit("Rnd"), 1, 0, 0, fFalse },
|
|
{ kopMulDiv, PszLit("MulDiv"), 3, 0, 0, fFalse },
|
|
{ kopRndList, PszLit("RndList"), 0, 1, 1, fFalse },
|
|
{ kopSelect, PszLit("Select"), 1, 1, 1, fFalse },
|
|
{ kopGoNz, PszLit("IfGoto"), 2, 0, 0, fTrue },
|
|
{ kopGo, PszLit("Goto"), 1, 0, 0, fTrue },
|
|
{ kopExit, PszLit("Exit") , 0, 0, 0, fTrue},
|
|
{ kopReturn, PszLit("Return"), 1, 0, 0, fTrue },
|
|
{ kopSetReturn, PszLit("SetReturn"), 1, 0, 0, fTrue },
|
|
{ kopShuffle, PszLit("Shuffle"), 1, 0, 0, fTrue },
|
|
{ kopShuffleList, PszLit("ShuffleList"), 0, 1, 1, fTrue },
|
|
{ kopNextCard, PszLit("NextCard"), 0, 0, 0, fFalse },
|
|
{ kopMatch, PszLit("Match"), 2, 2, 1, fFalse },
|
|
{ kopPause, PszLit("Pause"), 0, 0, 0, fTrue },
|
|
{ kopCopyStr, PszLit("CopyStr"), 2, 0, 0, fFalse },
|
|
{ kopMoveStr, PszLit("MoveStr"), 2, 0, 0, fFalse },
|
|
{ kopNukeStr, PszLit("NukeStr"), 1, 0, 0, fTrue },
|
|
{ kopMergeStrs, PszLit("MergeStrs"), 2, 0, 0, fTrue },
|
|
{ kopScaleTime, PszLit("ScaleTime"), 1, 0, 0, fTrue },
|
|
{ kopNumToStr, PszLit("NumToStr"), 2, 0, 0, fFalse },
|
|
{ kopStrToNum, PszLit("StrToNum"), 3, 0, 0, fFalse },
|
|
{ kopConcatStrs, PszLit("ConcatStrs"), 3, 0, 0, fFalse },
|
|
{ kopLenStr, PszLit("LenStr"), 1, 0, 0, fFalse },
|
|
{ kopCopySubStr, PszLit("CopySubStr"), 4, 0, 0, fFalse },
|
|
{ opNil, pvNil, 0, 0, 0, fTrue },
|
|
};
|
|
|
|
|
|
PSZ _rgpszKey[] =
|
|
{
|
|
PszLit("If"),
|
|
PszLit("Elif"),
|
|
PszLit("Else"),
|
|
PszLit("End"),
|
|
PszLit("While"),
|
|
PszLit("Break"),
|
|
PszLit("Continue"),
|
|
};
|
|
|
|
enum
|
|
{
|
|
kipszIf,
|
|
kipszElif,
|
|
kipszElse,
|
|
kipszEnd,
|
|
kipszWhile,
|
|
kipszBreak,
|
|
kipszContinue,
|
|
};
|
|
|
|
|
|
// An opcode long can be followed by at most 255 immediate values
|
|
#define kclwLimPush 256
|
|
|
|
|
|
// operator flags - for in-fix compilation
|
|
enum
|
|
{
|
|
fopNil = 0,
|
|
fopOp = 1, // an operator
|
|
fopAssign = 2, // an assignment operator
|
|
fopPostAssign = 4, // unary operator acts after using the value
|
|
fopFunction = 8, // a function
|
|
fopArray = 16, // an array reference
|
|
};
|
|
|
|
// expression tree node - for in-fix compilation
|
|
struct ETN
|
|
{
|
|
short tt; // the token type
|
|
short op; // operator (or function) to generate
|
|
short opl; // operator precedence level
|
|
short grfop; // flags
|
|
long lwValue; // value if a ttLong; an istn if a ttName
|
|
long ietn1; // indices into _pgletnTree for the operands
|
|
long ietn2;
|
|
long ietn3;
|
|
long cetnDeep; // depth of the etn tree to here
|
|
};
|
|
|
|
// control structure types - these are the keywords that are followed
|
|
// by a condition (which is why Else is not here).
|
|
enum
|
|
{
|
|
cstNil,
|
|
cstIf,
|
|
cstElif,
|
|
cstWhile,
|
|
};
|
|
|
|
// control structure descriptor
|
|
struct CSTD
|
|
{
|
|
long cst;
|
|
long lwLabel1; // use depends on cst
|
|
long lwLabel2; // use depends on cst
|
|
long lwLabel3; // use depends on cst
|
|
PGL pgletnTree; // for while loops - the expression tree
|
|
long ietnTop; // the top of the expression tree
|
|
};
|
|
|
|
|
|
/***************************************************************************
|
|
Constructor for a script compiler.
|
|
***************************************************************************/
|
|
SCCB::SCCB(void)
|
|
{
|
|
AssertBaseThis(0);
|
|
_plexb = pvNil;
|
|
_pscpt = pvNil;
|
|
_pgletnTree = pvNil;
|
|
_pgletnStack = pvNil;
|
|
_pglcstd = pvNil;
|
|
_pgstNames = pvNil;
|
|
_pgstLabel = pvNil;
|
|
_pgstReq = pvNil;
|
|
_pmsnk = pvNil;
|
|
AssertThis(0);
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Destructor for a script compiler.
|
|
***************************************************************************/
|
|
SCCB::~SCCB(void)
|
|
{
|
|
AssertThis(0);
|
|
_Free();
|
|
}
|
|
|
|
|
|
#ifdef DEBUG
|
|
/***************************************************************************
|
|
Assert the validity of a SCCB.
|
|
***************************************************************************/
|
|
void SCCB::AssertValid(ulong grf)
|
|
{
|
|
SCCB_PAR::AssertValid(0);
|
|
AssertNilOrPo(_plexb, 0);
|
|
AssertNilOrPo(_pscpt, 0);
|
|
AssertNilOrPo(_pgletnTree, 0);
|
|
AssertNilOrPo(_pgletnStack, 0);
|
|
AssertNilOrPo(_pglcstd, 0);
|
|
AssertNilOrPo(_pgstNames, 0);
|
|
AssertNilOrPo(_pgstLabel, 0);
|
|
AssertNilOrPo(_pgstReq, 0);
|
|
AssertNilOrPo(_pmsnk, 0);
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Mark memory for the SCCB.
|
|
***************************************************************************/
|
|
void SCCB::MarkMem(void)
|
|
{
|
|
AssertValid(0);
|
|
|
|
SCCB_PAR::MarkMem();
|
|
MarkMemObj(_plexb);
|
|
MarkMemObj(_pscpt);
|
|
MarkMemObj(_pgletnTree);
|
|
MarkMemObj(_pgletnStack);
|
|
if (pvNil != _pglcstd)
|
|
{
|
|
long icstd;
|
|
CSTD cstd;
|
|
|
|
MarkMemObj(_pglcstd);
|
|
for (icstd = _pglcstd->IvMac(); icstd-- > 0; )
|
|
{
|
|
_pglcstd->Get(icstd, &cstd);
|
|
MarkMemObj(cstd.pgletnTree);
|
|
}
|
|
}
|
|
MarkMemObj(_pgstNames);
|
|
MarkMemObj(_pgstLabel);
|
|
MarkMemObj(_pgstReq);
|
|
MarkMemObj(_pmsnk);
|
|
}
|
|
#endif //DEBUG
|
|
|
|
|
|
/***************************************************************************
|
|
Initializes the script compiler to compile the stream from the given
|
|
lexer object. pmsnk is a message sink for error reporting.
|
|
***************************************************************************/
|
|
bool SCCB::_FInit(PLEXB plexb, bool fInFix, PMSNK pmsnk)
|
|
{
|
|
AssertThis(0);
|
|
AssertPo(plexb, 0);
|
|
AssertPo(pmsnk, 0);
|
|
long lw;
|
|
|
|
_Free();
|
|
_fError = fFalse;
|
|
_fHitEnd = fFalse;
|
|
_plexb = plexb;
|
|
_plexb->AddRef();
|
|
_pmsnk = pmsnk;
|
|
_pmsnk->AddRef();
|
|
|
|
if (fInFix)
|
|
{
|
|
// in-fix compilation requires an expression stack, expression parse
|
|
// tree and a control structure stack
|
|
if (pvNil == (_pgletnTree = GL::PglNew(size(ETN))) ||
|
|
pvNil == (_pgletnStack = GL::PglNew(size(ETN))) ||
|
|
pvNil == (_pglcstd = GL::PglNew(size(CSTD))))
|
|
{
|
|
_Free();
|
|
return fFalse;
|
|
}
|
|
_pgletnTree->SetMinGrow(100);
|
|
_pgletnStack->SetMinGrow(100);
|
|
}
|
|
|
|
if (pvNil == (_pscpt = NewObj SCPT) ||
|
|
pvNil == (_pscpt->_pgllw = GL::PglNew(size(long))))
|
|
{
|
|
ReleasePpo(&_pscpt);
|
|
}
|
|
else
|
|
_pscpt->_pgllw->SetMinGrow(100);
|
|
|
|
// code starts at slot 1 because the version numbers are in slot 0.
|
|
_ilwOpLast = 1;
|
|
|
|
// compiled code must start with an operator
|
|
_fForceOp = fTrue;
|
|
|
|
// put version info in the script
|
|
lw = LwHighLow(_SwCur(), _SwBack());
|
|
if (pvNil == _pscpt || !_pscpt->_pgllw->FPush(&lw))
|
|
_ReportError(_pszOom);
|
|
|
|
_lwLastLabel = 0; // for internal labels
|
|
AssertThis(0);
|
|
return fTrue;
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Free all memory hanging off this SCCB.
|
|
***************************************************************************/
|
|
void SCCB::_Free(void)
|
|
{
|
|
AssertThis(0);
|
|
CSTD cstd;
|
|
|
|
ReleasePpo(&_pscpt);
|
|
ReleasePpo(&_plexb);
|
|
ReleasePpo(&_pmsnk);
|
|
ReleasePpo(&_pgstLabel);
|
|
ReleasePpo(&_pgstReq);
|
|
ReleasePpo(&_pgletnTree);
|
|
ReleasePpo(&_pgletnStack);
|
|
if (pvNil != _pglcstd)
|
|
{
|
|
while (_pglcstd->FPop(&cstd))
|
|
ReleasePpo(&cstd.pgletnTree);
|
|
ReleasePpo(&_pglcstd);
|
|
}
|
|
ReleasePpo(&_pgstNames);
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Compile a script given a lexer object. Compilation is terminated when
|
|
the lexer's stream is exhausted or token ttEnd is encountered. ttEnd
|
|
allows scripts to be embedded in source for other tools (such as
|
|
chomp.exe).
|
|
***************************************************************************/
|
|
PSCPT SCCB::PscptCompileLex(PLEXB plexb, bool fInFix, PMSNK pmsnk, long ttEnd)
|
|
{
|
|
AssertThis(0);
|
|
AssertPo(plexb, 0);
|
|
AssertPo(pmsnk, 0);
|
|
PSCPT pscpt;
|
|
|
|
if (!_FInit(plexb, fInFix, pmsnk))
|
|
return pvNil;
|
|
_ttEnd = ttEnd;
|
|
|
|
if (fInFix)
|
|
_CompileIn();
|
|
else
|
|
_CompilePost();
|
|
|
|
// link all the label requests with the labels
|
|
if (pvNil != _pgstReq)
|
|
{
|
|
AssertPo(_pgstReq, 0);
|
|
long istn;
|
|
long lw, ilw;
|
|
STN stn;
|
|
|
|
for (istn = _pgstReq->IstnMac(); istn-- > 0; )
|
|
{
|
|
_pgstReq->GetStn(istn, &stn);
|
|
if (!_FFindLabel(&stn, &lw))
|
|
{
|
|
//undefined label
|
|
_ReportError(PszLit("Undefined label"));
|
|
}
|
|
else if (pvNil != _pscpt)
|
|
{
|
|
AssertPo(_pscpt, 0);
|
|
_pgstReq->GetExtra(istn, &ilw);
|
|
Assert(B3Lw(lw) == kbLabel, 0);
|
|
AssertIn(ilw, 1, _pscpt->_pgllw->IvMac());
|
|
_pscpt->_pgllw->Put(ilw, &lw);
|
|
}
|
|
}
|
|
}
|
|
|
|
pscpt = _pscpt;
|
|
_pscpt = pvNil;
|
|
_Free();
|
|
return pscpt;
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Compile the given text file and return the executable script.
|
|
Uses the in-fix or post-fix compiler according to fInFix.
|
|
***************************************************************************/
|
|
PSCPT SCCB::PscptCompileFil(PFIL pfil, bool fInFix, PMSNK pmsnk)
|
|
{
|
|
AssertThis(0);
|
|
AssertPo(pfil, 0);
|
|
AssertPo(pmsnk, 0);
|
|
PSCPT pscpt;
|
|
PLEXB plexb;
|
|
|
|
if (pvNil == (plexb = NewObj LEXB(pfil)))
|
|
return pvNil;
|
|
pscpt = PscptCompileLex(plexb, fInFix, pmsnk);
|
|
ReleasePpo(&plexb);
|
|
return pscpt;
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Compile a script from the given text file name.
|
|
***************************************************************************/
|
|
PSCPT SCCB::PscptCompileFni(FNI *pfni, bool fInFix, PMSNK pmsnk)
|
|
{
|
|
AssertPo(pfni, ffniFile);
|
|
AssertPo(pmsnk, 0);
|
|
PFIL pfil;
|
|
PSCPT pscpt;
|
|
|
|
if (pvNil == (pfil = FIL::PfilOpen(pfni)))
|
|
return pvNil;
|
|
pscpt = PscptCompileFil(pfil, fInFix, pmsnk);
|
|
ReleasePpo(&pfil);
|
|
return pscpt;
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Get the next token. Returns false if the token is a _ttEnd.
|
|
***************************************************************************/
|
|
bool SCCB::_FGetTok(PTOK ptok)
|
|
{
|
|
AssertBaseThis(0);
|
|
AssertPo(_plexb, 0);
|
|
if (_fHitEnd || !_plexb->FGetTok(ptok) || ptok->tt == _ttEnd)
|
|
{
|
|
_fHitEnd = fTrue;
|
|
return fFalse;
|
|
}
|
|
return fTrue;
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Return the current version number of the script compiler. This is
|
|
a virtual method so subclasses of SCCB can provide their own
|
|
version numbers.
|
|
***************************************************************************/
|
|
short SCCB::_SwCur(void)
|
|
{
|
|
AssertBaseThis(0);
|
|
return kswCurSccb;
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Return the back version number of the script compiler. Versions
|
|
back to here can read this script.
|
|
***************************************************************************/
|
|
short SCCB::_SwBack(void)
|
|
{
|
|
AssertBaseThis(0);
|
|
return kswBackSccb;
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Return the min version number of the script compiler. We can read
|
|
scripts back to this version.
|
|
***************************************************************************/
|
|
short SCCB::_SwMin(void)
|
|
{
|
|
AssertBaseThis(0);
|
|
return kswMinSccb;
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
An error occured. Report it to the message sink.
|
|
***************************************************************************/
|
|
void SCCB::_ReportError(PSZ psz)
|
|
{
|
|
AssertThis(0);
|
|
AssertPo(_plexb, 0);
|
|
AssertPo(_pmsnk, 0);
|
|
STN stn;
|
|
STN stnFile;
|
|
|
|
ReleasePpo(&_pscpt);
|
|
_fError = fTrue;
|
|
_plexb->GetStnFile(&stnFile);
|
|
stn.FFormatSz(PszLit("%s(%d:%d) : error : %z"), &stnFile, _plexb->LwLine(),
|
|
_plexb->IchLine() + 1, psz);
|
|
_pmsnk->ReportLine(stn.Psz());
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
The given long is immediate data to be pushed onto the execution stack.
|
|
***************************************************************************/
|
|
void SCCB::_PushLw(long lw)
|
|
{
|
|
AssertThis(0);
|
|
|
|
if (_fError)
|
|
return;
|
|
|
|
AssertPo(_pscpt, 0);
|
|
if (_fForceOp || _pscpt->_pgllw->IvMac() - _ilwOpLast >= kclwLimPush)
|
|
_PushOp(opNil);
|
|
if (!_fError && !_pscpt->_pgllw->FPush(&lw))
|
|
_ReportError(_pszOom);
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
"Push" a string constant. Puts the string in the string table and emits
|
|
code to push the corresponding internal variable.
|
|
***************************************************************************/
|
|
void SCCB::_PushString(PSTN pstn)
|
|
{
|
|
AssertThis(0);
|
|
AssertPo(pstn, 0);
|
|
RTVN rtvn;
|
|
long istn;
|
|
|
|
if (_fError)
|
|
return;
|
|
|
|
AssertPo(_pscpt, 0);
|
|
if (pvNil == _pscpt->_pgstLiterals &&
|
|
pvNil == (_pscpt->_pgstLiterals = GST::PgstNew()) ||
|
|
!_pscpt->_pgstLiterals->FAddStn(pstn, pvNil, &istn))
|
|
{
|
|
_ReportError(_pszOom);
|
|
return;
|
|
}
|
|
|
|
rtvn.lu1 = 0;
|
|
rtvn.lu2 = istn;
|
|
_PushVarOp(kopPushLocVar, &rtvn);
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Add an opcode to the compiled script.
|
|
***************************************************************************/
|
|
void SCCB::_PushOp(long op)
|
|
{
|
|
AssertThis(0);
|
|
Assert((long)(short)op == op, "bad opcode");
|
|
long lw;
|
|
|
|
if (_fError)
|
|
return;
|
|
|
|
AssertPo(_pscpt, 0);
|
|
_EndOp(); // complete the previous opcode
|
|
_ilwOpLast = _pscpt->_pgllw->IvMac();
|
|
lw = LwHighLow(0, (short)op);
|
|
if (!_pscpt->_pgllw->FPush(&lw))
|
|
_ReportError(_pszOom);
|
|
_fForceOp = fFalse;
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Close out an opcode by setting the number of immediate longs that follow.
|
|
***************************************************************************/
|
|
void SCCB::_EndOp(void)
|
|
{
|
|
AssertThis(0);
|
|
long ilw;
|
|
long lw;
|
|
|
|
if (_fError)
|
|
return;
|
|
|
|
AssertPo(_pscpt, 0);
|
|
ilw = _pscpt->_pgllw->IvMac();
|
|
if (_ilwOpLast < ilw - 1)
|
|
{
|
|
//set the count of longs in the previous op
|
|
AssertIn(ilw - _ilwOpLast - 1, 1, kclwLimPush);
|
|
_pscpt->_pgllw->Get(_ilwOpLast, &lw);
|
|
lw = LwHighLow(SuHighLow(B3Lw(lw), (byte)(ilw - _ilwOpLast - 1)), SuLow(lw));
|
|
_pscpt->_pgllw->Put(_ilwOpLast, &lw);
|
|
}
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Add an opcode that acts on a variable.
|
|
***************************************************************************/
|
|
void SCCB::_PushVarOp(long op, RTVN *prtvn)
|
|
{
|
|
AssertThis(0);
|
|
Assert((long)(byte)op == op, "bad opcode");
|
|
AssertVarMem(prtvn);
|
|
long lw;
|
|
|
|
_PushOp(opNil); // push a nil op, then fill it in below
|
|
if (_fError)
|
|
return;
|
|
|
|
// the high byte is op, the low word is part of the rtvn, the rest of the
|
|
// rtvn is in the next long
|
|
AssertPo(_pscpt, 0);
|
|
Assert(SuHigh(prtvn->lu1) == 0, "bad rtvn");
|
|
lw = prtvn->lu1 | (op << 24);
|
|
_pscpt->_pgllw->Put(_ilwOpLast, &lw);
|
|
if (!_pscpt->_pgllw->FPush(&prtvn->lu2))
|
|
_ReportError(_pszOom);
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Look up the indicated label and put it's location in *plwLoc.
|
|
***************************************************************************/
|
|
bool SCCB::_FFindLabel(PSTN pstn, long *plwLoc)
|
|
{
|
|
AssertThis(0);
|
|
AssertPo(pstn, 0);
|
|
AssertVarMem(plwLoc);
|
|
long istn;
|
|
|
|
if (pvNil == _pgstLabel || !_pgstLabel->FFindStn(pstn, &istn, fgstSorted))
|
|
{
|
|
TrashVar(plwLoc);
|
|
return fFalse;
|
|
}
|
|
_pgstLabel->GetExtra(istn, plwLoc);
|
|
return fTrue;
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Add the given label, giving it the current location.
|
|
***************************************************************************/
|
|
void SCCB::_AddLabel(PSTN pstn)
|
|
{
|
|
AssertThis(0);
|
|
AssertPo(pstn, 0);
|
|
long lw;
|
|
long istn;
|
|
|
|
if (pvNil == _pgstLabel &&
|
|
pvNil == (_pgstLabel = GST::PgstNew(size(long), 5, 100)))
|
|
{
|
|
_ReportError(_pszOom);
|
|
return;
|
|
}
|
|
if (_pgstLabel->FFindStn(pstn, &istn, fgstSorted))
|
|
{
|
|
_ReportError(PszLit("duplicate label"));
|
|
return;
|
|
}
|
|
lw = LwFromBytes(kbLabel, 0, 0, 0);
|
|
if (pvNil != _pscpt)
|
|
{
|
|
AssertPo(_pscpt, 0);
|
|
lw |= _pscpt->_pgllw->IvMac();
|
|
}
|
|
Assert(B3Lw(lw) == kbLabel, 0);
|
|
|
|
// a label must address an opcode, not immediate data
|
|
_fForceOp = fTrue;
|
|
|
|
if (!_pgstLabel->FInsertStn(istn, pstn, &lw))
|
|
_ReportError(_pszOom);
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Add the label request to the request gst and put an immediate value
|
|
of 0 in the compiled script. When compilation is finished, we'll
|
|
write the actual value for the label.
|
|
***************************************************************************/
|
|
void SCCB::_PushLabelRequest(PSTN pstn)
|
|
{
|
|
AssertThis(0);
|
|
AssertPo(pstn, 0);
|
|
long lw;
|
|
|
|
if (_fError)
|
|
return;
|
|
|
|
if (pvNil == _pgstReq &&
|
|
pvNil == (_pgstReq = GST::PgstNew(size(long), 10, 200)))
|
|
{
|
|
_ReportError(_pszOom);
|
|
return;
|
|
}
|
|
_PushLw(0);
|
|
if (_fError)
|
|
return;
|
|
|
|
AssertPo(_pscpt, 0);
|
|
lw = _pscpt->_pgllw->IvMac() - 1;
|
|
if (!_pgstReq->FAddStn(pstn, &lw))
|
|
_ReportError(_pszOom);
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Add an internal label. These are numeric to avoid conflicting with
|
|
a user defined label.
|
|
***************************************************************************/
|
|
void SCCB::_AddLabelLw(long lw)
|
|
{
|
|
AssertThis(0);
|
|
STN stn;
|
|
|
|
stn.FFormatSz(PszLit("0%x"), lw);
|
|
_AddLabel(&stn);
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Push an internal label request.
|
|
***************************************************************************/
|
|
void SCCB::_PushLabelRequestLw(long lw)
|
|
{
|
|
AssertThis(0);
|
|
STN stn;
|
|
|
|
stn.FFormatSz(PszLit("0%x"), lw);
|
|
_PushLabelRequest(&stn);
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Find the opcode that corresponds to the given stn.
|
|
***************************************************************************/
|
|
long SCCB::_OpFromStn(PSTN pstn)
|
|
{
|
|
AssertThis(0);
|
|
AssertPo(pstn, 0);
|
|
|
|
return _OpFromStnRgszop(pstn, _rgszop);
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Check the pstn against the strings in the prgszop and return the
|
|
corresponding op code.
|
|
***************************************************************************/
|
|
long SCCB::_OpFromStnRgszop(PSTN pstn, SZOP *prgszop)
|
|
{
|
|
AssertThis(0);
|
|
AssertPo(pstn, 0);
|
|
AssertVarMem(prgszop);
|
|
SZOP *pszop;
|
|
|
|
for (pszop = prgszop; pszop->psz != pvNil; pszop++)
|
|
{
|
|
if (pstn->FEqualSz(pszop->psz))
|
|
return pszop->op;
|
|
}
|
|
return opNil;
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Find the string corresponding to the given opcode. This is used during
|
|
disassembly.
|
|
***************************************************************************/
|
|
bool SCCB::_FGetStnFromOp(long op, PSTN pstn)
|
|
{
|
|
AssertThis(0);
|
|
AssertPo(pstn, 0);
|
|
|
|
return _FGetStnFromOpRgszop(op, pstn, _rgszop);
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Check the op against the ops in the prgszop and return the corresponding
|
|
string.
|
|
***************************************************************************/
|
|
bool SCCB::_FGetStnFromOpRgszop(long op, PSTN pstn, SZOP *prgszop)
|
|
{
|
|
AssertThis(0);
|
|
AssertPo(pstn, 0);
|
|
AssertVarMem(prgszop);
|
|
SZOP *pszop;
|
|
|
|
for (pszop = prgszop; pszop->psz != pvNil; pszop++)
|
|
{
|
|
if (op == pszop->op)
|
|
{
|
|
*pstn = pszop->psz;
|
|
return fTrue;
|
|
}
|
|
}
|
|
pstn->SetNil();
|
|
return fFalse;
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Compile the post-fix script source in _plexb.
|
|
***************************************************************************/
|
|
void SCCB::_CompilePost(void)
|
|
{
|
|
AssertThis(0);
|
|
AssertPo(_plexb, 0);
|
|
TOK tok;
|
|
long op;
|
|
RTVN rtvn;
|
|
|
|
while (_FGetTok(&tok))
|
|
{
|
|
switch (tok.tt)
|
|
{
|
|
default:
|
|
_ReportError(_pszSyntax);
|
|
break;
|
|
|
|
case ttLong:
|
|
_PushLw(tok.lw);
|
|
break;
|
|
|
|
case ttString:
|
|
_PushString(&tok.stn);
|
|
break;
|
|
|
|
case ttSub:
|
|
// handle unary minus on constants only
|
|
if (!_FGetTok(&tok) || tok.tt != ttLong)
|
|
_ReportError(_pszSyntax);
|
|
else
|
|
_PushLw(-tok.lw);
|
|
break;
|
|
|
|
case ttName:
|
|
op = _OpFromStn(&tok.stn);
|
|
if (opNil == op)
|
|
_ReportError(PszLit("Unknown name"));
|
|
else
|
|
_PushOp(op);
|
|
break;
|
|
|
|
case ttGt:
|
|
// pop into a variable
|
|
if (!_FGetTok(&tok))
|
|
{
|
|
_ReportError(_pszSyntax);
|
|
break;
|
|
}
|
|
op = kopPopLocVar;
|
|
switch (tok.tt)
|
|
{
|
|
case ttBNot:
|
|
op = kopPopRemoteVar;
|
|
goto LGetName;
|
|
case ttDot:
|
|
op = kopPopThisVar;
|
|
goto LGetName;
|
|
case ttScope:
|
|
op = kopPopGlobalVar;
|
|
goto LGetName;
|
|
}
|
|
goto LAcceptName;
|
|
|
|
case ttLt:
|
|
// push a variable
|
|
if (!_FGetTok(&tok))
|
|
{
|
|
_ReportError(_pszSyntax);
|
|
break;
|
|
}
|
|
op = kopPushLocVar;
|
|
switch (tok.tt)
|
|
{
|
|
case ttBNot:
|
|
op = kopPushRemoteVar;
|
|
goto LGetName;
|
|
case ttDot:
|
|
op = kopPushThisVar;
|
|
goto LGetName;
|
|
case ttScope:
|
|
op = kopPushGlobalVar;
|
|
LGetName:
|
|
if (!_FGetTok(&tok))
|
|
{
|
|
_ReportError(_pszSyntax);
|
|
break;
|
|
}
|
|
break;
|
|
}
|
|
|
|
LAcceptName:
|
|
if (tok.tt == ttBAnd)
|
|
{
|
|
// an array access
|
|
op += kopPushLocArray - kopPushLocVar;
|
|
if (!_FGetTok(&tok))
|
|
{
|
|
_ReportError(_pszSyntax);
|
|
break;
|
|
}
|
|
}
|
|
if (tok.tt == ttName && _OpFromStn(&tok.stn) == opNil)
|
|
{
|
|
rtvn.SetFromStn(&tok.stn);
|
|
_PushVarOp(op, &rtvn);
|
|
}
|
|
else
|
|
_ReportError(PszLit("Variable expected"));
|
|
break;
|
|
|
|
case ttDollar:
|
|
// label reference
|
|
if (_FGetTok(&tok) && tok.tt == ttName &&
|
|
_OpFromStn(&tok.stn) == opNil)
|
|
{
|
|
_PushLabelRequest(&tok.stn);
|
|
}
|
|
else
|
|
_ReportError(_pszSyntax);
|
|
break;
|
|
|
|
case ttAt:
|
|
// label definition
|
|
if (_FGetTok(&tok) && tok.tt == ttName &&
|
|
_OpFromStn(&tok.stn) == opNil)
|
|
{
|
|
_AddLabel(&tok.stn);
|
|
}
|
|
else
|
|
_ReportError(_pszSyntax);
|
|
break;
|
|
}
|
|
}
|
|
|
|
// complete the last opcode
|
|
_EndOp();
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
In-fix compiler declarations and tables.
|
|
***************************************************************************/
|
|
|
|
|
|
// operator precedence levels
|
|
enum
|
|
{
|
|
oplNil = 0,
|
|
koplComma,
|
|
koplAssign,
|
|
koplColon,
|
|
koplLOr,
|
|
koplLXor,
|
|
koplLAnd,
|
|
koplBOr,
|
|
koplBXor,
|
|
koplBAnd,
|
|
koplEq,
|
|
koplRel,
|
|
koplShift,
|
|
koplAdd,
|
|
koplMul,
|
|
koplPreUn,
|
|
koplPostUn,
|
|
koplGroup,
|
|
koplNumber,
|
|
koplRemoteName,
|
|
koplThisName,
|
|
koplGlobalName,
|
|
koplArrayName,
|
|
koplName,
|
|
koplMax
|
|
};
|
|
|
|
|
|
// token-operator map entry
|
|
struct TOME
|
|
{
|
|
short tt;
|
|
short grfop;
|
|
short op;
|
|
short oplResolve;
|
|
short oplMinRes;
|
|
short ttPop;
|
|
short oplPush;
|
|
};
|
|
|
|
|
|
#define _TomeCore(tt,grfop,op,oplRes,oplMin,ttPop,oplPush) \
|
|
{tt,grfop,op,oplRes,oplMin,ttPop,oplPush}
|
|
#define _TomeRes(tt,op,oplRes) {tt,fopOp,op,oplRes,oplRes,ttNil,oplRes}
|
|
#define _TomePush(tt,op,oplPush) {tt,fopOp,op,oplNil,oplNil,ttNil,oplPush}
|
|
|
|
// following a non-operator
|
|
TOME _rgtomeExp[] =
|
|
{
|
|
_TomeCore(ttOpenParen, fopOp|fopFunction, opNil, koplName, koplName, ttNil, oplNil), //function call
|
|
_TomeCore(ttCloseParen, fopNil, opNil, koplComma, koplComma, ttOpenParen, koplGroup),
|
|
_TomeCore(ttOpenRef, fopOp|fopArray, opNil, koplName, koplName, ttNil, oplNil), //array reference
|
|
_TomeCore(ttCloseRef, fopNil, opNil, koplComma, koplComma, ttOpenRef, koplArrayName),
|
|
|
|
_TomeRes(ttAdd, kopAdd, koplAdd),
|
|
_TomeRes(ttSub, kopSub, koplAdd),
|
|
_TomeRes(ttMul, kopMul, koplMul),
|
|
_TomeRes(ttDiv, kopDiv, koplMul),
|
|
_TomeRes(ttMod, kopMod, koplMul),
|
|
_TomeCore(ttInc, fopAssign|fopPostAssign, kopInc, koplRemoteName, koplRemoteName, ttNil, koplPostUn),
|
|
_TomeCore(ttDec, fopAssign|fopPostAssign, kopDec, koplRemoteName, koplRemoteName, ttNil, koplPostUn),
|
|
_TomeRes(ttBOr, kopBOr, koplBOr),
|
|
_TomeRes(ttBAnd, kopBAnd, koplBAnd),
|
|
_TomeRes(ttBXor, kopBXor, koplBXor),
|
|
_TomeRes(ttShr, kopShr, koplShift),
|
|
_TomeRes(ttShl, kopShl, koplShift),
|
|
_TomeRes(ttLOr, opNil, koplLOr),
|
|
_TomeRes(ttLAnd, opNil, koplLAnd),
|
|
_TomeRes(ttLXor, kopLXor, koplLXor),
|
|
_TomeRes(ttEq, kopEq, koplEq),
|
|
_TomeRes(ttNe, kopNe, koplEq),
|
|
_TomeRes(ttGt, kopGt, koplRel),
|
|
_TomeRes(ttGe, kopGe, koplRel),
|
|
_TomeRes(ttLt, kopLt, koplRel),
|
|
_TomeRes(ttLe, kopLe, koplRel),
|
|
|
|
_TomeCore(ttAssign, fopAssign|fopOp, opNil, koplAssign + 1, koplRemoteName, ttNil, koplAssign),
|
|
_TomeCore(ttAAdd, fopAssign|fopOp, kopAdd, koplAssign + 1, koplRemoteName, ttNil, koplAssign),
|
|
_TomeCore(ttASub, fopAssign|fopOp, kopSub, koplAssign + 1, koplRemoteName, ttNil, koplAssign),
|
|
_TomeCore(ttAMul, fopAssign|fopOp, kopMul, koplAssign + 1, koplRemoteName, ttNil, koplAssign),
|
|
_TomeCore(ttADiv, fopAssign|fopOp, kopDiv, koplAssign + 1, koplRemoteName, ttNil, koplAssign),
|
|
_TomeCore(ttAMod, fopAssign|fopOp, kopMod, koplAssign + 1, koplRemoteName, ttNil, koplAssign),
|
|
_TomeCore(ttABOr, fopAssign|fopOp, kopBOr, koplAssign + 1, koplRemoteName, ttNil, koplAssign),
|
|
_TomeCore(ttABAnd, fopAssign|fopOp, kopBAnd, koplAssign + 1, koplRemoteName, ttNil, koplAssign),
|
|
_TomeCore(ttABXor, fopAssign|fopOp, kopBXor, koplAssign + 1, koplRemoteName, ttNil, koplAssign),
|
|
_TomeCore(ttAShr, fopAssign|fopOp, kopShr, koplAssign + 1, koplRemoteName, ttNil, koplAssign),
|
|
_TomeCore(ttAShl, fopAssign|fopOp, kopShl, koplAssign + 1, koplRemoteName, ttNil, koplAssign),
|
|
|
|
_TomeCore(ttQuery, fopOp, opNil, koplLOr, koplLOr, ttNil, oplNil),
|
|
_TomeCore(ttColon, fopOp, opNil, koplComma, koplComma, ttQuery, koplColon),
|
|
_TomeRes(ttComma, opNil, koplComma),
|
|
_TomeCore(ttArrow, fopOp, opNil, koplGroup, koplGroup, ttNil, koplRemoteName),
|
|
_TomeCore(ttDollar, fopNil, opNil, koplName, koplName, ttNil, koplNumber),
|
|
_TomeCore(ttAt, fopNil, opNil, koplComma, koplName, ttNil, koplComma),
|
|
|
|
//end of list marker
|
|
_TomeRes(ttNil, opNil, oplNil)
|
|
};
|
|
|
|
|
|
// following an operator
|
|
TOME _rgtomeOp[] =
|
|
{
|
|
_TomeCore(ttName, fopNil, opNil, oplNil, oplNil, ttNil, koplName),
|
|
_TomeCore(ttLong, fopNil, opNil, oplNil, oplNil, ttNil, koplNumber),
|
|
_TomeCore(ttString, fopNil, opNil, oplNil, oplNil, ttNil, koplNumber),
|
|
_TomeCore(ttOpenParen, fopOp, opNil, oplNil, oplNil, ttNil, oplNil), //grouping
|
|
_TomeCore(ttCloseParen, fopNil, opNil, oplNil, oplNil, ttOpenParen, koplGroup), //empty group
|
|
|
|
_TomePush(ttSub, kopNeg, koplPreUn),
|
|
_TomePush(ttLNot, kopLNot, koplPreUn),
|
|
_TomePush(ttBNot, kopBNot, koplPreUn),
|
|
_TomeCore(ttInc, fopOp|fopAssign, kopInc, oplNil, oplNil, ttNil, koplPreUn),
|
|
_TomeCore(ttDec, fopOp|fopAssign, kopDec, oplNil, oplNil, ttNil, koplPreUn),
|
|
_TomePush(ttAdd, opNil, koplPreUn),
|
|
|
|
_TomePush(ttDot, opNil, koplThisName),
|
|
_TomePush(ttScope, opNil, koplGlobalName),
|
|
|
|
//end of list marker
|
|
_TomeRes(ttNil, opNil, oplNil)
|
|
};
|
|
|
|
|
|
/***************************************************************************
|
|
Find the TOME corresponding to this token and fOp.
|
|
***************************************************************************/
|
|
TOME *_PtomeFromTt(long tt, bool fOp)
|
|
{
|
|
TOME *ptome;
|
|
|
|
for (ptome = fOp ? _rgtomeOp : _rgtomeExp; ttNil != ptome->tt; ptome++)
|
|
{
|
|
if (tt == ptome->tt)
|
|
return ptome;
|
|
}
|
|
return pvNil;
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Resolve the ETN stack to something at the given opl.
|
|
***************************************************************************/
|
|
bool SCCB::_FResolveToOpl(long opl, long oplMin, long *pietn)
|
|
{
|
|
AssertThis(0);
|
|
AssertIn(opl, oplNil + 1, koplMax);
|
|
AssertIn(oplMin, oplNil, koplMax);
|
|
AssertPo(_pgletnStack, 0);
|
|
AssertPo(_pgletnTree, 0);
|
|
AssertVarMem(pietn);
|
|
ETN etn, etnT;
|
|
long ietn, cetn;
|
|
|
|
_pgletnStack->Get(_pgletnStack->IvMac() - 1, &etn);
|
|
if (etn.grfop & fopOp)
|
|
{
|
|
Bug("I think this will only happen if a table entry is wrong");
|
|
_ReportError(_pszSyntax);
|
|
return fFalse;
|
|
}
|
|
|
|
for (;;)
|
|
{
|
|
cetn = _pgletnStack->IvMac();
|
|
Assert(cetn > 1, "bad stack");
|
|
Assert(((ETN *)_pgletnStack->QvGet(cetn - 1))->opl >= opl,
|
|
"bad opl on top of stack");
|
|
_pgletnStack->Get(cetn - 2, &etn);
|
|
if (etn.opl < opl)
|
|
break;
|
|
|
|
AssertDo(_pgletnStack->FPop(&etnT), 0);
|
|
if (!_FAddToTree(&etnT, &ietn))
|
|
{
|
|
_ReportError(_pszOom);
|
|
return fFalse;
|
|
}
|
|
if (ietn == ivNil)
|
|
return fFalse;
|
|
|
|
if (etn.ietn1 == ivNil)
|
|
etn.ietn1 = ietn;
|
|
else if (etn.ietn2 == ivNil)
|
|
etn.ietn2 = ietn;
|
|
else
|
|
{
|
|
Assert(etn.ietn3 == ivNil, "bad etn");
|
|
etn.ietn3 = ietn;
|
|
}
|
|
etn.grfop &= ~fopOp;
|
|
_pgletnStack->Put(cetn - 2, &etn);
|
|
}
|
|
|
|
AssertDo(_pgletnStack->FPop(&etnT), 0);
|
|
if (etnT.opl < oplMin)
|
|
{
|
|
_ReportError(_pszSyntax);
|
|
return fFalse;
|
|
}
|
|
if (!_FAddToTree(&etnT, pietn))
|
|
{
|
|
_ReportError(_pszOom);
|
|
return fFalse;
|
|
}
|
|
|
|
return fTrue;
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
See if we can simplify the expression because of constant operands and
|
|
other optimizations, then add it to the tree. Most of this routine
|
|
is not necessary for non-optimized compilation. This routine could
|
|
be simplified to nuke () groupings and unary plus operators and just
|
|
add the rest to _pgletnTree.
|
|
***************************************************************************/
|
|
bool SCCB::_FAddToTree(ETN *petn, long *pietn)
|
|
{
|
|
AssertThis(0);
|
|
AssertVarMem(petn);
|
|
AssertVarMem(pietn);
|
|
long lw1, lw2, lw;
|
|
bool fConst1, fConst2;
|
|
ETN etnT1, etnT2, etn;
|
|
long ietnConst;
|
|
bool fCommute = fFalse;
|
|
|
|
Assert((petn->ietn3 == ivNil || petn->ietn2 != ivNil)
|
|
&& (petn->ietn2 == ivNil || petn->ietn1 != ivNil),
|
|
"bad etn");
|
|
|
|
// get rid of non-function call groupings - they aren't necessary in
|
|
// the parse tree.
|
|
if (petn->op == opNil && petn->tt == ttCloseParen)
|
|
{
|
|
if (petn->grfop & fopFunction)
|
|
goto LAdd;
|
|
Assert(petn->ietn2 == ivNil, "shouldn't be a second operand");
|
|
if (petn->ietn1 == ivNil)
|
|
{
|
|
_ReportError(_pszSyntax);
|
|
*pietn = ivNil;
|
|
return fTrue;
|
|
}
|
|
*pietn = petn->ietn1;
|
|
return fTrue;
|
|
}
|
|
|
|
if (petn->ietn3 != ivNil || petn->ietn1 == ivNil)
|
|
goto LAdd;
|
|
|
|
// one or two operands
|
|
fConst1 = _FConstEtn(petn->ietn1, &lw1);
|
|
if (petn->ietn2 == ivNil)
|
|
{
|
|
// unary operators
|
|
|
|
// nuke unary plus operator
|
|
if (ttAdd == petn->tt && opNil == petn->op)
|
|
{
|
|
*pietn = petn->ietn1;
|
|
return fTrue;
|
|
}
|
|
|
|
if (!fConst1)
|
|
goto LAdd;
|
|
|
|
// optimize unary operators with constant operand
|
|
switch (petn->op)
|
|
{
|
|
default:
|
|
goto LAdd;
|
|
|
|
case kopNeg:
|
|
lw = -lw1;
|
|
break;
|
|
case kopBNot:
|
|
lw = ~lw1;
|
|
break;
|
|
case kopLNot:
|
|
lw = !lw1;
|
|
break;
|
|
}
|
|
*pietn = ietnConst = petn->ietn1;
|
|
goto LSetConst;
|
|
}
|
|
|
|
// two operands - determine if they are constants
|
|
fConst2 = _FConstEtn(petn->ietn2, &lw2);
|
|
if (fConst1 && fConst2)
|
|
{
|
|
// optimize binary operators with both operands constants
|
|
if (petn->op == opNil)
|
|
{
|
|
switch (petn->tt)
|
|
{
|
|
default:
|
|
goto LAdd;
|
|
case ttLOr:
|
|
lw = lw1 || lw2;
|
|
break;
|
|
case ttLAnd:
|
|
lw = lw1 && lw2;
|
|
break;
|
|
}
|
|
}
|
|
else if (!_FCombineConstValues(petn->op, lw1, lw2, &lw))
|
|
goto LAdd;
|
|
|
|
*pietn = ietnConst = petn->ietn1;
|
|
goto LSetConst;
|
|
}
|
|
|
|
// try to combine operand subtrees for the binary operators that are
|
|
// commutative and associative
|
|
Assert(!fConst1 || !fConst2, 0);
|
|
switch (petn->op)
|
|
{
|
|
default:
|
|
break;
|
|
|
|
case kopSub:
|
|
if (!fConst2)
|
|
break;
|
|
|
|
// the second argument is constant, but the first is not, so negate the
|
|
// constant and change the operator to kopAdd
|
|
_pgletnTree->Get(petn->ietn2, &etnT2);
|
|
etnT2.lwValue = -etnT2.lwValue;
|
|
_pgletnTree->Put(petn->ietn2, &etnT2);
|
|
petn->op = kopAdd;
|
|
// fall thru
|
|
case kopAdd:
|
|
case kopMul:
|
|
case kopBOr:
|
|
case kopBAnd:
|
|
case kopBXor:
|
|
case kopLXor:
|
|
// get the two etn's
|
|
fCommute = fTrue;
|
|
_pgletnTree->Get(petn->ietn1, &etnT1);
|
|
_pgletnTree->Get(petn->ietn2, &etnT2);
|
|
|
|
if (fConst1)
|
|
{
|
|
// first operand is constant, so swap them
|
|
Assert(!fConst2, 0);
|
|
SwapVars(&petn->ietn1, &petn->ietn2);
|
|
SwapVars(&fConst1, &fConst2);
|
|
SwapVars(&etnT1, &etnT2);
|
|
}
|
|
|
|
if (fConst2)
|
|
{
|
|
// the second is constant
|
|
// see if the first has the same op as petn
|
|
if (etnT1.op != petn->op)
|
|
break;
|
|
|
|
// see if the first one has a constant second operand
|
|
if (!_FConstEtn(etnT1.ietn2, &lw1))
|
|
break;
|
|
|
|
// all we have to do is modify the first one's second operand
|
|
AssertDo(_FCombineConstValues(petn->op, lw1, etnT2.lwValue, &lw), 0);
|
|
*pietn = petn->ietn1;
|
|
ietnConst = etnT1.ietn2;
|
|
goto LSetConst;
|
|
}
|
|
|
|
// neither operand is constant
|
|
Assert(!fConst1 && !fConst2, 0);
|
|
|
|
// see if the right operands of the operands are constant
|
|
fConst1 = (etnT1.op == petn->op) && _FConstEtn(etnT1.ietn2, &lw1);
|
|
fConst2 = (etnT2.op == petn->op) && _FConstEtn(etnT2.ietn2, &lw2);
|
|
|
|
if (fConst1 && fConst2)
|
|
{
|
|
// both are constant
|
|
AssertDo(_FCombineConstValues(petn->op, lw1, lw2, &lw), 0);
|
|
*pietn = petn->ietn2;
|
|
etnT1.ietn2 = etnT2.ietn1;
|
|
etnT2.ietn1 = petn->ietn1;
|
|
_SetDepth(&etnT1, fTrue);
|
|
_pgletnTree->Put(petn->ietn1, &etnT1);
|
|
ietnConst = etnT2.ietn2;
|
|
_SetDepth(&etnT2);\
|
|
Assert(ietnConst == etnT2.ietn2, "why did _SetDepth move this?");
|
|
_pgletnTree->Put(petn->ietn2, &etnT2);
|
|
LSetConst:
|
|
_pgletnTree->Get(ietnConst, &etn);
|
|
Assert(opNil == etn.op && ttLong == etn.tt, 0);
|
|
Assert(etn.cetnDeep == 1, 0);
|
|
etn.lwValue = lw;
|
|
_pgletnTree->Put(ietnConst, &etn);
|
|
return fTrue;
|
|
}
|
|
|
|
if (fConst1)
|
|
{
|
|
// only the first is constant
|
|
SwapVars(&etnT1.ietn2, &petn->ietn2);
|
|
_SetDepth(&etnT1, fTrue);
|
|
_pgletnTree->Put(petn->ietn1, &etnT1);
|
|
break;
|
|
}
|
|
|
|
if (fConst2)
|
|
{
|
|
// only the second is constant
|
|
goto LPivot;
|
|
}
|
|
|
|
// neither is constant
|
|
Assert(!fConst1 && !fConst2, 0);
|
|
if ((etnT1.op == petn->op) == (etnT2.op == petn->op))
|
|
{
|
|
// both the same as petn->op or both different, let _SetDepth
|
|
// do its thing
|
|
break;
|
|
}
|
|
|
|
if (etnT1.op == petn->op)
|
|
{
|
|
if (etnT2.ietn1 == ivNil)
|
|
break;
|
|
// swap them
|
|
SwapVars(&petn->ietn1, &petn->ietn2);
|
|
SwapVars(&etnT1, &etnT2);
|
|
}
|
|
|
|
Assert(etnT1.op != petn->op && etnT2.op == petn->op, 0);
|
|
//determine if we want to pivot or swap
|
|
_pgletnTree->Get(etnT2.ietn2, &etn);
|
|
if (etn.cetnDeep > etnT1.cetnDeep)
|
|
{
|
|
// swap them
|
|
SwapVars(&petn->ietn1, &petn->ietn2);
|
|
}
|
|
else
|
|
{
|
|
LPivot:
|
|
// pivot
|
|
Assert(etnT2.op == petn->op, 0);
|
|
etn = *petn;
|
|
etn.ietn2 = etnT2.ietn2;
|
|
etn.ietn1 = petn->ietn2;
|
|
etnT2.ietn2 = etnT2.ietn1;
|
|
etnT2.ietn1 = petn->ietn1;
|
|
_SetDepth(&etnT2, fTrue);
|
|
_pgletnTree->Put(petn->ietn2, &etnT2);
|
|
petn = &etn;
|
|
}
|
|
break;
|
|
}
|
|
|
|
LAdd:
|
|
_SetDepth(petn, fCommute);
|
|
return _pgletnTree->FAdd(petn, pietn);
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Set the depth of the ETN from its children. If fCommute is true and
|
|
the first two children are non-nil, puts the deepest child first.
|
|
***************************************************************************/
|
|
void SCCB::_SetDepth(ETN *petn, bool fCommute)
|
|
{
|
|
AssertThis(0);
|
|
AssertVarMem(petn);
|
|
AssertPo(_pgletnTree, 0);
|
|
ETN etn1, etn2;
|
|
|
|
if (fCommute && petn->ietn1 != ivNil && petn->ietn2 != ivNil)
|
|
{
|
|
// put the deeper guy on the left
|
|
_pgletnTree->Get(petn->ietn1, &etn1);
|
|
_pgletnTree->Get(petn->ietn2, &etn2);
|
|
if (etn1.cetnDeep < etn2.cetnDeep ||
|
|
etn1.cetnDeep == etn2.cetnDeep && etn1.op == petn->op &&
|
|
etn2.op != petn->op)
|
|
{
|
|
// swap them
|
|
SwapVars(&petn->ietn1, &petn->ietn2);
|
|
SwapVars(&etn1, &etn2);
|
|
}
|
|
// put as much stuff on the left as we can
|
|
while (etn2.op == petn->op)
|
|
{
|
|
etn1 = etn2;
|
|
etn1.ietn1 = petn->ietn1;
|
|
etn1.ietn2 = etn2.ietn1;
|
|
petn->ietn1 = petn->ietn2;
|
|
petn->ietn2 = etn2.ietn2;
|
|
_SetDepth(&etn1, fTrue);
|
|
_pgletnTree->Put(petn->ietn1, &etn1);
|
|
_pgletnTree->Get(petn->ietn2, &etn2);
|
|
}
|
|
}
|
|
|
|
petn->cetnDeep = 1;
|
|
if (petn->ietn1 != ivNil)
|
|
{
|
|
_pgletnTree->Get(petn->ietn1, &etn1);
|
|
petn->cetnDeep = LwMax(petn->cetnDeep, etn1.cetnDeep + 1);
|
|
if (petn->ietn2 != ivNil)
|
|
{
|
|
_pgletnTree->Get(petn->ietn2, &etn2);
|
|
petn->cetnDeep = LwMax(petn->cetnDeep, etn2.cetnDeep + 1);
|
|
if (petn->ietn3 != ivNil)
|
|
{
|
|
_pgletnTree->Get(petn->ietn3, &etn1);
|
|
petn->cetnDeep = LwMax(petn->cetnDeep, etn1.cetnDeep + 1);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Return true iff the given etn is constant. If so, set *plw to its
|
|
value.
|
|
***************************************************************************/
|
|
bool SCCB::_FConstEtn(long ietn, long *plw)
|
|
{
|
|
AssertThis(0);
|
|
AssertVarMem(plw);
|
|
AssertPo(_pgletnTree, 0);
|
|
ETN etn;
|
|
|
|
if (ietn != ivNil)
|
|
{
|
|
AssertIn(ietn, 0, _pgletnTree->IvMac());
|
|
_pgletnTree->Get(ietn, &etn);
|
|
if (etn.op == opNil && etn.tt == ttLong)
|
|
{
|
|
*plw = etn.lwValue;
|
|
return fTrue;
|
|
}
|
|
}
|
|
TrashVar(plw);
|
|
return fFalse;
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Combine the constant values lw1 and lw2 using the given operator.
|
|
Put the result in *plw. Return false if we can't combine the values
|
|
using op.
|
|
***************************************************************************/
|
|
bool SCCB::_FCombineConstValues(long op, long lw1, long lw2, long *plw)
|
|
{
|
|
AssertBaseThis(0);
|
|
AssertVarMem(plw);
|
|
|
|
switch (op)
|
|
{
|
|
default:
|
|
return fFalse;
|
|
|
|
case kopAdd:
|
|
*plw = lw1 + lw2;
|
|
break;
|
|
case kopSub:
|
|
*plw = lw1 - lw2;
|
|
break;
|
|
case kopMul:
|
|
*plw = lw1 * lw2;
|
|
break;
|
|
case kopDiv:
|
|
case kopMod:
|
|
if (lw2 == 0)
|
|
{
|
|
_ReportError(PszLit("divide by zero"));
|
|
*plw = 0;
|
|
}
|
|
else
|
|
*plw = op == kopDiv ? lw1 / lw2 : lw1 % lw2;
|
|
break;
|
|
case kopShr:
|
|
*plw = (ulong)lw1 >> lw2;
|
|
break;
|
|
case kopShl:
|
|
*plw = (ulong)lw1 << lw2;
|
|
break;
|
|
case kopBOr:
|
|
*plw = lw1 | lw2;
|
|
break;
|
|
case kopBAnd:
|
|
*plw = lw1 & lw2;
|
|
break;
|
|
case kopBXor:
|
|
*plw = lw1 ^ lw2;
|
|
break;
|
|
case kopLXor:
|
|
*plw = FPure(lw1) != FPure(lw2);
|
|
break;
|
|
case kopEq:
|
|
*plw = lw1 == lw2;
|
|
break;
|
|
case kopNe:
|
|
*plw = lw1 != lw2;
|
|
break;
|
|
case kopGt:
|
|
*plw = lw1 > lw2;
|
|
break;
|
|
case kopLt:
|
|
*plw = lw1 < lw2;
|
|
break;
|
|
case kopGe:
|
|
*plw = lw1 >= lw2;
|
|
break;
|
|
case kopLe:
|
|
*plw = lw1 <= lw2;
|
|
break;
|
|
}
|
|
|
|
return fTrue;
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Emit code for the expression tree with top at ietnTop. If pclwArg
|
|
is not nil, we are pushing function arguments, so the comma operator
|
|
has to keep the values of both its operands. Otherwise, the comma
|
|
operator discards the value of its left operand.
|
|
|
|
Values of grfscc include fsccTop, indicating whether a control structure
|
|
primitive is legal, and fsccWantVoid, indicating whether the emitted
|
|
code should (not) leave a value on the execution stack. If fsccTop
|
|
is set, fsccWantVoid should also be set.
|
|
|
|
This is highly recursive, so limit the stack space needed.
|
|
***************************************************************************/
|
|
void SCCB::_EmitCode(long ietnTop, ulong grfscc, long *pclwArg)
|
|
{
|
|
AssertThis(0);
|
|
AssertPo(_pgletnTree, 0);
|
|
AssertIn(ietnTop, 0, _pgletnTree->IvMac());
|
|
Assert(!(grfscc & fsccTop) || (grfscc & fsccWantVoid),
|
|
"fsccTop but not fsccWantVoid set");
|
|
AssertNilOrVarMem(pclwArg);
|
|
ETN etn;
|
|
RTVN rtvn;
|
|
long opPush, opPop;
|
|
long clwStack;
|
|
long lw1, lw2;
|
|
long cst;
|
|
|
|
_pgletnTree->Get(ietnTop, &etn);
|
|
|
|
// all non-nil operands should come before any nils
|
|
Assert((etn.ietn3 == ivNil || etn.ietn2 != ivNil)
|
|
&& (etn.ietn2 == ivNil || etn.ietn1 != ivNil),
|
|
"bad etn");
|
|
|
|
if (etn.grfop & fopAssign)
|
|
{
|
|
//an operator that changes the value of a variable
|
|
Assert(ivNil != etn.ietn1, "nil ietn1");
|
|
Assert(ivNil == etn.ietn3, "non-nil ietn3");
|
|
|
|
//if we're doing an operation before assigning (eg, +=),
|
|
//push the variable first
|
|
if (etn.op != opNil)
|
|
{
|
|
_EmitVarAccess(etn.ietn1, &rtvn, &opPush, &opPop, &clwStack);
|
|
if (clwStack == 1)
|
|
_PushOp(kopDup); //duplicate the variable access id
|
|
else if (clwStack > 0)
|
|
{
|
|
_PushLw(clwStack);
|
|
_PushOp(kopDupList);
|
|
}
|
|
_PushVarOp(opPush, &rtvn);
|
|
}
|
|
|
|
//generate the second operand
|
|
if (etn.ietn2 != ivNil)
|
|
_EmitCode(etn.ietn2, fsccNil, pvNil);
|
|
|
|
//do the operation (if not post-inc or post-dec)
|
|
if (etn.op != opNil && !(etn.grfop & fopPostAssign))
|
|
_PushOp(etn.op);
|
|
|
|
//duplicate the result
|
|
if (!(grfscc & fsccWantVoid))
|
|
_PushOp(kopDup);
|
|
|
|
//do the operation if post-inc or post-dec
|
|
if (etn.op != opNil && (etn.grfop & fopPostAssign))
|
|
_PushOp(etn.op);
|
|
|
|
//pop the result into the variable
|
|
if (etn.op == opNil)
|
|
_EmitVarAccess(etn.ietn1, &rtvn, pvNil, &opPop, pvNil);
|
|
else if (clwStack == 1)
|
|
{
|
|
//need to bring the variable access result to the top
|
|
if (grfscc & fsccWantVoid)
|
|
_PushOp(kopSwap);
|
|
else
|
|
{
|
|
//top two items on the stack are the result
|
|
_PushLw(3);
|
|
_PushOp(kopRev);
|
|
}
|
|
}
|
|
else if (clwStack > 0)
|
|
{
|
|
// top one or two values are the result, next
|
|
// clwStack values are the variable access values.
|
|
_PushLw(clwStack + 1 + !(grfscc & fsccWantVoid));
|
|
_PushLw(clwStack);
|
|
_PushOp(kopRot);
|
|
}
|
|
|
|
_PushVarOp(opPop, &rtvn);
|
|
return;
|
|
}
|
|
|
|
if (opNil != etn.op)
|
|
{
|
|
if (ivNil != etn.ietn1)
|
|
{
|
|
_EmitCode(etn.ietn1, fsccNil, pvNil);
|
|
if (ivNil != etn.ietn2)
|
|
{
|
|
_EmitCode(etn.ietn2, fsccNil, pvNil);
|
|
if (ivNil != etn.ietn3)
|
|
_EmitCode(etn.ietn3, fsccNil, pvNil);
|
|
}
|
|
}
|
|
_PushOp(etn.op);
|
|
if (grfscc & fsccWantVoid)
|
|
_PushOp(kopPop);
|
|
return;
|
|
}
|
|
|
|
//special cases
|
|
switch (etn.tt)
|
|
{
|
|
default:
|
|
Bug("what is this?");
|
|
break;
|
|
case ttName:
|
|
// first check for a control structure keyword
|
|
if (_FHandleCst(ietnTop))
|
|
{
|
|
// if we're not at the top of the parse tree, it's an error
|
|
if (!(grfscc & fsccTop))
|
|
_ReportError(_pszSyntax);
|
|
break;
|
|
}
|
|
// fall thru
|
|
case ttCloseRef:
|
|
case ttDot:
|
|
case ttScope:
|
|
case ttArrow:
|
|
// handle pushing a variable
|
|
_EmitVarAccess(ietnTop, &rtvn, &opPush, pvNil, pvNil);
|
|
_PushVarOp(opPush, &rtvn);
|
|
if (grfscc & fsccWantVoid)
|
|
_PushOp(kopPop);
|
|
break;
|
|
case ttLong:
|
|
// push a constant
|
|
Assert(ivNil == etn.ietn1, "non-nil ietn1");
|
|
if (!(grfscc & fsccWantVoid))
|
|
_PushLw(etn.lwValue);
|
|
break;
|
|
case ttString:
|
|
// "push" a constant string
|
|
Assert(ivNil == etn.ietn1, "non-nil ietn1");
|
|
if (!(grfscc & fsccWantVoid))
|
|
_PushStringIstn(etn.lwValue);
|
|
break;
|
|
case ttDollar:
|
|
//label reference
|
|
Assert(ivNil != etn.ietn1, "nil ietn1");
|
|
Assert(ivNil == etn.ietn2, "non-nil ietn2");
|
|
if (!(grfscc & fsccWantVoid))
|
|
_PushLabelRequestIetn(etn.ietn1);
|
|
break;
|
|
case ttAt:
|
|
//label declaration
|
|
Assert(ivNil != etn.ietn1, "nil ietn1");
|
|
Assert(ivNil == etn.ietn2, "non-nil ietn2");
|
|
Assert(grfscc & fsccTop, "fsccTop not set for label");
|
|
_AddLabelIetn(etn.ietn1);
|
|
break;
|
|
case ttCloseParen:
|
|
// a function call or control structure
|
|
Assert(etn.grfop & fopFunction, 0);
|
|
Assert(ivNil != etn.ietn1, "nil ietn1");
|
|
Assert(ivNil == etn.ietn3, "non-nil ietn3");
|
|
|
|
if ((grfscc & fsccTop) && cstNil != (cst = _CstFromName(etn.ietn1)))
|
|
{
|
|
// control structure
|
|
_BeginCst(cst, etn.ietn2);
|
|
}
|
|
else
|
|
{
|
|
//get the arguments and count them
|
|
long clwArg;
|
|
|
|
if (etn.ietn2 == ivNil)
|
|
clwArg = 0;
|
|
else
|
|
{
|
|
clwArg = 1;
|
|
_EmitCode(etn.ietn2, fsccNil, &clwArg);
|
|
}
|
|
_PushOpFromName(etn.ietn1, grfscc, clwArg);
|
|
}
|
|
break;
|
|
case ttComma:
|
|
if (pvNil != pclwArg)
|
|
{
|
|
//we're pushing function arguments
|
|
Assert(!(grfscc & fsccWantVoid), "bad comma request");
|
|
|
|
//push function arguments from right to left!
|
|
_EmitCode(etn.ietn2, fsccNil, pclwArg);
|
|
(*pclwArg)++;
|
|
_EmitCode(etn.ietn1, fsccNil, pclwArg);
|
|
}
|
|
else
|
|
{
|
|
_EmitCode(etn.ietn1, fsccWantVoid, pvNil);
|
|
_EmitCode(etn.ietn2, grfscc & ~fsccTop, pvNil);
|
|
}
|
|
break;
|
|
case ttColon:
|
|
//ternary operator
|
|
Assert(ivNil != etn.ietn3, "nil ietn3");
|
|
_PushLabelRequestLw(lw1 = ++_lwLastLabel);
|
|
_EmitCode(etn.ietn1, fsccNil, pvNil);
|
|
_PushOp(kopGoNz);
|
|
_EmitCode(etn.ietn3, grfscc & ~fsccTop, pvNil);
|
|
_PushLabelRequestLw(lw2 = ++_lwLastLabel);
|
|
_PushOp(kopGo);
|
|
_AddLabelLw(lw1);
|
|
_EmitCode(etn.ietn2, grfscc & ~fsccTop, pvNil);
|
|
_AddLabelLw(lw2);
|
|
break;
|
|
case ttLOr:
|
|
//logical or - handles short circuiting
|
|
if (!(grfscc & fsccWantVoid))
|
|
_PushLw(1); //assume true
|
|
_PushLabelRequestLw(lw1 = ++_lwLastLabel);
|
|
_EmitCode(etn.ietn1, fsccNil, pvNil);
|
|
_PushOp(kopGoNz);
|
|
if (!(grfscc & fsccWantVoid))
|
|
_PushLabelRequestLw(lw1);
|
|
_EmitCode(etn.ietn2, grfscc & ~fsccTop, pvNil);
|
|
if (!(grfscc & fsccWantVoid))
|
|
{
|
|
_PushOp(kopGoNz);
|
|
_PushOp(kopDec);
|
|
}
|
|
_AddLabelLw(lw1);
|
|
break;
|
|
case ttLAnd:
|
|
//logical and - handles short circuiting
|
|
if (!(grfscc & fsccWantVoid))
|
|
_PushLw(0); //assume false
|
|
_PushLabelRequestLw(lw1 = ++_lwLastLabel);
|
|
_EmitCode(etn.ietn1, fsccNil, pvNil);
|
|
_PushOp(kopGoZ);
|
|
if (!(grfscc & fsccWantVoid))
|
|
_PushLabelRequestLw(lw1);
|
|
_EmitCode(etn.ietn2, grfscc & ~fsccTop, pvNil);
|
|
if (!(grfscc & fsccWantVoid))
|
|
{
|
|
_PushOp(kopGoZ);
|
|
_PushOp(kopInc);
|
|
}
|
|
_AddLabelLw(lw1);
|
|
break;
|
|
}
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
If the etn is for a control structure, return the cst.
|
|
***************************************************************************/
|
|
long SCCB::_CstFromName(long ietn)
|
|
{
|
|
AssertThis(0);
|
|
long istn;
|
|
STN stn;
|
|
|
|
_GetIstnNameFromIetn(ietn, &istn);
|
|
_GetStnFromIstn(istn, &stn);
|
|
if (stn.FEqualSz(_rgpszKey[kipszIf]))
|
|
return cstIf;
|
|
if (stn.FEqualSz(_rgpszKey[kipszElif]))
|
|
return cstElif;
|
|
if (stn.FEqualSz(_rgpszKey[kipszWhile]))
|
|
return cstWhile;
|
|
|
|
return cstNil;
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Begin a new control structure.
|
|
***************************************************************************/
|
|
void SCCB::_BeginCst(long cst, long ietn)
|
|
{
|
|
AssertThis(0);
|
|
AssertPo(_pglcstd, 0);
|
|
CSTD cstd;
|
|
CSTD cstdPrev;
|
|
long cetn;
|
|
|
|
ClearPb(&cstd, size(cstd));
|
|
cstd.cst = cst;
|
|
cstd.lwLabel1 = ++_lwLastLabel;
|
|
switch (cst)
|
|
{
|
|
default:
|
|
Bug("why are we here?");
|
|
return;
|
|
|
|
case cstWhile:
|
|
// we do jump optimized loops (putting the conditional at the end).
|
|
// label 1 is where Continue jumps to
|
|
cstd.ietnTop = ietn;
|
|
if (ietn == ivNil)
|
|
{
|
|
// no conditional expression, an "infinite" loop
|
|
_AddLabelLw(cstd.lwLabel1);
|
|
}
|
|
else
|
|
{
|
|
// copy the etn tree
|
|
cetn = _pgletnTree->IvMac();
|
|
if (pvNil == (cstd.pgletnTree = GL::PglNew(size(ETN), cetn)))
|
|
{
|
|
_ReportError(_pszOom);
|
|
return;
|
|
}
|
|
AssertDo(cstd.pgletnTree->FSetIvMac(cetn), 0);
|
|
CopyPb(_pgletnTree->QvGet(0), cstd.pgletnTree->QvGet(0),
|
|
LwMul(cetn, size(ETN)));
|
|
|
|
// jump to where the condition will be
|
|
_PushLabelRequestLw(cstd.lwLabel1);
|
|
_PushOp(kopGo);
|
|
|
|
// add the label for the top of the loop
|
|
cstd.lwLabel2 = ++_lwLastLabel;
|
|
_AddLabelLw(cstd.lwLabel2);
|
|
}
|
|
break;
|
|
|
|
case cstIf:
|
|
// label 1 is used for where to jump if the condition fails
|
|
goto LTest;
|
|
|
|
case cstElif:
|
|
// label 1 is used for where to jump if the condition fails
|
|
// label 2 is used for the end of the entire if block
|
|
cstd.cst = cstIf;
|
|
if (_pglcstd->FPop(&cstdPrev))
|
|
{
|
|
if (cstdPrev.cst != cstIf)
|
|
{
|
|
_pglcstd->FPush(&cstdPrev);
|
|
goto LError;
|
|
}
|
|
}
|
|
else
|
|
{
|
|
LError:
|
|
_ReportError(PszLit("unexpected Elif"));
|
|
ClearPb(&cstdPrev, size(cstdPrev));
|
|
cstdPrev.cst = cstIf;
|
|
cstdPrev.lwLabel1 = ++_lwLastLabel;
|
|
}
|
|
|
|
// emit code for jumping to the end of the if block
|
|
cstd.lwLabel2 = cstdPrev.lwLabel2;
|
|
if (0 == cstd.lwLabel2)
|
|
cstd.lwLabel2 = ++_lwLastLabel;
|
|
_PushLabelRequestLw(cstd.lwLabel2);
|
|
_PushOp(kopGo);
|
|
|
|
// add label that previous condition jumps to on failure
|
|
_AddLabelLw(cstdPrev.lwLabel1);
|
|
|
|
LTest:
|
|
// emit code for the expression testing
|
|
_PushLabelRequestLw(cstd.lwLabel1);
|
|
if (ietn == ivNil)
|
|
_ReportError(_pszSyntax);
|
|
else
|
|
_EmitCode(ietn, fsccNil, pvNil);
|
|
_PushOp(kopGoZ);
|
|
break;
|
|
}
|
|
|
|
// put the cstd on the stack
|
|
if (!_pglcstd->FPush(&cstd))
|
|
_ReportError(_pszOom);
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
If this name token is "End", "Break", "Continue" or "Else", deal with it
|
|
and return true.
|
|
***************************************************************************/
|
|
bool SCCB::_FHandleCst(long ietn)
|
|
{
|
|
AssertThis(0);
|
|
AssertPo(_pglcstd, 0);
|
|
long istn;
|
|
STN stn;
|
|
CSTD cstd;
|
|
long icstd;
|
|
long *plwLabel;
|
|
|
|
_GetIstnNameFromIetn(ietn, &istn);
|
|
_GetStnFromIstn(istn, &stn);
|
|
if (stn.FEqualSz(_rgpszKey[kipszElse]))
|
|
{
|
|
// an Else
|
|
if (0 == (icstd = _pglcstd->IvMac()))
|
|
{
|
|
_ReportError(PszLit("unexpected Else"));
|
|
return fTrue;
|
|
}
|
|
_pglcstd->Get(--icstd, &cstd);
|
|
if (cstd.cst != cstIf)
|
|
{
|
|
_ReportError(PszLit("unexpected Else"));
|
|
return fTrue;
|
|
}
|
|
|
|
// emit code to jump to the end of the if block
|
|
if (0 == cstd.lwLabel2)
|
|
cstd.lwLabel2 = ++_lwLastLabel;
|
|
_PushLabelRequestLw(cstd.lwLabel2);
|
|
_PushOp(kopGo);
|
|
|
|
// add label that previous condition jumps to on failure
|
|
_AddLabelLw(cstd.lwLabel1);
|
|
|
|
cstd.cst = cstNil; // so we don't accept another else
|
|
cstd.lwLabel1 = cstd.lwLabel2;
|
|
_pglcstd->Put(icstd, &cstd);
|
|
return fTrue;
|
|
}
|
|
|
|
if (stn.FEqualSz(_rgpszKey[kipszBreak]))
|
|
{
|
|
// a Break - label 3 is where a Break jumps to
|
|
plwLabel = &cstd.lwLabel3;
|
|
goto LWhileJump;
|
|
}
|
|
|
|
if (stn.FEqualSz(_rgpszKey[kipszContinue]))
|
|
{
|
|
// a Continue - label 1 is where a Continue jumps to
|
|
plwLabel = &cstd.lwLabel1;
|
|
|
|
LWhileJump:
|
|
// find the enclosing While
|
|
for (icstd = _pglcstd->IvMac(); ; )
|
|
{
|
|
if (icstd-- <= 0)
|
|
{
|
|
_ReportError(plwLabel == &cstd.lwLabel1 ?
|
|
PszLit("unexpected Continue") :
|
|
PszLit("unexpected Break"));
|
|
return fTrue;
|
|
}
|
|
_pglcstd->Get(icstd, &cstd);
|
|
if (cstd.cst == cstWhile)
|
|
break;
|
|
}
|
|
|
|
if (*plwLabel == 0)
|
|
{
|
|
Assert(plwLabel == &cstd.lwLabel3, 0);
|
|
*plwLabel = ++_lwLastLabel;
|
|
_pglcstd->Put(icstd, &cstd);
|
|
}
|
|
_PushLabelRequestLw(*plwLabel);
|
|
_PushOp(kopGo);
|
|
return fTrue;
|
|
}
|
|
|
|
if (stn.FEqualSz(_rgpszKey[kipszEnd]))
|
|
{
|
|
// an End
|
|
if (!_pglcstd->FPop(&cstd))
|
|
{
|
|
_ReportError(PszLit("unexpected End"));
|
|
return fTrue;
|
|
}
|
|
|
|
switch (cstd.cst)
|
|
{
|
|
case cstWhile:
|
|
if (cstd.ietnTop == ivNil)
|
|
{
|
|
// an "infinite" loop - jump to the top
|
|
Assert(cstd.pgletnTree == pvNil, 0);
|
|
Assert(cstd.lwLabel2 == 0, 0);
|
|
_PushLabelRequestLw(cstd.lwLabel1);
|
|
_PushOp(kopGo);
|
|
}
|
|
else
|
|
{
|
|
AssertPo(cstd.pgletnTree, 0);
|
|
_AddLabelLw(cstd.lwLabel1);
|
|
|
|
// emit code for the expression testing
|
|
_PushLabelRequestLw(cstd.lwLabel2);
|
|
SwapVars(&_pgletnTree, &cstd.pgletnTree);
|
|
_EmitCode(cstd.ietnTop, fsccNil, pvNil);
|
|
SwapVars(&_pgletnTree, &cstd.pgletnTree);
|
|
ReleasePpo(&cstd.pgletnTree);
|
|
_PushOp(kopGoNz);
|
|
}
|
|
|
|
// add the Break label if it was used
|
|
if (cstd.lwLabel3 != 0)
|
|
_AddLabelLw(cstd.lwLabel3);
|
|
break;
|
|
|
|
case cstIf:
|
|
if (cstd.lwLabel2 != 0)
|
|
_AddLabelLw(cstd.lwLabel2);
|
|
_AddLabelLw(cstd.lwLabel1);
|
|
break;
|
|
|
|
default:
|
|
Assert(cstd.cst == cstNil, "bad cstd");
|
|
_AddLabelLw(cstd.lwLabel1);
|
|
break;
|
|
}
|
|
|
|
return fTrue;
|
|
}
|
|
|
|
return fFalse;
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Generate the code that handles remote variable access and fill
|
|
*popPush and *popPop with the appropriate op-codes (kopPushLocVar, etc).
|
|
Sets *pclwStack to the number of longs on the stack used to access the
|
|
variable (iff the variable is a remote variable or an array access).
|
|
Fills in *prtvn.
|
|
***************************************************************************/
|
|
void SCCB::_EmitVarAccess(long ietn, RTVN *prtvn,
|
|
long *popPush, long *popPop, long *pclwStack)
|
|
{
|
|
AssertThis(0);
|
|
AssertPo(_pgletnTree, 0);
|
|
AssertIn(ietn, 0, _pgletnTree->IvMac());
|
|
AssertVarMem(prtvn);
|
|
AssertNilOrVarMem(popPush);
|
|
AssertNilOrVarMem(popPop);
|
|
AssertNilOrVarMem(pclwStack);
|
|
ETN etn;
|
|
long opPop, opPush;
|
|
long clwStack = 0;
|
|
|
|
_pgletnTree->Get(ietn, &etn);
|
|
switch (etn.tt)
|
|
{
|
|
default:
|
|
opPop = kopPopLocVar;
|
|
opPush = kopPushLocVar;
|
|
break;
|
|
|
|
case ttDot:
|
|
Assert(etn.opl == koplThisName, "bad this name etn");
|
|
Assert(etn.ietn1 != ivNil && etn.ietn2 == ivNil, "bad this name etn 2");
|
|
ietn = etn.ietn1;
|
|
opPop = kopPopThisVar;
|
|
opPush = kopPushThisVar;
|
|
break;
|
|
|
|
case ttScope:
|
|
Assert(etn.opl == koplGlobalName, "bad global name etn");
|
|
Assert(etn.ietn1 != ivNil && etn.ietn2 == ivNil, "bad global name etn 2");
|
|
ietn = etn.ietn1;
|
|
opPop = kopPopGlobalVar;
|
|
opPush = kopPushGlobalVar;
|
|
break;
|
|
|
|
case ttArrow:
|
|
Assert(etn.opl == koplRemoteName, "bad remote name etn");
|
|
Assert(etn.ietn1 != ivNil && etn.ietn2 != ivNil && etn.ietn3 == ivNil,
|
|
"bad remote name etn 2");
|
|
_EmitCode(etn.ietn1, fsccNil, pvNil);
|
|
clwStack++;
|
|
ietn = etn.ietn2;
|
|
opPop = kopPopRemoteVar;
|
|
opPush = kopPushRemoteVar;
|
|
break;
|
|
}
|
|
|
|
_pgletnTree->Get(ietn, &etn);
|
|
if (etn.tt == ttCloseRef)
|
|
{
|
|
// an array reference
|
|
Assert(etn.opl == koplArrayName, "bad array name etn");
|
|
Assert(etn.ietn1 != ivNil && etn.ietn2 != ivNil && etn.ietn3 == ivNil,
|
|
"bad array name etn 2");
|
|
_EmitCode(etn.ietn2, fsccNil, pvNil);
|
|
clwStack++;
|
|
ietn = etn.ietn1;
|
|
opPop += kopPopLocArray - kopPopLocVar;
|
|
opPush += kopPushLocArray - kopPushLocVar;
|
|
}
|
|
|
|
_GetIstnNameFromIetn(ietn, &etn.lwValue);
|
|
_GetRtvnFromName(etn.lwValue, prtvn);
|
|
|
|
if (pvNil != pclwStack)
|
|
*pclwStack = clwStack;
|
|
if (pvNil != popPush)
|
|
*popPush = opPush;
|
|
if (pvNil != popPop)
|
|
*popPop = opPop;
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Push the opcode for a function and verify parameters and return type.
|
|
***************************************************************************/
|
|
void SCCB::_PushOpFromName(long ietn, ulong grfscc, long clwArg)
|
|
{
|
|
AssertThis(0);
|
|
long istn;
|
|
STN stn;
|
|
long op, clwFixed, clwVar, cactMinVar;
|
|
bool fVoid;
|
|
|
|
_GetIstnNameFromIetn(ietn, &istn);
|
|
_GetStnFromIstn(istn, &stn);
|
|
if (!_FGetOpFromName(&stn, &op, &clwFixed, &clwVar, &cactMinVar, &fVoid))
|
|
_ReportError(PszLit("unknown function"));
|
|
else if (clwArg < clwFixed || clwVar == 0 && clwArg > clwFixed ||
|
|
clwVar != 0 && (((clwArg - clwFixed) % clwVar) != 0 ||
|
|
(clwArg - clwFixed) / clwVar < cactMinVar))
|
|
{
|
|
_ReportError(PszLit("Wrong number of parameters"));
|
|
}
|
|
else if (!(grfscc & fsccWantVoid) && fVoid)
|
|
_ReportError(PszLit("Using void return value"));
|
|
else
|
|
{
|
|
if (clwVar > 0)
|
|
_PushLw((clwArg - clwFixed) / clwVar);
|
|
_PushOp(op);
|
|
if ((grfscc & fsccWantVoid) && !fVoid)
|
|
_PushOp(kopPop); //toss the return value
|
|
}
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Find the string in the given rgarop and get the associated parameter
|
|
and return type information.
|
|
***************************************************************************/
|
|
bool SCCB::_FGetArop(PSTN pstn, AROP *prgarop, long *pop, long *pclwFixed,
|
|
long *pclwVar, long *pcactMinVar, bool *pfVoid)
|
|
{
|
|
AssertThis(0);
|
|
AssertPo(pstn, 0);
|
|
AssertVarMem(prgarop);
|
|
AssertVarMem(pop);
|
|
AssertVarMem(pclwFixed);
|
|
AssertVarMem(pclwVar);
|
|
AssertVarMem(pcactMinVar);
|
|
AssertVarMem(pfVoid);
|
|
AROP *parop;
|
|
|
|
for (parop = prgarop; parop->psz != pvNil; parop++)
|
|
{
|
|
if (pstn->FEqualSz(parop->psz))
|
|
{
|
|
*pop = parop->op;
|
|
*pclwFixed = parop->clwFixed;
|
|
*pclwVar = parop->clwVar;
|
|
*pcactMinVar = parop->cactMinVar;
|
|
*pfVoid = parop->fVoid;
|
|
return fTrue;
|
|
}
|
|
}
|
|
return fFalse;
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
See if the given name is a function and give argument and return type
|
|
information.
|
|
***************************************************************************/
|
|
bool SCCB::_FGetOpFromName(PSTN pstn, long *pop, long *pclwFixed,
|
|
long *pclwVar, long *pcactMinVar, bool *pfVoid)
|
|
{
|
|
AssertThis(0);
|
|
return _FGetArop(pstn, _rgarop, pop, pclwFixed, pclwVar, pcactMinVar, pfVoid);
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Add the given string to _pgstNames.
|
|
***************************************************************************/
|
|
void SCCB::_AddNameRef(PSTN pstn, long *pistn)
|
|
{
|
|
AssertThis(0);
|
|
AssertPo(pstn, 0);
|
|
AssertVarMem(pistn);
|
|
|
|
if (pvNil == _pgstNames && pvNil == (_pgstNames = GST::PgstNew(0, 5, 100)))
|
|
{
|
|
*pistn = 0;
|
|
_ReportError(_pszOom);
|
|
return;
|
|
}
|
|
//can't sort, because then indices can change
|
|
if (_pgstNames->FFindStn(pstn, pistn, fgstNil))
|
|
return;
|
|
if (!_pgstNames->FInsertStn(*pistn, pstn))
|
|
_ReportError(_pszOom);
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Make sure (assert) the given ietn is a name and get the istn for the name.
|
|
***************************************************************************/
|
|
void SCCB::_GetIstnNameFromIetn(long ietn, long *pistn)
|
|
{
|
|
AssertThis(0);
|
|
AssertPo(_pgletnTree, 0);
|
|
AssertIn(ietn, 0, _pgletnTree->IvMac());
|
|
AssertVarMem(pistn);
|
|
ETN etn;
|
|
|
|
_pgletnTree->Get(ietn, &etn);
|
|
Assert(etn.tt == ttName && etn.opl == koplName && etn.op == opNil &&
|
|
etn.ietn1 == ivNil && etn.ietn2 == ivNil && etn.ietn3 == ivNil,
|
|
"bad name etn");
|
|
*pistn = etn.lwValue;
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Get the rtvn for the given string (in _pgstNames).
|
|
***************************************************************************/
|
|
void SCCB::_GetStnFromIstn(long istn, PSTN pstn)
|
|
{
|
|
AssertThis(0);
|
|
AssertPo(pstn, 0);
|
|
|
|
if (pvNil == _pgstNames || !FIn(istn, 0, _pgstNames->IstnMac()))
|
|
{
|
|
Assert(_fError, "bad istn");
|
|
pstn->SetNil();
|
|
return;
|
|
}
|
|
_pgstNames->GetStn(istn, pstn);
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Get the rtvn for the given string (in _pgstNames).
|
|
***************************************************************************/
|
|
void SCCB::_GetRtvnFromName(long istn, RTVN *prtvn)
|
|
{
|
|
AssertThis(0);
|
|
AssertVarMem(prtvn);
|
|
STN stn;
|
|
|
|
_GetStnFromIstn(istn, &stn);
|
|
if (_FKeyWord(&stn))
|
|
_ReportError(PszLit("Using keyword as variable"));
|
|
prtvn->SetFromStn(&stn);
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Determine if the given string is a keyword.
|
|
***************************************************************************/
|
|
bool SCCB::_FKeyWord(PSTN pstn)
|
|
{
|
|
AssertThis(0);
|
|
AssertPo(pstn, 0);
|
|
long op, clwFixed, clwVar, cactMinVar;
|
|
bool fVoid;
|
|
long ipsz;
|
|
|
|
if (_FGetOpFromName(pstn, &op, &clwFixed, &clwVar, &cactMinVar, &fVoid))
|
|
return fTrue;
|
|
for (ipsz = CvFromRgv(_rgpszKey); ipsz-- > 0; )
|
|
{
|
|
if (pstn->FEqualSz(_rgpszKey[ipsz]))
|
|
return fTrue;
|
|
}
|
|
|
|
return fFalse;
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Push a label request using the name in the given ietn.
|
|
***************************************************************************/
|
|
void SCCB::_PushLabelRequestIetn(long ietn)
|
|
{
|
|
AssertThis(0);
|
|
long istn;
|
|
STN stn;
|
|
|
|
_GetIstnNameFromIetn(ietn, &istn);
|
|
_GetStnFromIstn(istn, &stn);
|
|
_PushLabelRequest(&stn);
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Add the label here.
|
|
***************************************************************************/
|
|
void SCCB::_AddLabelIetn(long ietn)
|
|
{
|
|
AssertThis(0);
|
|
long istn;
|
|
STN stn;
|
|
|
|
_GetIstnNameFromIetn(ietn, &istn);
|
|
_GetStnFromIstn(istn, &stn);
|
|
_AddLabel(&stn);
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
"Push" a string constant that is currently in the name string table.
|
|
***************************************************************************/
|
|
void SCCB::_PushStringIstn(long istn)
|
|
{
|
|
AssertThis(0);
|
|
STN stn;
|
|
|
|
_GetStnFromIstn(istn, &stn);
|
|
_PushString(&stn);
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Compile the in-fix script source.
|
|
***************************************************************************/
|
|
void SCCB::_CompileIn(void)
|
|
{
|
|
AssertThis(0);
|
|
AssertPo(_plexb, 0);
|
|
AssertPo(_pgletnStack, 0);
|
|
AssertPo(_pgletnTree, 0);
|
|
TOK tok;
|
|
TOME *ptome;
|
|
ETN etn, etnT;
|
|
long ietn;
|
|
bool fDone;
|
|
|
|
// push the new record
|
|
ClearPb(&etn, size(etn));
|
|
etn.tt = ttNil;
|
|
etn.grfop = fopOp;
|
|
if (!_pgletnStack->FPush(&etn))
|
|
{
|
|
_ReportError(_pszOom);
|
|
return;
|
|
}
|
|
|
|
for (;;)
|
|
{
|
|
fDone = !_FGetTok(&tok);
|
|
if (fDone || tok.tt == ttSemi)
|
|
{
|
|
// end of a statement - emit the code
|
|
if (_pgletnStack->IvMac() > 1)
|
|
{
|
|
//non-empty statement
|
|
if (!_FResolveToOpl(koplComma, koplComma, &ietn))
|
|
{
|
|
Assert(_fError, "why wasn't an error reported?");
|
|
_pgletnStack->FSetIvMac(1);
|
|
}
|
|
else if (_pgletnStack->IvMac() != 1)
|
|
{
|
|
_ReportError(_pszSyntax);
|
|
_pgletnStack->FSetIvMac(1);
|
|
}
|
|
else
|
|
_EmitCode(ietn, fsccTop | fsccWantVoid, pvNil);
|
|
}
|
|
_pgletnTree->FSetIvMac(0);
|
|
if (fDone)
|
|
{
|
|
_EndOp();
|
|
if (_pglcstd->IvMac() != 0)
|
|
_ReportError(PszLit("unexpected end of source"));
|
|
break;
|
|
}
|
|
continue;
|
|
}
|
|
|
|
_pgletnStack->Get(_pgletnStack->IvMac() - 1, &etn);
|
|
ptome = _PtomeFromTt(tok.tt, etn.grfop & fopOp);
|
|
if (pvNil == ptome)
|
|
{
|
|
_ReportError(_pszSyntax);
|
|
goto LNextLine;
|
|
}
|
|
|
|
ClearPb(&etn, size(etn));
|
|
etn.tt = (short)tok.tt;
|
|
etn.lwValue = tok.lw;
|
|
etn.op = ptome->op;
|
|
etn.opl = ptome->oplPush;
|
|
etn.grfop = ptome->grfop;
|
|
etn.ietn1 = etn.ietn2 = etn.ietn3 = ivNil;
|
|
if (tok.tt == ttName || tok.tt == ttString)
|
|
_AddNameRef(&tok.stn, &etn.lwValue);
|
|
|
|
// resolve
|
|
if (oplNil != ptome->oplResolve)
|
|
{
|
|
if (!_FResolveToOpl(ptome->oplResolve, ptome->oplMinRes, &etn.ietn1))
|
|
{
|
|
Assert(_fError, "error not set");
|
|
goto LNextLine;
|
|
}
|
|
}
|
|
|
|
// pop an operator
|
|
if (ttNil != ptome->ttPop)
|
|
{
|
|
if (!_pgletnStack->FPop(&etnT) || etnT.tt != ptome->ttPop ||
|
|
!(etnT.grfop & fopOp))
|
|
{
|
|
_ReportError(_pszSyntax);
|
|
goto LNextLine;
|
|
}
|
|
Assert(etnT.ietn2 == ivNil, "bad etn");
|
|
if (etnT.ietn1 != ivNil)
|
|
{
|
|
etn.ietn2 = etn.ietn1;
|
|
etn.ietn1 = etnT.ietn1;
|
|
if (etnT.grfop & fopFunction)
|
|
etn.grfop |= fopFunction;
|
|
}
|
|
}
|
|
|
|
// push the new record
|
|
if (!_pgletnStack->FPush(&etn))
|
|
{
|
|
_ReportError(_pszOom);
|
|
goto LNextLine;
|
|
}
|
|
|
|
if (tok.tt == ttAt)
|
|
{
|
|
// label declaration - emit the code
|
|
if (!_FResolveToOpl(koplComma, koplComma, &ietn))
|
|
{
|
|
Assert(_fError, "error not set");
|
|
goto LNextLine;
|
|
}
|
|
if (_pgletnStack->IvMac() != 1)
|
|
{
|
|
_ReportError(_pszSyntax);
|
|
LNextLine:
|
|
//start parsing after the next semi-colon
|
|
while (_FGetTok(&tok) && tok.tt != ttSemi)
|
|
;
|
|
_pgletnStack->FSetIvMac(1);
|
|
}
|
|
else
|
|
_EmitCode(ietn, fsccTop | fsccWantVoid, pvNil);
|
|
_pgletnTree->FSetIvMac(0);
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Disassemble the script into a message sink (MSNK) and return whether
|
|
there was an error.
|
|
***************************************************************************/
|
|
bool SCCB::FDisassemble(PSCPT pscpt, PMSNK pmsnk, PMSNK pmsnkError)
|
|
{
|
|
AssertThis(0);
|
|
AssertPo(pscpt, 0);
|
|
AssertPo(pmsnk, 0);
|
|
AssertPo(pmsnkError, 0);
|
|
RTVN rtvn;
|
|
long ilwMac, ilw, clwPush;
|
|
long lw;
|
|
long op;
|
|
STN stn;
|
|
DVER dver;
|
|
PGL pgllw = pscpt->_pgllw;
|
|
PSZ pszError = pvNil;
|
|
AssertPo(pgllw, 0);
|
|
Assert(pgllw->CbEntry() == size(long), "bad script");
|
|
|
|
ilwMac = pgllw->IvMac();
|
|
if (ilwMac < 1)
|
|
{
|
|
pszError = PszLit("No version numbers on script");
|
|
goto LFail;
|
|
}
|
|
|
|
//check the version
|
|
pgllw->Get(0, &lw);
|
|
dver.Set(SwHigh(lw), SwLow(lw));
|
|
if (!dver.FReadable(_SwCur(), _SwMin()))
|
|
{
|
|
pszError = PszLit("Script version doesn't match script compiler version");
|
|
goto LFail;
|
|
}
|
|
|
|
for (ilw = 1; ; )
|
|
{
|
|
//write the label
|
|
stn.FFormatSz(PszLit("@L_%04x "), ilw);
|
|
pmsnk->Report(stn.Psz());
|
|
if (ilw >= ilwMac)
|
|
break;
|
|
|
|
pgllw->Get(ilw++, &lw);
|
|
clwPush = B2Lw(lw);
|
|
if (!FIn(clwPush, 0, ilwMac - ilw + 1))
|
|
{
|
|
pszError = PszLit("bad instruction");
|
|
goto LFail;
|
|
}
|
|
|
|
//write the op string
|
|
if (opNil != (op = B3Lw(lw)))
|
|
{
|
|
//this instruction acts on a variable
|
|
if (clwPush == 0)
|
|
{
|
|
pszError = PszLit("bad var instruction");
|
|
goto LFail;
|
|
}
|
|
clwPush--;
|
|
rtvn.lu1 = (ulong)SuLow(lw);
|
|
pgllw->Get(ilw++, &rtvn.lu2);
|
|
if (rtvn.lu1 == 0)
|
|
{
|
|
if (op != kopPushLocVar)
|
|
{
|
|
pszError = PszLit("bad variable");
|
|
goto LFail;
|
|
}
|
|
|
|
// string literal
|
|
if (pvNil == pscpt->_pgstLiterals ||
|
|
!FIn(rtvn.lu2, 0, pscpt->_pgstLiterals->IvMac()))
|
|
{
|
|
pszError = PszLit("bad internal variable");
|
|
goto LFail;
|
|
}
|
|
pscpt->_pgstLiterals->GetStn(rtvn.lu2, &stn);
|
|
stn.FExpandControls();
|
|
pmsnk->Report(PszLit("\""));
|
|
pmsnk->Report(stn.Psz());
|
|
pmsnk->Report(PszLit("\" "));
|
|
}
|
|
else
|
|
{
|
|
bool fArray = fFalse;
|
|
|
|
if (FIn(op, kopMinArray, kopLimArray))
|
|
{
|
|
op += kopPushLocVar - kopPushLocArray;
|
|
fArray = fTrue;
|
|
}
|
|
|
|
stn.SetNil();
|
|
switch (op)
|
|
{
|
|
case kopPushLocVar:
|
|
stn.FAppendCh(ChLit('<'));
|
|
break;
|
|
case kopPopLocVar:
|
|
stn.FAppendCh(ChLit('>'));
|
|
break;
|
|
case kopPushThisVar:
|
|
stn.FAppendSz(PszLit("<."));
|
|
break;
|
|
case kopPopThisVar:
|
|
stn.FAppendSz(PszLit(">."));
|
|
break;
|
|
case kopPushGlobalVar:
|
|
stn.FAppendSz(PszLit("<::"));
|
|
break;
|
|
case kopPopGlobalVar:
|
|
stn.FAppendSz(PszLit(">::"));
|
|
break;
|
|
case kopPushRemoteVar:
|
|
stn.FAppendSz(PszLit("<~"));
|
|
break;
|
|
case kopPopRemoteVar:
|
|
stn.FAppendSz(PszLit(">~"));
|
|
break;
|
|
default:
|
|
pszError = PszLit("bad var op");
|
|
goto LFail;
|
|
}
|
|
if (fArray)
|
|
stn.FAppendCh(ChLit('&'));
|
|
pmsnk->Report(stn.Psz());
|
|
|
|
rtvn.GetStn(&stn);
|
|
stn.FAppendCh(kchSpace);
|
|
pmsnk->Report(stn.Psz());
|
|
}
|
|
}
|
|
else if (opNil != (op = SuLow(lw)))
|
|
{
|
|
//normal opcode
|
|
if (!_FGetStnFromOp(op, &stn))
|
|
{
|
|
pszError = PszLit("bad op in script");
|
|
LFail:
|
|
if (pmsnkError != pvNil && pszError != pvNil)
|
|
pmsnkError->ReportLine(pszError);
|
|
return fFalse;
|
|
}
|
|
stn.FAppendCh(kchSpace);
|
|
pmsnk->Report(stn.Psz());
|
|
}
|
|
|
|
//dump the stack stuff
|
|
while (clwPush-- > 0)
|
|
{
|
|
pgllw->Get(ilw++, &lw);
|
|
if (B3Lw(lw) == kbLabel && FIn(lw &= 0x00FFFFFF, 1, ilwMac + 1))
|
|
{
|
|
//REVIEW shonk: label identification: this isn't foolproof
|
|
stn.FFormatSz(PszLit("$L_%04x "), lw);
|
|
pmsnk->Report(stn.Psz());
|
|
}
|
|
else
|
|
{
|
|
stn.FFormatSz(PszLit("%d /*0x%x*/ "), lw, lw);
|
|
pmsnk->Report(stn.Psz());
|
|
}
|
|
}
|
|
pmsnk->ReportLine(PszLit(""));
|
|
}
|
|
pmsnk->ReportLine(PszLit(""));
|
|
|
|
return fTrue;
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Set the values of the RTVN from the given stn. Only the first 8
|
|
characters of the stn are significant. The high word of lu1 is
|
|
guaranteed to be zero.
|
|
***************************************************************************/
|
|
void RTVN::SetFromStn(PSTN pstn)
|
|
{
|
|
AssertThisMem();
|
|
AssertPo(pstn, 0);
|
|
byte rgb[8];
|
|
byte bT;
|
|
long lw, ib, ibDst, cbit;
|
|
long cch = pstn->Cch();
|
|
PSZ psz = pstn->Psz();
|
|
|
|
// There are 52 letters, plus 10 digits, plus the underscore character,
|
|
// giving a total of 63 valid identifier characters. We encode these
|
|
// from 1 to 63 and pack them into 6 bits each. This lets us put 8
|
|
// characters in 6 bytes. We pad the result with 0's.
|
|
|
|
ClearPb(rgb, 8);
|
|
ibDst = 0;
|
|
cbit = 8;
|
|
for (ib = 0; ib < 8; ib++)
|
|
{
|
|
// map the character to its encoded value
|
|
if (ib >= cch)
|
|
bT = 0;
|
|
else
|
|
{
|
|
bT = (byte)(schar)psz[ib];
|
|
if (FIn(bT, '0', '9' + 1))
|
|
bT -= '0' - 1;
|
|
else if (FIn(bT, 'A', 'Z' + 1))
|
|
bT -= 'A' - 11;
|
|
else if (FIn(bT, 'a', 'z' + 1))
|
|
bT -= 'a' - 37;
|
|
else
|
|
{
|
|
Assert(bT == '_', "bad identifier");
|
|
bT = 63;
|
|
}
|
|
}
|
|
|
|
// pack the encoded value into its 6 bit slot
|
|
AssertIn(bT, 0, 64);
|
|
lw = (long)bT << (cbit + 2);
|
|
rgb[ibDst] = rgb[ibDst] & (-1L << cbit) | B1Lw(lw);
|
|
if ((cbit += 2) <= 8)
|
|
rgb[++ibDst] = B0Lw(lw);
|
|
else
|
|
cbit -= 8;
|
|
}
|
|
|
|
// put the bytes together into the rtvn's ulongs.
|
|
lu1 = LwFromBytes(0, 0, rgb[0], rgb[1]);
|
|
lu2 = LwFromBytes(rgb[2], rgb[3], rgb[4], rgb[5]);
|
|
}
|
|
|
|
|
|
/***************************************************************************
|
|
Get the variable name that an rtvn stores.
|
|
***************************************************************************/
|
|
void RTVN::GetStn(PSTN pstn)
|
|
{
|
|
AssertThisMem();
|
|
AssertPo(pstn, 0);
|
|
byte rgb[8];
|
|
byte bT;
|
|
long ib;
|
|
|
|
//unpack the individual bytes
|
|
rgb[0] = (byte)((lu1 & 0x0000FC00) >> 10);
|
|
rgb[1] = (byte)((lu1 & 0x000003F0) >> 4);
|
|
rgb[2] = (byte)(((lu1 & 0x0000000F) << 2) | ((lu2 & 0xC0000000) >> 30));
|
|
rgb[3] = (byte)((lu2 & 0x3F000000) >> 24);
|
|
rgb[4] = (byte)((lu2 & 0x00FC0000) >> 18);
|
|
rgb[5] = (byte)((lu2 & 0x0003F000) >> 12);
|
|
rgb[6] = (byte)((lu2 & 0x00000FC0) >> 6);
|
|
rgb[7] = (byte)(lu2 & 0x0000003F);
|
|
|
|
//convert the bytes to characters and append them to the stn
|
|
pstn->SetNil();
|
|
for (ib = 0; ib < 8; ib++)
|
|
{
|
|
bT = rgb[ib];
|
|
if (bT == 0)
|
|
break;
|
|
if (FIn(bT, 1, 11))
|
|
bT += '0' - 1;
|
|
else if (FIn(bT, 11, 37))
|
|
bT += 'A' - 11;
|
|
else if (FIn(bT, 37, 63))
|
|
bT += 'a' - 37;
|
|
else
|
|
{
|
|
Assert(bT == 63, 0);
|
|
bT = '_';
|
|
}
|
|
pstn->FAppendCh((achar)bT);
|
|
}
|
|
|
|
if (lu1 & 0xFFFF0000)
|
|
{
|
|
STN stn;
|
|
|
|
stn.FFormatSz(PszLit("[%d]"), SuHigh(lu1));
|
|
pstn->FAppendStn(&stn);
|
|
}
|
|
}
|
|
|