|
@@ -0,0 +1,1779 @@
|
|
|
+MODULE Dev0Linker;
|
|
|
+
|
|
|
+ (* THIS IS TEXT COPY OF Linker.odc *)
|
|
|
+ (* DO NOT EDIT *)
|
|
|
+
|
|
|
+ IMPORT
|
|
|
+ Kernel, Files, (* Dates, Dialog, *) Strings,
|
|
|
+ (* TextModels, TextViews, TextMappers,
|
|
|
+ Log := StdLog, DevCommanders *) Console;
|
|
|
+
|
|
|
+ CONST
|
|
|
+ NewRecFP = 4E27A847H;
|
|
|
+ NewArrFP = 76068C78H;
|
|
|
+
|
|
|
+ ImageBase = 00400000H;
|
|
|
+ ObjAlign = 1000H;
|
|
|
+ FileAlign = 200H;
|
|
|
+ HeaderSize = 400H;
|
|
|
+
|
|
|
+ FixLen = 30000;
|
|
|
+
|
|
|
+ OFdir = "Code";
|
|
|
+ SYSdir = "System";
|
|
|
+ RsrcDir = "Rsrc";
|
|
|
+ WinDir = "Win";
|
|
|
+
|
|
|
+ (* meta interface consts *)
|
|
|
+ mConst = 1; mTyp = 2; mVar = 3; mProc = 4; mField = 5;
|
|
|
+ mInternal = 1; mReadonly = 2; mExported = 4;
|
|
|
+
|
|
|
+ (* fixup types *)
|
|
|
+ absolute = 100; relative = 101; copy = 102; table = 103; tableend = 104;
|
|
|
+
|
|
|
+ (* mod desc fields *)
|
|
|
+ modOpts = 4; modRefcnt = 8; modTerm = 40; modNames = 84; modImports = 92; modExports = 96;
|
|
|
+
|
|
|
+
|
|
|
+ (* A. V. Shiryaev: Scanner *)
|
|
|
+ TMChar = 0; TMString = 1; TMInt = 2; TMEOT = 3;
|
|
|
+
|
|
|
+ TYPE
|
|
|
+ Name = ARRAY 40 OF SHORTCHAR;
|
|
|
+ Export = POINTER TO RECORD
|
|
|
+ next: Export;
|
|
|
+ name: Name;
|
|
|
+ adr: INTEGER
|
|
|
+ END;
|
|
|
+ Resource = POINTER TO RECORD
|
|
|
+ next, local: Resource;
|
|
|
+ typ, id, lid, size, pos, x, y: INTEGER;
|
|
|
+ opts: SET;
|
|
|
+ file: Files.File;
|
|
|
+ name: Files.Name
|
|
|
+ END;
|
|
|
+ Module = POINTER TO RECORD
|
|
|
+ next: Module;
|
|
|
+ name: Files.Name;
|
|
|
+ file: Files.File;
|
|
|
+ hs, ms, ds, cs, vs, ni, ma, ca, va: INTEGER;
|
|
|
+ dll, intf: BOOLEAN;
|
|
|
+ exp: Export;
|
|
|
+ imp: POINTER TO ARRAY OF Module;
|
|
|
+ data: POINTER TO ARRAY OF BYTE;
|
|
|
+ END;
|
|
|
+
|
|
|
+ (* A. V. Shiryaev: Scanner *)
|
|
|
+ ScanRider = RECORD
|
|
|
+ s: POINTER TO ARRAY OF CHAR;
|
|
|
+ i: INTEGER
|
|
|
+ END;
|
|
|
+ Scanner = RECORD
|
|
|
+ rider: ScanRider;
|
|
|
+ start, type: INTEGER;
|
|
|
+
|
|
|
+ string: ARRAY 100 OF CHAR;
|
|
|
+ char: CHAR;
|
|
|
+ int: INTEGER
|
|
|
+ END;
|
|
|
+
|
|
|
+ VAR
|
|
|
+(*
|
|
|
+ W: TextMappers.Formatter;
|
|
|
+*)
|
|
|
+ Out: Files.File;
|
|
|
+ R: Files.Reader;
|
|
|
+ Ro: Files.Writer;
|
|
|
+ error, isDll, isStatic, comLine: BOOLEAN;
|
|
|
+ modList, kernel, main, last, impg, impd: Module;
|
|
|
+ numMod, lastTerm: INTEGER;
|
|
|
+ resList: Resource;
|
|
|
+ numType, resHSize: INTEGER;
|
|
|
+ numId: ARRAY 32 OF INTEGER;
|
|
|
+ rsrcName: ARRAY 16 OF CHAR; (* name of resource file *)
|
|
|
+ firstExp, lastExp: Export;
|
|
|
+ entryPos, isPos, fixPos, himpPos, hexpPos, hrsrcPos, termPos: INTEGER;
|
|
|
+ codePos, dataPos, conPos, rsrcPos, impPos, expPos, relPos: INTEGER;
|
|
|
+ CodeSize, DataSize, ConSize, RsrcSize, ImpSize, ImpHSize, ExpSize, RelocSize, DllSize: INTEGER;
|
|
|
+ CodeRva, DataRva, ConRva, RsrcRva, ImpRva, ExpRva, RelocRva, ImagesSize: INTEGER;
|
|
|
+ CodeBase, DataBase, ConBase, maxCode, numImp, numExp, noffixup, timeStamp: INTEGER;
|
|
|
+ newRec, newArr: Name;
|
|
|
+ fixups: POINTER TO ARRAY OF INTEGER;
|
|
|
+ code: POINTER TO ARRAY OF BYTE;
|
|
|
+ atab: POINTER TO ARRAY OF INTEGER;
|
|
|
+ ntab: POINTER TO ARRAY OF SHORTCHAR;
|
|
|
+
|
|
|
+ (* A. V. Shiryaev: Console *)
|
|
|
+
|
|
|
+ PROCEDURE WriteString (s: ARRAY OF CHAR);
|
|
|
+ BEGIN
|
|
|
+ Console.WriteStr(s)
|
|
|
+ END WriteString;
|
|
|
+
|
|
|
+ PROCEDURE WriteChar (c: CHAR);
|
|
|
+ VAR s: ARRAY 2 OF CHAR;
|
|
|
+ BEGIN
|
|
|
+ s[0] := c; s[1] := 0X;
|
|
|
+ Console.WriteStr(s)
|
|
|
+ END WriteChar;
|
|
|
+
|
|
|
+ PROCEDURE WriteSString (ss: ARRAY OF SHORTCHAR);
|
|
|
+ BEGIN
|
|
|
+ Console.WriteStr(ss$)
|
|
|
+ END WriteSString;
|
|
|
+
|
|
|
+ PROCEDURE WriteInt (x: INTEGER);
|
|
|
+ VAR s: ARRAY 16 OF CHAR;
|
|
|
+ BEGIN
|
|
|
+ Strings.IntToString(x, s);
|
|
|
+ Console.WriteStr(s)
|
|
|
+ END WriteInt;
|
|
|
+
|
|
|
+ PROCEDURE WriteLn;
|
|
|
+ BEGIN
|
|
|
+ Console.WriteLn
|
|
|
+ END WriteLn;
|
|
|
+
|
|
|
+ PROCEDURE FlushW;
|
|
|
+ BEGIN
|
|
|
+ END FlushW;
|
|
|
+
|
|
|
+(*
|
|
|
+ PROCEDURE TimeStamp (): INTEGER; (* seconds since 1.1.1970 00:00:00 *)
|
|
|
+ VAR a: INTEGER; t: Dates.Time; d: Dates.Date;
|
|
|
+ BEGIN
|
|
|
+ Dates.GetTime(t); Dates.GetDate(d);
|
|
|
+ a := 12 * (d.year - 70) + d.month - 3;
|
|
|
+ a := a DIV 12 * 1461 DIV 4 + (a MOD 12 * 153 + 2) DIV 5 + d.day + 59;
|
|
|
+ RETURN ((a * 24 + t.hour) * 60 + t.minute) * 60 + t.second;
|
|
|
+ END TimeStamp;
|
|
|
+*)
|
|
|
+
|
|
|
+ PROCEDURE ThisFile (modname: ARRAY OF CHAR): Files.File;
|
|
|
+ VAR dir, name: Files.Name; loc: Files.Locator; f: Files.File;
|
|
|
+ BEGIN
|
|
|
+ Kernel.SplitName(modname, dir, name);
|
|
|
+ Kernel.MakeFileName(name, Kernel.objType);
|
|
|
+ loc := Files.dir.This(dir); loc := loc.This(OFdir);
|
|
|
+ f := Files.dir.Old(loc, name, TRUE);
|
|
|
+ IF (f = NIL) & (dir = "") THEN
|
|
|
+ loc := Files.dir.This(SYSdir); loc := loc.This(OFdir);
|
|
|
+ f := Files.dir.Old(loc, name, TRUE)
|
|
|
+ END;
|
|
|
+ RETURN f
|
|
|
+ END ThisFile;
|
|
|
+
|
|
|
+ PROCEDURE ThisResFile (VAR name: Files.Name): Files.File;
|
|
|
+ VAR loc: Files.Locator; f: Files.File;
|
|
|
+ BEGIN
|
|
|
+ f := Files.dir.Old(Files.dir.This(RsrcDir), name, TRUE);
|
|
|
+ IF f = NIL THEN
|
|
|
+ loc := Files.dir.This(WinDir); loc := loc.This(RsrcDir);
|
|
|
+ f := Files.dir.Old(loc, name, TRUE);
|
|
|
+ IF f = NIL THEN
|
|
|
+ f := Files.dir.Old(Files.dir.This(""), name, TRUE)
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ RETURN f
|
|
|
+ END ThisResFile;
|
|
|
+
|
|
|
+ PROCEDURE Read2 (VAR x: INTEGER);
|
|
|
+ VAR b: BYTE;
|
|
|
+ BEGIN
|
|
|
+ R.ReadByte(b); x := b MOD 256;
|
|
|
+ R.ReadByte(b); x := x + 100H * (b MOD 256)
|
|
|
+ END Read2;
|
|
|
+
|
|
|
+ PROCEDURE Read4 (VAR x: INTEGER);
|
|
|
+ VAR b: BYTE;
|
|
|
+ BEGIN
|
|
|
+ R.ReadByte(b); x := b MOD 256;
|
|
|
+ R.ReadByte(b); x := x + 100H * (b MOD 256);
|
|
|
+ R.ReadByte(b); x := x + 10000H * (b MOD 256);
|
|
|
+ R.ReadByte(b); x := x + 1000000H * b
|
|
|
+ END Read4;
|
|
|
+
|
|
|
+ PROCEDURE ReadName (VAR name: ARRAY OF SHORTCHAR);
|
|
|
+ VAR i: INTEGER; b: BYTE;
|
|
|
+ BEGIN i := 0;
|
|
|
+ REPEAT
|
|
|
+ R.ReadByte(b); name[i] := SHORT(CHR(b)); INC(i)
|
|
|
+ UNTIL b = 0
|
|
|
+ END ReadName;
|
|
|
+
|
|
|
+ PROCEDURE RNum (VAR i: INTEGER);
|
|
|
+ VAR b: BYTE; s, y: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ s := 0; y := 0; R.ReadByte(b);
|
|
|
+ WHILE b < 0 DO INC(y, ASH(b + 128, s)); INC(s, 7); R.ReadByte(b) END;
|
|
|
+ i := ASH((b + 64) MOD 128 - 64, s) + y
|
|
|
+ END RNum;
|
|
|
+
|
|
|
+ PROCEDURE WriteCh (ch: SHORTCHAR);
|
|
|
+ BEGIN
|
|
|
+ Ro.WriteByte(SHORT(ORD(ch)))
|
|
|
+ END WriteCh;
|
|
|
+
|
|
|
+ PROCEDURE Write2 (x: INTEGER);
|
|
|
+ BEGIN
|
|
|
+ Ro.WriteByte(SHORT(SHORT(x MOD 256))); x := x DIV 256;
|
|
|
+ Ro.WriteByte(SHORT(SHORT(x MOD 256)))
|
|
|
+ END Write2;
|
|
|
+
|
|
|
+ PROCEDURE Write4 (x: INTEGER);
|
|
|
+ BEGIN
|
|
|
+ Ro.WriteByte(SHORT(SHORT(x MOD 256))); x := x DIV 256;
|
|
|
+ Ro.WriteByte(SHORT(SHORT(x MOD 256))); x := x DIV 256;
|
|
|
+ Ro.WriteByte(SHORT(SHORT(x MOD 256))); x := x DIV 256;
|
|
|
+ Ro.WriteByte(SHORT(SHORT(x MOD 256)))
|
|
|
+ END Write4;
|
|
|
+
|
|
|
+ PROCEDURE WriteName (s: ARRAY OF SHORTCHAR; len: SHORTINT);
|
|
|
+ VAR i: SHORTINT;
|
|
|
+ BEGIN i := 0;
|
|
|
+ WHILE s[i] # 0X DO Ro.WriteByte(SHORT(ORD(s[i]))); INC(i) END;
|
|
|
+ WHILE i < len DO Ro.WriteByte(0); INC(i) END
|
|
|
+ END WriteName;
|
|
|
+
|
|
|
+ PROCEDURE Reloc (a: INTEGER);
|
|
|
+ VAR p: POINTER TO ARRAY OF INTEGER; i: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ IF noffixup >= LEN(fixups) THEN
|
|
|
+ NEW(p, 2 * LEN(fixups));
|
|
|
+ i := 0; WHILE i < LEN(fixups) DO p[i] := fixups[i]; INC(i) END;
|
|
|
+ fixups := p
|
|
|
+ END;
|
|
|
+ fixups[noffixup] := a; INC(noffixup)
|
|
|
+(*
|
|
|
+ ELSE
|
|
|
+ IF ~error THEN W.WriteSString(" too many fixups") END;
|
|
|
+ error := TRUE
|
|
|
+ END
|
|
|
+*)
|
|
|
+ END Reloc;
|
|
|
+
|
|
|
+ PROCEDURE Put (mod: Module; a, x: INTEGER);
|
|
|
+ BEGIN
|
|
|
+ mod.data[a] := SHORT(SHORT(x)); INC(a); x := x DIV 256;
|
|
|
+ mod.data[a] := SHORT(SHORT(x)); INC(a); x := x DIV 256;
|
|
|
+ mod.data[a] := SHORT(SHORT(x)); INC(a); x := x DIV 256;
|
|
|
+ mod.data[a] := SHORT(SHORT(x))
|
|
|
+ END Put;
|
|
|
+
|
|
|
+ PROCEDURE Get (mod: Module; a: INTEGER; VAR x: INTEGER);
|
|
|
+ BEGIN
|
|
|
+ x := ((mod.data[a + 3] * 256 +
|
|
|
+ (mod.data[a + 2] MOD 256)) * 256 +
|
|
|
+ (mod.data[a + 1] MOD 256)) * 256 +
|
|
|
+ (mod.data[a] MOD 256)
|
|
|
+ END Get;
|
|
|
+
|
|
|
+ PROCEDURE GenName (VAR from, to: ARRAY OF SHORTCHAR; ext: ARRAY OF SHORTCHAR);
|
|
|
+ VAR i, j: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ i := 0;
|
|
|
+ WHILE from[i] # 0X DO to[i] := from[i]; INC(i) END;
|
|
|
+ IF ext # "" THEN
|
|
|
+ to[i] := "."; INC(i); j := 0;
|
|
|
+ WHILE ext[j] # 0X DO to[i] := ext[j]; INC(i); INC(j) END
|
|
|
+ END;
|
|
|
+ to[i] := 0X
|
|
|
+ END GenName;
|
|
|
+
|
|
|
+ PROCEDURE Fixup0 (link, adr: INTEGER);
|
|
|
+ VAR offset, linkadr, t, n, x: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ WHILE link # 0 DO
|
|
|
+ RNum(offset);
|
|
|
+ WHILE link # 0 DO
|
|
|
+ IF link > 0 THEN
|
|
|
+ n := (code[link] MOD 256) + (code[link+1] MOD 256) * 256 + code[link+2] * 65536;
|
|
|
+ t := code[link+3]; linkadr := CodeBase + impg.ca + link
|
|
|
+ ELSE
|
|
|
+ n := (impg.data[-link] MOD 256) + (impg.data[-link+1] MOD 256) * 256 + impg.data[-link+2] * 65536;
|
|
|
+ t := impg.data[-link+3]; linkadr := ConBase + impg.ma - link
|
|
|
+ END;
|
|
|
+ IF t = absolute THEN x := adr + offset
|
|
|
+ ELSIF t = relative THEN x := adr + offset - linkadr - 4
|
|
|
+ ELSIF t = copy THEN Get(impd, adr + offset - ConBase - impd.ma, x)
|
|
|
+ ELSIF t = table THEN x := adr + n; n := link + 4
|
|
|
+ ELSIF t = tableend THEN x := adr + n; n := 0
|
|
|
+ ELSE HALT(99)
|
|
|
+ END;
|
|
|
+ IF link > 0 THEN
|
|
|
+ code[link] := SHORT(SHORT(x));
|
|
|
+ code[link+1] := SHORT(SHORT(x DIV 100H));
|
|
|
+ code[link+2] := SHORT(SHORT(x DIV 10000H));
|
|
|
+ code[link+3] := SHORT(SHORT(x DIV 1000000H))
|
|
|
+ ELSE
|
|
|
+ link := -link;
|
|
|
+ impg.data[link] := SHORT(SHORT(x));
|
|
|
+ impg.data[link+1] := SHORT(SHORT(x DIV 100H));
|
|
|
+ impg.data[link+2] := SHORT(SHORT(x DIV 10000H));
|
|
|
+ impg.data[link+3] := SHORT(SHORT(x DIV 1000000H))
|
|
|
+ END;
|
|
|
+ IF (t # relative) & ((t # copy) OR (x DIV 65536 # 0)) THEN Reloc(linkadr) END;
|
|
|
+ link := n
|
|
|
+ END;
|
|
|
+ RNum(link)
|
|
|
+ END
|
|
|
+ END Fixup0;
|
|
|
+
|
|
|
+ PROCEDURE Fixup (adr: INTEGER);
|
|
|
+ VAR link: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ RNum(link); Fixup0(link, adr)
|
|
|
+ END Fixup;
|
|
|
+
|
|
|
+ PROCEDURE CheckDllImports (mod: Module);
|
|
|
+ VAR i, x, y: INTEGER; name: Name; imp: Module; exp: Export;
|
|
|
+
|
|
|
+ PROCEDURE SkipLink;
|
|
|
+ VAR a: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ RNum(a);
|
|
|
+ WHILE a # 0 DO RNum(a); RNum(a) END
|
|
|
+ END SkipLink;
|
|
|
+
|
|
|
+ BEGIN
|
|
|
+ R := mod.file.NewReader(R);
|
|
|
+ R.SetPos(mod.hs + mod.ms + mod.ds + mod.cs);
|
|
|
+ SkipLink; SkipLink; SkipLink; SkipLink; SkipLink; SkipLink; i := 0;
|
|
|
+ WHILE i < mod.ni DO
|
|
|
+ imp := mod.imp[i];
|
|
|
+ IF imp # NIL THEN
|
|
|
+ RNum(x);
|
|
|
+ WHILE x # 0 DO
|
|
|
+ ReadName(name); RNum(y);
|
|
|
+ IF x = mVar THEN SkipLink;
|
|
|
+ IF imp.dll THEN
|
|
|
+ WriteString("variable (");
|
|
|
+ WriteString(imp.name); WriteChar(".");
|
|
|
+ WriteSString(name);
|
|
|
+ WriteString(") imported from DLL in ");
|
|
|
+ WriteString(mod.name);
|
|
|
+ WriteLn; FlushW; error := TRUE;
|
|
|
+ RETURN
|
|
|
+ END
|
|
|
+ ELSIF x = mTyp THEN RNum(y);
|
|
|
+ IF imp.dll THEN
|
|
|
+ RNum(y);
|
|
|
+ IF y # 0 THEN
|
|
|
+ WriteString("type descriptor (");
|
|
|
+ WriteString(imp.name); WriteChar(".");
|
|
|
+ WriteSString(name);
|
|
|
+ WriteString(") imported from DLL in ");
|
|
|
+ WriteString(mod.name);
|
|
|
+ WriteLn; FlushW; error := TRUE;
|
|
|
+ RETURN
|
|
|
+ END
|
|
|
+ ELSE SkipLink
|
|
|
+ END
|
|
|
+ ELSIF x = mProc THEN
|
|
|
+ IF imp.dll THEN
|
|
|
+ SkipLink; exp := imp.exp;
|
|
|
+ WHILE (exp # NIL) & (exp.name # name) DO exp := exp.next END;
|
|
|
+ IF exp = NIL THEN
|
|
|
+ NEW(exp); exp.name := name$;
|
|
|
+ exp.next := imp.exp; imp.exp := exp; INC(DllSize, 6)
|
|
|
+ END
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ RNum(x)
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ INC(i)
|
|
|
+ END
|
|
|
+ END CheckDllImports;
|
|
|
+
|
|
|
+ PROCEDURE ReadHeaders;
|
|
|
+ VAR mod, im, t: Module; x, i: INTEGER; impdll: BOOLEAN; exp: Export; name: Name;
|
|
|
+ BEGIN
|
|
|
+ mod := modList; modList := NIL; numMod := 0;
|
|
|
+ WHILE mod # NIL DO (* reverse mod list & count modules *)
|
|
|
+ IF ~mod.dll THEN INC(numMod) END;
|
|
|
+ t := mod; mod := t.next; t.next := modList; modList := t
|
|
|
+ END;
|
|
|
+ IF isStatic THEN
|
|
|
+ IF isDll THEN
|
|
|
+ (* push ebx; cmp [12, esp], 1; jne L1; mov ebx, modlist; { call body; } jp L2 *)
|
|
|
+ (* L1: cmp [12, esp], 0; jne L2; { call term; } *)
|
|
|
+ (* L2: pop ebx; mov aex,1; ret 12 *)
|
|
|
+ CodeSize := 42 + 10 * numMod
|
|
|
+ ELSE
|
|
|
+ (* push ebx; push ebx; push ebx; mov ebx, modlist; { call body; } { call term; } *)
|
|
|
+ (* pop ebx; pop ebx; pop ebx; ret *)
|
|
|
+ CodeSize := 12 + 10 * numMod
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ IF isDll THEN
|
|
|
+ (* push ebx; cmp [12, esp], 1; jne L1; mov ebx, modlist; call main; jp L2 *)
|
|
|
+ (* L1: cmp [12, esp], 0; jne L2; call mainTerm; *)
|
|
|
+ (* L2: pop ebx; mov aex,1; ret 12 *)
|
|
|
+ CodeSize := 41
|
|
|
+ ELSE
|
|
|
+ (* mov ebx, modlist; jmp main *)
|
|
|
+ CodeSize := 10
|
|
|
+ END
|
|
|
+ END;
|
|
|
+(*
|
|
|
+ IF isDll THEN
|
|
|
+ CodeSize := 24 (* push ebx, esi, edi; mov bx, modlist; call main; pop edi, esi, ebx; mov aex,1; ret 12 *)
|
|
|
+ ELSE
|
|
|
+ CodeSize := 10 (* mov bx, modlist; jmp main *)
|
|
|
+ END
|
|
|
+*)
|
|
|
+ DataSize := 0; ConSize := 0;
|
|
|
+ ImpSize := 0; ImpHSize := 0; ExpSize := 0;
|
|
|
+ RelocSize := 0; DllSize := 0; noffixup := 0; maxCode := 0; numImp := 0; numExp := 0;
|
|
|
+ mod := modList;
|
|
|
+ WHILE mod # NIL DO
|
|
|
+ IF ~mod.dll THEN
|
|
|
+ mod.file := ThisFile(mod.name);
|
|
|
+ IF mod.file # NIL THEN
|
|
|
+ R := mod.file.NewReader(R); R.SetPos(0); Read4(x);
|
|
|
+ IF x = 6F4F4346H THEN
|
|
|
+ Read4(x);
|
|
|
+ Read4(mod.hs); Read4(mod.ms); Read4(mod.ds); Read4(mod.cs);
|
|
|
+ Read4(mod.vs); RNum(mod.ni); ReadName(name); impdll := FALSE;
|
|
|
+ IF mod.ni > 0 THEN
|
|
|
+ NEW(mod.imp, mod.ni); x := 0;
|
|
|
+ WHILE x < mod.ni DO
|
|
|
+ ReadName(name);
|
|
|
+ IF name = "$$" THEN
|
|
|
+ IF (mod # kernel) & (kernel # NIL) THEN
|
|
|
+ mod.imp[x] := kernel
|
|
|
+ ELSE
|
|
|
+ WriteSString("no kernel"); WriteLn;
|
|
|
+ FlushW; error := TRUE
|
|
|
+ END
|
|
|
+ ELSIF name[0] = "$" THEN
|
|
|
+ i := 1;
|
|
|
+ WHILE name[i] # 0X DO name[i-1] := name[i]; INC(i) END;
|
|
|
+ name[i-1] := 0X; impdll := TRUE; im := modList;
|
|
|
+ WHILE (im # mod) & (im.name # name) DO im := im.next END;
|
|
|
+ IF (im = NIL) OR ~im.dll THEN
|
|
|
+ NEW(im); im.next := modList; modList := im;
|
|
|
+ im.name := name$;
|
|
|
+ im.dll := TRUE
|
|
|
+ END;
|
|
|
+ mod.imp[x] := im;
|
|
|
+ ELSE
|
|
|
+ im := modList;
|
|
|
+ WHILE (im # mod) & (im.name # name) DO im := im.next END;
|
|
|
+ IF im # mod THEN
|
|
|
+ mod.imp[x] := im;
|
|
|
+ ELSE
|
|
|
+ WriteSString(name);
|
|
|
+ WriteString(" not present (imported in ");
|
|
|
+ WriteString(mod.name); WriteChar(")");
|
|
|
+ WriteLn; FlushW; error := TRUE
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ INC(x)
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ IF impdll & ~error THEN CheckDllImports(mod) END;
|
|
|
+ mod.ma := ConSize; INC(ConSize, mod.ms + mod.ds);
|
|
|
+ mod.va := DataSize; INC(DataSize, mod.vs);
|
|
|
+ mod.ca := CodeSize; INC(CodeSize, mod.cs);
|
|
|
+ IF mod.cs > maxCode THEN maxCode := mod.cs END
|
|
|
+ ELSE
|
|
|
+ WriteString(mod.name); WriteString(": wrong file type");
|
|
|
+ WriteLn; FlushW; error := TRUE
|
|
|
+ END;
|
|
|
+ mod.file.Close; mod.file := NIL
|
|
|
+ ELSE
|
|
|
+ WriteString(mod.name); WriteString(" not found");
|
|
|
+ WriteLn; FlushW; error := TRUE
|
|
|
+ END;
|
|
|
+ last := mod
|
|
|
+ END;
|
|
|
+ mod := mod.next
|
|
|
+ END;
|
|
|
+ IF ~isStatic & (main = NIL) THEN
|
|
|
+ WriteSString("no main module specified"); WriteLn;
|
|
|
+ FlushW; error := TRUE
|
|
|
+ END;
|
|
|
+ (* calculate rva's *)
|
|
|
+ IF DataSize = 0 THEN DataSize := 1 END;
|
|
|
+ CodeRva := ObjAlign;
|
|
|
+ DataRva := CodeRva + (CodeSize + DllSize + (ObjAlign - 1)) DIV ObjAlign * ObjAlign;
|
|
|
+ ConRva := DataRva + (DataSize + (ObjAlign - 1)) DIV ObjAlign * ObjAlign;
|
|
|
+ RsrcRva := ConRva + (ConSize + (ObjAlign - 1)) DIV ObjAlign * ObjAlign;
|
|
|
+ CodeBase := ImageBase + CodeRva;
|
|
|
+ DataBase := ImageBase + DataRva;
|
|
|
+ ConBase := ImageBase + ConRva;
|
|
|
+ (* write dll export adresses *)
|
|
|
+ mod := modList; x := 0;
|
|
|
+ WHILE mod # NIL DO
|
|
|
+ IF mod.dll THEN
|
|
|
+ exp := mod.exp; INC(ImpSize, 20);
|
|
|
+ WHILE exp # NIL DO exp.adr := x; INC(x, 6); exp := exp.next END
|
|
|
+ END;
|
|
|
+ mod := mod.next
|
|
|
+ END;
|
|
|
+ ASSERT(x = DllSize); INC(ImpSize, 20); (* sentinel *)
|
|
|
+ END ReadHeaders;
|
|
|
+
|
|
|
+ PROCEDURE MenuSize (r: Resource): INTEGER;
|
|
|
+ VAR s, i: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ s := 0;
|
|
|
+ WHILE r # NIL DO
|
|
|
+ INC(s, 2);
|
|
|
+ IF r.local = NIL THEN INC(s, 2) END;
|
|
|
+ i := 0; WHILE r.name[i] # 0X DO INC(s, 2); INC(i) END;
|
|
|
+ INC(s, 2);
|
|
|
+ s := s + MenuSize(r.local);
|
|
|
+ r := r.next
|
|
|
+ END;
|
|
|
+ RETURN s
|
|
|
+ END MenuSize;
|
|
|
+
|
|
|
+ PROCEDURE PrepResources;
|
|
|
+ VAR res, r, s: Resource; n, i, j, t, x: INTEGER; loc: Files.Locator;
|
|
|
+ BEGIN
|
|
|
+ r := resList;
|
|
|
+ WHILE r # NIL DO
|
|
|
+ IF r.lid = 0 THEN r.lid := 1033 END;
|
|
|
+ IF r.name = "MENU" THEN
|
|
|
+ r.typ := 4; r.size := 4 + MenuSize(r.local);
|
|
|
+ ELSIF r.name = "ACCELERATOR" THEN
|
|
|
+ r.typ := 9; r.size := 0; s := r.local;
|
|
|
+ WHILE s # NIL DO INC(r.size, 8); s := s.next END;
|
|
|
+ ELSE
|
|
|
+ r.file := ThisResFile(r.name);
|
|
|
+ IF r.file # NIL THEN
|
|
|
+ IF r.typ = -1 THEN (* typelib *)
|
|
|
+ r.typ := 0; r.size := r.file.Length(); r.pos := 0; rsrcName := "TYPELIB"
|
|
|
+ ELSE
|
|
|
+ R := r.file.NewReader(R); R.SetPos(0); Read2(n);
|
|
|
+ IF n = 4D42H THEN (* bitmap *)
|
|
|
+ Read4(n); r.typ := 2; r.size := n - 14; r.pos := 14;
|
|
|
+ ELSE
|
|
|
+ Read2(x);
|
|
|
+ IF x = 1 THEN (* icon *)
|
|
|
+ Read2(n); r.typ := 14; r.size := 6 + 14 * n; r.pos := 0; i := 0;
|
|
|
+ WHILE i < n DO
|
|
|
+ NEW(s); s.typ := 3; s.id := 10 * r.id + i; s.lid := r.lid; s.name := r.name$;
|
|
|
+ Read4(x); Read4(x); Read4(s.size); Read2(s.pos); Read2(x);
|
|
|
+ s.next := resList; resList := s;
|
|
|
+ INC(i)
|
|
|
+ END
|
|
|
+ ELSIF x = 2 THEN (* cursor *)
|
|
|
+ Read2(n); r.typ := 12; r.size := 6 + 14 * n; r.pos := 0; i := 0;
|
|
|
+ WHILE i < n DO
|
|
|
+ NEW(s); s.typ := 1; s.id := 10 * r.id + i; s.lid := r.lid; s.name := r.name$;
|
|
|
+ Read4(x); Read2(s.x); Read2(s.y); Read4(s.size); INC(s.size, 4); Read2(s.pos); Read2(x);
|
|
|
+ s.next := resList; resList := s;
|
|
|
+ INC(i)
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ Read4(n);
|
|
|
+ IF (x = 0) & (n = 20H) THEN (* resource file *)
|
|
|
+ Read4(n); Read4(n); Read4(n); Read4(n); Read4(n); Read4(n); (* 32 bit marker *)
|
|
|
+ Read4(r.size); Read4(n); Read2(i);
|
|
|
+ IF i = 0FFFFH THEN
|
|
|
+ Read2(j);
|
|
|
+ IF (j >= 4) & ((j <= 11) OR (j = 16)) THEN
|
|
|
+ r.typ := j; r.pos := n + 32;
|
|
|
+ ELSE
|
|
|
+ WriteString(r.name); WriteString(": invalid type"); WriteLn;
|
|
|
+ FlushW; error := TRUE
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ j := 0;
|
|
|
+ WHILE i # 0 DO rsrcName[j] := CHR(i); INC(j); Read2(i) END;
|
|
|
+ rsrcName[j] := 0X;
|
|
|
+ r.typ := 0; r.pos := n + 32
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ WriteString(r.name); WriteString(": unknown type"); WriteLn;
|
|
|
+ FlushW; error := TRUE
|
|
|
+ END
|
|
|
+ END
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ r.file.Close; r.file := NIL
|
|
|
+ ELSE
|
|
|
+ WriteString(r.name); WriteString(" not found"); WriteLn;
|
|
|
+ FlushW; error := TRUE
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ r := r.next
|
|
|
+ END;
|
|
|
+ res := resList; resList := NIL; (* sort resources *)
|
|
|
+ WHILE res # NIL DO
|
|
|
+ r := res; res := res.next;
|
|
|
+ IF (resList = NIL) OR (r.typ < resList.typ) OR (r.typ = resList.typ) & ((r.id < resList.id) OR (r.id = resList.id) & (r.lid < resList.lid))
|
|
|
+ THEN
|
|
|
+ r.next := resList; resList := r
|
|
|
+ ELSE
|
|
|
+ s := resList;
|
|
|
+ WHILE (s.next # NIL) & (r.typ >= s.next.typ)
|
|
|
+ & ((r.typ # s.next.typ) OR (r.id >= s.next.id) & ((r.id # s.next.id) OR (r.lid >= s.next.lid))) DO s := s.next END;
|
|
|
+ r.next := s.next; s.next := r
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ r := resList; numType := 0; resHSize := 16; t := 0; n := 0; (* get resource size *)
|
|
|
+ WHILE t < LEN(numId) DO numId[t] := 0; INC(t) END;
|
|
|
+ WHILE r # NIL DO
|
|
|
+ INC(numType); INC(resHSize, 24); t := r.typ;
|
|
|
+ WHILE (r # NIL) & (r.typ = t) DO
|
|
|
+ INC(numId[t]); INC(resHSize, 24); i := r.id;
|
|
|
+ WHILE (r # NIL) & (r.typ = t) & (r.id = i) DO
|
|
|
+ INC(resHSize, 24); INC(n, (r.size + 3) DIV 4 * 4); r := r.next
|
|
|
+ END
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ IF numId[0] > 0 THEN INC(n, (LEN(rsrcName$) + 1) * 2) END;
|
|
|
+ RsrcSize := resHSize + n;
|
|
|
+ ImpRva := RsrcRva + (RsrcSize + (ObjAlign - 1)) DIV ObjAlign * ObjAlign
|
|
|
+ END PrepResources;
|
|
|
+
|
|
|
+ PROCEDURE WriteHeader(VAR name: Files.Name);
|
|
|
+ BEGIN
|
|
|
+ Out := Files.dir.New(Files.dir.This(""), Files.ask); Ro := Out.NewWriter(Ro); Ro.SetPos(0);
|
|
|
+
|
|
|
+ (* DOS header *)
|
|
|
+ Write4(905A4DH); Write4(3); Write4(4); Write4(0FFFFH);
|
|
|
+ Write4(0B8H); Write4(0); Write4(40H); Write4(0);
|
|
|
+ Write4(0); Write4(0); Write4(0); Write4(0);
|
|
|
+ Write4(0); Write4(0); Write4(0); Write4(80H);
|
|
|
+ Write4(0EBA1F0EH); Write4(0CD09B400H); Write4(4C01B821H); Write2(21CDH);
|
|
|
+ WriteName("This program cannot be run in DOS mode.", 39);
|
|
|
+ WriteCh(0DX); WriteCh(0DX); WriteCh(0AX);
|
|
|
+ Write4(24H); Write4(0);
|
|
|
+
|
|
|
+ (* Win32 header *)
|
|
|
+ WriteName("PE", 4); (* signature bytes *)
|
|
|
+ Write2(014CH); (* cpu type (386) *)
|
|
|
+ IF isDll THEN
|
|
|
+ Write2(7); (* 7 objects *)
|
|
|
+ ELSE
|
|
|
+ Write2(6); (* 6 objects *)
|
|
|
+ END;
|
|
|
+ Write4(timeStamp); (* time/date *)
|
|
|
+ Write4(0); Write4(0);
|
|
|
+ Write2(0E0H); (* NT header size *)
|
|
|
+ IF isDll THEN
|
|
|
+ Write2(0A38EH); (* library image flags *)
|
|
|
+ ELSE
|
|
|
+ Write2(838EH); (* program image flags *)
|
|
|
+ END;
|
|
|
+ Write2(10BH); (* magic (normal ececutable file) *)
|
|
|
+ Write2(0301H); (* linker version !!! *)
|
|
|
+ Write4(CodeSize); (* code size *)
|
|
|
+ Write4(ConSize); (* initialized data size *)
|
|
|
+ Write4(DataSize); (* uninitialized data size *)
|
|
|
+ entryPos := Ro.Pos();
|
|
|
+ Write4(0); (* entry point *) (* !!! *)
|
|
|
+ Write4(CodeRva); (* base of code *)
|
|
|
+ Write4(ConRva); (* base of data *)
|
|
|
+ Write4(400000H); (* image base *)
|
|
|
+ Write4(ObjAlign); (* object align *)
|
|
|
+ Write4(FileAlign); (* file align *)
|
|
|
+ Write4(3); (* OS version *)
|
|
|
+ Write4(4); (* user version *)
|
|
|
+ Write4(4); (* subsys version *) (* mf 14.3.04: value changed from 0A0003H to 4. Corrects menubar pixel bug on Windows XP *)
|
|
|
+ Write4(0);
|
|
|
+ isPos := Ro.Pos();
|
|
|
+ Write4(0); (* image size *) (* !!! *)
|
|
|
+ Write4(HeaderSize); (* header size !!! *)
|
|
|
+ Write4(0); (* checksum *)
|
|
|
+ IF comLine THEN
|
|
|
+ Write2(3) (* dos subsystem *)
|
|
|
+ ELSE
|
|
|
+ Write2(2) (* gui subsystem *)
|
|
|
+ END;
|
|
|
+ Write2(0); (* dll flags *)
|
|
|
+ Write4(200000H); (* stack reserve size *)
|
|
|
+ Write4(10000H); (* stack commit size *)
|
|
|
+ IF isDll THEN
|
|
|
+ Write4(00100000H); (* heap reserve size *)
|
|
|
+ ELSE
|
|
|
+ Write4(00400000H); (* heap reserve size *)
|
|
|
+ END;
|
|
|
+ Write4(10000H); (* heap commit size *)
|
|
|
+ Write4(0);
|
|
|
+ Write4(16); (* num of rva/sizes *)
|
|
|
+ hexpPos := Ro.Pos();
|
|
|
+ Write4(0); Write4(0); (* export table *)
|
|
|
+ himpPos := Ro.Pos();
|
|
|
+ Write4(0); Write4(0); (* import table *) (* !!! *)
|
|
|
+ hrsrcPos := Ro.Pos();
|
|
|
+ Write4(0); Write4(0); (* resource table *) (* !!! *)
|
|
|
+ Write4(0); Write4(0); (* exception table *)
|
|
|
+ Write4(0); Write4(0); (* security table *)
|
|
|
+ fixPos := Ro.Pos();
|
|
|
+ Write4(0); Write4(0); (* fixup table *) (* !!! *)
|
|
|
+ Write4(0); Write4(0); (* debug table *)
|
|
|
+ Write4(0); Write4(0); (* image description *)
|
|
|
+ Write4(0); Write4(0); (* machine specific *)
|
|
|
+ Write4(0); Write4(0); (* thread local storage *)
|
|
|
+ Write4(0); Write4(0); (* ??? *)
|
|
|
+ Write4(0); Write4(0); (* ??? *)
|
|
|
+ Write4(0); Write4(0); (* ??? *)
|
|
|
+ Write4(0); Write4(0); (* ??? *)
|
|
|
+ Write4(0); Write4(0); (* ??? *)
|
|
|
+ Write4(0); Write4(0); (* ??? *)
|
|
|
+
|
|
|
+ (* object directory *)
|
|
|
+ WriteName(".text", 8); (* code object *)
|
|
|
+ Write4(0); (* object size (always 0) *)
|
|
|
+ codePos := Ro.Pos();
|
|
|
+ Write4(0); (* object rva *)
|
|
|
+ Write4(0); (* physical size *)
|
|
|
+ Write4(0); (* physical offset *)
|
|
|
+ Write4(0); Write4(0); Write4(0);
|
|
|
+ Write4(60000020H); (* flags: code, exec, read *)
|
|
|
+
|
|
|
+ WriteName(".var", 8); (* variable object *)
|
|
|
+ Write4(0); (* object size (always 0) *)
|
|
|
+ dataPos := Ro.Pos();
|
|
|
+ Write4(0); (* object rva *)
|
|
|
+ Write4(0); (* physical size *)
|
|
|
+ Write4(0); (* physical offset *) (* zero! (noinit) *)
|
|
|
+ Write4(0); Write4(0); Write4(0);
|
|
|
+ Write4(0C0000080H); (* flags: noinit, read, write *)
|
|
|
+
|
|
|
+ WriteName(".data", 8); (* constant object *)
|
|
|
+ Write4(0); (* object size (always 0) *)
|
|
|
+ conPos := Ro.Pos();
|
|
|
+ Write4(0); (* object rva *)
|
|
|
+ Write4(0); (* physical size *)
|
|
|
+ Write4(0); (* physical offset *)
|
|
|
+ Write4(0); Write4(0); Write4(0);
|
|
|
+ Write4(0C0000040H); (* flags: data, read, write *)
|
|
|
+
|
|
|
+ WriteName(".rsrc", 8); (* resource object *)
|
|
|
+ Write4(0); (* object size (always 0) *)
|
|
|
+ rsrcPos := Ro.Pos();
|
|
|
+ Write4(0); (* object rva *)
|
|
|
+ Write4(0); (* physical size *)
|
|
|
+ Write4(0); (* physical offset *)
|
|
|
+ Write4(0); Write4(0); Write4(0);
|
|
|
+ Write4(0C0000040H); (* flags: data, read, write *)
|
|
|
+
|
|
|
+ WriteName(".idata", 8); (* import object *)
|
|
|
+ Write4(0); (* object size (always 0) *)
|
|
|
+ impPos := Ro.Pos();
|
|
|
+ Write4(0); (* object rva *)
|
|
|
+ Write4(0); (* physical size *)
|
|
|
+ Write4(0); (* physical offset *)
|
|
|
+ Write4(0); Write4(0); Write4(0);
|
|
|
+ Write4(0C0000040H); (* flags: data, read, write *)
|
|
|
+
|
|
|
+ IF isDll THEN
|
|
|
+ WriteName(".edata", 8); (* export object *)
|
|
|
+ Write4(0); (* object size (always 0) *)
|
|
|
+ expPos := Ro.Pos();
|
|
|
+ Write4(0); (* object rva *)
|
|
|
+ Write4(0); (* physical size *)
|
|
|
+ Write4(0); (* physical offset *)
|
|
|
+ Write4(0); Write4(0); Write4(0);
|
|
|
+ Write4(0C0000040H); (* flags: data, read, write *)
|
|
|
+ END;
|
|
|
+
|
|
|
+ WriteName(".reloc", 8); (* relocation object *)
|
|
|
+ Write4(0); (* object size (always 0) *)
|
|
|
+ relPos := Ro.Pos();
|
|
|
+ Write4(0); (* object rva *)
|
|
|
+ Write4(0); (* physical size *)
|
|
|
+ Write4(0); (* physical offset *)
|
|
|
+ Write4(0); Write4(0); Write4(0);
|
|
|
+ Write4(42000040H); (* flags: data, read, ? *)
|
|
|
+ END WriteHeader;
|
|
|
+
|
|
|
+ PROCEDURE SearchObj (mod: Module; VAR name: ARRAY OF SHORTCHAR; m, fp, opt: INTEGER; VAR adr: INTEGER);
|
|
|
+ VAR dir, len, ntab, f, id, l, r, p, n, i, j: INTEGER; nch, och: SHORTCHAR;
|
|
|
+ BEGIN
|
|
|
+ Get(mod, mod.ms + modExports, dir); DEC(dir, ConBase + mod.ma); Get(mod, dir, len); INC(dir, 4);
|
|
|
+ Get(mod, mod.ms + modNames, ntab); DEC(ntab, ConBase + mod.ma);
|
|
|
+ IF name # "" THEN
|
|
|
+ l := 0; r := len;
|
|
|
+ WHILE l < r DO (* binary search *)
|
|
|
+ n := (l + r) DIV 2; p := dir + n * 16;
|
|
|
+ Get(mod, p + 8, id);
|
|
|
+ i := 0; j := ntab + id DIV 256; nch := name[0]; och := SHORT(CHR(mod.data[j]));
|
|
|
+ WHILE (nch = och) & (nch # 0X) DO INC(i); INC(j); nch := name[i]; och := SHORT(CHR(mod.data[j])) END;
|
|
|
+ IF och = nch THEN
|
|
|
+ IF id MOD 16 = m THEN Get(mod, p, f);
|
|
|
+ IF m = mTyp THEN
|
|
|
+ IF ODD(opt) THEN Get(mod, p + 4, f) END;
|
|
|
+ IF (opt > 1) & (id DIV 16 MOD 16 # mExported) THEN
|
|
|
+ WriteString(mod.name); WriteChar("."); WriteSString(name);
|
|
|
+ WriteString(" imported from "); WriteString(impg.name);
|
|
|
+ WriteString(" has wrong visibility"); WriteLn; error := TRUE
|
|
|
+ END;
|
|
|
+ Get(mod, p + 12, adr)
|
|
|
+ ELSIF m = mVar THEN
|
|
|
+ Get(mod, p + 4, adr); INC(adr, DataBase + mod.va)
|
|
|
+ ELSIF m = mProc THEN
|
|
|
+ Get(mod, p + 4, adr); INC(adr, CodeBase + mod.ca)
|
|
|
+ END;
|
|
|
+ IF f # fp THEN
|
|
|
+ WriteString(mod.name); WriteChar("."); WriteSString(name);
|
|
|
+ WriteString(" imported from "); WriteString(impg.name);
|
|
|
+ WriteString(" has wrong fprint"); WriteLn; error := TRUE
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ WriteString(mod.name); WriteChar("."); WriteSString(name);
|
|
|
+ WriteString(" imported from "); WriteString(impg.name);
|
|
|
+ WriteString(" has wrong class"); WriteLn; error := TRUE
|
|
|
+ END;
|
|
|
+ RETURN
|
|
|
+ END;
|
|
|
+ IF och < nch THEN l := n + 1 ELSE r := n END
|
|
|
+ END;
|
|
|
+ WriteString(mod.name); WriteChar("."); WriteSString(name);
|
|
|
+ WriteString(" not found (imported from "); WriteString(impg.name);
|
|
|
+ WriteChar(")"); WriteLn; error := TRUE
|
|
|
+ ELSE (* anonymous type *)
|
|
|
+ WHILE len > 0 DO
|
|
|
+ Get(mod, dir + 4, f); Get(mod, dir + 8, id);
|
|
|
+ IF (f = fp) & (id MOD 16 = mTyp) & (id DIV 256 = 0) THEN
|
|
|
+ Get(mod, dir + 12, adr); RETURN
|
|
|
+ END;
|
|
|
+ DEC(len); INC(dir, 16)
|
|
|
+ END;
|
|
|
+ WriteString("anonymous type in "); WriteString(mod.name);
|
|
|
+ WriteString(" not found"); WriteLn; error := TRUE
|
|
|
+ END
|
|
|
+ END SearchObj;
|
|
|
+
|
|
|
+ PROCEDURE CollectExports (mod: Module);
|
|
|
+ VAR dir, len, ntab, id, i, j, n: INTEGER; e, exp: Export;
|
|
|
+ BEGIN
|
|
|
+ Get(mod, mod.ms + modExports, dir); DEC(dir, ConBase + mod.ma); Get(mod, dir, len); INC(dir, 4);
|
|
|
+ Get(mod, mod.ms + modNames, ntab); DEC(ntab, ConBase + mod.ma); n := 0;
|
|
|
+ WHILE n < len DO
|
|
|
+ Get(mod, dir + 8, id);
|
|
|
+ IF (id DIV 16 MOD 16 # mInternal) & ((id MOD 16 = mProc) OR (id MOD 16 = mVar))THEN (* exported procedure & var *)
|
|
|
+ NEW(exp);
|
|
|
+ i := 0; j := ntab + id DIV 256;
|
|
|
+ WHILE mod.data[j] # 0 DO exp.name[i] := SHORT(CHR(mod.data[j])); INC(i); INC(j) END;
|
|
|
+ exp.name[i] := 0X;
|
|
|
+ Get(mod, dir + 4, exp.adr);
|
|
|
+ IF id MOD 16 = mProc THEN INC(exp.adr, CodeRva + mod.ca)
|
|
|
+ ELSE ASSERT(id MOD 16 = mVar); INC(exp.adr, DataRva + mod.va)
|
|
|
+ END;
|
|
|
+ IF (firstExp = NIL) OR (exp.name < firstExp.name) THEN
|
|
|
+ exp.next := firstExp; firstExp := exp;
|
|
|
+ IF lastExp = NIL THEN lastExp := exp END
|
|
|
+ ELSE
|
|
|
+ e := firstExp;
|
|
|
+ WHILE (e.next # NIL) & (exp.name > e.next.name) DO e := e.next END;
|
|
|
+ exp.next := e.next; e.next := exp;
|
|
|
+ IF lastExp = e THEN lastExp := exp END
|
|
|
+ END;
|
|
|
+ INC(numExp);
|
|
|
+ END;
|
|
|
+ INC(n); INC(dir, 16)
|
|
|
+ END
|
|
|
+ END CollectExports;
|
|
|
+
|
|
|
+ PROCEDURE WriteTermCode (m: Module; i: INTEGER);
|
|
|
+ VAR x: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ IF m # NIL THEN
|
|
|
+ IF m.dll THEN WriteTermCode(m.next, i)
|
|
|
+ ELSE
|
|
|
+ IF isStatic THEN WriteTermCode(m.next, i + 1) END;
|
|
|
+ Get(m, m.ms + modTerm, x); (* terminator address in mod desc*)
|
|
|
+ IF x = 0 THEN
|
|
|
+ WriteCh(005X); Write4(0) (* add EAX, 0 (nop) *)
|
|
|
+ ELSE
|
|
|
+ WriteCh(0E8X); Write4(x - lastTerm + 5 * i - CodeBase) (* call term *)
|
|
|
+ END
|
|
|
+ END
|
|
|
+ END
|
|
|
+ END WriteTermCode;
|
|
|
+
|
|
|
+ PROCEDURE WriteCode;
|
|
|
+ VAR mod, m: Module; i, x, a, fp, opt: INTEGER; exp: Export; name: Name;
|
|
|
+ BEGIN
|
|
|
+ IF isStatic THEN
|
|
|
+ WriteCh(053X); (* push ebx *)
|
|
|
+ a := 1;
|
|
|
+ IF isDll THEN
|
|
|
+ WriteCh(083X); WriteCh(07CX); WriteCh(024X); WriteCh(00CX); WriteCh(001X); (* cmp [12, esp], 1 *)
|
|
|
+ WriteCh(00FX); WriteCh(085X); Write4(10 + 5 * numMod); (* jne L1 *)
|
|
|
+ INC(a, 11)
|
|
|
+ ELSE
|
|
|
+ WriteCh(053X); WriteCh(053X); (* push ebx; push ebx *)
|
|
|
+ INC(a, 2)
|
|
|
+ END;
|
|
|
+ WriteCh(0BBX); Write4(ConBase + last.ma + last.ms); Reloc(CodeBase + a + 1); (* mov bx, modlist *)
|
|
|
+ INC(a, 5); m := modList;
|
|
|
+ WHILE m # NIL DO
|
|
|
+ IF ~m.dll THEN
|
|
|
+ WriteCh(0E8X); INC(a, 5); Write4(m.ca - a) (* call body *)
|
|
|
+ END;
|
|
|
+ m := m.next
|
|
|
+ END;
|
|
|
+ IF isDll THEN
|
|
|
+ WriteCh(0E9X); Write4(11 + 5 * numMod); (* jp L2 *)
|
|
|
+ WriteCh(083X); WriteCh(07CX); WriteCh(024X); WriteCh(00CX); WriteCh(000X); (* L1: cmp [12, esp], 0 *)
|
|
|
+ WriteCh(00FX); WriteCh(085X); Write4(5 * numMod); (* jne L2 *)
|
|
|
+ INC(a, 16)
|
|
|
+ END;
|
|
|
+ termPos := Ro.Pos(); i := 0;
|
|
|
+ WHILE i < numMod DO (* nop for call terminator *)
|
|
|
+ WriteCh(02DX); Write4(0); (* sub EAX, 0 *)
|
|
|
+ INC(i); INC(a, 5)
|
|
|
+ END;
|
|
|
+ lastTerm := a;
|
|
|
+ WriteCh(05BX); (* L2: pop ebx *)
|
|
|
+ IF isDll THEN
|
|
|
+ WriteCh(0B8X); Write4(1); (* mov eax,1 *)
|
|
|
+ WriteCh(0C2X); Write2(12) (* ret 12 *)
|
|
|
+ ELSE
|
|
|
+ WriteCh(05BX); WriteCh(05BX); (* pop ebx; pop ebx *)
|
|
|
+ WriteCh(0C3X) (* ret *)
|
|
|
+ END
|
|
|
+ ELSIF isDll THEN
|
|
|
+ WriteCh(053X); (* push ebx *)
|
|
|
+ WriteCh(083X); WriteCh(07CX); WriteCh(024X); WriteCh(00CX); WriteCh(001X); (* cmp [12, esp], 1 *)
|
|
|
+ WriteCh(075X); WriteCh(SHORT(CHR(12))); (* jne L1 *)
|
|
|
+ WriteCh(0BBX); Write4(ConBase + last.ma + last.ms); Reloc(CodeBase + 9); (* mov bx, modlist *)
|
|
|
+ WriteCh(0E8X); Write4(main.ca - 18); (* call main *)
|
|
|
+ WriteCh(0EBX); WriteCh(SHORT(CHR(12))); (* jp L2 *)
|
|
|
+ WriteCh(083X); WriteCh(07CX); WriteCh(024X); WriteCh(00CX); WriteCh(000X); (* L1: cmp [12, esp], 0 *)
|
|
|
+ WriteCh(075X); WriteCh(SHORT(CHR(5))); (* jne L2 *)
|
|
|
+ termPos := Ro.Pos();
|
|
|
+ WriteCh(02DX); Write4(0); (* sub EAX, 0 *) (* nop for call terminator *)
|
|
|
+ lastTerm := 32;
|
|
|
+ WriteCh(05BX); (* L2: pop ebx *)
|
|
|
+ WriteCh(0B8X); Write4(1); (* mov eax,1 *)
|
|
|
+ WriteCh(0C2X); Write2(12) (* ret 12 *)
|
|
|
+ ELSE
|
|
|
+ WriteCh(0BBX); Write4(ConBase + last.ma + last.ms); Reloc(CodeBase + 1); (* mov bx, modlist *)
|
|
|
+ WriteCh(0E9X); Write4(main.ca - 10); (* jmp main *)
|
|
|
+ END;
|
|
|
+ NEW(code, maxCode);
|
|
|
+ mod := modList;
|
|
|
+ WHILE mod # NIL DO impg := mod; impd := mod;
|
|
|
+ IF ~mod.dll THEN
|
|
|
+ mod.file := ThisFile(mod.name);
|
|
|
+ R := mod.file.NewReader(R); R.SetPos(mod.hs);
|
|
|
+ NEW(mod.data, mod.ms + mod.ds);
|
|
|
+ R.ReadBytes(mod.data^, 0, mod.ms + mod.ds);
|
|
|
+ R.ReadBytes(code^, 0, mod.cs);
|
|
|
+ RNum(x);
|
|
|
+ IF x # 0 THEN
|
|
|
+ IF (mod # kernel) & (kernel # NIL) THEN
|
|
|
+ SearchObj(kernel, newRec, mProc, NewRecFP, -1, a); Fixup0(x, a)
|
|
|
+ ELSE
|
|
|
+ WriteSString("no kernel"); WriteLn;
|
|
|
+ FlushW; error := TRUE; RETURN
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ RNum(x);
|
|
|
+ IF x # 0 THEN
|
|
|
+ IF (mod # kernel) & (kernel # NIL) THEN
|
|
|
+ SearchObj(kernel, newArr, mProc, NewArrFP, -1, a); Fixup0(x, a)
|
|
|
+ ELSE
|
|
|
+ WriteSString("no kernel"); WriteLn;
|
|
|
+ FlushW; error := TRUE; RETURN
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ Fixup(ConBase + mod.ma);
|
|
|
+ Fixup(ConBase + mod.ma + mod.ms);
|
|
|
+ Fixup(CodeBase + mod.ca);
|
|
|
+ Fixup(DataBase + mod.va); i := 0;
|
|
|
+ WHILE i < mod.ni DO
|
|
|
+ m := mod.imp[i]; impd := m; RNum(x);
|
|
|
+ WHILE x # 0 DO
|
|
|
+ ReadName(name); RNum(fp); opt := 0;
|
|
|
+ IF x = mTyp THEN RNum(opt) END;
|
|
|
+ IF m.dll THEN
|
|
|
+ IF x = mProc THEN exp := m.exp;
|
|
|
+ WHILE exp.name # name DO exp := exp.next END;
|
|
|
+ a := exp.adr + CodeBase + CodeSize
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ SearchObj(m, name, x, fp, opt, a)
|
|
|
+ END;
|
|
|
+ IF x # mConst THEN Fixup(a) END;
|
|
|
+ RNum(x)
|
|
|
+ END;
|
|
|
+ IF ~m.dll THEN
|
|
|
+ Get(mod, mod.ms + modImports, x); DEC(x, ConBase + mod.ma); INC(x, 4 * i);
|
|
|
+ Put(mod, x, ConBase + m.ma + m.ms); (* imp ref *)
|
|
|
+ Reloc(ConBase + mod.ma + x);
|
|
|
+ Get(m, m.ms + modRefcnt, x); Put(m, m.ms + modRefcnt, x + 1) (* inc ref count *)
|
|
|
+ END;
|
|
|
+ INC(i)
|
|
|
+ END;
|
|
|
+ Ro.WriteBytes(code^, 0, mod.cs);
|
|
|
+ IF mod.intf THEN CollectExports(mod) END;
|
|
|
+ mod.file.Close; mod.file := NIL
|
|
|
+ END;
|
|
|
+ mod := mod.next
|
|
|
+ END;
|
|
|
+ (* dll links *)
|
|
|
+ mod := modList; ImpHSize := ImpSize;
|
|
|
+ WHILE mod # NIL DO
|
|
|
+ IF mod.dll THEN
|
|
|
+ exp := mod.exp;
|
|
|
+ WHILE exp # NIL DO
|
|
|
+ WriteCh(0FFX); WriteCh(25X); Write4(ImageBase + ImpRva + ImpSize); (* JMP indirect *)
|
|
|
+ Reloc(CodeBase + CodeSize + exp.adr + 2);
|
|
|
+ INC(ImpSize, 4); INC(numImp); exp := exp.next
|
|
|
+ END;
|
|
|
+ INC(ImpSize, 4); INC(numImp) (* sentinel *)
|
|
|
+ END;
|
|
|
+ mod := mod.next
|
|
|
+ END
|
|
|
+ END WriteCode;
|
|
|
+
|
|
|
+ PROCEDURE WriteConst;
|
|
|
+ VAR mod, last: Module; x: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ mod := modList; last := NIL;
|
|
|
+ WHILE mod # NIL DO
|
|
|
+ IF ~mod.dll THEN
|
|
|
+ IF last # NIL THEN
|
|
|
+ Put(mod, mod.ms, ConBase + last.ma + last.ms); (* mod list *)
|
|
|
+ Reloc(ConBase + mod.ma + mod.ms);
|
|
|
+ END;
|
|
|
+ Get(mod, mod.ms + modOpts, x);
|
|
|
+ IF isStatic THEN INC(x, 10000H) END; (* set init bit (16) *)
|
|
|
+ IF isDll THEN INC(x, 1000000H) END; (* set dll bit (24) *)
|
|
|
+ Put(mod, mod.ms + modOpts, x);
|
|
|
+ Ro.WriteBytes(mod.data^, 0, mod.ms + mod.ds);
|
|
|
+ last := mod
|
|
|
+ END;
|
|
|
+ mod := mod.next
|
|
|
+ END
|
|
|
+ END WriteConst;
|
|
|
+
|
|
|
+ PROCEDURE WriteResDir (n, i: INTEGER);
|
|
|
+ BEGIN
|
|
|
+ Write4(0); (* flags *)
|
|
|
+ Write4(timeStamp);
|
|
|
+ Write4(0); (* version *)
|
|
|
+ Write2(n); (* name entries *)
|
|
|
+ Write2(i); (* id entries *)
|
|
|
+ END WriteResDir;
|
|
|
+
|
|
|
+ PROCEDURE WriteResDirEntry (id, adr: INTEGER; dir: BOOLEAN);
|
|
|
+ BEGIN
|
|
|
+ IF id = 0 THEN id := resHSize + 80000000H END; (* name Rva *)
|
|
|
+ Write4(id);
|
|
|
+ IF dir THEN Write4(adr + 80000000H) ELSE Write4(adr) END
|
|
|
+ END WriteResDirEntry;
|
|
|
+
|
|
|
+ PROCEDURE WriteMenu (res: Resource);
|
|
|
+ VAR f, i: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ WHILE res # NIL DO
|
|
|
+ IF res.next = NIL THEN f := 80H ELSE f := 0 END;
|
|
|
+ IF 29 IN res.opts THEN INC(f, 1) END; (* = grayed *)
|
|
|
+ IF 13 IN res.opts THEN INC(f, 2) END; (* - inctive *)
|
|
|
+ IF 3 IN res.opts THEN INC(f, 4) END; (* # bitmap *)
|
|
|
+ IF 10 IN res.opts THEN INC(f, 8) END; (* * checked *)
|
|
|
+ IF 1 IN res.opts THEN INC(f, 20H) END; (* ! menubarbreak *)
|
|
|
+ IF 15 IN res.opts THEN INC(f, 40H) END; (* / menubreak *)
|
|
|
+ IF 31 IN res.opts THEN INC(f, 100H) END; (* ? ownerdraw *)
|
|
|
+ IF res.local # NIL THEN Write2(f + 10H) ELSE Write2(f); Write2(res.id) END;
|
|
|
+ i := 0; WHILE res.name[i] # 0X DO Write2(ORD(res.name[i])); INC(i) END;
|
|
|
+ Write2(0);
|
|
|
+ WriteMenu(res.local);
|
|
|
+ res := res.next
|
|
|
+ END
|
|
|
+ END WriteMenu;
|
|
|
+
|
|
|
+ PROCEDURE WriteResource;
|
|
|
+ VAR r, s: Resource; i, t, a, x, n, nlen, nsize: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ IF numId[0] > 0 THEN WriteResDir(1, numType - 1); nlen := LEN(rsrcName$); nsize := (nlen + 1) * 2;
|
|
|
+ ELSE WriteResDir(0, numType)
|
|
|
+ END;
|
|
|
+ a := 16 + 8 * numType; t := 0;
|
|
|
+ WHILE t < LEN(numId) DO
|
|
|
+ IF numId[t] > 0 THEN WriteResDirEntry(t, a, TRUE); INC(a, 16 + 8 * numId[t]) END;
|
|
|
+ INC(t)
|
|
|
+ END;
|
|
|
+ r := resList; t := -1;
|
|
|
+ WHILE r # NIL DO
|
|
|
+ IF t # r.typ THEN t := r.typ; WriteResDir(0, numId[t]) END;
|
|
|
+ WriteResDirEntry(r.id, a, TRUE); INC(a, 16); i := r.id;
|
|
|
+ WHILE (r # NIL) & (r.typ = t) & (r.id = i) DO INC(a, 8); r := r.next END
|
|
|
+ END;
|
|
|
+ r := resList;
|
|
|
+ WHILE r # NIL DO
|
|
|
+ n := 0; s := r;
|
|
|
+ WHILE (s # NIL) & (s.typ = r.typ) & (s.id = r.id) DO INC(n); s := s.next END;
|
|
|
+ WriteResDir(0, n);
|
|
|
+ WHILE r # s DO WriteResDirEntry(r.lid, a, FALSE); INC(a, 16); r := r.next END
|
|
|
+ END;
|
|
|
+ ASSERT(a = resHSize);
|
|
|
+ IF numId[0] > 0 THEN INC(a, nsize) END; (* TYPELIB string *)
|
|
|
+ r := resList;
|
|
|
+ WHILE r # NIL DO
|
|
|
+ Write4(a + RsrcRva); INC(a, (r.size + 3) DIV 4 * 4);
|
|
|
+ Write4(r.size);
|
|
|
+ Write4(0); Write4(0);
|
|
|
+ r := r.next
|
|
|
+ END;
|
|
|
+ ASSERT(a = RsrcSize);
|
|
|
+ IF numId[0] > 0 THEN
|
|
|
+ Write2(nlen); i := 0;
|
|
|
+ WHILE rsrcName[i] # 0X DO Write2(ORD(rsrcName[i])); INC(i) END
|
|
|
+ END;
|
|
|
+ r := resList;
|
|
|
+ WHILE r # NIL DO
|
|
|
+ IF r.typ = 4 THEN (* menu *)
|
|
|
+ Write2(0); Write2(0);
|
|
|
+ WriteMenu(r.local);
|
|
|
+ WHILE Ro.Pos() MOD 4 # 0 DO WriteCh(0X) END
|
|
|
+ ELSIF r.typ = 9 THEN (* accelerator *)
|
|
|
+ s := r.local;
|
|
|
+ WHILE s # NIL DO
|
|
|
+ i := 0; a := 0;
|
|
|
+ IF 10 IN s.opts THEN INC(a, 4) END; (* * shift *)
|
|
|
+ IF 16 IN s.opts THEN INC(a, 8) END; (* ^ ctrl *)
|
|
|
+ IF 0 IN s.opts THEN INC(a, 16) END; (* @ alt *)
|
|
|
+ IF 13 IN s.opts THEN INC(a, 2) END; (* - noinv *)
|
|
|
+ IF s.next = NIL THEN INC(a, 80H) END;
|
|
|
+ IF (s.name[0] = "v") & (s.name[1] # 0X) THEN
|
|
|
+ s.name[0] := " "; Strings.StringToInt(s.name, x, n); INC(a, 1)
|
|
|
+ ELSE x := ORD(s.name[0])
|
|
|
+ END;
|
|
|
+ Write2(a); Write2(x); Write2(s.id); Write2(0); s := s.next
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ r.file := ThisResFile(r.name);
|
|
|
+ IF r.file # NIL THEN
|
|
|
+ R := r.file.NewReader(R); R.SetPos(r.pos); i := 0;
|
|
|
+ IF r.typ = 12 THEN (* cursor group *)
|
|
|
+ Read4(x); Write4(x); Read2(n); Write2(n);
|
|
|
+ WHILE i < n DO
|
|
|
+ Read4(x); Write2(x MOD 256); Write2(x DIV 256 MOD 256 * 2);
|
|
|
+ Write2(1); Write2(1); Read4(x); (* ??? *)
|
|
|
+ Read4(x); Write4(x + 4); Read4(x); Write2(r.id * 10 + i); INC(i)
|
|
|
+ END;
|
|
|
+ IF ~ODD(n) THEN Write2(0) END
|
|
|
+ ELSIF r.typ = 14 THEN (* icon group *)
|
|
|
+ Read4(x); Write4(x); Read2(n); Write2(n);
|
|
|
+ WHILE i < n DO
|
|
|
+ Read2(x); Write2(x); Read2(x);
|
|
|
+ IF (13 IN r.opts) & (x = 16) THEN x := 4 END;
|
|
|
+ Write2(x);
|
|
|
+ a := x MOD 256; Read4(x); Write2(1);
|
|
|
+ IF a <= 2 THEN Write2(1)
|
|
|
+ ELSIF a <= 4 THEN Write2(2)
|
|
|
+ ELSIF a <= 16 THEN Write2(4)
|
|
|
+ ELSE Write2(8)
|
|
|
+ END;
|
|
|
+ Read4(x);
|
|
|
+ IF (13 IN r.opts) & (x = 744) THEN x := 440 END;
|
|
|
+ IF (13 IN r.opts) & (x = 296) THEN x := 184 END;
|
|
|
+ Write4(x); Read4(x); Write2(r.id * 10 + i); INC(i)
|
|
|
+ END;
|
|
|
+ IF ~ODD(n) THEN Write2(0) END
|
|
|
+ ELSE
|
|
|
+ IF r.typ = 1 THEN Write2(r.x); Write2(r.y); i := 4 END; (* cursor hot spot *)
|
|
|
+ WHILE i < r.size DO Read4(x); Write4(x); INC(i, 4) END
|
|
|
+ END;
|
|
|
+ r.file.Close; r.file := NIL
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ r := r.next
|
|
|
+ END
|
|
|
+ END WriteResource;
|
|
|
+
|
|
|
+ PROCEDURE Insert(VAR name: ARRAY OF SHORTCHAR; VAR idx: INTEGER; hint: INTEGER);
|
|
|
+ VAR i: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ IF hint >= 0 THEN
|
|
|
+ ntab[idx] := SHORT(CHR(hint)); INC(idx);
|
|
|
+ ntab[idx] := SHORT(CHR(hint DIV 256)); INC(idx);
|
|
|
+ END;
|
|
|
+ i := 0;
|
|
|
+ WHILE name[i] # 0X DO ntab[idx] := name[i]; INC(idx); INC(i) END;
|
|
|
+ IF (hint = -1) & ((ntab[idx-4] # ".") OR (CAP(ntab[idx-3]) # "D") OR (CAP(ntab[idx-2]) # "L") OR (CAP(ntab[idx-1]) # "L")) THEN
|
|
|
+ ntab[idx] := "."; INC(idx);
|
|
|
+ ntab[idx] := "d"; INC(idx);
|
|
|
+ ntab[idx] := "l"; INC(idx);
|
|
|
+ ntab[idx] := "l"; INC(idx);
|
|
|
+ END;
|
|
|
+ ntab[idx] := 0X; INC(idx);
|
|
|
+ IF ODD(idx) THEN ntab[idx] := 0X; INC(idx) END
|
|
|
+ END Insert;
|
|
|
+
|
|
|
+ PROCEDURE WriteImport;
|
|
|
+ VAR i, lt, at, nt, ai, ni: INTEGER; mod: Module; exp: Export; ss: ARRAY 256 OF SHORTCHAR;
|
|
|
+ BEGIN
|
|
|
+ IF numImp > 0 THEN NEW(atab, numImp) END;
|
|
|
+ IF numExp > numImp THEN i := numExp ELSE i := numImp END;
|
|
|
+ IF i > 0 THEN NEW(ntab, 40 * i) END;
|
|
|
+ at := ImpRva + ImpHSize; ai := 0; ni := 0;
|
|
|
+ lt := ImpRva + ImpSize; nt := lt + ImpSize - ImpHSize;
|
|
|
+ mod := modList;
|
|
|
+ WHILE mod # NIL DO
|
|
|
+ IF mod.dll THEN
|
|
|
+ Write4(lt); (* lookup table rva *)
|
|
|
+ Write4(0); (* time/data (always 0) *)
|
|
|
+ Write4(0); (* version (always 0) *)
|
|
|
+ Write4(nt + ni); (* name rva *)
|
|
|
+ ss := SHORT(mod.name$); Insert(ss, ni, -1);
|
|
|
+ Write4(at); (* addr table rva *)
|
|
|
+ exp := mod.exp;
|
|
|
+ WHILE exp # NIL DO
|
|
|
+ atab[ai] := nt + ni; (* hint/name rva *)
|
|
|
+ Insert(exp.name, ni, 0);
|
|
|
+ INC(lt, 4); INC(at, 4); INC(ai); exp := exp.next
|
|
|
+ END;
|
|
|
+ atab[ai] := 0; INC(lt, 4); INC(at, 4); INC(ai)
|
|
|
+ END;
|
|
|
+ mod := mod.next
|
|
|
+ END;
|
|
|
+ Write4(0); Write4(0); Write4(0); Write4(0); Write4(0);
|
|
|
+ i := 0;
|
|
|
+ WHILE i < ai DO Write4(atab[i]); INC(i) END; (* address table *)
|
|
|
+ i := 0;
|
|
|
+ WHILE i < ai DO Write4(atab[i]); INC(i) END; (* lookup table *)
|
|
|
+ i := 0;
|
|
|
+ WHILE i < ni DO WriteCh(ntab[i]); INC(i) END;
|
|
|
+ ASSERT(ai * 4 = ImpSize - ImpHSize);
|
|
|
+ INC(ImpSize, ai * 4 + ni);
|
|
|
+ ExpRva := ImpRva + (ImpSize + (ObjAlign - 1)) DIV ObjAlign * ObjAlign;
|
|
|
+ RelocRva := ExpRva;
|
|
|
+ END WriteImport;
|
|
|
+
|
|
|
+ PROCEDURE WriteExport (VAR name: ARRAY OF CHAR);
|
|
|
+ VAR i, ni: INTEGER; e: Export; ss: ARRAY 256 OF SHORTCHAR;
|
|
|
+ BEGIN
|
|
|
+ Write4(0); (* flags *)
|
|
|
+ Write4(timeStamp); (* time stamp *)
|
|
|
+ Write4(0); (* version *)
|
|
|
+ Write4(ExpRva + 40 + 10 * numExp); (* name rva *)
|
|
|
+ Write4(1); (* ordinal base *)
|
|
|
+ Write4(numExp); (* # entries *)
|
|
|
+ Write4(numExp); (* # name ptrs *)
|
|
|
+ Write4(ExpRva + 40); (* address table rva *)
|
|
|
+ Write4(ExpRva + 40 + 4 * numExp); (* name ptr table rva *)
|
|
|
+ Write4(ExpRva + 40 + 8 * numExp); (* ordinal table rva *)
|
|
|
+ ExpSize := 40 + 10 * numExp;
|
|
|
+ (* adress table *)
|
|
|
+ e := firstExp;
|
|
|
+ WHILE e # NIL DO Write4(e.adr); e := e.next END;
|
|
|
+ (* name ptr table *)
|
|
|
+ ni := 0; e := firstExp;
|
|
|
+ ss := SHORT(name$); Insert(ss, ni, -2);
|
|
|
+ WHILE e # NIL DO
|
|
|
+ Write4(ExpRva + ExpSize + ni); Insert(e.name, ni, -2); e := e.next
|
|
|
+ END;
|
|
|
+ (* ordinal table *)
|
|
|
+ i := 0;
|
|
|
+ WHILE i < numExp DO Write2(i); INC(i) END;
|
|
|
+ (* name table *)
|
|
|
+ i := 0;
|
|
|
+ WHILE i < ni DO WriteCh(ntab[i]); INC(i) END;
|
|
|
+ ExpSize := (ExpSize + ni + 15) DIV 16 * 16;
|
|
|
+ RelocRva := ExpRva + (ExpSize + (ObjAlign - 1)) DIV ObjAlign * ObjAlign;
|
|
|
+ END WriteExport;
|
|
|
+
|
|
|
+ PROCEDURE Sort (l, r: INTEGER);
|
|
|
+ VAR i, j, x, t: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ i := l; j := r; x := fixups[(l + r) DIV 2];
|
|
|
+ REPEAT
|
|
|
+ WHILE fixups[i] < x DO INC(i) END;
|
|
|
+ WHILE fixups[j] > x DO DEC(j) END;
|
|
|
+ IF i <= j THEN t := fixups[i]; fixups[i] := fixups[j]; fixups[j] := t; INC(i); DEC(j) END
|
|
|
+ UNTIL i > j;
|
|
|
+ IF l < j THEN Sort(l, j) END;
|
|
|
+ IF i < r THEN Sort(i, r) END
|
|
|
+ END Sort;
|
|
|
+
|
|
|
+ PROCEDURE WriteReloc;
|
|
|
+ VAR i, j, h, a, p: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ Sort(0, noffixup - 1); i := 0;
|
|
|
+ WHILE i < noffixup DO
|
|
|
+ p := fixups[i] DIV 4096 * 4096; j := i; a := p + 4096;
|
|
|
+ WHILE (j < noffixup) & (fixups[j] < a) DO INC(j) END;
|
|
|
+ Write4(p - ImageBase); (* page rva *)
|
|
|
+ h := 8 + 2 * (j - i);
|
|
|
+ Write4(h + h MOD 4); (* block size *)
|
|
|
+ INC(RelocSize, h);
|
|
|
+ WHILE i < j DO Write2(fixups[i] - p + 3 * 4096); INC(i) END; (* long fix *)
|
|
|
+ IF h MOD 4 # 0 THEN Write2(0); INC(RelocSize, 2) END
|
|
|
+ END;
|
|
|
+ Write4(0); Write4(0); INC(RelocSize, 8);
|
|
|
+ ImagesSize := RelocRva + (RelocSize + (ObjAlign - 1)) DIV ObjAlign * ObjAlign;
|
|
|
+ END WriteReloc;
|
|
|
+
|
|
|
+ PROCEDURE Align(VAR pos: INTEGER);
|
|
|
+ BEGIN
|
|
|
+ WHILE Ro.Pos() MOD FileAlign # 0 DO WriteCh(0X) END;
|
|
|
+ pos := Ro.Pos()
|
|
|
+ END Align;
|
|
|
+
|
|
|
+ PROCEDURE WriteOut (VAR name: Files.Name);
|
|
|
+ VAR res, codepos, conpos, rsrcpos, imppos, exppos, relpos, relend, end: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ IF ~error THEN Align(codepos); WriteCode END;
|
|
|
+ IF ~error THEN Align(conpos); WriteConst END;
|
|
|
+ IF ~error THEN Align(rsrcpos); WriteResource END;
|
|
|
+ IF ~error THEN Align(imppos); WriteImport END;
|
|
|
+ IF ~error & isDll THEN Align(exppos); WriteExport(name) END;
|
|
|
+ IF ~error THEN Align(relpos); WriteReloc END;
|
|
|
+ relend := Ro.Pos() - 8; Align(end);
|
|
|
+
|
|
|
+ IF ~error THEN
|
|
|
+ Ro.SetPos(entryPos); Write4(CodeRva);
|
|
|
+ Ro.SetPos(isPos); Write4(ImagesSize);
|
|
|
+ IF isDll THEN
|
|
|
+ Ro.SetPos(hexpPos); Write4(ExpRva); Write4(ExpSize);
|
|
|
+ END;
|
|
|
+ Ro.SetPos(himpPos); Write4(ImpRva); Write4(ImpHSize);
|
|
|
+ Ro.SetPos(hrsrcPos); Write4(RsrcRva); Write4(RsrcSize);
|
|
|
+ Ro.SetPos(fixPos); Write4(RelocRva); Write4(relend - relpos);
|
|
|
+
|
|
|
+ Ro.SetPos(codePos); Write4(CodeRva); Write4(conpos - HeaderSize); Write4(HeaderSize);
|
|
|
+ Ro.SetPos(dataPos); Write4(DataRva); Write4((DataSize + (FileAlign-1)) DIV FileAlign * FileAlign);
|
|
|
+ Ro.SetPos(conPos); Write4(ConRva); Write4(rsrcpos - conpos); Write4(conpos);
|
|
|
+ Ro.SetPos(rsrcPos); Write4(RsrcRva); Write4(imppos - rsrcpos); Write4(rsrcpos);
|
|
|
+ IF isDll THEN
|
|
|
+ Ro.SetPos(impPos); Write4(ImpRva); Write4(exppos - imppos); Write4(imppos);
|
|
|
+ Ro.SetPos(expPos); Write4(ExpRva); Write4(relpos - exppos); Write4(exppos)
|
|
|
+ ELSE
|
|
|
+ Ro.SetPos(impPos); Write4(ImpRva); Write4(relpos - imppos); Write4(imppos);
|
|
|
+ END;
|
|
|
+ Ro.SetPos(relPos); Write4(RelocRva); Write4(end - relpos); Write4(relpos);
|
|
|
+ IF isStatic THEN
|
|
|
+ Ro.SetPos(termPos); WriteTermCode(modList, 0)
|
|
|
+ ELSIF isDll THEN
|
|
|
+ Ro.SetPos(termPos); WriteTermCode(main, 0)
|
|
|
+ END
|
|
|
+ END;
|
|
|
+
|
|
|
+ IF ~error THEN
|
|
|
+ Out.Register(name, "exe", Files.ask, res);
|
|
|
+ IF res # 0 THEN error := TRUE END
|
|
|
+ END
|
|
|
+ END WriteOut;
|
|
|
+
|
|
|
+ (* A. V. Shiryaev: Scanner *)
|
|
|
+
|
|
|
+ PROCEDURE (VAR S: Scanner) SetPos (x: INTEGER), NEW;
|
|
|
+ BEGIN
|
|
|
+ S.rider.i := x
|
|
|
+ END SetPos;
|
|
|
+
|
|
|
+ PROCEDURE (VAR S: Scanner) ConnectTo (IN src: ARRAY OF CHAR), NEW;
|
|
|
+ BEGIN
|
|
|
+ NEW(S.rider.s, LEN(src$) + 1);
|
|
|
+ S.rider.s^ := src$;
|
|
|
+ S.rider.i := 0;
|
|
|
+ S.start := 0;
|
|
|
+ S.type := TMEOT
|
|
|
+ END ConnectTo;
|
|
|
+
|
|
|
+ PROCEDURE (VAR R: ScanRider) ReadPrevChar (VAR ch: CHAR), NEW;
|
|
|
+ BEGIN
|
|
|
+ ch := R.s[R.i]
|
|
|
+ END ReadPrevChar;
|
|
|
+
|
|
|
+ PROCEDURE (VAR R: ScanRider) ReadChar (VAR ch: CHAR), NEW;
|
|
|
+ BEGIN
|
|
|
+ ch := R.s[R.i];
|
|
|
+ INC(R.i)
|
|
|
+ END ReadChar;
|
|
|
+
|
|
|
+ PROCEDURE (VAR R: ScanRider) Pos (): INTEGER, NEW;
|
|
|
+ BEGIN
|
|
|
+ RETURN R.i
|
|
|
+ END Pos;
|
|
|
+
|
|
|
+ PROCEDURE (VAR S: Scanner) Scan, NEW;
|
|
|
+ VAR j, res: INTEGER;
|
|
|
+
|
|
|
+ PROCEDURE IsLetter (c: CHAR): BOOLEAN;
|
|
|
+ BEGIN
|
|
|
+ RETURN ((c >= 'A') & (c <= 'Z')) OR ((c >= 'a') & (c <= 'z')) OR (c = '_')
|
|
|
+ END IsLetter;
|
|
|
+
|
|
|
+ PROCEDURE IsDigit (c: CHAR): BOOLEAN;
|
|
|
+ BEGIN
|
|
|
+ RETURN (c >= '0') & (c <= '9')
|
|
|
+ END IsDigit;
|
|
|
+
|
|
|
+ BEGIN
|
|
|
+ WHILE (S.rider.i < LEN(S.rider.s$)) & (S.rider.s[S.rider.i] = ' ') DO
|
|
|
+ INC(S.rider.i)
|
|
|
+ END;
|
|
|
+ IF S.rider.i < LEN(S.rider.s$) THEN
|
|
|
+ S.start := S.rider.i;
|
|
|
+ IF IsDigit(S.rider.s[S.rider.i]) THEN
|
|
|
+ j := 0;
|
|
|
+ WHILE (S.rider.i < LEN(S.rider.s$)) & IsDigit(S.rider.s[S.rider.i]) DO
|
|
|
+ S.string[j] := S.rider.s[S.rider.i];
|
|
|
+ INC(j);
|
|
|
+ INC(S.rider.i)
|
|
|
+ END;
|
|
|
+ S.string[j] := 0X;
|
|
|
+ Strings.StringToInt(S.string, S.int, res);
|
|
|
+ IF res # 0 THEN S.type := TMEOT
|
|
|
+ ELSE S.type := TMInt
|
|
|
+ END
|
|
|
+ ELSIF IsLetter(S.rider.s[S.rider.i]) THEN
|
|
|
+ S.type := TMString;
|
|
|
+ j := 0;
|
|
|
+ WHILE (S.rider.i < LEN(S.rider.s$)) & (IsLetter(S.rider.s[S.rider.i]) OR IsDigit(S.rider.s[S.rider.i])) DO
|
|
|
+ S.string[j] := S.rider.s[S.rider.i];
|
|
|
+ INC(j);
|
|
|
+ INC(S.rider.i)
|
|
|
+ END;
|
|
|
+ S.string[j] := 0X
|
|
|
+ ELSE
|
|
|
+ S.type := TMChar;
|
|
|
+ S.char := S.rider.s[S.rider.i];
|
|
|
+ INC(S.rider.i)
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ S.type := TMEOT
|
|
|
+ END
|
|
|
+ END Scan;
|
|
|
+
|
|
|
+ PROCEDURE ScanRes (VAR S: Scanner; end: INTEGER; VAR list: Resource);
|
|
|
+ VAR res, tail: Resource; n: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ tail := NIL;
|
|
|
+ WHILE (S.start < end) & (S.type = TMInt) DO
|
|
|
+ NEW(res); res.id := S.int; S.Scan;
|
|
|
+ IF (S.type = TMChar) & (S.char = "[") THEN
|
|
|
+ S.Scan;
|
|
|
+ IF S.type = TMInt THEN res.lid := S.int; S.Scan END;
|
|
|
+ IF (S.type = TMChar) & (S.char = "]") THEN S.Scan
|
|
|
+ ELSE WriteSString("missing ']'"); error := TRUE
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ WHILE S.type = TMChar DO
|
|
|
+ IF S.char = "@" THEN n := 0
|
|
|
+ ELSIF S.char = "^" THEN n := 16
|
|
|
+ ELSIF S.char = "~" THEN n := 17
|
|
|
+ ELSIF S.char <= "?" THEN n := ORD(S.char) - ORD(" ")
|
|
|
+ END;
|
|
|
+ INCL(res.opts, n); S.Scan
|
|
|
+ END;
|
|
|
+ IF S.type = TMString THEN
|
|
|
+ res.name := S.string$; S.Scan;
|
|
|
+ IF (S.type = TMChar) & (S.char = ".") THEN S.Scan;
|
|
|
+ IF S.type = TMString THEN
|
|
|
+ IF (S.string = "tlb") OR (S.string = "TLB") THEN res.typ := -1 END;
|
|
|
+ Kernel.MakeFileName(res.name, S.string); S.Scan
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ IF (S.type = TMChar) & (S.char = "(") THEN S.Scan;
|
|
|
+ ScanRes(S, end, res.local);
|
|
|
+ IF (S.type = TMChar) & (S.char = ")") THEN S.Scan
|
|
|
+ ELSE WriteSString("missing ')'"); error := TRUE
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ IF tail = NIL THEN list := res ELSE tail.next := res END;
|
|
|
+ tail := res
|
|
|
+ ELSE
|
|
|
+ WriteSString("wrong resource name"); error := TRUE
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ END ScanRes;
|
|
|
+
|
|
|
+ PROCEDURE LinkIt (IN txt: ARRAY OF CHAR);
|
|
|
+ VAR S: Scanner; name: Files.Name; mod: Module; end: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ comLine := FALSE;
|
|
|
+ modList := NIL; kernel := NIL; main := NIL;
|
|
|
+ last := NIL; impg := NIL; impd := NIL; resList := NIL;
|
|
|
+ firstExp := NIL; lastExp := NIL;
|
|
|
+ NEW(fixups, FixLen);
|
|
|
+
|
|
|
+(*
|
|
|
+ Dialog.ShowStatus("linking");
|
|
|
+*)
|
|
|
+ Console.WriteStr("linking"); Console.WriteLn;
|
|
|
+
|
|
|
+(*
|
|
|
+ timeStamp := TimeStamp();
|
|
|
+*)
|
|
|
+ timeStamp := 0;
|
|
|
+
|
|
|
+ error := FALSE; modList := NIL; resList := NIL;
|
|
|
+
|
|
|
+(*
|
|
|
+ IF DevCommanders.par = NIL THEN RETURN END;
|
|
|
+ S.ConnectTo(DevCommanders.par.text);
|
|
|
+ S.SetPos(DevCommanders.par.beg);
|
|
|
+ end := DevCommanders.par.end;
|
|
|
+ DevCommanders.par := NIL;
|
|
|
+ W.ConnectTo(Log.buf);
|
|
|
+*)
|
|
|
+
|
|
|
+ S.ConnectTo(txt);
|
|
|
+ S.SetPos(0);
|
|
|
+ end := LEN(txt$);
|
|
|
+
|
|
|
+ S.Scan;
|
|
|
+ IF S.type = TMString THEN
|
|
|
+ IF S.string = "dos" THEN comLine := TRUE; S.Scan END;
|
|
|
+ name := S.string$; S.Scan;
|
|
|
+ IF (S.type = TMChar) & (S.char = ".") THEN S.Scan;
|
|
|
+ IF S.type = TMString THEN
|
|
|
+ Kernel.MakeFileName(name, S.string); S.Scan
|
|
|
+ END
|
|
|
+ ELSE Kernel.MakeFileName(name, "EXE");
|
|
|
+ END;
|
|
|
+ IF (S.type = TMChar) & (S.char = ":") THEN S.Scan;
|
|
|
+ IF (S.type = TMChar) & (S.char = "=") THEN S.Scan;
|
|
|
+ WHILE (S.start < end) & (S.type = TMString) DO
|
|
|
+ NEW(mod); mod.name := S.string$;
|
|
|
+ mod.next := modList; modList := mod;
|
|
|
+ S.Scan;
|
|
|
+ WHILE (S.start < end) & (S.type = TMChar) &
|
|
|
+ ((S.char = "*") OR (S.char = "+") OR (S.char = "$") OR (S.char = "#")) DO
|
|
|
+ IF S.char = "*" THEN mod.dll := TRUE
|
|
|
+ ELSIF S.char = "+" THEN kernel := mod
|
|
|
+ ELSIF S.char = "$" THEN main := mod
|
|
|
+ ELSE mod.intf := TRUE;
|
|
|
+ IF ~isDll THEN
|
|
|
+ WriteSString("Exports from Exe not possible. Use LinkDll or LinkDynDll.");
|
|
|
+ WriteLn; FlushW; error := TRUE
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ S.Scan
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ ScanRes(S, end, resList);
|
|
|
+ ReadHeaders;
|
|
|
+ PrepResources;
|
|
|
+ IF ~error THEN WriteHeader(name) END;
|
|
|
+ IF ~error THEN WriteOut(name) END;
|
|
|
+ IF ~error THEN
|
|
|
+ WriteString(name); WriteString(" written ");
|
|
|
+ WriteInt(Out.Length()); WriteString(" "); WriteInt(CodeSize)
|
|
|
+ END
|
|
|
+ ELSE WriteString(" := missing")
|
|
|
+ END
|
|
|
+ ELSE WriteString(" := missing")
|
|
|
+ END;
|
|
|
+ WriteLn; FlushW
|
|
|
+ END;
|
|
|
+(*
|
|
|
+ IF error THEN Dialog.ShowStatus("failed") ELSE Dialog.ShowStatus("ok") END;
|
|
|
+ W.ConnectTo(NIL); S.ConnectTo(NIL);
|
|
|
+*)
|
|
|
+ IF error THEN Console.WriteStr("failed") ELSE Console.WriteStr("ok") END; Console.WriteLn;
|
|
|
+ S.ConnectTo("");
|
|
|
+
|
|
|
+ modList := NIL; kernel := NIL; main := NIL; firstExp := NIL; lastExp := NIL;
|
|
|
+ last := NIL; impg := NIL; impd := NIL; resList := NIL; code := NIL; atab := NIL; ntab := NIL;
|
|
|
+ fixups := NIL
|
|
|
+ END LinkIt;
|
|
|
+
|
|
|
+ PROCEDURE Link* (IN txt: ARRAY OF CHAR);
|
|
|
+ BEGIN
|
|
|
+ isDll := FALSE; isStatic := FALSE;
|
|
|
+ LinkIt(txt)
|
|
|
+ END Link;
|
|
|
+
|
|
|
+ PROCEDURE LinkExe* (IN txt: ARRAY OF CHAR);
|
|
|
+ BEGIN
|
|
|
+ isDll := FALSE; isStatic := TRUE;
|
|
|
+ LinkIt(txt)
|
|
|
+ END LinkExe;
|
|
|
+
|
|
|
+ PROCEDURE LinkDll* (IN txt: ARRAY OF CHAR);
|
|
|
+ BEGIN
|
|
|
+ isDll := TRUE; isStatic := TRUE;
|
|
|
+ LinkIt(txt)
|
|
|
+ END LinkDll;
|
|
|
+
|
|
|
+ PROCEDURE LinkDynDll* (IN txt: ARRAY OF CHAR);
|
|
|
+ BEGIN
|
|
|
+ isDll := TRUE; isStatic := FALSE;
|
|
|
+ LinkIt(txt)
|
|
|
+ END LinkDynDll;
|
|
|
+
|
|
|
+(*
|
|
|
+ PROCEDURE Show*;
|
|
|
+ VAR S: TextMappers.Scanner; name: Name; mod: Module; t: TextModels.Model;
|
|
|
+ BEGIN
|
|
|
+ t := TextViews.FocusText(); IF t = NIL THEN RETURN END;
|
|
|
+ W.ConnectTo(Log.buf); S.ConnectTo(t); S.Scan;
|
|
|
+ IF S.type = TextMappers.string THEN
|
|
|
+ mod := modList;
|
|
|
+ WHILE (mod # NIL) & (mod.name # S.string) DO mod := mod.next END;
|
|
|
+ IF mod # NIL THEN
|
|
|
+ W.WriteString(S.string);
|
|
|
+ W.WriteString(" ca = ");
|
|
|
+ W.WriteIntForm(CodeBase + mod.ca, TextMappers.hexadecimal, 8, "0", TRUE);
|
|
|
+ W.WriteLn; Log.text.Append(Log.buf)
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ W.ConnectTo(NIL); S.ConnectTo(NIL)
|
|
|
+ END Show;
|
|
|
+*)
|
|
|
+
|
|
|
+BEGIN
|
|
|
+ newRec := "NewRec"; newArr := "NewArr"
|
|
|
+END Dev0Linker.
|
|
|
+
|
|
|
+
|
|
|
+(!)DevLinker.Link Usekrnl.exe := TestKernel$+ Usekrnl ~ (!)"DevDecExe.Decode('', 'Usekrnl.exe')"
|
|
|
+
|
|
|
+(!)DevLinker.LinkDynDll MYDLL.dll := TestKernel+ MYDLL$# ~ (!)"DevDecExe.Decode('', 'MYDLL.dll')"
|
|
|
+
|
|
|
+(!)DevLinker.LinkExe Usekrnl.exe := TestKernel+ Usekrnl ~ (!)"DevDecExe.Decode('', 'Usekrnl.exe')"
|
|
|
+
|
|
|
+(!)DevLinker.LinkDll MYDLL.dll := TestKernel+ MYDLL# ~ (!)"DevDecExe.Decode('', 'MYDLL.dll')"
|
|
|
+
|
|
|
+
|
|
|
+MODULE TestKernel;
|
|
|
+ IMPORT KERNEL32;
|
|
|
+
|
|
|
+ PROCEDURE Beep*;
|
|
|
+ BEGIN
|
|
|
+ KERNEL32.Beep(500, 200)
|
|
|
+ END Beep;
|
|
|
+
|
|
|
+BEGIN
|
|
|
+CLOSE
|
|
|
+ KERNEL32.ExitProcess(0)
|
|
|
+END TestKernel.
|
|
|
+
|
|
|
+MODULE Usekrnl;
|
|
|
+(* empty windows application using BlackBox Kernel *)
|
|
|
+(* Ominc (!) *)
|
|
|
+
|
|
|
+ IMPORT KERNEL32, USER32, GDI32, S := SYSTEM, Kernel := TestKernel;
|
|
|
+
|
|
|
+ VAR Instance, MainWnd: USER32.Handle;
|
|
|
+
|
|
|
+ PROCEDURE WndHandler (wnd, message, wParam, lParam: INTEGER): INTEGER;
|
|
|
+ VAR res: INTEGER; ps: USER32.PaintStruct; dc: GDI32.Handle;
|
|
|
+ BEGIN
|
|
|
+ IF message = USER32.WMDestroy THEN
|
|
|
+ USER32.PostQuitMessage(0)
|
|
|
+ ELSIF message = USER32.WMPaint THEN
|
|
|
+ dc := USER32.BeginPaint(wnd, ps);
|
|
|
+ res := GDI32.TextOutA(dc, 50, 50, "Hello World", 11);
|
|
|
+ res := USER32.EndPaint(wnd, ps)
|
|
|
+ ELSIF message = USER32.WMChar THEN
|
|
|
+ Kernel.Beep
|
|
|
+ ELSE
|
|
|
+ RETURN USER32.DefWindowProcA(wnd, message, wParam, lParam)
|
|
|
+ END;
|
|
|
+ RETURN 0
|
|
|
+ END WndHandler;
|
|
|
+
|
|
|
+ PROCEDURE OpenWindow;
|
|
|
+ VAR class: USER32.WndClass; res: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ class.cursor := USER32.LoadCursorA(0, USER32.MakeIntRsrc(USER32.IDCArrow));
|
|
|
+ class.icon := USER32.LoadIconA(Instance, USER32.MakeIntRsrc(1));
|
|
|
+ class.menuName := NIL;
|
|
|
+ class.className := "Simple";
|
|
|
+ class.backgnd := GDI32.GetStockObject(GDI32.WhiteBrush);
|
|
|
+ class.style := {0, 1, 5, 7};
|
|
|
+ class.instance := Instance;
|
|
|
+ class.wndProc := WndHandler;
|
|
|
+ class.clsExtra := 0;
|
|
|
+ class.wndExtra := 0;
|
|
|
+ USER32.RegisterClassA(class);
|
|
|
+ MainWnd := USER32.CreateWindowExA({}, "Simple", "Empty Windows Application",
|
|
|
+ {16..19, 22, 23, 25},
|
|
|
+ USER32.CWUseDefault, USER32.CWUseDefault,
|
|
|
+ USER32.CWUseDefault, USER32.CWUseDefault,
|
|
|
+ 0, 0, Instance, 0);
|
|
|
+ res := USER32.ShowWindow(MainWnd, 10);
|
|
|
+ res := USER32.UpdateWindow(MainWnd);
|
|
|
+ END OpenWindow;
|
|
|
+
|
|
|
+ PROCEDURE MainLoop;
|
|
|
+ VAR msg: USER32.Message; res: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ WHILE USER32.GetMessageA(msg, 0, 0, 0) # 0 DO
|
|
|
+ res := USER32.TranslateMessage(msg);
|
|
|
+ res := USER32.DispatchMessageA(msg);
|
|
|
+ END;
|
|
|
+(*
|
|
|
+ KERNEL32.ExitProcess(msg.wParam)
|
|
|
+*)
|
|
|
+ END MainLoop;
|
|
|
+
|
|
|
+BEGIN
|
|
|
+ Instance := KERNEL32.GetModuleHandleA(NIL);
|
|
|
+ OpenWindow;
|
|
|
+ MainLoop
|
|
|
+CLOSE
|
|
|
+ Kernel.Beep
|
|
|
+END Usekrnl.
|
|
|
+
|
|
|
+
|
|
|
+MODULE MYDLL;
|
|
|
+(* sample module to be linked into a dll *)
|
|
|
+(* Ominc (!) *)
|
|
|
+
|
|
|
+ IMPORT SYSTEM, KERNEL32;
|
|
|
+
|
|
|
+ VAR expVar*: INTEGER;
|
|
|
+
|
|
|
+ PROCEDURE GCD* (a, b: INTEGER): INTEGER;
|
|
|
+ BEGIN
|
|
|
+ WHILE a # b DO
|
|
|
+ IF a < b THEN b := b - a ELSE a := a - b END
|
|
|
+ END;
|
|
|
+ expVar := a;
|
|
|
+ RETURN a
|
|
|
+ END GCD;
|
|
|
+
|
|
|
+ PROCEDURE Beep*;
|
|
|
+ BEGIN
|
|
|
+ KERNEL32.Beep(500, 200)
|
|
|
+ END Beep;
|
|
|
+
|
|
|
+CLOSE
|
|
|
+ Beep
|
|
|
+END MYDLL.
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+Resource = Id [ "[" Language "]" ] Options name [ "." ext ] [ "(" { Resource } ")" ]
|
|
|
+Id = number
|
|
|
+Language = number
|
|
|
+Options = { "@" | "!" .. "?" | "^" | "~" }
|
|
|
+
|
|
|
+names
|
|
|
+
|
|
|
+MENU
|
|
|
+ 1 MENU (0 File (11 New 12 Open 13 Save 0 "" 14 Exit) 0 Edit (21 Cut 22 Copy 23 Paste))
|
|
|
+ = grayed
|
|
|
+ - inctive
|
|
|
+ # bitmap
|
|
|
+ * checked
|
|
|
+ ! menuBarBreak
|
|
|
+ / menuBreak
|
|
|
+ ? ownerDraw
|
|
|
+
|
|
|
+ACCELERATOR
|
|
|
+ 1 ACCELERATOR (11 ^N 12 ^O 13 ^S 21 ^X 22 ^C 23 ^V)
|
|
|
+ * shift
|
|
|
+ ^ ctrl
|
|
|
+ @ alt
|
|
|
+ - noInvert
|
|
|
+
|
|
|
+filename.ico
|
|
|
+
|
|
|
+filename.cur
|
|
|
+
|
|
|
+filname.bmp
|
|
|
+
|
|
|
+filename.res
|
|
|
+
|
|
|
+filename.tlb
|