function fix_post(expr : str; var post_expr : str) : boolean; var valid : boolean; token : str; begin { procedure fix_post } valid := true; post_expr := ''; while get_token(expr, token) do begin post_expr := post_expr + token + ' '; end; fix_post := valid; end; { function fix_post } function eval_post(expr : str; var val : number) : boolean; type num_ptr = ^num_rec; num_rec = record num : str; next : num_ptr; end; var num_stack : num_ptr; result : str; token : str; valid : boolean; function empty(num_stack : num_ptr) : boolean; begin { function empty } empty := num_stack = nil; end; { function empty } function pop(var num_stack : num_ptr) : str; var prev : num_ptr; begin { function pop } if empty(num_stack) then begin pop := ''; writeln('Stack empty.'); end else begin pop := num_stack^.num; prev := num_stack; num_stack := num_stack^.next; dispose(prev); end; end; { function pop } procedure push(var num_stack : num_ptr; num : str); var new_num : num_ptr; begin { procedure push } new(new_num); new_num^.num := num; new_num^.next := num_stack; num_stack := new_num; end; { procdure push } function top(num_stack : num_ptr) : str; begin { function top } if empty(num_stack) then begin top := ''; writeln('Stack empty.'); end else top := num_stack^.num; end; { function top } function get_token(var s : str; var token : str) : boolean; begin { function get_token } if s = '' then get_token := false else begin token := copy(s, 1, pos(' ', s) - 1); s := copy(s, pos(' ', s) + 1, length(s) - pos(' ', s)); get_token := true; end; end; { function get_token } procedure add(num1, num2 : number; var result : number); forward; procedure sub(num1, num2 : number; var result : number); procedure sub_sub(num1, num2 : number; var result : number); var temp : integer; borrow : integer; b : integer; begin { procedure sub_sub } borrow := 0; for b := 1 to MAXB do begin temp := (num1.n[b] - borrow) - num2.n[b]; if (temp < 0) then begin result.n[b] := temp + 256; borrow := 1; end else begin result.n[b] := temp; borrow := 0; end; end; if (borrow <> 0) then writeln('sub_sub: incorrect subtraction.'); end; { procedure sub_sub } begin { procedure sub } if num1.s * num2.s = -1 then begin num2.s := - num2.s; add(num1, num2, result); result.s := num1.s; end else if (numcmp(num1, num2) >= 0) then begin sub_sub(num1, num2, result); result.s := num1.s; end else begin sub_sub(num2, num1, result); result.s := - num1.s; end; end; { procedure sub } procedure add {num1, num2 : number; var result : number} ; procedure add_add(num1, num2 : number; var result : number); var b, carry : integer; begin { procedure add_add } carry := 0; for b := 1 to MAXB do begin result.n[b] := (num1.n[b] + num2.n[b] + carry) mod 256; carry := (num1.n[b] + num2.n[b] + carry) div 256; end; if (carry > 0) then writeln('numeric overflow.'); end; { procedure add_add } begin { procedure add } if num1.s * num2.s = -1 then if num1.s = -1 then begin num1.s := 1; sub(num2, num1, result); end else begin num2.s := 1; sub(num1, num2, result); end else begin add_add(num1, num2, result); result.s := num1.s; end; end; { procedure add } procedure mul(num1, num2 : number; var result : number); var b : integer; i : integer; m_result : number; begin { procedure mul } zero(result); for b := 1 to MAXB do begin mult_ni(num1, num2.n[b], m_result); for i := MAXB downto 1 do begin if i >= b then m_result.n[i] := m_result.n[i - b + 1] else m_result.n[i] := 0; end; add(result, m_result, result); end; result.s := num1.s * num2.s; end; { procedure mul } procedure dvd(num1, num2 : number; var result, remainder : number); var b : integer; partial, part_res : number; procedure dvd_dvd(num1, num2 : number; var result, remainder : number); var b : integer; begin { procedure dvd_dvd } zero(result); while (numcmp(num1, num2) >= 0) do begin sub(num1, num2, num1); add_ni(result, 1, result); end; remainder.n := num1.n; end; { procedure dvd_dvd } begin { procedure dvd } zero(remainder); for b := MAXB downto 1 do begin partial := remainder; mult_ni(partial, 256, partial); partial.n[1] := num1.n[b]; dvd_dvd(partial, num2, part_res, remainder); result.n[b] := part_res.n[1]; end; result.s := num1.s * num2.s; remainder.s := 1; end; { procedure dvd } procedure pow(num1, num2 : number; var result : number); begin { procedure pow } if odd(num2.n[1]) then result.s := num1.s else result.s := 1; zero(result); add_ni(result, 1, result); while (numcmp(num2, zero_n) <> 0) do begin mul(result, num1, result); add_ni(num2, -1, num2); end; end; { procedure pow } procedure fix_bit(var num : number); begin { procedure fix_bit } if num.s = -1 then begin num.b := (neg_one - num.b); add_ni(num, 1, num); end; num.s := 1; end; { procedure fix_bit } procedure bit_and(num1, num2 : number; var result : number); begin { procedure bit_and } fix_bit(num1); fix_bit(num2); result.b := num1.b * num2.b end; { procedure bit_and } procedure bit_or(num1, num2 : number; var result : number); begin { procedure bit_or } fix_bit(num1); fix_bit(num2); result.b := num1.b + num2.b; result.s := 1; end; { procedure bit_or } procedure bit_xor(num1, num2 : number; var result : number); begin { procedure bit_xor } fix_bit(num1); fix_bit(num2); result.b := (num1.b - num2.b) + (num2.b - num1.b); result.s := 1; end; { procedure bit_xor } function do_eval(num2, num1, op : str; var result : str) : boolean; var dec1, dec2 : number; dec_result, dummy : number; valid : boolean; begin { function do_eval } valid := true; if (num1 = '') or (num2 = '') then begin writeln('Unbalanced expression.'); writeln(' - missing operands.'); valid := false; end else if not todec(num1, in_rad, dec1) then valid := false else if not todec(num2, in_rad, dec2) then valid := false else if op = '+' then add(dec1, dec2, dec_result) else if op = '-' then sub(dec1, dec2, dec_result) else if op = '*' then mul(dec1, dec2, dec_result) else if op = '/' then if numcmp(dec2, zero_n) = 0 then begin writeln('Division by zero.'); valid := false; end else dvd(dec1, dec2, dec_result, dummy) else if op = '%' then if numcmp(dec2, zero_n) = 0 then begin writeln('Division by zero.'); valid := false; end else dvd(dec1, dec2, dummy, dec_result) else if op = '**' then pow(dec1, dec2, dec_result) else if op = '&' then bit_and(dec1, dec2, dec_result) else if op = '|' then bit_or(dec1, dec2, dec_result) else if op = '^' then bit_xor(dec1, dec2, dec_result) else begin writeln('Invalid operator: ''', op, '''.'); valid := false; end; if valid then toother(dec_result, in_rad, result, false); do_eval := valid; end; { function do_eval } procedure factoral(num : str; var result : str); var result_n, num_n : number; begin { procedure negate } zero(result_n); add_ni(result_n, 1, result_n); if not todec(num, in_rad, num_n) then begin result := ''; valid := false; end else begin while numcmp(num_n, zero_n) <> 0 do begin mul(result_n, num_n, result_n); add_ni(num_n, -1, num_n); end; toother(result_n, in_rad, result, false); end; end; { procedure negate } procedure negate(num : str; var result : str); begin { procedure negate } if num[1] = '-' then result := copy(num, 2, length(num) - 1) else result := '-' + num; end; { procedure negate } begin { function eval_post } valid := true; num_stack := nil; while get_token(expr, token) and valid do if is_num(token) then push(num_stack, token) else if (token = '!') then begin factoral(pop(num_stack), result); push(num_stack, result); end else if (token = '~') then begin negate(pop(num_stack), result); push(num_stack, result); end else if do_eval(pop(num_stack), pop(num_stack), token, result) then push(num_stack, result) else valid := false; if valid and empty(num_stack) then begin writeln(' - too many operator(s).'); valid := false; end else if valid then valid := todec(pop(num_stack), in_rad, val); if not empty(num_stack) then begin writeln('Unbalanced expression '); writeln(' - missing operator(s).'); valid := false; end; eval_post := valid; end; { function eval_post }