← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fpcsrc/ide/pmode.pas

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/ide/pmode.pas
 
1
{
 
2
    This file is part of the Free Sockets Interface
 
3
    Copyright (c) 1999 by Berczi Gabor
 
4
 
 
5
    Support routines for DPMI programs
 
6
 
 
7
    See the file COPYING.FCL, included in this distribution,
 
8
    for details about the copyright.
 
9
 
 
10
    This program is distributed in the hope that it will be useful,
 
11
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 
12
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
13
 
 
14
 **********************************************************************}
 
15
{$ifdef VER70}{$define TP}{$endif}
 
16
unit PMode;
 
17
 
 
18
interface
 
19
 
 
20
uses Dos;
 
21
 
 
22
type
 
23
    MemPtr = object
 
24
      Ofs,Seg: word;
 
25
      Size   : word;
 
26
    {$ifdef DPMI}
 
27
      Sel    : word;
 
28
    {$endif}
 
29
      function  DosPtr: pointer;
 
30
      function  DataPtr: pointer;
 
31
      function  DosSeg: word;
 
32
      function  DosOfs: word;
 
33
      procedure MoveDataTo(var Src; DSize: word);
 
34
      procedure MoveDataFrom(DSize: word; var Dest);
 
35
      procedure Clear;
 
36
    private
 
37
      function DataSeg: word;
 
38
      function DataOfs: word;
 
39
    end;
 
40
 
 
41
    PtrRec = packed record
 
42
      Ofs,Seg: word;
 
43
    end;
 
44
 
 
45
    registers32 = packed record     { DPMI call structure }
 
46
      EDI     : LongInt;
 
47
      ESI     : LongInt;
 
48
      EBP     : LongInt;
 
49
      Reserved: LongInt;
 
50
      EBX     : LongInt;
 
51
      EDX     : LongInt;
 
52
      ECX     : LongInt;
 
53
      EAX     : LongInt;
 
54
      Flags   : Word;
 
55
      ES      : Word;
 
56
      DS      : Word;
 
57
      FS      : Word;
 
58
      GS      : Word;
 
59
      IP      : Word;
 
60
      CS      : Word;
 
61
      SP      : Word;
 
62
      SS      : Word;
 
63
    end;
 
64
 
 
65
    pregisters = ^registers;
 
66
 
 
67
function  GetDosMem(var M: MemPtr; Size: word): boolean;
 
68
procedure FreeDosMem(var M: MemPtr);
 
69
procedure realintr(IntNo: byte; var r: registers);
 
70
{procedure realintr32(IntNo: byte; var r: registers32);}
 
71
procedure realcall(Proc: pointer; var r: registers);
 
72
function  MoveDosToPM(DosPtr: pointer; PMPtr: pointer; Size: word): boolean;
 
73
function  MovePMToDos(PMPtr: pointer; DosPtr: pointer; Size: word): boolean;
 
74
procedure realGetIntVec(IntNo: byte; var P: pointer);
 
75
function  allocrmcallback(PMAddr: pointer; RealRegs: pregisters): pointer;
 
76
procedure freermcallback(RealCallAddr: pointer);
 
77
 
 
78
function MakePtr(ASeg,AOfs: word): pointer;
 
79
 
 
80
implementation
 
81
 
 
82
{$ifdef TP}
 
83
{$ifdef DPMI}uses WinAPI;{$endif}
 
84
 
 
85
{$IFDEF DPMI}
 
86
const
 
87
    DPMI_INTR      = $31;
 
88
 
 
89
type
 
90
    TDPMIRegisters = {$ifdef TP}Registers32{$else}TRegisters32{$endif};
 
91
 
 
92
  var
 
93
    DPMIRegs: TDPMIRegisters;
 
94
{$ENDIF DPMI}
 
95
 
 
96
procedure realintr(IntNo: byte; var r: registers);
 
97
{$ifdef DPMI}
 
98
var Regs: Registers;
 
99
begin
 
100
  FillChar(DPMIRegs, SizeOf(TDPMIRegisters), 0);
 
101
  DPMIRegs.EAX := r.ax;
 
102
  DPMIRegs.EBX := r.bx;
 
103
  DPMIRegs.ECX := r.cx;
 
104
  DPMIRegs.EDX := r.dx;
 
105
  DPMIRegs.EDI := r.di;
 
106
  DPMIRegs.ESI := r.si;
 
107
  DPMIRegs.EBP := r.bp;
 
108
  DPMIRegs.DS := r.ds;
 
109
  DPMIRegs.ES := r.es;
 
110
  DPMIRegs.Flags := r.flags;
 
111
  Regs.AX := $0300;
 
112
  Regs.BL := IntNo;
 
113
  Regs.BH := 0;
 
114
  Regs.CX := 0;
 
115
  Regs.ES := Seg(DPMIRegs);
 
116
  Regs.DI := Ofs(DPMIRegs);
 
117
  Intr(DPMI_INTR, Regs);
 
118
  r.ax := DPMIRegs.EAX;
 
119
  r.bx := DPMIRegs.EBX;
 
120
  r.cx := DPMIRegs.ECX;
 
121
  r.dx := DPMIRegs.EDX;
 
122
  r.di := DPMIRegs.EDI;
 
123
  r.si := DPMIRegs.ESI;
 
124
  r.bp := DPMIRegs.EBP;
 
125
  r.ds := DPMIRegs.DS;
 
126
  r.es := DPMIRegs.ES;
 
127
  r.Flags := DPMIRegs.Flags;
 
128
end;
 
129
{$else}
 
130
begin
 
131
  intr(IntNo,r);
 
132
end;
 
133
{$endif}
 
134
 
 
135
(*procedure realintr32(IntNo: byte; var r: registers32);
 
136
{$ifdef DPMI}
 
137
var Regs: Registers;
 
138
begin
 
139
  FillChar(DPMIRegs, SizeOf(TDPMIRegisters), 0);
 
140
  DPMIRegs:=r;
 
141
 
 
142
  Regs.AX := $0300;
 
143
  Regs.BL := IntNo;
 
144
  Regs.BH := 0;
 
145
  Regs.CX := 0;
 
146
  Regs.ES := Seg(DPMIRegs);
 
147
  Regs.DI := Ofs(DPMIRegs);
 
148
  Intr(DPMI_INTR, Regs);
 
149
  r:=DPMIRegs;
 
150
end;
 
151
{$else}
 
152
begin
 
153
  { not implemented }
 
154
  Halt(99);
 
155
end;
 
156
{$endif}
 
157
*)
 
158
 
 
159
{$ifndef DPMI}
 
160
const DummyIntRedir: boolean = false;
 
161
      CallAddr: pointer = nil;
 
162
      DummyInt = $ef;
 
163
procedure CallInt; assembler;
 
164
asm
 
165
  push  ax
 
166
  push  ds
 
167
 
 
168
  mov   ax, seg CallAddr
 
169
  mov   ds, ax
 
170
  mov   ax, ds:CallAddr.word[0]
 
171
  mov   cs:@JmpAddr.word[0], ax
 
172
  mov   ax, ds:CallAddr.word[2]
 
173
  mov   cs:@JmpAddr.word[2], ax
 
174
 
 
175
  pop   ds
 
176
  pop   ax
 
177
 
 
178
  sti
 
179
 
 
180
  db    $9a
 
181
@JmpAddr:
 
182
  dw    0,0
 
183
  jmp   @over
 
184
@regax: dw  0
 
185
@over:
 
186
  mov  word ptr cs:@regax, ax
 
187
  push bx
 
188
  pushf
 
189
  pop  ax
 
190
  mov  bx, sp
 
191
  mov  word ptr ss:[bx+6], ax
 
192
  pop  bx
 
193
  mov  ax, word ptr cs:@regax
 
194
 
 
195
  iret
 
196
end;
 
197
{$endif}
 
198
 
 
199
procedure realcall(Proc: pointer; var r: registers);
 
200
{$ifdef DPMI}
 
201
var Regs: Registers;
 
202
begin
 
203
  FillChar(DPMIRegs, SizeOf(TDPMIRegisters), 0);
 
204
  DPMIRegs.EAX := r.ax;
 
205
  DPMIRegs.EBX := r.bx;
 
206
  DPMIRegs.ECX := r.cx;
 
207
  DPMIRegs.EDX := r.dx;
 
208
  DPMIRegs.EDI := r.di;
 
209
  DPMIRegs.ESI := r.si;
 
210
  DPMIRegs.EBP := r.bp;
 
211
  DPMIRegs.DS := r.ds;
 
212
  DPMIRegs.ES := r.es;
 
213
  DPMIRegs.Flags := r.flags;
 
214
  DPMIRegs.CS := PtrRec(Proc).Seg;
 
215
  DPMIRegs.IP := PtrRec(Proc).Ofs;
 
216
  DPMIRegs.SS :=0; DPMIRegs.SP:=0;
 
217
  Regs.AX := $0301;
 
218
  Regs.BH := 0;
 
219
  Regs.CX := 0;
 
220
  Regs.ES := Seg(DPMIRegs);
 
221
  Regs.DI := Ofs(DPMIRegs);
 
222
  Intr(DPMI_INTR, Regs);
 
223
  r.ax := DPMIRegs.EAX and $ffff;
 
224
  r.bx := DPMIRegs.EBX and $ffff;
 
225
  r.cx := DPMIRegs.ECX and $ffff;
 
226
  r.dx := DPMIRegs.EDX and $ffff;
 
227
  r.di := DPMIRegs.EDI and $ffff;
 
228
  r.si := DPMIRegs.ESI and $ffff;
 
229
  r.bp := DPMIRegs.EBP and $ffff;
 
230
  r.ds := DPMIRegs.DS;
 
231
  r.es := DPMIRegs.ES;
 
232
  r.Flags := DPMIRegs.Flags and $ffff;
 
233
end;
 
234
{$else}
 
235
(*begin
 
236
  asm
 
237
    push ds
 
238
    push bp
 
239
 
 
240
    mov  ax, Proc.word[2]
 
241
    mov  bx, Proc.word[0]
 
242
    mov  cs:@Call+1.word, bx
 
243
    mov  cs:@Call+3.word, ax
 
244
 
 
245
    lds  si, r
 
246
    mov  @rptr.word[2], ds
 
247
    mov  @rptr.word[0], si
 
248
 
 
249
    lodsw
 
250
    push ax { -> ax }
 
251
    lodsw
 
252
    mov  bx, ax
 
253
    lodsw
 
254
    mov  cx, ax
 
255
    lodsw
 
256
    mov  dx, ax
 
257
    lodsw
 
258
    mov  bp, ax
 
259
    lodsw
 
260
    push ax { -> si }
 
261
    lodsw
 
262
    mov  di, ax
 
263
    lodsw
 
264
    push ax { -> ds }
 
265
    lodsw
 
266
    mov  es, ax
 
267
    lodsw
 
268
    push ax { -> flags }
 
269
    popf
 
270
 
 
271
    pop  si
 
272
    pop  ds
 
273
    pop  ax
 
274
 
 
275
@Call:
 
276
    db   9ah
 
277
    dd   0
 
278
 
 
279
    jmp  @skipover
 
280
@rptr: dd  0
 
281
@skipover:
 
282
 
 
283
    pushf
 
284
    push es
 
285
    push di
 
286
 
 
287
    mov  es, @rptr.word[2]
 
288
    mov  di, @rptr.word[0]
 
289
    stosw
 
290
    mov  ax, bx
 
291
    stosw
 
292
    mov  ax, cx
 
293
    stosw
 
294
    mov  ax, dx
 
295
    stosw
 
296
    mov  ax, bp
 
297
    stosw
 
298
    mov  ax, si
 
299
    stosw
 
300
    pop  ax { <- di }
 
301
    stosw
 
302
    mov  ax, ds
 
303
    stosw
 
304
    pop  ax { <- es }
 
305
    stosw
 
306
    pop  ax { <- flags }
 
307
    stosw
 
308
 
 
309
    pop  bp
 
310
    pop  ds
 
311
  end;
 
312
end;
 
313
*)
 
314
begin
 
315
  if DummyIntRedir=false then
 
316
    begin
 
317
      SetIntVec(DummyInt,@CallInt);
 
318
      DummyIntRedir:=true;
 
319
    end;
 
320
  CallAddr:=Proc;
 
321
  dos.intr(DummyInt,r);
 
322
end;
 
323
 
 
324
{$endif}
 
325
 
 
326
(*const ActiveBlocks: word = 0;*)
 
327
 
 
328
function GetDosMem(var M: MemPtr; Size: word): boolean;
 
329
var P: pointer;
 
330
    L: longint;
 
331
begin
 
332
  M.Size:=Size;
 
333
{$ifndef DPMI}
 
334
  GetMem(P,Size);
 
335
  M.Seg:=PtrRec(P).Seg; M.Ofs:=PtrRec(P).Ofs;
 
336
{$else}
 
337
  L:=GlobalDosAlloc(Size);
 
338
  M.Seg:=(L shr 16); M.Ofs:=0;
 
339
  M.Sel:=(L and $ffff);
 
340
{$endif}
 
341
  if M.Seg<>0 then M.Clear;
 
342
  GetDosMem:=M.Seg<>0;
 
343
(*  Inc(ActiveBlocks);
 
344
  write('|DMC:',ActiveBlocks,'-S:',M.Sel,'-S:',M.Seg);*)
 
345
end;
 
346
 
 
347
procedure FreeDosMem(var M: MemPtr);
 
348
begin
 
349
  if M.Size=0 then Exit;
 
350
{$ifndef DPMI}
 
351
  if M.Seg<>0 then
 
352
  FreeMem(Ptr(M.Seg,M.Ofs),M.Size);
 
353
{$else}
 
354
  if M.Sel<>0 then
 
355
   if GlobalDosFree(M.Sel)<>0 then
 
356
    writeln('!!!Failed to deallocate Dos block!!!');
 
357
{$endif}
 
358
 
 
359
  FillChar(M,SizeOf(M),0);
 
360
end;
 
361
 
 
362
{$ifdef DPMI}
 
363
function GetSelectorForSeg(Seg: word): word;
 
364
var Sel: word;
 
365
    r: registers;
 
366
begin
 
367
  r.ax:=$0002; r.bx:=Seg;
 
368
  intr(DPMI_Intr,r);
 
369
  if (r.flags and fCarry)=0 then
 
370
    Sel:=r.ax
 
371
  else
 
372
    Sel:=0;
 
373
  GetSelectorForSeg:=Sel;
 
374
end;
 
375
{$endif}
 
376
 
 
377
function MoveDosToPM(DosPtr: pointer; PMPtr: pointer; Size: word): boolean;
 
378
{$ifndef DPMI}
 
379
begin
 
380
  Move(DosPtr^,PMPtr^,Size);
 
381
  MoveDosToPM:=true;
 
382
end;
 
383
{$else}
 
384
var Sel: word;
 
385
    OK,DisposeSel: boolean;
 
386
begin
 
387
  Sel:=GetSelectorForSeg(PtrRec(DosPtr).Seg);
 
388
  OK:=Sel<>0; DisposeSel:=false;
 
389
  if OK=false then
 
390
    begin
 
391
      Sel:=AllocSelector(0);
 
392
      OK:=Sel<>0;
 
393
      if OK then
 
394
        begin
 
395
          SetSelectorLimit(Sel,PtrRec(DosPtr).Ofs+Size);
 
396
          OK:=SetSelectorBase(Sel,PtrRec(DosPtr).Seg shl 4)=Sel;
 
397
        end;
 
398
      if OK then DisposeSel:=true;
 
399
    end;
 
400
  if OK then
 
401
    begin
 
402
      Move(ptr(Sel,PtrRec(DosPtr).Ofs)^,PMPtr^,Size);
 
403
      if DisposeSel then FreeSelector(Sel);
 
404
    end;
 
405
  MoveDosToPM:=OK;
 
406
end;
 
407
{$endif}
 
408
 
 
409
function MovePMToDos(PMPtr: pointer; DosPtr: pointer; Size: word): boolean;
 
410
{$ifndef DPMI}
 
411
begin
 
412
  Move(PMPtr^,DosPtr^,Size);
 
413
  MovePMToDos:=true;
 
414
end;
 
415
{$else}
 
416
var Sel: word;
 
417
    OK,DisposeSel: boolean;
 
418
begin
 
419
  Sel:=GetSelectorForSeg(PtrRec(DosPtr).Seg);
 
420
  OK:=Sel<>0; DisposeSel:=false;
 
421
  if OK=false then
 
422
    begin
 
423
      Sel:=AllocSelector(0);
 
424
      OK:=Sel<>0;
 
425
      if OK then
 
426
        begin
 
427
          SetSelectorLimit(Sel,PtrRec(DosPtr).Ofs+Size);
 
428
          OK:=SetSelectorBase(Sel,PtrRec(DosPtr).Seg shl 4)=Sel;
 
429
        end;
 
430
      if OK then DisposeSel:=true;
 
431
    end;
 
432
  if OK then
 
433
    begin
 
434
      Move(PMPtr^,ptr(Sel,PtrRec(DosPtr).Ofs)^,Size);
 
435
      if DisposeSel then FreeSelector(Sel);
 
436
    end;
 
437
  MovePMToDos:=OK;
 
438
end;
 
439
{$endif}
 
440
 
 
441
procedure realGetIntVec(IntNo: byte; var P: pointer);
 
442
{$ifndef DPMI}
 
443
begin
 
444
  GetIntVec(IntNo,P);
 
445
end;
 
446
{$else}
 
447
var r: registers;
 
448
begin
 
449
  r.ax:=$200; r.bl:=IntNo;
 
450
  intr(DPMI_Intr,r);
 
451
  P:=Ptr(r.cx,r.dx);
 
452
end;
 
453
{$endif}
 
454
 
 
455
procedure MemPtr.MoveDataTo(const Src; DSize: word);
 
456
begin
 
457
  if DSize>Size then
 
458
    RunError(216);
 
459
  Move(Src,Ptr(DataSeg,DataOfs)^,DSize);
 
460
end;
 
461
 
 
462
procedure MemPtr.MoveDataFrom(DSize: word; var Dest);
 
463
begin
 
464
  if DSize>Size then
 
465
    RunError(216);
 
466
  Move(Ptr(DataSeg,DataOfs)^,Dest,DSize);
 
467
end;
 
468
 
 
469
procedure MemPtr.Clear;
 
470
begin
 
471
  FillChar(Ptr(DataSeg,DataOfs)^,Size,0);
 
472
end;
 
473
 
 
474
procedure RealAbstract;
 
475
begin
 
476
  writeln('Abstract call in real mode...');
 
477
  RunError(255);
 
478
end;
 
479
 
 
480
function  allocrmcallback(PMAddr: pointer; RealRegs: pregisters): pointer;
 
481
{$ifdef DPMI}
 
482
var r: registers;
 
483
    P: pointer;
 
484
begin
 
485
  r.ax:=$0303;
 
486
  r.ds:=PtrRec(PMAddr).Seg; r.si:=PtrRec(PMAddr).Ofs;
 
487
  r.es:=PtrRec(RealRegs).Seg; r.di:=PtrRec(RealRegs).Ofs;
 
488
  intr(DPMI_Intr,r);
 
489
  if (r.flags and fCarry)=0 then
 
490
    P:=MakePtr(r.cx,r.dx)
 
491
  else
 
492
    P:=nil;
 
493
  allocrmcallback:=P;
 
494
end;
 
495
{$else}
 
496
begin
 
497
  RealAbstract;
 
498
end;
 
499
{$endif}
 
500
 
 
501
procedure freermcallback(RealCallAddr: pointer);
 
502
{$ifdef DPMI}
 
503
var r: registers;
 
504
begin
 
505
  r.ax:=$0304;
 
506
  r.cx:=PtrRec(RealCallAddr).Seg; r.dx:=PtrRec(RealCallAddr).Seg;
 
507
  intr(DPMI_Intr,r);
 
508
end;
 
509
{$else}
 
510
begin
 
511
  RealAbstract;
 
512
end;
 
513
{$endif}
 
514
 
 
515
{$endif TP}
 
516
 
 
517
{$ifdef GO32V2}
 
518
 
 
519
{ --------------------- GO32 --------------------- }
 
520
 
 
521
uses go32;
 
522
 
 
523
function  GetDosMem(var M: MemPtr; Size: word): boolean;
 
524
var L: longint;
 
525
begin
 
526
  M.Size:=Size;
 
527
  L:=global_dos_alloc(Size);
 
528
  M.Seg:=(L shr 16); M.Ofs:=0;
 
529
  M.Sel:=(L and $ffff);
 
530
  GetDosMem:=M.Seg<>0;
 
531
end;
 
532
 
 
533
procedure FreeDosMem(var M: MemPtr);
 
534
begin
 
535
  if M.Size=0 then Exit;
 
536
  if M.Sel<>0 then
 
537
  if global_dos_free(M.Sel)=false then
 
538
    writeln('!!!Failed to deallocate Dos block!!!');
 
539
  FillChar(M,SizeOf(M),0);
 
540
end;
 
541
 
 
542
procedure realintr(IntNo: byte; var r: registers);
 
543
var rr: trealregs;
 
544
begin
 
545
  rr.realeax:=r.ax;
 
546
  rr.realebx:=r.bx;
 
547
  rr.realecx:=r.cx;
 
548
  rr.realedx:=r.dx;
 
549
  rr.realesi:=r.si;
 
550
  rr.realedi:=r.di;
 
551
  rr.reales:=r.es;
 
552
  rr.realds:=r.ds;
 
553
  go32.realintr(IntNo,rr);
 
554
  r.ax:=rr.realeax and $ffff;
 
555
  r.bx:=rr.realebx and $ffff;
 
556
  r.cx:=rr.realecx and $ffff;
 
557
  r.dx:=rr.realedx and $ffff;
 
558
  r.si:=rr.realesi and $ffff;
 
559
  r.di:=rr.realedi and $ffff;
 
560
  r.es:=rr.reales and $ffff;
 
561
  r.ds:=rr.realds and $ffff;
 
562
end;
 
563
 
 
564
function dorealcall(var regs : trealregs) : boolean;
 
565
begin
 
566
  regs.realsp:=0;
 
567
  regs.realss:=0;
 
568
  asm
 
569
    movw  $0x0,%bx
 
570
    xorl  %ecx,%ecx
 
571
    movl  regs,%edi
 
572
    { es is always equal ds }
 
573
    movl  $0x301,%eax
 
574
    int   $0x31
 
575
    setnc %al
 
576
    movb  %al,__RESULT
 
577
  end;
 
578
end;
 
579
 
 
580
 
 
581
procedure realcall(Proc: pointer; var r: registers);
 
582
var rr: trealregs;
 
583
begin
 
584
  rr.realeax:=r.ax;
 
585
  rr.realebx:=r.bx;
 
586
  rr.realecx:=r.cx;
 
587
  rr.realedx:=r.dx;
 
588
  rr.realesi:=r.si;
 
589
  rr.realedi:=r.di;
 
590
  rr.reales:=r.es;
 
591
  rr.realds:=r.ds;
 
592
  rr.flags:=r.flags;
 
593
  rr.CS:=PtrRec(Proc).Seg;
 
594
  rr.IP:=PtrRec(Proc).Ofs;
 
595
 
 
596
  rr.realss:=0; rr.realsp:=0;
 
597
 
 
598
  dorealcall(rr);
 
599
 
 
600
  r.ax:=rr.realeax and $ffff;
 
601
  r.bx:=rr.realebx and $ffff;
 
602
  r.cx:=rr.realecx and $ffff;
 
603
  r.dx:=rr.realedx and $ffff;
 
604
  r.si:=rr.realesi and $ffff;
 
605
  r.di:=rr.realedi and $ffff;
 
606
  r.es:=rr.reales and $ffff;
 
607
  r.ds:=rr.realds and $ffff;
 
608
  r.flags:=rr.Flags and $ffff;
 
609
end;
 
610
 
 
611
function MoveDosToPM(DosPtr: pointer; PMPtr: pointer; Size: word): boolean;
 
612
begin
 
613
  dosmemget(PtrRec(DosPtr).Seg,PtrRec(DosPtr).Ofs,PMPtr^,Size);
 
614
  MoveDosToPM:=true;
 
615
end;
 
616
 
 
617
function MovePMToDos(PMPtr, DosPtr: pointer; Size: word): boolean;
 
618
begin
 
619
  dosmemput(PtrRec(DosPtr).Seg,PtrRec(DosPtr).Ofs,PMPtr^,Size);
 
620
  MovePMToDos:=true;
 
621
end;
 
622
 
 
623
procedure realGetIntVec(IntNo: byte; var P: pointer);
 
624
var si: tseginfo;
 
625
begin
 
626
  get_rm_interrupt(IntNo,si);
 
627
  PtrRec(P).Seg:=si.segment; PtrRec(P).Ofs:=longint(si.offset);
 
628
end;
 
629
 
 
630
procedure MemPtr.MoveDataTo(var Src; DSize: word);
 
631
begin
 
632
  dpmi_dosmemput(DosSeg,DosOfs,Src,DSize);
 
633
end;
 
634
 
 
635
procedure MemPtr.MoveDataFrom(DSize: word; var Dest);
 
636
begin
 
637
  dpmi_dosmemget(DosSeg,DosOfs,Dest,DSize);
 
638
end;
 
639
 
 
640
procedure MemPtr.Clear;
 
641
begin
 
642
  dpmi_dosmemfillchar(DosSeg,DosOfs,Size,#0);
 
643
end;
 
644
 
 
645
 
 
646
function  allocrmcallback(PMAddr: pointer; RealRegs: pregisters): pointer;
 
647
var s: tseginfo;
 
648
    P: pointer;
 
649
begin
 
650
  if get_rm_callback(PMAddr,RealRegs^,s) then
 
651
    P:=MakePtr(s.segment,longint(s.offset))
 
652
  else
 
653
    P:=nil;
 
654
  allocrmcallback:=P;
 
655
end;
 
656
 
 
657
procedure freermcallback(RealCallAddr: pointer);
 
658
var s: tseginfo;
 
659
begin
 
660
  s.segment:=PtrRec(RealCallAddr).seg;
 
661
  s.offset:=pointer(longint(PtrRec(RealCallAddr).ofs));
 
662
  free_rm_callback(s);
 
663
end;
 
664
 
 
665
{$endif GO32V2}
 
666
 
 
667
{ ---------------------- COMMON ---------------------- }
 
668
 
 
669
function MemPtr.DosPtr: pointer;
 
670
begin
 
671
  DosPtr:=MakePtr(Seg,Ofs);
 
672
end;
 
673
 
 
674
function MemPtr.DataPtr: pointer;
 
675
begin
 
676
  DataPtr:=MakePtr(DataSeg,DataOfs);
 
677
end;
 
678
 
 
679
function MemPtr.DataSeg: word;
 
680
begin
 
681
{$ifndef DPMI}
 
682
  DataSeg:=Seg;
 
683
{$else}
 
684
  DataSeg:=Sel;
 
685
{$endif}
 
686
end;
 
687
 
 
688
function MemPtr.DataOfs: word;
 
689
begin
 
690
{$ifndef DPMI}
 
691
  DataOfs:=Ofs;
 
692
{$else}
 
693
  DataOfs:=0;
 
694
{$endif}
 
695
end;
 
696
 
 
697
function MemPtr.DosSeg: word;
 
698
begin
 
699
  DosSeg:=Seg;
 
700
end;
 
701
 
 
702
function MemPtr.DosOfs: word;
 
703
begin
 
704
  DosOfs:=Ofs;
 
705
end;
 
706
 
 
707
function MakePtr(ASeg, AOfs: word): pointer;
 
708
var P: pointer;
 
709
begin
 
710
  with PtrRec(P) do
 
711
  begin
 
712
    Seg:=ASeg; Ofs:=AOfs;
 
713
  end;
 
714
  MakePtr:=P;
 
715
end;
 
716
 
 
717
END.