Raimondi

Untitled

Jun 25th, 2011
138
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 5.67 KB | None | 0 0
  1. {--------------------------------------------------------------}
  2. program Cradle;
  3.  
  4. {--------------------------------------------------------------}
  5. { Constant Declarations }
  6.  
  7. const TAB = ^I;
  8. const CR  = ^M;
  9. {--------------------------------------------------------------}
  10. { Variable Declarations }
  11.  
  12. var Look: char;              { Lookahead Character }
  13.                              
  14. {--------------------------------------------------------------}
  15. { Read New Character From Input Stream }
  16.  
  17. procedure GetChar;
  18. begin
  19.    Read(Look);
  20. end;
  21.  
  22. {--------------------------------------------------------------}
  23. { Report an Error }
  24.  
  25. procedure Error(s: string);
  26. begin
  27.    WriteLn;
  28.    WriteLn(^G, 'Error: ', s, '.');
  29. end;
  30.  
  31.  
  32. {--------------------------------------------------------------}
  33. { Report Error and Halt }
  34.  
  35. procedure Abort(s: string);
  36. begin
  37.    Error(s);
  38.    Halt;
  39. end;
  40.  
  41.  
  42. {--------------------------------------------------------------}
  43. { Report What Was Expected }
  44.  
  45. procedure Expected(s: string);
  46. begin
  47.    Abort(s + ' Expected');
  48. end;
  49.  
  50. {--------------------------------------------------------------}
  51. { Match a Specific Input Character }
  52.  
  53. procedure Match(x: char);
  54. begin
  55.    if Look = x then GetChar
  56.    else Expected('''' + x + '''');
  57. end;
  58.  
  59. {--------------------------------------------------------------}
  60. { Recognize an Addop }
  61.  
  62. function IsAddop(c: char): boolean;
  63. begin
  64.    IsAddop := c in ['+', '-'];
  65. end;
  66. {--------------------------------------------------------------}
  67.  
  68.  
  69. {--------------------------------------------------------------}
  70. { Recognize an Alpha Character }
  71.  
  72. function IsAlpha(c: char): boolean;
  73. begin
  74.    IsAlpha := upcase(c) in ['A'..'Z'];
  75. end;
  76.                              
  77.  
  78. {--------------------------------------------------------------}
  79.  
  80. { Recognize a Decimal Digit }
  81.  
  82. function IsDigit(c: char): boolean;
  83. begin
  84.    IsDigit := c in ['0'..'9'];
  85. end;
  86.  
  87.  
  88. {--------------------------------------------------------------}
  89. { Get an Identifier }
  90.  
  91. function GetName: char;
  92. begin
  93.    if not IsAlpha(Look) then Expected('Name');
  94.    GetName := UpCase(Look);
  95.    GetChar;
  96. end;
  97.  
  98.  
  99. {--------------------------------------------------------------}
  100. { Get a Number }
  101.  
  102. function GetNum: char;
  103. begin
  104.    if not IsDigit(Look) then Expected('Integer');
  105.    GetNum := Look;
  106.    GetChar;
  107. end;
  108.  
  109.  
  110. {--------------------------------------------------------------}
  111. { Output a String with Tab }
  112.  
  113. procedure Emit(s: string);
  114. begin
  115.    Write(TAB, s);
  116. end;
  117.  
  118.  
  119.  
  120.  
  121. {--------------------------------------------------------------}
  122. { Output a String with Tab and CRLF }
  123.  
  124. procedure EmitLn(s: string);
  125. begin
  126.    Emit(s);
  127.    WriteLn;
  128. end;
  129.  
  130. {--------------------------------------------------------------}
  131. { Initialize }
  132.  
  133. procedure Init;
  134. begin
  135.    GetChar;
  136. end;
  137.  
  138. {---------------------------------------------------------------}
  139. { Parse and Translate an Identifier }
  140.  
  141. procedure Ident;
  142. var Name: char;
  143. begin
  144.    Name := GetName;
  145.    if Look = '(' then begin
  146.       Match('(');
  147.       Match(')');
  148.       EmitLn('BSR ' + Name);
  149.       end
  150.    else
  151.       EmitLn('MOVE ' + Name + '(PC),D0')
  152. end;
  153. {---------------------------------------------------------------}
  154.  
  155.  
  156. {---------------------------------------------------------------}
  157. { Parse and Translate a Math Factor }
  158.  
  159. procedure Expression; Forward;
  160.  
  161. procedure Factor;
  162. begin
  163.    if Look = '(' then begin
  164.       Match('(');
  165.       Expression;
  166.       Match(')');
  167.       end
  168.    else if IsAlpha(Look) then
  169.       Ident
  170.    else
  171.       EmitLn('MOVE #' + GetNum + ',D0');
  172. end;
  173.  
  174.  
  175. {--------------------------------------------------------------}
  176. { Recognize and Translate a Multiply }
  177.  
  178. procedure Multiply;
  179. begin
  180.    Match('*');
  181.    Factor;
  182.    EmitLn('MULS (SP)+,D0');
  183. end;
  184.  
  185.  
  186. {-------------------------------------------------------------}
  187. { Recognize and Translate a Divide }
  188.  
  189. procedure Divide;
  190. begin
  191.    Match('/');
  192.    Factor;
  193.    EmitLn('MOVE (SP)+,D1');
  194.    EmitLn('DIVS D1,D0');
  195. end;
  196.  
  197.  
  198. {---------------------------------------------------------------}
  199. { Parse and Translate a Math Term }
  200.  
  201. procedure Term;
  202. begin
  203.    Factor;
  204.    while Look in ['*', '/'] do begin
  205.       EmitLn('MOVE D0,-(SP)');
  206.       case Look of
  207.        '*': Multiply;
  208.        '/': Divide;
  209.       end;
  210.    end;
  211. end;
  212.  
  213.  
  214.  
  215.  
  216. {--------------------------------------------------------------}
  217. { Recognize and Translate an Add }
  218.  
  219. procedure Add;
  220. begin
  221.    Match('+');
  222.    Term;
  223.    EmitLn('ADD (SP)+,D0');
  224. end;
  225.  
  226.  
  227. {-------------------------------------------------------------}
  228. { Recognize and Translate a Subtract }
  229.  
  230. procedure Subtract;
  231. begin
  232.    Match('-');
  233.    Term;
  234.    EmitLn('SUB (SP)+,D0');
  235.    EmitLn('NEG D0');
  236. end;
  237.  
  238.  
  239. {---------------------------------------------------------------}
  240. { Parse and Translate an Expression }
  241.  
  242. procedure Expression;
  243. begin
  244.    if IsAddop(Look) then
  245.       EmitLn('CLR D0')
  246.    else
  247.       Term;
  248.    while IsAddop(Look) do begin
  249.       EmitLn('MOVE D0,-(SP)');
  250.       case Look of
  251.        '+': Add;
  252.        '-': Subtract;
  253.       end;
  254.    end;
  255. end;
  256. {--------------------------------------------------------------}
  257.  
  258. {--------------------------------------------------------------}
  259. { Parse and Translate an Assigment Statement }
  260.  
  261. procedure Assignment;
  262. var Name: char;
  263. begin
  264.    Name := GetName;
  265.    Match('=');
  266.    Expression;
  267.    EmitLn('LEA ' + Name + '(PC),A0');
  268.    EmitLn('MOVE D0,(A0)')
  269. end;
  270. {--------------------------------------------------------------}
  271.  
  272. {--------------------------------------------------------------}
  273. { Main Program }
  274.  
  275. begin
  276.    Init;
  277.    Expression;
  278.    if Look <> CR then Expected('Newline');
  279. end.
  280. {--------------------------------------------------------------}
Advertisement
Add Comment
Please, Sign In to add comment