#! /usr/pkg/bin/gforth-fast \ rpn-n0.cgi - RPN Model n0 calculator CGI script \ Copyright 2013 David Meyer +JMJ \ Copying and distribution of this file, with or without \ modification, are permitted in any medium without royalty \ provided the copyright notice and this notice are preserved. \ This file is offered as-is, without any warranty. \ Global variables ... variable register-x variable register-y variable register-z variable register-t variable register-s variable mode \ 0: ENTER mode; next number will replace X \ 1: Op mode; next number will push X \ 2: Input mode; inputing number variable error variable query-adr variable query-len variable button-adr variable button-len \ Level 3 ... : push-stack ( -- ) register-z @ register-t ! register-y @ register-z ! register-x @ register-y ! ; : rot4 ( a b c d -- d a b c ) swap >r rot rot r> ; : trunc-fld-key ( c-field ufield ukey -- c-value uvalue ) dup >r - swap r> chars + swap ; : value-str-chars ( addr u1 -- u2 ) over swap [char] & scan drop swap - ; \ Level 2 ... : init-state ( -- ) 0 register-x ! 0 register-y ! 0 register-z ! 0 register-t ! 0 register-s ! 0 mode ! 0 button-len ! ; : nprint ( n -- ) s>d swap over dabs <<# #s rot sign #> type #>> ; : parse-num-fld { c-key ulen a-reg -- } query-adr @ query-len @ c-key ulen search if ulen trunc-fld-key over swap value-str-chars s>number? if d>s a-reg ! else 2drop 0 a-reg ! then else 0 a-reg ! then ; : parse-str-fld { c-key ulen a-value a-vlen -- } query-adr @ query-len @ c-key ulen search if ulen trunc-fld-key over swap value-str-chars a-vlen ! a-value ! else 2drop 0 a-vlen ! then ; : pressed-asterisk ( -- ) register-y @ register-x @ * register-x ! register-z @ register-y ! register-t @ register-z ! 1 mode ! ; : pressed-clr ( -- ) 0 register-x ! 0 register-y ! 0 register-z ! 0 register-t ! 0 register-s ! 0 mode ! ; : pressed-clx ( -- ) \ Or should this act like pop/drop? 0 register-x ! 0 mode ! ; : pressed-enter ( -- ) push-stack 0 mode ! ; : pressed-minus ( -- ) register-y @ register-x @ - register-x ! register-z @ register-y ! register-t @ register-z ! 1 mode ! ; : pressed-mod ( -- ) register-x @ 0= if true error ! 0 mode ! else register-y @ register-x @ mod register-x ! register-z @ register-y ! register-t @ register-z ! 1 mode ! then ; : pressed-neg ( -- ) register-x @ -1 * register-x ! 1 mode ! ; : pressed-num ( u -- ) mode @ case 0 of 2 mode ! endof 1 of push-stack 2 mode ! endof 2 of register-x @ 10 * + endof endcase register-x ! ; : pressed-plus ( -- ) register-y @ register-x @ + register-x ! register-z @ register-y ! register-t @ register-z ! 1 mode ! ; : pressed-rcl ( -- ) push-stack register-s @ register-x ! 1 mode ! ; : pressed-rld ( -- ) register-x @ register-y @ register-x ! register-z @ register-y ! register-t @ register-z ! register-t ! 1 mode ! ; : pressed-slash ( -- ) register-x @ 0= if true error ! 0 mode ! else register-y @ register-x @ / register-x ! register-z @ register-y ! register-t @ register-z ! 1 mode ! then ; : pressed-sto ( -- ) register-x @ register-s ! 1 mode ! ; : pressed-swp ( -- ) register-x @ register-y @ register-x ! register-y ! 1 mode ! ; \ Level 1 ... : calculate ( -- ) button-len @ 0<> if true case button-adr @ button-len @ s" ENTER" str= of pressed-enter endof button-adr @ button-len @ s" mod" str= of pressed-mod endof button-adr @ button-len @ s" clx" str= of pressed-clx endof button-adr @ button-len @ s" clr" str= of pressed-clr endof button-adr @ button-len @ s" swp" str= of pressed-swp endof button-adr @ button-len @ s" %2F" str= of pressed-slash endof button-adr @ button-len @ s" rld" str= of pressed-rld endof button-adr @ button-len @ s" *" str= of pressed-asterisk endof button-adr @ button-len @ s" sto" str= of pressed-sto endof button-adr @ button-len @ s" -" str= of pressed-minus endof button-adr @ button-len @ s" rcl" str= of pressed-rcl endof button-adr @ button-len @ s" neg" str= of pressed-neg endof button-adr @ button-len @ s" %2B" str= of pressed-plus endof button-adr @ button-len @ s>unumber? rot rot d>s >r of r> pressed-num endof endcase then ; : parse-query ( -- ) s" QUERY_STRING" getenv dup 0= if init-state else query-len ! query-adr ! s" s=" register-s parse-num-fld s" t=" register-t parse-num-fld s" z=" register-z parse-num-fld s" y=" register-y parse-num-fld s" x=" register-x parse-num-fld s" mode=" mode parse-num-fld s" button=" button-adr button-len parse-str-fld then ; : print-page ( -- ) ." Content-Type: text/html" cr cr .\" " ." RPN Calculator Model n0" .\" " .\" " .\"

RPN Calculator Model n0

" else .\" disp\">" then register-x @ nprint .\"
" .\" " .\" " .\" " .\" " .\" " .\" " .\" " .\" " .\" " .\" " .\" " .\" " .\" " .\" " .\" " .\" " .\" " .\" " .\" " .\" " .\" " .\"
" .\"
" .\" S
" .\" T
" .\" Z
" .\" Y
" .\" X
RPN CALCULATOR n0
" .\"
" ."

Instructions

" .\"

Enter numbers separated by " ." ENTER key, then press operation key to display the result " ." (= key is not needed). Numbers are stored in a " ." LIFO stack (registers X, Y, Z, T). Display shows the last " ." number (input or result) on the stack (register X). " ." Register S is for storing constants.

" .\"

Stack effects: " ." (x, y, z, t, s, are current register values.)

" .\" " .\" " .\" " .\" " .\" " .\" " .\" " .\" " .\" " .\" " .\"
op
()
z → T
y → Z
x → Y,X		t → T,Z
z → Y
y op x → X		-x → Xx → Sz → T
y → Z
x → Y
s → X
" .\" " .\" " .\" " .\" " .\" " .\" " .\" " .\"
x → T
t → Z
z → Y
y → X		x → Y
y → X		0 → X0 → X,Y,Z,T,S
" .\"

Precision and Fractional Arithmetic: " ." n0 processes all numbers as single-precision signed integers with a " ." range of -2,147,483,648 to 2,147,483,647. " ." It is possible to perform calculations with fractional " ." numbers by using the technique of " ." fixed-point arithmetic: The user multiplies input " ." operands and mentally divides results by appropriate powers of 10 to " ." obtain the required precision.

" .\"

Program source.

" ."

Model n0 is the first of a series of online " ." calculators inspired by the Hewlett-Packard " ." line of slide rule pocket calculators " ." produced in the 1970s (n0 was designed " ." with refrence to the " .\" HP-35 " ." in particular) and the " .\" " ." Forth programming language invented by " .\" " ." Chuck Moore in 1968.

" ."

RPN Calculator Model n0 is powered by " .\" Gforth " s" gforth" environment? if type space then ." on the MetaArray host at " .\" SDF.

" .\"

+JMJ

" ; \ Level 0: Main driver ... false error ! parse-query calculate print-page bye \ Emacs metadata ... \ Local variables: \ mode: forth \ End: \ +JMJ