home *** CD-ROM | disk | FTP | other *** search
- (* ****************************************************** *)
- (* XMS.PAS *)
- (* XMS-Zugriffs-Routinen *)
- (* (c) 1993 Andres Cvitkovich & DMV *)
- (* ****************************************************** *)
- UNIT XMS;
-
- INTERFACE
-
- VAR
- XmsThere : BOOLEAN;
- { TRUE, wenn XMS-Speicher vorhanden ist }
- XmsErrorCode : BYTE;
- { Fehlercode nach XMS-Funktion; 0=kein Fehler }
-
- FUNCTION XmsVersion : WORD;
- FUNCTION XmsKBytesAvail : WORD;
- FUNCTION XmsTotalKBytes : WORD;
- FUNCTION AllocateXmsBlock(KBytes : WORD) : WORD;
- FUNCTION DeallocateXmsHandle(Handle : WORD) : BOOLEAN;
- PROCEDURE MoveToXmsBlock(Data : Pointer; Size : LongInt;
- Handle : WORD; xOffset : LongInt);
- PROCEDURE MoveFromXmsBlock(Handle : WORD; xOffset: LongInt;
- Data : Pointer; Size : LongInt);
- PROCEDURE MoveToXms(buf : Pointer; Size : LongInt;
- xHdl : WORD; Offs : LongInt);
- PROCEDURE MoveFromXms(xHdl : WORD; Offs : LongInt;
- buf : Pointer; Size : LongInt);
-
- IMPLEMENTATION
-
- VAR
- XmsEntry : PROCEDURE;
- HIMEM_stack : ARRAY [0..255] OF WORD;
- Info_Block : RECORD
- Bytes : LongInt;
- src_hdl : WORD;
- src_ptr : Pointer;
- dst_hdl : WORD;
- dst_ptr : Pointer
- END;
-
- PROCEDURE NormalizePointer(VAR p : Pointer); ASSEMBLER;
- ASM
- LES DI, p
- MOV ax, ES:[DI]
- MOV CL, 4
- SHR AX, CL
- ADD ES:[DI+2], AX
- AND ES:[DI], Word(0Fh)
- END;
-
- FUNCTION XmsInstalled : BOOLEAN; ASSEMBLER;
- ASM
- MOV XmsThere, FALSE
- MOV AX, 4300h
- INT 2Fh
- CMP AL, 80h
- JNE @no
- INC XmsThere
- @no:
- MOV AL, XmsThere
- END;
-
- PROCEDURE SetEntry; ASSEMBLER;
- ASM
- MOV AX, 4310h
- INT 2Fh
- MOV Word (XmsEntry), BX
- MOV Word (XmsEntry+2), ES
- END;
-
- PROCEDURE XmsDrv; NEAR; ASSEMBLER;
- ASM
- JMP @overdata
- @axs:
- DW 0
- @sss:
- DW 0
- @ssp:
- DW 0
- @overdata:
- MOV Word Ptr CS:@sss, SS
- MOV Word Ptr CS:@ssp, SP
- MOV Word Ptr CS:@axs, AX
- MOV AX, SEG HIMEM_stack
- CLI
- MOV SS, AX
- MOV SP, (OFFSET HIMEM_stack) + (TYPE HIMEM_stack)
- MOV AX, Word Ptr CS:@axs
- STI
- CALL XmsEntry
- CLI
- MOV SS, Word Ptr CS:@sss
- MOV SP, Word Ptr CS:@ssp
- STI
- PUSH DS
- PUSH AX
- MOV AX, SEG @Data
- MOV DS, AX
- MOV XmsErrorCode, BL
- POP AX
- POP DS
- END;
-
- FUNCTION XmsVersion : WORD; ASSEMBLER;
- ASM
- XOR AX, AX
- CMP XmsThere, FALSE
- JE @@1
- CALL XmsDrv
- @@1:
- END;
-
- FUNCTION XmsKBytesAvail : WORD; ASSEMBLER;
- ASM
- XOR AX, AX
- CMP XmsThere, FALSE
- JE @@1
- MOV AH, 8
- CALL XmsDrv
- @@1:
- END;
-
- FUNCTION XmsTotalKBytes : WORD; ASSEMBLER;
- ASM
- XOR AX, AX
- CMP XmsThere, FALSE
- JE @@1
- MOV AH, 8
- CALL XmsDrv
- MOV AX, DX
- @@1:
- END;
-
- FUNCTION AllocateXmsBlock(KBytes: WORD): WORD; ASSEMBLER;
- ASM
- XOR AX, AX
- CMP XmsThere, FALSE
- JE @@1
- MOV AH, 9
- MOV DX, KBytes
- CALL XmsDrv
- OR AX, AX
- JZ @@1
- MOV AX, DX
- @@1:
- END;
-
- FUNCTION DeallocateXmsHandle(Handle : WORD) : BOOLEAN;
- ASSEMBLER;
- ASM
- CMP XmsThere, FALSE
- JE @@1
- MOV AH, 0Ah
- MOV DX, Handle
- CALL XmsDrv
- @@1:
- END;
-
- PROCEDURE MoveToXmsBlock(Data : Pointer; Size : LongInt;
- Handle : WORD; xOffset: LongInt);
- ASSEMBLER;
- ASM
- CMP XmsThere, FALSE
- JE @@2
- MOV CX, Handle
- MOV BL, 0A5h
- JCXZ @@1
- PUSH DS
- MOV AX, SEG Info_Block
- MOV ES, AX
- MOV DI, OFFSET Info_Block
- PUSH ES
- PUSH DI
- CLD
- MOV AX, Word (Size)
- STOSW
- MOV AX, Word (Size+2)
- STOSW
- XOR AX, AX
- STOSW
- MOV AX, Word (Data)
- STOSW
- MOV AX, Word (Data+2)
- STOSW
- MOV AX, CX
- STOSW
- MOV AX, Word (xOffset)
- STOSW
- MOV AX, Word (xOffset+2)
- STOSW
- POP SI
- POP DS
- MOV AH, 0Bh
- CALL XmsDrv
- POP DS
- OR AX,AX
- JZ @@1
- XOR BL,BL
- @@1:
- MOV XmsErrorCode, BL
- @@2:
- END;
-
- PROCEDURE MoveFromXmsBlock(Handle: WORD; xOffset: LongInt;
- Data: Pointer; Size: LongInt);
- ASSEMBLER;
- ASM
- CMP XmsThere, FALSE
- JE @@2
- MOV CX, Handle
- MOV BL, 0A5h
- JCXZ @@1
- PUSH DS
- MOV AX, SEG Info_Block
- MOV ES, AX
- MOV DI, OFFSET Info_Block
- PUSH ES
- PUSH DI
- CLD
- MOV AX, Word (Size)
- STOSW
- MOV AX, Word (Size+2)
- STOSW
- MOV AX, CX
- STOSW
- MOV AX, Word (xOffset)
- STOSW
- MOV AX, Word (xOffset+2)
- STOSW
- XOR AX, AX
- STOSW
- MOV AX, Word (Data)
- STOSW
- MOV AX, Word (Data+2)
- STOSW
- POP SI
- POP DS
- MOV AH, 0Bh
- CALL XmsDrv
- POP DS
- OR AX,AX
- JZ @@1
- XOR BL,BL
- @@1:
- MOV XmsErrorCode, BL
- @@2:
- END;
-
- PROCEDURE MoveToXms(buf : Pointer; Size : LongInt;
- xHdl : WORD; Offs : LongInt);
- TYPE
- BPtr = ^BYTE;
- VAR
- tmpbuf : ARRAY [1..2] OF BYTE;
- p : Pointer;
- BEGIN
- IF Size = 0 THEN Exit;
- IF Odd (Size) THEN BEGIN
- IF Size = 1 THEN BEGIN
- IF Offs = 0 THEN BEGIN
- MoveFromXmsBlock (xHdl, 0, @tmpbuf, 2);
- tmpbuf [1] := BPtr(buf)^;
- MoveToXmsBlock (@tmpbuf, 2, xHdl, 0);
- END ELSE BEGIN
- MoveFromXmsBlock (xHdl, Offs-1, @tmpbuf, 2);
- tmpbuf [2] := BPtr(buf)^;
- MoveToXmsBlock (@tmpbuf, 2, xHdl, Offs-1);
- END;
- END ELSE BEGIN
- p := buf;
- NormalizePointer (p);
- MoveToXmsBlock (p, 2, xHdl, Offs);
- Inc(Longint (p));
- NormalizePointer (p);
- MoveToXmsBlock (p, Size-1, xHdl, Offs+1);
- END;
- END ELSE
- MoveToXmsBlock (buf, Size, xHdl, Offs);
- END;
-
- PROCEDURE MoveFromXms(xHdl : WORD; Offs : LongInt;
- buf : Pointer; Size : LongInt);
- TYPE
- BPtr = ^Byte;
- VAR
- tmpbuf : ARRAY [1..2] OF BYTE;
- p : Pointer;
- BEGIN
- IF Size = 0 THEN Exit;
- IF Odd(Size) THEN BEGIN
- IF Size = 1 THEN BEGIN
- IF Offs = 0 THEN BEGIN
- MoveFromXmsBlock(xHdl, 0, @tmpbuf, 2);
- BPtr(buf)^ := tmpbuf [1];
- END ELSE BEGIN
- MoveFromXmsBlock(xHdl, Offs-1, @tmpbuf, 2);
- BPtr(buf)^ := tmpbuf [2];
- END;
- END ELSE BEGIN
- p := buf; NormalizePointer (p);
- MoveFromXmsBlock(xHdl, Offs, p, 2);
- Inc(LongInt(p)); NormalizePointer (p);
- MoveFromXmsBlock(xHdl, Offs+1, p, Size-1);
- END;
- END ELSE
- MoveFromXmsBlock(xHdl, Offs, buf, Size);
- END;
-
- BEGIN
- IF XmsInstalled THEN SetEntry;
- End.
- (* ****************************************************** *)
- (* Ende von XMS.PAS *)