Source code: pscalc.pal
From PROSE Programming Language - Wiki
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Simple arbitrary-precision calculator
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
._init
attr/load P0, [psString], P1, [psInteger], P2, [psBoolean]
%
% Function definitions
%
func/def [main], &[.main]
func/def [title], &[.func_title]
func/def [getcmd], &[.func_getcmd], P0
func/def [display], &[.func_display], NULL, P0, [s]
func/def [add], &[.func_op], P0, P0, [s], P1, [i]
func/def [sub], &[.func_op], P0, P0, [s], P1, [i]
func/def [mult], &[.func_op], P0, P0, [s], P1, [i]
func/def [div], &[.func_op], P0, P0, [s], P1, [i]
func/def [settype], &[.func_settype], NULL, P0, [type]
func/def [rsplit], &[.func_rsplit], P0, P0, [s], P1, [i]
func/def [toggle_debug], &[.func_debug]
func/def [is_debug], &[.func_is_debug], P2
local/rtn
%
% Mapping of code labels to commands
%
~cmdlist
EQUP { &[.quit] }; EQUS { [] }
EQUP { &[.quit] }; EQUS { [quit] }
EQUP { &[.int] }; EQUS { [int] }
EQUP { &[.flt] }; EQUS { [flt] }
EQUP { &[.rat] }; EQUS { [rat] }
EQUP { &[.help] }; EQUS { [help] }
EQUP { &[.debug] }; EQUS { [debug] }
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% main()
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
.main
func/call NULL, [title]
var/global NULL, [psIndex], [debug], #0
var/global NULL, [psString], [numtype], [psInteger]
.loop
%
% Fetch command from stdin
%
func/call P0, [getcmd]
%
% Test for one of the known commands
%
reg/load P1, ( &[~cmdlist] )
.cmdloop
reg/load P2, (P1)
reg/jmpeq &[.cmdloop_end], P2, NULL
reg/load P3, (P1)
reg/jmpneq &[.cmdloop], P0, P3
reg/clr P1
local/jmp P2
.cmdloop_end
%
% Process a mathematical command
%
reg/clr P1
reg/copy P2, P0
reg/xscan P1, P2, [+]
reg/jmpneq &[.add], P1, NULL
reg/xscan P1, P2, [-]
reg/jmpneq &[.sub], P1, NULL
reg/xscan P1, P2, [*]
reg/jmpneq &[.mult], P1, NULL
%
% The divide symbol can be / unless in psRational mode
%
var/addr P15, [numtype]
attr/copy P14, P15, [psString]
reg/cmp P14, [psRational]
reg/clr P14
reg/jmpneq &[.div_slash], SCMP, #1
reg/xscan P1, P2, [~]
reg/jmpneq &[.div], P1, NULL
local/jmp &[.display]
.div_slash
reg/xscan P1, P2, [/]
reg/jmpneq &[.div], P1, NULL
%
% Display anything else verbatim to stdout
%
.display
reg/clr P2
func/call NULL, [display], P0
local/jmp &[.loop]
.int
% Set number type to integer
reg/clr P0
func/call NULL, [settype], [psInteger]
local/jmp &[.loop]
.flt
% Set number type to floating-point
reg/clr P0
func/call NULL, [settype], [psFloat]
local/jmp &[.loop]
.rat
% Set number type to rational
reg/clr P0
func/call NULL, [settype], [psRational]
local/jmp &[.loop]
.quit
% Exit program
reg/clr P0
func/rtn
.debug
% Toggle debug mode ON or OFF
reg/clr P0
func/call NULL, [toggle_debug]
var/addr P0, [debug]
attr/index P0, P0, [psIndex]
reg/jmpeq &[.debug_level_0], P0, #0
debug/level #90
local/jmp &[.loop]
.debug_level_0
debug/level #0
local/jmp &[.loop]
.add
% Add two operands and display result
func/bcall P3, [add], P0, P1
reg/move P0, P3
local/jmp &[.display]
.sub
% Subtract two operands and display result
func/bcall P3, [sub], P0, P1
reg/move P0, P3
local/jmp &[.display]
.mult
% Multiply two operands and display result
func/bcall P3, [mult], P0, P1
reg/move P0, P3
local/jmp &[.display]
.div
% Divide two operands and display result
func/bcall P3, [div], P0, P1
reg/move P0, P3
local/jmp &[.display]
.help
% Display help message
reg/clr P0
attr/mod ![.prose.sys.io], [psStreamError], [
M+N adds two numbers M and N and displays the result
M*N multiplies two numbers M and N and displays the result
M-N subtracts two numbers M and N and displays the result
M/N divides two numbers M and N and displays the result
M~N divides two numbers M and N and displays the result
(when the number type is rational)
int set number type to integer
flt set number type to floating-point
rat set number type to rational
help displays this help page
debug toggles debug mode ON and OFF
quit exits this program
]
local/jmp &[.loop]
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% title()
%
% Display title of program to stderr
%
% Arguments:
% None
%
% Returns:
% None
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
.func_title
attr/mod ![.prose.sys.io], [psStreamError], [
pscalc: a simple arbitrary-precision calculator
Type 'help' for a list of commands or 'quit' to exit
]
func/rtn
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% getcmd()
%
% Gets next command from stdin (stripping newline character)
%
% Arguments:
% None
%
% Returns:
% String, or empty string if input is exhausted
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
.func_getcmd
reg/load P15, ![.prose.sys.io]
% Display command prompt to stderr
attr/mod P15, [psStreamError], [> ]
% Collect input
attr/copy P0, P15, [psStreamIn]
reg/jmpeq &[.getcmd_null], P0, NULL
% Strip trailing newline character
reg/xload P1, (P0)
op/decr P1
error/jmp &[.no_strip], ![.prose.error.sys.OutOfRange]
reg/load P2, (P0, P1)
op/shr P2, P2, #24
reg/jmpneq &[.no_strip], P2, #10
reg/save P0, (P1)
func/rtn P0
.no_strip
error/clr
func/rtn P0
.getcmd_null
func/rtn []
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% display()
%
% Displays string to stdout (appending a newline character)
%
% Arguments:
% s = string to display
%
% Returns:
% None
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
.func_display
var/addr P0, [s]
attr/copy P0, P0, [psString]
reg/copy P0, P0, [\n]
attr/mod ![.prose.sys.io], [psStreamOut], P0
func/rtn
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% add(), sub(), mult(), div()
%
% Perform maths operation on two operands
%
% Arguments:
% s = string in form M+N
% i = index position of + symbol
%
% Returns:
% Result (as a string)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
.func_op
var/addr P0, [s], P1, [i]
% Extra debug output if debug mode is ON
func/bcall P10, [is_debug]
reg/jmpneq &[.add_ops], P10, [1]
obj/dump PCTX, P0, P1
.add_ops
% Read variable values
attr/copy P0, P0, [psString]
attr/xcopy P1, P1, [psInteger]
attr/def PUSH, [psInteger], P1
% Split into two operands
reg/copy P2, P0
func/bcall P3, [rsplit], P2, P1
stack/pull P1
reg/save P0, (P1)
reg/clr P10
reg/copy P1, P3
reg/clr P3
% Operands are in P0 and P1
% Get number type and perform add operation
var/addr P4, [numtype]
attr/copy P4, P4, [psString]
error/jmp &[.bad_number1], ![.prose.error.sys.BadNumber]
var/local P0, P4, [m], P0
error/jmp
error/jmp &[.bad_number2], ![.prose.error.sys.BadNumber]
var/local P1, P4, [n], P1
% Get name of function, this determines the action we perform
attr/copy P2, PCTX, [pn]
reg/cmp P2, [add], P2, [sub], P2, [mult], P2, [div]
reg/clr P2
reg/jmpeq &[.do_div], SFLG, #1
reg/jmpeq &[.do_mult], SFLG, #2
reg/jmpeq &[.do_sub], SFLG, #4
.do_add
opo/add P0, P0, P1
local/jmp &[.do_return]
.do_sub
opo/sub P0, P0, P1
local/jmp &[.do_return]
.do_mult
opo/mult P0, P0, P1
local/jmp &[.do_return]
.do_div
opo/div P0, P0, P1
% Return result
.do_return
attr/xcopy P0, P0, P4
reg/clr P4
func/rtn P0
.bad_number1
reg/load P15, #1
local/jmp &[.bad_number]
.bad_number2
reg/load P15, #2
.bad_number
reg/clr P0, P1
reg/copy P0, [Bad number for selected number type ],
[(operand ], P15, [ is not a ], P4, [)]
error/now ![.prose.error.sys.BadNumber], P0
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% settype()
%
% Sets global number type
%
% Arguments:
% type = name of attribute type to set: psInteger, psFloat or psRational
%
% Returns:
% None
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
.func_settype
var/addr P0, [type]
attr/copy P0, P0, [psString]
reg/copy P2, P0
var/addr P1, [numtype]
attr/mod P1, [psString], P0
reg/copy P2, [Number type: ], P2, [\n]
attr/mod ![.prose.sys.io], [psStreamError], P2
func/rtn
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% rsplit()
%
% Splits a string at a given index position returning the portion to the
% right of the split
%
% Arguments:
% s = string to split
% i = index position of split
%
% Returns:
% String
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
.func_rsplit
var/addr P0, [s], P1, [i]
attr/copy P0, P0, [psString]
attr/xcopy P1, P1, [psInteger]
reg/xload P5, (P0)
op/incr P1
% Set-up new string of the correct size
attr/def P4, [psInteger], #0
opx/sub P4, P5, P1
reg/copy P3, []
reg/save P3, (P4)
% Copy 2nd portion 32 bits at a time
attr/def P4, [psInteger], #0
.rs_loop
reg/cmp P1, P5
reg/jmpneq &[.rs_end], SCMP, #2
reg/load P2, (P0, P1)
reg/save P3, (P2, P4)
% Move on 4 bytes and loop again
opx/add P1, P1, #4
opx/add P4, P4, #4
local/jmp &[.rs_loop]
.rs_end
reg/clr P0
func/rtn P3
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% debug()
%
% Toggle debug mode ON or OFF
%
% Arguments:
% None
%
% Returns:
% None
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
.func_debug
var/addr P0, [debug]
attr/index A, P0, [psIndex]
opa/xor #1
attr/mod P0, [psIndex], A
reg/jmpeq &[.debug_on], A, #1
.debug_off
reg/load P0, [OFF]
local/jmp &[.debug_status]
.debug_on
reg/load P0, [ON]
.debug_status
% Report debug status to stderr
reg/copy P0, [Debug mode ], P0, [\n]
attr/mod ![.prose.sys.io], [psStreamError], P0
func/rtn
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% is_debug()
%
% Tests to see if debug mode is ON or OFF
%
% Arguments:
% None
%
% Returns:
% #0 if debug mode if OFF, #1 if it is ON
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
.func_is_debug
var/addr P0, [debug]
attr/index A, P0, [psIndex]
func/rtn A
