program Main; const TAB = ^I; LF = ^J; var Look : char; LCount : integer; procedure Error(s : string); begin WriteLn; WriteLn(^G, 'Error: ', s, '.'); end; procedure GetChar; begin Read(Look); end; function IsWhite(c: char): boolean; begin IsWhite := c in [' ', TAB]; end; procedure SkipWhite; begin while IsWhite(Look) do GetChar; end; procedure Abort(s : string); begin Error(s); Halt; end; procedure Expected(s : string); begin Abort(s + ' expected'); end; procedure Match(c : char); begin if c <> Look then Expected('''' + c + '''') else begin GetChar; SkipWhite; end end; function IsAlpha(c : char) : boolean; begin IsAlpha := upcase(c) in ['A'..'Z']; end; function IsDigit(c : char) : boolean; begin IsDigit := c in ['0'..'9']; end; function IsAlNum(c: char): boolean; begin IsAlNum := IsAlpha(c) or IsDigit(c); end; function IsAddop(c: char): boolean; begin IsAddop := c in ['+', '-']; end; function GetName : string; var Token : string; begin Token := ''; if not IsAlpha(Look) then Expected('Name'); while IsAlNum(Look) do begin Token := Token + UpCase(Look); GetChar; SkipWhite; end; GetName := Token; end; function GetNum : string; var Value : string; begin Value := ''; if not IsDigit(Look) then Expected('Integer'); while IsDigit(Look) do begin Value := Value + Look; GetChar; SkipWhite; end; GetNum := Value; end; procedure Emit(s : string); begin Write(TAB, s); end; procedure EmitLn(s : string); begin Emit(s); WriteLn; end; function NewLabel : string; var s : string; begin Str(LCount, s); NewLabel := 'L'+s; Inc(LCount); end; procedure EmitLabel(s : string); begin WriteLn(s+':'); end; procedure EmitComment(s : string); begin WriteLn('; '+s); end; procedure Expression; forward; type symbolType = ( variableType = 1, functionType = 2 ); var nof_symbols : integer; symbols : array[0..26] of record name : string; sym_type : symbolType; end; procedure RememberName(name : string; sym_type : symbolType); var i : integer; found : boolean; begin found := false; for i := 0 to nof_symbols do begin if symbols[i].name = name then found := true; end; if i = 26 then Abort('Table of symbols overflowed'); if not found then begin symbols[nof_symbols].name := name; symbols[nof_symbols].sym_type := sym_type; inc(nof_symbols); end; end; procedure Ident; var name : string; begin name := GetName; if Look = '(' then begin Match('('); Match(')'); RememberName(name, functionType); EmitLn('call '+name); end else begin RememberName(name, variableType); EmitLn('mov eax,['+name+']'); end; end; procedure Factor; begin if Look = '(' then begin Match('('); Expression; Match(')'); end else if IsAlpha(Look) then Ident else EmitLn('mov eax, ' + GetNum); end; procedure Multiply; begin Match('*'); Factor; EmitLn('pop ebx'); EmitLn('mul ebx'); end; procedure Divide; begin Match('/'); Factor; EmitLn('mov ecx,eax'); EmitLn('pop eax'); EmitLn('div ecx'); end; procedure Term; begin Factor; while Look in ['*', '/'] do begin EmitLn('push eax'); case Look of '*': Multiply; '/': Divide; else Expected('* or /'); end; end; end; procedure Add; begin; Match('+'); Term; Emitln('pop ebx'); EmitLn('add eax,ebx'); end; procedure Subtract; begin; Match('-'); Term; EmitLn('pop ebx'); EmitLn('sub eax, ebx'); EmitLn('neg eax'); end; procedure Expression; begin if IsAddop(Look) then EmitLn('MOV eax, 0') else Term; while Look in ['+', '-'] do begin EmitLn('push eax'); case Look of '+': Add; '-': Subtract; else Expected('+ or -'); end; end; end; procedure Assignment; var name : string; begin name := GetName; RememberName(name, variableType); Match('='); Expression; EmitLn('lea ebx,['+name+']'); EmitLn('mov [ebx],eax'); end; procedure Init; begin nof_symbols := 0; LCount := 0; GetChar; SkipWhite; end; procedure Prologue; begin WriteLn('[bits 32]'); WriteLn('cpu 486'); WriteLn('org 0x1000000'); { WriteLn('section .text'); WriteLn('global main'); EmitLabel('main'); EmitLn('push ebp'); EmitLn('mov ebp, esp'); } end; procedure Functions; var i : integer; begin for i := 0 to nof_symbols-1 do begin if symbols[i].sym_type = FunctionType then begin EmitLabel(symbols[i].name); EmitLn('ret'); end; end; end; procedure Variables; var i : integer; begin for i := 0 to nof_symbols-1 do begin if symbols[i].sym_type = VariableType then begin EmitLabel(symbols[i].name); EmitLn('dd 0'); end; end; end; procedure Epilogue; begin EmitLn('hlt'); Functions; Variables; { EmitLn('leave'); EmitLn('ret'); } end; procedure NewLine; begin if Look = LF then GetChar; end; procedure Other; begin while not(Look in ['e']) do begin Assignment; Newline; { EmitComment('Other: '+GetName);} end; end; procedure Block; forward; procedure Condition; begin EmitComment('Condition: '+GetName); end; procedure DoIf; var L : string; begin Match('i'); L := NewLabel; Condition; EmitLn('jz '+L); Block; Match('e'); EmitLabel(L); end; procedure Block; begin while not(Look in ['e']) do begin case Look of 'i': DoIf; 'o': Other; end; end; end; procedure DoProgram; begin Block; if Look <> 'e' then Expected('END'); EmitComment('END'); end; begin Prologue; Init; DoProgram; { Other; repeat Assignment; NewLine; until Look = '.'; } Epilogue; end.