1 | | .param pmc argv # main is a sub, so we can use .param |
2 | | .local string me |
3 | | me = argv[0] # the filename of the calling prog |
4 | | .include "iterator.pasm" # we need iterator constants |
5 | | _read(me) |
6 | | end |
7 | | .end |
8 | | |
9 | | # utility to check if the program is already DWIMmed |
10 | | # returns (dwim, pos) |
11 | | .sub _check |
12 | | .param pmc pline |
13 | | |
14 | | .local int dwim |
15 | | .local int state |
16 | | .local pmc ci |
17 | | ci = new 'Iterator', pline |
18 | | ci = .ITERATE_FROM_START |
19 | | .local int c |
20 | | .local int pos |
21 | | |
22 | | null dwim |
23 | | null state |
24 | | null pos |
25 | | dec pos |
26 | | iter_rep: |
27 | | inc pos |
28 | | unless ci goto iter_end |
29 | | shift c, ci |
30 | | if c >= 65 goto dwim1 |
31 | | if c == 36 goto iter_end |
32 | | if c == 35 goto dwim2 |
33 | | if c == 46 goto iter_end |
34 | | goto iter_rep |
35 | | dwim1: |
36 | | dwim = 1 |
37 | | goto iter_end |
38 | | dwim2: |
39 | | dwim = 2 |
40 | | iter_end: |
41 | | |
42 | | .begin_return |
43 | | .return dwim |
44 | | .return pos |
45 | | .end_return |
46 | | .end |
47 | | |
48 | | # DWIM the source |
49 | | .sub _dwim1 |
50 | | .param string me |
51 | | .param pmc ar |
52 | | #concat me, "x" # test output is in source.pirx |
53 | | .local pmc file |
54 | | open file, me, 'w' |
55 | | unless file, err_write |
56 | | .local pmc iter |
57 | | iter = new 'Iterator', ar |
58 | | iter = .ITERATE_FROM_START |
59 | | .local int dwim |
60 | | .local int pos |
61 | | .local pmc pline |
62 | | iter_rep: |
63 | | unless iter goto iter_end |
64 | | shift pline, iter |
65 | | # print line |
66 | | (dwim, pos) = _check(pline) |
67 | | if dwim goto do_dwim |
68 | | print file, pline # print .lines directly |
69 | | goto iter_rep |
70 | | do_dwim: # DWIM ops lines, doesn't handle P0 = ... |
71 | | .local string r # result string |
72 | | r = "\t" |
73 | | print file, " # DWIM " |
74 | | .local string word |
75 | | .local pmc p |
76 | | lp1: |
77 | | substr word, pline, pos, 1 # get chars |
78 | | length $I0, word |
79 | | unless $I0 goto lp2 |
80 | | ord $I0, word |
81 | | if $I0 == 9 goto lp2 # until white space |
82 | | if $I0 == 32 goto lp2 |
83 | | if $I0 == 10 goto lp2 |
84 | | if $I0 == 13 goto lp2 |
85 | | sub $I0, 64 # make compacter code |
86 | | p = new 'SArray' # argument passing for sprintf |
87 | | p = 1 |
88 | | push p, $I0 |
89 | | sprintf $S0, "%06b", p |
90 | | .local int l |
91 | | l = 6 |
92 | | .local int ix |
93 | | ix = 0 |
94 | | l1: |
95 | | substr $S1, $S0, ix, 1 # convert binary string |
96 | | ord $I0, $S1 |
97 | | $S2 = " " |
98 | | if $I0 != 49 goto l2 |
99 | | $S2 = "\x1f" |
100 | | l2: |
101 | | concat r, $S2 |
102 | | inc ix |
103 | | dec l |
104 | | if l goto l1 |
105 | | inc pos |
106 | | goto lp1 |
107 | | |
108 | | lp2: |
109 | | substr word, pline, pos, 100 |
110 | | chopn word, 1 # append rest w/o newline |
111 | | print file, word |
112 | | print file, r # then the DWIM code |
113 | | print file, "\n" |
114 | | goto iter_rep # for all lines |
115 | | |
116 | | iter_end: |
117 | | close file |
118 | | .begin_return |
119 | | .end_return |
120 | | err_write: |
121 | | print "Can't open '" |
122 | | print me |
123 | | print "' for writing\n" |
124 | | exit 1 |
125 | | .end |
126 | | |
127 | | # deDWIM a source file - lines in ar |
128 | | .sub _dwim2 |
129 | | .param string me |
130 | | .param pmc ar |
131 | | .local string r |
132 | | r = "" |
133 | | .local pmc iter |
134 | | iter = new 'Iterator', ar |
135 | | iter = .ITERATE_FROM_START |
136 | | .local string line |
137 | | iter_rep: |
138 | | unless iter goto iter_end |
139 | | shift line, iter |
140 | | index $I0, line, "DWIM.pir" # ignore |
141 | | if $I0 > 0 goto iter_rep |
142 | | index $I0, line, " # DWIM " |
143 | | if $I0 < 0 goto l1 # normal line |
144 | | add $I0, 10 # end pos of the DWIM marker |
145 | | index $I1, line, "\t" # start pos of DWIMmed |
146 | | $I3 = $I1 |
147 | | sub $I2, $I1, $I0 |
148 | | .local string p1 |
149 | | .local string p2 |
150 | | inc $I3 |
151 | | substr p1, line, $I0, $I2 |
152 | | substr p2, line, 0, $I3, "" # extract DWIMmed |
153 | | # decode |
154 | | chopn line, 1 # the newline |
155 | | concat r, " " # result of decoded |
156 | | .local int i |
157 | | .local int p |
158 | | .local int c |
159 | | .local int l |
160 | | length l, line |
161 | | if l < 6 goto iter_rep |
162 | | p = 0 |
163 | | lp: |
164 | | c = 0 |
165 | | i = 1 << 5 |
166 | | lp1: |
167 | | substr $S5, line, p, 1 |
168 | | ord $I4, $S5 |
169 | | if $I4 == 32 goto nul |
170 | | c = c + i |
171 | | nul: |
172 | | i = i >> 1 |
173 | | inc p |
174 | | dec l |
175 | | if i goto lp1 |
176 | | add c, 64 |
177 | | chr $S5, c |
178 | | concat r, $S5 |
179 | | if l goto lp |
180 | | concat r, " " |
181 | | |
182 | | concat r, p1 |
183 | | concat r, "\n" # put result ttogether |
184 | | |
185 | | goto iter_rep # as long as there are lines |
186 | | l1: |
187 | | concat r, line |
188 | | goto iter_rep |
189 | | iter_end: |
190 | | #print r |
191 | | #print "\n============\n" |
192 | | .local pmc comp |
193 | | .local pmc code |
194 | | .local pmc interp |
195 | | compreg comp, "PIR" # get a PIR compiler |
196 | | code = comp(r) # compile source |
197 | | getinterp interp # setup argv for eval |
198 | | .include "iglobals.pasm" |
199 | | set $P5, interp[.IGLOBALS_ARGV_LIST] |
200 | | code($P5) # run it and be done |
201 | | end |
202 | | .end |
203 | | |
204 | | .sub _read # read in source code of script |
205 | | .param string me |
206 | | .local pmc file |
207 | | open file, me, 'r' |
208 | | unless file, err_open |
209 | | .local pmc ar |
210 | | .local string line |
211 | | .local pmc pline |
212 | | ar = new 'ResizablePMCArray' |
213 | | slurp: |
214 | | readline line, file |
215 | | pline = new 'String' |
216 | | pline = line |
217 | | push ar, pline # and push everythin in Array |
218 | | if line goto slurp |
219 | | close file |
220 | | .local pmc iter |
221 | | iter = new 'Iterator', ar |
222 | | iter = .ITERATE_FROM_START |
223 | | .local int dwim, pos |
224 | | iter_rep: # run over array |
225 | | unless iter goto iter_end |
226 | | shift pline, iter |
227 | | (dwim, pos) = _check(pline) |
228 | | # print line |
229 | | if dwim goto iter_end |
230 | | goto iter_rep |
231 | | iter_end: |
232 | | unless dwim goto ok |
233 | | if dwim == 2 goto dwim2 # then do either action |
234 | | _dwim1(me, ar) |
235 | | goto ok |
236 | | dwim2: |
237 | | _dwim2(me, ar) |
238 | | goto ok |
239 | | |
240 | | err_open: |
241 | | print "Can't open '" |
242 | | print me |
243 | | print "' for reading\n" |
244 | | exit 1 |
245 | | ok: # fall through to caller/includer |
246 | | |
247 | | =head1 TITLE |
248 | | |
249 | | Parrot::DWIM - Parrot's confusing opcodes made easy. |
250 | | |
251 | | =head1 SYNOPSIS |
252 | | |
253 | | .sub _main |
254 | | .include "DWIM.pir" |
255 | | print "The answer is\n" |
256 | | add $I0, 20, 23 |
257 | | dec $I0 |
258 | | print $I0 |
259 | | print "\nsay's Parrot!\n" |
260 | | end |
261 | | .end |
262 | | |
263 | | =head1 DESCRIPTION |
264 | | |
265 | | The first time you run a program under include DWIM, the |
266 | | module replaces all the unsightly opcodes from |
267 | | your source file with the new DWIM comment: B<# DWIM> and runs normally. |
268 | | |
269 | | The code continues to work exactly as it did before, but |
270 | | now it looks like this: |
271 | | |
272 | | .sub _main |
273 | | .include "DWIM.pir" |
274 | | # DWIM "The answer is\n" |
275 | | # DWIM $I0, 20, 23 |
276 | | # DWIM $I0 |
277 | | # DWIM $I0 |
278 | | # DWIM "\nsay's Parrot!\n" |
279 | | # DWIM |
280 | | .end |
281 | | |
282 | | =head1 DIAGNOSTICS |
283 | | |
284 | | =over |
285 | | |
286 | | =item Can't open 'file' for reading |
287 | | |
288 | | =item Can't open 'file' for writing |
289 | | |
290 | | =back |
291 | | |
292 | | =head1 BUGS |
293 | | |
294 | | Doesn't work for code like |
295 | | |
296 | | I0 = 1 |
297 | | |
298 | | Probably a lot more. |
299 | | |
300 | | =head1 AUTHOR |
301 | | |
302 | | Dami^WLeopold Toetsch (as if you couldn't guess) |
303 | | |
304 | | =head1 COPYRIGHT |
305 | | |
306 | | Copyright (C) 2003-2008, The Perl Foundation. |
307 | | |
308 | | This module is free software. It may be used, redistributed |
309 | | and/or modified under the same terms as Parrot. |
310 | | |
311 | | =cut |
312 | | |
313 | | |
314 | | # Local Variables: |
315 | | # mode: pir |
316 | | # fill-column: 100 |
317 | | # End: |
318 | | # vim: expandtab shiftwidth=4 ft=pir: |