-
-
Notifications
You must be signed in to change notification settings - Fork 3
/
pmain.e
15427 lines (14610 loc) · 581 KB
/
pmain.e
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
--
-- pmain.e
--
-- The main guts of the compiler.
--
-- DEV this might need to be in pHeap.e (:%pGetMCHK?): (so that pAlloc can store 0 in the era)
-- it may also want to be "with memory_leak_checking/full_memory_leak_checking"
--global constant NEWRETSLOT = 01 -- nb toggle in tandem with pStack/opRetf
global constant MARKTYPES = 0
global constant K_RIDT_UDTS = false -- added 28/02/19
global constant NEWGSCAN = false -- added 01/03/19 (note: if set, K_RIDT_UDTS is ignored, check MARKTYPES as well)
-- (for NEWGSCAN; move these to pglobals.e when done:)
global sequence g_scan, kridt_scan
-- g_scan is created as repeat(0,length(symtab)) on each iteration (actually kridt_scan, see below).
-- As we encounter each opFrame/opTchk, in routine vi [initially T_maintls==21], if g_scan[rtn]=0
-- then insert into chain, ie g_scan[rtn]:=g_scan[vi]; g_scan[vi]:=rtn.
-- However some "scannables" need to be more permanent, specifically when K_ridt is set on them.
-- The same principle is applied to (both g_scan and) kridt_scan, and in fact we re-initialise
-- g_scan from kridt_scan at the start of each iteration, rather than all-zero it.
-- This replaces (some) prior use of [S_Slink] and fixes the type-routine issue, as well as
-- doing a much better job of excluding routines due to constant propagtion effects.
-- Note that g_scan[T_maintls] (ditto kridt_scan) is initially "-1" as the chain terminator.
-- (It uses a string to prevent any chance of accidentally treating it as symtab[$].)
global constant NEWCATCH = 01
global constant NESTEDFUNC = 01
global constant FWARN = 01
--global constant useFLOAT = 01
global constant MCHK = 0 -- 0 = off, 1 = on
-- Note that MCHK is ignored if opLntpcalled!=0 or length(ptab)!=0, as otherwise
-- opLnp/t will leave random floats etc on the "wrong heap"
-- and therefore trigger spurious memory leak errors.
global constant ORAC = 1 -- adds int/eger seq/uence ~/length to/.. features.
-- note this disables s[end], just use s[$] instead
--SUG: check types and side-effects on auto-includes.
--
-- Programming notes: (some general tips regarding bugs etc in p.exw itself)
-- =================
-- index out of bounds caused by opstack[opsidx[-1/2/3]] of 0: if emitON is 0, there
-- is probably a missing "if emitON then" wrapper at that point.
-- The missing entry from the test set is "constant DEBUG=0" with
-- "if DEBUG then <any & all possible code constructs> end if",
-- which ought to do nothing except compile cleanly.
-- try "p p -cp" when "p -cp" fails. Certainly any change to the calling convention for
-- the backend VM (usually) requires this, similar build problems
-- have occured with #ilasm/updates to iload in pttree.e, and with
-- some changes to #isginfo handling.
--erm:
-- stuff I rule out includes: goto: see notes/alternative in pops.e
-- preprocessing/macros: make the compiler smarter rather
-- than make it handle two different interlaced languages.
-- no proven gain: don't care about "want", need proof.
-- try whacky ideas yourself, be not premature with them.
-- because C does it like that: so what? Go use C then.
-- open-source forks of the compiler are welcome, closed source ones are forbidden.
--
-- For a description of with/without console/gui, see file:docs/pfeat.htm#console
--
--DEV temp. removed (as it now triggers use of new emit, try putting back once pth works!)
--!/**/format "p.fmt"
----with gui 4.0 -- pw.exe/see verify_build() etc below
--!/**/with console 4.0 -- p.exe (this program does not run on RDS Eu!)
--DEV (this wants to be in a common file for p.exw/pth.exw)
--format PE32 4.0
--version { "FileDescription","Phix Programming Language",
-- "LegalCopyright","Pete Lomax",
-- "FileVersion","0.6.3",
-- "ProductName","Phix Programming Language",
-- "ProductVersion","0.6.3",
-- "OriginalFilename","pw.exe" }
--
-- Warning: it is not wise to trace/profile the compiler whilst that is also
-- trying to trace/profile a user app. In particular, "p p test" may
-- crash (error code 91) when one of these is enabled.
-- Update: I have stopped attempts to "share" a copy of pdebug.e and
-- as long as pdiag.e (which remains "shared") has "without debug",
-- this now seems better, albeit the sanity remains questionable...
--
--with profile_time
--with profile
--include demo\arwen\arwen.ew
--include demo\arwen\axtra.ew
--include builtins\timestamp.ew
--without trace
--without type_check
--with trace
--with type_check
--without debug -- no gain
--!/**/without licence -- Disable licencing, since it quite deliberately cripples
-- -- most of the core compiler/interpreter functionality.
-- -- (You may freely share modified compiler sources, with a
-- -- an "official" p.exe binary to recompile them, however
-- -- you may NOT ship a pre-built/closed source p.exe.)
-- -- (TIP: If you add a language construct, think twice before
-- -- using it in p.exw itself, otherwise you may need to
-- -- ship two versions of the modified compiler source.
-- -- Not that running p temp\pold -cp is a major burden
-- -- over "p -cp", as a one-time installation task.)
global integer bind = 0 -- set by -c, -listing command line options (create .exe file)
global integer repl = 0 -- set by -repl command line option (read eval print loop)
global constant replDSvsize = 8032
global integer testall = 0
global integer pauseOnWarnings = 01 -- only used if testall!=0 (which it is for final file)
-- note there is a "copy" of this in pdiag.e:
global integer batchmode = 0 -- set by -batch command line option
-- 1=suppress displays/prompts [incomplete]
--PL 5/10/21 (moved to pglobals.e/renamed as safe_mode)
--global integer safemode = false -- if true, running under -safe command line option.
global integer norun = 0 -- set by -norun, -listing command line options
global integer nodiag = 0 -- set by -nodiag command line option
-- (can make list.asm easier to follow)
global integer listing = 0 -- set by -listing command line option (also sets norun & bind)
-- (aka -d, -dump, -l, -list, command line option)
-- -1 indiates -d! (interpretive dump) listing
--DEV should no longer need this (rsn)
global integer listimports = 0 -- set by -import(s) command line option
-- 1 just dumps the import section to screen
global constant suppressopRetf = 0 -- debug aid, should be 0 in all releases
if suppressopRetf then
puts(1,"warning (p.exw line 107): suppressopRetf is ON\n")
end if
--DEV this is not properly implemented yet; needs to do a full gvar_scan in pemit.e,
-- process #isginfo/opGchk properly, etc. (pltype.e should be OK)
-- (btw, apart from completely ignoring "without warning", this would/should not
-- give you any more info than -c already does...)
global integer lint = 0 -- set by -lint command line option
-- (nb all x[i] = c_func will give warnings)
global integer dumpil = 0 -- set by -dumpil command line option
-- (nb only suitable for small programs/compiler debugging,
-- and also: not all errors/warnings will be displayed.)
global integer dilfn = 1 -- for use with dumpil option, output file "ildump.txt"
-- (opened here, written in pilx86, closed in pemit.e)
global integer minus_e = false -- if true, -e "pgm"; ie no source file.
global constant showfileprogress = 0 -- show files, times, etc.
global constant collectstats = 0 -- see opStat, profile.e, eg emitHex5(), Branch().
-- WARNING: this (=1) is currently broken.
global constant countTransTmpFer = 0 -- if set, writes a table of instructions which
-- might be suitable for tmptransfer, sorted in
-- order of occurrence, to ildump.txt only.
-- NB: does nowt else, and collects "consumers"
-- only, not potential producers (see pilx86.e).
global constant showOpCounts = 0 -- if set, writes a table of opcodes in order
-- of number of times ilxlate() processed them.
if countTransTmpFer then
if showOpCounts then ?9/0 end if -- these (debug) options are mutually exclusive!
end if
global constant AutoIncWarn = 01 -- If 1, warn when files are auto-included.
-- NB only has effect under -lint.
--include pcore.e
--include p6core.e
--
-- pcore.e
--
-- common incudeset for p.exw and pgui.exw
--
include pglobals.e
include builtins\ppp.e
include pops.e -- opcode table
include pttree.e -- ternary tree
include pmsgs.e -- Warnings/Warn/Abort/Duplicate/Expected/Fatal/Undefined
include ptok.e -- tokeniser: getToken()
--include p6tok.e -- tokeniser: getToken()
include pltype.e -- localtypes handling
include psym.e -- symbol table handler.
--include p6sym.e -- symbol table handler.
include pilx86.e -- ilxlate(), (also includes psched.e)
--7/4/16:
--global sequence code_section
global string code_section
global integer CSvsize, DSvsize
--25/4/16: (pHeap.e now using mmap)
--global integer CSvaddr, DSvaddr, ImageBase, VMvaddr, VMraddr, DVraddr, VMvsize --DEV temp, for listing
global atom CSvaddr, DSvaddr, ImageBase, VMvaddr, VMraddr, DVraddr, VMvsize --DEV temp, for listing
global string divm -- used by p2asm.e if dumpVM=1
global sequence VMep -- used by p2asm.e [DEV]
--include pemit.e
--include p6emit.e
include pEmit2.e
--DEV this does not appear in Edita's project tree... (Finc thing??)
--include pdebug.e -- trace routines
include VM\pTrace.e -- trace routines
--DEV: kill off paramLines, opsline, calltokline (inc temp code in Warn()),
-- tok_abort_line, wascalltokline, lblline, rtntokline, notumline,
-- sqline, relopline, savetokline, eqline,
-- (can opLchk and opGchk be shortened? if the latter then
-- also kill tl in isginfo().)
-- move this to bpset? pglobals?
-- On forward called routines, which have not yet or are in the
-- process of being defined, [S_il] takes the form:
-- {callset} -- (one set for each call)
-- where callset is
-- {{tokcol, fileno, routineNo}, -- (for error reporting)
-- {tokcol, offset[, ttidx, tokcolp]}}) -- (one per param)
-- ie after bcptr=symtab[N][S_il], then length(bcptr) is the
-- number of forward calls to routine N, which need to get
-- backpatched when it is actually defined, and likewise after
-- bi=bcptr[i], then bi[1] locates the call statement and the
-- remainder are either:
-- {tokcol,offset}
-- for normal/numbered parameters, or for named parameters:
-- {tokcol,offset,ttidx,tokcolp}
-- eg plonk(o,ctab:=table) might create a symtab[555][S_il] of:
-- {{{7746,3,427}, -- called at 7746th character of file 3,
-- -- somewhere within routine number 427.
-- {7774,35}, -- symtab[427][S_il][35] needs p1. Report
-- -- any error (type, too many) at ch 7774.
-- {7783,40,3764,7778}}} symtab[427][S_il][40] needs the
-- -- parameter which has a ttidx/[S_Name]
-- -- of 3764. Report any error with "table"
-- -- at ch 7783; if plonk has no parameter
-- -- named "ctab", report that at ch 7778.
-- Any length 2 (ie numbered) params are always at the start;
-- it makes no sense to permit eg p(1,2,p7:=7,8), since it
-- is just a bit too ambiguous where the 8 goes, plus if you
-- know there is a parameter called p7, then almost certainly
-- you know the name of the parameter the 8 is meant for.
-- While the total number of parameters is length(bi)-1, the
-- presence of named parameters means a more detailed check
-- may be required.
--
-- The amusing/interesting/confusing thing about forward calls
-- is that we are using a dummy X to specify the changes we
-- need in other X when we get round to creating a real X.
-- (for X read "routine" or "parameter" or "[S_il]"...)
--
sequence opstack, opstype, opsltrl, opsline, opstcol
opstack = repeat(0,4) -- var nos [index to symtab] or opcode [see also opTopIsOp]
opstype = repeat(0,4) -- eg T_integer, or UDT, -1 for ops/literals, -2 on stack
opsltrl = repeat(0,4) -- 0 (No), 1 (Yes), or allowTempReuse(-1) for temps
opsline = repeat(0,4) -- for error reporting
opstcol = repeat(0,4) -- ""
--procedure validate_opstack()
-- for i=1 to length(opstack) do
-- isInt(opstack[i],1)
-- end for
--end procedure
-- Technical/Linguistic point: The notion of "literal" bears some consideration.
-- The 1 and "hello" in say puts(1,"hello") are literals; the implicit 2 (ie
-- number of subscripts) in say s[5][6] is NOT a "literal" in this context,
-- but rather the same (opstype[]=-1) as opSubse.
-- verify that the compiler is setting these as "sequence of integer":
--DEV broken 23/4/21 (repeat.e) - fixme!
--!/**/ #isginfo{opstack,0b0100,MIN,MAX,integer,-2}
-- ^ gInfo is {10394,12,-1073741824,1073741823,15,-2}
--!/**/ #isginfo{opstype,0b0100,MIN,MAX,integer,-2}
--!/**/ #isginfo{opsltrl,0b0100,MIN,MAX,integer,-2}
--!/**/ #isginfo{opsline,0b0100,MIN,MAX,integer,-2}
--!/**/ #isginfo{opstcol,0b0100,MIN,MAX,integer,-2}
-- var, type, min,max,etype, len
-- #isginfo emits no code or otherwise alters compiler behaviour, it
-- just verifies the result of gvar_scan. See pemit.e for details.
integer opsidx = 0 -- index to above
integer opsidxm1, opsidxm2, opsidxm3
integer isGlobal -- set when "global" found
isGlobal = 0 -- (0==false, 1==true, 2==export)
integer opTopIsOp = 0 -- zero or one of the following groups
constant UnaryOp = 1,
MathOp = 2,
ConcatOp = 3,
BranchOp = 4,
LogicOp = 5,
BltinOp = 6,
SubscriptOp = 7,
SliceOp = 8,
MkSqOp = 9,
NotBltinOp = 16 -- opInt..opSq (opINSP) at least for for now
-- NotSubscriptOp = 17 -- not actually used, but logically this does exist (search comments).
--integer LastStatementWasAbort -- now in pglobals.e, for pilx86.e
integer onDeclaration = 0 -- eg "object x=e" or "object x x=e" forms, no check/dealloc rqd on x. [DEV: BLUFF]
-- also used for "constant y=e", some first ever uses of a var, and
-- all param setup between opFrame and opCall (since opFrame saves
-- and then clears all params [and local vars and temps]).
integer exitBP = -1, -- exit backpatch chain (0 terminated), -1: not valid(not inside a loop)
continueBP = -1, -- continue """
breakBP = -1, -- break backpatch "" "" switch
if_level = 0 -- 0: not inside an if construct (for nested function handling)
-- moved to pglobals 1/10/2011:
--integer returnvar -- -1: top_level/return illegal, 0: in a proc, +ve: func/type return var (symtab idx)
-- returnvar = -1 -- - see DoRoutineDef/DoReturn for more details.
integer returntype = -1 -- best guess so far of the return type
integer returnint = 0 -- 1: this is a type, ie a function which should return 0 or 1.
--
-- Probable Logic Errors (ple, aka plausibility tests) are things like:
-- =====================
--
-- integer i
-- ...
-- if sequence(i) then
-- ^ warning: probable logic error (always false)
-- object x
-- if sequence(x) then
-- ...
-- elsif atom(x) then
-- ^ warning: probable logic error (always true)
--
-- All "probable logic errors" are given as warnings.
-- These messages extend to user defined types and derivatives.
-- It is also possible to get these messages for subscripts in
-- cases where the compiler has proved the sequence only ever
-- contains elements of that type, for example in:
-- string t
-- t = "fred"
-- if integer(t[2]) then
--
-- Note that "if atom(i) then" and "if not atom(i) then" give
-- the same (always true) message, ie it is "atom(i)" which
-- is always true, rather than [say] "not atom(i)".
--
-- Also note that should the compiler detect that parameter X is only
-- ever assigned an integer, an "integer(X)" test (etc) does /NOT/
-- give a ple, otherwise general purpose code in library routines
-- would get spannered by small programs that use it "lightly".
-- Even better, the compiler quietly suppresses code generation for
-- the bits that would never be executed, ie any code in an always
-- false test, as well as any always true or always false tests.
--
integer probable_logic_error = 0 -- a "used count".
sequence plecol = repeat(0,4),
pleline = repeat(0,4),
pletruth = repeat(0,4)
-- verify compiler gets these right:
--DEV broken 23/4/21 (repeat.e) - fixme!
--!/**/ #isginfo{plecol,0b0100,MIN,MAX,integer,-2}
-- ^ gInfo is {10422,12,-1073741824,1073741823,15,-2}
--!/**/ #isginfo{pleline,0b0100,MIN,MAX,integer,-2}
--!/**/ #isginfo{pletruth,0b0100,MIN,MAX,integer,-2}
procedure add_ple(integer truth)
if emitON then -- test added 29/12/2011
probable_logic_error += 1
if probable_logic_error>length(plecol) then
plecol &= repeat(0,4)
pleline &= repeat(0,4)
pletruth &= repeat(0,4)
end if
plecol[probable_logic_error] = opstcol[opsidx]
pleline[probable_logic_error] = opsline[opsidx]
pletruth[probable_logic_error] = truth
end if
end procedure
procedure show_ple()
sequence tf
for i=probable_logic_error to 1 by -1 do
if pletruth[i] then
tf = "true)"
else
tf = "false)"
end if
Warn("probable logic error (always "&tf,pleline[i],plecol[i],0)
end for
probable_logic_error = 0
end procedure
global procedure Aborp(sequence msg)
if probable_logic_error then show_ple() end if
Abort(msg)
end procedure
procedure Abork(sequence msg, integer k)
tokline = opsline[k]
tokcol = opstcol[k]
Aborp(msg)
end procedure
bool not_js = false, -- catch "with js" occurring too late...
nested_locals = false, -- "with nested_locals" in force?
nested_globals = false -- "with nested_globals" in force?
string nj_reason
constant WITH=1, WITHOUT=0, FROMROUTINE=1
procedure DoWithOptions(integer OptOn, integer fromroutine=0)
integer k
getToken()
if toktype=LETTER then
k = find(ttidx,{T_profile, T_profile_time, T_trace, T_warning, T_type_check, T_debug})
if lint and k=OptWarning then
-- ignore/do nowt
getToken()
if toktype=LETTER and ttidx=T_strict then getToken() end if
return
elsif k then
if k=OptProfile
or k=OptProfileTime then
if OptOn then
if profileon and profileon!=k then
Aborp("cannot mix profile and profile_time")
end if
profileon = k
end if
--/*
-- --added 7/7/16:
-- optset[k] = OptOn
-- --DEV (spotted in passing) 28/6/16: I think I messed up for profile/profile_time...
-- -- elsif k=OptWarning then
-- -- finalOptWarn[fileno] = OptOn
-- -- end if
-- -- optset[k] = OptOn
-- elsif testall then
-- if k=OptWarning then
-- finalOptWarn[fileno] = OptOn
-- end if
-- optset[k] = OptOn
-- elsif k!=OptWarning then
-- optset[k] = OptOn
-- end if
--*/
elsif k=OptWarning then
finalOptWarn[fileno] = OptOn
--11/5/21:
-- elsif k=OptTrace and OptOn and with_js=1 then
-- Aborp("cannot mix with trace and with js")
end if
--p2js:
optset = deep_copy(optset)
optset[k] = OptOn
--10/10/2020:
-- if k=OptDebug and not OptOn and not fromroutine then
-- clearTLSDebug()
if k=OptDebug and not fromroutine then
clearTLSDebug(OptOn)
end if
getToken()
if toktype=LETTER and ttidx=T_strict then getToken() end if
return
elsif not fromroutine then
if ttidx=T_console
or ttidx=T_gui then -- DEV (both) deprecated (see DoFormat)
if ttidx=T_gui then
-- gui is antonym for console, ie
-- with gui == without console
-- without gui == with console
-- (the "with" forms should always be used, for readability's sake, but
-- it is harder to ban the "without" forms than it is to support them.)
OptOn = not OptOn
end if
OptConsole = OptOn
getToken(float_valid:=true)
if toktype=FLOAT or toktype=DIGIT then
-- optional subversion
if equal(TokN,3.10) then
getToken()
subvers = #000A0003 -- messes up gui, obviously
elsif equal(TokN,4.0) then
getToken()
subvers = #00000004 -- this is the default, btw
elsif equal(TokN,5.0) then
getToken()
subvers = #00000005 -- the 64-bit default, btw
else
Aborp("3.10, 4.0, or 5.0 expected")
end if
end if
return
elsif ttidx=T_licence then
if not newEmit then
if OptOn then Abort("invalid") end if
OptLicence = 0
getToken()
return
end if
elsif ttidx=T_indirect_incs
or ttidx=T_inline then
-- (OpenEuphoria only, ignored by Phix)
getToken()
return
elsif ttidx=T_js
or ttidx=T_javascript
or ttidx=T_js_semantics then
--?"with js"
if with_js!=2 and with_js!=OptOn then
Aborp("cannot mix with and without js")
elsif with_js=2 and OptOn and not_js then
Aborp("p2js violation already skipped ("&nj_reason&")")
end if
--11/5/21:
-- if optset[OptTrace] and OptOn then
-- Aborp("cannot mix with js and with trace")
-- end if
with_js = OptOn
getToken()
-- no need, done directly in p.exw/main():
-- s5 &= {opWithJS,flag}
return
--5/10/21:
elsif ttidx=T_safe_mode then
if not OptOn then Aborp("meaningless") end if
safe_mode = 0
getToken()
return
elsif ttidx=T_nested_globals then
nested_globals = OptOn
getToken()
return
elsif ttidx=T_nested_locals then
nested_locals = OptOn
getToken()
return
end if
end if
elsif toktype=DIGIT
or toktype=FLOAT then
-- old stamped file?
Warn("if that is a stamp, then this is a /very/ old file.\n"&
" It is probably worth getting a newer one.",tokline,tokcol,0)
getToken()
return
end if
Aborp("unrecognised option")
end procedure
constant pbrON=1
--
-- Automatic pass by reference optimisation:
-- First, consider function myfunc(object x) and a line of code such as s = myfunc(s).
-- For clarity, when I refer to s I mean lhs of the caller, rather than the copy in x.
-- In the simplest case, then if s is a local, it /cannot/ be referenced in myfunc,
-- although of course x has a copy of the value. So rather than incref s we can just
-- "move" it to x and make s unassigned over the call. The same cannot be said when
-- s is a global or file-level variable. Some complications arise in a statement such
-- as s = r & s[1..match(".html",s)-1]; we cannot unassign s over the call to match()
-- since we need it again before it gets re-assigned. We set lhsvar and zero lhspos
-- in Assignment() when the lhs is a plain (non-subscripted) tvar, lhspos is set to
-- the position of an onDeclaration flag, which is set after the full expression has
-- been parsed to 2, meaning that pilx86 should apply pbr, taking care to zero lhsvar
-- (and therefore ignore lhspos) if multiple uses or subscripts etc are detected.
-- Note [DEV] multiple assignment does not (yet) have pbr optimisation applied.
-- Also note that pbinary.e in particular is written in such a way that it would
-- suffer terrible performance degradation should automatic pbr stop working, see
-- SetField() for example - you would have to replace
-- res = SetField(res,...)
-- with a file-level res and
-- res = local
-- local = {}
-- SetField(...)
-- local = res
-- res = {}
-- to get anywhere near a similar level of performance.
--
integer lhspos = 0, -- locates the onDeclaration flag
lhsvar = 0
--
-- The core workspace. Expresssions get pushed on here in Reverse Polish
-- (eg 1,2,+) and either get stored into the result var or a temporary
-- var when attempting to push another value/opcode atop an op, ie/eg
-- "(1+2)*3" -> {1,2,+} -> {tmp,3,*}.
-- "1+2*3" -> {1,2,3,*} -> {1,tmp,+}.
--
--procedure isInt(object o, integer f)
-- if integer(o)!=f then ?9/0 end if
--end procedure
--isInt("",0)
-- moved to psym.e 27/8/14:
----with trace
--global -- for pilasm.e
--procedure apnds5(object code)
--integer opLnv
----/**/ #isginfo{code,0b0101,MIN,MAX,integer,-2} -- (integer|dseq of integer), any length
----/**/ #isginfo{s5,0b0100,MIN,MAX,integer,-2} -- (as good a place as any to check this)
-- if lastline!=emitline then
----DEV why oh why is this not just part of DoWithOptions?! (and optset=)
-- opLnv = opLn
-- if not bind then
-- if optset[OptProfile] then opLnv = opLnp
---- elsif optset[OptProfileClone] then opLnv = opLnpclone
---- elsif optset[OptProfileCoverage] then opLnv = opLnpcover
-- elsif optset[OptProfileTime] then opLnv = opLnpt
-- elsif optset[OptTrace] then opLnv = opLnt
-- end if
-- end if
-- s5 = append(s5,opLnv) -- opLn/p/pt/t
-- s5 = append(s5,emitline)
-- lastline = emitline
----if emitline=7 then trace(1) end if
-- end if
-- s5 &= code
--end procedure
--with trace
constant allowTempReuse = -1 -- Yes value
--without trace
procedure freeTmp(integer howmany)
if reusetmps then
while howmany do
if opsltrl[opsidx]=allowTempReuse then
--and opstype[opsidx]!=-1 (maybe?)
integer N = opstack[opsidx]
if N then
object si = symtab[N]
if si[S_NTyp]=S_TVar -- a tvar (doh!)
and equal(si[S_Name],-1) -- unnamed
and not and_bits(si[S_State],K_Fres) then -- but not a return var
si = si[S_vtype] -- (also kills refcount on symtab[N], btw)
--p2js:
-- symtab[N][S_Nlink] = freetmplists[si]
-- symtab[N][S_ltype] = si -- bugfix 9/4/9 (ltype:=vtype)
sequence sN = deep_copy(symtab[N])
sN[S_Nlink] = freetmplists[si]
sN[S_ltype] = si
symtab[N] = sN
--</p2js>
freetmplists[si] = N
end if
opsltrl[opsidx] = 0
end if
end if
opsidx -= 1
howmany += 1
end while
else
opsidx += howmany
end if
end procedure
-- now in pilx86.e:
--constant Bcde = {opJlt,opJle,opJeq,opJne,opJge,opJgt},
---- ie { "<" ,"<=","=(=)", "!=", ">=",">" }, -- (= and == treated the same, for now)
-- Scde = {opSlt,opSle,opSeq,opSne,opSge,opSgt},
---- cc={jl_rel32,jle_rel32,je_rel32,jne_rel32,jge_rel32,jg_rel32},
---- scOp = {setl, setle,sete, setne,setge,setg},
-- tnot = { 5, 6, 4, 3, 1, 2 },
---- i.e. jge jg jne je jl jle
-- eJmp = { 0, 0, 1, 1, 0, 0 } -- equality tests (when either is an integer)
---- i.e. BOTH,BOTH,EITHER,EITHER,BOTH,BOTH -- eg/ie 1.1=1 can be tested using alu/cmp,
-- -- but say 1.1>1 needs fld/fcmp/fnstsw etc.
-- chain of items to "uninitialise" on else, elsif, end if, end for, end while, end routine.
integer Ichain
Ichain = -1
integer oIItype -- scratch/rootType from a oneInitialisedInt call if S_Init
oIItype = 0
integer constInt -- only valid if oneInitialisedInt has just been called, or set manually
constInt = 0
atom constIntVal -- "", meaningless unless constInt=True
constIntVal = 0
integer oktoinit -- avoid marking vars init in short-circuit cases
oktoinit = 1
--without trace
function oneInitialisedInt(integer N, integer markInit)
oIItype = 0
if not emitON then return 0 end if --DEV would 1 be better?
sequence symtabN = symtab[N] -- (do this once not 4 times below)
constInt = (symtabN[S_NTyp]=S_Const)
if not symtabN[S_Init] then
-- non-init S_Const are treated as init vars
if not constInt then
if oktoinit and markInit then
symtab[N] = 0
symtabN[S_Init] = Ichain
symtab[N] = symtabN
Ichain = N
end if
return 0
end if
constInt = 0
end if
-- oIItype = rootType(symtabN[S_vtype])
-- oIItype = rootType(symtabN[S_ltype])
oIItype = symtabN[S_ltype]
if oIItype>T_object then oIItype = rootType(oIItype) end if
-- oIItype = symtabN[S_ltype] --NO!
--DEV change param to oneInitialisedInt() to opsidx/k and use opstype[opsidx],N=opstack[opsidx]...?
if oIItype!=T_integer then return 0 end if
if constInt then
-- if not integer(symtabN[S_value]) then return 0 end if
if isFLOAT(symtabN[S_value]) then return 0 end if
constIntVal = symtabN[S_value]
end if
return 1
end function
-- for inc,dec,div2 optimisations, etc:
atom secondintval -- only ever tested for >=-1, iff twoInitInts() returns true
secondintval = -2
integer firstintval -- only ever tested for >=-1, iff twoInitInts() returns true
firstintval = -2
--integer bothconst -- only valid if twoInitInts() returns true,
-- bothconst = 0 -- not actually used anywhere [yet] [DEV]
integer bothInit -- alt rv for twoInitInts(). Valid except in the emitON=0
-- case, when we don't care anyway.
--with trace
constant BOTH = 0 --, EITHER = 1 -- nb should match eJmp
function twoInitInts(integer either)
--
-- the top 2 stack items must be initialised else return false, always(/irrespective of "either").
-- if "either" is true then only one of them need be an integer, else both must.
--
integer N1, N2, rInt, const1, const2
sequence symtabN1, symtabN2
bothInit = 1
if not emitON then return 0 end if
opsidxm1 = opsidx-1 -- 2nd int
opsidxm2 = opsidxm1-1 -- 1st int
N1 = opstack[opsidxm2] -- 1st int
N2 = opstack[opsidxm1] -- 2nd int
symtabN1 = symtab[N1] -- 1st int
symtabN2 = symtab[N2] -- 2nd int
const2 = (symtabN2[S_NTyp]=S_Const)
if not symtabN2[S_Init] then
-- non-init S_Const are treated as init vars (ie their value is not
-- known at compile-time but instead gets calculated at run-time;
-- however they always get set before any user code can ref them).
if not const2 then
-- assume eg "if X=1 then" traps a non-init X; subsequent refs
-- to X (until next mergepoint) can/should treat X as init:
if oktoinit then
symtab[N2] = 0
symtabN2[S_Init] = Ichain
symtab[N2] = symtabN2
Ichain = N2
end if
bothInit = 0
return 0
end if
const2 = 0
end if
const1 = (symtabN1[S_NTyp]=S_Const)
if not symtabN1[S_Init] then -- as above
if not const1 then
if oktoinit then
symtab[N1] = 0
symtabN1[S_Init] = Ichain
symtab[N1] = symtabN1
Ichain = N1
end if
bothInit = 0
return 0
end if
const1 = 0
end if
-- rInt = (rootType(symtabN1[S_vtype])=T_integer)
-- rInt = (opstype[opsidxm1]=T_integer) -- 2nd int
rInt = opstype[opsidxm1] -- 2nd int
rInt = (rInt=T_integer)
if either then
either = rInt
else
if not rInt then return 0 end if
end if
-- bothconst = 1
if rInt and const2 then
--3/2/15:
-- if not integer(symtabN2[S_value]) then return 0 end if
if isFLOAT(symtabN2[S_value]) then return 0 end if
secondintval = symtabN2[S_value]
else
secondintval = -2 -- NB only ever test for >=-1
-- bothconst = 0
end if
-- rInt = (rootType(symtabN2[S_vtype])=T_integer)
-- rInt = (opstype[opsidxm2]=T_integer) -- 1st int
rInt = opstype[opsidxm2] -- 1st int
rInt = (rInt=T_integer)
if not rInt and not either then return 0 end if
if rInt and const1 then
firstintval = symtabN1[S_value]
else
firstintval = -2 -- NB only ever test for >=-1
-- bothconst = 0
end if
return 1
end function
--integer N2type
--function twoInit(integer N, integer N2)
---- if not equal(symtab[N][S_Name],-1) then
-- if not symtab[N][S_Init] then return 0 end if
---- end if
-- N2type = symtab[N2][S_vtype] -- ltype?
---- if equal(symtab[N2][S_Name],-1) then return 1 end if
-- return symtab[N2][S_Init]
--end function
--with trace
integer dpos
procedure emitHexMov(integer opcode, integer dest, integer src)
--procedure emitHexMov(integer opcode, object dest, integer src)
integer isInit, ltype
sequence symtabN
if emitON then
dpos=-1
-- opMove,dest,src,Init,onDeclaration,ltype
-- opMovsi,dest,src,Init,onDeclaration
-- opMovti,dest,src,Init
-- opMovbi,dest,src,Init -- (nb 6/10/9 src can be -1)
apnds5({opcode,dest,src})
dpos = length(s5)-1
--6/10/9:
if src=-1 then
-- (force 0/1, from makeBool)
isInit = 0
s5 = append(s5,isInit)
else
symtabN = symtab[src]
isInit = symtabN[S_Init]
--DEV and oktoinit?
--19/3/09:
-- if not isInit then
if not isInit and oktoinit and symtabN[S_NTyp]!=S_Const then
symtab[src] = 0
symtabN[S_Init] = Ichain
symtab[src] = symtabN
Ichain = src
end if
-- if bind and symtabN[S_NTyp]=S_Const then
-- -- assume constants are init when binding
-- -- (can be broken by forward calls from above
-- -- the constant definition, that is when the
-- -- constant cannot be S_lnc'd.)
-- isInit = 1
-- end if
s5 = append(s5,isInit)
if opcode=opMove
or opcode=opMovsi then
s5 = append(s5,onDeclaration)
--DEV opLtyp
if opcode=opMove then
-- s5 = append(s5,rootType(symtabN[S_ltype])) -- (nb T_integer would be opMovsi/bi)
ltype = symtabN[S_ltype] -- (nb T_integer would be opMovsi/bi)
if ltype>T_object then ltype = rootType(ltype) end if
s5 = append(s5,ltype)
end if
end if
end if
end if -- emitON
end procedure
--integer szt = 0
procedure zero_temp(integer tmp)
--if szt then ?{"zero_temp",tmp} end if
if tmp!=0
and symtab[tmp][S_Name]=-1
-- and not and_bits(symtab[tmp][S_State],K_noclr) then
and not and_bits(symtab[tmp][S_State],K_noclr+K_Fres) then
-- (Not entirely sure why the K_noclr check was needed, but t57masgn
-- crashed without it, setting dmin to "22" in pilx86.e/getDest().)
-- Could not get the reusetmps part to work either, then again since
-- it was never doing it before anyway, I guess it's alright...
-- (ah, probably because freeTmp(-1) has already been called?)
--19/10/21
onDeclaration = 0
emitHexMov(opMovsi,tmp,T_const0)
--/*
if reusetmps then
opsidx += 1
opstack[opsidx] = tmp
opsltrl[opsidx] = allowTempReuse
freeTmp(-1)
end if
--*/
end if
end procedure
--without trace
constant NOTINTS=0,
INTSTOO=1,
PUSHEAX=2 -- (implies INTSTOO) [DEV kill me... ?]
--integer fromQU = 0 --DEV tmp (t17incV)
--DEV no idea why opsidx is a parameter... (try removing it and see)
procedure saveFunctionResultVars(integer opsidx, integer intstoo)
--
-- In eg s = {f(1),g(2)}, the f(1) result var is initially left in opstack for
-- the pending (in this particular case) opMkSq call. However, the g(2) (or
-- another direct call to f()) might clobber it, so transfer to a new temp var.
--
integer osi, vtype, state, ttyp, tvar, opMov
sequence symtabN
integer wasemitline
for i=opsidx to 1 by -1 do
osi = opstack[i]
if osi -- skip emitON=0 cases
and opstype[i]!=-1 then -- and skip opcodes/literals (such as no of subscripts)
symtabN = symtab[osi]
vtype = symtabN[S_NTyp]
if vtype=S_TVar then
state = symtabN[S_State]
if and_bits(state,K_Fres) then
if intstoo=PUSHEAX then
wasemitline = emitline
--DEV we should use a flag for this instead[?]
emitline = lastline -- prevent apnds5 fouling eax
-- apnds5(opPushEax)
emitline = wasemitline
else
-- ttyp = rootType(symtabN[S_vtype])
-- ttyp = rootType(symtabN[S_ltype]) --DEV opstype[i]??!! (prolly not!)
ttyp = symtabN[S_ltype]
--if fromQU then
-- printf(1,"symtab[%d][S_ltype] = %d\n",{osi,ttyp})
--end if
if ttyp>T_object then ttyp = rootType(ttyp) end if
--Added 1/4/2012:
if intstoo or ttyp!=T_integer then
--DEV onDeclaration here...? (at toplevel not in a loop anyway)
tvar = newTempVar(ttyp,Shared)
opMov = opMove
if ttyp=T_integer then
constInt = 0 --DEV suspect this is unnecessary..
opMov = opMovbi
end if
wasemitline = emitline
--DEV we should use a flag for this instead[?]
emitline = lastline -- prevent apnds5 fouling eax
emitHexMov(opMov,tvar,osi)
emitline = wasemitline
opstack[i] = tvar
--validate_opstack()
opstype[i] = ttyp
opsltrl[i] = allowTempReuse -- mark for possible re-use
end if
end if
end if
end if
end if
end for
end procedure
procedure WarnX(sequence msg, integer k)
Warn(msg,opsline[k],opstcol[k],0)
end procedure