[Back to COMM SWAG index] [Back to Main SWAG index] [Original]
{
3 Files:
PROTCOMM.PAS
IO.PAS
BBS.PAS
[-----------protcomm.pas begins----------------------------------------]
{ Origin - Mark Dignam of Omen Technologies This unit has been highly modified }
Unit ProtComm;
Interface
Procedure SetBaud (NewRate : LongInt);
Function GetBaud : LongInt;
Function Comm_Init (Baud : LongInt; ThePort : Byte) : Boolean;
Procedure ModemDeInit;
Procedure SetDTR (OnOff : Boolean);
Function SendReady: Boolean;
Function Carrier : Boolean;
Function DataAvailable : Boolean;
Function GetChar : Byte;
Procedure HangUp;
Function Ringing : Boolean;
Procedure SendByte (Ch : Char);
Procedure AsyncFlushOutput;
Procedure AsyncPurgeOutput;
Procedure AsyncPurgeInput;
Procedure SendBreak;
Procedure CTS_RTS (OnOff : Boolean);
Procedure AWrite (S : String);
Procedure AWriteLn (S : String);
Var CanUseFossil : Boolean;
UsedPort : Byte;
Implementation
Uses Crt, { Borland CRT Routines }
Dos; { Borland Disk I/O Routines }
Const MaxPhysPort = 7;
BufferSize = 8196;
BufferMax = 8195;
CommInterrupt = $14 ;
I8088_IMR = $21 ; { port address of the Interrupt Mask Register }
IBM_UART_THR = $00 ;
IBM_UART_RBR = $00 ;
IBM_UART_IER = $01 ;
IBM_UART_IIR = $02 ;
IBM_UART_LCR = $03 ;
IBM_UART_MCR = $04 ;
IBM_UART_LSR = $05 ;
IBM_UART_MSR = $06 ;
PortTable : Array [0..MaxPhysPort] Of Record
Base : Word;
IRQ : Byte
End = ( (Base : $3F8; IRQ : 4),
(Base : $2F8; IRQ : 3),
(Base : $3E8; IRQ : 4),
(Base : $2E8; IRQ : 3),
(Base : 0; IRQ : 0),
(Base : 0; IRQ : 0),
(Base : 0; IRQ : 0),
(Base : 0; IRQ : 0));
Var BIOS_Ports, IRQ : Byte;
Old_IER, Old_IIR, Old_LCR, Old_MCR, Old_IMR : Byte;
ExitSave, OriginalVector : Pointer;
IsOpen, OverFlow, UseFossil, CTS_RTS_On : Boolean;
Base, BufferHead, BufferTail, BufferNewTail : Word;
Status, RxWord, CtsTimer : Word;
Buffer : Array [0..BufferMax] Of
Byte; Regs : Registers;
Procedure Comm_SetBios (NewRate : LongInt);
Var BaudRate : Byte;
Temp0 : Integer;
Begin
{$IFNDEF TEST}
Temp0 := NewRate Div 10;
Case Temp0 of
30 : BaudRate := $43;
60 : BaudRate := $63;
120 : BaudRate := $83;
240 : BaudRate := $A3;
480 : BaudRate := $C3;
960 : BaudRate := $E3;
1920 : BaudRate := $03;
3840 : BaudRate := $23;
5760 : BaudRate := $23;
End;
Regs.AH := 0;
Regs.AL := BaudRate;
Regs.DX := UsedPort;
Intr ($14, Regs);
{$ENDIF}
End;
Procedure Comm_SetDirect (NewRate : LongInt);
Var I, J, K : Word;
Temp : LongInt;
Begin
{$IFNDEF TEST}
Temp := 115200;
Temp := Temp DIV Newrate;
Move (Temp, J, 2);
K := Port [IBM_UART_LCR + Base];
port [IBM_UART_LCR + Base] := $80;
Port [IBM_UART_THR + Base] := Lo (J);
Port [IBM_UART_IER + Base] := Hi (J);
Port [IBM_UART_LCR + Base] := 3;
{$ENDIF}
End;
Procedure SetBaud (NewRate : LongInt);
Begin
{$IFNDEF TEST}
If UseFossil Then Comm_SetBios (NewRate) Else Comm_SetDirect (NewRate);
{$ENDIF}
End;
Function Getbaud : LongInt;
Var I, J, K : Word;
Temp : LongInt;
begin
{$IFNDEF TEST}
K := Port [ibm_UART_LCR + Base];
Port [IBM_UART_LCR + Base] := K OR $80;
i := Port [IBM_UART_THR + Base];
J := Port [IBM_UART_IER + Base];
J := J * $100;
J := J + I;
Port [IBM_UART_LCR + base] := k;
Temp := 115200;
Temp := Temp DIV J;
GetBaud := Temp;
{$ELSE}
GetBaud := 4800;
{$ENDIF}
End;
Function Carrier : Boolean;
Begin
{$IFNDEF TEST}
Carrier := Port [IBM_UART_MSR + Base] AND $80 = $80;
{$ELSE}
Carrier := False;
{$ENDIF}
End;
Procedure DisableInterrupts; Inline ($FA);
Procedure EnableInterrupts; Inline ($FB);
Procedure ISR; Interrupt;
Begin
{$IFNDEF TEST}
Inline(
$FB/ { sti }
{Start: }
{ get the incoming character }
{ Buffer[BufferHead] := chr(port[base + ibm_uart_rbr]); }
$8B/$16/Base/ { mov dx,Base }
$EC/ { in al,dx }
$8B/$1E/BufferHead/ { mov bx,BufferHead }
$88/$87/Buffer/ { mov Buffer[bx],al }
{ BufferNewHead := Succ (BufferHead); }
$43/ { inc bx }
{ if BufferNewHead > BufferMax then BufferNewHead := 0 ; }
$81/$FB/BufferMax/ { cmp bx,BufferMax }
$7E/$02/ { jle l001 }
$33/$DB/ { xor bx,bx }
{ if BufferNewHead = BufferTail then Overflow := true }
{L001: }
$3B/$1E/BufferTail/ { cmp bx,BufferTail }
$75/$07/ { jne L002 }
$C6/$06/Overflow/$01/ { mov overflow,1 }
$EB/$0E/ { jmp short L003 }
{ ELSE BEGIN }
{ BufferHead := BufferNewHead; }
{ Async_BufferUsed := succ(Async_BufferUsed); }
{ IF Async_BufferUsed > Async_MaxBufferUsed then }
{ Async_MaxBufferUsed := Async_BufferUsed }
{ END ; }
{L002: }
$89/$1E/BufferHead/ { mov BufferHead,bx }
$83/$C2/$05/ { Add dx,5 }
{ Check FIFO - And process if more bytes. }
$EC/ { In al,dx }
$24/$01/ { And al,$01 }
$3C/$01/ { cmp al,$01 }
$74/$CF/ { je start: }
{L003: }
$FA/ { cli }
{ issue non-specific EOI }
{ port[$20] := $20 ; }
$B0/$20/ { mov al,20h }
$E6/$20); { out 20h,al }
{$ENDIF}
End;
Procedure Async_Close;
Begin
{$IFNDEF TEST}
If IsOpen Then
Begin
DisableInterrupts;
Port [I8088_IMR] := (Port[I8088_IMR] OR (1 SHL IRQ));
Port [IBM_UART_IER + Base] := Old_IER;
EnableInterrupts;
Port [IBM_UART_MCR + Base] := Old_MCR;
Port [IBM_UART_LCR + Base] := Old_lCR;
SetIntVec (IRQ + 8, OriginalVector);
IsOpen := False;
End;
{$ENDIF}
End;
Function Init_fossil (Baud : LongInt; ThePort : Byte) : Boolean;
Begin
{$IFNDEF TEST}
UsedPort := ThePort - 1;
Regs.AH := 4;
Regs.DX := UsedPort;
Intr ($14, Regs);
If Regs.AX <> $1954 Then Init_Fossil := False Else
Begin
Init_Fossil := True;
UseFossil := True;
SetBaud (Baud);
End;
{$ELSE}
Init_Fossil := True;
{$ENDIF}
End;
Function Async_Open(Baud : Longint; LogicalPortNum: byte): boolean;
Var I, OldIIR : Byte;
Fifos, PortThere : Boolean;
Begin
{$IFNDEF TEST}
If Not IsOpen Then
Begin
BufferHead := 0;
BufferTail := 0;
Overflow := False;
UsedPort := Pred (LogicalPortNum);
Fifos := False;
IsOpen := False;
If PortTable [UsedPort].Base <> 0 Then
Begin
Base := PortTable [UsedPort].Base;
IRQ := PortTable [UsedPort].IRQ;
Old_IER := Port [IBM_UART_IER + Base];
Old_MCR := Port [IBM_UART_MCR + Base];
Old_LCR := Port [IBM_UART_LCR + Base];
Port [IBM_UART_LCR + Base] := $75;
PortThere := (Port [IBM_UART_LCR + Base] = $75);
Port [IBM_UART_LCR + Base] := $3;
If PortThere Then
Begin
Comm_SetDirect (Baud);
Port [IBM_UART_MCR + Base] := $0B;
OldIIR := Port [IBM_UART_IIR + Base];
Port [IBM_UART_IIR + Base] := 1;
Fifos := (Port [IBM_UART_IIR + Base] AND $C0 = $C0);
If Not Fifos Then Port [IBM_UART_IIR + Base] := OldIIR;
GetIntVec (IRQ + 8, OriginalVector);
SetIntVec (IRQ + 8, @ISR);
DisableInterrupts;
Port [I8088_IMR] := (Port [I8088_IMR] AND ((1 SHL IRQ) XOR $FF));
Port [IBM_UART_IER + Base] := 1;
EnableInterrupts;
IsOpen := True;
End;
End;
End;
Async_Open := IsOpen
{$ELSE}
Async_Open := True;
{$ENDIF}
End;
{$F+}
Procedure TerminateUnit;
{$F-}
Begin
Async_Close;
ExitProc := ExitSave
End;
Function Comm_init (Baud : Longint; ThePort : Byte) : Boolean;
Begin
{$IFNDEF TEST}
UseFossil := False;
If Not IsOpen Then
Begin
If (CanUseFossil) AND (Init_Fossil (Baud, ThePort)) Then
Begin
Comm_Init := True;
IsOpen := True;
Base := PortTable [UsedPort].Base;
End Else
Begin
If Async_Open (Baud, ThePort) Then
Begin
Comm_Init := true;
IsOpen := True;
End Else Comm_Init := False;
End;
End;
UsedPort := ThePort;
{$ELSE}
Comm_Init := True;
{$ENDIF}
End;
Function DataAvailable : Boolean;
Var AHigh : Byte;
Begin
{$IFNDEF TEST}
If UseFossil Then
Begin
Inline ($B4/$03/ { MOV AH, 3 }
$8b/$16/UsedPort/ { MOV DX, Usedport }
$cd/$14/ { INT 14h }
$a3/Status); { MOV [Status], AL }
DataAvailable := ((Status AND $100) <> 0);
End Else DataAvailable := (Bufferhead <> BufferTail);
{$ELSE}
DataAvailable := False;
{$ENDIF}
End;
Procedure ModemDeInit;
Begin
{$IFNDEF TEST}
If IsOpen Then
Begin
If UseFossil Then
Begin
Regs.AH := 5;
Regs.DX := UsedPort;
Intr ($14, Regs);
End Else Async_Close;
IsOpen := False;
End;
{$ENDIF}
End;
Function GetChar : byte;
Begin
{$IFNDEF TEST}
If UseFossil Then
Begin
Inline ($B4/$02/ { MOV AH, 3 }
$8b/$16/UsedPort/ { MOV Dx, Usedport }
$CD/$14/ { INT 14h }
$A3/RXWord); { Mov [Status], AL }
GetChar := Lo (RXWord);
End Else
Begin
GetChar := Buffer [BufferTail] ;
BufferTail := (Succ (BufferTail) MOD BufferSize) ;
End;
{$ENDIF}
End;
Function SendReady : boolean;
Var Ahigh : Byte;
Carr, CTS, THR : boolean;
Begin
{$IFNDEF TEST}
If UseFossil Then
Begin
Inline ($B4/$03/ { MOV AH, 3 }
$8B/$16/UsedPort/ { MOV DX, Usedport }
$CD/$14/ { INT 14h }
$A3/Status); { MOV Status, AX }
THR := (Status AND $2000) <> 0;
Carr := (Status AND $0080) <> 0;
SendReady := THR OR (Not Carr);
End Else
Begin
THR := ((Port [IBM_UART_LSR + Base] AND $20) <> 0);
CTS := (Port [IBM_UART_MSR + Base] AND $10 = $10);
If CTS_RTS_On AND Carrier Then SendReady := THR AND Cts Else SendReady :=
THR; End;
{$ELSE}
SendReady := False;
{$ENDIF}
End;
Procedure SendByte (Ch : Char);
Begin
{$IFNDEF TEST}
Repeat Until SendReady;
If UseFossil then
Begin
Regs.AH := 1;
Regs.AL := Ord (Ch);
Regs.DX := UsedPort;
intr($14,regs);
End Else Port [IBM_UART_THR + Base] := Ord (Ch);
{$ENDIF}
End;
Procedure AsyncFlushOutput;
Begin
{$IFNDEF TEST}
If Usefossil Then
Begin
Regs.AH := 8;
Regs.DX := UsedPort;
Intr ($14, Regs);
End;
{$ENDIF}
End;
Procedure AsyncPurgeOutput;
Begin
{$IFNDEF TEST}
If UseFossil Then
Begin
Regs.AH := 9;
Regs.DX := UsedPort;
Intr ($14, Regs);
End;
{$ENDIF}
End;
Procedure AsyncPurgeInput;
Begin
{$IFNDEF TEST}
If UseFossil then
Begin
Regs.AH := $0A;
Regs.DX := UsedPort;
Intr ($14, Regs);
End Else
Begin
BufferHead := 0;
BufferTail := 0;
OverFlow := False;
End;
{$ENDIF}
End;
Procedure SendBreak;
Var I, J : Byte;
Begin
{$IFNDEF TEST}
If UseFossil then
Begin
Regs.AX := $1A01;
Regs.DX := UsedPort;
Intr ($14, Regs);
Delay (100);
Regs.AX := $1A00;
Regs.DX := UsedPort;
Intr ($14, Regs);
End Else
Begin
I := Port [IBM_UART_LCR + Base];
J := I;
I := I AND $7F;
I := I OR $40;
Port [IBM_UART_LCR + Base] := I;
delay (100);
Port [IBM_UART_LCR + Base] := J;
End;
{$ENDIF}
End;
Procedure SetDTR (OnOff : Boolean);
Var I : Byte;
Begin
{$IFNDEF TEST}
If UseFossil then
Begin
Regs.AH := $06;
If OnOff Then Regs.AL := 1 Else Regs.AL := 0;
Regs.DX := UsedPort;
Intr ($14, Regs);
End Else
Begin
If OnOff Then Port [IBM_UART_MCR + Base] := $0B Else Port [IBM_Uart_MCR +
Base] := $0A; End;
{$ENDIF}
End;
Procedure CTS_RTS (OnOff : Boolean);
Begin
{$IFNDEF TEST}
If UseFossil Then
Begin
Regs.DX := UsedPort;
If OnOff Then Regs.AL := 2 Else Regs.AL := 0;
Regs.AH := $0F;
Intr ($14, Regs);
End Else CTS_RTS_On := OnOff;
{$ENDIF}
End;
Procedure AWrite (S : String);
Var I : Integer;
Begin
{$IFNDEF TEST}
For I := 1 To Length (S) Do SendByte ((S[I]));
{$ENDIF}
End;
Procedure AWriteLn (S : String);
Begin
{$IFNDEF TEST}
AWrite (S + #10#13);
{$ENDIF}
End;
Function Ringing : Boolean;
Begin
{$IFNDEF TEST}
Case UsedPort of
1 : Ringing := Boolean (Port[$3FE] And 64);
2 : Ringing := Boolean (Port[$2FE] And 64);
3 : Ringing := Boolean (Port[$3EE] And 64);
4 : Ringing := Boolean (Port[$2EE] And 64);
Else Ringing := False;
End;
{$ELSE}
Ringing := False;
{$ENDIF}
End;
Procedure Hangup;
Begin
{$IFNDEF TEST}
SetDTR (False);
Delay (250);
SetDTR (True);
{$ENDIF}
End;
Begin
{$IFNDEF TEST}
ExitSave := ExitProc;
ExitProc := @TerminateUnit;
IsOpen := FALSE;
Overflow := FALSE;
CanUseFossil := False;
CTS_RTS_On := True;
Bios_Ports := 4;
{$ENDIF}
End.
[-----------protcomm.pas ends -------------------------------------------------]
[-----------io.pas begins-----------------------------------------------------]
Unit IO;
Interface
Procedure SWrite (S : String);
Procedure SWriteLn (S : String);
Procedure SReadLn (Var S : String);
Procedure SClrScr;
Var Local : Boolean;
Implementation
Uses Crt, ProtComm;
Procedure SWrite (S : String);
Begin
Write (S);
If Not Local Then AWrite (S);
End;
Procedure SWriteLn (S : String);
Begin
WriteLn (S);
If Not Local Then AWriteLn (S);
End;
Function SReadKey : Char;
Var Done : Boolean;
Ch : Char;
Begin
Done := False;
Repeat
If (Not Local) and (Not Carrier) Then Done := True;
If Not Local Then
If DataAvailable Then
Begin
Ch := Chr (GetChar);
Done := True;
End;
If KeyPressed Then
Begin
Ch := ReadKey;
Done := True;
End;
Until Done;
SReadKey := Ch;
End;
Function SKeyPressed : Boolean;
Begin
SKeyPressed := False;
If DataAvailable Then SKeyPressed := True;
If KeyPressed Then SKeyPressed := True;
End;
Procedure SReadLn (Var S : String);
Var Ch : Char;
Begin
S := '';
Repeat
Ch := SReadKey;
If Ord (Ch) in [32..122] Then
Begin
S := S + Ch;
SWrite (Ch);
End;
If Ord (Ch) = Ord (8) Then
Begin
If Length (S) > 0 Then
Begin
SWrite (#8' '#8);
Delete (S, Length (S), 1);
End;
End;
Until (Ord (Ch) = 13) OR ((Not Carrier) AND (Not Local));
SWrite (#13#10);
End;
Procedure SClrScr;
Begin
SWriteLn (#12);
ClrScr;
End;
End.
[-----------io.pas ends-------------------------------------------------]
[-----------bbs.pas begins ---------------------------------------------]
{ Minimal BBS - part of the Communications Package of HTCPACK #7
For more information or for information on where to obtain complete
HTCPACK's email havoc.the.chaos@iirg.com }
Uses Crt, IO, ProtComm;
Var TestPad : String;
OutChar : Char;
Procedure RunBBS;
Var Answer : String;
Begin
SWriteLn ('Welcome to the minimal BBS!');
SWrite ('Type somethin: ');
SReadLn (Answer);
SWriteLn ('You typed "' + Answer + '"');
Delay (5000);
SWriteLn ('Goodbye!');
AsyncFlushOutput;
Hangup;
End;
Procedure FrontEnd;
Var EscPressed : Boolean;
ModemString : String;
Timer : Integer;
Ch : Char;
Begin
If Not Local Then AWriteLn ('ATA');
ClrScr;
WriteLn ('*** RING ***'#7);
ModemString := '';
EscPressed := False;
If Not Local Then
Begin
AsyncPurgeInput;
Timer := 0;
EscPressed := False;
Repeat
ModemString := '';
While DataAvailable Do ModemString := ModemString + Chr (GetChar);
Delay (1);
Inc (Timer);
If KeyPressed Then
Begin
Ch := ReadKey;
If Ord (Ch) = Ord (27) Then EscPressed := True;
End;
Until (Carrier) or (Timer = 60000) or (Local) or (EscPressed);
End;
If EscPressed OR (Timer = 60000) Then
Begin
ClrScr;
AWriteLn ('');
Write ('Connection not established due to ');
If EscPressed Then WriteLn ('local escape.');
If Timer = 60000 Then WriteLn ('a 60 time elapse with no connection.');
Delay (2000);
Exit;
End;
If Carrier OR Local Then
Begin
While KeyPressed Do Write (ReadKey, #8);
AsyncPurgeInput;
RunBBS;
End;
End;
Procedure Initialize;
Begin
Comm_Init (57600, 2);
ClrScr;
Local := False;
AsyncPurgeInput;
While DataAvailable Do Write (Chr (GetChar));
If Not Carrier Then AWriteLn ('ATZ');
End;
Begin
Initialize;
Repeat
TestPad := '';
While DataAvailable Do
Begin
TestPad := TestPad + Chr (GetChar);
End;
TestPad := '';
If Ringing Then
Begin
Local := False;
FrontEnd;
End;
If KeyPressed Then
Begin
OutChar := ReadKey;
Case Ord (OutChar) of
0 : Begin
OutChar := ReadKey;
Case Ord (OutChar) of
{F1} 59 : Begin
Local := True;
FrontEnd;
End;
{ALT-X} 45 : Begin
ModemDeInit;
Halt;
End;
End;
End;
End;
End;
Until 1 = 2;
End.
[-----------bbs.pas ends-------------------------------------------------]
[Back to COMM SWAG index] [Back to Main SWAG index] [Original]