Source code: pscalc.pal

From PROSE Programming Language - Wiki
Revision as of 21:43, 29 December 2010 by Cambridge (Talk | contribs)

(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to: navigation, search
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Simple arbitrary-precision calculator
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
._init
attr/load	P0, [psString], P1, [psIndex]

%
% 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	[debug],    &[.func_debug]
func/def	[is_debug], &[.func_is_debug],	P1
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/scan	P1, P2, [+]
reg/jmpneq	&[.add], P1, NULL
reg/scan	P1, P2, [-]
reg/jmpneq	&[.sub], P1, NULL
reg/scan	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/scan	P1, P2, [~]
reg/jmpneq	&[.div], P1, NULL
local/jmp	&[.display]

.div_slash
reg/scan	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, [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/load	A, (P0)
op/decr
error/jmp	&[.no_strip], ![.prose.error.sys.OutOfRange]
reg/load	P2, (P0, A)
op/shr		P2, P2, #24
reg/jmpneq	&[.no_strip], P2, #10
reg/save	P0, (A)
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/index	P1, P1, [psIndex]

% Split into two operands
reg/copy	P2, P0
func/bcall	P3, [rsplit], P2, 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/index	P1, P1, [psIndex]
reg/load	A, (P0)
op/incr		P1

% Set-up new string of the correct size
op/sub		P4, A, P1
reg/copy	P3, []
reg/save	P3, (P4)

% Copy 2nd portion 32 bits at a time
reg/load	P4, #0

.rs_loop
reg/cmp		P1, A
reg/jmpneq	&[.rs_end], SCMP, #2

reg/load	P2, (P0, P1)
reg/save	P3, (P2, P4)

% Move on 4 bytes and loop again
op/add		P1, P1, #4
op/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