Category : Pascal Source Code
Archive   : PIBMDOS.ZIP
Filename : PIBMDOS.PAS
(* PIBMDOS.PAS --- Multitasker interface routines *)
(*--------------------------------------------------------------------------*)
(* *)
(* Author: Philip R. Burns *)
(* *)
(* Date: Version 1.0: January, 1986. DoubleDos support. *)
(* Version 2.0: April, 1986. Add DesqView support. *)
(* Version 3.0: July, 1986. Add TopView/Windows support. *)
(* Version 3.1: September, 1986. Update for TaskView support. *)
(* *)
(* Systems: MS DOS or PC DOS with DoubleDos/DesqView/TopView/Windows *)
(* installed. *)
(* *)
(* History: These routines provide a simple interface for PibTerm *)
(* with SoftLogic's DoubleDos multitasking executive, *)
(* Quarterdeck's DesqView multitasker, IBM's TopView, *)
(* MicroSoft's Windows, and Sunny Hill's TaskView. *)
(* (Windows is handled as a Topview-emulating product. This is *)
(* also true for TaskView and DesqView, but those programs do *)
(* not require the explicit screen updates TopView requires. *)
(* *)
(* If you have another multitasker, you should be able to *)
(* replace these routines fairly easily with similar-acting *)
(* ones for your multitasker. Use the global types defined *)
(* for MultiTasker and MultiTaskerType. *)
(* *)
(* With DoubleDos, it is necessary to reobtain the display buffer *)
(* address every time the screen memory is written to. With *)
(* DesqView, this is unnecessary. With TopView and Windows, *)
(* it is necessary to inform them that the screen has changed. *)
(* TaskView works like DesqView. *)
(* *)
(* There are routines for suspending/unsuspending timesharing *)
(* included here, but the only actual code provided is for *)
(* DoubleDos. This is because it is rarely necessary to freeze *)
(* programs in the TopView-like group, but it IS necessary for *)
(* DoubleDos to ensure that, when a large screen update is being *)
(* performed, no task switch occurs during the middle of the *)
(* update. *)
(* *)
(*--------------------------------------------------------------------------*)
(* *)
(* Please leave messages on Gene Plantz's BBS (312) 882 4145 *)
(* or Ron Fox's BBS (312) 940 6496. *)
(* *)
(*--------------------------------------------------------------------------*)
(*----------------------------------------------------------------------*)
(* Color_Screen_Active --- Determine if color or mono screen *)
(*----------------------------------------------------------------------*)
FUNCTION Color_Screen_Active : BOOLEAN;
(*----------------------------------------------------------------------*)
(* *)
(* Function: Color_Screen_Active *)
(* *)
(* Purpose: Determines if color or mono screen active *)
(* *)
(* Calling Sequence: *)
(* *)
(* Color_Active := Color_Screen_Active : BOOLEAN; *)
(* *)
(* Color_Active --- set to TRUE if the color screen is *)
(* active, FALSE if the mono screen is *)
(* active. *)
(* *)
(* Calls: INTR *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Regs : RegPack;
BEGIN (* Color_Screen_Active *)
Regs.Ax := 15 SHL 8;
INTR( $10 , Regs );
Color_Screen_Active := ( Regs.Al <> 7 );
End (* Color_Screen_Active *);
(*----------------------------------------------------------------------*)
(* Current_Video_Mode --- Determine current video mode setting *)
(*----------------------------------------------------------------------*)
FUNCTION Current_Video_Mode: INTEGER;
(*----------------------------------------------------------------------*)
(* *)
(* Function: Current_Video_Mode *)
(* *)
(* Purpose: Gets current video mode setting from system *)
(* *)
(* Calling Sequence: *)
(* *)
(* Current_Mode := Current_Video_Mode : INTEGER; *)
(* *)
(* Current_Mode --- set to integer representing current *)
(* video mode inherited from system. *)
(* *)
(* Calls: INTR *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Regs : RegPack;
BEGIN (* Current_Video_Mode *)
Regs.Ax := 15 SHL 8;
INTR( $10 , Regs );
Current_Video_Mode := Regs.Al;
End (* Current_Video_Mode *);
(*----------------------------------------------------------------------*)
(* Get_Screen_Address --- Get address of current screen *)
(*----------------------------------------------------------------------*)
PROCEDURE Get_Screen_Address( VAR Actual_Screen : Screen_Ptr );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Get_Screen_Address *)
(* *)
(* Purpose: Gets screen address for current type of display *)
(* *)
(* Calling Sequence: *)
(* *)
(* Get_Screen_Address( VAR Actual_Screen : Screen_Ptr ); *)
(* *)
(* Actual_Screen --- pointer whose value receives the *)
(* current screen address. *)
(* *)
(* Calls: Color_Screen_Active *)
(* PTR *)
(* TimeSharingActive *)
(* *)
(* Remarks: *)
(* *)
(* This routine assumes that 'IsTimeSharingActive' has already *)
(* been called so that the value of 'Virtual_Screen' is defined. *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Regs: RegPack;
BEGIN (* Get_Screen_Address *)
CASE MultiTasker OF
DoubleDos: BEGIN
Regs.Ax := $EC00;
MsDos( Regs );
Actual_Screen := PTR( Regs.Es, 0 );
END;
(* For TopView family, if graphics mode, *)
(* we must return actual screen address, *)
(* not virtual buffer address. The *)
(* virtual buffer is only for the *)
(* text modes. *)
TaskView,
TopView,
MSWindows,
DesqView: IF ( Current_Video_Mode <> HiRes_GraphMode ) THEN
Actual_Screen := Virtual_Screen
ELSE
Actual_Screen := PTR( Color_Screen_Address , 0 );
ELSE
IF Color_Screen_Active THEN
Actual_Screen := PTR( Color_Screen_Address , 0 )
ELSE
Actual_Screen := PTR( Mono_Screen_Address , 0 );
END (* CASE *);
END (* Get_Screen_Address *);
(*--------------------------------------------------------------------------*)
(* IsTimeSharingActive --- Checks if multitasker is active *)
(*--------------------------------------------------------------------------*)
FUNCTION IsTimeSharingActive : BOOLEAN;
(*--------------------------------------------------------------------------*)
(* *)
(* Function: IsTimeSharingActive *)
(* *)
(* Purpose: Checks if multitasker is active *)
(* *)
(* Calling Sequence: *)
(* *)
(* Ts_On := IsTimeSharingActive : BOOLEAN; *)
(* *)
(* Ts_On --- TRUE if multitasker is active. *)
(* *)
(* Calls: MsDos *)
(* *)
(*--------------------------------------------------------------------------*)
VAR
Regs : RegPack;
(*--------------------------------------------------------------------------*)
FUNCTION Get_TopView_Screen_Address : BOOLEAN;
VAR
SegS : INTEGER;
SegO : INTEGER;
BEGIN (* Get_TopView_Screen_Address *)
Regs.Di := 0;
Regs.Ax := $FE00;
IF Color_Screen_Active THEN
Regs.Es := Color_Screen_Address
ELSE
Regs.Es := Mono_Screen_Address;
SegO := 0;
SegS := Regs.Es;
INTR( $10 , Regs );
Virtual_Screen := PTR( Regs.Es , Regs.Di );
Get_TopView_Screen_Address := ( ( Regs.Es <> SegS ) OR ( Regs.Di <> SegO ) );
END (* Get_TopView_Screen_Address *);
(*--------------------------------------------------------------------------*)
BEGIN (* IsTimeSharingActive *)
(* Assume timesharing not active *)
IsTimeSharingActive := FALSE;
MultiTasker := MultiTasker_None;
(* Get initial screen address *)
IF Color_Screen_Active THEN
Virtual_Screen := PTR( Color_Screen_Address , 0 )
ELSE
Virtual_Screen := PTR( Mono_Screen_Address , 0 );
(* If DDos is active, $E4 should *)
(* return a non-zero value in Al *)
Regs.Ax := $E400;
MsDos( Regs );
IF ( Regs.Al <> 0 ) THEN
BEGIN
IsTimeSharingActive := TRUE;
MultiTasker := DoubleDos;
EXIT;
END;
(* See if DesqView is active. *)
(* We do a time/date call with *)
(* DESQ as date. If DesqView is *)
(* active, this will be accepted. *)
(* If not, it returns as invalid. *)
(* While we're at it, get the *)
(* display buffer address, which *)
(* never changes. *)
Regs.Ax := $2B01;
Regs.Cx := $4445; (*'DE'*)
Regs.Dx := $5351; (*'SQ'*)
MsDos( Regs );
IF ( Regs.Al <> $FF ) THEN
IF Get_TopView_Screen_Address THEN
BEGIN
IsTimeSharingActive := TRUE;
MultiTasker := DesqView;
EXIT;
END;
(* Check for TaskView or TopView. We do *)
(* a request for a TopView version number. *)
(* If BX comes back $0001, this must be *)
(* TaskView. Anything non-zero indicates *)
(* TopView or a compatible program. *)
Regs.Ax := $1022;
Regs.Bx := 0;
INTR( $15 , Regs );
IF ( Regs.Bx <> 0 ) THEN
BEGIN
IF ( Regs.Bx = 1 ) THEN
MultiTasker := TaskView
ELSE
MultiTasker := TopView;
IF ( NOT Get_TopView_Screen_Address ) THEN
MultiTasker := Multitasker_None
ELSE
IsTimeSharingActive := TRUE;
END;
END (* IsTimeSharingActive *);
(*--------------------------------------------------------------------------*)
(* TurnOnTimeSharing --- allow timesharing to proceed *)
(*--------------------------------------------------------------------------*)
PROCEDURE TurnOnTimeSharing;
(*--------------------------------------------------------------------------*)
(* *)
(* Procedure: TurnOnTimeSharing; *)
(* *)
(* Purpose: Activates timesharing *)
(* *)
(* Calling Sequence: *)
(* *)
(* TurnOnTimeSharing; *)
(* *)
(* Calls: MsDos *)
(* *)
(*--------------------------------------------------------------------------*)
VAR
Regs : RegPack;
BEGIN (* TurnOnTimeSharing *)
CASE MultiTasker OF
(* If DDos is active, $EB turns *)
(* on timesharing *)
DoubleDos: BEGIN
Regs.Ax := $EB00;
MsDos( Regs );
END;
ELSE;
END (* CASE *);
END (* TurnOnTimeSharing *);
(*--------------------------------------------------------------------------*)
(* TurnOffTimeSharing --- suspend timesharing under DoubleDos *)
(*--------------------------------------------------------------------------*)
PROCEDURE TurnOffTimeSharing;
(*--------------------------------------------------------------------------*)
(* *)
(* Procedure: TurnOffTimeSharing; *)
(* *)
(* Purpose: Suspends timesharing *)
(* *)
(* Calling Sequence: *)
(* *)
(* TurnOffTimeSharing; *)
(* *)
(* Calls: MsDos *)
(* *)
(*--------------------------------------------------------------------------*)
VAR
Regs : RegPack;
BEGIN (* TurnOffTimeSharing *)
CASE MultiTasker OF
(* If DDos is active, $EA suspends *)
(* timesharing *)
DoubleDos: BEGIN
Regs.Ax := $EA00;
MsDos( Regs );
END;
ELSE;
END (* CASE *);
END (* TurnOffTimeSharing *);
(*--------------------------------------------------------------------------*)
(* GiveAwayTime --- gives away time slices to other task *)
(*--------------------------------------------------------------------------*)
PROCEDURE GiveAwayTime( NSlices : INTEGER );
(*--------------------------------------------------------------------------*)
(* *)
(* Procedure: GiveAwayTime; *)
(* *)
(* Purpose: Gives away time slices to other tasks *)
(* *)
(* Calling Sequence: *)
(* *)
(* GiveAwayTime( NSlices : INTEGER ); *)
(* *)
(* NSlices --- # of slices (55 ms) to give away, if DoubleDos. *)
(* For other multitaskers, the entire remaining *)
(* time-slice is given up. *)
(* *)
(* Calls: MsDos *)
(* *)
(*--------------------------------------------------------------------------*)
VAR
Regs : RegPack;
BEGIN (* GiveAwayTime *)
CASE MultiTasker OF
(* Function EE gives time to other part. *)
DoubleDos: BEGIN
Regs.Ah := $EE;
Regs.Al := NSlices;
MsDos( Regs );
END;
(* Int 15H for TopView family products *)
DesqView,
TopView,
MSWindows,
TaskView: BEGIN
Regs.Ax := $1000;
INTR( $15 , Regs );
END;
ELSE;
END (* CASE *);
END (* GiveAwayTime *);
(*--------------------------------------------------------------------------*)
(* Sync_Screen --- Synchronizes multitasker screen with hardware screen *)
(*--------------------------------------------------------------------------*)
PROCEDURE Sync_Screen( S_Pos: INTEGER; NChars : INTEGER );
(*--------------------------------------------------------------------------*)
(* *)
(* Procedure: Sync_Screen; *)
(* *)
(* Purpose: Synchronizes multitasker and hardware screens *)
(* *)
(* Calling Sequence: *)
(* *)
(* Sync_Screen( S_Pos : INTEGER; NChars: INTEGER ); *)
(* *)
(* Calls: INTR *)
(* *)
(* Remarks: *)
(* *)
(* This facility is required by the TopView-family products. *)
(* *)
(*--------------------------------------------------------------------------*)
VAR
Regs : RegPack;
Daddr : Screen_Ptr;
BEGIN (* Sync_Screen *)
IF ( MultiTasker IN [TopView,MSWindows] ) THEN
WITH Regs DO
BEGIN
Regs.Es := SEG( Virtual_Screen^ );
Regs.Di := OFS( Virtual_Screen^ ) + S_Pos - 1;
Regs.Cx := NChars SHL 1;
Regs.Ah := $FF;
INTR( $10 , Regs );
END;
END (* Sync_Screen *);
(*--------------------------------------------------------------------------*)
(* Sync_Entire_Screen --- Synchronizes multitasker screen with hardware *)
(*--------------------------------------------------------------------------*)
PROCEDURE Sync_Entire_Screen;
(*--------------------------------------------------------------------------*)
(* *)
(* Procedure: Sync_Entire_Screen; *)
(* *)
(* Purpose: Synchronizes multitasker and hardware screens *)
(* *)
(* Calling Sequence: *)
(* *)
(* Sync_Entire_Screen; *)
(* *)
(* Calls: INTR *)
(* *)
(* Remarks: *)
(* *)
(* This facility is used by the TopView-family products when the *)
(* entire screen has been updated. *)
(* *)
(*--------------------------------------------------------------------------*)
VAR
Regs : RegPack;
BEGIN (* Sync_Entire_Screen *)
IF ( MultiTasker IN [TopView,MSWindows] ) THEN
WITH Regs DO
BEGIN
Regs.Es := SEG( Virtual_Screen^ );
Regs.Di := OFS( Virtual_Screen^ );
Regs.Cx := Screen_Length SHR 1;
Regs.Ah := $FF;
INTR( $10 , Regs );
END;
END (* Sync_Entire_Screen *);
(*----------------------------------------------------------------------*)
(* WriteSXY --- Write text string to specified row/column *)
(*----------------------------------------------------------------------*)
PROCEDURE WriteSXY( S: AnyStr; X: INTEGER; Y: INTEGER; Color: INTEGER );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: WriteSXY *)
(* *)
(* Purpose: Writes text string at specified row and column *)
(* position on screen. *)
(* *)
(* Calling Sequence: *)
(* *)
(* WriteSXY( S: AnyStr; X: INTEGER; Y: INTEGER; Color: INTEGER );*)
(* *)
(* S --- String to be written *)
(* X --- Column position to write string *)
(* Y --- Column position to write string *)
(* Color --- Color in which to write string *)
(* *)
(* Calls: None *)
(* *)
(* Remarks: This routine is based in part on one written by *)
(* Dennis Brain. *)
(* *)
(*----------------------------------------------------------------------*)
BEGIN (* WriteSXY *)
(* Freeze screen for DoubleDos *)
IF ( MultiTasker = DoubleDos ) THEN
BEGIN
TurnOffTimeSharing;
Get_Screen_Address( Virtual_Screen );
END;
INLINE(
$1E { PUSH DS ;Save DS}
{;}
{; Check if we're going to use BIOS}
{;}
/$A0/>Write_Screen_Memory { MOV AL,[
/$73/$5B { JNC BIOS ;No -- skip to BIOS code}
{;}
{; Set up for direct screen write.}
{; Get row position and column positions, and offset in screen buffer.}
{;}
/$8B/$46/
/$B9/$04/$00 { MOV CX,$0004 ;CL = 4; CH = 0}
/$D3/$E0 { SHL AX,CL ;AX = Row * 16}
/$89/$C3 { MOV BX,AX ;Sore in BX}
/$D1/$E0 { SHL AX,1 ;AX = Row * 32}
/$D1/$E0 { SHL AX,1 ;AX = Row * 64}
/$01/$D8 { ADD AX,BX ;AX = (Row * 64) + (Row * 16)}
{ ; = Row * 80}
/$8B/$5E/
/$01/$D8 { ADD AX,BX ;AX = (Row * 80) + Col}
/$D1/$E0 { SHL AX,1 ;Account for attribute bytes}
/$89/$C7 { MOV DI,AX ;Move result into DI}
/$8D/$76/
/$8E/$C2 { MOV ES,DX ;ES:DI points to Base:Row,Col}
/$A0/>Wait_For_Retrace { MOV AL,[
/$8E/$DA { MOV DS,DX ; into DS}
/$8A/$0C { MOV CL,[SI] ;CL = Length(S)}
/$E3/$72 { JCXZ Exit ;If string empty, Exit}
/$46 { INC SI ;DS:SI points to S[1]}
/$8A/$66/
/$D0/$D8 { RCR AL,1 ;If Snow is False...}
/$73/$1C { JNC Mono ; use "Mono" routine}
{;}
{; Color routine (used only when Wait_For_Retrace is True) **}
{;}
/$BA/>CRT_Status { MOV DX,>CRT_Status ;Point DX to CGA status port}
/$AC {GetNext: LODSB ;Load next character into AL}
{ ; AH already has Attr}
/$89/$C3 { MOV BX,AX ;Store video word in BX}
/$B4/$09 { MOV AH,$09 ;Move horizontal & vertical}
{ ; retrace mask into AH}
/$FA { CLI ;No interrupts now}
/$EC {WaitH: IN AL,DX ;Get 6845 status}
/$D0/$D8 { RCR AL,1 ;Wait for horizontal}
/$72/$FB { JC WaitH ; retrace}
/$EC {WaitV: IN AL,DX ;Get 6845 status again}
/$20/$E0 { AND AL,AH ;Wait for vertical}
/$74/$FB { JZ WaitV ; retrace}
/$89/$D8 { MOV AX,BX ;Move word back to AX...}
/$AB { STOSW ; and then to screen}
/$FB { STI ;Allow interrupts}
/$E2/$EA { LOOP GetNext ;Get next character}
/$E9/$4D/$00 { JMP Exit ;Done}
{;}
{; Mono routine (used whenever Wait_For_Retrace is False) **}
{;}
/$AC {Mono: LODSB ;Load next character into AL}
{ ; AH already has Attr}
/$AB { STOSW ;Move video word into place}
/$E2/$FC { LOOP Mono ;Get next character}
/$E9/$46/$00 { JMP Exit ;Done}
{;}
{; Use BIOS to display string (if Wrie_To_Screen is False) **}
{;}
/$8A/$76/
/$8A/$56/
/$FE/$CA { DEC DL ;}
/$8D/$76/
/$8E/$D8 { MOV DS,AX ; into DS}
/$8A/$0C { MOV CL,[SI] ;CL = Length(S)}
/$E3/$2F { JCXZ Exit ;If string empty, Exit}
/$46 { INC SI ;DS:SI points to S[1]}
/$52 { PUSH DX ;Save X and Y}
/$1E { PUSH DS ;Save DS:SI}
/$56 { PUSH SI ;}
/$FC { CLD ;Forward direction}
{;}
/$51 {Bios1: PUSH CX ;Push length}
/$B4/$02 { MOV AH,2 ;BIOS Position cursor}
/$B7/$00 { MOV BH,0 ;Page zero}
/$59 { POP CX}
/$5E { POP SI ;Get S address}
/$1F { POP DS ;}
/$5A { POP DX ;X and Y}
/$FE/$C2 { INC DL ;X + 1}
/$52 { PUSH DX ;Save X and Y}
/$1E { PUSH DS}
/$56 { PUSH SI}
/$51 { PUSH CX}
/$CD/$10 { INT $10 ;Call BIOS}
/$B4/$09 { MOV AH,9 ;BIOS Display character}
/$59 { POP CX}
/$5E { POP SI ;Get S address}
/$1F { POP DS ;}
/$AC { LODSB ;Next character into AL}
/$1E { PUSH DS ;Save S address}
/$56 { PUSH SI ;}
/$51 { PUSH CX ;Length left to do}
/$B7/$00 { MOV BH,0 ;Display page zero}
/$8A/$5E/
/$CD/$10 { INT $10 ;Call BIOS}
/$59 { POP CX ;Get back length}
/$E2/$D9 { LOOP Bios1}
{; ;Remove stuff left on stack}
/$5E { POP SI}
/$1F { POP DS}
/$5A { POP DX}
{;}
/$1F {Exit: POP DS ;Restore DS}
);
(* Unfreeze screen in DoubleDos *)
IF ( MultiTasker = DoubleDos ) THEN
TurnOnTimeSharing
(* Synchronize screen for TopView *)
ELSE IF ( MultiTasker = TopView ) THEN
Sync_Screen( ( ( Y - 1 ) * 80 + X ) SHL 1 - 1 , ORD( S[0] ) );
END (* WriteSXY *);
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/