HIVE
/
TriOS-alt
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
TriOS-alt/zubehör/sphinx/spinx100225-ori/sphinx2/methods.spn

1172 lines
39 KiB
Plaintext
Raw Normal View History

2010-11-26 23:58:06 +01:00
' 2010-01-25 fix for outa[x..y] := z
obj
bt : "bintree"
st : "symbols"
kw : "kwdefs"
eval : "eval"
token : "tokenrdr"
var
long pLocalSymbols
byte repeatDepth ' nested REPEAT depth. 0 => at top level
word pStringWork
word pObjSpace
word pObjWork
word pObjTop
pub get_pObjSpace
return pObjSpace
pub set_pObjSpace( p )
pObjSpace := p
pub get_pObjWork
return pObjWork
pub set_pObjWork( p )
pObjWork := p
pub get_pObjTop
return pObjTop
pub set_pObjTop( p )
pObjTop := p
pub Parse2( type ) | pSym, pHeaderEntry, dim, localOffset, addedResult
{{
Second pass processing of PRI and PUB methods.
}}
pLocalSymbols := bt.Alloc( 2 ) ' Local symbol table space will be freed at the end of this method
bt.PokeW( pLocalSymbols, 0 )
pStringWork := pObjTop ' temp string storage starts at high end of memory
pSym := st.SymbolLookup( token.Text )
pHeaderEntry := pObjSpace + byte[pSym][1] << 2 ' method index * 4
token.Advance ' past method name
localOffset := 4 ' LOC+0 is RESULT, LOC+4, +8, +12... are params, beyond that are locals
' parse parameter names
if token.AdvanceIf( kw#kLPAREN )
repeat
ifnot token.IsId
abort string("Expected ID")
if st.SymbolLookup( token.Text )
abort string("Expected unique parameter name")
bt.AddToTable( token.Text, pLocalSymbols )
bt.PokeW( bt.Alloc(2), localOffset )
localOffset += 4
token.Advance
while token.AdvanceIf( kw#kCOMMA )
token.Eat( kw#kRPAREN )
' parse return value
addedResult~
if token.AdvanceIf( kw#kCOLON )
ifnot token.IsId or token.Type == kw#kRESULT
abort string("Expected ID")
if st.SymbolLookup( token.Text )
abort string("Expected unique result name")
bt.AddToTable( token.Text, pLocalSymbols )
bt.PokeW( bt.Alloc(2), 0 )
addedResult := token.Type == kw#kRESULT
token.Advance
ifnot addedResult
bt.AddToTable( string("RESULT"), pLocalSymbols )
bt.PokeW( bt.Alloc(2), 0 )
' parse local variables
if token.AdvanceIf( kw#kBAR )
ifnot token.IsId
abort string("Expected ID")
repeat
if st.SymbolLookup( token.Text )
abort string("Expected unique variable name")
bt.AddToTable( token.Text, pLocalSymbols )
bt.PokeW( bt.Alloc(2), localOffset )
token.Advance
if token.AdvanceIf( kw#kLBRACKET )
dim := Eval.EvaluateExpression( 0 )
token.Eat( kw#kRBRACKET )
else
dim := 1
localOffset += dim << 2
while token.AdvanceIf( kw#kCOMMA )
token.Eat( kw#kEOL )
word[pHeaderEntry][0] := pObjWork - pObjSpace
' Now store size of locals in header.
word[pHeaderEntry][1] := localOffset - (byte[pSym][2] + 1) << 2
''' DumpLocals( bt.PeekW( pLocalSymbols ) )'''
repeatDepth~
pFloatingReferences~
CompileStatements( -1 )
Emit( $32 ) ' RETURN
StringCleanup
ResolveFloatingReferences
bt.Alloc( pLocalSymbols - bt.Alloc(0) ) ' hack to free local symbol table memory
' should be fine as long as no permanent allocations were made
pri CompileStatements( col ) | p, op, nArgs
repeat until token.IsBlockDesignator or token.Type == kw#kEOF or token.Column =< col
if token.Type == kw#kIF or token.Type == kw#kIFNOT
CompileIf
elseif token.Type == kw#kREPEAT
CompileRepeat
elseif token.Type == kw#kCASE
CompileCase
elseif token.AdvanceIf( kw#kRETURN )
if token.Type == kw#kEOL
Emit( $32 ) ' RETURN
else
CompileExpression( 13, true, false )
Emit( $33 ) ' RETVAL
token.Eat( kw#kEOL )
elseif token.AdvanceIf( kw#kABORT )
if token.Type == kw#kEOL
Emit( $30 ) ' ABORT
else
CompileExpression( 13, true, false )
Emit( $31 ) ' ABOVAL
token.Eat( kw#kEOL )
elseif token.AdvanceIf( kw#kNEXT )
NextQuitHelper( nextDest )
elseif token.AdvanceIf( kw#kQUIT )
NextQuitHelper( quitDest )
elseif token.IsStmtFn
op := token.GetSpinOpcode
nArgs := token.GetNumArgs
token.Advance
CompileArgs( nArgs )
Emit( op )
token.Eat( kw#kEOL )
elseifnot token.AdvanceIf( kw#kEOL )
CompileExpression( 13, false, false )
token.Eat( kw#kEOL )
pri NextQuitHelper( dest )
ifnot repeatDepth
abort string("No enclosing REPEAT")
if caseNesting
EmitPushInt( caseNesting << 3 )
Emit( $14 ) ' mystery op
Emit( $04 ) ' GOTO
MakeFloatingReference( pObjWork, dest )
Emit( $80 ) ' placeholder
Emit( $00 )
token.Eat( kw#kEOL )
pri CompileIf | col, jumpOp, pIfJump, pElseJump
{{
Current token is IF, IFNOT, ELSEIF, or ELSEIFNOT.
}}
col := token.Column
if token.Type == kw#kIF or token.Type == kw#kELSEIF
jumpOp := $0a ' JPF
else
jumpOp := $0b ' JPT
token.Advance
CompileExpression( 13, true, false )
pIfJump := MakeForwardJump( jumpOp )
token.Eat( kw#kEOL )
CompileStatements( col )
if token.Column == col
if token.AdvanceIf( kw#kELSE )
pElseJump := MakeForwardJump( $04 ) ' GOTO
ResolveForwardJump( pIfJump )
token.Eat( kw#kEOL )
CompileStatements( col )
ResolveForwardJump( pElseJump )
return
if token.Type == kw#kELSEIF or token.Type == kw#kELSEIFNOT
pElseJump := MakeForwardJump( $04 ) ' GOTO
ResolveForwardJump( pIfJump )
CompileIf
ResolveForwardJump( pElseJump )
return
ResolveForwardJump( pIfJump )
pri MakeForwardJump( jumpOp )
{{
Emits jump instruction with 2-byte jump offset to be filled in by a subsequent call to ResolveJump.
Returns a pointer to the jump instruction; pass this pointer to ResolveJump.
}}
result := pObjWork
Emit( jumpOp )
Emit( $00 )
Emit( $00 )
pri ResolveForwardJump( pJump ) | d, p
{{
Resolves the jump instruction at pJump. If that instruction is part of a linked list
of jumps (as in a bunch of QUIT jumps out of a loop) then this method resolves all
the linked jumps.
}}
repeat while pJump
d := pObjWork - pJump - 3
p := bt.PeekW( pJump + 1 )
if d =< 16383
byte[pJump][1] := $80 + (d >> 8)
byte[pJump][2] := d
else
abort string("Jump out of range(1)")
pJump := p
pri MarkBackwardJumpDestination
return pObjWork
pri ResolveBackwardJump( jumpOp, pDest ) | d
{{
Emits a jump instruction to the location pointed to by pDest.
}}
Emit( jumpOp )
d := pDest - pObjWork - 1 ' d < 0
if d => -64
Emit( d + 128 )
elseif --d => -16384 ' decrementing d to compensate for emitting an additional byte
Emit( (d >> 8) + 256 )
Emit( d )
else
abort string("Jump out of range(2)")
var
word nextDest ' destination for NEXT
word quitDest ' destination for QUIT
dat
uniqueDest word $8000
var
byte caseNesting { #CASE levels between REPEAT and NEXT or QUIT. E.g.
REPEAT
CASE
NEXT caseNesting = 1
CASE
REPEAT
NEXT caseNesting = 0
NEXT caseNesting = 2
}
pri CompileRepeat | col, pJump, saveNextDest, saveQuitDest, pQuitJump, jumpOp, topDest, fromAllowed, p, q {
}, pFromVarStart { points to start of code for REPEAT FROM variable
}, pFromVarEnd { points to end "
}, pFromVarOp { points to the PUSH op that has to change to USING
}, pFromToExprStart { points to start of code for FROM..TO.. expressions
}, pFromToExprEnd { points to end "
}, pStepExprStart { points to start of STEP expression
}, pStepExprEnd { points to end "
}, saveCaseNesting
{{
Current token is REPEAT
}}
saveNextDest := nextDest
saveQuitDest := quitDest
++repeatDepth
nextDest := uniqueDest++
quitDest := uniqueDest++
saveCaseNesting := caseNesting~ ' save case nesting, make it 0
col := token.Column
token.Advance
if token.AdvanceIf( kw#kEOL ) ' Uncounted REPEAT or REPEAT ... WHILE/UNTIL -- can't tell until the end of the loop
topDest := MarkBackwardJumpDestination
CompileStatements( col )
jumpOp := $04 ' GOTO (used if this is an uncounted REPEAT)
if token.Column == col
if token.AdvanceIf( kw#kWHILE )
jumpOp := $0b ' JPT
elseif token.AdvanceIf( kw#kUNTIL )
jumpOp := $0a ' JPF
if jumpOp == $04
Retarget( nextDest, topDest ) ' for plain uncounted REPEAT, NEXT jumps to the top of the loop.
else
Retarget( nextDest, pObjWork ) ' for REPEAT ... WHILE/UNTIL <expr>, NEXT jumps to the expression.
CompileExpression( 13, true, false )
token.Eat( kw#kEOL )
ResolveBackwardJump( jumpOp, topDest ) ' back to top of loop
Retarget( quitDest, pObjWork )
elseif token.Type == kw#kWHILE or token.Type == kw#kUNTIL
jumpOp := $0a ' JPF
if token.Type == kw#kUNTIL
jumpOp := $0b ' JPT
token.Advance
nextDest := topDest := MarkBackwardJumpDestination
CompileExpression( 13, true, false )
token.Eat( kw#kEOL )
pJump := MakeForwardJump( jumpOp )
CompileStatements( col )
ResolveBackwardJump( $04, topDest ) ' GOTO top of loop
ResolveForwardJump( pJump )
Retarget( quitDest, pObjWork )
else ' REPEAT expr or REPEAT var FROM...
pFromVarStart := pObjWork
fromAllowed := CompileExpression( 13, true, true )
if token.AdvanceIf( kw#kFROM ) ' REPEAT var FROM...
ifnot fromAllowed
abort string("FROM not allowed")
{
REPEAT var FROM f TO t STEP s
If we just generated the bytecode in order, we'd get
vPUSHffffttttssss
What we want is
ffffvPOP
the body of the loop
ssssffffttttvUSING+RPTINCJ
(vPUSH is the code for pushing var; we'll modify the PUSH op to POP and then to USING.)
So:
Generate vPUSH, copy it to temp storage, and reset pObjWork to overwrite it.
Generate ffff and note pObjWork.
Generate tttt, copy fffftttt to temp storage.
Generate ssss, copy to temp storage.
Reset pObjWork to overwrite ttttssss.
Modify vPUSH to vPOP, emit it after ffff.
Generate the code for the body of the loop.
Emit ssss.
Emit fffftttt.
Modify vPOP to vUSING, emit it.
Emit RPTINCJ or RPTADDJ
}
pFromVarOp := fromAllowed
pFromVarEnd := pObjWork
p := SaveBytes( pFromVarStart, pFromVarEnd )
pObjWork := pFromVarStart ' overwrite var code
pFromVarEnd -= pFromVarStart - p
pFromVarOp -= pFromVarStart - p
pFromVarStart := p
pFromToExprStart := pObjWork
CompileExpression( 13, true, false ) ' FROM expression
token.Eat( kw#kTO )
q := pObjWork ' we're going to reset pObjWork to this point to overwrite TO and STEP expressions.
CompileExpression( 13, true, false ) ' TO expression
pFromToExprEnd := pObjWork
p := bt.Alloc( pFromToExprEnd - pFromToExprStart )
bytemove( p, pFromToExprStart, pFromToExprEnd - pFromToExprStart )
pFromToExprEnd -= pFromToExprStart - p
pFromToExprStart := p
pStepExprStart~
if token.AdvanceIf( kw#kSTEP )
pStepExprStart := pObjWork
CompileExpression( 13, true, false ) ' STEP expression
pStepExprEnd := pObjWork
p := SaveBytes( pStepExprStart, pStepExprEnd )
pStepExprEnd -= pStepExprStart - p
pStepExprStart := p
token.Eat( kw#kEOL )
pObjWork := q
' change PUSH to POP
if byte[pFromVarOp] | 1 == $3f ' reg?
byte[pFromVarOp][1] += $20 ' modify following byte: $9r => $br
else
++byte[pFromVarOp] ' PUSH => POP
repeat p from pFromVarStart to pFromVarEnd-1
Emit( byte[p] )
topDest := MarkBackwardJumpDestination
CompileStatements( col )
Retarget( nextDest, pObjWork )
jumpOp := $02 ' RPTINCJ for no STEP
if pStepExprStart ' emit STEP expression if present
repeat p from pStepExprStart to pStepExprEnd - 1
Emit( byte[p] )
jumpOp := $06 ' RPTADDJ for STEP
repeat p from pFromToExprStart to pFromToExprEnd - 1 ' emit FROM and TO expressions
Emit( byte[p] )
' change POP to USING
if byte[pFromVarOp] | 1 == $3f ' reg?
byte[pFromVarOp][1] += $20 ' modify following byte: $br => $dr
else
++byte[pFromVarOp] ' POP => USING
repeat p from pFromVarStart to pFromVarEnd-1 ' emit USING VAR expression
Emit( byte[p] )
ResolveBackwardJump( jumpOp, topDest )
Retarget( quitDest, pObjWork )
else ' REPEAT expr
token.Eat( kw#kEOL )
pQuitJump := MakeForwardJump( $08 ) ' LOOPJPF
topDest := MarkBackwardJumpDestination
CompileStatements( col )
Retarget( nextDest, pObjWork )
ResolveBackwardJump( $09, topDest ) ' LOOPRPT
ResolveForwardJump( pQuitJump )
Retarget( quitDest, pObjWork )
caseNesting := saveCaseNesting ' restore case nesting
nextDest := saveNextDest
quitDest := saveQuitDest
--repeatDepth
pri SaveBytes( p, q ) : r | l
r := bt.Alloc( l := q - p )
bytemove( r, p, l )
pri CompileCase | col, matchCol, otherEncountered, p0, p1, p2, pMatch, pCase
{{
Current token is CASE.
}}
++caseNesting
otherEncountered~
p0~
p1~
col := token.Column
token.Advance
Emit( $39 ) ' PUSH#k2
MakeFloatingReference( pObjWork, pObjWork ) ' Eventually this will be the offset (within the obj) to the end of the CASE construct.
pCase := pObjWork
Emit( 0 ) ' placeholder
Emit( 0 ) ' "
CompileExpression( 13, true, false )
token.Eat( kw#kEOL )
matchCol := token.Column
if matchCol =< col
abort string("No cases encountered")
repeat while token.Column > col
if token.AdvanceIf( kw#kOTHER )
otherEncountered~~
token.Eat( kw#kCOLON )
CompileStatements( matchCol )
Emit( $0c ) ' GOTO []
Swaperoo( p0, p1, pObjWork )
quit
else
pMatch := pObjWork
repeat
CompileExpression( 13, true, false )
if token.AdvanceIf( kw#kDOTDOT )
CompileExpression( 13, true, false )
Emit( $0e ) ' CASER
MakeFloatingReference( pObjWork, pMatch )
Emit( $80 )
Emit( 0 )
else
Emit( $0d ) ' CASE
MakeFloatingReference( pObjWork, pMatch )
Emit( $80 )
Emit( 0 )
while token.AdvanceIf( kw#kCOMMA )
token.Eat( kw#kCOLON )
Retarget( pMatch, pObjWork )
Swaperoo( p0, p1, pObjWork )
p0 += pObjWork - p1
CompileStatements( matchCol )
Emit( $0c ) ' GOTO []
p1 := pObjWork
ifnot otherEncountered
Emit( $0c ) ' GOTO []
Swaperoo( p0, p1, pObjWork )
Retarget( pCase, pObjWork )
--caseNesting
var
word pFloatingReferences
{
Floating reference data structure: 2-byte source address, 2-byte destination address, 2-byte pointer to next floating reference.
Floating refs are stored in temporary bt.Alloc-ed memory which is reclaimed after each method is compiled.
}
pri MakeFloatingReference( src, dst ) | p
p := bt.Alloc( 6 )
bt.PokeW( p , src )
bt.PokeW( p+2, dst )
bt.PokeW( p+4, pFloatingReferences )
pFloatingReferences := p
pri Retarget( dst0, dst1 ) | p
{{
Retarget any floating refs with destination dst0 to dst1.
}}
p := pFloatingReferences
repeat while p
if bt.PeekW( p+2 ) == dst0
bt.PokeW( p+2, dst1 )
p := bt.PeekW( p+4 )
pri ResolveFloatingReferences | p, src, dst, b, d
p := pFloatingReferences
repeat while p
dst := bt.PeekW( p+2 )
src := bt.PeekW( p )
b := byte[src-1]
if b == $39 ' PUSH#k2 at beginning of CASE
byte[src] := (dst - pObjSpace) >> 8
byte[src+1] := dst - pObjSpace
elseif b == $0d or b == $0e or b == $04 or b == $0a or b == $0b or b == $87 ' CASE or CASER or GOTO or JPF or JPT or PUSH#.B (for STRING)
d := dst - src - 2 ' relative offset
if b == $87 ' except for PUSH#.B
d := dst - pObjSpace
byte[src] := (d >> 8) | $80 ' SHOULDDO: range check
byte[src+1] := d
p := bt.PeekW( p+4 )
pri Swaperoo( p0, p1, p2 ) | pFR, src, dst
{{
Exchanges bytes [p0..p1) with [p1..p2)
E.g. abcdeXYZ => XYZabcde
Updates any floating references that have endpoints in [p0..p2)
}}
if p0 == p1
return
pFR := pFloatingReferences
repeat while pFR
bt.PokeW( pFR , AdjustEndpoint( bt.PeekW( pFR ), p0, p1, p2 ) )
bt.PokeW( pFR+2, AdjustEndpoint( bt.PeekW( pFR+2 ), p0, p1, p2 ) )
pFR := bt.PeekW( pFR+4 )
Reverse( p0, p1 )
Reverse( p1, p2 )
Reverse( p0, p2 )
pri AdjustEndpoint( p, p0, p1, p2 )
{{
Addresses [p0..p1) will be swapped with [p1..p2).
If p is in the affected range, return p's new value; otherwise, just return p
}}
if p0 =< p and p < p1
return p + p2 - p1 ' [p0..p1) will be shifted p2-p1 bytes
if p1 =< p and p < p2
return p - p1 + p0 ' p used to be p-p1 from p1, will be p-p1 from p0
return p
pri Reverse( i, j ) | t
{{
Reverses bytes [i..j)
E.g. abcde => edcba
}}
repeat while i < --j
t := byte[i]
byte[i++] := byte[j]
byte[j] := t
pri CompileString | p, size
{{
Current token is the ( after STRING.
Copy the string byte-by-byte to pObjWork, then copy the string up to
temp string storage in high memory. The reason for this nutty two-step is
the string length is unknown to begin with, so we don't know how much
temp string storage to allocate, but we can't leave the string at pObjWork
because it will doubtlessly be overwritten by subsequent calls to Emit.
}}
token.Eat( kw#kLPAREN )
p := pObjWork
repeat
byte[p++] := Eval.EvaluateExpression( 0 )
while token.AdvanceIf( kw#kCOMMA )
byte[p++]~
size := p - pObjWork
if (pStringWork -= size) < pObjWork
abort string("Out of string space")
bytemove( pStringWork, pObjWork, size )
Emit( $87 ) ' PUSH#.B
MakeFloatingReference( pObjWork, pStringWork )
Emit( 0 ) ' placeholder: this will eventually be the address of the string.
Emit( 0 )
token.Eat( kw#kRPAREN )
pri StringCleanup | size, p
{{
Call this at the end of compiling a method to move the strings down to abut the rest of the method code
and adjust floating references.
}}
p := pFloatingReferences
repeat while p
bt.PokeW( p+2, AdjustEndpoint( bt.PeekW( p+2 ), pObjWork, pStringWork, pObjTop ) )
p := bt.PeekW( p+4 )
size := pObjTop - pStringWork ' we're going to move this many bytes
bytemove( pObjWork, pStringWork, size ) '
pObjWork += size
con
#0, opPUSH, opPOP, opUSING, opPEA, opNONE = -1
#0, MEMSPACE, DATSPACE, VARSPACE, LOCALSPACE, REGSPACE, SPRSPACE
pri CompileExpression( rbp, push, fromAllowed ) | prec, opcode, opcode2, lbp
prec := token.GetPrecedence
if token.AdvanceIf( kw#kAT )
CompileVariable( push, opPEA, 0, false )
elseif token.AdvanceIf( kw#kMINUS )
if push
if token.IsIntLiteral or token.IsFloatLiteral
EmitPushInt( -token.Value )
token.Advance
else
CompileExpression( prec, push, false )
Emit( $e6 ) ' NEG
else ' in-place negate requires variable operand
CompileVariable( push, opUSING, $46, false ) ' NEG
elseif token.AdvanceIf( kw#kPLUS )
if push
if token.IsIntLiteral or token.IsFloatLiteral
EmitPushInt( token.Value )
token.Advance
else ' in-place negate requires variable operand
CompileVariable( push, opPUSH, 0, false ) ' just push
else
abort string("Syntax error after +")
elseif token.IsPostfixOp ' At this point, a postfix op is a prefix op
opcode := token.GetSpinOpcode
token.Advance
CompileVariable( push, opUSING, opcode, false )
elseif token.AdvanceIf( kw#kATAT ) ' special handling for @@
if push
CompileExpression( prec, push, false )
Emit( $97 ) 'PUSH#.B OBJ+0[]
Emit( 0 )
else
abort string("@@ must push")
elseif token.IsUnaryOp
opcode := token.GetSpinOpcode
opcode2 := token.GetSpinOpcode2
ifnot opcode2
opcode2 := opcode - $a0
token.Advance
if push
CompileExpression( prec, push, false )
Emit( opcode )
else ' in-place unary op requires variable operand
CompileVariable( push, opUSING, opcode2, false )
elseif token.AdvanceIf( kw#kLPAREN )
CompileExpression( 13, push, false )
token.Eat( kw#kRPAREN )
elseif token.IsIntLiteral or token.IsFloatLiteral
if push
EmitPushInt( token.Value )
token.Advance
else
abort string("Unexpected literal")
elseif token.IsId
result := CompileId( push, fromAllowed, false )
elseif token.AdvanceIf( kw#kSTRING )
CompileString
elseif token.AdvanceIf( kw#kCONSTANT )
token.Eat( kw#kLPAREN )
EmitPushInt( Eval.EvaluateExpression( 0 ) )
token.Eat( kw#kRPAREN )
elseif token.AdvanceIf( kw#kBACKSLASH )
CompileId( push, false, true )
elseif token.IsIntrinsic
CompileIntrinsic( push )
else
result := CompileVariable( push, opNONE, 0, fromAllowed )
repeat
lbp := token.GetPrecedence
if rbp =< lbp
quit
opcode := token.GetSpinOpcode
token.Advance
CompileExpression( lbp, push, false )
Emit( opcode )
result~
pri Emit( b )
if pObjWork => pStringWork
abort string("Out of obj space")
byte[pObjWork++] := b
pri EmitPushInt( v ) | mask, i, negate
{{
Emits the code the push integer v.
}}
if( v == -1 )
Emit( $34 ) ' PUSH#-1
elseif( v == 0 )
Emit( $35 ) ' PUSH#0
elseif( v == 1 )
Emit( $36 ) ' PUSH#-1
elseif Kp( v )
' nothing to do; Kp emits if necessary
else
negate~
mask~~
repeat i from 1 to 4
mask <<= 8
if (v & mask) == 0
quit
if (v | !mask) == -1
negate~~
!v
quit
' here i indicates how many bytes of v to emit (1..4)
v <<= (4-i)<<3 ' left-justify the i bytes we're interested in
Emit( $37 + i ) ' PUSH#k1/PUSH#k2/PUSH#k3/PUSH#k4
repeat i
Emit( v >> 24 ) ' pushing them out MSByte first
v <<= 8
if negate
Emit( $e7 ) ' BIT_NOT
pri Kp( v ) : f | b, m
{{
If v is one of the special bit patterns below, Kp emits the appropriate code and returns true;
otherwise just returns false.
Pattern Emits
2^(b+1) => %000bbbbb
2^(b+1)-1 => %001bbbbb
!(2^(b+1)) => %010bbbbb
-(2^(b+1)) => %011bbbbb
}}
m := 2
repeat b from 0 to 30
f~~
if v == m
quit
if v == m-1
b |= $20
quit
if v == !m
b |= $40
quit
if v == -m
b |= $60
quit
m <<= 1
f~
if f
Emit( $37 ) ' PUSH#kp
Emit( b )
pri CompileId( push, fromAllowed, abortFlag ) | p, type
p := st.SymbolLookup( token.Text )
ifnot p ' If it's not in the main symbol table...
if abortFlag
abort string("Expected method call")
return CompileVariable( push, opNONE, 0, fromAllowed ) ' ...it might be a local variable.
type := byte[p]
return CompileIdHelper( p, type, 0, push, fromAllowed, abortFlag, 0, 0 )
pri CompileIdHelper( p, type, objIndex, push, fromAllowed, abortFlag, i0, i1 ) | v, methodIndex, nArgs, pObj, expectCon
{{
returns non-zero if FROM may follow
}}
if abortFlag
ifnot type == st#kPUB_SYMBOL or type == st#kPRI_SYMBOL or type == st#kOBJ_SYMBOL
abort string("Expected method call")
if type == st#kINT_CON_SYMBOL or type == st#kFLOAT_CON_SYMBOL or type == st#kBUILTIN_INT_SYMBOL or type == st#kBUILTIN_FLOAT_SYMBOL
if push
v := bt.PeekL( p+1 )
EmitPushInt( v )
else
abort string("CON symbol not allowed here")
token.Advance
elseif type == st#kPUB_SYMBOL or type == st#kPRI_SYMBOL
Emit( ($01 & not push) | ($02 & abortFlag) )
' push abort Emit
' true false $00 ' FRAME call w/ return value
' false false $01 ' FRAME call w/o return value
' true true $02
' false true $03
token.Advance
methodIndex := byte[p][1]
nArgs := byte[p][2]
CompileArgs( nArgs )
if objIndex
if i0 == i1
Emit( $06 ) ' CALLOBJ
else
Swaperoo( i0, i1, pObjWork )
Emit( $07 ) ' CALLOBJ[]
Emit( objIndex )
Emit( methodIndex ) ' method #
else
Emit( $05 ) ' CALL
Emit( methodIndex ) ' method #
elseif type == st#kOBJ_SYMBOL
token.Advance
objIndex := byte[p][3]
p := bt.PeekW( p+1 )
pObj := bt.PeekW( p + strsize(p) + 2 )
if token.AdvanceIf( kw#kLBRACKET )
i0 := pObjWork
CompileExpression( 13, true, false )
i1 := pObjWork
token.Eat( kw#kRBRACKET )
token.Eat( kw#kDOT )
expectCon~
elseif token.AdvanceIf( kw#kOCTOTHORP )
expectCon~~
elseif token.AdvanceIf( kw#kDOT )
expectCon~
else
abort string("Expected . or #")
ifnot p := bt.FindInTable( token.Text, pObj )
abort string("Symbol unknown in sub-object")
type := byte[p]
if expectCon and ( type == st#kINT_CON_SYMBOL or type == st#kFLOAT_CON_SYMBOL ) {
} or not expectCon and ( type == st#kPUB_SYMBOL or type == st#kPRI_SYMBOL )
CompileIdHelper( p, type, objIndex, push, false, abortFlag, i0, i1 )
elseif expectCon
abort string("Expected CON symbol")
else
abort string("Expected PUB symbol")
else
result := CompileVariable( push, opNONE, 0, fromAllowed )
pri CompileArgs( n ) | t
ifnot n
return
t := kw#kLPAREN
repeat n
token.Eat( t ) ' 1st time, '('; subsequently, ','
t := kw#kCOMMA
CompileExpression( 13, true, false )
token.Eat( kw#kRPAREN )
pri CompileVariable( push, memop, spinOpcode, fromAllowed ) | space, offset, size, subscripted, dim, p, t, p0, p1
{{
Current token is anything that could be a variable: BYTE/WORD/LONG, a special register, SPR, an id.
Returns pointer to PUSH instruction if FROM is permitted to follow, false otherwise.
}}
p0~
p1~
subscripted~
if token.IsSize '========== BYTE/WORD/LONG
space := MEMSPACE
size := |< (token.Type - kw#kBYTE) ' size = 1, 2, or 4
token.Advance
if token.AdvanceIf( kw#kLBRACKET )
p0 := pObjWork
CompileExpression( 13, true, false )
p1 := pObjWork
token.Eat( kw#kRBRACKET )
if subscripted := token.AdvanceIf( kw#kLBRACKET )
CompileExpression( 13, true, false )
p1 := pObjWork
token.Eat( kw#kRBRACKET )
elseif token.IsReg '========== register (PAR, INA, etc.)
if memop == opPEA
abort string("Can't take address of register")
space := REGSPACE
offset := token.GetReg
size := 2 ' repurpose size for registers: 2 for plain reg
token.Advance
if token.AdvanceIf( kw#kLBRACKET )
p0 := pObjWork
size~ ' 0 for reg[]
CompileExpression( 13, true, false )
if token.AdvanceIf( kw#kDOTDOT )
++size ' 1 for reg[..]
CompileExpression( 13, true, false )
p1 := pObjWork
token.Eat( kw#kRBRACKET )
elseif token.AdvanceIf( kw#kSPR ) '========== SPR
if memop == opPEA
abort string("Can't take address of register")
space := SPRSPACE
token.Eat( kw#kLBRACKET )
CompileExpression( 13, true, false )
token.Eat( kw#kRBRACKET )
elseif token.IsId or token.Type == kw#kRESULT '========== id or RESULT
if p := st.SymbolLookup( token.Text )
t := byte[p++]
if t == st#kDAT_SYMBOL or t == st#kVAR_SYMBOL
if t == st#kDAT_SYMBOL
space := DATSPACE
else
space := VARSPACE
size := byte[p++]
offset := bt.PeekW( p )
else
abort string("Expected variable")
elseif p := bt.FindInTable( token.Text, bt.PeekW( pLocalSymbols ) )
space := LOCALSPACE
size := 4
offset := bt.PeekW( p )
else
abort string("Expected variable")
token.Advance
if token.AdvanceIf( kw#kDOT )
ifnot token.IsSize
abort string("Syntax error")
size := |< (token.Type - kw#kBYTE)
token.Advance
if subscripted := token.AdvanceIf( kw#kLBRACKET )
p0 := pObjWork
CompileExpression( 13, true, false )
p1 := pObjWork
token.Eat( kw#kRBRACKET )
else '==========
abort string("Syntax error")
' Now look for assignment or postfix op following variable
if token.AdvanceIf( kw#kCOLONEQUAL ) ' Straight assignment
if memop <> opNONE
abort string("Assignment not allowed here")
CompileExpression( 13, true, false )
Swaperoo( p0, p1, pObjWork )
if( push )
EmitVariable( space, size, offset, subscripted, opUSING )
Emit( $80 )
else
EmitVariable( space, size, offset, subscripted, opPOP )
return false
elseif token.IsAssignmentOp ' Assignment op (+=, AND=)
spinOpcode := token.GetSpinOpcode - $a0
token.Advance
CompileExpression( 13, true, false )
Swaperoo( p0, p1, pObjWork )
memop := opUSING
elseif token.IsPostfixOp ' Postfix (++)
if memop <> opNONE
abort string("Postfix op not allowed here")
spinOpcode := token.GetSpinOpcode2
token.Advance
memop := opUSING
if $20 =< spinOpcode and spinOpcode < $40 ' If pre/post inc/dec, adjust opcode based on size:
spinOpcode += (size >> 1) << 1 + 2 ' size 1, 2, 4 => +2, +4, +6
if push
spinOpcode |= $80
if memop == opNONE
memop := opPUSH
if memop == opPUSH and fromAllowed
result := pObjWork
EmitVariable( space, size, offset, subscripted, memop )
if memop == opUSING
Emit( spinOpcode )
pri EmitVariable( space, size, offset, subscripted, memop ) | op
if space == REGSPACE
Emit( $3d + size ) ' size means something different for reg: 0 => reg[], 1 => reg[..], 0 => reg
Emit( $90 + offset + (memop << 5) ) ' PUSH/POP/USING => $9r/$br/$dr
return
if space == SPRSPACE
Emit( $24 + memop ) ' PUSH/POP/USING => $24/$25/$26
return
if size == 4 and offset < 32 and not subscripted
op := %0100_0000 + offset + memop ' offset is a multiple of 4, given that size = 4
if space == VARSPACE
Emit( op )
return
elseif space == LOCALSPACE
Emit( op + %0010_0000 )
return
op := $80 + ((size>>1) << 5) + (space<<2) + memop
if subscripted
op += |< 4
Emit( op )
if( space <> MEMSPACE )
if offset < $80
Emit( offset )
else
Emit( (offset >> 8) | $80 ) ' high byte with MSB set
Emit( offset ) ' low byte
pri CompileIntrinsic( push ) | t
t := token.Type
token.Advance
if t & $10_00_0 ' LOOKUP|DOWN[Z] end with $1x_xx_x
CompileLookX( t, push )
return
if t & $20_00_0 ' LOCKCLR/NEW/SET end with $2x_xx_x
CompileLock( t, push )
return
if t & $100 ' STRCOMP/STRSIZE end with $1x_x
AssertPush( push )
CompileArgs( t & 3 ) ' could be 1 or 2
Emit( t >> 4 )
return
case t
kw#kCHIPVER:
AssertPush( push )
Emit( $34 ) ' PUSH#-1
Emit( $80 ) ' PUSH.B Mem[]
kw#kCLKFREQ:
AssertPush( push )
Emit( $35 ) ' PUSH#0
Emit( $c0 ) ' PUSH.L Mem[]
kw#kCLKMODE:
AssertPush( push )
EmitPushInt( 4 )
Emit( $80 ) ' PUSH.B Mem[]
kw#kCOGID:
AssertPush( push )
Emit( $3f ) ' REGPUSH cogid
Emit( $89 )
kw#kCOGINIT:
AssertNotPush( push )
CompileCoginewt( false, true )
kw#kCOGNEW:
CompileCoginewt( push, false )
kw#kREBOOT:
AssertNotPush( push )
EmitPushInt( $80 )
EmitPushInt( $00 )
Emit( $20 ) ' CLKSET
pri AssertPush( push )
ifnot push
abort string("Unexpected (must push)")
pri AssertNotPush( push )
if push
abort string("Unexpected (can't push)")
pri CompileLookX( t, push ) | op, opr, dest
{{
Current token is ( after LOOKUP/LOOKUPZ/LOOKDOWN/LOOKDOWNZ.
t = token.Type
}}
AssertPush( push )
op := (t >> 4) & $ff
opr := (t >> 12) & $ff
EmitPushInt( t & 1 )
Emit( $39 ) ' PUSH#k2
dest := uniqueDest++
MakeFloatingReference( pObjWork, dest )
Emit( 0 ) ' placeholder
Emit( 0 )
token.Eat( kw#kLPAREN )
CompileExpression( 13, true, false )
token.Eat( kw#kCOLON )
repeat
CompileExpression( 13, true, false )
if token.AdvanceIf( kw#kDOTDOT )
CompileExpression( 13, true, false )
Emit( opr )
else
Emit( op )
while token.AdvanceIf( kw#kCOMMA )
Emit( $0f ) ' LOOKEND
Retarget( dest, pObjWork )
token.Eat( kw#kRPAREN )
pri CompileLock( t, push ) | op
{{
Current token is ( after LOCKCLR/NEW/SET.
t = token.Type
}}
op := (t >> (4 + 8 & push)) & $ff ' fn op is bits 19..12; sub op is 11..4
CompileArgs( t & 1 ) ' only two possibilities for these LOCK* guys.
Emit( op )
pri CompileCoginewt( push, init ) | p0, p1, mark, pSym, index, nArgs
{{
Compile either COGINIT (init=true) or COGNEW (init=false).
Current token is the ( after COGINIT/NEW.
COGINIT( <exprA>, <exprB>, <exprC> )
COGNEW( <exprB, <exprC> )
}}
token.Eat( kw#kLPAREN )
mark~
if init
p0 := pObjWork
CompileExpression( 13, true, false ) ' exprA
p1 := pObjWork
token.Eat( kw#kCOMMA )
' see if the current token (start of exprB) is a method name
if (pSym := st.SymbolLookup( token.Text )) and (byte[pSym] == st#kPRI_SYMBOL or byte[pSym] == st#kPUB_SYMBOL)
' Short-circuit evaluation would be nice here, but this works (it's just a little wasteful).
mark~~
index := byte[pSym][1]
nArgs := byte[pSym][2]
token.Advance ' exprB is a method call, which
CompileArgs( nArgs ) ' we handle here ourselves
Emit( $39 ) ' PUSH#k2
Emit( nArgs )
Emit( index )
else
ifnot init
Emit( $34 ) ' PUSH#-1
CompileExpression( 13, true, false ) ' exprB is a plain old expression
token.Eat( kw#kCOMMA )
CompileExpression( 13, true, false ) ' exprC
if mark
Emit( $15) ' MARK
if init and mark
Swaperoo( p0, p1, pObjWork )
Emit( $3f ) ' REGPUSH $8f?
Emit( $8f )
Emit( $37 ) ' PUSH#kp -4 ($fffffffc)
Emit( $61 )
Emit( $d1 ) ' POP.L Mem[][]
if push
Emit( $28 ) ' COGIFUN
else
Emit( $2c ) ' COGISUB
token.Eat( kw#kRPAREN )
{'''
pri DumpLocals( p ) | s, t
ifnot p
return
s := p + 4
term.str( s )
s += strsize(s) + 1
term.out( "@" )
t := bt.PeekW( s )
term.dec( t )
term.out( 13 )
DumpLocals( bt.PeekW( p ) )
DumpLocals( bt.PeekW( p + 2 ) )
}'''
{{
Copyright (c) 2009 Michael Park
+------------------------------------------------------------------------------------------------------------------------------+
| TERMS OF USE: MIT License |
+------------------------------------------------------------------------------------------------------------------------------+
|Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation |
|files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, |
|modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software|
|is furnished to do so, subject to the following conditions: |
| |
|The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.|
| |
|THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE |
|WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR |
|COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, |
|ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. |
+------------------------------------------------------------------------------------------------------------------------------+
}}