Initial data commit
This commit is contained in:
Ingy döt Net
parent
72d218235f
commit
f23f22d71c
199087 changed files with 3378941 additions and 0 deletions
366
Task/Compiler-code-generator/ALGOL-W/compiler-code-generator.alg
Normal file
366
Task/Compiler-code-generator/ALGOL-W/compiler-code-generator.alg
Normal 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.
|
||||
Loading…
Add table
Add a link
Reference in a new issue