[Fdcil-cvs] dev/miracle2k/exercises/expression_parser Cradle.pas,NONE,1.1 test1.bdsproj,1.1,1.2 test
Status: Planning
Brought to you by:
miracle2k
Menu
▾
▴
[Fdcil-cvs] dev/miracle2k/exercises/expression_parser Cradle.pas,NONE,1.1 test1.bdsproj,1.1,1.2 test1.dpr,1.1,1.2
|
From: Michael E. <mir...@us...> - 2004-08-04 09:54:22
|
Update of /cvsroot/fdcil/dev/miracle2k/exercises/expression_parser In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv21509/miracle2k/exercises/expression_parser Modified Files: test1.bdsproj test1.dpr Added Files: Cradle.pas Log Message: support for mutliple digits; whitespace is now ignored --- NEW FILE: Cradle.pas --- unit Cradle; interface uses SysUtils; var Input: string; Curr: Integer; Look: char; procedure GetChar; procedure Error (s: string); procedure Abort(s: string); procedure Expected(s: string); procedure Match(x: char); function IsAlpha(c: char): boolean; function IsDigit(c: char): boolean; function IsAlNum(c: char): boolean; function IsAddOp(c: char): boolean; function IsWhite ( c : char ): boolean ; procedure SkipWhite; function GetName: string; function GetNum: string; procedure Emit(s: string); procedure EmitLn(s: string); procedure Init; implementation procedure GetChar; begin Inc(Curr); if Curr <= Length(Input) then Look := Input[Curr] else Look := #0; end; procedure Error(s: string); begin WriteLn; WriteLn(^G, 'Error: ', s, '.'); end; procedure Abort(s: string); begin Error(s); raise Exception.Create; end; procedure Expected(s: string); begin if s = #0 then Abort('Invalid characters at end of input') else Abort ( s + ' was expected.'); end; procedure Match(x: char); begin if Look = x then begin GetChar; SkipWhite; end else Expected(x); end ; function IsAlpha(c: char): boolean; begin IsAlpha := UpperCase(c)[1] 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 Result := c in ['+', '-']; end; function IsWhite ( c : char ): boolean ; begin Result := c in [ ' ' , #9 ] ; end; procedure SkipWhite; begin while IsWhite(Look) do GetChar; end; function GetName: string; var Token: string; begin Token := ''; if not IsAlpha (Look) then Expected('Name'); while IsAlpha(Look) do begin Token := Token + UpperCase(Look); GetChar; end; Result := Token; SkipWhite; 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; end; Result := Value; SkipWhite; end; procedure Emit(s: string); begin Write(#9 + s); end; procedure EmitLn(s: string); begin Emit(s); Writeln; end; procedure Init; begin Readln(Input); Curr := 0; GetChar; SkipWhite; end; end. Index: test1.dpr =================================================================== RCS file: /cvsroot/fdcil/dev/miracle2k/exercises/expression_parser/test1.dpr,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** test1.dpr 3 Aug 2004 15:09:30 -0000 1.1 --- test1.dpr 4 Aug 2004 09:54:13 -0000 1.2 *************** *** 5,12 **** uses SysUtils, ! Cradle in '..\Cradle.pas'; procedure Expression; forward; procedure Factor; begin --- 5,25 ---- uses SysUtils, ! Cradle in 'Cradle.pas'; procedure Expression; forward; + procedure Ident; + var + Name: string; + begin + Name := GetName; + if Look = '(' then begin + Match('('); Match(')'); + Emitln('BSR ' + Name); + end + else + EmitLn ('MOVE ' + Name + '(PC), D0') + end; + procedure Factor; begin *************** *** 17,20 **** --- 30,35 ---- Match(')'); end + else if IsAlpha ( Look ) then + Ident else Emitln('MOVE #' + GetNum + ', D0'); *************** *** 83,91 **** end; begin while true do try Init; ! Expression; Match(#0); except --- 98,118 ---- end; + procedure Assignment; + var + Name: string; + begin + Name := GetName; + Match('='); + Expression; + Emitln('LEA ' + Name + '(PC), A0'); + Emitln('MOVE D0, (A0)'); + end; + begin while true do try Init; ! (*Expression;*) ! Assignment; Match(#0); except Index: test1.bdsproj =================================================================== RCS file: /cvsroot/fdcil/dev/miracle2k/exercises/expression_parser/test1.bdsproj,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** test1.bdsproj 3 Aug 2004 15:09:30 -0000 1.1 --- test1.bdsproj 4 Aug 2004 09:54:13 -0000 1.2 *************** *** 163,775 **** - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - <FileList> <File FileName="" ContainerId="" ModuleName="SysUtils"/> ! <File FileName="..\Cradle.pas" ContainerId="" ModuleName="Cradle"/> </FileList> </DelphiDotNet.Personality> --- 163,169 ---- <FileList> <File FileName="" ContainerId="" ModuleName="SysUtils"/> ! <File FileName="Cradle.pas" ContainerId="" ModuleName="Cradle"/> </FileList> </DelphiDotNet.Personality> |
