1#!/bin/sed -nf
2#  dc.sed - an arbitrary precision RPN calculator
3#  Created by Greg Ubben <gsu@romulus.ncsc.mil> early 1995, late 1996
4#
5#  Dedicated to MAC's memory of the IBM 1620 ("CADET") computer.
6#  @(#)GSU dc.sed 1.1 06-Mar-1999 [non-explanatory]
7#
8#  Examples:
9#	sqrt(2) to 10 digits:	echo "10k 2vp" | dc.sed
10#	20 factorial:		echo "[d1-d1<!*]s! 20l!xp" | dc.sed
11#	sin(ln(7)):		echo "s(l(7))" | bc -c /usr/lib/lib.b | dc.sed
12#	hex to base 60:		echo "60o16i 6B407.CAFE p" | dc.sed
13#	tests most of dc.sed:	echo 16oAk2vp | dc.sed
14#
15#  To debug or analyze, give the dc Y command as input or add it to
16#  embedded dc routines, or add the sed p command to the beginning of
17#  the main loop or at various points in the low-level sed routines.
18#  If you need to allow [|~] characters in the input, filter this
19#  script through "tr '|~' '\36\37'" first (or use dc.pl).
20#
21#  Not implemented:	! \
22#  But implemented:	K Y t # !< !> != fractional-bases
23#  SunOS limits:	199/199 commands (though could pack in 10-20 more)
24#  Limitations:		scale <= 999; |obase| >= 1; input digits in [0..F]
25#  Completed:		1am Feb 4, 1997
26
27s/^/|P|K0|I10|O10|?~/
28
29: next
30s/|?./|?/
31s/|?#[	 -}]*/|?/
32/|?!*[lLsS;:<>=]\{0,1\}$/N
33/|?!*[-+*/%^<>=]/b binop
34/^|.*|?[dpPfQXZvxkiosStT;:]/b binop
35/|?[_0-9A-F.]/b number
36/|?\[/b string
37/|?l/b load
38/|?L/b Load
39/|?[sS]/b save
40/|?c/ s/[^|]*//
41/|?d/ s/[^~]*~/&&/
42/|?f/ s//&[pSbz0<aLb]dSaxsaLa/
43/|?x/ s/\([^~]*~\)\(.*|?x\)~*/\2\1/
44/|?[KIO]/ s/.*|\([KIO]\)\([^|]*\).*|?\1/\2~&/
45/|?T/ s/\.*0*~/~/
46#  a slow, non-stackable array implementation in dc, just for completeness
47#  A fast, stackable, associative array implementation could be done in sed
48#  (format: {key}value{key}value...), but would be longer, like load & save.
49/|?;/ s/|?;\([^{}]\)/|?~[s}s{L{s}q]S}[S}l\1L}1-d0>}s\1L\1l{xS\1]dS{xL}/
50/|?:/ s/|?:\([^{}]\)/|?~[s}L{s}L{s}L}s\1q]S}S}S{[L}1-d0>}S}l\1s\1L\1l{xS\1]dS{x/
51/|?[ ~	cdfxKIOT]/b next
52/|?\n/b next
53/|?[pP]/b print
54/|?k/ s/^\([0-9]\{1,3\}\)\([.~].*|K\)[^|]*/\2\1/
55/|?i/ s/^\(-\{0,1\}[0-9]*\.\{0,1\}[0-9]\{1,\}\)\(~.*|I\)[^|]*/\2\1/
56/|?o/ s/^\(-\{0,1\}[1-9][0-9]*\.\{0,1\}[0-9]*\)\(~.*|O\)[^|]*/\2\1/
57/|?[kio]/b pop
58/|?t/b trunc
59/|??/b input
60/|?Q/b break
61/|?q/b quit
62h
63/|?[XZz]/b count
64/|?v/b sqrt
65s/.*|?\([^Y]\).*/\1 is unimplemented/
66s/\n/\\n/g
67l
68g
69b next
70
71: print
72/^-\{0,1\}[0-9]*\.\{0,1\}[0-9]\{1,\}~.*|?p/!b Print
73/|O10|/b Print
74
75#  Print a number in a non-decimal output base.  Uses registers a,b,c,d.
76#  Handles fractional output bases (O<-1 or O>=1), unlike other dc's.
77#  Converts the fraction correctly on negative output bases, unlike
78#  UNIX dc.  Also scales the fraction more accurately than UNIX dc.
79#
80s,|?p,&KSa0kd[[-]Psa0la-]Sad0>a[0P]sad0=a[A*2+]saOtd0>a1-ZSd[[[[ ]P]sclb1\
81!=cSbLdlbtZ[[[-]P0lb-sb]sclb0>c1+]sclb0!<c[0P1+dld>c]scdld>cscSdLbP]q]Sb\
82[t[1P1-d0<c]scd0<c]ScO_1>bO1!<cO[16]<bOX0<b[[q]sc[dSbdA>c[A]sbdA=c[B]sbd\
83B=c[C]sbdC=c[D]sbdD=c[E]sbdE=c[F]sb]xscLbP]~Sd[dtdZOZ+k1O/Tdsb[.5]*[.1]O\
84X^*dZkdXK-1+ktsc0kdSb-[Lbdlb*lc+tdSbO*-lb0!=aldx]dsaxLbsb]sad1!>a[[.]POX\
85+sb1[SbO*dtdldx-LbO*dZlb!<a]dsax]sadXd0<asbsasaLasbLbscLcsdLdsdLdLak[]pP,
86b next
87
88: Print
89/|?p/s/[^~]*/&\
90~&/
91s/\(.*|P\)\([^|]*\)/\
92\2\1/
93s/\([^~]*\)\n\([^~]*\)\(.*|P\)/\1\3\2/
94h
95s/~.*//
96/./{ s/.//; p; }
97#  Just s/.//p would work if we knew we were running under the -n option.
98#  Using l vs p would kind of do \ continuations, but would break strings.
99g
100
101: pop
102s/[^~]*~//
103b next
104
105: load
106s/\(.*|?.\)\(.\)/\20~\1/
107s/^\(.\)0\(.*|r\1\([^~|]*\)~\)/\1\3\2/
108s/.//
109b next
110
111: Load
112s/\(.*|?.\)\(.\)/\2\1/
113s/^\(.\)\(.*|r\1\)\([^~|]*~\)/|\3\2/
114/^|/!i\
115register empty
116s/.//
117b next
118
119: save
120s/\(.*|?.\)\(.\)/\2\1/
121/^\(.\).*|r\1/ !s/\(.\).*|/&r\1|/
122/|?S/ s/\(.\).*|r\1/&~/
123s/\(.\)\([^~]*~\)\(.*|r\1\)[^~|]*~\{0,1\}/\3\2/
124b next
125
126: quit
127t quit
128s/|?[^~]*~[^~]*~/|?q/
129t next
130#  Really should be using the -n option to avoid printing a final newline.
131s/.*|P\([^|]*\).*/\1/
132q
133
134: break
135s/[0-9]*/&;987654321009;/
136: break1
137s/^\([^;]*\)\([1-9]\)\(0*\)\([^1]*\2\(.\)[^;]*\3\(9*\).*|?.\)[^~]*~/\1\5\6\4/
138t break1
139b pop
140
141: input
142N
143s/|??\(.*\)\(\n.*\)/|?\2~\1/
144b next
145
146: count
147/|?Z/ s/~.*//
148/^-\{0,1\}[0-9]*\.\{0,1\}[0-9]\{1,\}$/ s/[-.0]*\([^.]*\)\.*/\1/
149/|?X/ s/-*[0-9A-F]*\.*\([0-9A-F]*\).*/\1/
150s/|.*//
151/~/ s/[^~]//g
152
153s/./a/g
154: count1
155	s/a\{10\}/b/g
156	s/b*a*/&a9876543210;/
157	s/a.\{9\}\(.\).*;/\1/
158	y/b/a/
159/a/b count1
160G
161/|?z/ s/\n/&~/
162s/\n[^~]*//
163b next
164
165: trunc
166#  for efficiency, doesn't pad with 0s, so 10k 2 5/ returns just .40
167#  The X* here and in a couple other places works around a SunOS 4.x sed bug.
168s/\([^.~]*\.*\)\(.*|K\([^|]*\)\)/\3;9876543210009909:\1,\2/
169: trunc1
170	s/^\([^;]*\)\([1-9]\)\(0*\)\([^1]*\2\(.\)[^:]*X*\3\(9*\)[^,]*\),\([0-9]\)/\1\5\6\4\7,/
171t trunc1
172s/[^:]*:\([^,]*\)[^~]*/\1/
173b normal
174
175: number
176s/\(.*|?\)\(_\{0,1\}[0-9A-F]*\.\{0,1\}[0-9A-F]*\)/\2~\1~/
177s/^_/-/
178/^[^A-F~]*~.*|I10|/b normal
179/^[-0.]*~/b normal
180s:\([^.~]*\)\.*\([^~]*\):[Ilb^lbk/,\1\2~0A1B2C3D4E5F1=11223344556677889900;.\2:
181: digit
182    s/^\([^,]*\),\(-*\)\([0-F]\)\([^;]*\(.\)\3[^1;]*\(1*\)\)/I*+\1\2\6\5~,\2\4/
183t digit
184s:...\([^/]*.\)\([^,]*\)[^.]*\(.*|?.\):\2\3KSb[99]k\1]SaSaXSbLalb0<aLakLbktLbk:
185b next
186
187: string
188/|?[^]]*$/N
189s/\(|?[^]]*\)\[\([^]]*\)]/\1|{\2|}/
190/|?\[/b string
191s/\(.*|?\)|{\(.*\)|}/\2~\1[/
192s/|{/[/g
193s/|}/]/g
194b next
195
196: binop
197/^[^~|]*~[^|]/ !i\
198stack empty
199//!b next
200/^-\{0,1\}[0-9]*\.\{0,1\}[0-9]\{1,\}~/ !s/[^~]*\(.*|?!*[^!=<>]\)/0\1/
201/^[^~]*~-\{0,1\}[0-9]*\.\{0,1\}[0-9]\{1,\}~/ !s/~[^~]*\(.*|?!*[^!=<>]\)/~0\1/
202h
203/|?\*/b mul
204/|?\//b div
205/|?%/b rem
206/|?^/b exp
207
208/|?[+-]/ s/^\(-*\)\([^~]*~\)\(-*\)\([^~]*~\).*|?\(-\{0,1\}\).*/\2\4s\3o\1\3\5/
209s/\([^.~]*\)\([^~]*~[^.~]*\)\(.*\)/<\1,\2,\3|=-~.0,123456789<></
210/^<\([^,]*,[^~]*\)\.*0*~\1\.*0*~/ s/</=/
211: cmp1
212	s/^\(<[^,]*\)\([0-9]\),\([^,]*\)\([0-9]\),/\1,\2\3,\4/
213t cmp1
214/^<\([^~]*\)\([^~]\)[^~]*~\1\(.\).*|=.*\3.*\2/ s/</>/
215/|?/{
216	s/^\([<>]\)\(-[^~]*~-.*\1\)\(.\)/\3\2/
217	s/^\(.\)\(.*|?!*\)\1/\2!\1/
218	s/|?![^!]\(.\)/&l\1x/
219	s/[^~]*~[^~]*~\(.*|?\)!*.\(.*\)|=.*/\1\2/
220	b next
221}
222s/\(-*\)\1|=.*/;9876543210;9876543210/
223/o-/ s/;9876543210/;0123456789/
224s/^>\([^~]*~\)\([^~]*~\)s\(-*\)\(-*o\3\(-*\)\)/>\2\1s\5\4/
225
226s/,\([0-9]*\)\.*\([^,]*\),\([0-9]*\)\.*\([0-9]*\)/\1,\2\3.,\4;0/
227: right1
228	s/,\([0-9]\)\([^,]*\),;*\([0-9]\)\([0-9]*\);*0*/\1,\2\3,\4;0/
229t right1
230s/.\([^,]*\),~\(.*\);0~s\(-*\)o-*/\1~\30\2~/
231
232: addsub1
233	s/\(.\{0,1\}\)\(~[^,]*\)\([0-9]\)\(\.*\),\([^;]*\)\(;\([^;]*\(\3[^;]*\)\).*X*\1\(.*\)\)/\2,\4\5\9\8\7\6/
234	s/,\([^~]*~\).\{10\}\(.\)[^;]\{0,9\}\([^;]\{0,1\}\)[^;]*/,\2\1\3/
235#	  could be done in one s/// if we could have >9 back-refs...
236/^~.*~;/!b addsub1
237
238: endbin
239s/.\([^,]*\),\([0-9.]*\).*/\1\2/
240G
241s/\n[^~]*~[^~]*//
242
243: normal
244s/^\(-*\)0*\([0-9.]*[0-9]\)[^~]*/\1\2/
245s/^[^1-9~]*~/0~/
246b next
247
248: mul
249s/\(-*\)\([0-9]*\)\.*\([0-9]*\)~\(-*\)\([0-9]*\)\.*\([0-9]*\).*|K\([^|]*\).*/\1\4\2\5.!\3\6,|\2<\3~\5>\6:\7;9876543210009909/
250
251: mul1
252    s/![0-9]\([^<]*\)<\([0-9]\{0,1\}\)\([^>]*\)>\([0-9]\{0,1\}\)/0!\1\2<\3\4>/
253    /![0-9]/ s/\(:[^;]*\)\([1-9]\)\(0*\)\([^0]*\2\(.\).*X*\3\(9*\)\)/\1\5\6\4/
254/<~[^>]*>:0*;/!t mul1
255
256s/\(-*\)\1\([^>]*\).*/;\2^>:9876543210aaaaaaaaa/
257
258: mul2
259    s/\([0-9]~*\)^/^\1/
260    s/<\([0-9]*\)\(.*[~^]\)\([0-9]*\)>/\1<\2>\3/
261
262    : mul3
263	s/>\([0-9]\)\(.*\1.\{9\}\(a*\)\)/\1>\2;9\38\37\36\35\34\33\32\31\30/
264	s/\(;[^<]*\)\([0-9]\)<\([^;]*\).*\2[0-9]*\(.*\)/\4\1<\2\3/
265	s/a[0-9]/a/g
266	s/a\{10\}/b/g
267	s/b\{10\}/c/g
268    /|0*[1-9][^>]*>0*[1-9]/b mul3
269
270    s/;/a9876543210;/
271    s/a.\{9\}\(.\)[^;]*\([^,]*\)[0-9]\([.!]*\),/\2,\1\3/
272    y/cb/ba/
273/|<^/!b mul2
274b endbin
275
276: div
277#  CDDET
278/^[-.0]*[1-9]/ !i\
279divide by 0
280//!b pop
281s/\(-*\)\([0-9]*\)\.*\([^~]*~-*\)\([0-9]*\)\.*\([^~]*\)/\2.\3\1;0\4.\5;0/
282: div1
283	s/^\.0\([^.]*\)\.;*\([0-9]\)\([0-9]*\);*0*/.\1\2.\3;0/
284	s/^\([^.]*\)\([0-9]\)\.\([^;]*;\)0*\([0-9]*\)\([0-9]\)\./\1.\2\30\4.\5/
285t div1
286s/~\(-*\)\1\(-*\);0*\([^;]*[0-9]\)[^~]*/~123456789743222111~\2\3/
287s/\(.\(.\)[^~]*\)[^9]*\2.\{8\}\(.\)[^~]*/\3~\1/
288s,|?.,&SaSadSaKdlaZ+LaX-1+[sb1]Sbd1>bkLatsbLa[dSa2lbla*-*dLa!=a]dSaxsakLasbLb*t,
289b next
290
291: rem
292s,|?%,&Sadla/LaKSa[999]k*Lak-,
293b next
294
295: exp
296#  This decimal method is just a little faster than the binary method done
297#  totally in dc:  1LaKLb [kdSb*LbK]Sb [[.5]*d0ktdSa<bkd*KLad1<a]Sa d1<a kk*
298/^[^~]*\./i\
299fraction in exponent ignored
300s,[^-0-9].*,;9d**dd*8*d*d7dd**d*6d**d5d*d*4*d3d*2lbd**1lb*0,
301: exp1
302	s/\([0-9]\);\(.*\1\([d*]*\)[^l]*\([^*]*\)\(\**\)\)/;dd*d**d*\4\3\5\2/
303t exp1
304G
305s,-*.\{9\}\([^9]*\)[^0]*0.\(.*|?.\),\2~saSaKdsaLb0kLbkK*+k1\1LaktsbkLax,
306s,|?.,&SadSbdXSaZla-SbKLaLadSb[0Lb-d1lb-*d+K+0kkSb[1Lb/]q]Sa0>a[dk]sadK<a[Lb],
307b next
308
309: sqrt
310#  first square root using sed:  8k2v at 1:30am Dec 17, 1996
311/^-/i\
312square root of negative number
313/^[-0]/b next
314s/~.*//
315/^\./ s/0\([0-9]\)/\1/g
316/^\./ !s/[0-9][0-9]/7/g
317G
318s/\n/~/
319s,|?.,&K1+k KSbSb[dk]SadXdK<asadlb/lb+[.5]*[sbdlb/lb+[.5]*dlb>a]dsaxsasaLbsaLatLbk K1-kt,
320b next
321
322#  END OF GSU dc.sed
323