1# Copyright (C) 2008-2010, Parrot Foundation.
2#
3# pirric.pir
4# A rudimentary old style Basic interpreter for parrot
5# This is a proof of concept version, don't blame for redundant code
6# and other ugliness
7#
8# pirric is PIR Retro basIC
9#
10# Only one instruction per line.
11#
12# Instructions implemented:
13# - Flow control: GOTO, GOSUB, RETURN, RUN, END, STOP, CONT, EXIT
14# - Conditional: IF/ELSE
15# - Loop: FOR/NEXT
16# - Programming: LIST, LOAD, SAVE
17# - Debugging: TRON, TROFF
18# - Input/Output: PRINT
19# - Error control: ERROR, ON ERROR GOTO, ON ERROR EXIT
20# - Miscellaneous: REM, CLEAR
21# - Variables: varname = expression
22# - Access to parrot modules: LOAD "module name" , B
23#
24# Shorthands:
25# - ? -> PRINT
26#
27# Expressions:
28# - Operators: + - * / < > = unary+ unary- MOD ^
29# - Predefined numeric functions: COMPLEX, SQR, EXP, LN, SIN, COS, TAN, ASIN, ACOS, ATAN, SINH, COSH, TANH
30# - Predefined string functions: CHR$, ASC, LEN, LEFT$, RIGHT$, MID$
31# - Parenthesis
32# - Indexing with [ ]
33# - Special functions: NEW, ISA, COMPREG, GETPARROTINTERP
34# - Calls to methods in foreign objects
35# - Calls to functions in foreign namespaces
36#
37# Command line options:
38# -d Parrot debugger mode. Jumps to the debugger after each
39#    TRON line inform and after the 'Ready' prompt.
40# -t Trace on. Same as the TRON instruction
41# -p all remaining arguments are executed as PRINT instructions
42#-----------------------------------------------------------------------
43
44.include 'iterator.pasm'
45.include 'except_severity.pasm'
46.include 'except_types.pasm'
47.include 'cclass.pasm'
48
49.include 'warnings.pasm'
50
51.loadlib 'io_ops'
52.loadlib 'debug_ops'
53.loadlib 'trans_ops'
54
55#-----------------------------------------------------------------------
56
57.sub pirric_aux_loadbytecode
58    .param string bcname
59    load_bytecode bcname
60.end
61
62.HLL 'parrot'
63
64#-----------------------------------------------------------------------
65
66.const int PIRRIC_ERROR_NORMAL = 0
67.const int PIRRIC_ERROR_EXIT = 1
68.const int PIRRIC_ERROR_GOTO = 2
69
70#-----------------------------------------------------------------------
71.sub init :load :init
72
73    warningson .PARROT_WARNINGS_DEPRECATED_FLAG
74
75    .local pmc func
76    func = get_global ['Tokenizer'], 'newTokenizer'
77    set_global 'newTokenizer', func
78
79    .local pmc cl
80    cl = newclass ['Tokenizer']
81    addattribute cl, 'line'
82    addattribute cl, 'pos'
83    addattribute cl, 'last'
84    addattribute cl, 'pending'
85
86    .local pmc progclass
87    progclass = newclass ['Program']
88    addattribute progclass, 'text'
89    addattribute progclass, 'lines'
90
91    .local pmc runnerclass
92    runnerclass = newclass ['Runner']
93    addattribute runnerclass, 'program'
94    addattribute runnerclass, 'exitcode'
95    addattribute runnerclass, 'errormode'
96    addattribute runnerclass, 'errorvalue'
97    addattribute runnerclass, 'curline'
98    addattribute runnerclass, 'vars'
99    addattribute runnerclass, 'stack'
100    addattribute runnerclass, 'debugger'
101    addattribute runnerclass, 'tron'
102
103    $P0 = get_class 'String'
104    cl = newclass 'Literal'
105    addparent cl, $P0
106    set_global 'Literal', cl
107
108    .local pmc keywords, methods
109    # Get methods hash to verify
110    methods = inspect runnerclass, 'methods'
111    keywords = new 'Hash'
112    setkeyword(methods, keywords, 'CLEAR')
113    setkeyword(methods, keywords, 'CONT')
114    setkeyword(methods, keywords, 'END')
115    setkeyword(methods, keywords, 'EXIT')
116    setkeyword(methods, keywords, 'ERROR')
117    setkeyword(methods, keywords, 'FOR')
118    setkeyword(methods, keywords, 'GOSUB')
119    setkeyword(methods, keywords, 'GOTO')
120    setkeyword(methods, keywords, 'IF')
121    setkeyword(methods, keywords, 'LIST')
122    setkeyword(methods, keywords, 'LOAD')
123    setkeyword(methods, keywords, 'NEXT')
124    setkeyword(methods, keywords, 'NEW')
125    setkeyword(methods, keywords, 'ON')
126    setkeyword(methods, keywords, 'PRINT')
127    setkeyword(methods, keywords, 'REM')
128    setkeyword(methods, keywords, 'RETURN')
129    setkeyword(methods, keywords, 'RUN')
130    setkeyword(methods, keywords, 'SAVE')
131    setkeyword(methods, keywords, 'STOP')
132    setkeyword(methods, keywords, 'TROFF')
133    setkeyword(methods, keywords, 'TRON')
134    set_global 'keywords', keywords
135
136    .local pmc predefs
137    predefs = new 'Hash'
138    setpredef(methods, predefs, 'NEW')
139    setpredef(methods, predefs, 'ISA')
140    setpredef(methods, predefs, 'GETPARROTINTERP')
141    setpredef(methods, predefs, 'CHR$', 'CHR_S')
142    setpredef(methods, predefs, 'ASC')
143    setpredef(methods, predefs, 'LEN')
144    setpredef(methods, predefs, 'LEFT$', 'LEFT_S')
145    setpredef(methods, predefs, 'RIGHT$', 'RIGHT_S')
146    setpredef(methods, predefs, 'MID$', 'MID_S')
147    setpredef(methods, predefs, 'COMPLEX')
148    setpredef(methods, predefs, 'COMPREG')
149    setpredef(methods, predefs, 'EXP')
150    setpredef(methods, predefs, 'LN')
151    setpredef(methods, predefs, 'SIN')
152    setpredef(methods, predefs, 'SINH')
153    setpredef(methods, predefs, 'COS')
154    setpredef(methods, predefs, 'COSH')
155    setpredef(methods, predefs, 'TAN')
156    setpredef(methods, predefs, 'TANH')
157    setpredef(methods, predefs, 'ASIN')
158    setpredef(methods, predefs, 'ACOS')
159    setpredef(methods, predefs, 'ATAN')
160    setpredef(methods, predefs, 'SQR')
161    set_global 'predefs', predefs
162
163# Create classes for control flow exceptions
164
165    .local pmc pircontrol
166    pircontrol = newclass ['pircontrol']
167
168    .local pmc basejump
169    basejump = subclass pircontrol, ['basejump']
170    addattribute basejump, 'jumpline'
171
172    .local pmc endclass
173    endclass = subclass pircontrol, ['End']
174
175    .local pmc exitclass
176    exitclass = subclass pircontrol, ['Exit']
177
178    .local pmc returnclass
179    returnclass = subclass pircontrol, ['Return']
180
181    .local pmc nextclass
182    nextclass = subclass basejump, ['Next']
183
184    .local pmc jumpclass
185    jumpclass = subclass basejump, ['Jump']
186    addattribute jumpclass, 'jumptype'
187
188    .local pmc stopclass
189    stopclass = subclass pircontrol, ['Stop']
190
191    .local pmc contclass
192    stopclass = subclass pircontrol,['Cont']
193
194    .local pmc forclass
195    forclass = subclass basejump, ['For']
196    addattribute forclass, 'controlvar'
197    addattribute forclass, 'increment'
198    addattribute forclass, 'limit'
199.end
200
201#-----------------------------------------------------------------------
202.sub main :main
203    .param pmc args
204
205    .local pmc program
206    program = new ['Program']
207
208    .local pmc runner
209    runner = new ['Runner']
210    setattribute runner, 'program', program
211
212    $I0 = args
213    $I1 = 1
214read_args:
215    le $I0, $I1, no_prog
216    .local string arg
217    arg = args[$I1]
218    if arg == '-d' goto opt_debugger
219    if arg == '-t' goto opt_tron
220    if arg == '-p' goto print_items
221
222    #say arg
223    program.'load'(arg)
224
225    $I0 = 1
226    goto start
227
228opt_debugger:
229    debug_init
230    runner.'debugger'()
231    inc $I1
232    goto read_args
233
234opt_tron:
235    runner.'trace'(1)
236    inc $I1
237    goto read_args
238
239print_items:
240    .local pmc tokenizer
241    inc $I1
242    le $I0, $I1, print_end
243    $S9 = args [$I1]
244    tokenizer = newTokenizer($S9)
245    runner.'func_PRINT'(tokenizer)
246    null tokenizer
247    goto print_items
248print_end:
249    exit 0
250
251no_prog:
252    $I0 = 0
253start:
254    $I1 = runner.'runloop'($I0)
255    exit $I1
256.end
257
258#-----------------------------------------------------------------------
259.sub setkeyword
260    .param pmc methods
261    .param pmc keywords
262    .param string key
263
264    .local string funcname
265    funcname = concat 'func_', key
266
267    .local pmc func
268    func = methods[funcname]
269    $I0 = defined func
270    if $I0 goto good
271    print funcname
272    die ': No func!'
273    exit 1
274good:
275    keywords [key] = func
276.end
277
278#-----------------------------------------------------------------------
279.sub setpredef
280    .param pmc methods
281    .param pmc predefs
282    .param string key
283    .param string name :optional
284    .param int has_name :opt_flag
285
286    if has_name goto setfuncname
287    name = key
288setfuncname:
289    .local string funcname
290    funcname = concat 'predef_', name
291
292    .local pmc func
293    func = methods[funcname]
294    $I0 = defined func
295    if $I0 goto good
296    print funcname
297    say ': no func!'
298    exit 1
299good:
300    predefs [key] = func
301.end
302
303#-----------------------------------------------------------------------
304.sub FatalError
305    .param string msg
306
307    .local pmc excep
308    excep = new 'Exception'
309    .local pmc aux
310    aux = new 'String'
311    aux = msg
312    setattribute excep, 'message', aux
313    aux = new 'Integer'
314    aux = .EXCEPT_FATAL
315    setattribute excep, 'severity', aux
316    throw excep
317.end
318
319#-----------------------------------------------------------------------
320.sub UserError
321    .param string msg
322
323    .local pmc excep, message, severity
324    message = new 'String'
325    message = 'ERROR: '
326    message = concat message, msg
327    severity = new 'Integer'
328    severity = .EXCEPT_ERROR
329    excep = new 'Exception'
330    setattribute excep, 'message', message
331    setattribute excep, 'severity', severity
332    throw excep
333.end
334
335#-----------------------------------------------------------------------
336.sub SyntaxError
337    .local pmc excep
338    excep = new 'Exception'
339    .local pmc aux
340    aux = new 'String'
341    aux = 'Syntax error'
342    setattribute excep, 'message', aux
343    aux = new 'Integer'
344    aux = .EXCEPT_ERROR
345    setattribute excep, 'severity', aux
346    throw excep
347.end
348
349#-----------------------------------------------------------------------
350.sub VarNotDefined
351    .local pmc excep
352    excep = new 'Exception'
353    .local pmc aux
354    aux = new 'String'
355    aux = 'Variable not found'
356    setattribute excep, 'message', aux
357    aux = new 'Integer'
358    aux = .EXCEPT_ERROR
359    setattribute excep, 'severity', aux
360    throw excep
361.end
362
363#-----------------------------------------------------------------------
364.sub readlinebas
365    .param pmc file
366    .param int interactive :optional
367
368    .local string line
369
370    if interactive goto read_inter
371    line = readline file
372    goto read_done
373read_inter:
374    line = file.'readline_interactive'()
375read_done:
376
377    $I1 = length line
378checkline:
379    if $I1 < 1 goto done
380    dec $I1
381    $I2 = is_cclass .CCLASS_NEWLINE, line, $I1
382    unless $I2 goto done
383    line = substr line, 0, $I1
384    goto checkline
385done:
386    .return(line)
387.end
388
389########################################################################
390
391.namespace ['Runner']
392
393#-----------------------------------------------------------------------
394.sub init :vtable
395    $P0 = new 'Integer'
396    $P0 = 0
397    setattribute self, 'tron', $P0
398    $P0 = new 'Integer'
399    $P0 = 0
400    setattribute self, 'debugger', $P0
401    $P1 = new 'ResizablePMCArray'
402    setattribute self, 'stack', $P1
403    $P2 = new 'Integer'
404    $P2 = PIRRIC_ERROR_NORMAL
405    setattribute self, 'errormode', $P2
406    $P3 = new 'Integer'
407    setattribute self, 'errorvalue', $P3
408    $P4 = new 'Integer'
409    setattribute self, 'exitcode', $P4
410
411    self.'clear_vars'()
412.end
413
414#-----------------------------------------------------------------------
415.sub clear_vars :method
416    .local pmc vars
417    vars = new 'Hash'
418    setattribute self, 'vars', vars
419.end
420
421#-----------------------------------------------------------------------
422.sub get_var :method
423    .param string varname
424
425    .local pmc vars, var
426    vars = getattribute self, 'vars'
427    varname = upcase varname
428    var = vars[varname]
429    .return(var)
430.end
431
432#-----------------------------------------------------------------------
433.sub set_var :method
434    .param string varname
435    .param pmc value
436
437    .local pmc vars, var
438    vars = getattribute self, 'vars'
439    varname = upcase varname
440    vars[varname] = value
441.end
442
443#-----------------------------------------------------------------------
444.sub set_error_exit :method
445    .param int code
446
447    $P0 = getattribute self, 'errormode'
448    $P0 = PIRRIC_ERROR_EXIT
449    $P1 = getattribute self, 'errorvalue'
450    $P1 = code
451.end
452
453#-----------------------------------------------------------------------
454.sub set_error_goto :method
455    .param int code
456
457    .local int newmode
458    newmode = PIRRIC_ERROR_GOTO
459    ne code, 0, setmode
460    # ON ERROR GOTO 0 means use default error handling
461    newmode = PIRRIC_ERROR_NORMAL
462setmode:
463    $P0 = getattribute self, 'errormode'
464    $P0 = newmode
465    $P1 = getattribute self, 'errorvalue'
466    $P1 = code
467.end
468
469#-----------------------------------------------------------------------
470.sub clear_all :method
471    .local pmc stack
472
473    self.'clear_vars'()
474    stack = getattribute self, 'stack'
475    stack = 0
476.end
477
478#-----------------------------------------------------------------------
479.sub set_program :method
480    .param pmc program
481
482    setattribute self, 'program', program
483.end
484
485#-----------------------------------------------------------------------
486.sub getcurline :method
487    $P0 = getattribute self, 'curline'
488    $S0 = $P0
489    .return($S0)
490.end
491
492#-----------------------------------------------------------------------
493.sub debugger :method
494    $P0 = getattribute self, 'debugger'
495    $P0 = 1
496.end
497
498#-----------------------------------------------------------------------
499.sub trace :method
500    .param int level
501
502    $P0 = getattribute self, 'tron'
503    $P0 = level
504.end
505
506#-----------------------------------------------------------------------
507.sub get_numeric_arg :method
508    .param pmc tokenizer
509
510    .local pmc arg
511
512    arg = self.'evaluate'(tokenizer)
513    $P0 = tokenizer.'get'()
514    $I0 = defined $P0
515    unless $I0 goto fail
516    ne $P0, ')', fail
517
518    $I0 = isa arg, 'Integer'
519    unless $I0 goto done
520    $I0 = arg
521    $N0 = $I0
522    arg = new 'Float'
523    arg = $N0
524done:
525    .return(arg)
526fail:
527    SyntaxError()
528.end
529
530#-----------------------------------------------------------------------
531.sub get_1_arg :method
532    .param pmc tokenizer
533
534    .local pmc arg
535
536    arg = self.'evaluate'(tokenizer)
537    $P0 = tokenizer.'get'()
538    $I0 = defined $P0
539    unless $I0 goto fail
540    ne $P0, ')', fail
541    .return(arg)
542fail:
543    SyntaxError()
544.end
545
546#-----------------------------------------------------------------------
547.sub get_2_args :method
548    .param pmc tokenizer
549
550    .local pmc arg1, arg2
551
552    arg1 = self.'evaluate'(tokenizer)
553    $P0 = tokenizer.'get'()
554    if_null $P0, fail
555    $I0 = defined $P0
556    unless $I0 goto fail
557    ne $P0, ',', fail
558    arg2 = self.'evaluate'(tokenizer)
559    $P0 = tokenizer.'get'()
560    if_null $P0, fail
561    $I0 = defined $P0
562    unless $I0 goto fail
563    ne $P0, ')', fail
564    .return(arg1, arg2)
565fail:
566    SyntaxError()
567.end
568
569#-----------------------------------------------------------------------
570.sub get_args :method
571    .param pmc tokenizer
572
573    .local pmc args
574    .local pmc arg
575    .local pmc token
576    .local pmc delim
577
578    args = new 'ResizablePMCArray'
579    token = tokenizer.'get'()
580    $I0 = defined token
581    unless $I0 goto fail
582    eq token, ')', empty
583    null arg
584    arg = self.'evaluate'(tokenizer, token)
585nextarg:
586    push args, arg
587    null arg
588    delim = tokenizer.'get'()
589    if_null delim, fail
590    $I0 = defined delim
591    unless $I0 goto fail
592    eq delim, ')', endargs
593    ne delim, ',', fail
594    arg = self.'evaluate'(tokenizer)
595    goto nextarg
596endargs:
597    .return(args)
598empty:
599    null $P0
600    .return($P0)
601fail:
602    SyntaxError()
603.end
604
605#-----------------------------------------------------------------------
606.sub predef_NEW :method
607    .param pmc tokenizer
608
609    .local pmc args
610    .local int nargs
611    .local string name
612    .local pmc obj
613
614    $P1 = tokenizer.'get'()
615    ne $P1, '(', fail
616    args = self.'get_args'(tokenizer)
617    $I0 = defined args
618    unless $I0 goto fail
619    nargs = args
620    name = args [0]
621    #print 'NEW: '
622    #say name
623    eq nargs, 1, noarg
624
625    .local pmc arg1
626    arg1 = args [1]
627    #say arg1
628
629    obj = new name, arg1
630
631    goto done
632noarg:
633    obj = new name
634done:
635    .return(obj)
636fail:
637    SyntaxError()
638.end
639
640#-----------------------------------------------------------------------
641.sub predef_ISA :method
642    .param pmc tokenizer
643
644    $P1 = tokenizer.'get'()
645    ne $P1, '(', fail
646    ($P1, $P2) = self.'get_2_args'(tokenizer)
647    $I0 = isa $P1, $P2
648    $P0 = new 'Integer'
649    $P0 = $I0
650    .return($P0)
651fail:
652    SyntaxError()
653.end
654
655#-----------------------------------------------------------------------
656
657.sub predef_GETPARROTINTERP :method
658    .param pmc tokenizer
659
660    $P0 = getinterp
661    .return($P0)
662.end
663
664#-----------------------------------------------------------------------
665.sub predef_CHR_S :method
666    .param pmc tokenizer
667
668    $P1 = tokenizer.'get'()
669    ne $P1, '(', fail
670    $P2 = self.'get_1_arg'(tokenizer)
671
672    $I0 = $P2
673    $S0 = chr $I0
674    $I1 = find_encoding 'utf8'
675    $S0 = trans_encoding $S0, $I1
676    $P3 = new 'String'
677    $P3 = $S0
678    .return($P3)
679fail:
680    SyntaxError()
681.end
682
683#-----------------------------------------------------------------------
684.sub predef_ASC :method
685    .param pmc tokenizer
686
687    $P1 = tokenizer.'get'()
688    ne $P1, '(', fail
689    $P2 = self.'get_1_arg'(tokenizer)
690
691    $S0 = $P2
692    $I0 = ord $S0
693    $P3 = new 'Integer'
694    $P3 = $I0
695    .return($P3)
696fail:
697    SyntaxError()
698.end
699
700#-----------------------------------------------------------------------
701.sub predef_LEN :method
702    .param pmc tokenizer
703
704    $P1 = tokenizer.'get'()
705    ne $P1, '(', fail
706    null $P5
707    $P5 = self.'get_1_arg'(tokenizer)
708
709    $S5 = $P5
710    $I0 = length $S5
711    $P6 = new 'Integer'
712    $P6 = $I0
713    .return($P6)
714fail:
715    SyntaxError()
716.end
717
718#-----------------------------------------------------------------------
719.sub predef_LEFT_S :method
720    .param pmc tokenizer
721
722    $P1 = tokenizer.'get'()
723    ne $P1, '(', fail
724    null $P5
725    null $P6
726    ($P5, $P6) = self.'get_2_args'(tokenizer)
727
728    $S0 = $P5
729    $I0 = $P6
730    $S1 = substr $S0, 0, $I0
731    $P7 = new 'String'
732    $P7 = $S1
733    .return($P7)
734fail:
735    SyntaxError()
736.end
737
738#-----------------------------------------------------------------------
739.sub predef_RIGHT_S :method
740    .param pmc tokenizer
741
742    $P1 = tokenizer.'get'()
743    ne $P1, '(', fail
744    null $P5
745    null $P6
746    ($P5, $P6) = self.'get_2_args'(tokenizer)
747
748    $S0 = $P5
749    $I0 = $P6
750    $I1 = $S0
751    $I0 = $I1 - $I0
752    $S1 = substr $S0, $I0
753    $P7 = new 'String'
754    $P7 = $S1
755    .return($P7)
756fail:
757    SyntaxError()
758.end
759
760#-----------------------------------------------------------------------
761.sub predef_MID_S :method
762    .param pmc tokenizer
763
764    $P0 = tokenizer.'get'()
765    ne $P0, '(', fail
766    $P1 = self.'get_args'(tokenizer)
767    $I0 = $P1
768    lt $I0, 2, fail
769    gt $I0, 3, fail
770    $S0 = $P1[0]
771    $I1 = $P1[1]
772    dec $I1
773    lt $I0, 3, mid_nolen
774    $I2 = $P1[2]
775    $S1 = substr $S0, $I1, $I2
776    goto mid_result
777mid_nolen:
778    $S1 = substr $S0, $I1
779mid_result:
780    $P2 = new 'String'
781    $P2 = $S1
782    .return($P2)
783fail:
784    SyntaxError()
785.end
786
787#-----------------------------------------------------------------------
788.sub predef_COMPLEX :method
789    .param pmc tokenizer
790
791    $P1 = tokenizer.'get'()
792    ne $P1, '(', fail
793    null $P5
794    null $P6
795    ($P5, $P6) = self.'get_2_args'(tokenizer)
796    $P7 = new 'Complex'
797    $N5 = $P5
798    $N6 = $P6
799    $P7[0] = $N5
800    $P7[1] = $N6
801    .return($P7)
802fail:
803    SyntaxError()
804.end
805
806#-----------------------------------------------------------------------
807.sub predef_COMPREG :method
808    .param pmc tokenizer
809
810    $P1 = tokenizer.'get'()
811    ne $P1, '(', fail
812    $P2 = self.'get_1_arg'(tokenizer)
813    $S1 = $P2
814    $P3 = compreg $S1
815    .return($P3)
816fail:
817    SyntaxError()
818.end
819
820#-----------------------------------------------------------------------
821.sub predef_EXP :method
822    .param pmc tokenizer
823
824    $P1 = tokenizer.'get'()
825    ne $P1, '(', fail
826    $P2 = self.'get_numeric_arg'(tokenizer)
827    $P3 = $P2.'exp'()
828    .return($P3)
829fail:
830    SyntaxError()
831.end
832
833#-----------------------------------------------------------------------
834.sub predef_LN :method
835    .param pmc tokenizer
836
837    $P1 = tokenizer.'get'()
838    ne $P1, '(', fail
839    $P2 = self.'get_numeric_arg'(tokenizer)
840    $P3 = $P2.'ln'()
841    .return($P3)
842fail:
843    SyntaxError()
844.end
845
846#-----------------------------------------------------------------------
847.sub predef_SIN :method
848    .param pmc tokenizer
849
850    $P1 = tokenizer.'get'()
851    ne $P1, '(', fail
852    $P2 = self.'get_numeric_arg'(tokenizer)
853    $P3 = $P2.'sin'()
854    .return($P3)
855fail:
856    SyntaxError()
857.end
858
859#-----------------------------------------------------------------------
860.sub predef_SINH :method
861    .param pmc tokenizer
862
863    $P1 = tokenizer.'get'()
864    ne $P1, '(', fail
865    $P2 = self.'get_numeric_arg'(tokenizer)
866    $P3 = $P2.'sinh'()
867    .return($P3)
868fail:
869    SyntaxError()
870.end
871
872#-----------------------------------------------------------------------
873.sub predef_COS :method
874    .param pmc tokenizer
875
876    $P1 = tokenizer.'get'()
877    ne $P1, '(', fail
878    $P2 = self.'get_numeric_arg'(tokenizer)
879    $P3 = $P2.'cos'()
880    .return($P3)
881fail:
882    SyntaxError()
883.end
884
885#-----------------------------------------------------------------------
886.sub predef_COSH :method
887    .param pmc tokenizer
888
889    $P1 = tokenizer.'get'()
890    ne $P1, '(', fail
891    $P2 = self.'get_numeric_arg'(tokenizer)
892    $P3 = $P2.'cosh'()
893    .return($P3)
894fail:
895    SyntaxError()
896.end
897
898#-----------------------------------------------------------------------
899.sub predef_TAN :method
900    .param pmc tokenizer
901
902    $P1 = tokenizer.'get'()
903    ne $P1, '(', fail
904    $P2 = self.'get_numeric_arg'(tokenizer)
905    $P3 = $P2.'tan'()
906    .return($P3)
907fail:
908    SyntaxError()
909.end
910
911#-----------------------------------------------------------------------
912.sub predef_TANH :method
913    .param pmc tokenizer
914
915    $P1 = tokenizer.'get'()
916    ne $P1, '(', fail
917    $P2 = self.'get_numeric_arg'(tokenizer)
918    $P3 = $P2.'tanh'()
919    .return($P3)
920fail:
921    SyntaxError()
922.end
923
924#-----------------------------------------------------------------------
925.sub predef_ASIN :method
926    .param pmc tokenizer
927
928    $P1 = tokenizer.'get'()
929    ne $P1, '(', fail
930    $P2 = self.'get_numeric_arg'(tokenizer)
931    $P3 = $P2.'asin'()
932    .return($P3)
933fail:
934    SyntaxError()
935.end
936
937#-----------------------------------------------------------------------
938.sub predef_ACOS :method
939    .param pmc tokenizer
940
941    $P1 = tokenizer.'get'()
942    ne $P1, '(', fail
943    $P2 = self.'get_numeric_arg'(tokenizer)
944    $P3 = $P2.'acos'()
945    .return($P3)
946fail:
947    SyntaxError()
948.end
949
950#-----------------------------------------------------------------------
951.sub predef_ATAN :method
952    .param pmc tokenizer
953
954    $P1 = tokenizer.'get'()
955    ne $P1, '(', fail
956    $P2 = self.'get_numeric_arg'(tokenizer)
957    $P3 = $P2.'atan'()
958    .return($P3)
959fail:
960    SyntaxError()
961.end
962
963#-----------------------------------------------------------------------
964.sub predef_SQR :method
965    .param pmc tokenizer
966
967    $P1 = tokenizer.'get'()
968    ne $P1, '(', fail
969    $P2 = self.'get_numeric_arg'(tokenizer)
970    $P3 = $P2.'sqrt'()
971    .return($P3)
972fail:
973    SyntaxError()
974.end
975
976#-----------------------------------------------------------------------
977.sub get_args_and_call :method
978    .param pmc tokenizer
979    .param pmc fun
980
981    .local pmc args, result
982
983    args = self.'get_args'(tokenizer)
984    $I0 = defined args
985    unless $I0 goto emptyargs
986    result = fun(args :flat)
987    goto done
988emptyargs:
989    result = fun()
990done:
991    .return(result)
992.end
993
994#-----------------------------------------------------------------------
995.sub eval_base :method
996    .param pmc tokenizer
997    .param pmc token :optional
998
999    .local pmc arg
1000    .local pmc args
1001
1002    $I0 = defined token
1003    if $I0 goto check
1004    token = tokenizer.'get'()
1005check:
1006    $I0 = defined token
1007    unless $I0 goto fail
1008
1009    eq token, '(', parenexp
1010
1011    $I0 = isa token, 'Literal'
1012    if $I0 goto isliteral
1013    $I0 = isa token, 'Integer'
1014    if $I0 goto isinteger
1015    $I0 = isa token, 'Float'
1016    if $I0 goto isfloat
1017    $I0 = isa token, 'String'
1018    unless $I0 goto fail
1019
1020    $S0 = token
1021    $S0 = upcase $S0
1022    #print $S0
1023
1024# Some predefined functions:
1025    .local pmc predefs
1026    predefs = get_hll_global 'predefs'
1027    .local pmc func
1028    func = predefs[$S0]
1029    $I0 = defined func
1030    unless $I0 goto no_predef
1031
1032    $P0 = self.func(tokenizer)
1033    .return($P0)
1034
1035no_predef:
1036
1037    #say $S0
1038    .local pmc var
1039    var = self.'get_var'($S0)
1040
1041    unless_null var, getvar
1042
1043    $P0 = get_namespace token
1044    $I0 = defined $P0
1045    if $I0 goto spaced
1046    $P0 = get_root_namespace token
1047    $I0 = defined $P0
1048    if $I0 goto spaced
1049
1050    $P1 = tokenizer.'get'()
1051    $S1 = $P1
1052    ne $S1, '(', var_not_defined
1053
1054    $S0 = token
1055    #say $S0
1056    var = get_hll_global $S0
1057    if_null var, fail
1058    args = self.'get_args'(tokenizer)
1059    $P9 = var(args)
1060    .return($P9)
1061
1062spaced:
1063    # say "namespace"
1064
1065    $P1 = tokenizer.'get'()
1066    ne $P1, '.', fail
1067    $P1 = tokenizer.'get'()
1068    $S1 = $P1
1069    $P2 = $P0 [$S1]
1070
1071    $P4 = tokenizer.'get'()
1072    eq $P4, '(', getargs
1073    tokenizer.'back'()
1074
1075    .return($P2)
1076
1077isliteral:
1078    .return(token)
1079
1080isinteger:
1081    .return(token)
1082
1083isfloat:
1084    .return(token)
1085
1086getargs:
1087    args = self.'get_args'(tokenizer)
1088    $I0 = defined args
1089    unless $I0 goto emptyargs
1090endargs:
1091    $P3 = $P2(args :flat)
1092    .return($P3)
1093emptyargs:
1094    $P3 = $P2()
1095    .return($P3)
1096
1097getvar:
1098    $P2 = tokenizer.'get'()
1099    if_null $P2, donevar
1100    eq $P2, '.', dotted
1101    eq $P2, '(', isfunctor
1102    tokenizer.'back'()
1103donevar:
1104    .return(var)
1105
1106isfunctor:
1107    #say 'Functor'
1108
1109    $P3 = self.'get_args_and_call'(tokenizer, var)
1110    .return($P3)
1111
1112
1113dotted:
1114    $P3 = tokenizer.'get'()
1115    $P4 = tokenizer.'get'()
1116    eq $P4, '(', methodcall
1117    tokenizer.'back'()
1118
1119    $S1 = $P3
1120    $P5 = getattribute token, $S1
1121    .return($P5)
1122
1123methodcall:
1124    $S2 = $P3
1125    #say $S2
1126
1127    .local pmc methargs
1128    methargs = self.'get_args'(tokenizer)
1129    $I0 = defined methargs
1130    unless $I0 goto memptyargs
1131    $P5 = var.$S2(methargs :flat)
1132    .return($P5)
1133
1134memptyargs:
1135    $P2 = var.$S2()
1136    .return($P2)
1137
1138parenexp:
1139    $P1 = self.'evaluate'(tokenizer)
1140    token = tokenizer.'get'()
1141    ne token, ')', fail
1142    .return($P1)
1143
1144var_not_defined:
1145    VarNotDefined()
1146
1147fail:
1148    SyntaxError()
1149.end
1150
1151#-----------------------------------------------------------------------
1152.sub eval_base_1 :method
1153    .param pmc tokenizer
1154    .param pmc token :optional
1155
1156    $P0 = self.'eval_base'(tokenizer, token)
1157again:
1158    $P1 = tokenizer.'get'()
1159    if_null $P1, done
1160    $I0 = defined $P1
1161    unless $I0 goto done
1162    eq $P1, '[', keyit
1163    tokenizer.'back'()
1164done:
1165    .return($P0)
1166keyit:
1167    $P2 = self.'evaluate'(tokenizer)
1168    $P1 = tokenizer.'get'()
1169    if_null $P1, fail
1170    eq $P1, ']', last
1171    ne $P1, ',', fail
1172    $P3 = $P0 [$P2]
1173    null $P2
1174    null $P0
1175    $P0 = $P3
1176    null $P3
1177    goto keyit
1178last:
1179    $P3 = $P0 [$P2]
1180    null $P0
1181    $P0 = $P3
1182    null $P3
1183    goto again
1184fail:
1185    SyntaxError()
1186.end
1187
1188#-----------------------------------------------------------------------
1189.sub eval_pow :method
1190    .param pmc tokenizer
1191    .param pmc token :optional
1192
1193    $P0 = self.'eval_base_1'(tokenizer, token)
1194more:
1195    $P1 = tokenizer.'get'()
1196    if_null $P1, done
1197    eq $P1, '^', dopow
1198    tokenizer.'back'()
1199done:
1200    .return($P0)
1201dopow:
1202    $P2 = self.'eval_unary'(tokenizer)
1203    null $P3
1204    $P3 = pow $P0, $P2
1205    set $P0, $P3
1206    null $P2
1207    goto more
1208.end
1209
1210#-----------------------------------------------------------------------
1211.sub eval_mod :method
1212    .param pmc tokenizer
1213    .param pmc token :optional
1214    $P0 = self.'eval_pow'(tokenizer, token)
1215more:
1216    $P1 = tokenizer.'get'()
1217    if_null $P1, done
1218    eq $P1, 'MOD', domod
1219    tokenizer.'back'()
1220done:
1221    .return($P0)
1222domod:
1223    $P2 = self.'eval_pow'(tokenizer)
1224    $P3 = clone $P0
1225    mod $P3, $P2
1226    set $P0, $P3
1227    goto more
1228.end
1229
1230#-----------------------------------------------------------------------
1231.sub eval_unary :method
1232    .param pmc tokenizer
1233    .param pmc token :optional
1234
1235    $I0 = defined token
1236    if $I0 goto check
1237    token = tokenizer.'get'()
1238    $I0 = defined token
1239    unless $I0 goto fail
1240check:
1241# Quick fix to MMD problem
1242    $I0 = isa token, 'Literal'
1243    if $I0 goto notoken
1244
1245    eq token, '-', unaryminus
1246    eq token, '+', unaryplus
1247notoken:
1248    $P0 = self.'eval_mod'(tokenizer, token)
1249    .return($P0)
1250unaryplus:
1251    $P0 = self.'eval_unary'(tokenizer)
1252    .return($P0)
1253unaryminus:
1254    $P0 = self.'eval_unary'(tokenizer)
1255    $P1 = clone $P0
1256    $P1 = 0
1257    $P1 = $P1 - $P0
1258    .return($P1)
1259fail:
1260    SyntaxError()
1261.end
1262
1263#-----------------------------------------------------------------------
1264.sub eval_mul :method
1265    .param pmc tokenizer
1266    .param pmc token :optional
1267
1268    $P0 = self.'eval_unary'(tokenizer, token)
1269more:
1270    $P1 = tokenizer.'get'()
1271    if_null $P1, done
1272    eq $P1, '*', domul
1273    eq $P1, '/', dodiv
1274    tokenizer.'back'()
1275done:
1276    .return($P0)
1277domul:
1278    $P2 = self.'eval_unary'(tokenizer)
1279    $P3 = clone $P0
1280    mul $P3, $P2
1281    set $P0, $P3
1282    goto more
1283dodiv:
1284    $P2 = self.'eval_unary'(tokenizer)
1285    $P3 = clone $P0
1286    div $P3, $P2
1287    set $P0, $P3
1288    goto more
1289.end
1290
1291#-----------------------------------------------------------------------
1292.sub eval_add :method
1293    .param pmc tokenizer
1294    .param pmc token :optional
1295
1296    $P0 = self.'eval_mul'(tokenizer, token)
1297more:
1298    $P1 = tokenizer.'get'()
1299    if_null $P1, done
1300    eq $P1, '+', doadd
1301    eq $P1, '-', dosub
1302    tokenizer.'back'()
1303done:
1304    .return($P0)
1305
1306doadd:
1307    $P2 = self.'eval_mul'(tokenizer)
1308    clone $P3, $P0
1309
1310    $I3 = isa $P3, 'String'
1311    if $I3 goto str_add
1312    $I2 = isa $P2, 'String'
1313    if $I2 goto str_add
1314
1315    add $P3, $P2
1316    set $P0, $P3
1317    goto more
1318str_add:
1319    $S0 = $P3
1320    $S1 = $P2
1321    $S3 = concat $S0, $S1
1322    $P3 = $S3
1323    set $P0, $P3
1324    goto more
1325
1326dosub:
1327    $P2 = self.'eval_mul'(tokenizer)
1328    clone $P3, $P0
1329    sub $P3, $P2
1330    set $P0, $P3
1331    goto more
1332.end
1333
1334#-----------------------------------------------------------------------
1335.sub eval_comp :method
1336    .param pmc tokenizer
1337    .param pmc token :optional
1338
1339    $P0 = self.'eval_add'(tokenizer, token)
1340more:
1341    $P1 = tokenizer.'get'()
1342    if_null $P1, done
1343    eq $P1, '=', doequal
1344    eq $P1, '<', doless
1345    eq $P1, '>', dogreat
1346    tokenizer.'back'()
1347done:
1348    .return($P0)
1349doequal:
1350    $P2 = self.'eval_add'(tokenizer)
1351    set $P3, $P0
1352    $I0 = iseq $P3, $P2
1353    goto next
1354doless:
1355    $P2 = self.'eval_add'(tokenizer)
1356    set $P3, $P0
1357    $I0 = islt $P3, $P2
1358    goto next
1359dogreat:
1360    $P2 = self.'eval_add'(tokenizer)
1361    set $P3, $P0
1362    $I0 = isgt $P3, $P2
1363next:
1364    null $P0
1365    $P0 = new 'Integer'
1366    set $P0, $I0
1367    goto more
1368.end
1369
1370#-----------------------------------------------------------------------
1371.sub evaluate :method
1372    .param pmc tokenizer
1373    .param pmc token :optional
1374
1375    $P0 = self.'eval_comp'(tokenizer, token)
1376#    $I0 = isa $P0, 'Integer'
1377#    unless $I0 goto done
1378#    say '<Integer'
1379#done:
1380    .return($P0)
1381.end
1382
1383#-----------------------------------------------------------------------
1384.sub findline :method
1385    .param int linenum
1386
1387    .local pmc program
1388    program = getattribute self, 'program'
1389    .local pmc iter
1390    iter = program.'begin'()
1391
1392    .local int fline
1393nextline:
1394    unless iter goto noline
1395    shift fline, iter
1396    gt fline, linenum, noline
1397    lt fline, linenum, nextline
1398    .return(iter)
1399noline:
1400    null iter
1401    .return(iter)
1402.end
1403
1404#-----------------------------------------------------------------------
1405.sub runloop :method
1406    .param int start :optional
1407
1408    .local pmc program
1409    .local pmc stack
1410    .local pmc iter
1411    .local pmc debugger
1412    .local pmc tron
1413    .local pmc pircontrol
1414    .local int stopline
1415    .local int curline
1416    .local pmc pcurline
1417    .local int target
1418
1419    pircontrol = get_class ['pircontrol']
1420
1421    program = getattribute self, 'program'
1422    stack = getattribute self, 'stack'
1423
1424    tron = getattribute self, 'tron'
1425    debugger = getattribute self, 'debugger'
1426    stopline = 0
1427
1428    pcurline = new 'Integer'
1429    setattribute self, 'curline', pcurline
1430
1431    iter = program.'begin'()
1432
1433    push_eh handle_excep
1434
1435    curline = 0
1436
1437    unless start goto next
1438    shift curline, iter
1439
1440next:
1441    if curline goto runit
1442    self.'interactive'()
1443    goto next
1444
1445runit:
1446    pcurline = curline
1447    unless tron goto executeline
1448    print '['
1449    print curline
1450    print ']'
1451
1452    unless debugger goto executeline
1453    debug_break
1454
1455executeline:
1456    program = getattribute self, 'program'
1457    $S1 = program [curline]
1458
1459    .local pmc tokenizer
1460    tokenizer = newTokenizer($S1)
1461    self.'execute'(tokenizer)
1462    unless iter goto endprog
1463    shift curline, iter
1464    goto next
1465endprog:
1466    curline = 0
1467    goto next
1468
1469handle_excep:
1470    .local pmc excep, type, severity
1471    .local int itype
1472    .get_results(excep)
1473
1474    type = getattribute excep, 'type'
1475    itype = type
1476    severity = getattribute excep, 'severity'
1477    eq severity, .EXCEPT_EXIT, finish
1478
1479    eq itype, .CONTROL_RETURN, handle_return
1480
1481    $P1 = getattribute excep, 'payload'
1482    $I1 = defined $P1
1483    unless $I1 goto unhandled
1484    $I1 = isa $P1, pircontrol
1485    unless $I1 goto unhandled
1486
1487    $I1 = isa $P1, 'Jump'
1488    if $I1 goto handle_jump
1489    $I1 = isa $P1, 'Next'
1490    if $I1 goto handle_next
1491    $I1 = isa $P1, 'Return'
1492    if $I1 goto handle_return
1493    $I1 = isa $P1, 'Stop'
1494    if $I1 goto handle_stop
1495    $I1 = isa $P1, 'Cont'
1496    if $I1 goto handle_cont
1497    $I1 = isa $P1, 'End'
1498    if $I1 goto prog_end
1499    $I1 = isa $P1, 'Exit'
1500    if $I1 goto finish
1501    FatalError('Unhandled control type')
1502
1503handle_stop:
1504    print 'Stopped'
1505    goto linenum_msg
1506
1507handle_cont:
1508    unless stopline goto cannot_cont
1509    iter = self.'findline'(stopline)
1510    shift curline, iter
1511    stopline = 0
1512    push_eh handle_excep
1513    goto next
1514cannot_cont:
1515    print 'Cannot CONTinue'
1516    goto linenum_msg
1517
1518handle_jump:
1519    $P2 = getattribute $P1, 'jumpline'
1520    $I1 = $P2
1521    eq $I1, 0, prog_end
1522    eq $I1, -1, prog_end
1523
1524    $S2 = curline
1525    target = $P2
1526
1527do_jump:
1528    iter = self.'findline'(target)
1529    if_null iter, noline
1530    curline = target
1531
1532    $P3 = getattribute $P1, 'jumptype'
1533    $I1 = defined $P3
1534    unless $I1 goto handled_jump
1535    eq $P3, 1, handle_gosub
1536    goto handled_jump
1537
1538handle_gosub:
1539    push stack, $S2
1540    goto handled_jump
1541
1542handle_next:
1543    $P2 = getattribute $P1, 'jumpline'
1544    $I1 = $P2
1545    iter = self.'findline'($I1)
1546    curline = shift iter
1547
1548handled_jump:
1549    push_eh handle_excep
1550    goto runit
1551
1552handle_return:
1553    .local pmc stack
1554    stack = getattribute self, 'stack'
1555    $I0 = stack
1556    unless $I0 goto no_gosub
1557    $P0 = pop stack
1558    curline = $P0
1559    iter = self.'findline'(curline)
1560    curline = shift iter
1561    #say curline
1562    push_eh handle_excep
1563    goto next
1564no_gosub:
1565    print 'RETURN without GOSUB'
1566    goto linenum_msg
1567
1568prog_end:
1569    curline = 0
1570    null iter
1571    push_eh handle_excep
1572    goto next
1573
1574unhandled:
1575    $P3 = getattribute self, 'errormode'
1576    $I0 = $P3
1577    eq $I0, PIRRIC_ERROR_GOTO, goto_error
1578    ne $I0, PIRRIC_ERROR_NORMAL, exit_error
1579    $P1 = getattribute excep, 'message'
1580    print $P1
1581    goto linenum_msg
1582exit_error:
1583    $P4 = getattribute self, 'errorvalue'
1584    $I0 = $P4
1585    $P5 = getattribute self, 'exitcode'
1586    $P5 = $I0
1587    goto finish
1588goto_error:
1589    $P4 = getattribute self, 'errorvalue'
1590    $I1 = PIRRIC_ERROR_NORMAL
1591    $P3 = $I1
1592    $I0 = $P4
1593    iter = self.'findline'($I0)
1594    if_null iter, noline
1595    curline = $I0
1596    push_eh handle_excep
1597    goto runit
1598
1599noline:
1600    print 'Line does not exist'
1601
1602linenum_msg:
1603    unless curline goto endmsg
1604    print ' in '
1605    print curline
1606endmsg:
1607    say ''
1608    curline = 0
1609    push_eh handle_excep
1610    goto next
1611
1612finish:
1613    $P9 = getattribute self, 'exitcode'
1614    $I0 = $P9
1615    .return($I0)
1616.end
1617
1618#-----------------------------------------------------------------------
1619.sub interactive :method
1620    .local pmc stdin
1621    stdin = getstdin
1622    .local pmc program
1623    program = getattribute self, 'program'
1624    .local string line
1625    .local pmc debugger
1626    debugger = getattribute self, 'debugger'
1627
1628    say 'Ready'
1629
1630reinit:
1631    unless debugger goto doreadline
1632    debug_break
1633doreadline:
1634    line = readlinebas(stdin, 1)
1635
1636    .local pmc tokenizer
1637    .local pmc token
1638
1639    tokenizer = newTokenizer(line)
1640    token = tokenizer.'get'()
1641    if_null token, reinit
1642    $I0 = isa token, 'Integer'
1643    unless $I0 goto execute
1644
1645# Have line number: if has content store it, else delete
1646    $I0 = token
1647    line = tokenizer.'getall'()
1648    $I1 = length line
1649    unless $I1 goto deleteit
1650
1651    program.'storeline'($I0, line)
1652    goto reinit
1653
1654deleteit:
1655    program.'deleteline'($I0)
1656    goto reinit
1657
1658execute:
1659    self.'execute'(tokenizer, token)
1660.end
1661
1662#-----------------------------------------------------------------------
1663.sub execute :method
1664    .param pmc tokenizer
1665    .param pmc token :optional
1666    .param int has :opt_flag
1667
1668    if has goto check
1669    token = tokenizer.'get'()
1670check:
1671    unless token goto next
1672
1673    .local string key
1674    key = token
1675    unless key == '?' goto findkey
1676    key = 'PRINT'
1677
1678findkey:
1679    key = upcase key
1680    .local pmc keywords
1681    keywords = get_hll_global 'keywords'
1682    $I0 = keywords
1683    .local pmc func
1684    func = keywords [key]
1685    $I0 = defined func
1686    if $I0 goto exec
1687
1688    .local pmc op
1689    op = tokenizer.'get'()
1690    eq op, '=', assign
1691    eq op, '[', keyed
1692    goto fail
1693assign:
1694    .local pmc value
1695    value = self.'evaluate'(tokenizer)
1696    self.'set_var'(key, value)
1697
1698    goto next
1699keyed:
1700    .local pmc obj, index, auxobj
1701    obj = self.'get_var'(key)
1702keyed_next:
1703    index = self.'evaluate'(tokenizer)
1704    op = tokenizer.'get'()
1705    if_null op, fail
1706    eq op, ']', last
1707    ne op, ',', fail
1708    auxobj = obj[index]
1709    null index
1710    null obj
1711    obj = auxobj
1712    null auxobj
1713    goto keyed_next
1714last:
1715    op = tokenizer.'get'()
1716    ne op, '=', fail
1717    value = self.'evaluate'(tokenizer)
1718    obj[index] = value
1719    goto next
1720fail:
1721    SyntaxError()
1722exec:
1723    self.func(tokenizer)
1724next:
1725.end
1726
1727#-----------------------------------------------------------------------
1728.sub throw_typed
1729    .param pmc payload
1730    .param int type :optional
1731    .param int has_type :opt_flag
1732
1733    .local pmc excep, ex_severity
1734    excep = new 'Exception'
1735    ex_severity = new 'Integer'
1736    ex_severity= .EXCEPT_NORMAL
1737    unless has_type goto setattrs
1738    .local pmc ex_type
1739    ex_type = new 'Integer'
1740    ex_type = type
1741    setattribute excep, 'type', ex_type
1742setattrs:
1743    setattribute excep, 'severity', ex_severity
1744    setattribute excep, 'payload', payload
1745    throw excep
1746.end
1747
1748#-----------------------------------------------------------------------
1749.sub throw_jump
1750    .param pmc payload
1751    .param int jumpline
1752
1753    $P0 = new 'Integer'
1754    $P0 = jumpline
1755    setattribute payload, 'jumpline', $P0
1756
1757    throw_typed(payload)
1758.end
1759
1760#-----------------------------------------------------------------------
1761.sub func_CLEAR :method
1762    .param pmc tokenizer
1763
1764    self.'clear_all'()
1765.end
1766
1767.sub func_CONT :method
1768    .param pmc tokenizer
1769
1770    .local pmc cont
1771    cont = new 'Cont'
1772    throw_typed(cont)
1773.end
1774
1775.sub func_END :method
1776    .param pmc tokenizer
1777
1778    .local pmc end
1779    end = new 'End'
1780    throw_typed(end)
1781.end
1782
1783.sub func_EXIT :method
1784    .param pmc tokenizer
1785
1786    .local pmc ex_exit
1787    ex_exit = new 'Exit'
1788    throw_typed(ex_exit)
1789.end
1790
1791.sub func_ERROR :method
1792    .param pmc tokenizer
1793
1794    .local pmc arg
1795    arg = self.'evaluate'(tokenizer)
1796    .local string msg
1797    msg = arg
1798    UserError(msg)
1799.end
1800
1801.sub func_FOR :method
1802    .param pmc tokenizer
1803
1804    .local pmc pvar
1805    pvar = tokenizer.'get'()
1806    .local string var
1807    var = pvar
1808    var = upcase var
1809    $P0 = tokenizer.'get'()
1810    ne $P0, '=', fail
1811    .local pmc value
1812    value = self.'evaluate'(tokenizer)
1813    $P0 = tokenizer.'get'()
1814    $S0 = $P0
1815    $S0 = upcase $S0
1816    ne $S0, 'TO', fail
1817
1818    .local pmc limit
1819    limit = self.'evaluate'(tokenizer)
1820
1821    .local pmc increment
1822    $P0 = tokenizer.'get'()
1823    $I0 = defined $P0
1824    unless $I0 goto default_step
1825    $S0 = $P0
1826    $S0 = upcase $S0
1827    ne $S0, 'STEP', fail
1828    increment = self.'evaluate'(tokenizer)
1829    goto prepare
1830default_step:
1831    increment = new 'Integer'
1832    increment = 1
1833prepare:
1834    .local pmc for
1835    for = new 'For'
1836    .local pmc line
1837    line = self.'getcurline'()
1838    setattribute for, 'jumpline', line
1839    setattribute for, 'increment', increment
1840    setattribute for, 'limit', limit
1841
1842    .local pmc vars, controlvar
1843    vars = getattribute self, 'vars'
1844    vars[var] = value
1845    controlvar = vars[var]
1846    $P0 = new 'String'
1847    $P0 = var
1848    setattribute for, 'controlvar', $P0
1849
1850    .local pmc stack
1851    stack = getattribute self, 'stack'
1852    push stack, for
1853
1854    .return()
1855fail:
1856    SyntaxError()
1857.end
1858
1859.sub func_GOTO :method
1860    .param pmc tokenizer
1861
1862    .local pmc arg
1863    arg = tokenizer.'get'()
1864    $I0 = defined arg
1865    unless $I0 goto fail
1866    $I0 = arg
1867
1868    .local pmc line
1869    line = new 'Jump'
1870    throw_jump(line, $I0)
1871
1872fail:
1873    SyntaxError()
1874.end
1875
1876.sub func_GOSUB :method
1877    .param pmc tokenizer
1878
1879    .local pmc arg
1880    arg = tokenizer.'get'()
1881    $I0 = defined arg
1882    unless $I0 goto fail
1883    $I0 = arg
1884
1885    .local pmc line
1886    line = new 'Jump'
1887    $P1 = new 'Integer'
1888    $P1 = 1
1889    setattribute line, 'jumptype', $P1
1890    throw_jump(line, $I0)
1891
1892fail:
1893    SyntaxError()
1894.end
1895
1896.sub func_IF :method
1897    .param pmc tokenizer
1898
1899    .local pmc arg
1900    .local pmc token
1901
1902    arg = self.'evaluate'(tokenizer)
1903    token = tokenizer.'get'()
1904    $I0 = defined token
1905    unless $I0 goto fail
1906    $S0 = token
1907    $S0 = upcase $S0
1908    ne $S0, 'THEN', fail
1909
1910    $I0 = defined arg
1911    unless $I0 goto is_false
1912    $I0 = arg
1913    unless $I0 goto is_false
1914    self.'execute'(tokenizer)
1915    goto finish
1916
1917is_false:
1918    .local int level
1919    level = 1
1920# Search for ELSE, taking nested IF into account
1921nextitem:
1922    $P0 = tokenizer.'get' ()
1923    $I0 = defined $P0
1924    unless $I0 goto finish
1925    $I0 = isa $P0, 'String'
1926    unless $I0 goto nextitem
1927    $S0 = $P0
1928    $S0 = upcase $S0
1929    eq $S0, 'ELSE', is_else
1930    eq $S0, 'IF', is_if
1931    goto nextitem
1932is_if:
1933    inc level
1934    goto nextitem
1935is_else:
1936    dec level
1937    if level > 0 goto nextitem
1938    self.'execute'(tokenizer)
1939
1940finish:
1941    .return()
1942fail:
1943    SyntaxError()
1944.end
1945
1946.sub func_LIST :method
1947    .param pmc tokenizer
1948
1949    .local pmc program
1950    program = getattribute self, 'program'
1951    program.'list'(0, 0)
1952
1953.end
1954
1955.sub func_LOAD :method
1956    .param pmc tokenizer
1957
1958    .local pmc arg
1959    arg = self.'evaluate'(tokenizer)
1960    $P1 = tokenizer.'get'()
1961    if_null $P1, notype
1962    $I1 = defined $P1
1963    unless $I1 goto notype
1964    ne $P1, ',', notype
1965
1966    $P1 = tokenizer.'get'()
1967    $I1 = defined $P1
1968    unless $I1 goto fail
1969    $S1 = $P1
1970    $S1 = upcase $S1
1971    ne $S1, 'B', fail
1972    $S1 = arg
1973    pirric_aux_loadbytecode($S1)
1974    .return()
1975notype:
1976    .local pmc program, newprogram
1977    newprogram = new ['Program']
1978    .local string filename
1979    filename = arg
1980    newprogram.'load'(filename)
1981    setattribute self, 'program', newprogram
1982
1983    .local pmc end
1984    end = new 'End'
1985    throw_typed(end)
1986
1987fail:
1988    SyntaxError()
1989.end
1990
1991.sub func_NEXT :method
1992    .param pmc tokenizer
1993
1994    .local pmc stack
1995    stack = getattribute self, 'stack'
1996    $I0 = stack
1997    dec $I0
1998    .local pmc for
1999    for = stack[$I0]
2000    .local pmc controlvar, varvalue, increment, limit
2001    controlvar = getattribute for, 'controlvar'
2002    varvalue = self.'get_var'(controlvar)
2003    increment = getattribute for, 'increment'
2004    limit = getattribute for, 'limit'
2005
2006    $P0 = clone varvalue
2007    add $P0, increment
2008    self.'set_var'(controlvar, $P0)
2009
2010    lt increment, 0, negstep
2011    gt $P0, limit, endloop
2012    goto jump
2013negstep:
2014    lt $P0, limit, endloop
2015jump:
2016    .local pmc jumpline
2017    jumpline = getattribute for, 'jumpline'
2018
2019    .local pmc line
2020    line = new 'Next'
2021    throw_jump(line,jumpline)
2022
2023    .return()
2024endloop:
2025    $P0 = pop stack
2026.end
2027
2028.sub func_NEW :method
2029    .param pmc tokenizer
2030
2031    .local pmc newprogram
2032    newprogram = new ['Program']
2033    setattribute self, 'program', newprogram
2034
2035    self.'clear_all'()
2036
2037    .local pmc end
2038    end = new 'End'
2039    throw_typed(end)
2040.end
2041
2042.sub func_ON :method
2043    .param pmc tokenizer
2044
2045    .local pmc token
2046    token = tokenizer.'get'()
2047    $S0 = token
2048    $S0 = upcase $S0
2049    if $S0 == 'ERROR' goto on_error
2050    goto fail
2051on_error:
2052    token = tokenizer.'get'()
2053    $S0 = token
2054    $S0 = upcase $S0
2055    if $S0 == 'GOTO' goto on_error_goto
2056    if $S0 == 'EXIT' goto on_error_exit
2057    goto fail
2058on_error_exit:
2059    $P0 = self.'evaluate'(tokenizer)
2060    $I0 = $P0
2061    self.'set_error_exit'($I0)
2062    goto finish
2063on_error_goto:
2064    $P0 = tokenizer.'get'()
2065    $I0 = defined $P0
2066    unless $I0 goto fail
2067    $I0 = $P0
2068    self.'set_error_goto'($I0)
2069    goto finish
2070fail:
2071    SyntaxError()
2072finish:
2073.end
2074
2075.sub func_PRINT :method
2076    .param pmc tokenizer
2077
2078    .local pmc arg
2079
2080    arg = tokenizer.'get'()
2081    $I0 = defined arg
2082    unless $I0 goto endline
2083
2084item:
2085    $S0 = arg
2086    $S0 = upcase $S0
2087    eq $S0, 'ELSE', endline
2088    arg = self.'evaluate'(tokenizer, arg)
2089print_it:
2090    print arg
2091    arg = tokenizer.'get'()
2092    $I0 = defined arg
2093    unless $I0 goto endline
2094    eq arg, ';', nextitem
2095    eq arg, ',', comma
2096    $S0 = arg
2097    $S0 = upcase $S0
2098    eq $S0, 'ELSE', endline
2099    SyntaxError()
2100comma:
2101    print "\t"
2102    goto nextitem
2103
2104fail:
2105    SyntaxError()
2106endline:
2107    say ''
2108    .return()
2109nextitem:
2110    arg = tokenizer.'get'()
2111    $I0 = defined arg
2112    unless $I0 goto finish
2113    $S0 = arg
2114    $S0 = upcase $S0
2115    eq $S0, 'ELSE', finish
2116    goto item
2117finish:
2118.end
2119
2120.sub func_REM :method
2121    .param pmc tokenizer
2122
2123    # Do nothing
2124.end
2125
2126.sub func_RETURN :method
2127    .param pmc tokenizer
2128
2129    .local pmc line
2130    line = new 'Return'
2131    throw_typed(line, .CONTROL_RETURN)
2132
2133fail:
2134    SyntaxError()
2135.end
2136
2137.sub func_RUN :method
2138    .param pmc tokenizer
2139
2140    self.'clear_all'()
2141    .local pmc program, iter
2142    program = getattribute self, 'program'
2143    iter = program.'begin'()
2144    .local int numline
2145    numline = 0
2146    unless iter goto doit
2147    numline = shift iter
2148doit:
2149    .local pmc line
2150    line = new 'Jump'
2151    throw_jump(line, numline)
2152.end
2153
2154.sub func_SAVE :method
2155    .param pmc tokenizer
2156
2157    .local pmc arg
2158    arg = self.'evaluate'(tokenizer)
2159    $P1 = tokenizer.'get'()
2160    $I1 = defined $P1
2161    if $I1 goto fail
2162
2163    .local string filename
2164    filename = arg
2165    .local pmc program
2166    program = getattribute self, 'program'
2167    program.'save'(filename)
2168
2169    .return()
2170
2171fail:
2172    SyntaxError()
2173.end
2174
2175.sub func_STOP :method
2176    .param pmc tokenizer
2177
2178    .local pmc line
2179    line = new 'Stop'
2180    throw_typed(line)
2181.end
2182
2183.sub func_TROFF :method
2184    .param pmc tokenizer
2185
2186    self.'trace'(0)
2187.end
2188
2189.sub func_TRON :method
2190    .param pmc tokenizer
2191
2192    self.'trace'(1)
2193.end
2194
2195########################################################################
2196
2197.namespace [ 'Tokenizer' ]
2198
2199#-----------------------------------------------------------------------
2200.sub 'newTokenizer'
2201    .param string line
2202    .local pmc tkn
2203    .local pmc l
2204
2205    tkn = new ['Tokenizer']
2206    l = new 'String'
2207    l = line
2208    setattribute tkn, 'line', l
2209    $P0 = new 'Integer'
2210    $P0 = 0
2211    setattribute tkn, 'pos', $P0
2212    .return(tkn)
2213.end
2214
2215#-----------------------------------------------------------------------
2216.sub get :method
2217
2218    .local pmc pending
2219    .local pmc last
2220
2221    pending = getattribute self, 'pending'
2222    if_null pending, getnext
2223    null $P1
2224    setattribute self, 'pending', $P1
2225    last = clone pending
2226    setattribute self, 'last', last
2227    .return(pending)
2228
2229getnext:
2230    .local string line
2231    $P0 = getattribute self, 'line'
2232    line = $P0
2233    .local pmc pos
2234    pos = getattribute self, 'pos'
2235
2236    .local int i, l
2237    l = length line
2238    i = pos
2239    .local string result
2240    result = ''
2241    .local pmc objres
2242    .local string c
2243loop:
2244    ge i, l, endline
2245    c = substr line, i, 1
2246    inc i
2247    eq c, ' ', loop
2248    eq c, "\n", endline
2249
2250    eq c, '.', operator
2251    eq c, ',', operator
2252    eq c, ';', operator
2253    eq c, '=', operator
2254    eq c, '+', operator
2255    eq c, '-', operator
2256    eq c, '*', operator
2257    eq c, '/', operator
2258    eq c, '^', operator
2259    eq c, '<', operator
2260    eq c, '>', operator
2261    eq c, '(', operator
2262    eq c, ')', operator
2263    eq c, '[', operator
2264    eq c, ']', operator
2265    eq c, '?', operator
2266
2267    eq c, '"', str
2268    $I0 = ord c
2269    $I1 = ord '9'
2270    gt $I0, $I1, nextchar
2271    $I1 = ord '0'
2272    lt $I0, $I1, nextchar
2273
2274# Number
2275    .local string snum
2276    snum = ''
2277
2278    snum = concat snum, c
2279    #say value
2280nextnum:
2281    ge i, l, endnum
2282    c = substr line, i, 1
2283    eq c, '.', floatnum
2284    $I0 = ord c
2285    $I1 = ord '9'
2286    gt $I0, $I1, endnum
2287    $I1 = ord '0'
2288    lt $I0, $I1, endnum
2289    inc i
2290
2291    snum = concat snum, c
2292    #say value
2293    goto nextnum
2294endnum:
2295    .local int value
2296    value = snum
2297    objres = new 'Integer'
2298    objres = value
2299    goto doit
2300
2301floatnum:
2302    snum = concat snum, c
2303    inc i
2304nextfloat:
2305    ge i, l, endfloat
2306    c = substr line, i, 1
2307    $I0 = ord c
2308    $I1 = ord '9'
2309    gt $I0, $I1, endfloat
2310    $I1 = ord '0'
2311    lt $I0, $I1, endfloat
2312    inc i
2313    snum = concat snum, c
2314    goto nextfloat
2315
2316endfloat:
2317    .local num floatvalue
2318    #say snum
2319    floatvalue = snum
2320    objres = new 'Float'
2321    objres = floatvalue
2322    goto doit
2323
2324operator:
2325    result = c
2326    goto endtoken
2327
2328nextchar:
2329    result = concat result, c
2330    ge i, l, endtoken
2331    c = substr line, i , 1
2332    eq c, ' ', endtoken
2333    eq c, "\n", endtoken
2334    eq c, '"', endtoken
2335    eq c, '.', endtoken
2336    eq c, ',', endtoken
2337    eq c, ';', endtoken
2338    eq c, '=', endtoken
2339    eq c, '+', endtoken
2340    eq c, '-', endtoken
2341    eq c, '*', endtoken
2342    eq c, '/', endtoken
2343    eq c, '^', endtoken
2344    eq c, '<', endtoken
2345    eq c, '>', endtoken
2346    eq c, '(', endtoken
2347    eq c, ')', endtoken
2348    eq c, '[', endtoken
2349    eq c, ']', endtoken
2350    inc i
2351    goto nextchar
2352endtoken:
2353    objres = new 'String'
2354    objres = result
2355    goto doit
2356
2357str:
2358    ge i, l, endstr
2359    c = substr line, i, 1
2360    inc i
2361    eq c, '"', checkquote
2362    result = concat result, c
2363    goto str
2364checkquote:
2365    ge i, l, endstr
2366    c = substr line, i, 1
2367    ne c, '"', endstr
2368    inc i
2369    result = concat result, c
2370    goto str
2371endstr:
2372    objres = new 'Literal'
2373    objres = result
2374    goto doit
2375
2376endline:
2377#    last = new 'Undef'
2378    null last
2379    setattribute self, 'last', last
2380    .local pmc none
2381#    none = new 'Undef'
2382    null none
2383    .return(none)
2384
2385doit:
2386    pos = i
2387    last = clone objres
2388    setattribute self, 'last', last
2389    .return(objres)
2390.end
2391
2392#-----------------------------------------------------------------------
2393.sub back :method
2394    $P0 = getattribute self, 'last'
2395    setattribute self, 'pending', $P0
2396.end
2397
2398#-----------------------------------------------------------------------
2399.sub getall :method
2400    .local string line
2401    $P0 = getattribute self, 'line'
2402    line = $P0
2403    .local pmc pos
2404    pos = getattribute self, 'pos'
2405    .local int i, l
2406    l = length line
2407    i = pos
2408loop:
2409    ge i, l, endline
2410    .local string c
2411    c = substr line, i, 1
2412    inc i
2413    eq c, ' ', loop
2414    eq c, "\n", endline
2415    dec i
2416endline:
2417    .local string str
2418    str = substr line, i
2419    .return(str)
2420.end
2421
2422########################################################################
2423
2424.namespace ['Program']
2425
2426#-----------------------------------------------------------------------
2427.sub init :vtable
2428    .local pmc text
2429    .local pmc lines
2430
2431    # say 'Program.init'
2432
2433    text = new 'Hash'
2434    lines = new 'ResizableIntegerArray'
2435    setattribute self, 'text', text
2436    setattribute self, 'lines', lines
2437.end
2438
2439#-----------------------------------------------------------------------
2440.sub elements :method :vtable
2441    .local pmc text
2442    text = getattribute self, 'text'
2443    $I0 = text
2444    .return($I0)
2445.end
2446
2447#;-----------------------------------------------------------------------
2448.sub get_string_keyed :vtable
2449    .param pmc key
2450
2451    #say key
2452
2453    .local pmc text
2454    text = getattribute self, 'text'
2455    $S0 = text[key]
2456    .return($S0)
2457.end
2458
2459#-----------------------------------------------------------------------
2460.sub begin :method
2461    .local pmc text
2462    text = getattribute self, 'lines'
2463    iter $P0, text
2464    set $P0, .ITERATE_FROM_START
2465    .return($P0)
2466.end
2467
2468#-----------------------------------------------------------------------
2469.sub storeline :method
2470    .param int linenum
2471    .param string line
2472
2473    .local pmc text, lines
2474    .local int n, i, j, curnum
2475    text = getattribute self, 'text'
2476    lines = getattribute self, 'lines'
2477    n = lines
2478    i = 0
2479next:
2480    ge i, n, storenum
2481    curnum = lines [i]
2482    ge curnum, linenum, storeit
2483    inc i
2484    goto next
2485storeit:
2486    eq curnum, linenum, storeline
2487    j = n
2488nextmove:
2489    dec j
2490    curnum = lines [j]
2491    lines [n] = curnum
2492    dec n
2493    gt n, i, nextmove
2494storenum:
2495    lines [i] = linenum
2496storeline:
2497    text [linenum] = line
2498.end
2499
2500#-----------------------------------------------------------------------
2501.sub deleteline :method
2502    .param int linenum
2503    .local pmc text, lines
2504    .local int n, i, j, curnum
2505    text = getattribute self, 'text'
2506    lines = getattribute self, 'lines'
2507    n = lines
2508    i = 0
2509next:
2510    ge i, n, notexist
2511    curnum = lines [i]
2512    ge curnum, linenum, foundnum
2513    inc i
2514    goto next
2515foundnum:
2516    gt i, n, notexist
2517    delete text[linenum]
2518    delete lines[i]
2519    .return()
2520notexist:
2521
2522.end
2523
2524#-----------------------------------------------------------------------
2525.sub load :method
2526    .param string filename
2527
2528    .local pmc file
2529    .local string line
2530    .local pmc tokenizeline
2531    .local pmc token
2532    .local int linenum
2533    .local int linecount
2534
2535    #say filename
2536
2537    open file, filename, 'r'
2538
2539    linecount = 0
2540nextline:
2541    line = readlinebas(file)
2542    unless line goto eof
2543    unless linecount == 0 goto enterline
2544    $S0 = substr line, 0, 1
2545    if $S0 == '#' goto nextline
2546enterline:
2547    inc linecount
2548    tokenizeline = newTokenizer(line)
2549    token = tokenizeline.'get'()
2550    linenum = token
2551    unless linenum goto fail
2552    line = tokenizeline.'getall'()
2553    self.'storeline'(linenum, line)
2554    goto nextline
2555
2556eof:
2557    close file
2558    $I0 = self.'elements'()
2559    unless $I0 == linecount goto fatal
2560    .return()
2561
2562fail:
2563    SyntaxError()
2564fatal:
2565    FatalError('Incorrect count when loading file')
2566.end
2567
2568#-----------------------------------------------------------------------
2569.sub save :method
2570    .param string filename
2571
2572    .local pmc file
2573    .local pmc program
2574
2575    open file, filename, 'w'
2576
2577    self.'list'(0, 0, file)
2578
2579    close file
2580.end
2581
2582#-----------------------------------------------------------------------
2583.sub list :method
2584    .param int start
2585    .param int stop
2586    .param pmc file :optional
2587    .param int has_file :opt_flag
2588
2589    if has_file goto do_list
2590    file = getstdout
2591do_list:
2592    gt start, stop, finish
2593    .local pmc lines, text
2594    lines = getattribute self, 'lines'
2595    text = getattribute self, 'text'
2596
2597    .local int i, n, linenum
2598    .local string content
2599    n = lines
2600#    say n
2601    i = 0
2602nextline:
2603    ge i, n, finish
2604    linenum = lines [i]
2605    lt linenum, start, skip
2606    unless stop > 0 goto list_it
2607    gt linenum, stop, finish
2608list_it:
2609    content = text [linenum]
2610    print file, linenum
2611    print file, ' '
2612    print file, content
2613    print file, "\n"
2614skip:
2615    inc i
2616    goto nextline
2617finish:
2618.end
2619
2620########################################################################
2621# Local Variables:
2622#   mode: pir
2623#   fill-column: 100
2624# End:
2625# vim: expandtab shiftwidth=4 ft=pir:
2626