execswap.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
{
Copyright (c) 1988 TurboPower Software
May be used freely as long as due credit is given
Version 1.1 - 3/15/89
save and restore EMS page map
Version 1.2 - 3/29/89
add more compiler directives (far calls off, boolean short-circuiting)
add UseEmsIfAvailable to disable EMS usage when desired
Version 1.3 - 5/02/89
fix problem with exit chain when InitExecSwap/ShutdownExecSwap called
more than once in a program
flush swap file before execing
}
16
{$A+,B-,E+,F+,I-,L-,N-,O-,R-,S-,V-}
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
unit ExecSwap;
{-Memory-efficient DOS EXEC call}
interface
const
UseEmsIfAvailable : Boolean = True; {True to use EMS if available}
BytesSwapped : LongInt = 0; {Bytes to swap to EMS/disk}
EmsAllocated : Boolean = False; {True when EMS allocated for swap}
FileAllocated : Boolean = False; {True when file allocated for swap}
function ExecWithSwap(Path, CmdLine : String) : Word;
{-DOS EXEC supporting swap to EMS or disk}
function InitExecSwap(LastToSave : Pointer; SwapFileName : String) : Boolean;
{-Initialize for swapping, returning TRUE if successful}
procedure ShutdownExecSwap;
{-Deallocate swap area}
implementation
var
EmsHandle : Word; {Handle of EMS allocation block}
FrameSeg : Word; {Segment of EMS page frame}
FileHandle : Word; {DOS handle of swap file}
SwapName : String[80]; {ASCIIZ name of swap file}
SaveExit : Pointer; {Exit chain pointer}
{rcg11172000 stubs follow...}
(*
{$L EXECSWAP}
function ExecWithSwap(Path, CmdLine : String) : Word; external;
procedure FirstToSave; external;
function AllocateSwapFile : Boolean; external;
procedure DeallocateSwapFile; external;
{$F+} {These routines could be interfaced for general use}
function EmsInstalled : Boolean; external;
function EmsPageFrame : Word; external;
function AllocateEmsPages(NumPages : Word) : Word; external;
procedure DeallocateEmsHandle(Handle : Word); external;
function DefaultDrive : Char; external;
function DiskFree(Drive : Byte) : LongInt; external;
*)
procedure DeallocateEmsHandle(Handle : Word);
begin
end;
function ExecWithSwap(Path, CmdLine : String) : Word;
begin
writeln('STUB: execswap.pas; ExecWithSwap()...');
ExecWithSwap := 0;
end;
procedure FirstToSave;
begin
end;
function AllocateSwapFile : Boolean;
begin
AllocateSwapFile := false;
end;
procedure DeallocateSwapFile;
begin
end;
function EmsInstalled : Boolean;
begin
EmsInstalled := false;
end;
function EmsPageFrame : Word;
begin
EmsPageFrame := 0;
end;
function AllocateEmsPages(NumPages : Word) : Word;
begin
AllocateEmsPages := 0;
end;
function DefaultDrive : Char;
begin
DefaultDrive := #103; { 'C' }
end;
function DiskFree(Drive : Byte) : LongInt;
begin
DiskFree := 10000000;
end;
procedure ExecSwapExit;
begin
ExitProc := SaveExit;
ShutdownExecSwap;
end;
{$F-}
procedure ShutdownExecSwap;
begin
if EmsAllocated then begin
DeallocateEmsHandle(EmsHandle);
EmsAllocated := False;
end else if FileAllocated then begin
DeallocateSwapFile;
FileAllocated := False;
end;
end;
function PtrDiff(H, L : Pointer) : LongInt;
type
OS = record O, S : Word; end; {Convenient typecast}
begin
PtrDiff := (LongInt(OS(H).S) shl 4+OS(H).O)-
(LongInt(OS(L).S) shl 4+OS(L).O);
end;
function InitExecSwap(LastToSave : Pointer;
SwapFileName : String) : Boolean;
const
EmsPageSize = 16384; {Bytes in a standard EMS page}
var
PagesInEms : Word; {Pages needed in EMS}
BytesFree : LongInt; {Bytes free on swap file drive}
DriveChar : Char; {Drive letter for swap file}
begin
InitExecSwap := False;
if EmsAllocated or FileAllocated then
Exit;
BytesSwapped := PtrDiff(LastToSave, @FirstToSave);
if BytesSwapped <= 0 then
Exit;
if UseEmsIfAvailable and EmsInstalled then begin
PagesInEms := (BytesSwapped+EmsPageSize-1) div EmsPageSize;
EmsHandle := AllocateEmsPages(PagesInEms);
if EmsHandle <> $FFFF then begin
EmsAllocated := True;
FrameSeg := EmsPageFrame;
if FrameSeg <> 0 then begin
InitExecSwap := True;
Exit;
end;
end;
end;
if Length(SwapFileName) <> 0 then begin
SwapName := SwapFileName+#0;
if Pos(':', SwapFileName) = 2 then
DriveChar := Upcase(SwapFileName[1])
else
DriveChar := DefaultDrive;
BytesFree := DiskFree(Byte(DriveChar)-$40);
FileAllocated := (BytesFree > BytesSwapped) and AllocateSwapFile;
if FileAllocated then
InitExecSwap := True;
end;
end;
begin
SaveExit := ExitProc;
ExitProc := @ExecSwapExit;
end.