-
-
Notifications
You must be signed in to change notification settings - Fork 2
/
pemit.e
4143 lines (3932 loc) · 158 KB
/
pemit.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
--
-- pemit.e
--
--constant trimST = 01 --DEV I think this can go now
constant debug = 0
constant show_full_symtab = 0 -- You should NOT want or need to set this to 1.
-- (It was used to improve the use of opCleanup.)
-- If anything, if you are new to symtab dumps you
-- probably want a cut down version - by using the
-- "-nodiag" command line option.
constant -- not global: use only in scanforShortJmp/blurph, not before.
-- isShortJmp = #004000 -- isJmp that has been found to fit in a byte.
isShortJmp = #010000 -- isJmp that has been found to fit in a byte.
-- (fixup as isJmp, patch 5->2 or 6->2)
--function o(integer i)
-- return {floor(i/#40)+'0',floor(and_bits(i,#38)/8)+'0',and_bits(i,7)+'0'}
--end function
--for i=0 to 255 do
-- printf(1,"o%s=#%02x,",{o(i),i})
-- if remainder(i,8)=7 then puts(1,"\n") else puts(1," ") end if
--end for
--abort(0)
--
-- Fixup code: branch straighten, check for dword offsets that fit in a byte,
-- ========== calculate actual code size, convert opcode indexes to dword
-- offsets into VM, relative addresses and variable indexes into
-- absolute addresses, and adjust all other offsets as necessary
-- by the changing of any dword->byte form instructions. (whew)
--
-- if binding then create .exe file (using specified resource file) else
-- if interpreting just poke to memory and execute it immediately.
--
-- if binding, then we need to write symtab to section 6, whereas
-- if interpreting we can just use the existing symtab directly.
--
-- Note that if binding, there is no source at the point of execution, hence
-- there can be no trace, profile, or profile_time going on.
--
-- Also note that critical parts of this process, specifically those where
-- performance matters and anything to do with licencing issues, have been
-- coded in low level assembly (not open source for obvious reasons).
--
--sequence mzpe -- MZ and PE headers, #400 bytes
string mzpe
-- verify the compiler is working properly:
--DEV 31/1/14 (broken on pth)
--/**/ #isginfo{mzpe,0b1000,MIN,MAX,integer,#400} -- verify this is a string
-- standard PE header fields:
-- Note that file offsets given are 0-based, add 1 to index mzpe (as done in getmzpe,setmzpe, etc).
--global atom -- 7/1/09
global integer
ImageBase -- dword @ #B4, must be #400000
--atom SectionAlignment, -- dword @ #B8, must be #1000
integer SectionAlignment, -- dword @ #B8, must be #1000
FileAlignment, -- dword @ #BC, must be #200
SAless1, -- #00000FFF for rounding to section alignment
SAmask, -- #FFFFF000
FAless1, -- #000001FF for rounding to file alignment
FAmask, -- #FFFFFE00
SubsystemVersion, -- dword @ #C8, must be ssv310 or ssv400
SizeOfImage, -- dword @ #D0, rounded up to SectionAlignment, eg #8000
Subsystem, -- word @ #DC, must be CUI or GUI
ITaddr, -- RVA Import Table address, == ISvaddr -- dword @ #100, eg #2000
ITsize, -- RVA Import Table size, == ISvsize -- dword @ #104, eg #31D
RTaddr, -- RVA Resource Table address == RSvaddr -- dword @ #108, eg #5000
RTsize -- RVA Resource Table size == RSvsize -- dword @ #10C, eg #504
--global atom -- 7/1/09
global integer
-- 6 sections: -- offset:examples vsize vaddr rsize raddr
DVvsize, DVvaddr, DVrsize, DVraddr, -- data for vm (fixed) -- #180:#54C #184:#1000 #188:#600 #18C:#400
ISvsize, ISvaddr, ISrsize, ISraddr, -- import section (fixed) -- #1A8:#31D #1AC:#2000 #1B0:#400 #1B4:#A00
VMvsize, VMvaddr, VMrsize, VMraddr, -- the virtual machine (fixed) -- #1D0:#1ED8 #1D4:#3000 #1D8:#2000 #1DC:#E00
RSvsize, RSvaddr, RSrsize, RSraddr, -- resource section (var len) -- #1F8:#504 #1FC:#5000 #200:#600 #204:#2E00
CSvsize, CSvaddr, CSrsize, CSraddr, -- user code (var start & len) -- #220:#10 #224:#6000 #228:#200 #22C:#3400
DSvsize, DSvaddr, DSrsize, DSraddr -- user data (var start & len) -- #248:#4 #24C:#7000 #250:#200 #254:#3600
constant mzpelen = #400, -- == DVraddr
ssv310 = #000A0003, -- SubsystemVersion: 3.10
ssv400 = #00000004, -- SubsystemVersion: 4.00
CUI = 3, -- Subsystem: console app
GUI = 2 -- Subsystem: gui app
mzpe = repeat(' ',mzpelen)
constant WORD = 2,
DWORD = 4,
bytemul = {0,#100,#10000,#1000000}
function getmzpe(integer offset, integer dsize)
-- reassemble dsize bytes at offset in mzpe
-- Note that offset as passed is 0-based, adjusted here(+1) to index mzpe.
-- dsize is WORD or DWORD
atom res
res = mzpe[offset+1]
for i=2 to dsize do
res += mzpe[offset+i]*bytemul[i]
end for
return res
end function
procedure setmzpe(integer offset, atom v, integer dsize)
-- breakup v into dsize bytes in mzpe at offset.
-- Note that offset as passed is 0-based, adjusted here(+1) to index mzpe.
-- dsize is WORD or DWORD
for i=1 to dsize do
mzpe[offset+i] = and_bits(v,#FF)
v = floor(v/#100)
end for
end procedure
sequence mzpeErrMsg
constant ueof = "unexpected end of file",
noMZ = "MZ missing",
bpeo = "bad PE offset",
noPE = "PE missing",
nsl4 = "number of sections is less than 4", -- rsrc.exe files
nsn6 = "number of sections is not 6", -- p.exe file
bibv = "bad ImageBase value",
bsav = "bad SectionAlignment value",
bfav = "bad FileAlignment value",
ussv = "unrecognised Subsystem version",
uss = "unrecognised Subsystem",
sned = "section name in error (.data)",
snei = "section name in error (.idata)",
snet = "section name in error (.text)",
sner = "section name in error (.rsrc)",
ismm = "import table/section mismatch",
rsmm = "resource table/section mismatch",
dvve = "data for vm section 1 virtual address error",
dvre = "data for vm section 1 raw address error",
isve = "import section 2 virtual address error",
isre = "import section 2 raw address error",
vmve = "vm section 3 virtual address error",
vmre = "vm section 3 raw address error",
rsve = "resource section 4 virtual address error",
rsre = "resource section 4 raw address error",
csve = "code section 5 virtual address error",
csre = "code section 5 raw address error",
dsve = "data section 6 virtual address error",
dsre = "data section 6 raw address error",
soie = "size of image/eof of section mismatch"
function mzErr(string msg)
-- parameter is one of the above constants
-- verify the compiler is working properly:
--/**/ #isginfo{mzpeErrMsg,string,MIN,MAX,integer,-2}
mzpeErrMsg = msg
return 0
end function
function mzpeCheckSection(atom addr, sequence txt)
-- Note that addr as passed is 0-based, adjusted here(+1) to index mzpe.
integer c
for i=1 to 8 do
c = mzpe[addr+i]
if i>length(txt) then
if c!=0 then return 0 end if -- section name in error
else
if c!=txt[i] then return 0 end if -- section name in error
end if
end for
return 1
end function
function readmzpe(integer fn, integer asRsrc)
-- read the mzheaders from p.exe or rsrc.exe's (asRsrc=1 for the latter)
-- returns 1 on success, 0 on failure (see mzpeErrMsg).
-- The following fields must be updated before mzpe is rewritten:
-- SubsystemVersion,SizeOfImage,Subsystem,RTsize,RSvsize,RSrsize,
-- CSvsize,CSvaddr,CSrsize,CSraddr,DSvsize,DSvaddr,DSrsize,DSraddr
-- This routine can be called again on the newly created file as a sanity check.
-- The headers for rsrc.exe files should be read before p.exe, and when both
-- have been read the RSraddr fields should be checked for equality.
integer c
--atom PEoffset, nSections -- 7/1/09
integer PEoffset, nSections
--
-- The main job being done here is a flat read of a fixed (#400 byte) structure,
-- (although several sub-structures within that do exist); the wobbly and/or
-- non-standard indents I have used are as follows:
--
-- main code (indented thus whether inside "if not asRsrc" or not)
-- if not asRsrc
-- sanity checks (indented thus whether inside "if not asRsrc" or not)
--
--#without reformat
-- mzpe = repeat(0,mzpelen)
-- mzpe = repeat(' ',mzpelen)
c = 0
for i=1 to mzpelen do
c = getc(fn)
c = and_bits(c,#FF) -- added 23/2/10 (keeps mzpe T_string)
mzpe[i] = c
end for
if c=-1 then return mzErr(ueof) end if
if getmzpe(#00,WORD)!=#5A4D then return mzErr(noMZ) end if
PEoffset = getmzpe(#3C,DWORD)
if PEoffset!=#80 then return mzErr(bpeo) end if
if getmzpe(PEoffset,DWORD)!=#4550 then return mzErr(noPE) end if
nSections = getmzpe(#86,WORD)
if not asRsrc then
if nSections!=6 then return mzErr(nsn6) end if
else
if nSections<4 then return mzErr(nsl4) end if
end if
ImageBase = getmzpe(#B4,DWORD)
SectionAlignment = getmzpe(#B8,DWORD)
FileAlignment = getmzpe(#BC,DWORD)
if ImageBase!=#400000 then return mzErr(bibv) end if
if SectionAlignment!=#1000 then return mzErr(bsav) end if
if FileAlignment!=#200 then return mzErr(bfav) end if
SAless1 = SectionAlignment-1 -- ie #00000FFF
SAmask = not_bits(SAless1) -- ie #FFFFF000
FAless1 = FileAlignment-1 -- ie #000001FF
FAmask = not_bits(FAless1) -- ie #FFFFFE00
SubsystemVersion = getmzpe(#C8,DWORD) -- [updateme -- almost done]
if SubsystemVersion!=ssv310
and SubsystemVersion!=ssv400 then
return mzErr(ussv)
end if
SizeOfImage = getmzpe(#D0,DWORD) -- [updateme -- DONE]
Subsystem = getmzpe(#DC,WORD) -- [updateme -- almost done]
if Subsystem!=CUI and Subsystem!=GUI then return mzErr(uss) end if
ITaddr = getmzpe(#100,DWORD) -- Import Table address
ITsize = getmzpe(#104,DWORD) -- Import Table size
RTaddr = getmzpe(#108,DWORD) -- Resource Table address
RTsize = getmzpe(#10C,DWORD) -- Resource Table size -- [updateme - DONE]
if not mzpeCheckSection(#178,".data") then return mzErr(sned) end if
if not asRsrc then
DVvsize = getmzpe(#180,DWORD)
DVvaddr = getmzpe(#184,DWORD)
DVrsize = getmzpe(#188,DWORD)
DVraddr = getmzpe(#18C,DWORD)
if DVvaddr!=#1000 then return mzErr(dvve) end if
if DVraddr!=#400 then return mzErr(dvre) end if
if not mzpeCheckSection(#1A0,".idata") then return mzErr(snei) end if
ISvsize = getmzpe(#1A8,DWORD)
ISvaddr = getmzpe(#1AC,DWORD)
ISrsize = getmzpe(#1B0,DWORD)
ISraddr = getmzpe(#1B4,DWORD)
if ISvaddr!=and_bits(DVvaddr+DVvsize+SAless1,SAmask) then return mzErr(isve) end if
if ISraddr!=DVraddr+DVrsize then return mzErr(isre) end if
if ISvsize!=ITsize then return mzErr(ismm) end if
if ISvaddr!=ITaddr then return mzErr(ismm) end if
if not mzpeCheckSection(#1C8,".text") then return mzErr(snet) end if
VMvsize = getmzpe(#1D0,DWORD)
VMvaddr = getmzpe(#1D4,DWORD)
VMrsize = getmzpe(#1D8,DWORD)
VMraddr = getmzpe(#1DC,DWORD)
if VMvaddr!=and_bits(ISvaddr+ISvsize+SAless1,SAmask) then return mzErr(vmve) end if
if VMraddr!=ISraddr+ISrsize then return mzErr(vmre) end if
end if
if not mzpeCheckSection(#1F0,".rsrc") then return mzErr(sner) end if
RSvsize = getmzpe(#1F8,DWORD) -- [updateme - DONE]
RSvaddr = getmzpe(#1FC,DWORD)
RSrsize = getmzpe(#200,DWORD) -- [updateme - DONE]
RSraddr = getmzpe(#204,DWORD) -- [verifyme - DONE]
if RSvsize!=RTsize then return mzErr(rsmm) end if
if RSvaddr!=RTaddr then return mzErr(rsmm) end if
if not asRsrc then
if RSvaddr!=and_bits(VMvaddr+VMvsize+SAless1,SAmask) then return mzErr(rsve) end if
if RSraddr!=VMraddr+VMrsize then return mzErr(rsre) end if
if not mzpeCheckSection(#218,".text") then return mzErr(snet) end if
CSvsize = getmzpe(#220,DWORD) -- [updateme - DONE]
CSvaddr = getmzpe(#224,DWORD) -- [updateme - DONE]
CSrsize = getmzpe(#228,DWORD) -- [updateme - DONE]
CSraddr = getmzpe(#22C,DWORD) -- [updateme - DONE]
if CSvaddr!=and_bits(RSvaddr+RSvsize+SAless1,SAmask) then return mzErr(csve) end if
if CSraddr!=RSraddr+RSrsize then return mzErr(csre) end if
if not mzpeCheckSection(#240,".data") then return mzErr(sned) end if
DSvsize = getmzpe(#248,DWORD) -- [updateme - DONE]
DSvaddr = getmzpe(#24C,DWORD) -- [updateme - DONE]
DSrsize = getmzpe(#250,DWORD) -- [updateme - DONE]
DSraddr = getmzpe(#254,DWORD) -- [updateme - DONE]
if DSvaddr!=and_bits(CSvaddr+CSvsize+SAless1,SAmask) then return mzErr(dsve) end if
if DSraddr!=CSraddr+CSrsize then return mzErr(dsre) end if
if SizeOfImage!=and_bits(DSvaddr+DSvsize+SAless1,SAmask) then return mzErr(soie) end if
else
CSvaddr = and_bits(RSvaddr+RSvsize+SAless1,SAmask)
CSraddr = RSraddr+RSrsize
end if
--#with reformat
return 1 -- all OK
end function
global string divm -- used by p2asm.e if dumpVM=1
global sequence VMep -- used by p2asm.e
-- verify the compiler is working properly:
--!/**/ #isginfo{divm,0b0100,MIN,MAX,integer,-2} -- 0b1000 better?! (see aside in readdivm())
--!/**/ #isginfo{divm,0b1000,MIN,MAX,integer,-2} -- (nb 0b1100 (ie 12) is /worse/ )
--!/**/ #isginfo{divm,0b1100,MIN,MAX,integer,-2} -- I can live with this...
--!/**/ #isginfo{divm,0b1000,MIN,MAX,integer,-2} -- Yay! (23/02/10)
--!/**/ #isginfo{divm,0b1000,MIN,MAX,integer,-1} -- OK? (24/06/10)
--/**/ #isginfo{divm,0b1000,MIN,MAX,integer,-2} -- Yay! (18/01/12)
--/**/ #isginfo{VMep,0b0100,MIN,MAX,integer,-2}
function divmDword(integer i)
-- this routine is used to load VMep (virtual machine entry points table)
-- NB: i is 0-based
return divm[i+1]+divm[i+2]*#100+divm[i+3]*#10000+divm[i+4]*#1000000
end function
procedure setdivm(integer offset, atom v, integer dsize)
-- breakup v into dsize bytes in divm at offset.
-- used I think only to locate symtab and threadstack.
-- Note that offset as passed is 0-based, adjusted here(+1) to index divm.
-- dsize is WORD or DWORD
for i=1 to dsize do
divm[offset+i] = and_bits(v,#FF)
v = floor(v/#100)
end for
end procedure
integer fn, fnr,
asmoptions,
vmaxpos
procedure readdivm()
-- read the data for vm, imports and vm (sections 1..3) verbatim:
-- If we are bootstrapping on RDS Eu, then assume we have a fresh pstub.exe, which
-- is neither encrypted nor publically distributed, which we can/must read.
-- For Phix-hosted operation, there is already one in the root, albeit in need of
-- some deciphering.
integer c, b
atom magic, VMe
sequence x8
-- verify the compiler is working properly:
--/**/ #isginfo{x8,0b1000,MIN,MAX,integer,8}
if DEBUG then
if where(fn)!=#400 then ?9/0 end if
end if
-- divm = repeat(0,RSraddr-DVraddr)
-- divm = repeat(' ',RSraddr-DVraddr) -- nope, makes it T_sequence(0b1100 aka 12), not T_string
divm = repeat(' ',RSraddr-DVraddr)
-- Update 23/2/10: now addressed with and_bits hack below.
-- <aside>
-- OK, divm gets T_Dsq *here*:: c=getc(fn) leaves c as -1..255, obviously (now I see it)
-- that -1 would(/does) make divm a T_Dsq..... No biggie, just look no more. ;-)
-- </aside>
c = 0
for i=1 to length(divm) do
c = getc(fn)
-- divm[i] = c
b = and_bits(c,#FF) -- 23/02/10: c is -1..255, b is 0..255, keeps divm T_string...
divm[i] = b
end for
if c=-1 then ?9/0 end if
VMep = {}
magic = divmDword(#24)
if magic!=#65762B50 then ?9/0 end if
c = #28
while 1 do
VMe = divmDword(c)
c += 4
if VMe = magic then exit end if
-- VMep = append(VMep,VMe)
b = VMe
VMep = append(VMep,b)
end while
asmoptions = divmDword(c) -- (verified in unused_cleanup, in pilxl.e)
if newEBP then
if newEBP!=4 then ?9/0 end if
asmoptions = or_bits(asmoptions,newEBP)
elsif and_bits(asmoptions,4) then
asmoptions -= 4
end if
-- (8 = batchbit)
if batchmode then
asmoptions = or_bits(asmoptions,8)
elsif and_bits(asmoptions,8) then
asmoptions -= 8
end if
setdivm(c, asmoptions, DWORD)
--
-- The following is used to check whether the build involved RDS Eu;
-- see t28sprntf.exw for more details. Note that "exw p -cp" will
-- "iron this one out", but "exw p test.exw" won't. [DEV not that you an do that anymore?]
--
x8 = atom_to_float64(1e308)
-- printf(1,"x8=#%02x,#%02x,#%02x,#%02x,#%02x,#%02x,#%02x,#%02x\n",x8)
c += 4
for i=1 to 8 do
c += 1
b = x8[i]
divm[c] = b
end for
--DEV (untested) try:
-- divm[c+4..c+11] = atom_to_float64(1e308)
vmaxpos = c
--?c -- 844
end procedure
function getdivmstring(integer address)
integer ch
string res = ""
while 1 do -- (until ch = '\0')
address += 1
ch = divm[address]
if ch='\0' then exit end if
res &= ch
end while
return res
end function
function firstatom(sequence sets)
sequence si
object sij
for i=1 to length(sets) do
si = sets[i]
for j=1 to length(si) do
sij = si[j]
if atom(sij) then
if sij=0 then ?9/0 end if
return sij
end if
end for
end for
return 0
end function
sequence Names -- eg {"kernel32.dll",...}
sequence HintNames -- eg {{{#40470,...},{"AllocConsole",...}},{..}}
sequence thunkaddrs -- \ scratch vars, set from HintNames[i],
sequence thunknames -- / where i is eg find("kernel32.dll",Names)
procedure peek_import_table()
-- NB: any fixes here probably also apply to read_import_table() below,
-- and possibly also demo\arwendemo\filedump.exw
integer Base = #00400000
integer e_lfanew
integer machine
integer ImageBase
integer nSections
integer address
integer NumberOfRvaAndSizes
integer RelativeVirtualAddress2
integer RVASize2
integer SH_VirtualSize
integer SH_VirtualAddr
integer PointerToRawData
integer ImportBase
integer ThunkBase
integer Name
integer FirstThunk
integer thunkaddr
integer k
string text
atom RVA
integer signed
integer Hint
if peek({Base,2})!="MZ" then ?9/0 end if
e_lfanew = Base+peek4u(Base+#3C)
if peek({e_lfanew,2})!="PE" then ?9/0 end if
machine = peek2u(e_lfanew+4)
if machine=0x014C then
machine = 32
ImageBase = peek4u(e_lfanew+#34)
NumberOfRvaAndSizes = #74 -- (offset)
elsif machine=0x8664 then
machine = 64
ImageBase = peek4u(e_lfanew+#30)
if peek4u(e_lfanew+#34)!=0 then ?9/0 end if
NumberOfRvaAndSizes = #84 -- (offset)
else
?9/0 -- return fatal("unknown architecture")
end if
nSections = peek2u(e_lfanew+6)
address = e_lfanew+NumberOfRvaAndSizes
NumberOfRvaAndSizes = peek4u(address)
if NumberOfRvaAndSizes<2 then ?9/0 end if
RelativeVirtualAddress2 = peek4u(address+12)
RVASize2 = peek4u(address+16)
address += NumberOfRvaAndSizes*8+4
for i=1 to nSections do
SH_VirtualSize = peek4u(address+8)
SH_VirtualAddr = peek4u(address+12)
if RelativeVirtualAddress2>=SH_VirtualAddr
and RelativeVirtualAddress2+RVASize2<=SH_VirtualAddr+SH_VirtualSize then
PointerToRawData = peek4u(address+20)
exit
end if
address += 40
end for
address = SH_VirtualAddr+ImageBase
ImportBase = address-RelativeVirtualAddress2
ThunkBase = ImageBase-ImportBase
--
-- Collect any pointers we find, and (hopefully) get through them all later.
--
Names = {}
HintNames = {}
-- An array of IMAGE_IMPORT_DESCRIPTOR (ends with an an all null one)
while 1 do
Name = peek4u(address+12)
FirstThunk = peek4u(address+16)
address += 20 -- sizeofstruct(IMAGE_IMPORT_DESCRIPTOR)
if Name=0 and FirstThunk=0 then exit end if
Names = append(Names,Name+ImportBase)
HintNames = append(HintNames,FirstThunk+ImportBase)
end while
--
-- The IMAGE_IMPORT_DESCRIPTOR above contain pointers (RVAs), so
-- presumably the rest of this section can be written in any order.
-- Try to do things in file address order.
--
while 1 do
k = find(address,Names)
if k!=0 then
text = peek_string(address)
Names[k] = lower(text)
address += length(text)+1
else
k = find(address,HintNames)
if k=0 then
-- I would prefer to do it in file order, but if
-- things have been written out higgledy-piggledy...
address = firstatom({Names,HintNames})
if address=0 then exit end if
else
-- An array of IMAGE_THUNK_DATA32/64 (which does not help much..)
-- one d/qword RVA per line, until we hit a null...
thunkaddrs = {}
thunknames = {}
while 1 do
signed = 0
thunkaddr = address+ThunkBase
if machine=32 then
RVA = peek4u(address)
if and_bits(RVA,#80000000) then
signed = 1
end if
address += 4
else
RVA = peek(address+7)
if and_bits(RVA,#80) then
signed = 1
else
RVA = peek4u(address) -- 8 bytes really...
if peek4u(address+4)!=0 then ?9/0 end if
end if
address += 8
end if
if RVA=0 then exit end if
if not signed then
thunkaddrs = append(thunkaddrs,thunkaddr)
end if
end while
for i=1 to length(thunkaddrs) do
Hint = peek2u(address)
if Hint!=0 then
-- oops (import by ordinal or something?)
thunkaddrs = {-1}
thunknames = {"some error"}
exit
end if
address += 2
text = peek_string(address)
thunknames = append(thunknames,text)
address += length(text)+1
end for
--DEV or add to ttree with terminator of -4?
HintNames[k] = {thunkaddrs,thunknames}
end if
end if
end while
end procedure
procedure read_import_table()
-- NB: any fixes here probably also apply to peek_import_table()
integer e_lfanew
integer machine
integer ImageBase
integer nSections
integer address
integer NumberOfRvaAndSizes
integer RelativeVirtualAddress2
integer RVASize2
integer SH_VirtualSize
integer SH_VirtualAddr
integer PointerToRawData
integer ImportBase
integer ThunkBase
integer Name
integer FirstThunk
integer thunkaddr
integer k
string text
atom RVA
integer signed
e_lfanew = getmzpe(#3C,4)
if getmzpe(e_lfanew,4)!=#00004550 then ?9/0 end if
machine = getmzpe(e_lfanew+4,2)
if machine=0x014C then
machine = 32
ImageBase = getmzpe(e_lfanew+#34,4)
NumberOfRvaAndSizes = #74 -- (offset)
elsif machine=0x8664 then
machine = 64
ImageBase = getmzpe(e_lfanew+#30,8)
NumberOfRvaAndSizes = #84 -- (offset)
else
?9/0 -- return fatal("unknown architecture")
end if
nSections = getmzpe(e_lfanew+6,2)
address = e_lfanew+NumberOfRvaAndSizes
NumberOfRvaAndSizes = getmzpe(address,4)
if NumberOfRvaAndSizes<2 then ?9/0 end if
RelativeVirtualAddress2 = getmzpe(address+12,4)
RVASize2 = getmzpe(address+16,4)
address += NumberOfRvaAndSizes*8+4
for i=1 to nSections do
SH_VirtualSize = getmzpe(address+8,4)
SH_VirtualAddr = getmzpe(address+12,4)
if RelativeVirtualAddress2>=SH_VirtualAddr
and RelativeVirtualAddress2+RVASize2<=SH_VirtualAddr+SH_VirtualSize then
PointerToRawData = getmzpe(address+20,4)
exit
end if
address += 40
end for
address = PointerToRawData+RelativeVirtualAddress2-SH_VirtualAddr-mzpelen
ImportBase = address-RelativeVirtualAddress2
ThunkBase = ImageBase-ImportBase
--
-- Collect any pointers we find, and (hopefully) get through them all later.
--
Names = {}
HintNames = {}
-- An array of IMAGE_IMPORT_DESCRIPTOR (ends with an an all null one)
while 1 do
Name = divmDword(address+12)
FirstThunk = divmDword(address+16)
address += 20 -- sizeofstruct(IMAGE_IMPORT_DESCRIPTOR)
if Name=0 and FirstThunk=0 then exit end if
Names = append(Names,Name+ImportBase)
HintNames = append(HintNames,FirstThunk+ImportBase)
end while
--
-- The IMAGE_IMPORT_DESCRIPTOR above contain pointers (RVAs), so
-- presumably the rest of this section can be written in any order.
-- Try to do things in file address order.
--
while 1 do
k = find(address,Names)
if k!=0 then
text = getdivmstring(address)
Names[k] = lower(text)
address += length(text)+1
else
k = find(address,HintNames)
if k=0 then
-- I would prefer to do it in file order, but if
-- things have been written out higgledy-piggledy...
address = firstatom({Names,HintNames})
if address=0 then exit end if
else
-- An array of IMAGE_THUNK_DATA32/64 (which does not help much..)
-- one d/qword RVA per line, until we hit a null...
thunkaddrs = {}
thunknames = {}
while 1 do
signed = 0
thunkaddr = address+ThunkBase
if machine=32 then
RVA = divmDword(address)
if and_bits(RVA,#80000000) then
signed = 1
end if
address += 4
else
RVA = divmDword(address+4)
if and_bits(RVA,#80000000) then
signed = 1
else
if RVA!=0 then ?9/0 end if
RVA = divmDword(address)
end if
address += 8
end if
if RVA=0 then exit end if
if not signed then
thunkaddrs = append(thunkaddrs,thunkaddr)
thunknames = append(thunknames,getdivmstring(RVA+ImportBase+2))
end if
end while
HintNames[k] = {thunkaddrs,thunknames}
end if
end if
end while
end procedure
sequence resource_section
function read_resource_section(integer fn)
integer c
if seek(fn,RSraddr) then ?9/0 end if
resource_section = repeat(0,CSraddr-RSraddr)
c = 0
for i=1 to length(resource_section) do
c = getc(fn)
resource_section[i] = c
end for
if c=-1 then return 0 end if
return 1 -- all OK
end function
constant dorsrc = 0
sequence rsfilename
integer rsrcRSraddr, rsrcRSrsize, rsrcRSvsize, rsrcCSvaddr, rsrcCSraddr
-- used in p2asm.e, plist.e
global sequence code_section
--sequence data_section
--type dst(sequence d)
-- return string(d)
--end type
--dst data_section
sequence data_section
--/**/ #isginfo{data_section,0b1000,MIN,MAX,integer,-2} -- verify this is a string
function isString(object x)
-- avoid "probable logic errors" testing that data_section really is a string
-- (because p.exw contains "without type_check"....)
return string(x)
end function
if isString(0) then end if -- and prevent the compiler from optimising it away!
constant m4 = allocate(4),
-- m41 = m4+1,
-- m42 = m4+2,
-- m43 = m4+3,
m44 = {m4,4}
procedure setcsDword(integer i, atom v)
-- set a dword in code_section
-- NB: offset passed here is 1-based index
--integer c,vi -- intermediate integers to help the compiler optimise
-- c = and_bits(v,#FF) code_section[i] = c vi = floor(v/#100)
-- c = and_bits(vi,#FF) i += 1 code_section[i] = c vi = floor(vi/#100)
-- c = and_bits(vi,#FF) i += 1 code_section[i] = c vi = floor(vi/#100)
-- c = and_bits(vi,#FF) i += 1 code_section[i] = c
--integer b
poke4(m4, v) -- faster than doing divides etc. (idea from database.e)
-- b = peek(m4) code_section[i] = b i += 1
-- b = peek(m41) code_section[i] = b i += 1
-- b = peek(m42) code_section[i] = b i += 1
-- b = peek(m43) code_section[i] = b
code_section[i..i+3] = peek(m44)
end procedure
--function gets5Dword(integer i)
---- used to get routine no for patching parameter info on forward calls
---- NB: i is 1-based
-- return s5[i]+s5[i+1]*#100+s5[i+2]*#10000+s5[i+3]*#1000000
--end function
procedure sets5Dword(integer i, atom v)
-- used for patching parameter info on forward calls
-- NB: offset passed here is 1-based index
--integer c,vi -- intermediate integers to help the compiler optimise
-- c = and_bits(v,#FF) s5[i] = c vi = floor(v/#100)
-- c = and_bits(vi,#FF) i += 1 s5[i] = c vi = floor(vi/#100)
-- c = and_bits(vi,#FF) i += 1 s5[i] = c vi = floor(vi/#100)
-- c = and_bits(vi,#FF) i += 1 s5[i] = c
--integer b
poke4(m4, v) -- faster than doing divides etc. (idea from database.e)
-- b = peek(m4) s5[i] = b i += 1
-- b = peek(m41) s5[i] = b i += 1
-- b = peek(m42) s5[i] = b i += 1
-- b = peek(m43) s5[i] = b
s5[i..i+3] = peek(m44)
end procedure
function getdsDword(integer i)
-- used to get refcount for subsequence/substring patch
-- NB: i is 1-based (** unlike setdsDword **)
return data_section[i]+data_section[i+1]*#100+data_section[i+2]*#10000+data_section[i+3]*#1000000
end function
procedure setdsDword(integer i, atom v)
-- NB: offset passed here is 0-based index
--integer c,vi -- intermediate integers to help the compiler optimise
-- c = and_bits(v,#FF) i += 1 data_section[i] = c vi = floor(v/#100)
-- c = and_bits(vi,#FF) i += 1 data_section[i] = c vi = floor(vi/#100)
-- c = and_bits(vi,#FF) i += 1 data_section[i] = c vi = floor(vi/#100)
-- c = and_bits(vi,#FF) i += 1 data_section[i] = c
--integer b
poke4(m4, v) -- faster than doing divides etc. (idea from database.e)
-- b = peek(m4) i += 1 data_section[i] = b
-- b = peek(m41) i += 1 data_section[i] = b
-- b = peek(m42) i += 1 data_section[i] = b
-- b = peek(m43) i += 1 data_section[i] = b
data_section[i+1..i+4] = peek(m44)
end procedure
procedure appenddsDword(atom v)
--integer c,vi
-- c = and_bits(v,#FF) ds = append(ds,c) vi = floor(v/#100)
-- c = and_bits(vi,#FF) ds = append(ds,c) vi = floor(vi/#100)
-- c = and_bits(vi,#FF) ds = append(ds,c) vi = floor(vi/#100)
-- c = and_bits(vi,#FF) ds = append(ds,c)
poke4(m4, v) -- faster than doing divides etc. (idea from database.e)
--if not isString(data_section) then ?9/0 end if
data_section &= peek(m44)
--if not isString(data_section) then ?9/0 end if
end procedure
procedure appenddsType(integer t)
--DEV 30/7/2013 plant a dummy (illegal) delete_routine:
-- data_section = append(data_section,0)
data_section = append(data_section,1)
data_section = append(data_section,0)
data_section = append(data_section,0)
data_section = append(data_section,t)
end procedure
procedure appenddsBytes(sequence s)
integer ch
for i=1 to length(s) do
ch = and_bits(s[i],#FF)
data_section = append(data_section,ch)
end for
--if not isString(data_section) then ?9/0 end if
end procedure
procedure APIerror(integer i, string msg)
sequence x = APIerritem[i]
fileno = x[1]
tokline = x[2]
tokcol = x[3]
Abort(msg)
end procedure
procedure readAllHeaders()
string s
integer k
integer libidx, nameidx
atom offset
if bind then
if dorsrc then
rsfilename = "pf1.exe" -- DEV from commandline, full path expansion
fnr = open(rsfilename,"rb")
if not readmzpe(fnr,0) then
printf(1,"Error :%s\n",{mzpeErrMsg})
?9/0
end if
rsrcRSraddr = RSraddr -- for checking only [DEV I might mean RSvaddr here!!]
rsrcRSvsize = RSvsize
rsrcRSrsize = RSrsize
rsrcCSvaddr = CSvaddr
rsrcCSraddr = CSraddr
end if
fn = open(cl1,"rb") -- cl1 is from commandline, ie p.exe with full path expansion
if fn=-1 then
puts(1,"error opening "&cl1&"\n")
?9/0
end if
if not readmzpe(fn,0) then
printf(1,"Error :%s\n",{mzpeErrMsg})
?9/0
end if
readdivm()
if dorsrc then
if rsrcRSraddr!=RSraddr then
printf(1,"resource file %s error: section 5 @ #%08x, not #%08x (difference of %d)\n",
{rsfilename,rsrcRSraddr,RSraddr,rsrcRSraddr-RSraddr})
?9/0
end if
RSvsize = rsrcRSvsize
RSrsize = rsrcRSrsize
CSvaddr = rsrcCSvaddr
CSraddr = rsrcCSraddr
RTsize = RSvsize
setmzpe(#10C, RTsize, DWORD)
setmzpe(#1F8, RSvsize, DWORD)
setmzpe(#200, RSrsize, DWORD)
setmzpe(#224, CSvaddr, DWORD)
setmzpe(#22C, CSraddr, DWORD)
if not read_resource_section(fnr) then ?9/0 end if
else
if not read_resource_section(fn) then ?9/0 end if
end if
close(fn)
read_import_table()
else
peek_import_table()
--DEV/SUG I could get this using peek...
--!/**/ #ilasm{ mov_edi_imm32,%isVar,0,0,VMep, -- mov edi,VMep
--!/**/ mov_ecx_imm32,%isVar,0,0,asmoptions, -- mov ecx,asmoptions
--!/**/ call_rel32,%isOpCode,0,0,%opGetVMep} -- [edi]=VMep; [ecx]=asmoptions
--/**/ #ilASM{ lea edi,[VMep]
--/**/ lea ecx,[asmoptions]
--/**/ call %opGetVMep} -- [edi]=VMep; [ecx]=asmoptions
CSvaddr = 0
ImageBase = 0
end if
if listimports then
for i=1 to length(Names) do
printf(1,"%s:\n",Names[i])
thunkaddrs = HintNames[i][1]
thunknames = HintNames[i][2]
for j=1 to length(thunkaddrs) do
printf(1,"Thunk[%08x] :%s\n",{thunkaddrs[j],thunknames[j]})
end for
end for
-- if getc(0) then end if
abort(0)
end if
--
-- Map any api functions and issue errors for any not found
--
if newEmit then ?9/0 end if
for i=1 to length(APIlibs) do
s = APIlibs[i]
k = find(s,Names)
if k=0 then
APIerritem = APIerrlib
APIerror(i, "no such library")
?9/0 -- sanity check
end if
APIlibs[i] = k
end for
for i=1 to length(APINames) do
libidx = APIlibs[APINames[i][1]]
nameidx = find(APINames[i][2],HintNames[libidx][2])
if nameidx=0 then
APIerror(i, "not found in import table")
?9/0 -- sanity check
end if
offset = HintNames[libidx][1][nameidx]
APINames[i] = offset
end for
end procedure
--with trace
--procedure stripPathInfo()
----
---- Strip alsolute path info, leaving just relative path info,
----
---- eg {"F:\test\", "F:\test\builtins\"} ==> {"","builtins\"}
----
---- If you build an app in say F:\test\ and someone installs it in C:\new\,
---- the last thing wanted is any mention of the (non-existent) F:\test\ in
---- any error reports. nb pdiag.e plugs back in current_dir() info.
----
--sequence fpi, -- copy of filepaths[i]
-- fpj -- copy of filepaths[j]
--integer lfpi, -- length(fpi)
-- lfpj -- length(fpj)
--integer k, p, rooti
--
----filepaths={
---- "x:\\misc\\a\\", "x:\\misc\\a\\b\\", "x:\\misc\\"}
--
----filepaths={
---- "c:\\Program Files\\Phix\\builtins\\",
---- "c:\\crud\\",
---- "c:\\crud\\builtins\\",
---- "c:\\Program Files\\Phix\\"}
----filenames={
---- {1, "test1.exw"},
---- {2, "test2.exw"},
------ {4, "test3.exw"},
---- {3, "test4.exw"}}
----pp(filepaths)
----pp(filenames)
-- for i=1 to length(filepaths) do
-- rooti = i
-- fpi = filepaths[i]
-- lfpi = length(fpi)
-- if lfpi>=2 and fpi[2]=':' then
-- -- first make sure we have the shortest root, eg from
-- -- "x:\\misc\\a\\", "x:\\misc\\a\\b\\", "x:\\misc\\",