' 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 , 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( , , ) COGNEW( ) }} 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. | +------------------------------------------------------------------------------------------------------------------------------+ }}