Contributor: ALFONS HOOGERVORST
(*> I have now added the {$IFOPT G+} to most of my current sources, but I> would like default detection code in my libraries (often used TPUs)> Even if my TPUs are compiled in G- (which they always are, because> I update them with TPC from a batch file), but if my 'main' source> files are accidentally G+ I would like that detected by my library> code.
*)
{$X+}{<<< Need this and strings unit }
{===========================================================================
Copyrighted by Alfons Hoogervorst 1994 AD.
Well. Ok. It's dumped in the public domain.
==========================================================================}
program Test8086;
uses
WinCrt, Strings;
const
{ My firstname expressed in bytes, I guess. Use same bytes if possible
to overcome the byte ordering on PC's }
SEARCHID = $A2A2A2A2;
SEARCHBYTE = Byte(SEARCHID); { LoByte }
PUSHINT = 2;
procedure CallInOne(int: Integer);
begin
{ So I return }
end;
procedure CheckThisOut;
begin
asm
jmp @Continue
dd SEARCHID { Bytes we're looking for }
@continue:
end;
{ if G+: push 0x02
else mov ax,02; push ax
}
CallInOne(PUSHINT)
end;
type
TGOption = (Error, Goff, Gon);
function IsOptionGOn: TGOption;
type
PDword = ^Longint;
var
Opcodes: PChar;
i: Integer; { Say 50 bytes }
begin
IsOptionGOn := Error;
OpCodes := PChar(@CheckThisOut);
{ Find our ID }
for i := 0 to 49 do { search some 50 bytes, must be enough }
begin
if PDword(OpCodes)^ = SEARCHID then
begin { Found our bytes }
OpCodes := OpCodes + sizeof(Longint); { Next instruction }
{ Check if it's PUSH PUSHINT instruction }
if (OpCodes^ = #6ドルA) and ((OpCodes+1)^ = Char(PUSHINT)) then
IsOptionGOn := Gon
else IsOptionGOn := Goff;
exit
end;
OpCodes := OpCodes + 1 { Try next }
end;
end;
begin
WriteLn('I Call You Call Me? Ok!');
case IsOptionGOn of
Error:
begin
WriteLn('Error... Borland Pascal code generation changed dramatically');
WriteLn('The world is collapsing, all programs have become
incompatible'); WriteLn('The Horror of It! Get me some assembler and I''ll
fix it!') end;
Gon:
begin
WriteLn('''t Was On');
end;
Goff:
begin
WriteLn('''t Was Off');
end;
end;
end.
(*
What am I doing here? Just looking for a push instruction. If {$G} on
constants are pushed with an immediate push instruction. Sounds
dificult? Well, just forget it, implement these functions in a unit
and you have your long-awaited test function.
I have some notes on my own code. If you're using my check-80X86 function
NEVER do the following things:
*)
if (OptionGOn = Goff) then
begin
WriteLn('This code is compiled with $G+');
Halt(2) {<<<<< PROBLEMS!!! }
end;
(*
Why?
If $G has been enabled you'll get:
push 2
call far HALT
And (as you noted) an 808X does not accept this.
Instead use this:
*)
if (OptionGOn = GOn) then
begin
WriteLn('Option $G enabled message');
Halt(Integer(OptionGOn)) { Or pass a variable }
end;
(*
In plain words: after checking the G-state with my function, don't call a
function with constant parameters. Always pass variables/function-results as
parameters.
This is not "portable":
*)
const
ERROR_GERROR = 2;
ANOTHER_CONST = 3;
if { my test } then
begin
IWantToExitRightNow(ERROR_GERROR, ANOTHER_CONST, 4, 6, 7);
end;
{ Instead try this: }
if { my test } then
begin
IWantToExitRightNow(VarIndicatingError, VarForAnotherConst,
FunctionCall4, FunctionCall6, VarContaining7)
end;
{
This is _only_ necessary in the "code" block immediately following my
function, not in your other code. By the way: I have written a unit for
detecting this $G-state. It's partly written in asm. This unit does not
require the "use" of other units.
}