Free42 extended "SHOW" fun Message #1 Posted by Glen Sanft on 24 Feb 2011, 12:27 a.m.
I recently picked up a copy of Free42 and it made me dig out the real thing to play with again. I'd forgotten many of the joys of using it, as well as the painful aspects, but they're all fresh in my mind again now. :)
At any rate, this program evolved over time, as they all do, and I guess it might be useful in some way to some of you, so I offer it for your consideration.
There might be enough comments within the listing. If not, ask.
I normally wouldn't use "@" for comments, but I seem to recall that was the convention for this sort of stuff.
Also, I don't presently have access to a web server to put a 39KB zip file on, so cannot include the .raw file and several formatted versions of the text listing. Sorry. I'll see what I can do if there's any interest.
Here it is:
00 { 388Byte (Free42) Prgm } @@ pretty much pointless on native hardware @@
01>LBL "FWIW" @"For What It's Worth"; "show" all digits of stack X value
02 GTO 01
03>LBL 00 @two options placed early for ease of manipulation:
04 3 @< maximum quantity of digits preradix / min. "E" multiplier
05 STO ".M." @@ "1" = "SCI"; "3" = "ENG"; but others seem to work as well...
06 3 @< digits "grouping" size postradix; practical range begins
07 STO ".G." @@ at "3" and ends at "24" (see declaration of ".J." below)
08 RTN
09>LBL 01
10 REAL? @we'll be using "LOG" which won't work well otherwise
11 GTO 02
12 GTO 11 @so abort; it's "otherwise"
13>LBL 02
14 X=0? @if nothing's in the register this whole thing's (even more?)
15 GTO 11 @@ pointless, so just skip to the end
16 STO ".X." @place copies of the stack aside for later restoration:
17 Rv @ @ excepting the ALPHA register, this program leaves the
18 STO ".Y." @ @ machine completely in it's same prior state when done
19 Rv @ @ unless named variables herein had preexisted (see list
20 STO ".Z." @ @ of "CLV"s at the end); no user flags or REGs get molested
21 Rv
22 STO ".T."
23 LASTX
24 STO ".L."
25 CLA
26 XEQ 00
27 STO ".I."
28 24 @< this variable is only necessary in Free42bin, where a
29 STO ".J." @@ smaller value would really be more appropriate anyway since
30 RCL ".X." @@ "noise" starts earlier, and keeps rising like so much radon
31 SIGN @@ from the cellar in that version
32 STO ".S." @< keep track of the sign for display purposes
33 LASTX
34 ABS @LOG likes positive values for "real" results
35 ENTER
36 LOG @this section would be as easy to step through and watch as
37 ENTER @to read a description of it; at least easier than writing it...
38 X>=0?
39 GTO 03
40 FP
41 X=0?
42 GTO 03
43 Rv
44 IP
45 1
46 
47 ENTER
48>LBL 03
49 Rv
50 IP
51 STO ".E."
52 RCL ".M."
53 MOD
54 STO ".E."
55 Rv
56 RCL ".E."
57 10^X
58 X=0? @< depending on ".M." (if >1) plus proximity to limits of
59 GTO 09 @@ "E" values (where things can get "dicey" anyway for this in
60 ÷ @@ Free42bin), trouble can ensue here; this allows restoration
61 RCL× ".S." @@ of state in that unfortunate event, accompanied by a cryptic
62 AIP @@ statement at (failed) program exit (see below)
63 RCL× ".S."
64 FS? 28 @here we follow current radix display convention
65 "."
66 FC? 28
67 ","
68 FP
69>LBL 04 @start appending postradix digits
70 10
71 ×
72 AIP
73 FP
74 DSE ".J." @< in Free42dec this isn't even necessary but in *bin it is;
75 X=0? @< *dec's digits run out and break loop all on their own
76 GTO 07
77 DSE ".I." @restart ingroup loop or add (linefeed/)separator to ALPHA
78 GTO 04
79 RCL ".G."
80 STO ".I." @reuse variable here to count back "groupsize" digits from
81 Rv @@ end of first ALPHA linewidth, to ensure entire
82 ALENG @@ un"wrapbroke" groupings
83 22
84 X<=Y?
85 GTO 06
86 1
87 
88>LBL 05 @add a linefeed within any appropriate group separator
89 X=Y?
90 "\LF"
91 DSE ST X
92 DSE ".I."
93 GTO 05
94 RCL ".G."
95 STO ".I." @rereset counter for adding another "group" of digits to ALPHA
96 Rv
97>LBL 06
98 " " @at least this'll happen whenever we get into this loop
99 RCL ST Z
100 GTO 04 @back for (possibly) more digits above...
101>LBL 07 @no more digits to add at this point
102 ALENG
103 22
104 X<=Y? @add a linefeed if needed to prevent exponent component from
105 GTO 08 @@ getting "wrapbroke"
106 10 @@ as a result of "rudimentaryness" it'll always appear on the
107 POSA @@ second line of the display, even with a very short mantissa
108 X<0?
109 "\LF"
110>LBL 08 @and here it comes...
111 " E" @this is the "exponent" (little big) "E"
112 RCL ".E."
113 AIP
114 GTO 10
115>LBL 09 @this is the cryptic "we'd 'divode' by zero" message, if needed,
116 "Went out of" @ it can (probably?) be avoided by using a "1" for ".M."
117 " range! :("
118>LBL 10
119 AVIEW @show result
120 CLA @wipe the slate
121 RCL ".L." @restore all programchanged state
122 STO ST L
123 RCL ".T."
124 RCL ".Z."
125 RCL ".Y."
126 RCL ".X."
127 CLV ".M." @the unsorted list of variables created(?)/destroyed ensues
128 CLV ".G."
129 CLV ".I."
130 CLV ".J."
131 CLV ".S."
132 CLV ".E."
133 CLV ".L."
134 CLV ".T."
135 CLV ".Z."
136 CLV ".Y."
137 CLV ".X."
138>LBL 11
139 END
@I believe I've culled all code which would never get called...
@ © GMS 21 Feb 2011, for what it's worth :)
EDIT: Here's the FWIW.raw file uuencoded (base64):
beginbase64 644 FWIW.raw
wAD1AEZXSVeyAAETAPSBLk0uEwD0gS5HLoUComWzALwAA2e8APSBLlgudfSB
LlkudfSBLloudfSBLlQudvSBLkwuh+AAAPSBLkkuEhQA9IEuSi70kS5YLnr0
gS5TLnZhg1aDol+0AGlntAB1aBEAQYMEdWj0gS5FLvSRLk0uS/SDLkUudfSR
LkUuV2e6AEP0lC5TLqYx9JQuUy6sHPJ/Lq0c8n8saQUREABCpjFp9JcuSi5n
uAD0ly5JLrUA9JEuRy70gS5JLnWmQRISAEa3ABEAQQZ48n8Kl3P0ly5JLrYA
9JEuRy70gS5JLnUH8n8gkHG1AAimQRISAEa5ABEQAKZcZvJ/CgnzfyAY9JEu
RS6mMbsACvtXZW50IG91dCBvZvx/IHJhbmdlISAgOigLfof0kS5MLpF09JEu
VC70kS5aLvSRLlku9JEuWC70sC5NLvSwLkcu9LAuSS70sC5KLvSwLlMu9LAu
RS70sC5MLvSwLlQu9LAuWi70sC5ZLvSwLlguDMAADQ==
====
Edited: 24 Feb 2011, 12:46 a.m.
