Initial data commit

This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 72d218235f
commit f23f22d71c
199087 changed files with 3378941 additions and 0 deletions

View file

@ -0,0 +1,2 @@
---
from: http://rosettacode.org/wiki/Compiler/code_generator

View file

@ -0,0 +1,5 @@
Code Generator
A code generator translates the output of the syntax analyzer and/or semantic analyzer
into lower level code, either assembly, object, or virtual.

View file

@ -0,0 +1,288 @@
# RC Compiler code generator #
COMMENT
this writes a .NET IL assembler source to standard output.
If the output is stored in a file called "rcsample.il",
it could be compiled the command:
ilasm /opt /out:rcsample.exe rcsample.il
(Note ilasm may not be in the PATH by default(
Note: The generated IL is *very* naive
COMMENT
# parse tree nodes #
MODE NODE = STRUCT( INT type, REF NODE left, right, INT value );
INT nidentifier = 1, nstring = 2, ninteger = 3, nsequence = 4, nif = 5, nprtc = 6, nprts = 7
, nprti = 8, nwhile = 9, nassign = 10, nnegate = 11, nnot = 12, nmultiply = 13, ndivide = 14
, nmod = 15, nadd = 16, nsubtract = 17, nless = 18, nlessequal = 19, ngreater = 20
, ngreaterequal = 21, nequal = 22, nnotequal = 23, nand = 24, nor = 25
;
# op codes #
INT ofetch = 1, ostore = 2, opush = 3, oadd = 4, osub = 5, omul = 6, odiv = 7, omod = 8
, olt = 9, ogt = 10, ole = 11, oge = 12, oeq = 13, one = 14, oand = 15, oor = 16
, oneg = 17, onot = 18, ojmp = 19, ojz = 20, oprtc = 21, oprts = 22, oprti = 23, opushstr = 24
;
[]INT ndop
= ( -1 , -1 , -1 , -1 , -1 , -1 , -1
, -1 , -1 , -1 , oneg , -1 , omul , odiv
, omod , oadd , osub , olt , -1 , ogt
, -1 , oeq , -1 , oand , oor
) ;
[]STRING ndname
= ( "Identifier" , "String" , "Integer" , "Sequence" , "If" , "Prtc" , "Prts"
, "Prti" , "While" , "Assign" , "Negate" , "Not" , "Multiply" , "Divide"
, "Mod" , "Add" , "Subtract" , "Less" , "LessEqual" , "Greater"
, "GreaterEqual" , "Equal" , "NotEqual" , "And" , "Or"
) ;
[]STRING opname
= ( "ldloc ", "stloc ", "ldc.i4 ", "add ", "sub ", "mul ", "div ", "rem "
, "clt ", "cgt ", "?le ", "?ge ", "ceq ", "?ne ", "and ", "or "
, "neg ", "?not ", "br ", "brfalse", "?prtc ", "?prts ", "?prti ", "ldstr "
) ;
# string and identifier arrays - a hash table might be better... #
INT max string number = 1024;
[ 0 : max string number ]STRING identifiers, strings;
FOR s pos FROM 0 TO max string number DO
identifiers[ s pos ] := "";
strings [ s pos ] := ""
OD;
# label number for label generation #
INT next label number := 0;
# returns the next free label number #
PROC new label = INT: next label number +:= 1;
# returns a new node with left and right branches #
PROC op node = ( INT op type, REF NODE left, right )REF NODE: HEAP NODE := NODE( op type, left, right, 0 );
# returns a new operand node #
PROC operand node = ( INT op type, value )REF NODE: HEAP NODE := NODE( op type, NIL, NIL, value );
# reports an error and stops #
PROC gen error = ( STRING message )VOID:
BEGIN
print( ( message, newline ) );
stop
END # gen error # ;
# reads a node from standard input #
PROC read node = REF NODE:
BEGIN
REF NODE result := NIL;
# parses a string from line and stores it in a string in the text array #
# - if it is not already present in the specified textElement list. #
# returns the position of the string in the text array #
PROC read string = ( REF[]STRING text list, CHAR terminator )INT:
BEGIN
# get the text of the string #
STRING str := line[ l pos ];
l pos +:= 1;
WHILE IF l pos <= UPB line THEN line[ l pos ] /= terminator ELSE FALSE FI DO
str +:= line[ l pos ];
l pos +:= 1
OD;
IF l pos > UPB line THEN gen error( "Unterminated String in node file: (" + line + ")." ) FI;
# attempt to find the text in the list of strings/identifiers #
INT t pos := LWB text list;
BOOL found := FALSE;
INT result := LWB text list - 1;
FOR t pos FROM LWB text list TO UPB text list WHILE NOT found DO
IF found := text list[ t pos ] = str THEN
# found the string #
result := t pos
ELIF text list[ t pos ] = "" THEN
# have an empty slot for ther string #
found := TRUE;
text list[ t pos ] := str;
result := t pos
FI
OD;
IF NOT found THEN gen error( "Out of string space." ) FI;
result
END # read string # ;
# gets an integer from the line - no checks for valid digits #
PROC read integer = INT:
BEGIN
INT n := 0;
WHILE line[ l pos ] /= " " DO
( n *:= 10 ) +:= ( ABS line[ l pos ] - ABS "0" );
l pos +:= 1
OD;
n
END # read integer # ;
STRING line, name;
INT l pos := 1, nd type := -1;
read( ( line, newline ) );
line +:= " ";
# get the node type name #
WHILE line[ l pos ] = " " DO l pos +:= 1 OD;
name := "";
WHILE IF l pos > UPB line THEN FALSE ELSE line[ l pos ] /= " " FI DO
name +:= line[ l pos ];
l pos +:= 1
OD;
# determine the node type #
nd type := LWB nd name;
IF name /= ";" THEN
# not a null node #
WHILE IF nd type <= UPB nd name THEN name /= nd name[ nd type ] ELSE FALSE FI DO nd type +:= 1 OD;
IF nd type > UPB nd name THEN gen error( "Malformed node: (" + line + ")." ) FI;
# handle the additional parameter for identifier/string/integer, or sub-nodes for operator nodes #
IF nd type = ninteger OR nd type = nidentifier OR nd type = nstring THEN
WHILE line[ l pos ] = " " DO l pos +:= 1 OD;
IF nd type = ninteger THEN result := operand node( nd type, read integer )
ELIF nd type = nidentifier THEN result := operand node( nd type, read string( identifiers, " " ) )
ELSE # nd type = nString # result := operand node( nd type, read string( strings, """" ) )
FI
ELSE
# operator node #
REF NODE left node = read node;
result := op node( nd type, left node, read node )
FI
FI;
result
END # read node # ;
# returns a formatted op code for code generation #
PROC operation = ( INT op code )STRING: " " + op name[ op code ] + " ";
# defines the specified label #
PROC define label = ( INT label number )VOID: print( ( "lbl_", whole( label number, 0 ), ":", newline ) );
# generates code to load a string value #
PROC gen load string = ( INT value )VOID:
BEGIN
print( ( operation( opushstr ), " ", strings[ value ], """", newline ) )
END # push string # ;
# generates code to load a constant value #
PROC gen load constant = ( INT value )VOID: print( ( operation( opush ), " ", whole( value, 0 ), newline ) );
# generates an operation acting on an address #
PROC gen data op = ( INT op, address )VOID: print( ( operation( op ), " l_", identifiers[ address ], newline ) );
# generates a nullary operation #
PROC gen op 0 = ( INT op )VOID: print( ( operation( op ), newline ) );
# generates a "not" instruction sequence #
PROC gen not = VOID:
BEGIN
gen load constant( 0 );
print( ( operation( oeq ), newline ) )
END # gen not # ;
# generates a negated condition #
PROC gen not op = ( INT op, REF NODE n )VOID:
BEGIN
gen( left OF n );
gen( right OF n );
gen op 0( op );
gen not
END # gen not op # ;
# generates a jump operation #
PROC gen jump = ( INT op, label )VOID: print( ( operation( op ), " lbl_", whole( label, 0 ), newline ) );
# generates code to output something to System.Console.Out #
PROC gen output = ( REF NODE n, STRING output type )VOID:
BEGIN
print( ( " call " ) );
print( ( "class [mscorlib]System.IO.TextWriter [mscorlib]System.Console::get_Out()", newline ) );
gen( left OF n );
print( ( " callvirt " ) );
print( ( "instance void [mscorlib]System.IO.TextWriter::Write(", output type, ")", newline ) )
END # gen output # ;
# generates the code header - assembly info, namespace, class and start of the Main method #
PROC code header = VOID:
BEGIN
print( ( ".assembly extern mscorlib { auto }", newline ) );
print( ( ".assembly RccSample {}", newline ) );
print( ( ".module RccSample.exe", newline ) );
print( ( ".namespace Rcc.Sample", newline ) );
print( ( "{", newline ) );
print( ( " .class public auto ansi Program extends [mscorlib]System.Object", newline ) );
print( ( " {", newline ) );
print( ( " .method public static void Main() cil managed", newline ) );
print( ( " {", newline ) );
print( ( " .entrypoint", newline ) );
# output the local variables #
BOOL have locals := FALSE;
STRING local prefix := " .locals init (int32 l_";
FOR s pos FROM LWB identifiers TO UPB identifiers WHILE identifiers[ s pos ] /= "" DO
print( ( local prefix, identifiers[ s pos ], newline ) );
local prefix := " ,int32 l_";
have locals := TRUE
OD;
IF have locals THEN
# there were some local variables defined - output the terminator #
print( ( " )", newline ) )
FI
END # code header # ;
# generates code for the node n #
PROC gen = ( REF NODE n )VOID:
IF n IS REF NODE( NIL ) THEN # null node #
SKIP
ELIF type OF n = nidentifier THEN # load identifier #
gen data op( ofetch, value OF n )
ELIF type OF n = nstring THEN # load string #
gen load string( value OF n )
ELIF type OF n = ninteger THEN # load integer #
gen load constant( value OF n )
ELIF type OF n = nsequence THEN # list #
gen( left OF n );
gen( right OF n )
ELIF type OF n = nif THEN # if-else #
INT else label := new label;
gen( left OF n );
gen jump( ojz, else label );
gen( left OF right OF n );
IF right OF right OF n IS REF NODE( NIL ) THEN
# no "else" part #
define label( else label )
ELSE
# have an "else" part #
INT end if label := new label;
gen jump( ojmp, end if label );
define label( else label );
gen( right OF right OF n );
define label( end if label )
FI
ELIF type OF n = nwhile THEN # while-loop #
INT loop label := new label;
INT exit label := new label;
define label( loop label );
gen( left OF n );
gen jump( ojz, exit label );
gen( right OF n );
gen jump( ojmp, loop label );
define label( exit label )
ELIF type OF n = nassign THEN # assignment #
gen( right OF n );
gen data op( ostore, value OF left OF n )
ELIF type OF n = nnot THEN # bolean not #
gen( left OF n );
gen not
ELIF type OF n = ngreaterequal THEN # compare >= #
gen not op( olt, n )
ELIF type OF n = nnotequal THEN # compare not = #
gen not op( oeq, n )
ELIF type OF n = nlessequal THEN # compare <= #
gen not op( ogt, n )
ELIF type OF n = nprts THEN # print string #
gen output( n, "string" )
ELIF type OF n = nprtc THEN # print character #
gen output( n, "char" )
ELIF type OF n = nprti THEN # print integer #
gen output( n, "int32" )
ELSE # everything else #
gen( left OF n );
gen( right OF n ); # right will be null for a unary op so no code will be generated #
print( ( operation( ndop( type OF n ) ), newline ) )
FI # gen # ;
# generates the code trailer - return instruction, end of Main method, end of class and end of namespace #
PROC code trailer = VOID:
BEGIN
print( ( " ret", newline ) );
print( ( " } // Main method", newline ) );
print( ( " } // Program class", newline ) );
print( ( "} // Rcc.Sample namespace", newline ) )
END # code trailer # ;
# parse the output from the syntax analyser and generate code from the parse tree #
REF NODE code = read node;
code header;
gen( code );
code trailer

View file

@ -0,0 +1,366 @@
begin % code generator %
% parse tree nodes %
record node( integer type
; reference(node) left, right
; integer iValue % nString/nIndentifier number or nInteger value %
);
integer nIdentifier, nString, nInteger, nSequence, nIf, nPrtc, nPrts
, nPrti, nWhile, nAssign, nNegate, nNot, nMultiply
, nDivide, nMod, nAdd, nSubtract, nLess, nLessEqual
, nGreater, nGreaterEqual, nEqual, nNotEqual, nAnd, nOr
;
string(14) array ndName ( 1 :: 25 );
integer array nOp ( 1 :: 25 );
integer MAX_NODE_TYPE;
% string literals and identifiers - uses a linked list - a hash table might be better... %
string(1) array text ( 0 :: 4095 );
integer textNext, TEXT_MAX;
record textElement ( integer start, length; reference(textElement) next );
reference(textElement) idList, stList;
% op codes %
integer oFetch, oStore, oPush
, oAdd, oSub, oMul, oDiv, oMod, oLt, oGt, oLe, oGe, oEq, oNe
, oAnd, oOr, oNeg, oNot, oJmp, oJz, oPrtc, oPrts, oPrti, oHalt
;
string(6) array opName ( 1 :: 24 );
% code - although this is intended to be byte code, as we are going to output %
% an assembler source, we use integers for convenience %
% labelLocations are: - ( referencing location + 1 ) if they have been referenced but not defined yet, %
% zero if they are unreferenced and undefined, %
% ( referencing location + 1 ) if they are defined %
integer array byteCode ( 0 :: 4095 );
integer array labelLocation( 1 :: 4096 );
integer nextLocation, MAX_LOCATION, nextLabelNumber, MAX_LABEL_NUMBER;
% returns a new node with left and right branches %
reference(node) procedure opNode ( integer value opType; reference(node) value opLeft, opRight ) ; begin
node( opType, opLeft, opRight, 0 )
end opNode ;
% returns a new operand node %
reference(node) procedure operandNode ( integer value opType, opValue ) ; begin
node( opType, null, null, opValue )
end operandNode ;
% reports an error and stops %
procedure genError( string(80) value message ); begin
integer errorPos;
write( s_w := 0, "**** Code generation error: " );
errorPos := 0;
while errorPos < 80 and message( errorPos // 1 ) not = "." do begin
writeon( s_w := 0, message( errorPos // 1 ) );
errorPos := errorPos + 1
end while_not_at_end_of_message ;
writeon( s_w := 0, "." );
assert( false )
end genError ;
% reads a node from standard input %
reference(node) procedure readNode ; begin
reference(node) resultNode;
% parses a string from line and stores it in a string in the text array %
% - if it is not already present in the specified textElement list. %
% returns the position of the string in the text array %
integer procedure readString ( reference(textElement) value result txList; string(1) value terminator ) ; begin
string(256) str;
integer sLen, sPos, ePos;
logical found;
reference(textElement) txPos, txLastPos;
% get the text of the string %
str := " ";
sLen := 0;
str( sLen // 1 ) := line( lPos // 1 );
sLen := sLen + 1;
lPos := lPos + 1;
while lPos <= 255 and line( lPos // 1 ) not = terminator do begin
str( sLen // 1 ) := line( lPos // 1 );
sLen := sLen + 1;
lPos := lPos + 1
end while_more_string ;
if lPos > 255 then genError( "Unterminated String in node file." );
% attempt to find the text in the list of strings/identifiers %
txLastPos := txPos := txList;
found := false;
ePos := 0;
while not found and txPos not = null do begin
ePos := ePos + 1;
found := ( length(txPos) = sLen );
sPos := 0;
while found and sPos < sLen do begin
found := str( sPos // 1 ) = text( start(txPos) + sPos );
sPos := sPos + 1
end while_not_found ;
txLastPos := txPos;
if not found then txPos := next(txPos)
end while_string_not_found ;
if not found then begin
% the string/identifier is not in the list - add it %
ePos := ePos + 1;
if txList = null then txList := textElement( textNext, sLen, null )
else next(txLastPos) := textElement( textNext, sLen, null );
if textNext + sLen > TEXT_MAX then genError( "Text space exhausted." )
else begin
for cPos := 0 until sLen - 1 do begin
text( textNext ) := str( cPos // 1 );
textNext := textNext + 1
end for_cPos
end
end if_not_found ;
ePos
end readString ;
% gets an integer from the line - no checks for valid digits %
integer procedure readInteger ; begin
integer n;
n := 0;
while line( lPos // 1 ) not = " " do begin
n := ( n * 10 ) + ( decode( line( lPos // 1 ) ) - decode( "0" ) );
lPos := lPos + 1
end while_not_end_of_integer ;
n
end readInteger ;
string(256) line;
string(16) name;
integer lPos, tPos, ndType;
tPos := lPos := 0;
readcard( line );
% get the node type name %
while line( lPos // 1 ) = " " do lPos := lPos + 1;
name := "";
while lPos < 256 and line( lPos // 1 ) not = " " do begin
name( tPos // 1 ) := line( lPos // 1 );
lPos := lPos + 1;
tPos := tPos + 1
end while_more_name ;
% determine the node type %
ndType := 1;
resultNode := null;
if name not = ";" then begin
% not a null node %
while ndType <= MAX_NODE_TYPE and name not = ndName( ndType ) do ndType := ndType + 1;
if ndType > MAX_NODE_TYPE then genError( "Malformed node." );
% handle the additional parameter for identifier/string/integer, or sub-nodes for operator nodes %
if ndType = nInteger or ndType = nIdentifier or ndType = nString then begin
while line( lPos // 1 ) = " " do lPos := lPos + 1;
if ndType = nInteger then resultNode := operandNode( ndType, readInteger )
else if ndType = nIdentifier then resultNode := operandNode( ndType, readString( idList, " " ) )
else % ndType = nString % resultNode := operandNode( ndType, readString( stList, """" ) )
end
else begin
% operator node %
reference(node) leftNode;
leftNode := readNode;
resultNode := opNode( ndType, leftNode, readNode )
end
end if_non_null_node ;
resultNode
end readNode ;
% returns the next free label number %
integer procedure newLabel ; begin
nextLabelNumber := nextLabelNumber + 1;
if nextLabelNumber > MAX_LABEL_NUMBER then genError( "Program too complex" );
nextLabelNumber
end newLabel ;
% defines the specified label to be at the next location %
procedure defineLabel ( integer value labelNumber ) ; begin
if labelLocation( labelNumber ) > 0 then genError( "Label already defined" )
else begin
% this is the first definition of the label, define it and if it has already been referenced, fill in the reference %
integer currValue;
currValue := labelLocation( labelNumber );
labelLocation( labelNumber ) := nextLocation + 1; % we store pc + 1 to ensure the label location is positive %
if currValue < 0 then % already referenced % byteCode( - ( currValue + 1 ) ) := labelLocation( labelNumber )
end
end defineLabel ;
% stores a byte in the code %
procedure genByte ( integer value byteValue ) ; begin
if nextLocation > MAX_LOCATION then genError( "Program too large" );
byteCode( nextLocation ) := byteValue;
nextLocation := nextLocation + 1
end genByte ;
% stores an integer in the code %
procedure genInteger ( integer value integerValue ) ; begin
% we are storing the bytes of the code in separate integers for convenience %
genByte( integerValue ); genByte( 0 ); genByte( 0 ); genByte( 0 )
end genInteger ;
% generates an operation acting on an address %
procedure genDataOp ( integer value opCode, address ) ; begin
genByte( opCode );
genInteger( address )
end genDataOp ;
% generates a nullary operation %
procedure genOp0 ( integer value opCode ) ; begin
genByte( opCode )
end genOp0 ;
% generates a unary/binary operation %
procedure genOp ( reference(node) value n ) ; begin
gen( left(n) );
gen( right(n) ); % right will be null for a unary op so no code will be generated %
genByte( nOp( type(n) ) )
end genOp ;
% generates a jump operation %
procedure genJump ( integer value opCode, labelNumber ) ; begin
genByte( opCode );
% if the label is not defined yet - set it's location to the negative of the referencing location %
% so it can be resolved later %
if labelLocation( labelNumber ) = 0 then labelLocation( labelNumber ) := - ( nextLocation + 1 );
genInteger( labelLocation( labelNumber ) )
end genJump ;
% generates code for the node n %
procedure gen ( reference(node) value n ) ; begin
if n = null then % empty node % begin end
else if type(n) = nIdentifier then genDataOp( oFetch, iValue(n) )
else if type(n) = nString then genDataOp( oPush, iValue(n) - 1 )
else if type(n) = nInteger then genDataOp( oPush, iValue(n) )
else if type(n) = nSequence then begin
gen( left(n) );
gen( right(n) )
end
else if type(n) = nIf then % if-else % begin
integer elseLabel;
elseLabel := newLabel;
gen( left(n) );
genJump( oJz, elseLabel );
gen( left( right(n) ) );
if right(right(n)) = null then % no "else" part % defineLabel( elseLabel )
else begin
% have an "else" part %
integer endIfLabel;
endIfLabel := newLabel;
genJump( oJmp, endIfLabel );
defineLabel( elseLabel );
gen( right(right(n)) );
defineLabel( endIfLabel )
end
end
else if type(n) = nWhile then % while-loop % begin
integer loopLabel, exitLabel;
loopLabel := newLabel;
exitLabel := newLabel;
defineLabel( loopLabel );
gen( left(n) );
genJump( oJz, exitLabel );
gen( right(n) );
genJump( oJmp, loopLabel );
defineLabel( exitLabel )
end
else if type(n) = nAssign then % assignment % begin
gen( right( n ) );
genDataOp( oStore, iValue(left(n)) )
end
else genOp( n )
end gen ;
% outputs the generated code to standard output %
procedure emitCode ; begin
% counts the number of elements in a text element list %
integer procedure countElements ( reference(textElement) value txHead ) ; begin
integer count;
reference(textElement) txPos;
count := 0;
txPos := txHead;
while txPos not = null do begin
count := count + 1;
txPos := next(txPos)
end while_txPos_not_null ;
count
end countElements ;
integer pc, op;
reference(textElement) txPos;
% code header %
write( i_w := 1, s_w := 0
, "Datasize: ", countElements( idList )
, " Strings: ", countElements( stList )
);
% output the string literals %
txPos := stList;
while txPos not = null do begin
integer cPos;
write( """" );
cPos := 1; % start from 1 to skip over the leading " %
while cPos < length(txPos) do begin
writeon( s_w := 0, text( start(txPos) + cPos ) );
cPos := cPos + 1
end while_not_end_of_string ;
writeon( s_w := 0, """" );
txPos := next(txPos)
end while_not_at_end_of_literals ;
% code body %
pc := 0;
while pc < nextLocation do begin
op := byteCode( pc );
write( i_w := 4, s_w := 0, pc, " ", opName( op ) );
pc := pc + 1;
if op = oFetch or op = oStore then begin
% data load/store - add the address in square brackets %
writeon( i_w := 1, s_w := 0, "[", byteCode( pc ) - 1, "]" );
pc := pc + 4
end
else if op = oPush then begin
% push constant - add the constant %
writeon( i_w := 1, s_w := 0, byteCode( pc ) );
pc := pc + 4
end
else if op = oJmp or op = oJz then begin
% jump - show the relative address in brackets and the absolute address %
writeon( i_w := 1, s_w := 0, "(", ( byteCode( pc ) - 1 ) - pc, ") ", byteCode( pc ) - 1 );
pc := pc + 4
end
end while_pc_lt_nextLocation
end emitCode ;
oFetch := 1; opName( oFetch ) := "fetch"; oStore := 2; opName( oStore ) := "store"; oPush := 3; opName( oPush ) := "push";
oAdd := 4; opName( oAdd ) := "add"; oSub := 5; opName( oSub ) := "sub"; oMul := 6; opName( oMul ) := "mul";
oDiv := 7; opName( oDiv ) := "div"; oMod := 8; opName( oMod ) := "mod"; oLt := 9; opName( oLt ) := "lt";
oGt := 10; opName( oGt ) := "gt"; oLe := 11; opName( oLe ) := "le"; oGe := 12; opName( oGe ) := "ge";
oEq := 13; opName( oEq ) := "eq"; oNe := 14; opName( oNe ) := "ne"; oAnd := 15; opName( oAnd ) := "and";
oOr := 16; opName( oOr ) := "or"; oNeg := 17; opName( oNeg ) := "neg"; oNot := 18; opName( oNot ) := "not";
oJmp := 19; opName( oJmp ) := "jmp"; oJz := 20; opName( oJz ) := "jz"; oPrtc := 21; opName( oPrtc ) := "prtc";
oPrts := 22; opName( oPrts ) := "prts"; oPrti := 23; opName( oPrti ) := "prti"; oHalt := 24; opName( oHalt ) := "halt";
nIdentifier := 1; ndName( nIdentifier ) := "Identifier"; nString := 2; ndName( nString ) := "String";
nInteger := 3; ndName( nInteger ) := "Integer"; nSequence := 4; ndName( nSequence ) := "Sequence";
nIf := 5; ndName( nIf ) := "If"; nPrtc := 6; ndName( nPrtc ) := "Prtc";
nPrts := 7; ndName( nPrts ) := "Prts"; nPrti := 8; ndName( nPrti ) := "Prti";
nWhile := 9; ndName( nWhile ) := "While"; nAssign := 10; ndName( nAssign ) := "Assign";
nNegate := 11; ndName( nNegate ) := "Negate"; nNot := 12; ndName( nNot ) := "Not";
nMultiply := 13; ndName( nMultiply ) := "Multiply"; nDivide := 14; ndName( nDivide ) := "Divide";
nMod := 15; ndName( nMod ) := "Mod"; nAdd := 16; ndName( nAdd ) := "Add";
nSubtract := 17; ndName( nSubtract ) := "Subtract"; nLess := 18; ndName( nLess ) := "Less";
nLessEqual := 19; ndName( nLessEqual ) := "LessEqual"; nGreater := 20; ndName( nGreater ) := "Greater";
nGreaterEqual := 21; ndName( nGreaterEqual ) := "GreaterEqual"; nEqual := 22; ndName( nEqual ) := "Equal";
nNotEqual := 23; ndName( nNotEqual ) := "NotEqual"; nAnd := 24; ndName( nAnd ) := "And";
nOr := 25; ndName( nOr ) := "Or";
MAX_NODE_TYPE := 25; TEXT_MAX := 4095; textNext := 0;
stList := idList := null;
for nPos := 1 until MAX_NODE_TYPE do nOp( nPos ) := -1;
nOp( nPrtc ) := oPrtc; nOp( nPrts ) := oPrts; nOp( nPrti ) := oPrti; nOp( nNegate ) := oNeg; nOp( nNot ) := oNot;
nOp( nMultiply ) := oMul; nOp( nDivide ) := oDiv; nOp( nMod ) := oMod; nOp( nAdd ) := oAdd; nOp( nSubtract ) := oSub;
nOp( nLess ) := oLt; nOp( nLessEqual ) := oLe; nOp( nGreater ) := oGt; nOp( nGreaterEqual ) := oGe; nOp( nEqual ) := oEq;
nOp( nNotEqual ) := oNe; nOp( nAnd ) := oAnd; nOp( nOr ) := oOr;
nextLocation := 0; MAX_LOCATION := 4095;
for pc := 0 until MAX_LOCATION do byteCode( pc ) := 0;
nextLabelNumber := 0; MAX_LABEL_NUMBER := 4096;
for lPos := 1 until MAX_LABEL_NUMBER do labelLocation( lPos ) := 0;
% parse the output from the syntax analyser and generate code from the parse tree %
gen( readNode );
genOp0( oHalt );
emitCode
end.

View file

@ -0,0 +1,944 @@
(* The Rosetta Code code generator in ATS2. *)
(* Usage: gen [INPUTFILE [OUTPUTFILE]]
If INPUTFILE or OUTPUTFILE is "-" or missing, then standard input
or standard output is used, respectively. *)
(* Note: you might wish to add code to catch exceptions and print nice
messages. *)
(*------------------------------------------------------------------*)
#define ATS_DYNLOADFLAG 0
#include "share/atspre_staload.hats"
staload UN = "prelude/SATS/unsafe.sats"
#define NIL list_vt_nil ()
#define :: list_vt_cons
%{^
/* alloca(3) is needed for ATS exceptions. */
#include <alloca.h>
%}
exception internal_error of ()
exception bad_ast_node_type of string
exception premature_end_of_input of ()
exception bad_number_field of string
exception missing_identifier_field of ()
exception bad_quoted_string of string
(* Some implementations that are likely missing from the prelude. *)
implement
g0uint2int<sizeknd, llintknd> x =
$UN.cast x
implement
g0uint2uint<sizeknd, ullintknd> x =
$UN.cast x
implement
g0uint2int<ullintknd, llintknd> x =
$UN.cast x
(*------------------------------------------------------------------*)
extern fn {}
skip_characters$skipworthy (c : char) :<> bool
fn {}
skip_characters {n : int}
{i : nat | i <= n}
(s : string n,
i : size_t i)
:<> [j : int | i <= j; j <= n]
size_t j =
let
fun
loop {k : int | i <= k; k <= n}
.<n - k>.
(k : size_t k)
:<> [j : int | k <= j; j <= n]
size_t j =
if string_is_atend (s, k) then
k
else if ~skip_characters$skipworthy (string_get_at (s, k)) then
k
else
loop (succ k)
in
loop i
end
fn
skip_whitespace {n : int}
{i : nat | i <= n}
(s : string n,
i : size_t i)
:<> [j : int | i <= j; j <= n]
size_t j =
let
implement
skip_characters$skipworthy<> c =
isspace c
in
skip_characters<> (s, i)
end
fn
skip_nonwhitespace {n : int}
{i : nat | i <= n}
(s : string n,
i : size_t i)
:<> [j : int | i <= j; j <= n]
size_t j =
let
implement
skip_characters$skipworthy<> c =
~isspace c
in
skip_characters<> (s, i)
end
fn
skip_nonquote {n : int}
{i : nat | i <= n}
(s : string n,
i : size_t i)
:<> [j : int | i <= j; j <= n]
size_t j =
let
implement
skip_characters$skipworthy<> c =
c <> '"'
in
skip_characters<> (s, i)
end
fn
skip_to_end {n : int}
{i : nat | i <= n}
(s : string n,
i : size_t i)
:<> [j : int | i <= j; j <= n]
size_t j =
let
implement
skip_characters$skipworthy<> c =
true
in
skip_characters<> (s, i)
end
(*------------------------------------------------------------------*)
fn
substring_equals {n : int}
{i, j : nat | i <= j; j <= n}
(s : string n,
i : size_t i,
j : size_t j,
t : string)
:<> bool =
let
val m = strlen t
in
if j - i <> m then
false (* The substring is the wrong length. *)
else
let
val p_s = ptrcast s
and p_t = ptrcast t
in
0 = $extfcall (int, "strncmp",
ptr_add<char> (p_s, i), p_t, m)
end
end
(*------------------------------------------------------------------*)
datatype node_type_t =
| NullNode
| Identifier
| String
| Integer
| Sequence
| If
| Prtc
| Prts
| Prti
| While
| Assign
| Negate
| Not
| Multiply
| Divide
| Mod
| Add
| Subtract
| Less
| LessEqual
| Greater
| GreaterEqual
| Equal
| NotEqual
| And
| Or
#define ARBITRARY_NODE_ARG 1234
datatype ast_node_t =
| ast_node_t_nil
| ast_node_t_nonnil of node_contents_t
where node_contents_t =
@{
node_type = node_type_t,
node_arg = ullint,
node_left = ast_node_t,
node_right = ast_node_t
}
fn
get_node_type {n : int}
{i : nat | i <= n}
(s : string n,
i : size_t i)
: [j : int | i <= j; j <= n]
@(node_type_t,
size_t j) =
let
val i_start = skip_whitespace (s, i)
val i_end = skip_nonwhitespace (s, i_start)
macdef eq t =
substring_equals (s, i_start, i_end, ,(t))
val node_type =
if eq ";" then
NullNode
else if eq "Identifier" then
Identifier
else if eq "String" then
String
else if eq "Integer" then
Integer
else if eq "Sequence" then
Sequence
else if eq "If" then
If
else if eq "Prtc" then
Prtc
else if eq "Prts" then
Prts
else if eq "Prti" then
Prti
else if eq "While" then
While
else if eq "Assign" then
Assign
else if eq "Negate" then
Negate
else if eq "Not" then
Not
else if eq "Multiply" then
Multiply
else if eq "Divide" then
Divide
else if eq "Mod" then
Mod
else if eq "Add" then
Add
else if eq "Subtract" then
Subtract
else if eq "Less" then
Less
else if eq "LessEqual" then
LessEqual
else if eq "Greater" then
Greater
else if eq "GreaterEqual" then
GreaterEqual
else if eq "Equal" then
Equal
else if eq "NotEqual" then
NotEqual
else if eq "And" then
And
else if eq "Or" then
Or
else
let
val s_bad =
strnptr2string
(string_make_substring (s, i_start, i_end - i_start))
in
$raise bad_ast_node_type s_bad
end
in
@(node_type, i_end)
end
fn
get_unsigned {n : int}
{i : nat | i <= n}
(s : string n,
i : size_t i)
: [j : int | i <= j; j <= n]
@(ullint,
size_t j) =
let
val i = skip_whitespace (s, i)
val [j : int] j = skip_nonwhitespace (s, i)
in
if j = i then
$raise bad_number_field ""
else
let
fun
loop {k : int | i <= k; k <= j}
(k : size_t k,
v : ullint)
: ullint =
if k = j then
v
else
let
val c = string_get_at (s, k)
in
if ~isdigit c then
let
val s_bad =
strnptr2string
(string_make_substring (s, i, j - i))
in
$raise bad_number_field s_bad
end
else
let
val digit = char2int1 c - char2int1 '0'
val () = assertloc (0 <= digit)
in
loop (succ k, (g1i2u 10 * v) + g1i2u digit)
end
end
in
@(loop (i, g0i2u 0), j)
end
end
fn
get_identifier
{n : int}
{i : nat | i <= n}
(s : string n,
i : size_t i)
: [j : int | i <= j; j <= n]
@(string,
size_t j) =
let
val i = skip_whitespace (s, i)
val j = skip_nonwhitespace (s, i)
in
if i = j then
$raise missing_identifier_field ()
else
let
val ident =
strnptr2string (string_make_substring (s, i, j - i))
in
@(ident, j)
end
end
fn
get_quoted_string
{n : int}
{i : nat | i <= n}
(s : string n,
i : size_t i)
: [j : int | i <= j; j <= n]
@(string,
size_t j) =
let
val i = skip_whitespace (s, i)
in
if string_is_atend (s, i) then
$raise bad_quoted_string ""
else if string_get_at (s, i) <> '"' then
let
val j = skip_to_end (s, i)
val s_bad =
strnptr2string (string_make_substring (s, i, j - i))
in
$raise bad_quoted_string s_bad
end
else
let
val j = skip_nonquote (s, succ i)
in
if string_is_atend (s, j) then
let
val s_bad =
strnptr2string (string_make_substring (s, i, j - i))
in
$raise bad_quoted_string s_bad
end
else
let
val quoted_string =
strnptr2string
(string_make_substring (s, i, succ j - i))
in
@(quoted_string, succ j)
end
end
end
fn
collect_string
{n : int}
(str : string,
strings : &list_vt (string, n) >> list_vt (string, m))
: #[m : int | m == n || m == n + 1]
[str_num : nat | str_num <= m]
size_t str_num =
(* This implementation uses list_vt instead of list, so
appending elements to the end of the list will be both efficient
and safe. It would also have been reasonable to build a list
backwards and then make a reversed copy. *)
let
fun
find_or_extend
{i : nat | i <= n}
.<n - i>.
(strings1 : &list_vt (string, n - i)
>> list_vt (string, m),
i : size_t i)
: #[m : int | m == n - i || m == n - i + 1]
[j : nat | j <= n]
size_t j =
case+ strings1 of
| ~ NIL =>
let (* The string is not there. Extend the list. *)
prval () = prop_verify {i == n} ()
in
strings1 := (str :: NIL);
i
end
| @ (head :: tail) =>
if head = str then
let (* The string is found. *)
prval () = fold@ strings1
in
i
end
else
let (* Continue looking. *)
val j = find_or_extend (tail, succ i)
prval () = fold@ strings1
in
j
end
prval () = lemma_list_vt_param strings
val n = i2sz (length strings)
and j = find_or_extend (strings, i2sz 0)
in
j
end
fn
load_ast (inpf : FILEref,
idents : &List_vt string >> _,
strings : &List_vt string >> _)
: ast_node_t =
let
fun
recurs (idents : &List_vt string >> _,
strings : &List_vt string >> _)
: ast_node_t =
if fileref_is_eof inpf then
$raise premature_end_of_input ()
else
let
val s = strptr2string (fileref_get_line_string inpf)
prval () = lemma_string_param s (* String length >= 0. *)
val i = i2sz 0
val @(node_type, i) = get_node_type (s, i)
in
case+ node_type of
| NullNode () => ast_node_t_nil ()
| Integer () =>
let
val @(number, _) = get_unsigned (s, i)
in
ast_node_t_nonnil
@{
node_type = node_type,
node_arg = number,
node_left = ast_node_t_nil,
node_right = ast_node_t_nil
}
end
| Identifier () =>
let
val @(ident, _) = get_identifier (s, i)
val arg = collect_string (ident, idents)
in
ast_node_t_nonnil
@{
node_type = node_type,
node_arg = g0u2u arg,
node_left = ast_node_t_nil,
node_right = ast_node_t_nil
}
end
| String () =>
let
val @(quoted_string, _) = get_quoted_string (s, i)
val arg = collect_string (quoted_string, strings)
in
ast_node_t_nonnil
@{
node_type = node_type,
node_arg = g0u2u arg,
node_left = ast_node_t_nil,
node_right = ast_node_t_nil
}
end
| _ =>
let
val node_left = recurs (idents, strings)
val node_right = recurs (idents, strings)
in
ast_node_t_nonnil
@{
node_type = node_type,
node_arg = g1i2u ARBITRARY_NODE_ARG,
node_left = node_left,
node_right = node_right
}
end
end
in
recurs (idents, strings)
end
fn
print_strings {n : int}
(outf : FILEref,
strings : !list_vt (string, n))
: void =
let
fun
loop {m : nat}
.<m>.
(strings1 : !list_vt (string, m)) :
void =
case+ strings1 of
| NIL => ()
| head :: tail =>
begin
fprintln! (outf, head);
loop tail
end
prval () = lemma_list_vt_param strings
in
loop strings
end
(*------------------------------------------------------------------*)
#define ARBITRARY_INSTRUCTION_ARG 1234
#define ARBITRARY_JUMP_ARG 123456789
typedef instruction_t =
@{
address = ullint,
opcode = string,
arg = llint
}
typedef code_t = ref instruction_t
vtypedef pjump_t (p : addr) =
(instruction_t @ p,
instruction_t @ p -<lin,prf> void |
ptr p)
vtypedef pjump_t = [p : addr] pjump_t p
fn
add_instruction (opcode : string,
arg : llint,
size : uint,
code : &List0_vt code_t >> List1_vt code_t,
pc : &ullint >> _)
: void =
let
val instr =
@{
address = pc,
opcode = opcode,
arg = arg
}
in
code := (ref instr :: code);
pc := pc + g0u2u size
end
fn
add_jump (opcode : string,
code : &List0_vt code_t >> List1_vt code_t,
pc : &ullint >> _)
: pjump_t =
let
val instr =
@{
address = pc,
opcode = opcode,
arg = g1i2i ARBITRARY_JUMP_ARG
}
val ref_instr = ref instr
in
code := (ref_instr :: code);
pc := pc + g0u2u 5U;
ref_vtakeout ref_instr
end
fn
fill_jump (pjump : pjump_t,
address : ullint)
: void =
let
val @(pf, fpf | p) = pjump
val instr0 = !p
val jump_offset : llint =
let
val from = succ (instr0.address)
and to = address
in
if from <= to then
g0u2i (to - from)
else
~g0u2i (from - to)
end
val instr1 =
@{
address = instr0.address,
opcode = instr0.opcode,
arg = jump_offset
}
val () = !p := instr1
prval () = fpf pf
in
end
fn
add_filled_jump (opcode : string,
address : ullint,
code : &List0_vt code_t >> List1_vt code_t,
pc : &ullint >> _)
: void =
let
val pjump = add_jump (opcode, code, pc)
in
fill_jump (pjump, address)
end
fn
generate_code (ast : ast_node_t)
: List_vt code_t =
let
fnx
traverse (ast : ast_node_t,
code : &List0_vt code_t >> _,
pc : &ullint >> _)
: void =
(* Generate the code by consing a list. *)
case+ ast of
| ast_node_t_nil () => ()
| ast_node_t_nonnil contents =>
begin
case+ contents.node_type of
| NullNode () => $raise internal_error ()
| If () => if_then (contents, code, pc)
| While () => while_do (contents, code, pc)
| Sequence () => sequence (contents, code, pc)
| Assign () => assign (contents, code, pc)
| Identifier () => immediate ("fetch", contents, code, pc)
| Integer () => immediate ("push", contents, code, pc)
| String () => immediate ("push", contents, code, pc)
| Prtc () => unary_op ("prtc", contents, code, pc)
| Prti () => unary_op ("prti", contents, code, pc)
| Prts () => unary_op ("prts", contents, code, pc)
| Negate () => unary_op ("neg", contents, code, pc)
| Not () => unary_op ("not", contents, code, pc)
| Multiply () => binary_op ("mul", contents, code, pc)
| Divide () => binary_op ("div", contents, code, pc)
| Mod () => binary_op ("mod", contents, code, pc)
| Add () => binary_op ("add", contents, code, pc)
| Subtract () => binary_op ("sub", contents, code, pc)
| Less () => binary_op ("lt", contents, code, pc)
| LessEqual () => binary_op ("le", contents, code, pc)
| Greater () => binary_op ("gt", contents, code, pc)
| GreaterEqual () => binary_op ("ge", contents, code, pc)
| Equal () => binary_op ("eq", contents, code, pc)
| NotEqual () => binary_op ("ne", contents, code, pc)
| And () => binary_op ("and", contents, code, pc)
| Or () => binary_op ("or", contents, code, pc)
end
and
if_then (contents : node_contents_t,
code : &List0_vt code_t >> _,
pc : &ullint >> _)
: void =
case- (contents.node_right) of
| ast_node_t_nonnil contents1 =>
let
val condition = (contents.node_left)
and true_branch = (contents1.node_left)
and false_branch = (contents1.node_right)
(* Generate code to evaluate the condition. *)
val () = traverse (condition, code, pc);
(* Generate a conditional jump. Where it goes to will be
filled in later. *)
val pjump = add_jump ("jz", code, pc)
(* Generate code for the true branch. *)
val () = traverse (true_branch, code, pc);
in
case+ false_branch of
| ast_node_t_nil () =>
begin (* There is no false branch. *)
(* Fill in the conditional jump to come here. *)
fill_jump (pjump, pc)
end
| ast_node_t_nonnil _ =>
let (* There is a false branch. *)
(* Generate an unconditional jump. Where it goes to will
be filled in later. *)
val pjump1 = add_jump ("jmp", code, pc)
(* Fill in the conditional jump to come here. *)
val () = fill_jump (pjump, pc)
(* Generate code for the false branch. *)
val () = traverse (false_branch, code, pc);
(* Fill in the unconditional jump to come here. *)
val () = fill_jump (pjump1, pc)
in
end
end
and
while_do (contents : node_contents_t,
code : &List0_vt code_t >> _,
pc : &ullint >> _)
: void =
(* I would prefer to implement while by putting the
conditional jump at the end, and jumping to it to get into
the loop. However, we need to generate not the code of our
choice, but the reference result. The reference result has
the conditional jump at the top. *)
let
(* Where to jump from the bottom of the loop. *)
val loop_top_address = pc
(* Generate code to evaluate the condition. *)
val () = traverse (contents.node_left, code, pc)
(* Generate a conditional jump. It will be filled in later to
go past the end of the loop. *)
val pjump = add_jump ("jz", code, pc)
(* Generate code for the loop body. *)
val () = traverse (contents.node_right, code, pc)
(* Generate a jump to the top of the loop. *)
val () = add_filled_jump ("jmp", loop_top_address, code, pc)
(* Fill in the conditional jump to come here. *)
val () = fill_jump (pjump, pc)
in
end
and
sequence (contents : node_contents_t,
code : &List0_vt code_t >> _,
pc : &ullint >> _)
: void =
begin
traverse (contents.node_left, code, pc);
traverse (contents.node_right, code, pc)
end
and
assign (contents : node_contents_t,
code : &List0_vt code_t >> _,
pc : &ullint >> _)
: void =
case- contents.node_left of
| ast_node_t_nonnil ident_contents =>
let
val variable_no = ident_contents.node_arg
in
traverse (contents.node_right, code, pc);
add_instruction ("store", g0u2i variable_no, 5U, code, pc)
end
and
immediate (opcode : string,
contents : node_contents_t,
code : &List0_vt code_t >> _,
pc : &ullint >> _)
: void =
add_instruction (opcode, g0u2i (contents.node_arg), 5U,
code, pc)
and
unary_op (opcode : string,
contents : node_contents_t,
code : &List0_vt code_t >> _,
pc : &ullint >> _)
: void =
begin
traverse (contents.node_left, code, pc);
add_instruction (opcode, g0i2i ARBITRARY_INSTRUCTION_ARG, 1U,
code, pc)
end
and
binary_op (opcode : string,
contents : node_contents_t,
code : &List0_vt code_t >> _,
pc : &ullint >> _)
: void =
begin
traverse (contents.node_left, code, pc);
traverse (contents.node_right, code, pc);
add_instruction (opcode, g0i2i ARBITRARY_INSTRUCTION_ARG, 1U,
code, pc)
end
var code : List_vt code_t = NIL
var pc : ullint = g0i2u 0
in
traverse (ast, code, pc);
add_instruction ("halt", g0i2i ARBITRARY_INSTRUCTION_ARG, 1U,
code, pc);
(* The code is a cons-list, in decreasing-address order, so
reverse it to put the instructions in increasing-address
order. *)
list_vt_reverse code
end
fn
print_code (outf : FILEref,
code : !List_vt code_t)
: void =
let
fun
loop {n : nat}
.<n>.
(code : !list_vt (code_t, n))
: void =
case+ code of
| NIL => ()
| ref_instr :: tail =>
let
val @{
address = address,
opcode = opcode,
arg = arg
} = !ref_instr
in
fprint! (outf, address, " ");
fprint! (outf, opcode);
if opcode = "push" then
fprint! (outf, " ", arg)
else if opcode = "fetch" || opcode = "store" then
fprint! (outf, " [", arg, "]")
else if opcode = "jmp" || opcode = "jz" then
begin
fprint! (outf, " (", arg, ") ");
if arg < g1i2i 0 then
let
val offset : ullint = g0i2u (~arg)
val () = assertloc (offset <= succ address)
in
fprint! (outf, succ address - offset)
end
else
let
val offset : ullint = g0i2u arg
in
fprint! (outf, succ address + offset)
end
end;
fprintln! (outf);
loop tail
end
prval () = lemma_list_vt_param code
in
loop code
end
(*------------------------------------------------------------------*)
fn
main_program (inpf : FILEref,
outf : FILEref)
: int =
let
var idents : List_vt string = NIL
var strings : List_vt string = NIL
val ast = load_ast (inpf, idents, strings)
val code = generate_code ast
val () = fprintln! (outf, "Datasize: ", length idents,
" Strings: ", length strings)
val () = print_strings (outf, strings)
val () = print_code (outf, code)
val () = free idents
and () = free strings
and () = free code
in
0
end
implement
main (argc, argv) =
let
val inpfname =
if 2 <= argc then
$UN.cast{string} argv[1]
else
"-"
val outfname =
if 3 <= argc then
$UN.cast{string} argv[2]
else
"-"
val inpf =
if (inpfname : string) = "-" then
stdin_ref
else
fileref_open_exn (inpfname, file_mode_r)
val outf =
if (outfname : string) = "-" then
stdout_ref
else
fileref_open_exn (outfname, file_mode_w)
in
main_program (inpf, outf)
end
(*------------------------------------------------------------------*)

View file

@ -0,0 +1,280 @@
function error(msg) {
printf("%s\n", msg)
exit(1)
}
function bytes_to_int(bstr, i, sum) {
sum = 0
for (i=word_size-1; i>=0; i--) {
sum *= 256
sum += code[bstr+i]
}
return sum
}
function make_node(oper, left, right, value) {
node_type [next_free_node_index] = oper
node_left [next_free_node_index] = left
node_right[next_free_node_index] = right
node_value[next_free_node_index] = value
return next_free_node_index ++
}
function make_leaf(oper, n) {
return make_node(oper, 0, 0, n)
}
function emit_byte(x) {
code[next_free_code_index++] = x
}
function emit_word(x, i) {
for (i=0; i<word_size; i++) {
emit_byte(int(x)%256);
x = int(x/256)
}
}
function emit_word_at(at, n, i) {
for (i=0; i<word_size; i++) {
code[at+i] = int(n)%256
n = int(n/256)
}
}
function hole( t) {
t = next_free_code_index
emit_word(0)
return t
}
function fetch_var_offset(name, n) {
if (name in globals) {
n = globals[name]
} else {
globals[name] = globals_n
n = globals_n
globals_n += 1
}
return n
}
function fetch_string_offset(the_string, n) {
n = string_pool[the_string]
if (n == "") {
string_pool[the_string] = string_n
n = string_n
string_n += 1
}
return n
}
function code_gen(x, n, p1, p2) {
if (x == 0) {
return
} else if (node_type[x] == "nd_Ident") {
emit_byte(FETCH)
n = fetch_var_offset(node_value[x])
emit_word(n)
} else if (node_type[x] == "nd_Integer") {
emit_byte(PUSH)
emit_word(node_value[x])
} else if (node_type[x] == "nd_String") {
emit_byte(PUSH)
n = fetch_string_offset(node_value[x])
emit_word(n)
} else if (node_type[x] == "nd_Assign") {
n = fetch_var_offset(node_value[node_left[x]])
code_gen(node_right[x])
emit_byte(STORE)
emit_word(n)
} else if (node_type[x] == "nd_If") {
code_gen(node_left[x]) # expr
emit_byte(JZ) # if false, jump
p1 = hole() # make room for jump dest
code_gen(node_left[node_right[x]]) # if true statements
if (node_right[node_right[x]] != 0) {
emit_byte(JMP) # jump over else statements
p2 = hole()
}
emit_word_at(p1, next_free_code_index - p1)
if (node_right[node_right[x]] != 0) {
code_gen(node_right[node_right[x]]) # else statements
emit_word_at(p2, next_free_code_index - p2)
}
} else if (node_type[x] == "nd_While") {
p1 =next_free_code_index
code_gen(node_left[x])
emit_byte(JZ)
p2 = hole()
code_gen(node_right[x])
emit_byte(JMP) # jump back to the top
emit_word(p1 - next_free_code_index)
emit_word_at(p2, next_free_code_index - p2)
} else if (node_type[x] == "nd_Sequence") {
code_gen(node_left[x])
code_gen(node_right[x])
} else if (node_type[x] == "nd_Prtc") {
code_gen(node_left[x])
emit_byte(PRTC)
} else if (node_type[x] == "nd_Prti") {
code_gen(node_left[x])
emit_byte(PRTI)
} else if (node_type[x] == "nd_Prts") {
code_gen(node_left[x])
emit_byte(PRTS)
} else if (node_type[x] in operators) {
code_gen(node_left[x])
code_gen(node_right[x])
emit_byte(operators[node_type[x]])
} else if (node_type[x] in unary_operators) {
code_gen(node_left[x])
emit_byte(unary_operators[node_type[x]])
} else {
error("error in code generator - found '" node_type[x] "', expecting operator")
}
}
function code_finish() {
emit_byte(HALT)
}
function list_code() {
printf("Datasize: %d Strings: %d\n", globals_n, string_n)
# Make sure that arrays are sorted by value in ascending order.
PROCINFO["sorted_in"] = "@val_str_asc"
# This is a dependency on GAWK.
for (k in string_pool)
print(k)
pc = 0
while (pc < next_free_code_index) {
printf("%4d ", pc)
op = code[pc]
pc += 1
if (op == FETCH) {
x = bytes_to_int(pc)
printf("fetch [%d]\n", x);
pc += word_size
} else if (op == STORE) {
x = bytes_to_int(pc)
printf("store [%d]\n", x);
pc += word_size
} else if (op == PUSH) {
x = bytes_to_int(pc)
printf("push %d\n", x);
pc += word_size
} else if (op == ADD) { print("add")
} else if (op == SUB) { print("sub")
} else if (op == MUL) { print("mul")
} else if (op == DIV) { print("div")
} else if (op == MOD) { print("mod")
} else if (op == LT) { print("lt")
} else if (op == GT) { print("gt")
} else if (op == LE) { print("le")
} else if (op == GE) { print("ge")
} else if (op == EQ) { print("eq")
} else if (op == NE) { print("ne")
} else if (op == AND) { print("and")
} else if (op == OR) { print("or")
} else if (op == NEG) { print("neg")
} else if (op == NOT) { print("not")
} else if (op == JMP) {
x = bytes_to_int(pc)
printf("jmp (%d) %d\n", x, pc + x);
pc += word_size
} else if (op == JZ) {
x = bytes_to_int(pc)
printf("jz (%d) %d\n", x, pc + x);
pc += word_size
} else if (op == PRTC) { print("prtc")
} else if (op == PRTI) { print("prti")
} else if (op == PRTS) { print("prts")
} else if (op == HALT) { print("halt")
} else { error("list_code: Unknown opcode '" op "'")
}
} # while pc
}
function load_ast( line, line_list, text, n, node_type, value, left, right) {
getline line
n=split(line, line_list)
text = line_list[1]
if (text == ";")
return 0
node_type = all_syms[text]
if (n > 1) {
value = line_list[2]
for (i=3;i<=n;i++)
value = value " " line_list[i]
if (value ~ /^[0-9]+$/)
value = int(value)
return make_leaf(node_type, value)
}
left = load_ast()
right = load_ast()
return make_node(node_type, left, right)
}
BEGIN {
all_syms["Identifier" ] = "nd_Ident"
all_syms["String" ] = "nd_String"
all_syms["Integer" ] = "nd_Integer"
all_syms["Sequence" ] = "nd_Sequence"
all_syms["If" ] = "nd_If"
all_syms["Prtc" ] = "nd_Prtc"
all_syms["Prts" ] = "nd_Prts"
all_syms["Prti" ] = "nd_Prti"
all_syms["While" ] = "nd_While"
all_syms["Assign" ] = "nd_Assign"
all_syms["Negate" ] = "nd_Negate"
all_syms["Not" ] = "nd_Not"
all_syms["Multiply" ] = "nd_Mul"
all_syms["Divide" ] = "nd_Div"
all_syms["Mod" ] = "nd_Mod"
all_syms["Add" ] = "nd_Add"
all_syms["Subtract" ] = "nd_Sub"
all_syms["Less" ] = "nd_Lss"
all_syms["LessEqual" ] = "nd_Leq"
all_syms["Greater" ] = "nd_Gtr"
all_syms["GreaterEqual"] = "nd_Geq"
all_syms["Equal" ] = "nd_Eql"
all_syms["NotEqual" ] = "nd_Neq"
all_syms["And" ] = "nd_And"
all_syms["Or" ] = "nd_Or"
FETCH=1; STORE=2; PUSH=3; ADD=4; SUB=5; MUL=6;
DIV=7; MOD=8; LT=9; GT=10; LE=11; GE=12;
EQ=13; NE=14; AND=15; OR=16; NEG=17; NOT=18;
JMP=19; JZ=20; PRTC=21; PRTS=22; PRTI=23; HALT=24;
operators["nd_Lss"] = LT
operators["nd_Gtr"] = GT
operators["nd_Leq"] = LE
operators["nd_Geq"] = GE
operators["nd_Eql"] = EQ
operators["nd_Neq"] = NE
operators["nd_And"] = AND
operators["nd_Or" ] = OR
operators["nd_Sub"] = SUB
operators["nd_Add"] = ADD
operators["nd_Div"] = DIV
operators["nd_Mul"] = MUL
operators["nd_Mod"] = MOD
unary_operators["nd_Negate"] = NEG
unary_operators["nd_Not" ] = NOT
next_free_node_index = 1
next_free_code_index = 0
globals_n = 0
string_n = 0
word_size = 4
input_file = "-"
if (ARGC > 1)
input_file = ARGV[1]
n = load_ast()
code_gen(n)
code_finish()
list_code()
}

View file

@ -0,0 +1,374 @@
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <stdarg.h>
#include <stdint.h>
#include <ctype.h>
typedef unsigned char uchar;
typedef enum {
nd_Ident, nd_String, nd_Integer, nd_Sequence, nd_If, nd_Prtc, nd_Prts, nd_Prti, nd_While,
nd_Assign, nd_Negate, nd_Not, nd_Mul, nd_Div, nd_Mod, nd_Add, nd_Sub, nd_Lss, nd_Leq,
nd_Gtr, nd_Geq, nd_Eql, nd_Neq, nd_And, nd_Or
} NodeType;
typedef enum { FETCH, STORE, PUSH, ADD, SUB, MUL, DIV, MOD, LT, GT, LE, GE, EQ, NE, AND,
OR, NEG, NOT, JMP, JZ, PRTC, PRTS, PRTI, HALT
} Code_t;
typedef uchar code;
typedef struct Tree {
NodeType node_type;
struct Tree *left;
struct Tree *right;
char *value;
} Tree;
#define da_dim(name, type) type *name = NULL; \
int _qy_ ## name ## _p = 0; \
int _qy_ ## name ## _max = 0
#define da_redim(name) do {if (_qy_ ## name ## _p >= _qy_ ## name ## _max) \
name = realloc(name, (_qy_ ## name ## _max += 32) * sizeof(name[0]));} while (0)
#define da_rewind(name) _qy_ ## name ## _p = 0
#define da_append(name, x) do {da_redim(name); name[_qy_ ## name ## _p++] = x;} while (0)
#define da_len(name) _qy_ ## name ## _p
#define da_add(name) do {da_redim(name); _qy_ ## name ## _p++;} while (0)
FILE *source_fp, *dest_fp;
static int here;
da_dim(object, code);
da_dim(globals, const char *);
da_dim(string_pool, const char *);
// dependency: Ordered by NodeType, must remain in same order as NodeType enum
struct {
char *enum_text;
NodeType node_type;
Code_t opcode;
} atr[] = {
{"Identifier" , nd_Ident, -1 },
{"String" , nd_String, -1 },
{"Integer" , nd_Integer, -1 },
{"Sequence" , nd_Sequence, -1 },
{"If" , nd_If, -1 },
{"Prtc" , nd_Prtc, -1 },
{"Prts" , nd_Prts, -1 },
{"Prti" , nd_Prti, -1 },
{"While" , nd_While, -1 },
{"Assign" , nd_Assign, -1 },
{"Negate" , nd_Negate, NEG},
{"Not" , nd_Not, NOT},
{"Multiply" , nd_Mul, MUL},
{"Divide" , nd_Div, DIV},
{"Mod" , nd_Mod, MOD},
{"Add" , nd_Add, ADD},
{"Subtract" , nd_Sub, SUB},
{"Less" , nd_Lss, LT },
{"LessEqual" , nd_Leq, LE },
{"Greater" , nd_Gtr, GT },
{"GreaterEqual", nd_Geq, GE },
{"Equal" , nd_Eql, EQ },
{"NotEqual" , nd_Neq, NE },
{"And" , nd_And, AND},
{"Or" , nd_Or, OR },
};
void error(const char *fmt, ... ) {
va_list ap;
char buf[1000];
va_start(ap, fmt);
vsprintf(buf, fmt, ap);
va_end(ap);
printf("error: %s\n", buf);
exit(1);
}
Code_t type_to_op(NodeType type) {
return atr[type].opcode;
}
Tree *make_node(NodeType node_type, Tree *left, Tree *right) {
Tree *t = calloc(sizeof(Tree), 1);
t->node_type = node_type;
t->left = left;
t->right = right;
return t;
}
Tree *make_leaf(NodeType node_type, char *value) {
Tree *t = calloc(sizeof(Tree), 1);
t->node_type = node_type;
t->value = strdup(value);
return t;
}
/*** Code generator ***/
void emit_byte(int c) {
da_append(object, (uchar)c);
++here;
}
void emit_int(int32_t n) {
union {
int32_t n;
unsigned char c[sizeof(int32_t)];
} x;
x.n = n;
for (size_t i = 0; i < sizeof(x.n); ++i) {
emit_byte(x.c[i]);
}
}
int hole() {
int t = here;
emit_int(0);
return t;
}
void fix(int src, int dst) {
*(int32_t *)(object + src) = dst-src;
}
int fetch_var_offset(const char *id) {
for (int i = 0; i < da_len(globals); ++i) {
if (strcmp(id, globals[i]) == 0)
return i;
}
da_add(globals);
int n = da_len(globals) - 1;
globals[n] = strdup(id);
return n;
}
int fetch_string_offset(const char *st) {
for (int i = 0; i < da_len(string_pool); ++i) {
if (strcmp(st, string_pool[i]) == 0)
return i;
}
da_add(string_pool);
int n = da_len(string_pool) - 1;
string_pool[n] = strdup(st);
return n;
}
void code_gen(Tree *x) {
int p1, p2, n;
if (x == NULL) return;
switch (x->node_type) {
case nd_Ident:
emit_byte(FETCH);
n = fetch_var_offset(x->value);
emit_int(n);
break;
case nd_Integer:
emit_byte(PUSH);
emit_int(atoi(x->value));
break;
case nd_String:
emit_byte(PUSH);
n = fetch_string_offset(x->value);
emit_int(n);
break;
case nd_Assign:
n = fetch_var_offset(x->left->value);
code_gen(x->right);
emit_byte(STORE);
emit_int(n);
break;
case nd_If:
code_gen(x->left); // if expr
emit_byte(JZ); // if false, jump
p1 = hole(); // make room for jump dest
code_gen(x->right->left); // if true statements
if (x->right->right != NULL) {
emit_byte(JMP);
p2 = hole();
}
fix(p1, here);
if (x->right->right != NULL) {
code_gen(x->right->right);
fix(p2, here);
}
break;
case nd_While:
p1 = here;
code_gen(x->left); // while expr
emit_byte(JZ); // if false, jump
p2 = hole(); // make room for jump dest
code_gen(x->right); // statements
emit_byte(JMP); // back to the top
fix(hole(), p1); // plug the top
fix(p2, here); // plug the 'if false, jump'
break;
case nd_Sequence:
code_gen(x->left);
code_gen(x->right);
break;
case nd_Prtc:
code_gen(x->left);
emit_byte(PRTC);
break;
case nd_Prti:
code_gen(x->left);
emit_byte(PRTI);
break;
case nd_Prts:
code_gen(x->left);
emit_byte(PRTS);
break;
case nd_Lss: case nd_Gtr: case nd_Leq: case nd_Geq: case nd_Eql: case nd_Neq:
case nd_And: case nd_Or: case nd_Sub: case nd_Add: case nd_Div: case nd_Mul:
case nd_Mod:
code_gen(x->left);
code_gen(x->right);
emit_byte(type_to_op(x->node_type));
break;
case nd_Negate: case nd_Not:
code_gen(x->left);
emit_byte(type_to_op(x->node_type));
break;
default:
error("error in code generator - found %d, expecting operator\n", x->node_type);
}
}
void code_finish() {
emit_byte(HALT);
}
void list_code() {
fprintf(dest_fp, "Datasize: %d Strings: %d\n", da_len(globals), da_len(string_pool));
for (int i = 0; i < da_len(string_pool); ++i)
fprintf(dest_fp, "%s\n", string_pool[i]);
code *pc = object;
again: fprintf(dest_fp, "%5d ", (int)(pc - object));
switch (*pc++) {
case FETCH: fprintf(dest_fp, "fetch [%d]\n", *(int32_t *)pc);
pc += sizeof(int32_t); goto again;
case STORE: fprintf(dest_fp, "store [%d]\n", *(int32_t *)pc);
pc += sizeof(int32_t); goto again;
case PUSH : fprintf(dest_fp, "push %d\n", *(int32_t *)pc);
pc += sizeof(int32_t); goto again;
case ADD : fprintf(dest_fp, "add\n"); goto again;
case SUB : fprintf(dest_fp, "sub\n"); goto again;
case MUL : fprintf(dest_fp, "mul\n"); goto again;
case DIV : fprintf(dest_fp, "div\n"); goto again;
case MOD : fprintf(dest_fp, "mod\n"); goto again;
case LT : fprintf(dest_fp, "lt\n"); goto again;
case GT : fprintf(dest_fp, "gt\n"); goto again;
case LE : fprintf(dest_fp, "le\n"); goto again;
case GE : fprintf(dest_fp, "ge\n"); goto again;
case EQ : fprintf(dest_fp, "eq\n"); goto again;
case NE : fprintf(dest_fp, "ne\n"); goto again;
case AND : fprintf(dest_fp, "and\n"); goto again;
case OR : fprintf(dest_fp, "or\n"); goto again;
case NOT : fprintf(dest_fp, "not\n"); goto again;
case NEG : fprintf(dest_fp, "neg\n"); goto again;
case JMP : fprintf(dest_fp, "jmp (%d) %d\n",
*(int32_t *)pc, (int32_t)(pc + *(int32_t *)pc - object));
pc += sizeof(int32_t); goto again;
case JZ : fprintf(dest_fp, "jz (%d) %d\n",
*(int32_t *)pc, (int32_t)(pc + *(int32_t *)pc - object));
pc += sizeof(int32_t); goto again;
case PRTC : fprintf(dest_fp, "prtc\n"); goto again;
case PRTI : fprintf(dest_fp, "prti\n"); goto again;
case PRTS : fprintf(dest_fp, "prts\n"); goto again;
case HALT : fprintf(dest_fp, "halt\n"); break;
default:error("listcode:Unknown opcode %d\n", *(pc - 1));
}
}
void init_io(FILE **fp, FILE *std, const char mode[], const char fn[]) {
if (fn[0] == '\0')
*fp = std;
else if ((*fp = fopen(fn, mode)) == NULL)
error(0, 0, "Can't open %s\n", fn);
}
NodeType get_enum_value(const char name[]) {
for (size_t i = 0; i < sizeof(atr) / sizeof(atr[0]); i++) {
if (strcmp(atr[i].enum_text, name) == 0) {
return atr[i].node_type;
}
}
error("Unknown token %s\n", name);
return -1;
}
char *read_line(int *len) {
static char *text = NULL;
static int textmax = 0;
for (*len = 0; ; (*len)++) {
int ch = fgetc(source_fp);
if (ch == EOF || ch == '\n') {
if (*len == 0)
return NULL;
break;
}
if (*len + 1 >= textmax) {
textmax = (textmax == 0 ? 128 : textmax * 2);
text = realloc(text, textmax);
}
text[*len] = ch;
}
text[*len] = '\0';
return text;
}
char *rtrim(char *text, int *len) { // remove trailing spaces
for (; *len > 0 && isspace(text[*len - 1]); --(*len))
;
text[*len] = '\0';
return text;
}
Tree *load_ast() {
int len;
char *yytext = read_line(&len);
yytext = rtrim(yytext, &len);
// get first token
char *tok = strtok(yytext, " ");
if (tok[0] == ';') {
return NULL;
}
NodeType node_type = get_enum_value(tok);
// if there is extra data, get it
char *p = tok + strlen(tok);
if (p != &yytext[len]) {
for (++p; isspace(*p); ++p)
;
return make_leaf(node_type, p);
}
Tree *left = load_ast();
Tree *right = load_ast();
return make_node(node_type, left, right);
}
int main(int argc, char *argv[]) {
init_io(&source_fp, stdin, "r", argc > 1 ? argv[1] : "");
init_io(&dest_fp, stdout, "wb", argc > 2 ? argv[2] : "");
code_gen(load_ast());
code_finish();
list_code();
return 0;
}

View file

@ -0,0 +1,652 @@
>>SOURCE FORMAT IS FREE
identification division.
*> this code is dedicated to the public domain
*> (GnuCOBOL) 2.3-dev.0
program-id. generator.
environment division.
configuration section.
repository. function all intrinsic.
data division.
working-storage section.
01 program-name pic x(32) value spaces global.
01 input-name pic x(32) value spaces global.
01 input-status pic xx global.
01 ast-record global.
03 ast-type pic x(14).
03 ast-value pic x(48).
03 filler redefines ast-value.
05 asl-left pic 999.
05 asl-right pic 999.
01 error-record pic x(64) value spaces global.
01 loadstack global.
03 l pic 99 value 0.
03 l-lim pic 99 value 64.
03 load-entry occurs 64.
05 l-node pic x(14).
05 l-left pic 999.
05 l-right pic 999.
05 l-link pic 999.
01 abstract-syntax-tree global.
03 t pic 999 value 0.
03 t1 pic 999.
03 t-lim pic 999 value 998.
03 filler occurs 998.
05 p1 pic 999.
05 p2 pic 999.
05 p3 pic 999.
05 n1 pic 999.
05 leaf.
07 leaf-type pic x(14).
07 leaf-value pic x(48).
05 node redefines leaf.
07 node-type pic x(14).
07 node-left pic 999.
07 node-right pic 999.
01 opcodes global.
03 opFETCH pic x value x'00'.
03 opSTORE pic x value x'01'.
03 opPUSH pic x value x'02'.
03 opADD pic x value x'03'.
03 opSUB pic x value x'04'.
03 opMUL pic x value x'05'.
03 opDIV pic x value x'06'.
03 opMOD pic x value x'07'.
03 opLT pic x value x'08'.
03 opGT pic x value x'09'.
03 opLE pic x value x'0A'.
03 opGE pic x value x'0B'.
03 opEQ pic x value x'0C'.
03 opNE pic x value x'0D'.
03 opAND pic x value x'0E'.
03 opOR pic x value x'0F'.
03 opNEG pic x value x'10'.
03 opNOT pic x value x'11'.
03 opJMP pic x value x'13'.
03 opJZ pic x value x'14'.
03 opPRTC pic x value x'15'.
03 opPRTS pic x value x'16'.
03 opPRTI pic x value x'17'.
03 opHALT pic x value x'18'.
01 variables global.
03 v pic 99.
03 v-max pic 99 value 0.
03 v-lim pic 99 value 16.
03 variable-entry occurs 16 pic x(48).
01 strings global.
03 s pic 99.
03 s-max pic 99 value 0.
03 s-lim pic 99 value 16.
03 string-entry occurs 16 pic x(48).
01 generated-code global.
03 c pic 999 value 1.
03 c1 pic 999.
03 c-lim pic 999 value 512.
03 kode pic x(512).
procedure division chaining program-name.
start-generator.
call 'loadast'
if program-name <> spaces
call 'readinput' *> close input-file
end-if
>>d perform print-ast
call 'codegen' using t
call 'emitbyte' using opHALT
>>d call 'showhex' using kode c
call 'listcode'
stop run
.
print-ast.
call 'printast' using t
display 'ast:' upon syserr
display 't=' t
perform varying t1 from 1 by 1 until t1 > t
if leaf-type(t1) = 'Identifier' or 'Integer' or 'String'
display t1 space trim(leaf-type(t1)) space trim(leaf-value(t1)) upon syserr
else
display t1 space node-left(t1) space node-right(t1) space trim(node-type(t1))
upon syserr
end-if
end-perform
.
identification division.
program-id. codegen common recursive.
data division.
working-storage section.
01 r pic ---9.
linkage section.
01 n pic 999.
procedure division using n.
start-codegen.
if n = 0
exit program
end-if
>>d display 'at 'c ' node=' space n space node-type(n) upon syserr
evaluate node-type(n)
when 'Identifier'
call 'emitbyte' using opFetch
call 'variableoffset' using leaf-value(n)
call 'emitword' using v '0'
when 'Integer'
call 'emitbyte' using opPUSH
call 'emitword' using leaf-value(n) '0'
when 'String'
call 'emitbyte' using opPUSH
call 'stringoffset' using leaf-value(n)
call 'emitword' using s '0'
when 'Assign'
call 'codegen' using node-right(n)
call 'emitbyte' using opSTORE
move node-left(n) to n1(n)
call 'variableoffset' using leaf-value(n1(n))
call 'emitword' using v '0'
when 'If'
call 'codegen' using node-left(n) *> conditional expr
call 'emitbyte' using opJZ *> jump to false path or exit
move c to p1(n)
call 'emitword' using '0' '0'
move node-right(n) to n1(n) *> true path
call 'codegen' using node-left(n1(n))
if node-right(n1(n)) <> 0 *> there is a false path
call 'emitbyte' using opJMP *> jump past false path
move c to p2(n)
call 'emitword' using '0' '0'
compute r = c - p1(n) *> fill in jump to false path
call 'emitword' using r p1(n)
call 'codegen' using node-right(n1(n)) *> false path
compute r = c - p2(n) *> fill in jump to exit
call 'emitword' using r p2(n)
else
compute r = c - p1(n)
call 'emitword' using r p1(n) *> fill in jump to exit
end-if
when 'While'
move c to p3(n) *> save address of while start
call 'codegen' using node-left(n) *> conditional expr
call 'emitbyte' using opJZ *> jump to exit
move c to p2(n)
call 'emitword' using '0' '0'
call 'codegen' using node-right(n) *> while body
call 'emitbyte' using opJMP *> jump to while start
compute r = p3(n) - c
call 'emitword' using r '0'
compute r = c - p2(n) *> fill in jump to exit
call 'emitword' using r p2(n)
when 'Sequence'
call 'codegen' using node-left(n)
call 'codegen' using node-right(n)
when 'Prtc'
call 'codegen' using node-left(n)
call 'emitbyte' using opPRTC
when 'Prti'
call 'codegen' using node-left(n)
call 'emitbyte' using opPRTI
when 'Prts'
call 'codegen' using node-left(n)
call 'emitbyte' using opPRTS
when 'Less'
call 'codegen' using node-left(n)
call 'codegen' using node-right(n)
call 'emitbyte' using opLT
when 'Greater'
call 'codegen' using node-left(n)
call 'codegen' using node-right(n)
call 'emitbyte' using opGT
when 'LessEqual'
call 'codegen' using node-left(n)
call 'codegen' using node-right(n)
call 'emitbyte' using opLE
when 'GreaterEqual'
call 'codegen' using node-left(n)
call 'codegen' using node-right(n)
call 'emitbyte' using opGE
when 'Equal'
call 'codegen' using node-left(n)
call 'codegen' using node-right(n)
call 'emitbyte' using opEQ
when 'NotEqual'
call 'codegen' using node-left(n)
call 'codegen' using node-right(n)
call 'emitbyte' using opNE
when 'And'
call 'codegen' using node-left(n)
call 'codegen' using node-right(n)
call 'emitbyte' using opAND
when 'Or'
call 'codegen' using node-left(n)
call 'codegen' using node-right(n)
call 'emitbyte' using opOR
when 'Subtract'
call 'codegen' using node-left(n)
call 'codegen' using node-right(n)
call 'emitbyte' using opSUB
when 'Add'
call 'codegen' using node-left(n)
call 'codegen' using node-right(n)
call 'emitbyte' using opADD
when 'Divide'
call 'codegen' using node-left(n)
call 'codegen' using node-right(n)
call 'emitbyte' using opDIV
when 'Multiply'
call 'codegen' using node-left(n)
call 'codegen' using node-right(n)
call 'emitbyte' using opMUL
when 'Mod'
call 'codegen' using node-left(n)
call 'codegen' using node-right(n)
call 'emitbyte' using opMOD
when 'Negate'
call 'codegen' using node-left(n)
call 'emitbyte' using opNEG
when 'Not'
call 'codegen' using node-left(n)
call 'emitbyte' using opNOT
when other
string 'in generator unknown node type: ' node-type(n) into error-record
call 'reporterror'
end-evaluate
.
end program codegen.
identification division.
program-id. variableoffset common.
data division.
linkage section.
01 variable-value pic x(48).
procedure division using variable-value.
start-variableoffset.
perform varying v from 1 by 1
until v > v-max
or variable-entry(v) = variable-value
continue
end-perform
if v > v-lim
string 'in generator variable offset v exceeds ' v-lim into error-record
call 'reporterror'
end-if
if v > v-max
move v to v-max
move variable-value to variable-entry(v)
end-if
.
end program variableoffset.
identification division.
program-id. stringoffset common.
data division.
linkage section.
01 string-value pic x(48).
procedure division using string-value.
start-stringoffset.
perform varying s from 1 by 1
until s > s-max
or string-entry(s) = string-value
continue
end-perform
if s > s-lim
string ' generator stringoffset s exceeds ' s-lim into error-record
call 'reporterror'
end-if
if s > s-max
move s to s-max
move string-value to string-entry(s)
end-if
subtract 1 from s *> convert index to offset
.
end program stringoffset.
identification division.
program-id. emitbyte common.
data division.
linkage section.
01 opcode pic x.
procedure division using opcode.
start-emitbyte.
if c >= c-lim
string 'in generator emitbyte c exceeds ' c-lim into error-record
call 'reporterror'
end-if
move opcode to kode(c:1)
add 1 to c
.
end program emitbyte.
identification division.
program-id. emitword common.
data division.
working-storage section.
01 word-x.
03 word usage binary-int.
01 loc pic 999.
linkage section.
01 word-value any length.
01 loc-value any length.
procedure division using word-value loc-value.
start-emitword.
if c + length(word) > c-lim
string 'in generator emitword exceeds ' c-lim into error-record
call 'reporterror'
end-if
move numval(word-value) to word
move numval(loc-value) to loc
if loc = 0
move word-x to kode(c:length(word))
add length(word) to c
else
move word-x to kode(loc:length(word))
end-if
.
end program emitword.
identification division.
program-id. listcode common.
data division.
working-storage section.
01 word-x.
03 word usage binary-int.
01 address-display pic ---9.
01 address-absolute pic zzz9.
01 data-display pic -(9)9.
01 v-display pic z9.
01 s-display pic z9.
01 c-display pic zzz9.
procedure division.
start-listcode.
move v-max to v-display
move s-max to s-display
display 'Datasize: ' trim(v-display) space 'Strings: ' trim(s-display)
perform varying s from 1 by 1
until s > s-max
display string-entry(s)
end-perform
move 1 to c1
perform until c1 >= c
compute c-display = c1 - 1
display c-display space with no advancing
evaluate kode(c1:1)
when opFETCH
add 1 to c1
move kode(c1:4) to word-x
compute address-display = word - 1
display 'fetch [' trim(address-display) ']'
add 3 to c1
when opSTORE
add 1 to c1
move kode(c1:4) to word-x
compute address-display = word - 1
display 'store [' trim(address-display) ']'
add 3 to c1
when opPUSH
add 1 to c1
move kode(c1:4) to word-x
move word to data-display
display 'push ' trim(data-display)
add 3 to c1
when opADD display 'add'
when opSUB display 'sub'
when opMUL display 'mul'
when opDIV display 'div'
when opMOD display 'mod'
when opLT display 'lt'
when opGT display 'gt'
when opLE display 'le'
when opGE display 'ge'
when opEQ display 'eq'
when opNE display 'ne'
when opAND display 'and'
when opOR display 'or'
when opNEG display 'neg'
when opNOT display 'not'
when opJMP
move kode(c1 + 1:length(word)) to word-x
move word to address-display
compute address-absolute = c1 + word
display 'jmp (' trim(address-display) ') ' trim(address-absolute)
add length(word) to c1
when opJZ
move kode(c1 + 1:length(word)) to word-x
move word to address-display
compute address-absolute = c1 + word
display 'jz (' trim(address-display) ') ' trim(address-absolute)
add length(word) to c1
when opPRTC display 'prtc'
when opPRTI display 'prti'
when opPRTS display 'prts'
when opHALT display 'halt'
when other
string 'in generator unknown opcode ' kode(c1:1) into error-record
call 'reporterror'
end-evaluate
add 1 to c1
end-perform
.
end program listcode.
identification division.
program-id. loadast common recursive.
procedure division.
start-loadast.
if l >= l-lim
string 'in generator loadast l exceeds ' l-lim into error-record
call 'reporterror'
end-if
add 1 to l
call 'readinput'
evaluate true
when ast-record = ';'
when input-status = '10'
move 0 to return-code
when ast-type = 'Identifier'
when ast-type = 'Integer'
when ast-type = 'String'
call 'makeleaf' using ast-type ast-value
move t to return-code
when ast-type = 'Sequence'
move ast-type to l-node(l)
call 'loadast'
move return-code to l-left(l)
call 'loadast'
move t to l-right(l)
call 'makenode' using l-node(l) l-left(l) l-right(l)
move t to return-code
when other
move ast-type to l-node(l)
call 'loadast'
move return-code to l-left(l)
call 'loadast'
move return-code to l-right(l)
call 'makenode' using l-node(l) l-left(l) l-right(l)
move t to return-code
end-evaluate
subtract 1 from l
.
end program loadast.
identification division.
program-id. printast common recursive.
data division.
linkage section.
01 n pic 999.
procedure division using n.
start-printast.
if n = 0
display ';' upon syserr
exit program
end-if
display leaf-type(n) upon syserr
evaluate leaf-type(n)
when 'Identifier'
when 'Integer'
when 'String'
display leaf-type(n) space trim(leaf-value(n)) upon syserr
when other
display node-type(n) upon syserr
call 'printast' using node-left(n)
call 'printast' using node-right(n)
end-evaluate
.
end program printast.
identification division.
program-id. makenode common.
data division.
linkage section.
01 parm-type any length.
01 parm-l-left pic 999.
01 parm-l-right pic 999.
procedure division using parm-type parm-l-left parm-l-right.
start-makenode.
if t >= t-lim
string 'in generator makenode t exceeds ' t-lim into error-record
call 'reporterror'
end-if
add 1 to t
move parm-type to node-type(t)
move parm-l-left to node-left(t)
move parm-l-right to node-right(t)
.
end program makenode.
identification division.
program-id. makeleaf common.
data division.
linkage section.
01 parm-type any length.
01 parm-value pic x(48).
procedure division using parm-type parm-value.
start-makeleaf.
add 1 to t
if t >= t-lim
string 'in generator makeleaf t exceeds ' t-lim into error-record
call 'reporterror'
end-if
move parm-type to leaf-type(t)
move parm-value to leaf-value(t)
.
end program makeleaf.
identification division.
program-id. readinput common.
environment division.
input-output section.
file-control.
select input-file assign using input-name
status is input-status
organization is line sequential.
data division.
file section.
fd input-file.
01 input-record pic x(64).
procedure division.
start-readinput.
if program-name = spaces
move '00' to input-status
accept ast-record on exception move '10' to input-status end-accept
exit program
end-if
if input-name = spaces
string program-name delimited by space '.ast' into input-name
open input input-file
if input-status = '35'
string 'in generator ' trim(input-name) ' not found' into error-record
call 'reporterror'
end-if
end-if
read input-file into ast-record
evaluate input-status
when '00'
continue
when '10'
close input-file
when other
string 'in generator ' trim(input-name) ' unexpected input-status: ' input-status
into error-record
call 'reporterror'
end-evaluate
.
end program readinput.
program-id. reporterror common.
procedure division.
start-reporterror.
report-error.
display error-record upon syserr
stop run with error status -1
.
end program reporterror.
identification division.
program-id. showhex common.
data division.
working-storage section.
01 hex.
03 filler pic x(32) value '000102030405060708090A0B0C0D0E0F'.
03 filler pic x(32) value '101112131415161718191A1B1C1D1E1F'.
03 filler pic x(32) value '202122232425262728292A2B2C2D2E2F'.
03 filler pic x(32) value '303132333435363738393A3B3C3D3E3F'.
03 filler pic x(32) value '404142434445464748494A4B4C4D4E4F'.
03 filler pic x(32) value '505152535455565758595A5B5C5D5E5F'.
03 filler pic x(32) value '606162636465666768696A6B6C6D6E6F'.
03 filler pic x(32) value '707172737475767778797A7B7C7D7E7F'.
03 filler pic x(32) value '808182838485868788898A8B8C8D8E8F'.
03 filler pic x(32) value '909192939495969798999A9B9C9D9E9F'.
03 filler pic x(32) value 'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'.
03 filler pic x(32) value 'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'.
03 filler pic x(32) value 'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'.
03 filler pic x(32) value 'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'.
03 filler pic x(32) value 'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'.
03 filler pic x(32) value 'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'.
01 cdx pic 9999.
01 bdx pic 999.
01 byte-count pic 9.
01 bytes-per-word pic 9 value 4.
01 word-count pic 9.
01 words-per-line pic 9 value 8.
linkage section.
01 data-field any length.
01 length-data-field pic 999.
procedure division using
by reference data-field
by reference length-data-field.
start-showhex.
move 1 to byte-count
move 1 to word-count
perform varying cdx from 1 by 1
until cdx > length-data-field
compute bdx = 2 * ord(data-field(cdx:1)) - 1 end-compute
display hex(bdx:2) with no advancing upon syserr
add 1 to byte-count end-add
if byte-count > bytes-per-word
display ' ' with no advancing upon syserr
move 1 to byte-count
add 1 to word-count end-add
end-if
if word-count > words-per-line
display ' ' upon syserr
move 1 to word-count
end-if
end-perform
if word-count <> 1
or byte-count <> 1
display ' ' upon syserr
end-if
display ' ' upon syserr
goback
.
end program showhex.
end program generator.

View file

@ -0,0 +1,129 @@
CREATE BUF 0 ,
: PEEK BUF @ 0= IF KEY BUF ! THEN BUF @ ;
: GETC PEEK 0 BUF ! ;
: SPACE? DUP BL = SWAP 9 14 WITHIN OR ;
: >SPACE BEGIN PEEK SPACE? WHILE GETC DROP REPEAT ;
: DIGIT? 48 58 WITHIN ;
: >Integer >SPACE 0
BEGIN PEEK DIGIT?
WHILE GETC [CHAR] 0 - SWAP 10 * + REPEAT ;
: SKIP ( xt --)
BEGIN PEEK OVER EXECUTE WHILE GETC DROP REPEAT DROP ;
: WORD ( xt -- c-addr) DUP >R SKIP PAD 1+
BEGIN PEEK R@ EXECUTE INVERT
WHILE GETC OVER C! CHAR+
REPEAT R> SKIP PAD TUCK - 1- PAD C! ;
: INTERN ( c-addr -- c-addr)
HERE TUCK OVER C@ CHAR+ DUP ALLOT CMOVE ;
: "? [CHAR] " = ;
: "TYPE" [CHAR] " EMIT TYPE [CHAR] " EMIT ;
: . 0 .R ;
: 3@ ( addr -- w3 w2 w1)
[ 2 CELLS ]L + DUP @ SWAP CELL - DUP @ SWAP CELL - @ ;
CREATE BUF' 12 ALLOT
: PREPEND ( c-addr c -- c-addr) BUF' 1+ C!
COUNT 10 MIN DUP 1+ BUF' C! BUF' 2 + SWAP CMOVE BUF' ;
: >NODE ( c-addr -- n) [CHAR] $ PREPEND FIND
IF EXECUTE ELSE ." unrecognized node " COUNT TYPE CR THEN ;
: NODE ( n left right -- addr) HERE >R , , , R> ;
: CONS ( a b l -- l) HERE >R , , , R> ;
: FIRST ( l -- a) [ 2 CELLS ]L + @ ;
: SECOND ( l -- b) CELL+ @ ;
: C=? ( c-addr1 c-addr2 -- t|f) COUNT ROT COUNT COMPARE 0= ;
: LOOKUP ( c-addr l -- n t | c-addr f)
BEGIN DUP WHILE OVER OVER FIRST C=?
IF NIP SECOND TRUE EXIT THEN @
REPEAT DROP FALSE ;
CREATE GLOBALS 0 , CREATE STRINGS 0 ,
: DEPTH ( pool -- n) DUP IF SECOND 1+ THEN ;
: FISH ( c-addr pool -- n pool') TUCK LOOKUP IF SWAP
ELSE INTERN OVER DEPTH ROT OVER >R CONS R> SWAP THEN ;
: >Identifier ['] SPACE? WORD GLOBALS @ FISH GLOBALS ! ;
: >String ['] "? WORD STRINGS @ FISH STRINGS ! ;
: >; 0 ;
: HANDLER [CHAR] @ PREPEND FIND DROP ;
: READER ( c-addr -- xt t | f)
[CHAR] > PREPEND FIND DUP 0= IF NIP THEN ;
DEFER GETAST
: READ ( c-addr -- right left) READER
IF EXECUTE 0 ELSE GETAST GETAST THEN SWAP ;
: (GETAST) ['] SPACE? WORD DUP HANDLER >R READ R> NODE ;
' (GETAST) IS GETAST
CREATE PC 0 ,
: i32! ( n addr --)
OVER $FF AND OVER C! 1+
OVER 8 RSHIFT $FF AND OVER C! 1+
OVER 16 RSHIFT $FF AND OVER C! 1+
OVER 24 RSHIFT $FF AND OVER C! DROP DROP ;
: i32, ( n --) HERE i32! 4 ALLOT 4 PC +! ;
: i8, ( c --) C, 1 PC +! ;
: i8@+ DUP 1+ SWAP C@ 1 PC +! ;
: i32@+ ( addr -- addr+4 n)
i8@+ >R i8@+ 8 LSHIFT R> OR >R
i8@+ 16 LSHIFT R> OR >R i8@+ 24 LSHIFT R> OR ;
CREATE #OPS 0 ,
: OP: CREATE #OPS @ , 1 #OPS +! DOES> @ ;
OP: fetch OP: store OP: push OP: jmp OP: jz
OP: prtc OP: prti OP: prts OP: neg OP: not
OP: add OP: sub OP: mul OP: div OP: mod
OP: lt OP: gt OP: le OP: ge
OP: eq OP: ne OP: and OP: or OP: halt
: GEN ( ast --) 3@ EXECUTE ;
: @; ( r l) DROP DROP ;
: @Identifier fetch i8, i32, DROP ;
: @Integer push i8, i32, DROP ;
: @String push i8, i32, DROP ;
: @Prtc GEN prtc i8, DROP ;
: @Prti GEN prti i8, DROP ;
: @Prts GEN prts i8, DROP ;
: @Not GEN not i8, DROP ;
: @Negate GEN neg i8, DROP ;
: @Sequence GEN GEN ;
: @Assign CELL+ @ >R GEN store i8, R> i32, ;
: @While PC @ SWAP GEN jz i8, HERE >R 0 i32,
SWAP GEN jmp i8, i32, PC @ R> i32! ;
: @If GEN jz i8, HERE >R 0 i32,
CELL+ DUP CELL+ @ DUP @ ['] @; = IF DROP @
ELSE SWAP @ GEN jmp i8, HERE 0 i32, PC @ R> i32! >R
THEN GEN PC @ R> i32! ;
: BINARY >R GEN GEN R> i8, ;
: @Subtract sub BINARY ; : @Add add BINARY ;
: @Mod mod BINARY ; : @Multiply mul BINARY ;
: @Divide div BINARY ;
: @Less lt BINARY ; : @LessEqual le BINARY ;
: @Greater gt BINARY ; : @GreaterEqual ge BINARY ;
: @Equal eq BINARY ; : @NotEqual ne BINARY ;
: @And and BINARY ; : @Or or BINARY ;
: REVERSE ( l -- l') 0 SWAP
BEGIN DUP WHILE TUCK DUP @ ROT ROT ! REPEAT DROP ;
: .STRINGS STRINGS @ REVERSE BEGIN DUP
WHILE DUP FIRST COUNT "TYPE" CR @ REPEAT DROP ;
: .HEADER ( --)
." Datasize: " GLOBALS @ DEPTH . SPACE
." Strings: " STRINGS @ DEPTH . CR .STRINGS ;
: GENERATE ( ast -- addr u)
0 PC ! HERE >R GEN halt i8, R> PC @ ;
: ," [CHAR] " PARSE TUCK HERE SWAP CMOVE ALLOT ;
CREATE "OPS"
," fetch store push jmp jz prtc prti prts "
," neg not add sub mul div mod lt "
," gt le ge eq ne and or halt "
: .i32 i32@+ . ;
: .[i32] [CHAR] [ EMIT .i32 [CHAR] ] EMIT ;
: .off [CHAR] ( EMIT PC @ >R i32@+ DUP R> - . [CHAR] ) EMIT
SPACE . ;
CREATE .INT ' .[i32] , ' .[i32] , ' .i32 , ' .off , ' .off ,
: EMIT ( addr u --) >R 0 PC !
BEGIN PC @ R@ <
WHILE PC @ 5 .R SPACE i8@+
DUP 6 * "OPS" + 6 TYPE
DUP 5 < IF CELLS .INT + @ EXECUTE ELSE DROP THEN CR
REPEAT DROP R> DROP ;
GENERATE EMIT BYE

File diff suppressed because it is too large Load diff

View file

@ -0,0 +1,393 @@
package main
import (
"bufio"
"encoding/binary"
"fmt"
"log"
"os"
"strconv"
"strings"
)
type NodeType int
const (
ndIdent NodeType = iota
ndString
ndInteger
ndSequence
ndIf
ndPrtc
ndPrts
ndPrti
ndWhile
ndAssign
ndNegate
ndNot
ndMul
ndDiv
ndMod
ndAdd
ndSub
ndLss
ndLeq
ndGtr
ndGeq
ndEql
ndNeq
ndAnd
ndOr
)
type code = byte
const (
fetch code = iota
store
push
add
sub
mul
div
mod
lt
gt
le
ge
eq
ne
and
or
neg
not
jmp
jz
prtc
prts
prti
halt
)
type Tree struct {
nodeType NodeType
left *Tree
right *Tree
value string
}
// dependency: Ordered by NodeType, must remain in same order as NodeType enum
type atr struct {
enumText string
nodeType NodeType
opcode code
}
var atrs = []atr{
{"Identifier", ndIdent, 255},
{"String", ndString, 255},
{"Integer", ndInteger, 255},
{"Sequence", ndSequence, 255},
{"If", ndIf, 255},
{"Prtc", ndPrtc, 255},
{"Prts", ndPrts, 255},
{"Prti", ndPrti, 255},
{"While", ndWhile, 255},
{"Assign", ndAssign, 255},
{"Negate", ndNegate, neg},
{"Not", ndNot, not},
{"Multiply", ndMul, mul},
{"Divide", ndDiv, div},
{"Mod", ndMod, mod},
{"Add", ndAdd, add},
{"Subtract", ndSub, sub},
{"Less", ndLss, lt},
{"LessEqual", ndLeq, le},
{"Greater", ndGtr, gt},
{"GreaterEqual", ndGeq, ge},
{"Equal", ndEql, eq},
{"NotEqual", ndNeq, ne},
{"And", ndAnd, and},
{"Or", ndOr, or},
}
var (
stringPool []string
globals []string
object []code
)
var (
err error
scanner *bufio.Scanner
)
func reportError(msg string) {
log.Fatalf("error : %s\n", msg)
}
func check(err error) {
if err != nil {
log.Fatal(err)
}
}
func nodeType2Op(nodeType NodeType) code {
return atrs[nodeType].opcode
}
func makeNode(nodeType NodeType, left *Tree, right *Tree) *Tree {
return &Tree{nodeType, left, right, ""}
}
func makeLeaf(nodeType NodeType, value string) *Tree {
return &Tree{nodeType, nil, nil, value}
}
/*** Code generator ***/
func emitByte(c code) {
object = append(object, c)
}
func emitWord(n int) {
bs := make([]byte, 4)
binary.LittleEndian.PutUint32(bs, uint32(n))
for _, b := range bs {
emitByte(code(b))
}
}
func emitWordAt(at, n int) {
bs := make([]byte, 4)
binary.LittleEndian.PutUint32(bs, uint32(n))
for i := at; i < at+4; i++ {
object[i] = code(bs[i-at])
}
}
func hole() int {
t := len(object)
emitWord(0)
return t
}
func fetchVarOffset(id string) int {
for i := 0; i < len(globals); i++ {
if globals[i] == id {
return i
}
}
globals = append(globals, id)
return len(globals) - 1
}
func fetchStringOffset(st string) int {
for i := 0; i < len(stringPool); i++ {
if stringPool[i] == st {
return i
}
}
stringPool = append(stringPool, st)
return len(stringPool) - 1
}
func codeGen(x *Tree) {
if x == nil {
return
}
var n, p1, p2 int
switch x.nodeType {
case ndIdent:
emitByte(fetch)
n = fetchVarOffset(x.value)
emitWord(n)
case ndInteger:
emitByte(push)
n, err = strconv.Atoi(x.value)
check(err)
emitWord(n)
case ndString:
emitByte(push)
n = fetchStringOffset(x.value)
emitWord(n)
case ndAssign:
n = fetchVarOffset(x.left.value)
codeGen(x.right)
emitByte(store)
emitWord(n)
case ndIf:
codeGen(x.left) // if expr
emitByte(jz) // if false, jump
p1 = hole() // make room forjump dest
codeGen(x.right.left) // if true statements
if x.right.right != nil {
emitByte(jmp)
p2 = hole()
}
emitWordAt(p1, len(object)-p1)
if x.right.right != nil {
codeGen(x.right.right)
emitWordAt(p2, len(object)-p2)
}
case ndWhile:
p1 = len(object)
codeGen(x.left) // while expr
emitByte(jz) // if false, jump
p2 = hole() // make room for jump dest
codeGen(x.right) // statements
emitByte(jmp) // back to the top
emitWord(p1 - len(object)) // plug the top
emitWordAt(p2, len(object)-p2) // plug the 'if false, jump'
case ndSequence:
codeGen(x.left)
codeGen(x.right)
case ndPrtc:
codeGen(x.left)
emitByte(prtc)
case ndPrti:
codeGen(x.left)
emitByte(prti)
case ndPrts:
codeGen(x.left)
emitByte(prts)
case ndLss, ndGtr, ndLeq, ndGeq, ndEql, ndNeq,
ndAnd, ndOr, ndSub, ndAdd, ndDiv, ndMul, ndMod:
codeGen(x.left)
codeGen(x.right)
emitByte(nodeType2Op(x.nodeType))
case ndNegate, ndNot:
codeGen(x.left)
emitByte(nodeType2Op(x.nodeType))
default:
msg := fmt.Sprintf("error in code generator - found %d, expecting operator\n", x.nodeType)
reportError(msg)
}
}
func codeFinish() {
emitByte(halt)
}
func listCode() {
fmt.Printf("Datasize: %d Strings: %d\n", len(globals), len(stringPool))
for _, s := range stringPool {
fmt.Println(s)
}
pc := 0
for pc < len(object) {
fmt.Printf("%5d ", pc)
op := object[pc]
pc++
switch op {
case fetch:
x := int32(binary.LittleEndian.Uint32(object[pc : pc+4]))
fmt.Printf("fetch [%d]\n", x)
pc += 4
case store:
x := int32(binary.LittleEndian.Uint32(object[pc : pc+4]))
fmt.Printf("store [%d]\n", x)
pc += 4
case push:
x := int32(binary.LittleEndian.Uint32(object[pc : pc+4]))
fmt.Printf("push %d\n", x)
pc += 4
case add:
fmt.Println("add")
case sub:
fmt.Println("sub")
case mul:
fmt.Println("mul")
case div:
fmt.Println("div")
case mod:
fmt.Println("mod")
case lt:
fmt.Println("lt")
case gt:
fmt.Println("gt")
case le:
fmt.Println("le")
case ge:
fmt.Println("ge")
case eq:
fmt.Println("eq")
case ne:
fmt.Println("ne")
case and:
fmt.Println("and")
case or:
fmt.Println("or")
case neg:
fmt.Println("neg")
case not:
fmt.Println("not")
case jmp:
x := int32(binary.LittleEndian.Uint32(object[pc : pc+4]))
fmt.Printf("jmp (%d) %d\n", x, int32(pc)+x)
pc += 4
case jz:
x := int32(binary.LittleEndian.Uint32(object[pc : pc+4]))
fmt.Printf("jz (%d) %d\n", x, int32(pc)+x)
pc += 4
case prtc:
fmt.Println("prtc")
case prti:
fmt.Println("prti")
case prts:
fmt.Println("prts")
case halt:
fmt.Println("halt")
default:
reportError(fmt.Sprintf("listCode: Unknown opcode %d", op))
}
}
}
func getEnumValue(name string) NodeType {
for _, atr := range atrs {
if atr.enumText == name {
return atr.nodeType
}
}
reportError(fmt.Sprintf("Unknown token %s\n", name))
return -1
}
func loadAst() *Tree {
var nodeType NodeType
var s string
if scanner.Scan() {
line := strings.TrimRight(scanner.Text(), " \t")
tokens := strings.Fields(line)
first := tokens[0]
if first[0] == ';' {
return nil
}
nodeType = getEnumValue(first)
le := len(tokens)
if le == 2 {
s = tokens[1]
} else if le > 2 {
idx := strings.Index(line, `"`)
s = line[idx:]
}
}
check(scanner.Err())
if s != "" {
return makeLeaf(nodeType, s)
}
left := loadAst()
right := loadAst()
return makeNode(nodeType, left, right)
}
func main() {
ast, err := os.Open("ast.txt")
check(err)
defer ast.Close()
scanner = bufio.NewScanner(ast)
codeGen(loadAst())
codeFinish()
listCode()
}

View file

@ -0,0 +1,132 @@
require'format/printf'
(opcodes)=: opcodes=: ;:{{)n
fetch store push add sub mul div mod lt gt le ge
eq ne and or neg not jmp jz prtc prts prti halt
}}-.LF
(ndDisp)=: ndDisp=:;:{{)n
Sequence Multiply Divide Mod Add Subtract Negate Less LessEqual Greater
GreaterEqual Equal NotEqual Not And Or Prts Assign Prti x If x x x While
x x Prtc x Identifier String Integer
}}-.LF
ndDisp,.ndOps=:;: {{)n
x mul div mod add sub neg lt le gt ge eq ne not and or
x x x x x x x x x x x x x x x x
}} -.LF
load_ast=: {{
'node_types node_values'=: 2{.|:(({.,&<&<}.@}.)~ i.&' ');._2 y
1{::0 load_ast ''
:
node_type=. x{::node_types
if. node_type-:,';' do. x;a: return.end.
node_value=. x{::node_values
if. -.''-:node_value do.x;<node_type make_leaf node_value return.end.
'x left'=.(x+1) load_ast''
'x right'=.(x+1) load_ast''
x;<node_type make_node left right
}}
make_leaf=: ;
make_node=: {{m;n;<y}}
typ=: 0&{::
val=: left=: 1&{::
right=: 2&{::
gen_code=: {{
if.y-:'' do.'' return.end.
V=. val y
W=. ;2}.y
select.op=.typ y
case.'Integer'do.gen_int _".V [ gen_op push
case.'String'do.gen_string V [ gen_op push
case.'Identifier'do.gen_var V [ gen_op fetch
case.'Assign'do.gen_var left V [ gen_op store [ gen_code W
case.;:'Multiply Divide Mod Add Subtract Less LessEqual Greater GreaterEqual Equal NotEqual And Or'do.
gen_op op [ gen_code W [ gen_code V
case.;:'Not Negate'do.
gen_op op [ gen_code V
case.'If'do.
p1=. gen_int 0 [ gen_op jz [ gen_code V
gen_code left W
if.#right W do.
p2=. gen_int 0 [ gen_op jmp
gen_code right W [ p1 patch #object
p2 patch #object
else.
p1 patch #object
end.
case.'While'do.
p1=. #object
p2=. gen_int 0 [ gen_op jz [ gen_code V
gen_int p1 [ gen_op jmp [ gen_code W
p2 patch #object
case.'Prtc'do.gen_op prtc [ gen_code V
case.'Prti'do.gen_op prti [ gen_code V
case.'Prts'do.gen_op prts [ gen_code V
case.'Sequence'do.
gen_code W [ gen_code V
case.do.error'unknown node type ',typ y
end.
}}
gen_op=:{{
arg=. boxopen y
if. -.arg e. opcodes do.
arg=. (ndDisp i. arg){ndOps
end.
assert. arg e. opcodes
object=: object,opcodes i.arg
}}
gen_int=:{{
if.#$y do.num=. _ ".y
else.num=. y end.
r=. #object
object=: object,(4#256)#:num
r
}}
gen_string=: {{
strings=:~.strings,<y
gen_int strings i.<y
}}
gen_var=: {{
vars=:~.vars,<y
gen_int vars i.<y
}}
patch=: {{ #object=: ((4#256)#:y) (x+i.4)} object }}
error=: {{echo y throw.}}
getint=: _2147483648+4294967296|2147483648+256#.]
list_code=: {{
r=.'Datasize: %d Strings: %d\n' sprintf vars;&#strings
r=.r,;strings,each LF
pc=. 0
lim=.<:#object
while.do.
op=.(pc{object){::opcodes
r=.r,'%5d %s'sprintf pc;op
pc=. pc+1
i=. getint (lim<.pc+i.4){object
k=. 0
select.op
case.fetch;store do.k=.4[r=.r,' [%d]'sprintf i
case.push do.k=.4[r=.r,' %d'sprintf i
case.jmp;jz do.k=.4[r=.r,' (%d) %d'sprintf (i-pc);i
case.halt do.r=.r,LF return.
end.
pc=.pc+k
r=.r,LF
end.
}}
gen=: {{
object=:strings=:vars=:i.0
gen_code load_ast y
list_code gen_op halt
}}

View file

@ -0,0 +1,30 @@
count=:{{)n
count = 1;
while (count < 10) {
print("count is: ", count, "\n");
count = count + 1;
}
}}
gen syntax lex count
Datasize: 1 Strings: 2
"count is: "
"\n"
0 push 1
5 store [0]
10 fetch [0]
15 push 10
20 lt
21 jz (43) 65
26 push 0
31 prts
32 fetch [0]
37 prti
38 push 1
43 prts
44 fetch [0]
49 push 1
54 add
55 store [0]
60 jmp (-51) 10
65 halt

View file

@ -0,0 +1,342 @@
package codegenerator;
import java.io.File;
import java.util.ArrayList;
import java.util.Arrays;
import java.util.HashMap;
import java.util.List;
import java.util.Map;
import java.util.Scanner;
public class CodeGenerator {
final static int WORDSIZE = 4;
static byte[] code = {};
static Map<String, NodeType> str_to_nodes = new HashMap<>();
static List<String> string_pool = new ArrayList<>();
static List<String> variables = new ArrayList<>();
static int string_count = 0;
static int var_count = 0;
static Scanner s;
static NodeType[] unary_ops = {
NodeType.nd_Negate, NodeType.nd_Not
};
static NodeType[] operators = {
NodeType.nd_Mul, NodeType.nd_Div, NodeType.nd_Mod, NodeType.nd_Add, NodeType.nd_Sub,
NodeType.nd_Lss, NodeType.nd_Leq, NodeType.nd_Gtr, NodeType.nd_Geq,
NodeType.nd_Eql, NodeType.nd_Neq, NodeType.nd_And, NodeType.nd_Or
};
static enum Mnemonic {
NONE, FETCH, STORE, PUSH, ADD, SUB, MUL, DIV, MOD, LT, GT, LE, GE, EQ, NE, AND, OR, NEG, NOT,
JMP, JZ, PRTC, PRTS, PRTI, HALT
}
static class Node {
public NodeType nt;
public Node left, right;
public String value;
Node() {
this.nt = null;
this.left = null;
this.right = null;
this.value = null;
}
Node(NodeType node_type, Node left, Node right, String value) {
this.nt = node_type;
this.left = left;
this.right = right;
this.value = value;
}
public static Node make_node(NodeType nodetype, Node left, Node right) {
return new Node(nodetype, left, right, "");
}
public static Node make_node(NodeType nodetype, Node left) {
return new Node(nodetype, left, null, "");
}
public static Node make_leaf(NodeType nodetype, String value) {
return new Node(nodetype, null, null, value);
}
}
static enum NodeType {
nd_None("", Mnemonic.NONE), nd_Ident("Identifier", Mnemonic.NONE), nd_String("String", Mnemonic.NONE), nd_Integer("Integer", Mnemonic.NONE), nd_Sequence("Sequence", Mnemonic.NONE),
nd_If("If", Mnemonic.NONE),
nd_Prtc("Prtc", Mnemonic.NONE), nd_Prts("Prts", Mnemonic.NONE), nd_Prti("Prti", Mnemonic.NONE), nd_While("While", Mnemonic.NONE),
nd_Assign("Assign", Mnemonic.NONE),
nd_Negate("Negate", Mnemonic.NEG), nd_Not("Not", Mnemonic.NOT), nd_Mul("Multiply", Mnemonic.MUL), nd_Div("Divide", Mnemonic.DIV), nd_Mod("Mod", Mnemonic.MOD), nd_Add("Add", Mnemonic.ADD),
nd_Sub("Subtract", Mnemonic.SUB), nd_Lss("Less", Mnemonic.LT), nd_Leq("LessEqual", Mnemonic.LE),
nd_Gtr("Greater", Mnemonic.GT), nd_Geq("GreaterEqual", Mnemonic.GE), nd_Eql("Equal", Mnemonic.EQ),
nd_Neq("NotEqual", Mnemonic.NE), nd_And("And", Mnemonic.AND), nd_Or("Or", Mnemonic.OR);
private final String name;
private final Mnemonic m;
NodeType(String name, Mnemonic m) {
this.name = name;
this.m = m;
}
Mnemonic getMnemonic() { return this.m; }
@Override
public String toString() { return this.name; }
}
static void appendToCode(int b) {
code = Arrays.copyOf(code, code.length + 1);
code[code.length - 1] = (byte) b;
}
static void emit_byte(Mnemonic m) {
appendToCode(m.ordinal());
}
static void emit_word(int n) {
appendToCode(n >> 24);
appendToCode(n >> 16);
appendToCode(n >> 8);
appendToCode(n);
}
static void emit_word_at(int pos, int n) {
code[pos] = (byte) (n >> 24);
code[pos + 1] = (byte) (n >> 16);
code[pos + 2] = (byte) (n >> 8);
code[pos + 3] = (byte) n;
}
static int get_word(int pos) {
int result;
result = ((code[pos] & 0xff) << 24) + ((code[pos + 1] & 0xff) << 16) + ((code[pos + 2] & 0xff) << 8) + (code[pos + 3] & 0xff) ;
return result;
}
static int fetch_var_offset(String name) {
int n;
n = variables.indexOf(name);
if (n == -1) {
variables.add(name);
n = var_count++;
}
return n;
}
static int fetch_string_offset(String str) {
int n;
n = string_pool.indexOf(str);
if (n == -1) {
string_pool.add(str);
n = string_count++;
}
return n;
}
static int hole() {
int t = code.length;
emit_word(0);
return t;
}
static boolean arrayContains(NodeType[] a, NodeType n) {
boolean result = false;
for (NodeType test: a) {
if (test.equals(n)) {
result = true;
break;
}
}
return result;
}
static void code_gen(Node x) throws Exception {
int n, p1, p2;
if (x == null) return;
switch (x.nt) {
case nd_None: return;
case nd_Ident:
emit_byte(Mnemonic.FETCH);
n = fetch_var_offset(x.value);
emit_word(n);
break;
case nd_Integer:
emit_byte(Mnemonic.PUSH);
emit_word(Integer.parseInt(x.value));
break;
case nd_String:
emit_byte(Mnemonic.PUSH);
n = fetch_string_offset(x.value);
emit_word(n);
break;
case nd_Assign:
n = fetch_var_offset(x.left.value);
code_gen(x.right);
emit_byte(Mnemonic.STORE);
emit_word(n);
break;
case nd_If:
p2 = 0; // to avoid NetBeans complaining about 'not initialized'
code_gen(x.left);
emit_byte(Mnemonic.JZ);
p1 = hole();
code_gen(x.right.left);
if (x.right.right != null) {
emit_byte(Mnemonic.JMP);
p2 = hole();
}
emit_word_at(p1, code.length - p1);
if (x.right.right != null) {
code_gen(x.right.right);
emit_word_at(p2, code.length - p2);
}
break;
case nd_While:
p1 = code.length;
code_gen(x.left);
emit_byte(Mnemonic.JZ);
p2 = hole();
code_gen(x.right);
emit_byte(Mnemonic.JMP);
emit_word(p1 - code.length);
emit_word_at(p2, code.length - p2);
break;
case nd_Sequence:
code_gen(x.left);
code_gen(x.right);
break;
case nd_Prtc:
code_gen(x.left);
emit_byte(Mnemonic.PRTC);
break;
case nd_Prti:
code_gen(x.left);
emit_byte(Mnemonic.PRTI);
break;
case nd_Prts:
code_gen(x.left);
emit_byte(Mnemonic.PRTS);
break;
default:
if (arrayContains(operators, x.nt)) {
code_gen(x.left);
code_gen(x.right);
emit_byte(x.nt.getMnemonic());
} else if (arrayContains(unary_ops, x.nt)) {
code_gen(x.left);
emit_byte(x.nt.getMnemonic());
} else {
throw new Exception("Error in code generator! Found " + x.nt + ", expecting operator.");
}
}
}
static void list_code() throws Exception {
int pc = 0, x;
Mnemonic op;
System.out.println("Datasize: " + var_count + " Strings: " + string_count);
for (String s: string_pool) {
System.out.println(s);
}
while (pc < code.length) {
System.out.printf("%4d ", pc);
op = Mnemonic.values()[code[pc++]];
switch (op) {
case FETCH:
x = get_word(pc);
System.out.printf("fetch [%d]", x);
pc += WORDSIZE;
break;
case STORE:
x = get_word(pc);
System.out.printf("store [%d]", x);
pc += WORDSIZE;
break;
case PUSH:
x = get_word(pc);
System.out.printf("push %d", x);
pc += WORDSIZE;
break;
case ADD: case SUB: case MUL: case DIV: case MOD:
case LT: case GT: case LE: case GE: case EQ: case NE:
case AND: case OR: case NEG: case NOT:
case PRTC: case PRTI: case PRTS: case HALT:
System.out.print(op.toString().toLowerCase());
break;
case JMP:
x = get_word(pc);
System.out.printf("jmp (%d) %d", x, pc + x);
pc += WORDSIZE;
break;
case JZ:
x = get_word(pc);
System.out.printf("jz (%d) %d", x, pc + x);
pc += WORDSIZE;
break;
default:
throw new Exception("Unknown opcode " + code[pc] + "@" + (pc - 1));
}
System.out.println();
}
}
static Node load_ast() throws Exception {
String command, value;
String line;
Node left, right;
while (s.hasNext()) {
line = s.nextLine();
value = null;
if (line.length() > 16) {
command = line.substring(0, 15).trim();
value = line.substring(15).trim();
} else {
command = line.trim();
}
if (command.equals(";")) {
return null;
}
if (!str_to_nodes.containsKey(command)) {
throw new Exception("Command not found: '" + command + "'");
}
if (value != null) {
return Node.make_leaf(str_to_nodes.get(command), value);
}
left = load_ast(); right = load_ast();
return Node.make_node(str_to_nodes.get(command), left, right);
}
return null; // for the compiler, not needed
}
public static void main(String[] args) {
Node n;
str_to_nodes.put(";", NodeType.nd_None);
str_to_nodes.put("Sequence", NodeType.nd_Sequence);
str_to_nodes.put("Identifier", NodeType.nd_Ident);
str_to_nodes.put("String", NodeType.nd_String);
str_to_nodes.put("Integer", NodeType.nd_Integer);
str_to_nodes.put("If", NodeType.nd_If);
str_to_nodes.put("While", NodeType.nd_While);
str_to_nodes.put("Prtc", NodeType.nd_Prtc);
str_to_nodes.put("Prts", NodeType.nd_Prts);
str_to_nodes.put("Prti", NodeType.nd_Prti);
str_to_nodes.put("Assign", NodeType.nd_Assign);
str_to_nodes.put("Negate", NodeType.nd_Negate);
str_to_nodes.put("Not", NodeType.nd_Not);
str_to_nodes.put("Multiply", NodeType.nd_Mul);
str_to_nodes.put("Divide", NodeType.nd_Div);
str_to_nodes.put("Mod", NodeType.nd_Mod);
str_to_nodes.put("Add", NodeType.nd_Add);
str_to_nodes.put("Subtract", NodeType.nd_Sub);
str_to_nodes.put("Less", NodeType.nd_Lss);
str_to_nodes.put("LessEqual", NodeType.nd_Leq);
str_to_nodes.put("Greater", NodeType.nd_Gtr);
str_to_nodes.put("GreaterEqual", NodeType.nd_Geq);
str_to_nodes.put("Equal", NodeType.nd_Eql);
str_to_nodes.put("NotEqual", NodeType.nd_Neq);
str_to_nodes.put("And", NodeType.nd_And);
str_to_nodes.put("Or", NodeType.nd_Or);
if (args.length > 0) {
try {
s = new Scanner(new File(args[0]));
n = load_ast();
code_gen(n);
emit_byte(Mnemonic.HALT);
list_code();
} catch (Exception e) {
System.out.println("Ex: "+e);//.getMessage());
}
}
}
}

View file

@ -0,0 +1,162 @@
import Base.show
mutable struct Asm32
offset::Int32
code::String
arg::Int32
targ::Int32
end
Asm32(code, arg = 0) = Asm32(0, code, arg, 0)
show(io::IO, a::Asm32) = print(io, lpad("$(a.offset)", 6), lpad(a.code, 8),
a.targ > 0 ? (lpad("($(a.arg))", 8) * lpad("$(a.targ)", 4)) :
(a.code in ["store", "fetch"] ? lpad("[$(a.arg)]", 8) :
(a.code in ["push"] ? lpad("$(a.arg)", 8) : "")))
const ops32 = Dict{String,String}("Multiply" => "mul", "Divide" => "div", "Mod" => "mod", "Add" => "add",
"Subtract" => "sub", "Less" => "lt", "Greater" => "gt", "LessEqual" => "le", "GreaterEqual" => "ge",
"Equal" => "eq", "NotEqual" => "ne", "And" => "and", "or" => "or", "Not" => "not", "Minus" => "neg",
"Prtc" => "prtc", "Prti" => "prti", "Prts" => "prts")
function compiletoasm(io)
identifiers = Vector{String}()
strings = Vector{String}()
labels = Vector{Int}()
function cpile(io, islefthandside = false)
arr = Vector{Asm32}()
jlabel() = (push!(labels, length(labels) + 1); labels[end])
m = match(r"^(\w+|;)\s*([\d\w\"\\ \S]+)?", strip(readline(io)))
x, val = m == nothing ? Pair(";", 0) : m.captures
if x == ";" return arr
elseif x == "Assign"
lhs = cpile(io, true)
rhs = cpile(io)
append!(arr, rhs)
append!(arr, lhs)
if length(arr) > 100 exit() end
elseif x == "Integer" push!(arr, Asm32("push", parse(Int32, val)))
elseif x == "String"
if !(val in strings)
push!(strings, val)
end
push!(arr, Asm32("push", findfirst(x -> x == val, strings) - 1))
elseif x == "Identifier"
if !(val in identifiers)
if !islefthandside
throw("Identifier $val referenced before it is assigned")
end
push!(identifiers, val)
end
push!(arr, Asm32(islefthandside ? "store" : "fetch", findfirst(x -> x == val, identifiers) - 1))
elseif haskey(ops32, x)
append!(arr, cpile(io))
append!(arr, cpile(io))
push!(arr, Asm32(ops32[x]))
elseif x == "If"
append!(arr, cpile(io))
x, y = jlabel(), jlabel()
push!(arr, Asm32("jz", x))
append!(arr, cpile(io))
push!(arr, Asm32("jmp", y))
a = cpile(io)
if length(a) < 1
push!(a, Asm32("nop", 0))
end
a[1].offset = x
append!(arr, a)
push!(arr, Asm32(y, "nop", 0, 0)) # placeholder
elseif x == "While"
x, y = jlabel(), jlabel()
a = cpile(io)
if length(a) < 1
push!(a, Asm32("nop", 0))
end
a[1].offset = x
append!(arr, a)
push!(arr, Asm32("jz", y))
append!(arr, cpile(io))
push!(arr, Asm32("jmp", x), Asm32(y, "nop", 0, 0))
elseif x == "Sequence"
append!(arr, cpile(io))
append!(arr, cpile(io))
else
throw("unknown node type: $x")
end
arr
end
# compile AST
asmarr = cpile(io)
push!(asmarr, Asm32("halt"))
# move address markers to working code and prune nop code
for (i, acode) in enumerate(asmarr)
if acode.code == "nop" && acode.offset != 0 && i < length(asmarr)
asmarr[i + 1].offset = asmarr[i].offset
end
end
filter!(x -> x.code != "nop", asmarr)
# renumber offset column with actual offsets
pos = 0
jmps = Dict{Int, Int}()
for acode in asmarr
if acode.offset > 0
jmps[acode.offset] = pos
end
acode.offset = pos
pos += acode.code in ["push", "store", "fetch", "jz", "jmp"] ? 5 : 1
end
# fix up jump destinations
for acode in asmarr
if acode.code in ["jz", "jmp"]
if haskey(jmps, acode.arg)
acode.targ = jmps[acode.arg]
acode.arg = acode.targ - acode.offset -1
else
throw("unknown jump location: $acode")
end
end
end
# print Datasize and Strings header
println("Datasize: $(length(identifiers)) Strings: $(length(strings))\n" *
join(strings, "\n") )
# print assembly lines
foreach(println, asmarr)
end
const testAST = raw"""
Sequence
Sequence
;
Assign
Identifier count
Integer 1
While
Less
Identifier count
Integer 10
Sequence
Sequence
;
Sequence
Sequence
Sequence
;
Prts
String "count is: "
;
Prti
Identifier count
;
Prts
String "\n"
;
Assign
Identifier count
Add
Identifier count
Integer 1 """
iob = IOBuffer(testAST) # use an io buffer here for testing, but could use stdin instead of iob
compiletoasm(iob)

View file

@ -0,0 +1,224 @@
Module CodeGenerator (s$){
Function code$(op$) {
=format$("{0::-6} {1}", pc, op$)
pc++
}
Function code2$(op$, n$) {
=format$("{0::-6} {1} {2}", pc, op$, n$)
pc+=5
}
Function code3$(op$,pc, st, ed) {
=format$("{0::-6} {1} ({2}) {3}", pc, op$, ed-st-1, ed)
}
Enum tok {
gneg, gnot, gmul, gdiv, gmod, gadd, gle, gsub, glt
gle, ggt, gge, geq, gne, gand, gor, gprtc, gprti, gprts,
gif, gwhile, gAssign, gSeq, gstring, gidentifier, gint, gnone
}
\\ Inventories are lists with keys, or keys/data (key must be unique)
\\ there is one type more the Invetory Queue which get same keys.
\\ But here not used.
Inventory symb="Multiply":=gmul, "Divide":=gdiv, "Mod":=gmod, "Add":=gadd
Append symb, "Negate":=gneg, "Not":=gnot,"Less":=glt,"Subtract":=gsub
Append symb, "LessEqual":=gle, "Greater":=ggt, "GreaterEqual":=gge, "Sequence":=gSeq
Append symb, "Equal":=geq, "NotEqual":=gne, "And":=gand, "Or":=gor, "While":=gwhile
Append symb, "Prtc":=gprtc,"Prti":=gprti,"Prts":=gprts, "Assign":=gAssign, "If":=gif
Append symb, "String":=gstring, "Identifier":=gidentifier, "Integer":=gint, ";", gnone
Inventory DataSet
\\ We set string as key. key maybe an empty string, a string or a number.
\\ so we want eash string to saved one time only.
Inventory Strings
Const nl$=chr$(13)+chr$(10), Ansi=3
Def z$, lim, line$, newvar_ok, i=0
Document message$=nl$
Global pc \\ functions have own scope, so we make it global, for this module, and childs.
Dim lines$()
s$=filter$(s$,chr$(9)) \\ exclude tabs
Lines$()=piece$(s$,nl$) \\ break to lines
lim=len(Lines$())
Flush ' empty stack (there is a current stack of values which we use here)
Load_Ast()
If not stack.size=1 Then Flush : Error "Ast not loaded"
AST=array \\ pop the array from stack
Document Assembly$, Header$
\\ all lines of assembly goes to stack. Maybe not in right order.
\\ Push statement push to top, Data statement push to bottom of stack
CodeGenerator(Ast)
Data code$("halt") ' append to end of stack
\\ So now we get all data (letters) from stack
While not empty
Assembly$=letter$+nl$
end while
\\ So now we have to place them in order
Sort Assembly$
\\ Let's make the header
Header$=format$("Datasize: {0} Strings: {1}", Len(Dataset),Len(strings))
\\ we use an iterator object, str^ is the counter, readonly, but Eval$() use it from object.
str=each(strings)
While str
Header$=nl$+Eval$(str)
End while
Assembly$=nl$
\\ insert to line 1 the Header
Insert 1 Assembly$=Header$
\\ Also we check for warnings
If len(message$)>2 then Assembly$="Warnings: "+nl$+message$
\\ So now we get a report
\\ (at each 3/4 of window's lines, the printing stop and wait for user response, any key)
Report Assembly$
Clipboard Assembly$
Save.Doc Assembly$, "code.t", Ansi
End
\\ subs have 10000 limit for recursion but can be extended to 1000000 or more.
Sub CodeGenerator(t)
If len(t)=3 then
select case t#val(0)
Case gSeq
CodeGenerator(t#val(1)) : CodeGenerator(t#val(2))
Case gwhile
{
local spc=pc
CodeGenerator(t#val(1))
local pc1=pc
pc+=5 ' room for jz
CodeGenerator(t#val(2))
data code3$("jz",pc1, pc1, pc+5)
data code3$("jmp",pc, pc, spc)
pc+=5 ' room for jmp
}
Case gif
{
CodeGenerator(t#val(1))
local pc1=pc, pc2
pc+=5
CodeGenerator(t#val(2)#val(1))
If len(t#val(2)#val(2))>0 then
pc2=pc
pc+=5
data code3$("jz",pc1, pc1, pc)
CodeGenerator(t#val(2)#val(2))
data code3$("jmp",pc2, pc2, pc)
else
data code3$("jz",pc1, pc1, pc)
end If
}
Case gAssign
{
CodeGenerator(t#val(2))
local newvar_ok=true
CodeGenerator(t#val(1))
}
case gneg to gnot, gprtc to gprts
CodeGenerator(t#val(1)) : data code$(mid$(eval$(t#val(0)),2))
case gmul to gor
{
CodeGenerator(t#val(1))
CodeGenerator(t#val(2))
data code$(mid$(eval$(t#val(0)),2))
}
End select
Else.if len(t)=2 then
select case t#val(0)
Case gString
{
local spos
If exist(strings,t#val$(1)) then
spos=eval(strings!)
else
append strings, t#val$(1)
spos=len(strings)-1
end If
Push code2$("push",str$(spos,0))
}
Case gInt
Push code2$("push",t#val$(1), pc)
Case gIdentifier
{
local ipos
If exist(dataset,t#val$(1)) then
ipos=Eval(dataset!) ' return position
else.if newvar_ok then
Append dataset, t#val$(1)
ipos=len(dataset)-1
else
message$="Variable "+t#val$(1)+" not initialized"+nl$
end If
If newvar_ok then
Push code2$("store","["+str$(ipos, 0)+"]")
else
Push code2$("fetch","["+str$(ipos, 0)+"]")
end If
}
end select
End If
End Sub
Sub Load_Ast()
If i>=lim then Push (,) : exit sub
do
line$=Trim$(lines$(i))
I++
tok$=piece$(line$," ")(0)
until line$<>"" or i>=lim
If tok$="Identifier" then
Push (gidentifier,trim$(Mid$(line$,11)))
else.if tok$="Integer" then
long n=Val(Mid$(line$,8)) ' check overflow
Push (gint, Trim$(Mid$(line$,8)))
else.if tok$="String" then
Push (gstring,Trim$(Mid$(line$,7)))
else.if tok$=";" then
Push (,)
Else
local otok=symb(tok$)
Load_Ast()
Load_Ast()
Shift 2
Push (otok,array, array)
End If
End Sub
}
CodeGenerator {
Sequence
Sequence
;
Assign
Identifier count
Integer 1
While
Less
Identifier count
Integer 10
Sequence
Sequence
;
Sequence
Sequence
Sequence
;
Prts
String "count is: "
;
Prti
Identifier count
;
Prts
String "\n"
;
Assign
Identifier count
Add
Identifier count
Integer 1
}

View file

@ -0,0 +1,311 @@
import os, re, streams, strformat, strutils, tables, std/decls
type
# AST node types.
NodeKind = enum
nIdentifier = "Identifier"
nString = "String"
nInteger = "Integer"
nSequence = "Sequence"
nIf = "If"
nPrtc = "Prtc"
nPrts = "Prts"
nPrti = "Prti"
nWhile = "While"
nAssign = "Assign"
nNegate = "Negate"
nNot = "Not"
nMultiply = "Multiply"
nDivide = "Divide"
nMod = "Mod"
nAdd = "Add"
nSubtract = "Subtract"
nLess = "Less"
nLessEqual = "LessEqual"
nGreater = "Greater"
nGreaterEqual = "GreaterEqual"
nEqual = "Equal"
nNotEqual = "NotEqual"
nAnd = "And"
nOr = "Or"
# Ast node description.
Node = ref object
left: Node
right: Node
case kind: NodeKind
of nString: stringVal: string
of nInteger: intVal: int
of nIdentifier: name: string
else: nil
# Virtual machine opcodes.
OpCode = enum
opFetch = "fetch"
opStore = "store"
opPush = "push"
opJmp = "jmp"
opJz = "jz"
opAdd = "add"
opSub = "sub"
opMul = "mul"
opDiv = "div"
opMod = "mod"
opLt = "lt"
opgt = "gt"
opLe = "le"
opGe = "ge"
opEq = "eq"
opNe = "ne"
opAnd = "and"
opOr = "or"
opNeg = "neg"
opNot = "not"
opPrtc = "prtc"
opPrti = "prti"
opPrts = "prts"
opHalt = "halt"
opInvalid = "invalid"
# Code generator context.
CodeGen = object
address: int # Current address in code part.
instr: seq[string] # List of instructions.
vars: Table[string, int] # Mapping variable name -> variable index.
strings: seq[string] # List of strings.
# Node ranges.
UnaryOpNode = range[nNegate..nNot]
BinaryOpNode = range[nMultiply..nOr]
PrintNode = range[nPrtc..nPrti]
const
# Mapping unary operator Node -> OpCode.
UnOp: array[UnaryOpNode, OpCode] = [opNeg, opNot]
# Mapping binary operator Node -> OpCode.
BinOp: array[BinaryOpNode, OpCode] = [opMul, opDiv, opMod, opAdd, opSub, opLt,
opLe, opGt, opGe, opEq, opNe, opAnd, opOr]
# Mapping print Node -> OpCode.
PrintOp: array[PrintNode, OpCode] = [opPrtc, opPrts, opPrti]
####################################################################################################
# Code generator.
proc genSimpleInst(gen: var CodeGen; opcode: OpCode) =
## Build a simple instruction (no operand).
gen.instr.add &"{gen.address:>5} {opcode}"
#---------------------------------------------------------------------------------------------------
proc genMemInst(gen: var CodeGen; opcode: OpCode; memIndex: int) =
## Build a memory access instruction (opFetch, opStore).
gen.instr.add &"{gen.address:>5} {opcode:<5} [{memIndex}]"
#---------------------------------------------------------------------------------------------------
proc genJumpInst(gen: var CodeGen; opcode: OpCode): int =
## Build a jump instruction. We use the letters X and Y as placeholders
## for the offset and the target address.
result = gen.instr.len
gen.instr.add &"{gen.address:>5} {opcode:<5} (X) Y"
#---------------------------------------------------------------------------------------------------
proc genPush(gen: var CodeGen; value: int) =
## Build a push instruction.
gen.instr.add &"{gen.address:>5} {opPush:<5} {value}"
#---------------------------------------------------------------------------------------------------
proc updateJumpInst(gen: var CodeGen; index: int; jumpAddress, targetAddress: int) =
## Update the offset and the target address of a jump instruction.
var instr {.byAddr.} = gen.instr[index]
let offset = targetAddress - jumpAddress - 1
for idx in countdown(instr.high, 0):
case instr[idx]
of 'Y':
instr[idx..idx] = $targetAddress
of 'X':
instr[idx..idx] = $offset
break
else:
discard
#---------------------------------------------------------------------------------------------------
proc process(gen: var CodeGen; node: Node) =
## Generate code for a node.
if node.isNil: return
case node.kind:
of nInteger:
gen.genPush(node.intVal)
inc gen.address, 5
of nIdentifier:
if node.name notin gen.vars:
gen.vars[node.name] = gen.vars.len
gen.genMemInst(opFetch, gen.vars[node.name])
inc gen.address, 5
of nString:
var index = gen.strings.find(node.stringVal)
if index < 0:
index = gen.strings.len
gen.strings.add(node.stringVal)
gen.genPush(index)
inc gen.address, 5
of nAssign:
gen.process(node.right)
if node.left.name notin gen.vars:
gen.vars[node.left.name] = gen.vars.len
gen.genMemInst(opStore, gen.vars[node.left.name])
inc gen.address, 5
of UnaryOpNode.low..UnaryOpNode.high:
gen.process(node.left)
gen.genSimpleInst(UnOp[node.kind])
inc gen.address
of BinaryOpNode.low..BinaryOpNode.high:
gen.process(node.left)
gen.process(node.right)
gen.genSimpleInst(BinOp[node.kind])
inc gen.address
of PrintNode.low..PrintNode.high:
gen.process(node.left)
gen.genSimpleInst(PrintOp[node.kind])
inc gen.address
of nIf:
# Generate condition expression.
gen.process(node.left)
# Generate jump if zero.
let jzAddr = gen.address
let jzInst = gen.genJumpInst(opJz)
inc gen.address, 5
# Generate then branch expression.
gen.process(node.right.left)
# If there is an "else" clause, generate unconditional jump
var jmpAddr, jmpInst: int
let hasElseClause = not node.right.right.isNil
if hasElseClause:
jmpAddr = gen.address
jmpInst = gen.genJumpInst(opJmp)
inc gen.address, 5
# Update JZ offset.
gen.updateJumpInst(jzInst, jzAddr, gen.address)
# Generate else expression.
if hasElseClause:
gen.process(node.right.right)
# Update JMP offset.
gen.updateJumpInst(jmpInst, jmpAddr, gen.address)
of nWhile:
let condAddr = gen.address
# Generate condition expression.
gen.process(node.left)
# Generate jump if zero.
let jzAddr = gen.address
let jzInst = gen.genJumpInst(opJz)
inc gen.address, 5
# Generate loop code.
gen.process(node.right)
# Generate unconditional jump.
let jmpAddr = gen.address
let jmpInst = gen.genJumpInst(opJmp)
inc gen.address, 5
# Update JMP offset.
gen.updateJumpInst(jmpInst, jmpAddr, condAddr)
# Update JZ offset.
gen.updateJumpInst(jzInst, jzAddr, gen.address)
of nSequence:
gen.process(node.left)
gen.process(node.right)
#---------------------------------------------------------------------------------------------------
proc run(gen: var CodeGen; ast: Node) =
## Run the code generator on the AST.
# Process recursively the nodes.
gen.process(ast)
gen.genSimpleInst(opHalt) # Add a Halt operator at the end.
# Output header.
echo &"Datasize: {gen.vars.len} Strings: {gen.strings.len}"
# Output strings.
for s in gen.strings:
echo s.escape().replace("\\x0A", "\\n")
# Output code.
for inst in gen.instr:
echo inst
####################################################################################################
# AST loader.
proc newNode(kind: NodeKind; left: Node; right: Node = nil): Node =
## Create a new node with given left and right children.
result = Node(kind: kind, left: left, right: right)
#---------------------------------------------------------------------------------------------------
proc loadAst(stream: Stream): Node =
## Load a linear AST and build a binary tree.
let line = stream.readLine().strip()
if line.startsWith(';'):
return nil
var fields = line.split(' ', 1)
let kind = parseEnum[NodeKind](fields[0])
if kind in {nIdentifier, nString, nInteger}:
if fields.len < 2:
raise newException(ValueError, "Missing value field for " & fields[0])
else:
fields[1] = fields[1].strip()
case kind
of nIdentifier:
return Node(kind: nIdentifier, name: fields[1])
of nString:
let str = fields[1].replacef(re"([^\\])(\\n)", "$1\n").replace(r"\\", r"\").replace("\"", "")
return Node(kind: nString, stringVal: str)
of nInteger:
return Node(kind: nInteger, intVal: parseInt(fields[1]))
else:
if fields.len > 1:
raise newException(ValueError, "Extra field for " & fields[0])
let left = stream.loadAst()
let right = stream.loadAst()
result = newNode(kind, left, right)
#———————————————————————————————————————————————————————————————————————————————————————————————————
var stream: Stream
var toClose = false
var codegen: CodeGen
if paramCount() < 1:
stream = newFileStream(stdin)
else:
stream = newFileStream(paramStr(1))
toClose = true
let ast = loadAst(stream)
if toClose: stream.close()
codegen.run(ast)

View file

@ -0,0 +1,40 @@
#!/usr/bin/perl
use strict; # gen.pl - flatAST to stack machine code
use warnings; # http://www.rosettacode.org/wiki/Compiler/code_generator
my $stringcount = my $namecount = my $pairsym = my $pc = 0;
my (%strings, %names);
my %opnames = qw( Less lt LessEqual le Multiply mul Subtract sub Divide div
GreaterEqual ge Equal eq Greater gt NotEqual ne Negate neg );
sub tree
{
my ($A, $B) = ( '_' . ++$pairsym, '_' . ++$pairsym ); # labels for jumps
my $line = <> // return '';
(local $_, my $arg) = $line =~ /^(\w+|;)\s+(.*)/ or die "bad input $line";
/Identifier/ ? "fetch [@{[ $names{$arg} //= $namecount++ ]}]\n" :
/Sequence/ ? tree() . tree() :
/Integer/ ? "push $arg\n" :
/String/ ? "push @{[ $strings{$arg} //= $stringcount++ ]}\n" :
/Assign/ ? join '', reverse tree() =~ s/fetch/store/r, tree() :
/While/ ? "$A:\n@{[ tree() ]}jz $B\n@{[ tree() ]}jmp $A\n$B:\n" :
/If/ ? tree() . "jz $A\n@{[ !<> . # !<> skips second 'If'
tree() ]}jmp $B\n$A:\n@{[ tree() ]}$B:\n" :
/;/ ? '' :
tree() . tree() . ($opnames{$_} // lc) . "\n";
}
$_ = tree() . "halt\n";
s/^jmp\s+(\S+)\n(_\d+:\n)\1:\n/$2/gm; # remove jmp next
s/^(?=[a-z]\w*(.*))/ # add locations
(sprintf("%4d ", $pc), $pc += $1 ? 5 : 1)[0] /gem;
my %labels = /^(_\d+):(?=(?:\n_\d+:)*\n *(\d+) )/gm; # pc addr of labels
s/^ *(\d+) j(?:z|mp) *\K(_\d+)$/ (@{[ # fix jumps
$labels{$2} - $1 - 1]}) $labels{$2}/gm;
s/^_\d+.*\n//gm; # remove labels
print "Datasize: $namecount Strings: $stringcount\n";
print "$_\n" for sort { $strings{$a} <=> $strings{$b} } keys %strings;
print;

View file

@ -0,0 +1,395 @@
(notonline)-->
<span style="color: #000080;font-style:italic;">--
-- demo\rosetta\Compiler\cgen.e
-- ============================
--
-- The reusable part of cgen.exw
--</span>
<span style="color: #008080;">without</span> <span style="color: #008080;">js</span> <span style="color: #000080;font-style:italic;">-- (machine code!)</span>
<span style="color: #008080;">include</span> <span style="color: #000000;">parse</span><span style="color: #0000FF;">.</span><span style="color: #000000;">e</span>
<span style="color: #008080;">global</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">vars</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{},</span>
<span style="color: #000000;">strings</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{},</span>
<span style="color: #000000;">stringptrs</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
<span style="color: #008080;">global</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">chain</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #008080;">global</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">code</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">var_idx</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">inode</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">inode</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]!=</span><span style="color: #000000;">tk_Identifier</span> <span style="color: #008080;">then</span> <span style="color: #0000FF;">?</span><span style="color: #000000;">9</span><span style="color: #0000FF;">/</span><span style="color: #000000;">0</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">ident</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">inode</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">]</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">ident</span><span style="color: #0000FF;">,</span><span style="color: #000000;">vars</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">vars</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">vars</span><span style="color: #0000FF;">,</span><span style="color: #000000;">ident</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">vars</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">n</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">string_idx</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">inode</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">inode</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]!=</span><span style="color: #000000;">tk_String</span> <span style="color: #008080;">then</span> <span style="color: #0000FF;">?</span><span style="color: #000000;">9</span><span style="color: #0000FF;">/</span><span style="color: #000000;">0</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">inode</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">]</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">,</span><span style="color: #000000;">strings</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">strings</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">strings</span><span style="color: #0000FF;">,</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">stringptrs</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">stringptrs</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">strings</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">n</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">gen_size</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
<span style="color: #000080;font-style:italic;">-- note: must be kept precisely in sync with gen_rec!
-- (relentlessly tested via estsize/actsize)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">size</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">!=</span><span style="color: #004600;">NULL</span> <span style="color: #008080;">then</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">n_type</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">node_type</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">tkNames</span><span style="color: #0000FF;">[</span><span style="color: #000000;">n_type</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">switch</span> <span style="color: #000000;">n_type</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_Sequence</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">gen_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">gen_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">])</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_assign</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">gen_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">])+</span><span style="color: #000000;">6</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_Integer</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">5</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_Identifier</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">6</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_String</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">5</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_while</span><span style="color: #0000FF;">:</span>
<span style="color: #000080;font-style:italic;">-- emit: @@:&lt;condition&gt;&lt;topjmp(@f)&gt;&lt;body&gt;&lt;tailjmp(@b)&gt;@@:</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">gen_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])+</span><span style="color: #000000;">3</span>
<span style="color: #004080;">integer</span> <span style="color: #7060A8;">body</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">gen_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">])</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">stail</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">size</span><span style="color: #0000FF;">+</span><span style="color: #7060A8;">body</span><span style="color: #0000FF;">+</span><span style="color: #000000;">2</span><span style="color: #0000FF;">></span><span style="color: #000000;">128</span><span style="color: #0000FF;">?</span><span style="color: #000000;">5</span><span style="color: #0000FF;">:</span><span style="color: #000000;">2</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">stop</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">body</span><span style="color: #0000FF;">+</span><span style="color: #000000;">stail</span> <span style="color: #0000FF;">></span><span style="color: #000000;">127</span><span style="color: #0000FF;">?</span><span style="color: #000000;">6</span><span style="color: #0000FF;">:</span><span style="color: #000000;">2</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">stop</span><span style="color: #0000FF;">+</span><span style="color: #7060A8;">body</span><span style="color: #0000FF;">+</span><span style="color: #000000;">stail</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_lt</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_le</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_ne</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_eq</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_gt</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_ge</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">gen_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">gen_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">10</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_and</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_or</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">gen_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">gen_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">15</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_add</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_sub</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">gen_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">gen_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">4</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_mul</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">gen_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">gen_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">5</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_div</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_mod</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">gen_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">gen_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">6</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_putc</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_Printi</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_Prints</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">gen_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">5</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_if</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">gen_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])+</span><span style="color: #000000;">3</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">][</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]!=</span><span style="color: #000000;">tk_if</span> <span style="color: #008080;">then</span> <span style="color: #0000FF;">?</span><span style="color: #000000;">9</span><span style="color: #0000FF;">/</span><span style="color: #000000;">0</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">truesize</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">gen_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">][</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">falsesize</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">gen_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">][</span><span style="color: #000000;">3</span><span style="color: #0000FF;">])</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">elsejmp</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">falsesize</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span><span style="color: #0000FF;">?</span><span style="color: #000000;">0</span><span style="color: #0000FF;">:</span><span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">falsesize</span><span style="color: #0000FF;">></span><span style="color: #000000;">127</span><span style="color: #0000FF;">?</span><span style="color: #000000;">5</span><span style="color: #0000FF;">:</span><span style="color: #000000;">2</span><span style="color: #0000FF;">))</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">mainjmp</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">truesize</span><span style="color: #0000FF;">+</span><span style="color: #000000;">elsejmp</span><span style="color: #0000FF;">></span><span style="color: #000000;">127</span><span style="color: #0000FF;">?</span><span style="color: #000000;">6</span><span style="color: #0000FF;">:</span><span style="color: #000000;">2</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">mainjmp</span><span style="color: #0000FF;">+</span><span style="color: #000000;">truesize</span><span style="color: #0000FF;">+</span><span style="color: #000000;">elsejmp</span><span style="color: #0000FF;">+</span><span style="color: #000000;">falsesize</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_not</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">gen_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">9</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_neg</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">gen_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">size</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">4</span>
<span style="color: #008080;">else</span><span style="color: #0000FF;">:</span>
<span style="color: #0000FF;">?</span><span style="color: #000000;">9</span><span style="color: #0000FF;">/</span><span style="color: #000000;">0</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">switch</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">size</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">gen_rec</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
<span style="color: #000080;font-style:italic;">-- the recursive part of code_gen</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">!=</span><span style="color: #004600;">NULL</span> <span style="color: #008080;">then</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">initsize</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">estsize</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">gen_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- (test the gen_size function)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">n_type</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">node_type</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">tkNames</span><span style="color: #0000FF;">[</span><span style="color: #000000;">n_type</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">switch</span> <span style="color: #000000;">n_type</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_Sequence</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">gen_rec</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">gen_rec</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">])</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_assign</span><span style="color: #0000FF;">:</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">var_idx</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">gen_rec</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">code</span> <span style="color: #0000FF;">&=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">0o217</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o005</span><span style="color: #0000FF;">,</span><span style="color: #000000;">chain</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">n</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">}</span> <span style="color: #000080;font-style:italic;">-- pop [i]</span>
<span style="color: #000000;">chain</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code</span><span style="color: #0000FF;">)-</span><span style="color: #000000;">3</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_Integer</span><span style="color: #0000FF;">:</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">code</span> <span style="color: #0000FF;">&=</span> <span style="color: #000000;">0o150</span><span style="color: #0000FF;">&</span><span style="color: #7060A8;">int_to_bytes</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- push imm32</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_while</span><span style="color: #0000FF;">:</span>
<span style="color: #000080;font-style:italic;">-- emit: @@:&lt;condition&gt;&lt;topjmp(@f)&gt;&lt;body&gt;&lt;tailjmp(@b)&gt;@@:</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">looptop</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">gen_rec</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">code</span> <span style="color: #0000FF;">&=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">0o130</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- pop eax</span>
<span style="color: #000000;">0o205</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o300</span><span style="color: #0000FF;">}</span> <span style="color: #000080;font-style:italic;">-- test eax,eax</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">bodysize</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">gen_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">])</span>
<span style="color: #000080;font-style:italic;">-- can we use short jumps?
-- disclaimer: size calcs are not heavily tested; if in
-- doubt reduce 128/7 by 8, and if that works
-- then yep, you just found a boundary case.</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">stail</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code</span><span style="color: #0000FF;">)+</span><span style="color: #000000;">bodysize</span><span style="color: #0000FF;">+</span><span style="color: #000000;">4</span><span style="color: #0000FF;">-</span><span style="color: #000000;">looptop</span><span style="color: #0000FF;">></span><span style="color: #000000;">128</span><span style="color: #0000FF;">?</span><span style="color: #000000;">5</span><span style="color: #0000FF;">:</span><span style="color: #000000;">2</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">offset</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">bodysize</span><span style="color: #0000FF;">+</span><span style="color: #000000;">stail</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">stop</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">offset</span><span style="color: #0000FF;">></span><span style="color: #000000;">127</span><span style="color: #0000FF;">?</span><span style="color: #000000;">6</span><span style="color: #0000FF;">:</span><span style="color: #000000;">2</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">stop</span><span style="color: #0000FF;">=</span><span style="color: #000000;">2</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">code</span> <span style="color: #0000FF;">&=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">0o164</span><span style="color: #0000FF;">,</span><span style="color: #000000;">offset</span><span style="color: #0000FF;">}</span> <span style="color: #000080;font-style:italic;">-- jz (short) end</span>
<span style="color: #008080;">else</span>
<span style="color: #000000;">code</span> <span style="color: #0000FF;">&=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">0o017</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o204</span><span style="color: #0000FF;">}&</span><span style="color: #7060A8;">int_to_bytes</span><span style="color: #0000FF;">(</span><span style="color: #000000;">offset</span><span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- jz (long) end</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">gen_rec</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">offset</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">looptop</span><span style="color: #0000FF;">-(</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code</span><span style="color: #0000FF;">)+</span><span style="color: #000000;">stail</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">stail</span><span style="color: #0000FF;">=</span><span style="color: #000000;">2</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">code</span> <span style="color: #0000FF;">&=</span> <span style="color: #000000;">0o353</span><span style="color: #0000FF;">&</span><span style="color: #000000;">offset</span> <span style="color: #000080;font-style:italic;">-- jmp looptop (short)</span>
<span style="color: #008080;">else</span>
<span style="color: #000000;">code</span> <span style="color: #0000FF;">&=</span> <span style="color: #000000;">0o351</span><span style="color: #0000FF;">&</span><span style="color: #7060A8;">int_to_bytes</span><span style="color: #0000FF;">(</span><span style="color: #000000;">offset</span><span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- jmp looptop (long)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_lt</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_le</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_gt</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_ge</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_ne</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_eq</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">gen_rec</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">gen_rec</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">])</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">xrm</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">n_type</span><span style="color: #0000FF;">=</span><span style="color: #000000;">tk_ne</span> <span style="color: #008080;">then</span> <span style="color: #000000;">xrm</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0o225</span> <span style="color: #000080;font-style:italic;">-- (#95)</span>
<span style="color: #008080;">elsif</span> <span style="color: #000000;">n_type</span><span style="color: #0000FF;">=</span><span style="color: #000000;">tk_lt</span> <span style="color: #008080;">then</span> <span style="color: #000000;">xrm</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0o234</span> <span style="color: #000080;font-style:italic;">-- (#9C)</span>
<span style="color: #008080;">elsif</span> <span style="color: #000000;">n_type</span><span style="color: #0000FF;">=</span><span style="color: #000000;">tk_ge</span> <span style="color: #008080;">then</span> <span style="color: #000000;">xrm</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0o235</span> <span style="color: #000080;font-style:italic;">-- (#9D)</span>
<span style="color: #008080;">elsif</span> <span style="color: #000000;">n_type</span><span style="color: #0000FF;">=</span><span style="color: #000000;">tk_le</span> <span style="color: #008080;">then</span> <span style="color: #000000;">xrm</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0o236</span> <span style="color: #000080;font-style:italic;">-- (#9E)</span>
<span style="color: #008080;">elsif</span> <span style="color: #000000;">n_type</span><span style="color: #0000FF;">=</span><span style="color: #000000;">tk_gt</span> <span style="color: #008080;">then</span> <span style="color: #000000;">xrm</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0o237</span> <span style="color: #000080;font-style:italic;">-- (#9F)</span>
<span style="color: #008080;">else</span> <span style="color: #0000FF;">?</span><span style="color: #000000;">9</span><span style="color: #0000FF;">/</span><span style="color: #000000;">0</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">code</span> <span style="color: #0000FF;">&=</span> <span style="color: #0000FF;">{</span> <span style="color: #000000;">0o061</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o300</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- xor eax,eax</span>
<span style="color: #000000;">0o132</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- pop edx</span>
<span style="color: #000000;">0o131</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- pop ecx</span>
<span style="color: #000000;">0o071</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o321</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- cmp ecx,edx</span>
<span style="color: #000000;">0o017</span><span style="color: #0000FF;">,</span><span style="color: #000000;">xrm</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o300</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- setcc al</span>
<span style="color: #000000;">0o120</span><span style="color: #0000FF;">}</span> <span style="color: #000080;font-style:italic;">-- push eax</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_or</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_and</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">gen_rec</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">gen_rec</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">])</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">op</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n_type</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">tk_or</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">tk_and</span><span style="color: #0000FF;">})</span>
<span style="color: #000000;">op</span> <span style="color: #0000FF;">*=</span> <span style="color: #000000;">0o010</span>
<span style="color: #000000;">code</span> <span style="color: #0000FF;">&=</span> <span style="color: #0000FF;">{</span> <span style="color: #000000;">0o130</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- pop eax</span>
<span style="color: #000000;">0o131</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- pop ecx</span>
<span style="color: #000000;">0o205</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o300</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- test eax,eax</span>
<span style="color: #000000;">0o017</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o225</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o300</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- setne al</span>
<span style="color: #000000;">0o205</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o311</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- test ecx,ecx</span>
<span style="color: #000000;">0o017</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o225</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o301</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- setne cl</span>
<span style="color: #000000;">op</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o310</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- or/and al,cl</span>
<span style="color: #000000;">0o120</span><span style="color: #0000FF;">}</span> <span style="color: #000080;font-style:italic;">-- push eax</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_add</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_sub</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">gen_rec</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">gen_rec</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">])</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">op</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n_type</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">tk_add</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">tk_sub</span><span style="color: #0000FF;">})</span>
<span style="color: #000000;">op</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0o001</span> <span style="color: #0000FF;">+</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">op</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)*</span><span style="color: #000000;">0o010</span>
<span style="color: #000000;">code</span> <span style="color: #0000FF;">&=</span> <span style="color: #0000FF;">{</span> <span style="color: #000000;">0o130</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- pop eax</span>
<span style="color: #000000;">op</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o004</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o044</span><span style="color: #0000FF;">}</span> <span style="color: #000080;font-style:italic;">-- add/or/and/sub [esp],eax</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_mul</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">gen_rec</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">gen_rec</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">code</span> <span style="color: #0000FF;">&=</span> <span style="color: #0000FF;">{</span> <span style="color: #000000;">0o131</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- pop ecx</span>
<span style="color: #000000;">0o130</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- pop eax</span>
<span style="color: #000000;">0o367</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o341</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- mul ecx</span>
<span style="color: #000000;">0o120</span><span style="color: #0000FF;">}</span> <span style="color: #000080;font-style:italic;">-- push eax</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_div</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_mod</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">gen_rec</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">gen_rec</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">])</span>
<span style="color: #004080;">integer</span> <span style="color: #7060A8;">push</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0o120</span><span style="color: #0000FF;">+(</span><span style="color: #000000;">n_type</span><span style="color: #0000FF;">=</span><span style="color: #000000;">tk_mod</span><span style="color: #0000FF;">)*</span><span style="color: #000000;">2</span>
<span style="color: #000000;">code</span> <span style="color: #0000FF;">&=</span> <span style="color: #0000FF;">{</span> <span style="color: #000000;">0o131</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- pop ecx</span>
<span style="color: #000000;">0o130</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- pop eax</span>
<span style="color: #000000;">0o231</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- cdq (eax -&gt; edx:eax)</span>
<span style="color: #000000;">0o367</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o371</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- idiv ecx</span>
<span style="color: #7060A8;">push</span><span style="color: #0000FF;">}</span> <span style="color: #000080;font-style:italic;">-- push eax|edx</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_Identifier</span><span style="color: #0000FF;">:</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">var_idx</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">code</span> <span style="color: #0000FF;">&=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">0o377</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o065</span><span style="color: #0000FF;">,</span><span style="color: #000000;">chain</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">n</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">}</span> <span style="color: #000080;font-style:italic;">-- push [n]</span>
<span style="color: #000000;">chain</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code</span><span style="color: #0000FF;">)-</span><span style="color: #000000;">3</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_putc</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_Printi</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_Prints</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">gen_rec</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n_type</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">tk_putc</span><span style="color: #0000FF;">,</span><span style="color: #000000;">tk_Printi</span><span style="color: #0000FF;">,</span><span style="color: #000000;">tk_Prints</span><span style="color: #0000FF;">})</span>
<span style="color: #000000;">code</span> <span style="color: #0000FF;">&=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">0o350</span><span style="color: #0000FF;">,</span><span style="color: #000000;">chain</span><span style="color: #0000FF;">,</span><span style="color: #000000;">3</span><span style="color: #0000FF;">,</span><span style="color: #000000;">n</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">}</span> <span style="color: #000080;font-style:italic;">-- call :printc/i/s</span>
<span style="color: #000000;">chain</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code</span><span style="color: #0000FF;">)-</span><span style="color: #000000;">3</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_String</span><span style="color: #0000FF;">:</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">string_idx</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">code</span> <span style="color: #0000FF;">&=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">0o150</span><span style="color: #0000FF;">,</span><span style="color: #000000;">chain</span><span style="color: #0000FF;">,</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,</span><span style="color: #000000;">n</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">}</span> <span style="color: #000080;font-style:italic;">-- push RawStringPtr(string)</span>
<span style="color: #000000;">chain</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code</span><span style="color: #0000FF;">)-</span><span style="color: #000000;">3</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_if</span><span style="color: #0000FF;">:</span>
<span style="color: #000080;font-style:italic;">-- emit: &lt;condition&gt;&lt;mainjmp&gt;&lt;truepart&gt;[&lt;elsejmp&gt;&lt;falsepart&gt;]</span>
<span style="color: #000000;">gen_rec</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">code</span> <span style="color: #0000FF;">&=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">0o130</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- pop eax</span>
<span style="color: #000000;">0o205</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o300</span><span style="color: #0000FF;">}</span> <span style="color: #000080;font-style:italic;">-- test eax,eax</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">][</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]!=</span><span style="color: #000000;">tk_if</span> <span style="color: #008080;">then</span> <span style="color: #0000FF;">?</span><span style="color: #000000;">9</span><span style="color: #0000FF;">/</span><span style="color: #000000;">0</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">truesize</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">gen_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">][</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">falsesize</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">gen_size</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">][</span><span style="color: #000000;">3</span><span style="color: #0000FF;">])</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">elsejmp</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">falsesize</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span><span style="color: #0000FF;">?</span><span style="color: #000000;">0</span><span style="color: #0000FF;">:</span><span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">falsesize</span><span style="color: #0000FF;">></span><span style="color: #000000;">127</span><span style="color: #0000FF;">?</span><span style="color: #000000;">5</span><span style="color: #0000FF;">:</span><span style="color: #000000;">2</span><span style="color: #0000FF;">))</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">offset</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">truesize</span><span style="color: #0000FF;">+</span><span style="color: #000000;">elsejmp</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">mainjmp</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">offset</span><span style="color: #0000FF;">></span><span style="color: #000000;">127</span><span style="color: #0000FF;">?</span><span style="color: #000000;">6</span><span style="color: #0000FF;">:</span><span style="color: #000000;">2</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">mainjmp</span><span style="color: #0000FF;">=</span><span style="color: #000000;">2</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">code</span> <span style="color: #0000FF;">&=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">0o164</span><span style="color: #0000FF;">,</span><span style="color: #000000;">offset</span><span style="color: #0000FF;">}</span> <span style="color: #000080;font-style:italic;">-- jz (short) else/end</span>
<span style="color: #008080;">else</span>
<span style="color: #000000;">code</span> <span style="color: #0000FF;">&=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">0o017</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o204</span><span style="color: #0000FF;">}&</span><span style="color: #7060A8;">int_to_bytes</span><span style="color: #0000FF;">(</span><span style="color: #000000;">offset</span><span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- jz (long) else/end</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">gen_rec</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">][</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">falsesize</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">offset</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">falsesize</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">elsejmp</span><span style="color: #0000FF;">=</span><span style="color: #000000;">2</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">code</span> <span style="color: #0000FF;">&=</span> <span style="color: #000000;">0o353</span><span style="color: #0000FF;">&</span><span style="color: #000000;">offset</span> <span style="color: #000080;font-style:italic;">-- jmp end if (short)</span>
<span style="color: #008080;">else</span>
<span style="color: #000000;">code</span> <span style="color: #0000FF;">&=</span> <span style="color: #000000;">0o351</span><span style="color: #0000FF;">&</span><span style="color: #7060A8;">int_to_bytes</span><span style="color: #0000FF;">(</span><span style="color: #000000;">offset</span><span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- jmp end if (long)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">gen_rec</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">][</span><span style="color: #000000;">3</span><span style="color: #0000FF;">])</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_not</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">gen_rec</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">code</span> <span style="color: #0000FF;">&=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">0o132</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- pop edx</span>
<span style="color: #000000;">0o061</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o300</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- xor eax,eax</span>
<span style="color: #000000;">0o205</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o322</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- test edx,edx</span>
<span style="color: #000000;">0o017</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o224</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o300</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- setz al</span>
<span style="color: #000000;">0o120</span><span style="color: #0000FF;">}</span> <span style="color: #000080;font-style:italic;">-- push eax</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_neg</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">gen_rec</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">code</span> <span style="color: #0000FF;">&=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">0o130</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- pop eax</span>
<span style="color: #000000;">0o367</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o330</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- neg eax</span>
<span style="color: #000000;">0o120</span><span style="color: #0000FF;">}</span> <span style="color: #000080;font-style:italic;">-- push eax</span>
<span style="color: #008080;">else</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">error</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"error in code generator - found %d, expecting operator\n"</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">n_type</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">switch</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">actsize</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">initsize</span><span style="color: #0000FF;">+</span><span style="color: #000000;">estsize</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">actsize</span> <span style="color: #008080;">then</span> <span style="color: #0000FF;">?</span><span style="color: #008000;">"9/0"</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span> <span style="color: #000080;font-style:italic;">-- (test gen_size)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">global</span> <span style="color: #008080;">procedure</span> <span style="color: #000000;">code_gen</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
<span style="color: #000080;font-style:italic;">--
-- Generates proper machine code.
--
-- Example: i=10; print "\n"; print i; print "\n"
-- Result in vars, strings, chain, code (declared above)
-- where vars is: {"i"},
-- strings is {"\n"},
-- code is { 0o150,#0A,#00,#00,#00, -- 1: push 10
-- 0o217,0o005,0,1,1,0 -- 6: pop [i]
-- 0o150,8,2,1,0, -- 12: push ("\n")
-- 0o350,13,3,3,0, -- 17: call :prints
-- 0o377,0o065,18,1,1,0, -- 22: push [i]
-- 0o350,24,3,2,0, -- 28: call :printi
-- 0o150,29,2,1,0, -- 33: push ("\n")
-- 0o350,34,3,3,0, -- 38: call :prints
-- 0o303} -- 43: ret
-- and chain is 39 (-&gt;34-&gt;29-&gt;24-&gt;18-&gt;13-&gt;8-&gt;0)
-- The chain connects all places where we need an actual address before
-- the code is executed, with the byte after the link differentiating
-- between var(1), string(2), and builtin(3), and the byte after that
-- determining the instance of the given type - not that any of them
-- are actually limited to a byte in the above intermediate form, and
-- of course the trailing 0 of each {link,type,id,0} is just there to
-- reserve the space we will need.
--</span>
<span style="color: #000000;">gen_rec</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">code</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o303</span><span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- ret (0o303=#C3)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">include</span> <span style="color: #000000;">builtins</span><span style="color: #0000FF;">/</span><span style="color: #000000;">VM</span><span style="color: #0000FF;">/</span><span style="color: #000000;">puts1</span><span style="color: #0000FF;">.</span><span style="color: #000000;">e</span> <span style="color: #000080;font-style:italic;">-- low-level console i/o routines</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">setbuiltins</span><span style="color: #0000FF;">()</span>
<span style="color: #004080;">atom</span> <span style="color: #000000;">printc</span><span style="color: #0000FF;">,</span><span style="color: #000000;">printi</span><span style="color: #0000FF;">,</span><span style="color: #000000;">prints</span>
#ilASM{
jmp :setbuiltins
::printc
lea edi,[esp+4]
mov esi,1
call :%puts1ediesi -- (edi=raw text, esi=length)
ret 4
::printi
mov eax,[esp+4]
push 0 -- no cr
call :%putsint -- (nb limited to +/-9,999,999,999)
ret 4
::prints
mov edi,[esp+4]
mov esi,[edi-12]
call :%puts1ediesi -- (edi=raw text, esi=length)
ret 4
::setbuiltins
mov eax,:printc
lea edi,[printc]
call :%pStoreMint
mov eax,:printi
lea edi,[printi]
call :%pStoreMint
mov eax,:prints
lea edi,[prints]
call :%pStoreMint
}
<span style="color: #008080;">return</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">printc</span><span style="color: #0000FF;">,</span><span style="color: #000000;">printi</span><span style="color: #0000FF;">,</span><span style="color: #000000;">prints</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">global</span> <span style="color: #008080;">constant</span> <span style="color: #000000;">builtin_names</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"printc"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"printi"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"prints"</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">global</span> <span style="color: #008080;">constant</span> <span style="color: #000000;">builtins</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">setbuiltins</span><span style="color: #0000FF;">()</span>
<span style="color: #008080;">global</span> <span style="color: #004080;">atom</span> <span style="color: #000000;">var_mem</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">code_mem</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">RawStringPtr</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- (based on IupRawStringPtr from pGUI.e)
--
-- Returns a raw string pointer for s, somewhat like allocate_string(s), but using the existing memory.
-- NOTE: The return is only valid as long as the value passed as the parameter remains in existence.
--</span>
<span style="color: #004080;">atom</span> <span style="color: #000000;">res</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">strings</span><span style="color: #0000FF;">[</span><span style="color: #000000;">n</span><span style="color: #0000FF;">]</span>
#ilASM{
mov eax,[s]
lea edi,[res]
shl eax,2
call :%pStoreMint
}
<span style="color: #000000;">stringptrs</span><span style="color: #0000FF;">[</span><span style="color: #000000;">n</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">res</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">global</span> <span style="color: #008080;">procedure</span> <span style="color: #000000;">fixup</span><span style="color: #0000FF;">()</span>
<span style="color: #000000;">var_mem</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">allocate</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">vars</span><span style="color: #0000FF;">)*</span><span style="color: #000000;">4</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">mem_set</span><span style="color: #0000FF;">(</span><span style="color: #000000;">var_mem</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">vars</span><span style="color: #0000FF;">)*</span><span style="color: #000000;">4</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">code_mem</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">allocate</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code</span><span style="color: #0000FF;">))</span>
<span style="color: #7060A8;">poke</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code_mem</span><span style="color: #0000FF;">,</span><span style="color: #000000;">code</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">chain</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">integer</span> <span style="color: #7060A8;">this</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">chain</span>
<span style="color: #000000;">chain</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">code</span><span style="color: #0000FF;">[</span><span style="color: #7060A8;">this</span><span style="color: #0000FF;">]</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">ftype</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">code</span><span style="color: #0000FF;">[</span><span style="color: #7060A8;">this</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">id</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">code</span><span style="color: #0000FF;">[</span><span style="color: #7060A8;">this</span><span style="color: #0000FF;">+</span><span style="color: #000000;">2</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">switch</span> <span style="color: #000000;">ftype</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">1</span><span style="color: #0000FF;">:</span> <span style="color: #000080;font-style:italic;">-- vars</span>
<span style="color: #7060A8;">poke4</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code_mem</span><span style="color: #0000FF;">+</span><span style="color: #7060A8;">this</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">var_mem</span><span style="color: #0000FF;">+(</span><span style="color: #000000;">id</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)*</span><span style="color: #000000;">4</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">2</span><span style="color: #0000FF;">:</span> <span style="color: #000080;font-style:italic;">-- strings</span>
<span style="color: #7060A8;">poke4</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code_mem</span><span style="color: #0000FF;">+</span><span style="color: #7060A8;">this</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">RawStringPtr</span><span style="color: #0000FF;">(</span><span style="color: #000000;">id</span><span style="color: #0000FF;">))</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">3</span><span style="color: #0000FF;">:</span> <span style="color: #000080;font-style:italic;">-- builtins</span>
<span style="color: #7060A8;">poke4</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code_mem</span><span style="color: #0000FF;">+</span><span style="color: #7060A8;">this</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">builtins</span><span style="color: #0000FF;">[</span><span style="color: #000000;">id</span><span style="color: #0000FF;">]-(</span><span style="color: #000000;">code_mem</span><span style="color: #0000FF;">+</span><span style="color: #7060A8;">this</span><span style="color: #0000FF;">+</span><span style="color: #000000;">3</span><span style="color: #0000FF;">))</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">switch</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<!--

View file

@ -0,0 +1,197 @@
(notonline)-->
<span style="color: #000080;font-style:italic;">--
-- demo\rosetta\Compiler\cgen.exw
-- ==============================
--
-- Generates 32-bit machine code (see note in vm.exw)
--</span>
<span style="color: #008080;">without</span> <span style="color: #008080;">js</span> <span style="color: #000080;font-style:italic;">-- (machine code!)</span>
<span style="color: #008080;">include</span> <span style="color: #000000;">cgen</span><span style="color: #0000FF;">.</span><span style="color: #000000;">e</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">get_var_name</span><span style="color: #0000FF;">(</span><span style="color: #004080;">atom</span> <span style="color: #000000;">addr</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">addr</span><span style="color: #0000FF;">-</span><span style="color: #000000;">var_mem</span><span style="color: #0000FF;">)/</span><span style="color: #000000;">4</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">n</span><span style="color: #0000FF;"><</span><span style="color: #000000;">1</span> <span style="color: #008080;">or</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">></span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">vars</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span> <span style="color: #0000FF;">?</span><span style="color: #000000;">9</span><span style="color: #0000FF;">/</span><span style="color: #000000;">0</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">vars</span><span style="color: #0000FF;">[</span><span style="color: #000000;">n</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">hxl</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">pc</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">object</span> <span style="color: #000000;">oh</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">string</span> <span style="color: #000000;">fmt</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">args</span><span style="color: #0000FF;">={})</span>
<span style="color: #000080;font-style:italic;">-- helper routine to display the octal/hex bytes just decoded,
-- along with the code offset and the human-readable text.</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">args</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span> <span style="color: #000000;">fmt</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">fmt</span><span style="color: #0000FF;">,</span><span style="color: #000000;">args</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">octhex</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
<span style="color: #004080;">atom</span> <span style="color: #000000;">base</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">code_mem</span><span style="color: #0000FF;">+</span><span style="color: #000000;">pc</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">len</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #008080;">if</span> <span style="color: #004080;">integer</span><span style="color: #0000FF;">(</span><span style="color: #000000;">oh</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span> <span style="color: #000080;font-style:italic;">-- all octal</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">oh</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">octhex</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">octhex</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"0o%03o"</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">peek</span><span style="color: #0000FF;">(</span><span style="color: #000000;">base</span><span style="color: #0000FF;">)))</span>
<span style="color: #000000;">base</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #000000;">len</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">oh</span>
<span style="color: #008080;">else</span> <span style="color: #000080;font-style:italic;">-- some octal and some hex</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">oh</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">by</span> <span style="color: #000000;">2</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">oh</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">octhex</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">octhex</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"0o%03o"</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">peek</span><span style="color: #0000FF;">(</span><span style="color: #000000;">base</span><span style="color: #0000FF;">)))</span>
<span style="color: #000000;">base</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #000000;">len</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">oh</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">oh</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">octhex</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">octhex</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"#%02x"</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">peek</span><span style="color: #0000FF;">(</span><span style="color: #000000;">base</span><span style="color: #0000FF;">)))</span>
<span style="color: #000000;">base</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #000000;">len</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">oh</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">output_file</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%4d: %-30s %s\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">join</span><span style="color: #0000FF;">(</span><span style="color: #000000;">octhex</span><span style="color: #0000FF;">,</span><span style="color: #008000;">","</span><span style="color: #0000FF;">),</span><span style="color: #000000;">fmt</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">len</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">cccodes</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"o?"</span> <span style="color: #0000FF;">,</span><span style="color: #008000;">"no?"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"b?"</span> <span style="color: #0000FF;">,</span><span style="color: #008000;">"ae?"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"z"</span> <span style="color: #0000FF;">,</span><span style="color: #008000;">"ne"</span> <span style="color: #0000FF;">,</span><span style="color: #008000;">"be?"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"a?"</span><span style="color: #0000FF;">,</span>
<span style="color: #000080;font-style:italic;">-- 0 , 1 , 2 , 3 , 4 , 5 , 6 , 7 ,</span>
<span style="color: #008000;">"s?"</span> <span style="color: #0000FF;">,</span><span style="color: #008000;">"ns?"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"pe?"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"po?"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"l"</span> <span style="color: #0000FF;">,</span><span style="color: #008000;">"ge"</span> <span style="color: #0000FF;">,</span><span style="color: #008000;">"le"</span> <span style="color: #0000FF;">,</span><span style="color: #008000;">"g"</span> <span style="color: #0000FF;">}</span>
<span style="color: #000080;font-style:italic;">-- 8 , 9 , 10 , 11 , 12 , 13 , 14 , 15</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">regs</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"eax"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"ecx"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"edx"</span><span style="color: #0000FF;">}</span> <span style="color: #000080;font-style:italic;">-- (others as/when needed)</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">decode</span><span style="color: #0000FF;">()</span>
<span style="color: #000080;font-style:italic;">-- for a much more complete (and better organised) disassembler, see p2asm.e</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">pc</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- nb 0-based</span>
<span style="color: #000000;">opcode</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">xrm</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">pc</span><span style="color: #0000FF;"><</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">opcode</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">peek</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code_mem</span><span style="color: #0000FF;">+</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">xrm</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span>
<span style="color: #008080;">switch</span> <span style="color: #000000;">opcode</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o150</span><span style="color: #0000FF;">:</span>
<span style="color: #004080;">atom</span> <span style="color: #000000;">vaddr</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">peek4s</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code_mem</span><span style="color: #0000FF;">+</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">vaddr</span><span style="color: #0000FF;">,</span><span style="color: #000000;">stringptrs</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">object</span> <span style="color: #000000;">arg</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">?</span><span style="color: #000000;">enquote</span><span style="color: #0000FF;">(</span><span style="color: #000000;">strings</span><span style="color: #0000FF;">[</span><span style="color: #000000;">n</span><span style="color: #0000FF;">])</span>
<span style="color: #0000FF;">:</span><span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"%d"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">vaddr</span><span style="color: #0000FF;">))</span>
<span style="color: #000000;">pc</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">hxl</span><span style="color: #0000FF;">(</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">4</span><span style="color: #0000FF;">},</span><span style="color: #008000;">"push %s"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">arg</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o217</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o377</span><span style="color: #0000FF;">:</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">opcode</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">0o217</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o377</span><span style="color: #0000FF;">})</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">op</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"pop"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"push"</span><span style="color: #0000FF;">}[</span><span style="color: #000000;">n</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">xrm</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">peek</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code_mem</span><span style="color: #0000FF;">+</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">!=</span><span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">xrm</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">0o005</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o065</span><span style="color: #0000FF;">})</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #004080;">atom</span> <span style="color: #000000;">addr</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">peek4u</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code_mem</span><span style="color: #0000FF;">+</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">+</span><span style="color: #000000;">2</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">pc</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">hxl</span><span style="color: #0000FF;">(</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,</span><span style="color: #000000;">4</span><span style="color: #0000FF;">},</span><span style="color: #008000;">"%s [%s]"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">op</span><span style="color: #0000FF;">,</span><span style="color: #000000;">get_var_name</span><span style="color: #0000FF;">(</span><span style="color: #000000;">addr</span><span style="color: #0000FF;">)})</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o061</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o071</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o205</span><span style="color: #0000FF;">:</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">opcode</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">0o061</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o071</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o205</span><span style="color: #0000FF;">})</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">op</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"xor"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"cmp"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"test"</span><span style="color: #0000FF;">}[</span><span style="color: #000000;">n</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">xrm</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">peek</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code_mem</span><span style="color: #0000FF;">+</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">and_bits</span><span style="color: #0000FF;">(</span><span style="color: #000000;">xrm</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o300</span><span style="color: #0000FF;">)!=</span><span style="color: #000000;">0o300</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">r1</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">regs</span><span style="color: #0000FF;">[</span><span style="color: #7060A8;">and_bits</span><span style="color: #0000FF;">(</span><span style="color: #000000;">xrm</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o070</span><span style="color: #0000FF;">)/</span><span style="color: #000000;">0o010</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">r2</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">regs</span><span style="color: #0000FF;">[</span><span style="color: #7060A8;">and_bits</span><span style="color: #0000FF;">(</span><span style="color: #000000;">xrm</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o007</span><span style="color: #0000FF;">)+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">pc</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">hxl</span><span style="color: #0000FF;">(</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">,</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%s %s,%s"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">op</span><span style="color: #0000FF;">,</span><span style="color: #000000;">r1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">r2</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o017</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">xrm</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">peek</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code_mem</span><span style="color: #0000FF;">+</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">switch</span> <span style="color: #000000;">xrm</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o224</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o225</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o234</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o235</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o236</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o237</span><span style="color: #0000FF;">:</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">cc</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">cccodes</span><span style="color: #0000FF;">[</span><span style="color: #7060A8;">and_bits</span><span style="color: #0000FF;">(</span><span style="color: #000000;">xrm</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o017</span><span style="color: #0000FF;">)+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">xrm</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">peek</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code_mem</span><span style="color: #0000FF;">+</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">+</span><span style="color: #000000;">2</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">xrm</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0o300</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">pc</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">hxl</span><span style="color: #0000FF;">(</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">,</span><span style="color: #000000;">3</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"set%s al"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">cc</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">elsif</span> <span style="color: #000000;">xrm</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0o301</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">pc</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">hxl</span><span style="color: #0000FF;">(</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">,</span><span style="color: #000000;">3</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"set%s cl"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">cc</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">else</span>
<span style="color: #008080;">exit</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o204</span><span style="color: #0000FF;">:</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">offset</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">peek4s</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code_mem</span><span style="color: #0000FF;">+</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">+</span><span style="color: #000000;">2</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">pc</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">hxl</span><span style="color: #0000FF;">(</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,</span><span style="color: #000000;">4</span><span style="color: #0000FF;">},</span><span style="color: #008000;">"jz %d"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">+</span><span style="color: #000000;">6</span><span style="color: #0000FF;">+</span><span style="color: #000000;">offset</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">else</span>
<span style="color: #008080;">exit</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">switch</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o010</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o040</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">xrm</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">peek</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code_mem</span><span style="color: #0000FF;">+</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">xrm</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0o310</span> <span style="color: #008080;">then</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">lop</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"or"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"and"</span><span style="color: #0000FF;">}[</span><span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">opcode</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">0o010</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o040</span><span style="color: #0000FF;">})]</span>
<span style="color: #000000;">pc</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">hxl</span><span style="color: #0000FF;">(</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">,</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%s al,cl"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">lop</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">else</span>
<span style="color: #008080;">exit</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o120</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o122</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o130</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o131</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o132</span><span style="color: #0000FF;">:</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">op</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"push"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"pop"</span><span style="color: #0000FF;">}[</span><span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">and_bits</span><span style="color: #0000FF;">(</span><span style="color: #000000;">opcode</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o070</span><span style="color: #0000FF;">),{</span><span style="color: #000000;">0o020</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o030</span><span style="color: #0000FF;">})]</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">reg</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">regs</span><span style="color: #0000FF;">[</span><span style="color: #7060A8;">and_bits</span><span style="color: #0000FF;">(</span><span style="color: #000000;">opcode</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o007</span><span style="color: #0000FF;">)+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">pc</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">hxl</span><span style="color: #0000FF;">(</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%s %s"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">op</span><span style="color: #0000FF;">,</span><span style="color: #000000;">reg</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o231</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">pc</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">hxl</span><span style="color: #0000FF;">(</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"cdq"</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o164</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o353</span><span style="color: #0000FF;">:</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">jop</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">opcode</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0o164</span><span style="color: #0000FF;">?</span><span style="color: #008000;">"jz"</span><span style="color: #0000FF;">:</span><span style="color: #008000;">"jmp"</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">offset</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">peek1s</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code_mem</span><span style="color: #0000FF;">+</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">pc</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">hxl</span><span style="color: #0000FF;">(</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">},</span><span style="color: #008000;">"%s %d"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">jop</span><span style="color: #0000FF;">,</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">+</span><span style="color: #000000;">2</span><span style="color: #0000FF;">+</span><span style="color: #000000;">offset</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o351</span><span style="color: #0000FF;">:</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">offset</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">peek4s</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code_mem</span><span style="color: #0000FF;">+</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">pc</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">hxl</span><span style="color: #0000FF;">(</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">4</span><span style="color: #0000FF;">},</span><span style="color: #008000;">"jmp %d"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">+</span><span style="color: #000000;">5</span><span style="color: #0000FF;">+</span><span style="color: #000000;">offset</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o303</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">pc</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">hxl</span><span style="color: #0000FF;">(</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"ret"</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o350</span><span style="color: #0000FF;">:</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">offset</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">peek4s</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code_mem</span><span style="color: #0000FF;">+</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">atom</span> <span style="color: #000000;">addr</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">offset</span><span style="color: #0000FF;">+</span><span style="color: #000000;">code_mem</span><span style="color: #0000FF;">+</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">+</span><span style="color: #000000;">5</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">addr</span><span style="color: #0000FF;">,</span><span style="color: #000000;">builtins</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">pc</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">hxl</span><span style="color: #0000FF;">(</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">4</span><span style="color: #0000FF;">},</span><span style="color: #008000;">"call :%s"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">builtin_names</span><span style="color: #0000FF;">[</span><span style="color: #000000;">n</span><span style="color: #0000FF;">]})</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o001</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o041</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o051</span><span style="color: #0000FF;">:</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">opcode</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">0o001</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o041</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o051</span><span style="color: #0000FF;">})</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">op</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"add"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"and"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"sub"</span><span style="color: #0000FF;">}[</span><span style="color: #000000;">n</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">xrm</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">peek</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code_mem</span><span style="color: #0000FF;">+</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">switch</span> <span style="color: #000000;">xrm</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o004</span><span style="color: #0000FF;">:</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">peek</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code_mem</span><span style="color: #0000FF;">+</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">+</span><span style="color: #000000;">2</span><span style="color: #0000FF;">)=</span><span style="color: #000000;">0o044</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">pc</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">hxl</span><span style="color: #0000FF;">(</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">,</span><span style="color: #000000;">3</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%s [esp],eax"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">op</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">else</span>
<span style="color: #008080;">exit</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">else</span>
<span style="color: #008080;">exit</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">switch</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">0o367</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">xrm</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">peek</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code_mem</span><span style="color: #0000FF;">+</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">and_bits</span><span style="color: #0000FF;">(</span><span style="color: #000000;">xrm</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o300</span><span style="color: #0000FF;">)!=</span><span style="color: #000000;">0o300</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">and_bits</span><span style="color: #0000FF;">(</span><span style="color: #000000;">xrm</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o070</span><span style="color: #0000FF;">),{</span><span style="color: #000000;">0o030</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o040</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o070</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">op</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"neg"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"mul"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"idiv"</span><span style="color: #0000FF;">}[</span><span style="color: #000000;">n</span><span style="color: #0000FF;">]</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">reg</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">regs</span><span style="color: #0000FF;">[</span><span style="color: #7060A8;">and_bits</span><span style="color: #0000FF;">(</span><span style="color: #000000;">xrm</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0o007</span><span style="color: #0000FF;">)+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">pc</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">hxl</span><span style="color: #0000FF;">(</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">,</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%s %s"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">op</span><span style="color: #0000FF;">,</span><span style="color: #000000;">reg</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">else</span>
<span style="color: #008080;">exit</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">switch</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">pc</span><span style="color: #0000FF;"><</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">code</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #0000FF;">?</span><span style="color: #008000;">"incomplete:"</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">xrm</span><span style="color: #0000FF;">=-</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span>
<span style="color: #0000FF;">?{</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"0o%03o"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">opcode</span><span style="color: #0000FF;">)}</span>
<span style="color: #008080;">else</span>
<span style="color: #0000FF;">?{</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"0o%03o 0o%03o"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">opcode</span><span style="color: #0000FF;">,</span><span style="color: #000000;">xrm</span><span style="color: #0000FF;">})}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">main</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">cl</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">open_files</span><span style="color: #0000FF;">(</span><span style="color: #000000;">cl</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">toks</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">lex</span><span style="color: #0000FF;">()</span>
<span style="color: #004080;">object</span> <span style="color: #000000;">t</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">parse</span><span style="color: #0000FF;">()</span>
<span style="color: #000000;">code_gen</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">fixup</span><span style="color: #0000FF;">()</span>
<span style="color: #000000;">decode</span><span style="color: #0000FF;">()</span>
<span style="color: #7060A8;">free</span><span style="color: #0000FF;">({</span><span style="color: #000000;">var_mem</span><span style="color: #0000FF;">,</span><span style="color: #000000;">code_mem</span><span style="color: #0000FF;">})</span>
<span style="color: #000000;">close_files</span><span style="color: #0000FF;">()</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #000080;font-style:italic;">--main(command_line())</span>
<span style="color: #000000;">main</span><span style="color: #0000FF;">({</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"gcd.c"</span><span style="color: #0000FF;">})</span>
<!--

View file

@ -0,0 +1,254 @@
from __future__ import print_function
import sys, struct, shlex, operator
nd_Ident, nd_String, nd_Integer, nd_Sequence, nd_If, nd_Prtc, nd_Prts, nd_Prti, nd_While, \
nd_Assign, nd_Negate, nd_Not, nd_Mul, nd_Div, nd_Mod, nd_Add, nd_Sub, nd_Lss, nd_Leq, \
nd_Gtr, nd_Geq, nd_Eql, nd_Neq, nd_And, nd_Or = range(25)
all_syms = {
"Identifier" : nd_Ident, "String" : nd_String,
"Integer" : nd_Integer, "Sequence" : nd_Sequence,
"If" : nd_If, "Prtc" : nd_Prtc,
"Prts" : nd_Prts, "Prti" : nd_Prti,
"While" : nd_While, "Assign" : nd_Assign,
"Negate" : nd_Negate, "Not" : nd_Not,
"Multiply" : nd_Mul, "Divide" : nd_Div,
"Mod" : nd_Mod, "Add" : nd_Add,
"Subtract" : nd_Sub, "Less" : nd_Lss,
"LessEqual" : nd_Leq, "Greater" : nd_Gtr,
"GreaterEqual": nd_Geq, "Equal" : nd_Eql,
"NotEqual" : nd_Neq, "And" : nd_And,
"Or" : nd_Or}
FETCH, STORE, PUSH, ADD, SUB, MUL, DIV, MOD, LT, GT, LE, GE, EQ, NE, AND, OR, NEG, NOT, \
JMP, JZ, PRTC, PRTS, PRTI, HALT = range(24)
operators = {nd_Lss: LT, nd_Gtr: GT, nd_Leq: LE, nd_Geq: GE, nd_Eql: EQ, nd_Neq: NE,
nd_And: AND, nd_Or: OR, nd_Sub: SUB, nd_Add: ADD, nd_Div: DIV, nd_Mul: MUL, nd_Mod: MOD}
unary_operators = {nd_Negate: NEG, nd_Not: NOT}
input_file = None
code = bytearray()
string_pool = {}
globals = {}
string_n = 0
globals_n = 0
word_size = 4
#*** show error and exit
def error(msg):
print("%s" % (msg))
exit(1)
def int_to_bytes(val):
return struct.pack("<i", val)
def bytes_to_int(bstr):
return struct.unpack("<i", bstr)
class Node:
def __init__(self, node_type, left = None, right = None, value = None):
self.node_type = node_type
self.left = left
self.right = right
self.value = value
#***
def make_node(oper, left, right = None):
return Node(oper, left, right)
#***
def make_leaf(oper, n):
return Node(oper, value = n)
#***
def emit_byte(x):
code.append(x)
#***
def emit_word(x):
s = int_to_bytes(x)
for x in s:
code.append(x)
def emit_word_at(at, n):
code[at:at+word_size] = int_to_bytes(n)
def hole():
t = len(code)
emit_word(0)
return t
#***
def fetch_var_offset(name):
global globals_n
n = globals.get(name, None)
if n == None:
globals[name] = globals_n
n = globals_n
globals_n += 1
return n
#***
def fetch_string_offset(the_string):
global string_n
n = string_pool.get(the_string, None)
if n == None:
string_pool[the_string] = string_n
n = string_n
string_n += 1
return n
#***
def code_gen(x):
if x == None: return
elif x.node_type == nd_Ident:
emit_byte(FETCH)
n = fetch_var_offset(x.value)
emit_word(n)
elif x.node_type == nd_Integer:
emit_byte(PUSH)
emit_word(x.value)
elif x.node_type == nd_String:
emit_byte(PUSH)
n = fetch_string_offset(x.value)
emit_word(n)
elif x.node_type == nd_Assign:
n = fetch_var_offset(x.left.value)
code_gen(x.right)
emit_byte(STORE)
emit_word(n)
elif x.node_type == nd_If:
code_gen(x.left) # expr
emit_byte(JZ) # if false, jump
p1 = hole() # make room for jump dest
code_gen(x.right.left) # if true statements
if (x.right.right != None):
emit_byte(JMP) # jump over else statements
p2 = hole()
emit_word_at(p1, len(code) - p1)
if (x.right.right != None):
code_gen(x.right.right) # else statements
emit_word_at(p2, len(code) - p2)
elif x.node_type == nd_While:
p1 = len(code)
code_gen(x.left)
emit_byte(JZ)
p2 = hole()
code_gen(x.right)
emit_byte(JMP) # jump back to the top
emit_word(p1 - len(code))
emit_word_at(p2, len(code) - p2)
elif x.node_type == nd_Sequence:
code_gen(x.left)
code_gen(x.right)
elif x.node_type == nd_Prtc:
code_gen(x.left)
emit_byte(PRTC)
elif x.node_type == nd_Prti:
code_gen(x.left)
emit_byte(PRTI)
elif x.node_type == nd_Prts:
code_gen(x.left)
emit_byte(PRTS)
elif x.node_type in operators:
code_gen(x.left)
code_gen(x.right)
emit_byte(operators[x.node_type])
elif x.node_type in unary_operators:
code_gen(x.left)
emit_byte(unary_operators[x.node_type])
else:
error("error in code generator - found %d, expecting operator" % (x.node_type))
#***
def code_finish():
emit_byte(HALT)
#***
def list_code():
print("Datasize: %d Strings: %d" % (len(globals), len(string_pool)))
for k in sorted(string_pool, key=string_pool.get):
print(k)
pc = 0
while pc < len(code):
print("%4d " % (pc), end='')
op = code[pc]
pc += 1
if op == FETCH:
x = bytes_to_int(code[pc:pc+word_size])[0]
print("fetch [%d]" % (x));
pc += word_size
elif op == STORE:
x = bytes_to_int(code[pc:pc+word_size])[0]
print("store [%d]" % (x));
pc += word_size
elif op == PUSH:
x = bytes_to_int(code[pc:pc+word_size])[0]
print("push %d" % (x));
pc += word_size
elif op == ADD: print("add")
elif op == SUB: print("sub")
elif op == MUL: print("mul")
elif op == DIV: print("div")
elif op == MOD: print("mod")
elif op == LT: print("lt")
elif op == GT: print("gt")
elif op == LE: print("le")
elif op == GE: print("ge")
elif op == EQ: print("eq")
elif op == NE: print("ne")
elif op == AND: print("and")
elif op == OR: print("or")
elif op == NEG: print("neg")
elif op == NOT: print("not")
elif op == JMP:
x = bytes_to_int(code[pc:pc+word_size])[0]
print("jmp (%d) %d" % (x, pc + x));
pc += word_size
elif op == JZ:
x = bytes_to_int(code[pc:pc+word_size])[0]
print("jz (%d) %d" % (x, pc + x));
pc += word_size
elif op == PRTC: print("prtc")
elif op == PRTI: print("prti")
elif op == PRTS: print("prts")
elif op == HALT: print("halt")
else: error("list_code: Unknown opcode %d", (op));
def load_ast():
line = input_file.readline()
line_list = shlex.split(line, False, False)
text = line_list[0]
if text == ";":
return None
node_type = all_syms[text]
if len(line_list) > 1:
value = line_list[1]
if value.isdigit():
value = int(value)
return make_leaf(node_type, value)
left = load_ast()
right = load_ast()
return make_node(node_type, left, right)
#*** main driver
input_file = sys.stdin
if len(sys.argv) > 1:
try:
input_file = open(sys.argv[1], "r", 4096)
except IOError as e:
error("Can't open %s" % sys.argv[1])
n = load_ast()
code_gen(n)
code_finish()
list_code()

File diff suppressed because it is too large Load diff

View file

@ -0,0 +1,37 @@
my %opnames = <
Less lt LessEqual le Multiply mul Subtract sub NotEqual ne
Divide div GreaterEqual ge Equal eq Greater gt Negate neg
>;
my (@AST, %strings, %names);
my $string-count = my $name-count = my $pairsym = my $pc = 0;
sub tree {
my ($A, $B) = ( '_' ~ ++$pairsym, '_' ~ ++$pairsym );
my $line = @AST.shift // return '';
$line ~~ /^ $<instr> = (\w+|';') [\s+ $<arg> =(.*)]? / or die "bad input $line";
given $<instr> {
when 'Identifier' { "fetch [{%names{$<arg>} //= $name-count++ }]\n" }
when 'Sequence' { tree() ~ tree() }
when 'Integer' { "push $<arg>\n" }
when 'String' { "push { %strings{$<arg>} //= $string-count++ }\n" }
when 'Assign' { join '', reverse (tree().subst( /fetch/, 'store')), tree() }
when 'While' { "$A:\n{ tree() }jz $B\n{ tree() }jmp $A\n$B:\n" }
when 'If' { tree() ~ "jz $A\n{ !@AST.shift ~ tree() }jmp $B\n$A:\n{ tree() }$B:\n" }
when ';' { '' }
default { tree() ~ tree() ~ (%opnames{$<instr>} // $<instr>.lc) ~ "\n" }
}
}
@AST = slurp('ast.txt').lines;
my $code = tree() ~ "halt\n";
$code ~~ s:g/^^ jmp \s+ (\S+) \n ('_'\d+:\n) $0:\n/$1/; # remove jmp next
$code ~~ s:g/^^ (<[a..z]>\w* (\N+)? ) $$/{my $l=$pc.fmt("%4d "); $pc += $0[0] ?? 5 !! 1; $l}$0/; # add locations
my %labels = ($code ~~ m:g/^^ ('_' \d+) ':' \n \s* (\d+)/)».Slip».Str; # pc addr of labels
$code ~~ s:g/^^ \s* (\d+) \s j[z|mp] \s* <(('_'\d+)/ ({%labels{$1} - $0 - 1}) %labels{$1}/; # fix jumps
$code ~~ s:g/^^ '_'\d+.*?\n//; # remove labels
say "Datasize: $name-count Strings: $string-count\n"
~ join('', %strings.keys.sort.reverse «~» "\n")
~ $code;

View file

@ -0,0 +1,155 @@
package xyz.hyperreal.rosettacodeCompiler
import scala.collection.mutable.{ArrayBuffer, HashMap}
import scala.io.Source
object CodeGenerator {
def fromStdin = fromSource(Source.stdin)
def fromString(src: String) = fromSource(Source.fromString(src))
def fromSource(ast: Source) = {
val vars = new HashMap[String, Int]
val strings = new ArrayBuffer[String]
val code = new ArrayBuffer[String]
var s: Stream[String] = ast.getLines.toStream
def line =
if (s.nonEmpty) {
val n = s.head
s = s.tail
n.split(" +", 2) match {
case Array(n) => n
case a => a
}
} else
sys.error("unexpected end of AST")
def variableIndex(name: String) =
vars get name match {
case None =>
val idx = vars.size
vars(name) = idx
idx
case Some(idx) => idx
}
def stringIndex(s: String) =
strings indexOf s match {
case -1 =>
val idx = strings.length
strings += s
idx
case idx => idx
}
var loc = 0
def addSimple(inst: String) = {
code += f"$loc%4d $inst"
loc += 1
}
def addOperand(inst: String, operand: String) = {
code += f"$loc%4d $inst%-5s $operand"
loc += 5
}
def fixup(inst: String, idx: Int, at: Int) = code(idx) = f"$at%4d $inst%-5s (${loc - at - 1}) $loc"
generate
addSimple("halt")
println(s"Datasize: ${vars.size} Strings: ${strings.length}")
for (s <- strings)
println(s)
println(code mkString "\n")
def generate: Unit =
line match {
case "Sequence" =>
generate
generate
case ";" =>
case "Assign" =>
val idx =
line match {
case Array("Identifier", name: String) =>
variableIndex(name)
case l => sys.error(s"expected identifier: $l")
}
generate
addOperand("store", s"[$idx]")
case Array("Identifier", name: String) => addOperand("fetch", s"[${variableIndex(name)}]")
case Array("Integer", n: String) => addOperand("push", s"$n")
case Array("String", s: String) => addOperand("push", s"${stringIndex(s)}")
case "If" =>
generate
val cond = loc
val condidx = code.length
addOperand("", "")
s = s.tail
generate
if (s.head == ";") {
s = s.tail
fixup("jz", condidx, cond)
} else {
val jump = loc
val jumpidx = code.length
addOperand("", "")
fixup("jz", condidx, cond)
generate
fixup("jmp", jumpidx, jump)
}
case "While" =>
val start = loc
generate
val cond = loc
val condidx = code.length
addOperand("", "")
generate
addOperand("jmp", s"(${start - loc - 1}) $start")
fixup("jz", condidx, cond)
case op =>
generate
generate
addSimple(
op match {
case "Prti" => "prti"
case "Prts" => "prts"
case "Prtc" => "prtc"
case "Add" => "add"
case "Subtract" => "sub"
case "Multiply" => "mul"
case "Divide" => "div"
case "Mod" => "mod"
case "Less" => "lt"
case "LessEqual" => "le"
case "Greater" => "gt"
case "GreaterEqual" => "ge"
case "Equal" => "eq"
case "NotEqual" => "ne"
case "And" => "and"
case "Or" => "or"
case "Negate" => "neg"
case "Not" => "not"
}
)
}
}
}

View file

@ -0,0 +1,187 @@
(import (scheme base)
(scheme file)
(scheme process-context)
(scheme write)
(only (srfi 1) delete-duplicates list-index)
(only (srfi 13) string-delete string-index string-trim))
(define *names* '((Add add) (Subtract sub) (Multiply mul) (Divide div) (Mod mod)
(Less lt) (Greater gt) (LessEqual le) (GreaterEqual ge)
(Equal eq) (NotEqual ne) (And and) (Or or) (Negate neg)
(Not not) (Prts prts) (Prti prti) (Prtc prtc)))
(define (change-name name)
(if (assq name *names*)
(cdr (assq name *names*))
(error "Cannot find name" name)))
;; Read AST from given filename
;; - return as an s-expression
(define (read-code filename)
(define (read-expr)
(let ((line (string-trim (read-line))))
(if (string=? line ";")
'()
(let ((space (string-index line #\space)))
(if space
(list (string->symbol (string-trim (substring line 0 space)))
(string-trim (substring line space (string-length line))))
(list (string->symbol line) (read-expr) (read-expr)))))))
;
(with-input-from-file filename (lambda () (read-expr))))
;; run a three-pass assembler
(define (generate-code ast)
(define new-address ; create a new unique address - for jump locations
(let ((count 0))
(lambda ()
(set! count (+ 1 count))
(string->symbol (string-append "loc-" (number->string count))))))
; define some names for fields
(define left cadr)
(define right (lambda (x) (cadr (cdr x))))
;
(define (extract-values ast)
(if (null? ast)
(values '() '())
(case (car ast)
((Integer)
(values '() '()))
((Negate Not Prtc Prti Prts)
(extract-values (left ast)))
((Assign Add Subtract Multiply Divide Mod Less Greater LessEqual GreaterEqual
Equal NotEqual And Or If While Sequence)
(let-values (((a b) (extract-values (left ast)))
((c d) (extract-values (right ast))))
(values (delete-duplicates (append a c) string=?)
(delete-duplicates (append b d) string=?))))
((String)
(values '() (list (left ast))))
((Identifier)
(values (list (left ast)) '())))))
;
(let-values (((constants strings) (extract-values ast)))
(define (constant-idx term)
(list-index (lambda (s) (string=? s term)) constants))
(define (string-idx term)
(list-index (lambda (s) (string=? s term)) strings))
;
(define (pass-1 ast asm) ; translates ast into a list of basic operations
(if (null? ast)
asm
(case (car ast)
((Integer)
(cons (list 'push (left ast)) asm))
((Identifier)
(cons (list 'fetch (constant-idx (left ast))) asm))
((String)
(cons (list 'push (string-idx (left ast))) asm))
((Assign)
(cons (list 'store (constant-idx (left (left ast)))) (pass-1 (right ast) asm)))
((Add Subtract Multiply Divide Mod Less Greater LessEqual GreaterEqual
Equal NotEqual And Or) ; binary operators
(cons (change-name (car ast))
(pass-1 (right ast) (pass-1 (left ast) asm))))
((Negate Not Prtc Prti Prts) ; unary operations
(cons (change-name (car ast))
(pass-1 (left ast) asm)))
((If)
(let ((label-else (new-address))
(label-end (new-address)))
(if (null? (right (right ast)))
(cons (list 'label label-end) ; label for end of if statement
(pass-1 (left (right ast)) ; output the 'then block
(cons (list 'jz label-end) ; jump to end when test is false
(pass-1 (left ast) asm))))
(cons (list 'label label-end) ; label for end of if statement
(pass-1 (right (right ast)) ; output the 'else block
(cons (list 'label label-else)
(cons (list 'jmp label-end) ; jump past 'else, after 'then
(pass-1 (left (right ast)) ; output the 'then block
(cons (list 'jz label-else) ; jumpt to else when false
(pass-1 (left ast) asm))))))))))
((While)
(let ((label-test (new-address))
(label-end (new-address)))
(cons (list 'label label-end) ; introduce a label for end of while block
(cons (list 'jmp label-test) ; jump back to repeat test
(pass-1 (right ast) ; output the block
(cons (list 'jz label-end) ; test failed, jump around block
(pass-1 (left ast) ; output the test
(cons (list 'label label-test) ; introduce a label for test
asm))))))))
((Sequence)
(pass-1 (right ast) (pass-1 (left ast) asm)))
(else
"Unknown token type"))))
;
(define (pass-2 asm) ; adds addresses and fills in jump locations
(define (fill-addresses)
(let ((addr 0))
(map (lambda (instr)
(let ((res (cons addr instr)))
(unless (eq? (car instr) 'label)
(set! addr (+ addr (if (= 1 (length instr)) 1 5))))
res))
asm)))
;
(define (extract-labels asm)
(let ((labels '()))
(for-each (lambda (instr)
(when (eq? (cadr instr) 'label)
(set! labels (cons (cons (cadr (cdr instr)) (car instr))
labels))))
asm)
labels))
;
(define (add-jump-locations asm labels rec)
(cond ((null? asm)
(reverse rec))
((eq? (cadr (car asm)) 'label) ; ignore the labels
(add-jump-locations (cdr asm) labels rec))
((memq (cadr (car asm)) '(jmp jz)) ; replace labels with addresses for jumps
(add-jump-locations (cdr asm)
labels
(cons (list (car (car asm)) ; previous address
(cadr (car asm)) ; previous jump type
(cdr (assq (cadr (cdar asm)) labels))) ; actual address
rec)))
(else
(add-jump-locations (cdr asm) labels (cons (car asm) rec)))))
;
(let ((asm+addr (fill-addresses)))
(add-jump-locations asm+addr (extract-labels asm+addr) '())))
;
(define (output-instruction instr)
(display (number->string (car instr))) (display #\tab)
(display (cadr instr)) (display #\tab)
(case (cadr instr)
((fetch store)
(display "[") (display (number->string (cadr (cdr instr)))) (display "]\n"))
((jmp jz)
(display
(string-append "("
(number->string (- (cadr (cdr instr)) (car instr) 1))
")"))
(display #\tab)
(display (number->string (cadr (cdr instr)))) (newline))
((push)
(display (cadr (cdr instr))) (newline))
(else
(newline))))
; generate the code and output to stdout
(display
(string-append "Datasize: "
(number->string (length constants))
" Strings: "
(number->string (length strings))))
(newline)
(for-each (lambda (str) (display str) (newline))
strings)
(for-each output-instruction
(pass-2 (reverse (cons (list 'halt) (pass-1 ast '())))))))
;; read AST from file and output code to stdout
(if (= 2 (length (command-line)))
(generate-code (read-code (cadr (command-line))))
(display "Error: pass an ast filename\n"))

View file

@ -0,0 +1,345 @@
import "/dynamic" for Enum, Struct, Tuple
import "/crypto" for Bytes
import "/fmt" for Fmt
import "/ioutil" for FileUtil
var nodes = [
"Ident",
"String",
"Integer",
"Sequence",
"If",
"Prtc",
"Prts",
"Prti",
"While",
"Assign",
"Negate",
"Not",
"Mul",
"Div",
"Mod",
"Add",
"Sub",
"Lss",
"Leq",
"Gtr",
"Geq",
"Eql",
"Neq",
"And",
"Or"
]
var Node = Enum.create("Node", nodes)
var codes = [
"fetch",
"store",
"push",
"add",
"sub",
"mul",
"div",
"mod",
"lt",
"gt",
"le",
"ge",
"eq",
"ne",
"and",
"or",
"neg",
"not",
"jmp",
"jz",
"prtc",
"prts",
"prti",
"halt"
]
var Code = Enum.create("Code", codes)
var Tree = Struct.create("Tree", ["nodeType", "left", "right", "value"])
// dependency: Ordered by Node value, must remain in same order as Node enum
var Atr = Tuple.create("Atr", ["enumText", "nodeType", "opcode"])
var atrs = [
Atr.new("Identifier", Node.Ident, 255),
Atr.new("String", Node.String, 255),
Atr.new("Integer", Node.Integer, 255),
Atr.new("Sequence", Node.Sequence, 255),
Atr.new("If", Node.If, 255),
Atr.new("Prtc", Node.Prtc, 255),
Atr.new("Prts", Node.Prts, 255),
Atr.new("Prti", Node.Prti, 255),
Atr.new("While", Node.While, 255),
Atr.new("Assign", Node.Assign, 255),
Atr.new("Negate", Node.Negate, Code.neg),
Atr.new("Not", Node.Not, Code.not),
Atr.new("Multiply", Node.Mul, Code.mul),
Atr.new("Divide", Node.Div, Code.div),
Atr.new("Mod", Node.Mod, Code.mod),
Atr.new("Add", Node.Add, Code.add),
Atr.new("Subtract", Node.Sub, Code.sub),
Atr.new("Less", Node.Lss, Code.lt),
Atr.new("LessEqual", Node.Leq, Code.le),
Atr.new("Greater", Node.Gtr, Code.gt),
Atr.new("GreaterEqual", Node.Geq, Code.ge),
Atr.new("Equal", Node.Eql, Code.eq),
Atr.new("NotEqual", Node.Neq, Code.ne),
Atr.new("And", Node.And, Code.and),
Atr.new("Or", Node.Or, Code.or),
]
var stringPool = []
var globals = []
var object = []
var reportError = Fn.new { |msg| Fiber.abort("error : %(msg)") }
var nodeToOp = Fn.new { |nodeType| atrs[nodeType].opcode }
var makeNode = Fn.new { |nodeType, left, right| Tree.new(nodeType, left, right, "") }
var makeLeaf = Fn.new { |nodeType, value| Tree.new(nodeType, null, null, value) }
/* Code generator */
var emitByte = Fn.new { |c| object.add(c) }
var emitWord = Fn.new { |n|
var bs = Bytes.fromIntLE(n)
for (b in bs) emitByte.call(b)
}
var emitWordAt = Fn.new { |at, n|
var bs = Bytes.fromIntLE(n)
for (i in at...at+4) object[i] = bs[i-at]
}
var hole = Fn.new {
var t = object.count
emitWord.call(0)
return t
}
var fetchVarOffset = Fn.new { |id|
for (i in 0...globals.count) {
if (globals[i] == id) return i
}
globals.add(id)
return globals.count - 1
}
var fetchStringOffset = Fn.new { |st|
for (i in 0...stringPool.count) {
if (stringPool[i] == st) return i
}
stringPool.add(st)
return stringPool.count - 1
}
var binOpNodes = [
Node.Lss, Node.Gtr, Node.Leq, Node.Geq, Node.Eql, Node.Neq,
Node.And, Node.Or, Node.Sub, Node.Add, Node.Div, Node.Mul, Node.Mod
]
var codeGen // recursive function
codeGen = Fn.new { |x|
if (!x) return
var n
var p1
var p2
var nt = x.nodeType
if (nt == Node.Ident) {
emitByte.call(Code.fetch)
n = fetchVarOffset.call(x.value)
emitWord.call(n)
} else if (nt == Node.Integer) {
emitByte.call(Code.push)
n = Num.fromString(x.value)
emitWord.call(n)
} else if (nt == Node.String) {
emitByte.call(Code.push)
n = fetchStringOffset.call(x.value)
emitWord.call(n)
} else if (nt == Node.Assign) {
n = fetchVarOffset.call(x.left.value)
codeGen.call(x.right)
emitByte.call(Code.store)
emitWord.call(n)
} else if (nt == Node.If) {
codeGen.call(x.left) // if expr
emitByte.call(Code.jz) // if false, jump
p1 = hole.call() // make room forjump dest
codeGen.call(x.right.left) // if true statements
if (x.right.right) {
emitByte.call(Code.jmp)
p2 = hole.call()
}
emitWordAt.call(p1, object.count-p1)
if (x.right.right) {
codeGen.call(x.right.right)
emitWordAt.call(p2, object.count-p2)
}
} else if (nt == Node.While) {
p1 = object.count
codeGen.call(x.left) // while expr
emitByte.call(Code.jz) // if false, jump
p2 = hole.call() // make room for jump dest
codeGen.call(x.right) // statements
emitByte.call(Code.jmp) // back to the top
emitWord.call(p1 - object.count) // plug the top
emitWordAt.call(p2, object.count-p2) // plug the 'if false, jump'
} else if (nt == Node.Sequence) {
codeGen.call(x.left)
codeGen.call(x.right)
} else if (nt == Node.Prtc) {
codeGen.call(x.left)
emitByte.call(Code.prtc)
} else if (nt == Node.Prti) {
codeGen.call(x.left)
emitByte.call(Code.prti)
} else if (nt == Node.Prts) {
codeGen.call(x.left)
emitByte.call(Code.prts)
} else if (binOpNodes.contains(nt)) {
codeGen.call(x.left)
codeGen.call(x.right)
emitByte.call(nodeToOp.call(x.nodeType))
} else if (nt == Node.negate || nt == Node.Not) {
codeGen.call(x.left)
emitByte.call(nodeToOp.call(x.nodeType))
} else {
var msg = "error in code generator - found %(x.nodeType) expecting operator"
reportError.call(msg)
}
}
// Converts the 4 bytes starting at object[pc] to an unsigned 32 bit integer
// and thence to a signed 32 bit integer
var toInt32LE = Fn.new { |pc|
var x = Bytes.toIntLE(object[pc...pc+4])
if (x >= 2.pow(31)) x = x - 2.pow(32)
return x
}
var codeFinish = Fn.new { emitByte.call(Code.halt) }
var listCode = Fn.new {
Fmt.print("Datasize: $d Strings: $d", globals.count, stringPool.count)
for (s in stringPool) System.print(s)
var pc = 0
while (pc < object.count) {
Fmt.write("$5d ", pc)
var op = object[pc]
pc = pc + 1
if (op == Code.fetch) {
var x = toInt32LE.call(pc)
Fmt.print("fetch [$d]", x)
pc = pc + 4
} else if (op == Code.store) {
var x = toInt32LE.call(pc)
Fmt.print("store [$d]", x)
pc = pc + 4
} else if (op == Code.push) {
var x = toInt32LE.call(pc)
Fmt.print("push $d", x)
pc = pc + 4
} else if (op == Code.add) {
System.print("add")
} else if (op == Code.sub) {
System.print("sub")
} else if (op == Code.mul) {
System.print("mul")
} else if (op == Code.div) {
System.print("div")
} else if (op == Code.mod) {
System.print("mod")
} else if (op == Code.lt) {
System.print("lt")
} else if (op == Code.gt) {
System.print("gt")
} else if (op == Code.le) {
System.print("le")
} else if (op == Code.ge) {
System.print("ge")
} else if (op == Code.eq) {
System.print("eq")
} else if (op == Code.ne) {
System.print("ne")
} else if (op == Code.and) {
System.print("and")
} else if (op == Code.or) {
System.print("or")
} else if (op == Code.neg) {
System.print("neg")
} else if (op == Code.not) {
System.print("not")
} else if (op == Code.jmp) {
var x = toInt32LE.call(pc)
Fmt.print("jmp ($d) $d", x, pc+x)
pc = pc + 4
} else if (op == Code.jz) {
var x = toInt32LE.call(pc)
Fmt.print("jz ($d) $d", x, pc+x)
pc = pc + 4
} else if (op == Code.prtc) {
System.print("prtc")
} else if (op == Code.prti){
System.print("prti")
} else if (op == Code.prts) {
System.print("prts")
} else if (op == Code.halt) {
System.print("halt")
} else {
reportError.call("listCode: Unknown opcode %(op)")
}
}
}
var getEnumValue = Fn.new { |name|
for (atr in atrs) {
if (atr.enumText == name) return atr.nodeType
}
reportError.call("Unknown token %(name)")
}
var lines = []
var lineCount = 0
var lineNum = 0
var loadAst // recursive function
loadAst = Fn.new {
var nodeType = 0
var s = ""
if (lineNum < lineCount) {
var line = lines[lineNum].trimEnd(" \t")
lineNum = lineNum + 1
var tokens = line.split(" ").where { |s| s != "" }.toList
var first = tokens[0]
if (first[0] == ";") return null
nodeType = getEnumValue.call(first)
var le = tokens.count
if (le == 2) {
s = tokens[1]
} else if (le > 2) {
var idx = line.indexOf("\"")
s = line[idx..-1]
}
}
if (s != "") return makeLeaf.call(nodeType, s)
var left = loadAst.call()
var right = loadAst.call()
return makeNode.call(nodeType, left, right)
}
lines = FileUtil.readLines("ast.txt")
lineCount = lines.count
codeGen.call(loadAst.call())
codeFinish.call()
listCode.call()

View file

@ -0,0 +1,508 @@
const std = @import("std");
pub const CodeGeneratorError = error{OutOfMemory};
pub const CodeGenerator = struct {
allocator: std.mem.Allocator,
string_pool: std.ArrayList([]const u8),
globals: std.ArrayList([]const u8),
bytecode: std.ArrayList(u8),
const Self = @This();
const word_size = @sizeOf(i32);
pub fn init(
allocator: std.mem.Allocator,
string_pool: std.ArrayList([]const u8),
globals: std.ArrayList([]const u8),
) Self {
return CodeGenerator{
.allocator = allocator,
.string_pool = string_pool,
.globals = globals,
.bytecode = std.ArrayList(u8).init(allocator),
};
}
pub fn gen(self: *Self, ast: ?*Tree) CodeGeneratorError!void {
try self.genH(ast);
try self.emitHalt();
}
// Helper function to allow recursion.
pub fn genH(self: *Self, ast: ?*Tree) CodeGeneratorError!void {
if (ast) |t| {
switch (t.typ) {
.sequence => {
try self.genH(t.left);
try self.genH(t.right);
},
.kw_while => {
const condition_address = self.currentAddress();
try self.genH(t.left);
try self.emitByte(.jz);
const condition_address_hole = self.currentAddress();
try self.emitHole();
try self.genH(t.right);
try self.emitByte(.jmp);
try self.emitInt(condition_address);
self.insertInt(condition_address_hole, self.currentAddress());
},
.kw_if => {
try self.genH(t.left);
try self.emitByte(.jz);
const condition_address_hole = self.currentAddress();
try self.emitHole();
try self.genH(t.right.?.left);
if (t.right.?.right) |else_tree| {
try self.emitByte(.jmp);
const else_address_hole = self.currentAddress();
try self.emitHole();
const else_address = self.currentAddress();
try self.genH(else_tree);
self.insertInt(condition_address_hole, else_address);
self.insertInt(else_address_hole, self.currentAddress());
} else {
self.insertInt(condition_address_hole, self.currentAddress());
}
},
.assign => {
try self.genH(t.right);
try self.emitByte(.store);
try self.emitInt(self.fetchGlobalsOffset(t.left.?.value.?.string));
},
.prts => {
try self.genH(t.left);
try self.emitByte(.prts);
},
.prti => {
try self.genH(t.left);
try self.emitByte(.prti);
},
.prtc => {
try self.genH(t.left);
try self.emitByte(.prtc);
},
.string => {
try self.emitByte(.push);
try self.emitInt(self.fetchStringsOffset(t.value.?.string));
},
.integer => {
try self.emitByte(.push);
try self.emitInt(t.value.?.integer);
},
.identifier => {
try self.emitByte(.fetch);
try self.emitInt(self.fetchGlobalsOffset(t.value.?.string));
},
.negate, .not => {
try self.genH(t.left);
try self.emitByte(Op.fromNodeType(t.typ).?);
},
.add,
.multiply,
.subtract,
.divide,
.mod,
.less,
.less_equal,
.greater,
.greater_equal,
.equal,
.not_equal,
.bool_and,
.bool_or,
=> try self.genBinOp(t),
.unknown => {
std.debug.print("\nINTERP: UNKNOWN {}\n", .{t.typ});
std.os.exit(1);
},
}
}
}
fn genBinOp(self: *Self, tree: *Tree) CodeGeneratorError!void {
try self.genH(tree.left);
try self.genH(tree.right);
try self.emitByte(Op.fromNodeType(tree.typ).?);
}
fn emitByte(self: *Self, op: Op) CodeGeneratorError!void {
try self.bytecode.append(@enumToInt(op));
}
fn emitInt(self: *Self, n: i32) CodeGeneratorError!void {
var n_var = n;
var n_bytes = @ptrCast(*[4]u8, &n_var);
for (n_bytes) |byte| {
try self.bytecode.append(byte);
}
}
// Holes are later populated via `insertInt` because they can't be known when
// we populate the bytecode array sequentially.
fn emitHole(self: *Self) CodeGeneratorError!void {
try self.emitInt(std.math.maxInt(i32));
}
// Populates the "hole" produced by `emitHole`.
fn insertInt(self: *Self, address: i32, n: i32) void {
var i: i32 = 0;
var n_var = n;
var n_bytes = @ptrCast(*[4]u8, &n_var);
while (i < word_size) : (i += 1) {
self.bytecode.items[@intCast(usize, address + i)] = n_bytes[@intCast(usize, i)];
}
}
fn emitHalt(self: *Self) CodeGeneratorError!void {
try self.bytecode.append(@enumToInt(Op.halt));
}
fn currentAddress(self: Self) i32 {
return @intCast(i32, self.bytecode.items.len);
}
fn fetchStringsOffset(self: Self, str: []const u8) i32 {
for (self.string_pool.items) |string, idx| {
if (std.mem.eql(u8, string, str)) {
return @intCast(i32, idx);
}
}
unreachable;
}
fn fetchGlobalsOffset(self: Self, str: []const u8) i32 {
for (self.globals.items) |global, idx| {
if (std.mem.eql(u8, global, str)) {
return @intCast(i32, idx);
}
}
unreachable;
}
pub fn print(self: Self) ![]u8 {
var result = std.ArrayList(u8).init(self.allocator);
var writer = result.writer();
try writer.print(
"Datasize: {d} Strings: {d}\n",
.{ self.globals.items.len, self.string_pool.items.len },
);
for (self.string_pool.items) |string| {
try writer.print("{s}\n", .{string});
}
var pc: usize = 0;
while (pc < self.bytecode.items.len) : (pc += 1) {
try writer.print("{d:>5} ", .{pc});
switch (@intToEnum(Op, self.bytecode.items[pc])) {
.push => {
try writer.print("push {d}\n", .{self.unpackInt(pc + 1)});
pc += word_size;
},
.store => {
try writer.print("store [{d}]\n", .{self.unpackInt(pc + 1)});
pc += word_size;
},
.fetch => {
try writer.print("fetch [{d}]\n", .{self.unpackInt(pc + 1)});
pc += word_size;
},
.jz => {
const address = self.unpackInt(pc + 1);
try writer.print("jz ({d}) {d}\n", .{ address - @intCast(i32, pc) - 1, address });
pc += word_size;
},
.jmp => {
const address = self.unpackInt(pc + 1);
try writer.print("jmp ({d}) {d}\n", .{ address - @intCast(i32, pc) - 1, address });
pc += word_size;
},
else => try writer.print("{s}\n", .{Op.toString(@intToEnum(Op, self.bytecode.items[pc]))}),
}
}
return result.items;
}
fn unpackInt(self: Self, pc: usize) i32 {
const arg_ptr = @ptrCast(*[4]u8, self.bytecode.items[pc .. pc + word_size]);
var arg_array = arg_ptr.*;
const arg = @ptrCast(*i32, @alignCast(@alignOf(i32), &arg_array));
return arg.*;
}
};
pub const Op = enum(u8) {
fetch,
store,
push,
add,
sub,
mul,
div,
mod,
lt,
gt,
le,
ge,
eq,
ne,
@"and",
@"or",
neg,
not,
jmp,
jz,
prtc,
prts,
prti,
halt,
const from_node = std.enums.directEnumArray(NodeType, ?Op, 0, .{
.unknown = null,
.identifier = null,
.string = null,
.integer = null,
.sequence = null,
.kw_if = null,
.prtc = null,
.prts = null,
.prti = null,
.kw_while = null,
.assign = null,
.negate = .neg,
.not = .not,
.multiply = .mul,
.divide = .div,
.mod = .mod,
.add = .add,
.subtract = .sub,
.less = .lt,
.less_equal = .le,
.greater = .gt,
.greater_equal = .ge,
.equal = .eq,
.not_equal = .ne,
.bool_and = .@"and",
.bool_or = .@"or",
});
pub fn fromNodeType(node_type: NodeType) ?Op {
return from_node[@enumToInt(node_type)];
}
const to_string = std.enums.directEnumArray(Op, []const u8, 0, .{
.fetch = "fetch",
.store = "store",
.push = "push",
.add = "add",
.sub = "sub",
.mul = "mul",
.div = "div",
.mod = "mod",
.lt = "lt",
.gt = "gt",
.le = "le",
.ge = "ge",
.eq = "eq",
.ne = "ne",
.@"and" = "and",
.@"or" = "or",
.neg = "neg",
.not = "not",
.jmp = "jmp",
.jz = "jz",
.prtc = "prtc",
.prts = "prts",
.prti = "prti",
.halt = "halt",
});
pub fn toString(self: Op) []const u8 {
return to_string[@enumToInt(self)];
}
};
pub fn main() !void {
var arena = std.heap.ArenaAllocator.init(std.heap.page_allocator);
defer arena.deinit();
const allocator = arena.allocator();
var arg_it = std.process.args();
_ = try arg_it.next(allocator) orelse unreachable; // program name
const file_name = arg_it.next(allocator);
// We accept both files and standard input.
var file_handle = blk: {
if (file_name) |file_name_delimited| {
const fname: []const u8 = try file_name_delimited;
break :blk try std.fs.cwd().openFile(fname, .{});
} else {
break :blk std.io.getStdIn();
}
};
defer file_handle.close();
const input_content = try file_handle.readToEndAlloc(allocator, std.math.maxInt(usize));
var string_pool = std.ArrayList([]const u8).init(allocator);
var globals = std.ArrayList([]const u8).init(allocator);
const ast = try loadAST(allocator, input_content, &string_pool, &globals);
var code_generator = CodeGenerator.init(allocator, string_pool, globals);
try code_generator.gen(ast);
const result: []const u8 = try code_generator.print();
_ = try std.io.getStdOut().write(result);
}
pub const NodeType = enum {
unknown,
identifier,
string,
integer,
sequence,
kw_if,
prtc,
prts,
prti,
kw_while,
assign,
negate,
not,
multiply,
divide,
mod,
add,
subtract,
less,
less_equal,
greater,
greater_equal,
equal,
not_equal,
bool_and,
bool_or,
const from_string_map = std.ComptimeStringMap(NodeType, .{
.{ "UNKNOWN", .unknown },
.{ "Identifier", .identifier },
.{ "String", .string },
.{ "Integer", .integer },
.{ "Sequence", .sequence },
.{ "If", .kw_if },
.{ "Prtc", .prtc },
.{ "Prts", .prts },
.{ "Prti", .prti },
.{ "While", .kw_while },
.{ "Assign", .assign },
.{ "Negate", .negate },
.{ "Not", .not },
.{ "Multiply", .multiply },
.{ "Divide", .divide },
.{ "Mod", .mod },
.{ "Add", .add },
.{ "Subtract", .subtract },
.{ "Less", .less },
.{ "LessEqual", .less_equal },
.{ "Greater", .greater },
.{ "GreaterEqual", .greater_equal },
.{ "Equal", .equal },
.{ "NotEqual", .not_equal },
.{ "And", .bool_and },
.{ "Or", .bool_or },
});
pub fn fromString(str: []const u8) NodeType {
return from_string_map.get(str).?;
}
};
pub const NodeValue = union(enum) {
integer: i32,
string: []const u8,
};
pub const Tree = struct {
left: ?*Tree,
right: ?*Tree,
typ: NodeType = .unknown,
value: ?NodeValue = null,
fn makeNode(allocator: std.mem.Allocator, typ: NodeType, left: ?*Tree, right: ?*Tree) !*Tree {
const result = try allocator.create(Tree);
result.* = Tree{ .left = left, .right = right, .typ = typ };
return result;
}
fn makeLeaf(allocator: std.mem.Allocator, typ: NodeType, value: ?NodeValue) !*Tree {
const result = try allocator.create(Tree);
result.* = Tree{ .left = null, .right = null, .typ = typ, .value = value };
return result;
}
};
const LoadASTError = error{OutOfMemory} || std.fmt.ParseIntError;
fn loadAST(
allocator: std.mem.Allocator,
str: []const u8,
string_pool: *std.ArrayList([]const u8),
globals: *std.ArrayList([]const u8),
) LoadASTError!?*Tree {
var line_it = std.mem.split(u8, str, "\n");
return try loadASTHelper(allocator, &line_it, string_pool, globals);
}
fn loadASTHelper(
allocator: std.mem.Allocator,
line_it: *std.mem.SplitIterator(u8),
string_pool: *std.ArrayList([]const u8),
globals: *std.ArrayList([]const u8),
) LoadASTError!?*Tree {
if (line_it.next()) |line| {
var tok_it = std.mem.tokenize(u8, line, " ");
const tok_str = tok_it.next().?;
if (tok_str[0] == ';') return null;
const node_type = NodeType.fromString(tok_str);
const pre_iteration_index = tok_it.index;
if (tok_it.next()) |leaf_value| {
const node_value = blk: {
switch (node_type) {
.integer => break :blk NodeValue{ .integer = try std.fmt.parseInt(i32, leaf_value, 10) },
.identifier => {
var already_exists = false;
for (globals.items) |global| {
if (std.mem.eql(u8, global, leaf_value)) {
already_exists = true;
break;
}
}
if (!already_exists) try globals.append(leaf_value);
break :blk NodeValue{ .string = leaf_value };
},
.string => {
tok_it.index = pre_iteration_index;
const str = tok_it.rest();
var already_exists = false;
for (string_pool.items) |string| {
if (std.mem.eql(u8, string, str)) {
already_exists = true;
break;
}
}
if (!already_exists) try string_pool.append(str);
break :blk NodeValue{ .string = str };
},
else => unreachable,
}
};
return try Tree.makeLeaf(allocator, node_type, node_value);
}
const left = try loadASTHelper(allocator, line_it, string_pool, globals);
const right = try loadASTHelper(allocator, line_it, string_pool, globals);
return try Tree.makeNode(allocator, node_type, left, right);
} else {
return null;
}
}

View file

@ -0,0 +1,113 @@
// This is a little endian machine
const WORD_SIZE=4;
const{ var _n=-1; var[proxy]N=fcn{ _n+=1 }; } // enumerator
const FETCH=N, STORE=N, PUSH=N, ADD=N, SUB=N, MUL=N, DIV=N, MOD=N,
LT=N, GT=N, LE=N, GE=N, EQ=N, NE=N,
AND=N, OR=N, NEG=N, NOT=N,
JMP=N, JZ=N, PRTC=N, PRTS=N, PRTI=N, HALT=N;
const nd_String=N, nd_Sequence=N, nd_If=N, nd_While=N;
var all_syms=Dictionary(
"Identifier" ,FETCH, "String" ,nd_String,
"Integer" ,PUSH, "Sequence" ,nd_Sequence,
"If" ,nd_If, "Prtc" ,PRTC,
"Prts" ,PRTS, "Prti" ,PRTI,
"While" ,nd_While, "Assign" ,STORE,
"Negate" ,NEG, "Not" ,NOT,
"Multiply" ,MUL, "Divide" ,DIV,
"Mod" ,MOD, "Add" ,ADD,
"Subtract" ,SUB, "Less" ,LT,
"LessEqual" ,LE, "Greater" ,GT,
"GreaterEqual",GE, "Equal" ,EQ,
"NotEqual" ,NE, "And" ,AND,
"Or" ,OR, "halt" ,HALT);
var binOps=T(LT,GT,LE,GE,EQ,NE, AND,OR, SUB,ADD,DIV,MUL,MOD),
unaryOps=T(NEG,NOT);
class Node{
fcn init(_node_type, _value, _left=Void, _right=Void){
var type=_node_type, left=_left, right=_right, value=_value;
}
}
var vars=Dictionary(), strings=Dictionary(); // ( value:offset, ...)
fcn doVar(value){
var offset=-1; // fcn local static var
offset=_doValue(value,vars,offset)
}
fcn doString(str){ str=str[1,-1]; // str is \"text\"
var offset=-1; // fcn local static var
str=str.replace("\\n","\n");
offset=_doValue(str,strings,offset)
}
fcn _doValue(value,vars,offset){ //--> offset of value in vars
if(Void!=(n:=vars.find(value))) return(n); // fetch existing value
vars[value]=offset+=1; // store new value
}
fcn asm(node,code){
if(Void==node) return(code);
emitB:='wrap(n){ code.append(n) };
emitW:='wrap(n){ code.append(n.toLittleEndian(WORD_SIZE)) }; // signed
switch(node.type){
case(FETCH) { emitB(FETCH); emitW(doVar(node.value)); }
case(PUSH) { emitB(PUSH); emitW(node.value); }
case(nd_String){ emitB(PUSH); emitW(doString(node.value)); }
case(STORE){
asm(node.right,code);
emitB(STORE); emitW(doVar(node.left.value));
}
case(nd_If){
asm(node.left,code); # expr
emitB(JZ); # if false, jump
p1,p2 := code.len(),0;
emitW(0); # place holder for jump dest
asm(node.right.left,code); # if true statements
if (node.right.right!=Void){
emitB(JMP); # jump over else statements
p2=code.len();
emitW(0);
}
code[p1,WORD_SIZE]=(code.len() - p1).toLittleEndian(WORD_SIZE);
if(node.right.right!=Void){
asm(node.right.right,code); # else statements
code[p2,WORD_SIZE]=(code.len() - p2).toLittleEndian(WORD_SIZE)
}
}
case(nd_While){
p1:=code.len();
asm(node.left,code);
emitB(JZ);
p2:=code.len();
emitW(0); # place holder
asm(node.right,code);
emitB(JMP); # jump back to the top
emitW(p1 - code.len());
code[p2,WORD_SIZE]=(code.len() - p2).toLittleEndian(WORD_SIZE);
}
case(nd_Sequence){ asm(node.left,code); asm(node.right,code); }
case(PRTC,PRTI,PRTS){ asm(node.left,code); emitB(node.type); }
else{
if(binOps.holds(node.type)){
asm(node.left,code); asm(node.right,code);
emitB(node.type);
}
else if(unaryOps.holds(node.type))
{ asm(node.left,code); emitB(node.type); }
else throw(Exception.AssertionError(
"error in code generator - found %d, expecting operator"
.fmt(node.type)))
}
}
code
}
fcn code_finish(code){
code.append(HALT);
// prepend the strings to the code,
// using my magic [66,1 byte len,text], no trailing '\0' needed
idxs:=strings.pump(Dictionary(),"reverse");
idxs.keys.sort().reverse().pump(Void,'wrap(n){
text:=idxs[n];
code.insert(0,66,text.len(),text);
})
}

View file

@ -0,0 +1,35 @@
fcn unasm(code){
all_ops,nthString := all_syms.pump(Dictionary(),"reverse"),-1;
println("Datasize: %d bytes, Strings: %d bytes"
.fmt(vars.len()*WORD_SIZE,strings.reduce(fcn(s,[(k,v)]){ s+k.len() },0)));
word:='wrap(pc){ code.toLittleEndian(pc,WORD_SIZE,False) }; // signed
pc:=0; while(pc<code.len()){
op:=code[pc]; print("%4d: %2d ".fmt(pc,op));
pc+=1;
switch(op){
case(66){
n,str := code[pc], code[pc+=1,n].text;
println("String #%d %3d \"%s\"".fmt(nthString+=1,n,
Compiler.Asm.quotify(str)));
pc+=n;
}
case(FETCH,STORE,PUSH){
println("%s [%d]".fmt(all_ops[op],word(pc)));
pc+=WORD_SIZE;
}
case(ADD,SUB,MUL,DIV,MOD,LT,GT,LE,GE,EQ,NE,AND,OR,NEG,NOT,
PRTC,PRTI,PRTS,HALT){ println(all_ops[op]) }
case(JMP){
n:=word(pc);
println("jmp (%d) %d".fmt(n, pc + n));
pc+=WORD_SIZE;
}
case(JZ){
n:=word(pc);
println("jz (%d) %d".fmt(n, pc + n));
pc+=WORD_SIZE;
}
else throw(Exception.AssertionError("Unknown opcode %d".fmt(op)));
}
}
}

View file

@ -0,0 +1,12 @@
fcn load_ast(file){
line:=file.readln().strip(); // one or two tokens
if(line[0]==";") return(Void);
parts,type,value := line.split(),parts[0],parts[1,*].concat(" ");
type=all_syms[type];
if(value){
try{ value=value.toInt() }catch{}
return(Node(type,value));
}
left,right := load_ast(file),load_ast(file);
Node(type,Void,left,right)
}

View file

@ -0,0 +1,6 @@
ast:=load_ast(File(vm.nthArg(0)));
code:=asm(ast,Data());
code_finish(code);
unasm(code);
File("code.bin","wb").write(code);
println("Wrote %d bytes to code.bin".fmt(code.len()));