Skip to content

Commit

Permalink
Initial commit
Browse files Browse the repository at this point in the history
  • Loading branch information
dosworld committed Jan 9, 2022
1 parent 059183d commit 69cda60
Show file tree
Hide file tree
Showing 6 changed files with 1,758 additions and 0 deletions.
16 changes: 16 additions & 0 deletions MAKEFILE
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,16 @@
all : SYSTEM2.TPU

SYSTEM2.TPU: SYSTEM2.PAS SYSMEM.TPU
tpc SYSTEM2.PAS

SYSEMS.TPU: SYSEMS.PAS
tpc SYSEMS.PAS

SYSXMS.TPU: SYSXMS.PAS
tpc SYSXMS.PAS

SYSMEM.TPU: SYSMEM.PAS SYSXMS.TPU SYSEMS.TPU
tpc SYSMEM.PAS

clean:
del *.TPU
19 changes: 19 additions & 0 deletions README.MD
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,19 @@
# System2 library for Trubo Pascal (MS-DOS)

This units is designed to replace some functions from system unit.

It has support for:

1. Long file names
2. Buffered I/O (DOS memory, 16K per file)
3. Buffered I/O (EMS and XMS memory, up to 512 KB per file)
4. File in memory (EMS, XMS) up to 64 MB each.
5. Quoted command-line parameters

NOTE about 16K: This value became from EMS-page size,
so please dont change it.

# License

MIT License

124 changes: 124 additions & 0 deletions SYSEMS.PAS
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,124 @@
{
MIT License
Copyright (c) 2022 Viacheslav Komenda
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.
}
{$A+,I-,S-,R-,D-,L-,Q-,F-,G-,O-,B-}
UNIT SysEms;

INTERFACE

CONST

EMS_PAGE_SIZE = 16*1024;
EMS_STATUS_OK = 0;
EMS_PAGE_UNMAP = $FFFF;

FUNCTION ems_check_driver : BOOLEAN;
FUNCTION ems_get_status : BYTE;
FUNCTION ems_get_window : PCHAR;
FUNCTION ems_get_free_page_count : WORD;
FUNCTION ems_malloc(pages : WORD) : WORD;
PROCEDURE ems_free(handle : WORD);
{ dest : [0..3], page : [0..] }
FUNCTION ems_map(handle : WORD; page : WORD; dest : BYTE) : BYTE;

IMPLEMENTATION

CONST

EMMDEVNAME : STRING[8] = 'EMMXXXX0';

FUNCTION ems_get_status : BYTE;ASSEMBLER;
ASM
MOV AH, $40
INT $67
MOV AL, AH
END;

FUNCTION ems_get_window : PCHAR;ASSEMBLER;
ASM
MOV AH, $41
INT $67
OR AH, AH
jz @present
XOR BX, BX
@present:
MOV DX, BX
XOR AX, AX
END;

FUNCTION ems_get_free_page_count : WORD;ASSEMBLER;
ASM
MOV AH, $42
INT $67
OR AH, AH
JZ @present
XOR BX, BX
@present:
MOV AX, BX
END;

FUNCTION ems_malloc(pages : WORD) : WORD;ASSEMBLER;
ASM
MOV BX, pages
MOV AH, $43
INT $67
OR AH, AH
JZ @present
XOR DX, DX
@present:
MOV AX, DX
END;

PROCEDURE ems_free(handle : WORD);ASSEMBLER;
ASM
MOV AH, $45
MOV DX, handle
INT $67
END;

FUNCTION ems_map(handle : WORD; page : WORD; dest : BYTE) : BYTE; ASSEMBLER;
ASM
MOV AL, dest
MOV AH, $44
MOV BX, page
MOV DX, handle
INT $67
MOV AL, AH
END;

FUNCTION ems_check_driver : BOOLEAN;
VAR dev_name : STRING[8];
int67seg : WORD;
BEGIN
ASM
MOV AX, $3567
INT $21
MOV AX, ES
MOV int67seg, AX
END;
Move(MEM[int67seg : $0A], dev_name[1], 8);
dev_name[0] := #8;
ems_check_driver := dev_name = EMMDEVNAME;
END;

END.
221 changes: 221 additions & 0 deletions SYSMEM.PAS
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,221 @@
{
MIT License
Copyright (c) 2022 Viacheslav Komenda
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.
}
{$A+,I-,S-,R-,D-,L-,Q-,F-,G-,O-,B-}
UNIT SysMem;

INTERFACE

CONST

EXTMEM_BLOCK_SIZE = 16 * 1024;

FUNCTION sysmem_avail : BOOLEAN;
FUNCTION sysmem_alloc(blk_count : WORD) : POINTER;
FUNCTION sysmem_put(h : POINTER; blk_num : WORD; VAR blk) : BOOLEAN;
FUNCTION sysmem_get(h : POINTER; blk_num : WORD; VAR blk) : BOOLEAN;
PROCEDURE sysmem_free(h : POINTER);

IMPLEMENTATION

USES SysEms, SysXms;

TYPE

DWORD = LONGINT;

TMEMTYPE = (MT_NONE, MT_EMS, MT_XMS);

PSYSMEM_REC = ^TSYSMEM_REC;
TSYSMEM_REC = RECORD
ems_h : WORD;
xms_h : WORD;
size : WORD;
END;

VAR

ems_installed : BOOLEAN;
ems_window : PCHAR;
ems_winnum : WORD;
ems_windows : ARRAY[0..3] OF WORD;
xms_installed : BOOLEAN;
memtype : TMEMTYPE;

FUNCTION ems_alloc(VAR he : TSYSMEM_REC; blk_count : WORD) : BOOLEAN;
BEGIN
he.ems_h := sysems.ems_malloc(blk_count);
ems_alloc := he.ems_h <> 0;
END;

FUNCTION xms_alloc(VAR he : TSYSMEM_REC; blk_count : WORD) : BOOLEAN;
BEGIN
he.xms_h := sysxms.xms_malloc(blk_count);
xms_alloc := he.xms_h <> 0;
END;

FUNCTION ems_get_win(h : WORD) : WORD;
VAR i : WORD;
BEGIN
i := 0;
WHILE i < 4 DO BEGIN
IF ems_windows[i] = h THEN BEGIN
BREAK;
END;
Inc(i);
END;
IF i = 4 THEN BEGIN
i := ems_winnum;
ems_windows[i] := h;
ems_winnum := (ems_winnum + 1) AND 3;
END;
ems_get_win := i;
END;

FUNCTION ems_get(VAR he : TSYSMEM_REC; blk_num : WORD; VAR blk) : BOOLEAN;
VAR r : BOOLEAN;
win : WORD;
BEGIN
r := FALSE;
win := ems_get_win(he.ems_h);
IF sysems.ems_map(he.ems_h, blk_num, win) = EMS_STATUS_OK THEN BEGIN
Move(ems_window[win SHL 14], blk, EMS_PAGE_SIZE);
sysems.ems_map(he.ems_h, EMS_PAGE_UNMAP, win);
r := TRUE;
END;
ems_get := r;
END;

FUNCTION xms_get(VAR he : TSYSMEM_REC; blk_num : WORD; VAR blk) : BOOLEAN;
BEGIN
xms_copy(he.xms_h, blk_num, blk, XMS2DOS);
xms_get := TRUE;
END;

FUNCTION ems_put(VAR he : TSYSMEM_REC; blk_num : WORD; VAR blk) : BOOLEAN;
VAR r : BOOLEAN;
win : WORD;
BEGIN
r := FALSE;
win := ems_get_win(he.ems_h);
IF sysems.ems_map(he.ems_h, blk_num, win) = EMS_STATUS_OK THEN BEGIN
Move(blk, ems_window[win SHL 14], EMS_PAGE_SIZE);
sysems.ems_map(he.ems_h, EMS_PAGE_UNMAP, win);
r := TRUE;
END;
ems_put := r;
END;

FUNCTION xms_put(VAR he : TSYSMEM_REC; blk_num : WORD; VAR blk) : BOOLEAN;
BEGIN
xms_copy(he.xms_h, blk_num, blk, DOS2XMS);
xms_put := TRUE;
END;

PROCEDURE ems_free(VAR he : TSYSMEM_REC);
VAR i : INTEGER;
BEGIN
IF he.ems_h <> 0 THEN BEGIN
FOR i := 0 TO 3 DO BEGIN
IF ems_windows[i] = he.ems_h THEN BEGIN
ems_windows[i] := 0;
END;
END;
sysems.ems_free(he.ems_h);
END;
END;

PROCEDURE xms_free(VAR he : TSYSMEM_REC);
BEGIN
IF he.xms_h <> 0 THEN sysxms.xms_free(he.xms_h);
END;

FUNCTION sysmem_avail : BOOLEAN;
BEGIN
sysmem_avail := memtype IN [MT_EMS, MT_XMS];
END;

FUNCTION sysmem_alloc(blk_count : WORD):POINTER;
VAR he : Psysmem_REC;
r : BOOLEAN;
BEGIN
he := NIL;
IF memtype <> MT_NONE THEN BEGIN
GetMem(he, SizeOf(Tsysmem_REC));
IF he <> NIL THEN BEGIN
FillChar(he^, SizeOf(Tsysmem_REC), #0);
IF memtype = MT_EMS THEN r := sysmem.ems_alloc(he^, blk_count)
ELSE IF memtype = MT_XMS THEN r := sysmem.xms_alloc(he^, blk_count)
ELSE r := FALSE;
IF r THEN he^.size := blk_count ELSE BEGIN
FreeMem(he, SizeOf(Tsysmem_REC));
he := NIL;
END;
END;
END;
sysmem_alloc := he;
END;

FUNCTION sysmem_get(h : POINTER; blk_num:WORD; VAR blk) : BOOLEAN;
BEGIN
IF h = NIL THEN sysmem_get := FALSE
ELSE IF blk_num >= Psysmem_REC(h)^.size THEN sysmem_get := FALSE
ELSE IF memtype = MT_XMS THEN sysmem_get := xms_get(PSYSMEM_REC(h)^, blk_num, blk)
ELSE IF memtype = MT_EMS THEN sysmem_get := ems_get(PSYSMEM_REC(h)^, blk_num, blk)
ELSE sysmem_get := FALSE;
END;

FUNCTION sysmem_put(h : POINTER; blk_num : WORD; VAR blk) : BOOLEAN;
BEGIN
IF h = NIL THEN sysmem_put := FALSE
ELSE IF blk_num >= Psysmem_REC(h)^.size THEN sysmem_put := FALSE
ELSE IF memtype = MT_XMS THEN sysmem_put := xms_put(PSYSMEM_REC(h)^, blk_num, blk)
ELSE IF memtype = MT_EMS THEN sysmem_put := ems_put(PSYSMEM_REC(h)^, blk_num, blk)
ELSE sysmem_put := FALSE;
END;

PROCEDURE sysmem_free(h : POINTER);
BEGIN
IF h = NIL THEN EXIT
ELSE IF memtype = MT_XMS THEN xms_free(PSYSMEM_REC(h)^)
ELSE IF memtype = MT_EMS THEN ems_free(PSYSMEM_REC(h)^);
FreeMem(h, SizeOf(TSYSMEM_REC));
END;

BEGIN
ems_installed := FALSE;
xms_installed := FALSE;
ems_window := NIL;
FillChar(ems_windows, SizeOf(ems_windows), #0);
memtype := MT_NONE;

xms_installed := xms_check_driver;
IF ems_check_driver THEN IF ems_get_status = EMS_STATUS_OK THEN BEGIN
ems_installed := TRUE;
ems_window := ems_get_window;
ems_winnum := 0;
END;

IF xms_installed THEN memtype := MT_XMS
ELSE IF ems_installed THEN memtype := MT_EMS;
END.
Loading

0 comments on commit 69cda60

Please sign in to comment.