{[b+, c+, d+, n+, o=82, q+, r+, u+, x+, y+, #+]}
{ format options for pasmat }
UNIT ISDNLAP;
{$R-} { Note: library must be compiled without range check! }
{ ********** The ISDN Link Access Protocol for AppleTalk *********** }
{ }
{ Unit for setting up X.21 connections, transmitting }
{ and receiving AppleTalk packets over an ISDN link }
{ }
{ Developed by Alfred Lupper at the University of Augsburg }
{ }
{ Version 1.5 1988-1989 }
{ }
{ This unit is the main part of ISDNLAP }
{ }
{ last modification: 13.09.1989 by Alfred Lupper }
{ }
{ ****************************************************************** }
INTERFACE
USES {$LOAD $$Shell(Plibraries)MemQDOSToolPack}
Memtypes, Quickdraw, OSintf, Toolintf, Packintf, PasLibIntf,
{$LOAD} AppleTalk;
{$R-}
CONST
{ some SCC commands }
RHIUS = $38; { Reset Highest Interrupt Under Service }
Register1 = $01; { select SCC register 1 }
ResEOM = $C0; { reset End of Message bit }
ResetError = $30; { reset error status }
{ some character codes used }
SYN = $16; { this is the synchronisation charakter for X.21 }
ONEs = $7F; { 7 times one }
NULL = $00; { null character }
BEL = $7; { sign of an incomming call }
HDLCFlag = $7E; { this is the HDLC flag character }
PLUS = $2B; { '+'-charackter }
CharacterMask = $7F; { mask to knock out the parity bit }
BusyCode = '+21+'; { line busy result code }
VisibleChars = [' '..'}'];
{ status flag bits}
TxBufferEmpty = 2; { set if TxBuffer empty }
GOTCHAR = 0; { set if character available }
EoFRAME = 7; { End Of Frame bit }
EndofMess = 6; { End of Message bit }
OverRun = 5; { set if overrun occured }
CRCErrBit = 6; { signals the CRC status }
{ time constants }
TaskTime = 120; { the VBL task is called every 2 seconds }
TerminateDelay = 2; { release after 2 calls }
DialTimeOut = 5000; { the dial timeout in milliseconds }
ReceiveTimeOut = 2000; { the receive timeout is 2000 loops }
TransmitTimeOut = 2000; { the transmit timeout is 2000 }
TakeOffTimeOut = 80000; { the receive call timeout is 80000 }
WaitHangUp = 2; { wait 2 ticks after the hangup packet sent }
HangUpDelay = 30; { wait 30 ticks after clearing connection }
MaxRetrys = 10; { do 10 tries if line busy }
ReDialDelay = 300; { try it again after 5 seconds }
{ Retrys }
maxENQs = 50; { send 50 ENQ-frames at connection setup}
maxNodeIDTrys = 4; { do 4 tries to get an unused node ID }
maxFNDs = 5; { send 5 FND packets to get an ISDN number }
{ ALAP Constants }
minFrameSize = 5; { frame contains at least header & CRC }
maxFrameSize = 605; { but not more than 605 bytes with CRC }
maxDataSize = 600; { there may be up to 600 bytes of data }
{ LAP packettypes and addresses }
lapENQ = $81; { LAP type of an ENQ frame }
lapACK = $82; { LAP type of an ACK frame }
lapRTS = $84; { LAP type of a RTS frame, not used }
lapCTS = $85; { LAP type of a CTS frame, not used }
lapHUP = $86; { LAP type of hangup packets, non standard }
lapFND = $87; { LAP type of find number packets }
lapRND = $88; { LAP type of response packets of # search }
BroadCastID = $FF; { broadcast address }
{ addresses of system globals }
SCCRd = $1D8; { SCC read base address }
SCCWr = $1DC; { SCC write base address }
Ticks = $16A; { current # of ticks since system startup }
PortBUse = $291; { current availability of serial port B }
Lvl2DT = $1B2; { Level-2 secondary interrupt vector table }
SPATalkA = $1F9; { AppleTalk node ID hint for modem port }
SPATalkB = $1FA; { AppleTalk node ID hint for printer port }
NumberRes = 128; { resource # of the NameServer´s phone # }
HistorySize = 4000; { size of history buffer in system heap }
TYPE
PORT = (MODEM, PRINTER); { these are the Mac's Ports }
LineStatus = (connected, called, inProcess, notConnected, timeout, busy);
TransmitStatus = (transmitOk, clockmissing, dialerror);
FrameStatus = (closedFrame, continuedFrame, badFrameCRC, overrunError, underrunError, noFrame);
FrameInterpretation = (rawData, structured, RHA);
IdStatus = (noResponse, valid, inUse); { status of node ID }
aDataField = PACKED ARRAY [1..maxFrameSize] OF CHAR;
{ unstructured frame }
ISDNNumber = Str255; { here we use 255 chars }
NumberCache = RECORD { structure of the chached connection }
StoredID: BYTE;
StoredNumber: ISDNNumber;
END;
{ the local MPP variables, as far as known }
ABusVars = PACKED RECORD { as far as needed }
sysLAPAddr: SignedByte; { LAP address of node }
toRHA: SignedByte; { top of RHA }
END; { don´t use BYTEs here, compiler bug! }
ABusVarsPtr = ^ABusVars; { pointer to MPP's local variables }
{ the structure of an AppleTalk frame }
aFrame = PACKED RECORD
CASE FrameInterpretation OF
rawData:
(DATA: aDataField); { unstructured frame }
structured: { structure of a RND frame }
(dstAddr: BYTE; { dest. address of frame}
srcAddr: BYTE; { source address of frame }
lapType: BYTE; { LAP type address of frame }
lookupID: BYTE; { nodeID we are looking for}
lookupNumber: ISDNNumber);
{ number returned by the NS }
RHA: { structure of the Read Header Area }
(dstAddr1: BYTE;
srcAddr1: BYTE;
lapType1: BYTE;
LengthHigh: BYTE;
LengthLow: BYTE;
DataStart: BYTE; )
END;
FramePtr = ^aFrame;
{ structure of the SCC´s registers in memory }
SCCReg = RECORD
bCtl: INTEGER; { control register of port B }
aCtl: INTEGER; { control register of port A }
bData: INTEGER; { data register of port B }
aData: INTEGER { data register of port B }
END;
SCCPtr = ^SCCReg; { pointer to SCC-registers }
SCCHandle = ^SCCPtr; { handle to SCC-registers }
Level2IntTable = RECORD { Level-2 Interrupt Dispatch Table }
ChannelBTBufferempty: Ptr;
ChannelBESchange: Ptr;
ChannelBRavailable: Ptr;
ChannelBScondition: Ptr;
ChannelATBufferempty: Ptr;
ChannelAESchange: Ptr;
ChannelARavailable: Ptr;
ChannelAScondition: Ptr;
END;
LongPtr = ^LONGINT;
{ the WDS structure, Inside Macintosh vol. II pp. 307 }
Entry = PACKED RECORD { structure of the first entry }
dstAddr: BYTE;
srcAddr: BYTE;
lapType: BYTE;
DataStart: BYTE
END;
PtrToEntry = ^Entry;
WDSEntryPtr = ^WDSElement; { predefined by AppleTalkEqu.p }
WDSDataPtr = ^aDataField;
{ small WDS structure for control packets }
MyWDSEntry = PACKED RECORD
EntryLength: INTEGER;
Entry: PtrToEntry;
Sentinel: INTEGER;
{ the end of the WDS is marked by length 0 }
END;
{ conditioned compilation commands }
{$SETC DEBUG:=TDEBUG OR DDEBUG OR RDEBUG}
{$IFC DEBUG} { history stuff, written by P. Schulthess}
Str8 = string[8];
charwurm = PACKED ARRAY [0..HistorySize] OF CHAR;
charPtr = ^charwurm;
globrec = RECORD
histHandle: Handle;
hist, maxhist: INTEGER;
END { globrec } ;
globrecptr = ^globrec;
{$ENDC}
{ the global variables of ISDNLAP }
GlobalVars = RECORD
MPPVars: ABusVarsPtr; { pointer to local MPP variables }
Guard: BOOLEAN; { guard for locking out async tasks }
SCCWrCtl: Ptr; { addr of SCC's Write Control Register }
SCCRdCtl: Ptr; { addr of SCC's Read Control Register }
SCCWrData: Ptr; {addr of SCC's Write Data Register }
SCCRdData: Ptr; { addr of SCC's Read Data Register }
NameServerNumber: ISDNNumber; { number of NameServer }
ActualNumber: ISDNNumber; { number to be dialed }
IsUp: LineStatus; { status of connection }
LastTransmission: LONGINT;
{ tasks since last transmision or receiption }
TOut: BOOLEAN; { timeout flag }
VBLEntry: VBLTask; { element of the VBLQueue }
MSecQueue: TMTask; { task entry for millisecondes }
AddrStatus: IdStatus; { status of node ID }
HisAddress: BYTE; { node ID of our partner }
{ here we keep the old interrupt service routines }
OldReceiveInterruptVector: Ptr;
OldReceiveSpecialVector: Ptr;
Cache: NumberCache; { here we keep number last dialed }
{$IFC DEBUG} { debug stuff }
globzeux: globrec;
{$ENDC}
END;
GlobalPtr = ^GlobalVars;
CONST
MyPort = PRINTER; { Here we use Port B }
{ *************************************************************** }
{ procedures used by the assembler modules }
FUNCTION InitLAP: BOOLEAN;
FUNCTION RestoreOldLap: BOOLEAN;
FUNCTION TransmitPacket(WDS: WDSEntryPtr): TransmitStatus;
FUNCTION ReceiveFrame(incomingPacket: FramePtr;
BytesToRead: INTEGER;
VAR incomingLength: INTEGER;
NoDiscard: BOOLEAN): FrameStatus;
PROCEDURE SetNumber;
PROCEDURE InitSCCStuff(First: BOOLEAN);
PROCEDURE PurgeRest;
{ forward declaration }
PROCEDURE InitHDLCStuff;
{ *************************************************************** }
IMPLEMENTATION
{ some external procedures from ISDNatlk.a }
PROCEDURE Globals; { get address of global variables }
EXTERNAL;
PROCEDURE ReadDispatch(RHA: Ptr; Rest: LONGINT; lapType: BYTE;
MPPVars: ABusVarsPtr);
EXTERNAL;
{$IFC DEBUG}
FUNCTION NewHandleClrSys(Size: LONGINT): Handle;
EXTERNAL;
{$ENDC}
{ *************************************************************** }
{ some usefull inline statements }
PROCEDURE SavePreservedRegs; { save all registers }
INLINE $48E7, $FFFF; { MOVEM.L D0-D7/A0-A7,-(A7) }
PROCEDURE RestorePreservedRegs; { restore all registers }
INLINE $4CDF, $FFFF; { MOVEM.L (A7)+,D0-D7/A0-A7 }
PROCEDURE SaveAndSetSR; { disable SCC interrupts and lower }
INLINE $40E7, { MOVE.L SR, -(SP) }
$007C, $2600; { ORI #$2600, SR }
PROCEDURE RestoreStatusRegister; { restore status register }
INLINE $46DF; { MOVE.L (SP)+, SR }
{ *************************************************************** }
{$IFC DEBUG}
PROCEDURE EavesHist(mark: Str8; VAR str: Str255);
{ write messages to the history on system heap! }
{ originally written by P. Schulthess }
VAR
mlen, slen, pos: INTEGER;
histptr: charPtr;
MyGlobals: GlobalPtr;
BEGIN
MyGlobals:=GlobalPtr(@Globals);
WITH MyGlobals^.globzeux DO BEGIN
mlen:=length(mark); slen:=length(str);
IF hist<maxhist-slen-mlen-20 THEN BEGIN
Hlock(histHandle);
histptr:=charPtr(histHandle^);
IF mark<>'' THEN BEGIN
WHILE (hist MOD 16)<>0 DO hist:=hist+1;
histptr^[hist]:='['; hist:=hist+1;
END;
FOR pos:=1 TO mlen DO BEGIN
histptr^[hist]:=mark[pos]; hist:=hist+1
END;
IF mark<>'' THEN BEGIN
histptr^[hist]:=']'; hist:=hist+1;
END;
FOR pos:=1 TO slen DO BEGIN
histptr^[hist]:=str[pos]; hist:=hist+1
END;
HUnlock(histHandle);
END
END
END; { EavesHist }
{ *************************************************************** }
PROCEDURE PtrEavesHist(marke: Str8; Size: INTEGER;
Ptr: charPtr);
{ write msg pointed to by Ptr to history on system heap! }
{ originally written by P. Schulthess }
VAR
str: Str255;
BEGIN
IF Size>240 THEN Size:=240;
str[0]:=chr(Size);
WHILE Size>0 DO BEGIN
str[Size]:=Ptr^[Size-1];
Size:=Size-1
END;
EavesHist(marke, str);
END; { PtrEavesHist }
{ *************************************************************** }
PROCEDURE EavesInit;
{ create new history on system heap }
{ originally written by P. Schulthess }
VAR
MyGlobals: GlobalPtr;
BEGIN
MyGlobals:=GlobalPtr(@Globals);
WITH MyGlobals^.globzeux DO BEGIN
maxhist:=HistorySize;
histHandle:=NewHandleClrSys(maxhist);
hist:=0;
END
END; { EavesInit }
{$ENDC}
{ *************************************************************** }
PROCEDURE TimeOutTask;
{ this task is called after X ms and signals timeout}
VAR MyGlobals: GlobalPtr;
BEGIN
MyGlobals:=GlobalPtr(@Globals); MyGlobals^.TOut := TRUE;
END; { TimeOutTask }
{ *************************************************************** }
FUNCTION GetNodeID: BYTE; { get port´s node ID from system }
VAR
myNode, myNet: INTEGER;
BEGIN
myNode:=0; myNet:=0;
IF GetNodeAddress(myNode, myNet)<>NoErr THEN GetNodeID:=0
ELSE GetNodeID:=myNode;
END; { GetNodeID }
{ *************************************************************** }
PROCEDURE SetNodeID(nodeID: BYTE; InAbusVars: BOOLEAN);
{ Don't use InAbusVars before first packet transmitted !!}
{ There are three places we can find the node ID }
{ in Parameter RAM and in system globals and in AbusVars }
VAR
Result: OSErr;
MyGlobals: GlobalPtr;
BEGIN
MyGlobals:=GlobalPtr(@Globals);
WITH MyGlobals^ DO BEGIN
GetSysPPtr^.aTalkB:=nodeID; { write nodID to Par RAM }
Ptr(SPATalkB)^:=nodeID; { write node ID to sys globals }
Result:=WriteParam; { write parameter }
IF InAbusVars THEN MPPVars^.sysLAPAddr:=nodeID;
END;
END; { SetNodeID }
{ *************************************************************** }
PROCEDURE Write_SCC(reg, value: BYTE);
{ do the write access to the control registers of the SCC }
VAR
MyGlobals: GlobalPtr;
BEGIN
MyGlobals:=GlobalPtr(@Globals);
WITH MyGlobals^ DO BEGIN
IF reg<>0 THEN SCCWrCtl^:=reg;
SCCWrCtl^:=value;
END;
END; { Write_SCC }
{ *************************************************************** }
PROCEDURE SetAddress(FrameAddress: BYTE);
{ we only want to receive frames of a this address }
{ don't forget to set the bit in write register 3 of the SCC! }
{ do not use before the SCC is initialized }
VAR
MyGlobals: GlobalPtr;
inChar: BYTE;
BEGIN
MyGlobals:=GlobalPtr(@Globals);
WITH MyGlobals^ DO BEGIN
inChar:=SCCRdCtl^; { clear the SCC's register pointer }
Write_SCC(6, FrameAddress);
END;
END; { SetAddress }
{ *************************************************************** }
PROCEDURE GetNumber(VAR Number: ISDNNumber);
{ get number from resource fork }
VAR
HelpHandle: StringHandle;
BEGIN
HelpHandle:=GetString(NumberRes);
IF HelpHandle=NIL THEN Number:=''
ELSE Number:=HelpHandle^^;
END; { GetNumber }
{ *************************************************************** }
PROCEDURE SetNumber;
{ set number of the NameServer by dialog at selection time }
CONST
OkBtn = 1; { item number of Ok button }
textItem = 3; { item number for editable text field}
NumberDialog = 128; { resource ID of the number dialog }
VAR
theDialog: DialogPtr;
itemHit, theType: INTEGER;
theTextHdl: Handle;
txtBox: Rect;
theText: Str255;
HelpHandle: StringHandle;
BEGIN
GetNumber(theText); { get number from resource fork }
FlushEvents(everyEvent, 0);
theDialog:=GetNewDialog(NumberDialog, NIL, pointer(-1));
IF theDialog<>NIL THEN BEGIN
GetDItem(theDialog, textItem, theType, theTextHdl, txtBox);
SetIText(theTextHdl, theText); InitCursor;
REPEAT
ModalDialog(NIL, itemHit);
UNTIL itemHit=OkBtn;
GetDItem(theDialog, textItem, theType, theTextHdl, txtBox);
GetIText(theTextHdl, theText);
DisposDialog(theDialog);
HelpHandle:=GetString(NumberRes); { write number back }
IF HelpHandle<>NIL THEN BEGIN
HNoPurge(Handle(HelpHandle));
SetString(HelpHandle, theText);
ChangedResource(Handle(HelpHandle));
WriteResource(Handle(HelpHandle));
HPurge(Handle(HelpHandle));
END;
END;
END; { SetNumber }
{ *************************************************************** }
PROCEDURE FilterNumber(VAR Number: Str255);
{ filter the connection ID, for example:
'ffhjhjh*00531+fsztevbv' -> 531 }
VAR
What: Str255;
index: INTEGER;
BEGIN
What:='*'; index:=pos(What, Number);
IF index=0 THEN Number:=''
ELSE BEGIN
Delete(Number, 1, index); { skip leading garbage }
What:='+'; index:=pos(What, Number);
IF index=0 THEN Number:=''
{ skip tail }
ELSE Delete(Number, index, length(Number)-index+1);
{ skip nulls }
WHILE Number[1]='0' DO Delete(Number, 1, 1) END;
END; { FilterNumber }
{ *************************************************************** }
PROCEDURE ClearCache(VAR Cache: NumberCache);
{ reset cached connection }
BEGIN
WITH Cache DO BEGIN
StoredID:=0;
StoredNumber:='';
END;
END; { ClearCache }
{ *************************************************************** }
{$W-}
FUNCTION TransmitFrame(WDS: WDSEntryPtr): TransmitStatus;
{ send the contents of a WDS writing byte by byte to the SCC }
CONST
wdsEntrySz = 6; { taken from AppleTalkEqu.a }
VAR
i: INTEGER;
timeout: INTEGER;
MyGlobals: GlobalPtr;
WDSData: WDSDataPtr;
{$IFC TDEBUG}
DebugWDS: WDSEntryPtr;
{$ENDC}
BEGIN
MyGlobals:=GlobalPtr(@Globals);
WITH MyGlobals^ DO BEGIN
{$IFC TDEBUG} { write packet to history }
DebugWDS:=WDS;
PtrEavesHist('TFrame', 0, charPtr(DebugWDS^.EntryPtr));
WHILE DebugWDS^.EntryLength>0 DO BEGIN
PtrEavesHist('', DebugWDS^.EntryLength,
charPtr(DebugWDS^.EntryPtr));
DebugWDS:=WDSEntryPtr(LONGINT(DebugWDS)+wdsEntrySz);
END;
{$ENDC}
SaveAndSetSR; { disable interrupts }
LastTransmission:=0; timeout:=0;
WHILE NOT BTst(SCCRdCtl^, EndofMess) AND
(timeout<TransmitTimeOut) DO
timeout:=timeout+1;
IF timeout<TransmitTimeOut THEN BEGIN
WHILE WDS^.EntryLength>0 DO BEGIN
{ don't use WITH before WHILE}
WITH WDS^ DO BEGIN
WDSData:=WDSDataPtr(EntryPtr);
FOR i:=1 TO EntryLength DO BEGIN
timeout:=0;
WHILE NOT BTst(SCCRdCtl^, TxBufferEmpty) AND
(timeout< TransmitTimeOut) DO
timeout:=timeout+1;
IF timeout>=TransmitTimeOut THEN BEGIN
TransmitFrame:=clockmissing;
RestoreStatusRegister;
Exit(TransmitFrame);
END;
SCCWrData^:=BYTE(WDSData^[i]);
END;
END;
WDS:=WDSEntryPtr(LONGINT(WDS)+wdsEntrySz);
{ move pointer to WDS }
END;
SCCWrCtl^:=ResEOM;
TransmitFrame:=transmitOk;
END
ELSE TransmitFrame:=clockmissing;
RestoreStatusRegister; { reenable interrupts }
END;
END; { TransmitFrame }
{$W+}
{ *************************************************************** }
FUNCTION TransmitMessage(destAddr: BYTE; Message: BYTE):
TransmitStatus;
{ setup and send a message packet }
VAR
MyWDS: MyWDSEntry;
Contents: Entry;
MyGlobals: GlobalPtr;
BEGIN
MyGlobals:=GlobalPtr(@Globals);
WITH MyGlobals^, MyWDS, Contents DO BEGIN
{ build control frame }
dstAddr:=destAddr;
srcAddr:=GetNodeID;
lapType:=Message;
EntryLength:=3; { control packets are 3 bytes }
Entry:=PtrToEntry(@Contents);
Sentinel:=0; { no more entries in WDS }
TransmitMessage:=TransmitFrame(WDSEntryPtr(@MyWDS));
END;
END; { TransmitMessage }
{ *************************************************************** }
FUNCTION AcquireAddress(Destination: BYTE): BOOLEAN;
{ proof connection and get an unused node ID }
VAR
PacketTrys, IdTrys: INTEGER;
MyGlobals: GlobalPtr;
Finalticks: LONGINT;
MyAddress: BYTE;
{$IFC DDEBUG}
dummy: Str255;
{$ENDC}
BEGIN
{$IFC DDEBUG}
dummy:='';
EavesHist('acquire', dummy);
{$ENDC}
MyGlobals:=GlobalPtr(@Globals);
WITH MyGlobals^ DO BEGIN
IF GetNodeID<=0 THEN BEGIN
SetAddress(1); SetNodeID(1, TRUE);
END;
IdTrys:=0;
REPEAT
{$W-}
PacketTrys:=0; AddrStatus:=noResponse;
REPEAT { Waiting for an ACKFrame to be received }
AcquireAddress:=NOT (TransmitMessage(Destination, lapENQ)= transmitOk);
DELAY(1, Finalticks);
PacketTrys:=PacketTrys+1;
UNTIL (AddrStatus>noResponse) OR
(PacketTrys>maxENQs);
{$W+}
IF AddrStatus=inUse THEN BEGIN { new node ID }
MyAddress:=(GetNodeID+1) MOD 127+1;
IF GetNodeID>127 THEN MyAddress:=MyAddress+127;
SetAddress(MyAddress); SetNodeID(MyAddress, TRUE);
END;
IdTrys:=IdTrys+1;
UNTIL NOT (AddrStatus=inUse) OR
(IdTrys>maxNodeIDTrys);
AcquireAddress:= AddrStatus=valid;
{$IFC DDEBUG}
EavesHist('acquEnd', dummy);
{$ENDC}
END;
END; { AcquireAddress }
{ *************************************************************** }
PROCEDURE HangUp(quitpacket: BOOLEAN);
{ destroy connection and send quit packets }
VAR
inChar: BYTE;
Finalticks: LONGINT;
done: TransmitStatus;
MyGlobals: GlobalPtr;
{$IFC DDEBUG}
dummy: Str255;
{$ENDC}
BEGIN { say your partner good by }
{$IFC DDEBUG}
dummy:='';
EavesHist('HangUp', dummy);
{$ENDC}
MyGlobals:=GlobalPtr(@Globals);
WITH MyGlobals^ DO BEGIN
inChar:=SCCRdCtl^; { clear the SCC's register pointer }
Write_SCC(1, $01); { MIE disabled }
IF quitpacket THEN
done:=TransmitMessage(BroadCastID, lapHUP);
DELAY(WaitHangUp, Finalticks);
inChar:=SCCRdCtl^; { clear the SCC's register pointer }
Write_SCC(7, $00); { Send continuously zero }
Write_SCC(5, $6B);
{ 8 Bits, Tx enabled, RTS high, DTR low }
DELAY(HangUpDelay, Finalticks);
{ wait until interface ready }
{ remember the missing indicate signal! }
InitSCCStuff(FALSE);
END;
END; { HangUp }
{ *************************************************************** }
FUNCTION DialUp(Number: ISDNNumber): LineStatus;
{ setup connection to number specified }
VAR
i: INTEGER;
inChar: BYTE;
Finalticks: LONGINT;
MyGlobals: GlobalPtr;
ConnectedTo: String; { the call identification }
PROCEDURE FlushIncomingChars;
{ clear the error condition of the SCC and flush the SCC }
CONST
FlushTimeOut = 2000; { milliseconds }
VAR
inChar: CHAR;
{$IFC DDEBUG}
dummy: Str255;
{$ENDC}
BEGIN
WITH MyGlobals^ DO BEGIN
TOut:= FALSE; PrimeTime(@MSecQueue, FlushTimeOut);
REPEAT
IF BTst(SCCRdCtl^, GOTCHAR) THEN
inChar:=chr(SCCRdData^);
UNTIL TOut;
{$IFC DDEBUG}
dummy:='';
EavesHist('Flush', dummy)
{$ENDC}
END;
END; { FlushIncomingChars }
BEGIN
MyGlobals:=GlobalPtr(@Globals);
WITH MyGlobals^ DO BEGIN
{$IFC DDEBUG}
EavesHist('DialUp', Number);
{$ENDC}
DialUp:=inProcess;
{ clear connection }
IF HisAddress<>0 THEN HangUp(TRUE)
ELSE InitSCCStuff(FALSE);
Write_SCC(1, $01);
{ Rx Int disabled, external interupts enabled }
{ append SYNs and End of Selection sign to number }
ConnectedTo[0]:=chr(2);
ConnectedTo[1]:=chr(SYN); ConnectedTo[2]:=chr(SYN);
Number:=Concat(ConnectedTo, Number, '+');
{ call request }
Write_SCC(5, $AA); { 7 Bits, DTR high, RTS high }
Write_SCC(6, $00); { Send continuously 00000000 }
{ proceed to select }
TOut:=FALSE; PrimeTime(@MSecQueue, DialTimeOut);
{ start timeout task }
inChar:=SYN;
REPEAT
IF BTst(SCCRdCtl^, GOTCHAR) THEN
inChar:=BAND(SCCRdData^, CharacterMask);
UNTIL (inChar=PLUS) OR TOut;
IF TOut THEN BEGIN
DialUp:=timeout;
{$IFC DDEBUG}
EavesHist('DialTO1', Number);
{$ENDC}
HangUp(FALSE); { reset connection }
Exit(DialUp);
END;
FOR i:=1 TO length(Number) DO BEGIN
{ send the number with a plus }
WHILE NOT (BTst(SCCRdCtl^, TxBufferEmpty) OR TOut)
DO;
SCCWrData^:=BYTE(Number[i]);
IF BTst(SCCRdCtl^, GOTCHAR) THEN
inChar:=BAND(SCCRdData^, CharacterMask);
END;
{ DTE waiting }
Write_SCC(6, $FF); { send continuously 11111111 }
{ receive connection ID}
i:=0;
REPEAT { skip leading PLUS charakters }
IF BTst(SCCRdCtl^, GOTCHAR) THEN
inChar:=BAND(SCCRdData^, CharacterMask);
UNTIL (inChar<>PLUS) OR TOut;
REPEAT
IF BTst(SCCRdCtl^, GOTCHAR) THEN BEGIN
inChar:=BAND(SCCRdData^, CharacterMask);
IF (chr(inChar) IN VisibleChars) AND (i<255) THEN
BEGIN
i:=i+1; ConnectedTo[i]:=chr(inChar);
END;
END;
UNTIL (inChar IN [ONEs, NULL]) OR TOut;
ConnectedTo[0]:=chr(i);
{Note: We get no confirmation signal because of the missing indicate }
IF TOut THEN BEGIN
DialUp:=timeout;
{$IFC DDEBUG}
EavesHist('DialTO2', Number);
{$ENDC}
HangUp(FALSE); { reset sender }
END
ELSE BEGIN
IF pos('*', ConnectedTo)=0 THEN BEGIN
IF pos(BusyCode, ConnectedTo)<>0 THEN DialUp:=busy
ELSE DialUp:=notConnected;
FlushIncomingChars;
HangUp(FALSE);
{ clear connection if dialing failed }
END
ELSE BEGIN
DELAY(1, Finalticks);
InitHDLCStuff; { now we enter HDLC mode }
END;
{$IFC DDEBUG}
EavesHist('DialRes', Str255(ConnectedTo));
{$ENDC}
END;
END;
END; { DialUp }
{ *************************************************************** }
FUNCTION FindNumber(VAR Number: ISDNNumber;
dstParam: BYTE): BOOLEAN;
{ look up for number accomplished with node ID }
VAR
WDS: MyWDSEntry;
Contents: aFrame;
MyGlobals: GlobalPtr;
trys: INTEGER;
Finalticks: LONGINT;
{$IFC DDEBUG}
dummy: Str255;
{$ENDC}
BEGIN
{$IFC DDEBUG}
dummy:='';
EavesHist('Find', dummy);
{$ENDC}
FindNumber:=TRUE;
MyGlobals:=GlobalPtr(@Globals);
WITH MyGlobals^, WDS, Contents DO
IF dstParam<>BroadCastID THEN BEGIN
{ prepare FND packet }
IF dstParam<>Cache.StoredID THEN BEGIN
dstAddr:=BroadCastID; srcAddr:=GetNodeID;
lapType:=lapFND; lookupID:=dstParam;
EntryLength:=4;
Entry:=PtrToEntry(@Contents);
Sentinel:=0;
ActualNumber:=''; trys:=0;
REPEAT
{ do some tries to get number from NameServer }
IF TransmitPacket(WDSEntryPtr(@WDS))<>transmitOk
THEN BEGIN
FindNumber:=FALSE;
LEAVE
END;
trys:=trys+1;
DELAY(1, Finalticks);
UNTIL (ActualNumber<>'') OR (trys>maxFNDs);
IF ActualNumber<>'' THEN Number:=ActualNumber;
{$IFC DDEBUG}
EavesHist('Found', Number);
{$ENDC}
WITH Cache DO BEGIN
StoredID:=dstParam;
StoredNumber:=Number;
END;
END
ELSE Number:=Cache.StoredNumber;
END;
END; { FindNumber }
{ *************************************************************** }
FUNCTION TransmitPacket(WDS: WDSEntryPtr): TransmitStatus;
{ control connections to destination nodes }
VAR
MyGlobals: GlobalPtr;
Finalticks: LONGINT;
dstParam: BYTE;
{$IFC TDEBUG}
dummy: Str255;
Counter: LONGINT;
{$ENDC}
FUNCTION DoDialing(Number: ISDNNumber): LineStatus;
{ redial if called node is busy }
VAR
Retry: INTEGER;
Status: LineStatus;
{$IFC DDEBUG}
dummy: Str255;
{$ENDC}
BEGIN
{$IFC DDEBUG}
dummy:='';
EavesHist('DoDial', dummy);
{$ENDC}
WITH MyGlobals^ DO BEGIN
IF FindNumber(Number, dstParam) THEN BEGIN
IF (Number<>NameServerNumber) OR (HisAddress=0)
THEN BEGIN
Status:=DialUp(Number);
IF Status=busy THEN BEGIN
Retry:=0;
REPEAT
Retry:=Retry+1;
DELAY(ReDialDelay, Finalticks);
Status:=DialUp(Number);
UNTIL (Status<>busy) OR (Retry>MaxRetrys);
END;
DoDialing:=Status;
END
ELSE DoDialing:=IsUp;
END
ELSE DoDialing:=notConnected;
END;
END; { DoDialing }
BEGIN
dstParam:= PtrToEntry(WDS^.EntryPtr)^.dstAddr;
MyGlobals:=GlobalPtr(@Globals);
WITH MyGlobals^ DO BEGIN
{$IFC TDEBUG}
NumToString(dstParam, dummy);
EavesHist('TPacket', dummy);
NumToString(HisAddress, dummy);
EavesHist('Hisaddr', dummy);
Counter:=LongPtr(Ticks)^;
{ take time of connection setup }
{$ENDC}
LastTransmission:=0; { reset connection timeout }
IF (HisAddress<>dstParam) THEN
IF ((HisAddress=0) OR (dstParam<>BroadCastID) OR (NameServerNumber<> Cache.StoredNumber)) THEN BEGIN
IsUp:=DoDialing(NameServerNumber);
IF IsUp>inProcess THEN BEGIN
ClearCache(Cache);
TransmitPacket:=dialerror;
Exit(TransmitPacket);
END;
END;
IF NOT AcquireAddress(dstParam) THEN BEGIN
{ test connection }
HangUp(FALSE);
TransmitPacket:=dialerror;
Exit(TransmitPacket);
END;
PtrToEntry(WDS^.EntryPtr)^.srcAddr:=GetNodeID;
TransmitPacket:=TransmitFrame(WDS);
{$IFC TDEBUG}
NumToString(LongPtr(Ticks)^-Counter, dummy);
EavesHist('TXEnd', dummy);
{$ENDC}
HisAddress:=dstParam;
{ set it for using a Bridge and a NameServer}
END;
END; { TransmitPacket }
{ *************************************************************** }
PROCEDURE PurgeRest;
{ clear the error condition of the SCC and flush the SCC }
VAR
inChar: CHAR;
MyGlobals: GlobalPtr;
{$IFC RDEBUG}
dummy: Str255;
{$ENDC}
BEGIN
MyGlobals:=GlobalPtr(@Globals);
WITH MyGlobals^ DO BEGIN
Write_SCC(3, $DD); { enter Hunt Mode }
WHILE BTst(SCCRdCtl^, GOTCHAR) DO { clear SCC's FIFO }
inChar:=chr(SCCRdData^);
Write_SCC(0, ResetError); { reset error status bits }
{$IFC RDEBUG}
dummy:='';
EavesHist('Purge', dummy)
{$ENDC}
END;
END; { PurgeRest }
{ *************************************************************** }
FUNCTION ReceiveFrame(incomingPacket: FramePtr;
BytesToRead: INTEGER;
VAR incomingLength: INTEGER;
NoDiscard: BOOLEAN): FrameStatus;
{ receive part of a frame and write it to buffer spezified by incomingPacket}
VAR
timeout: INTEGER;
inChar: CHAR;
framedone: BOOLEAN;
MyGlobals: GlobalPtr;
{$IFC RDEBUG}
dummy: Str255;
{$ENDC}
BEGIN
MyGlobals:=GlobalPtr(@Globals);
WITH MyGlobals^ DO BEGIN
incomingLength:=0; framedone:=FALSE;
ReceiveFrame:=noFrame;
REPEAT
timeout:=ReceiveTimeOut;
REPEAT { wait for character }
IF BTst(SCCRdCtl^, GOTCHAR) THEN LEAVE;
timeout:=timeout-1;
UNTIL timeout<0;
IF timeout>=0 THEN BEGIN
{ first let´s have a look at the status of the charakter }
SCCWrCtl^:=Register1;
IF BTst(SCCRdCtl^, EoFRAME) THEN BEGIN
SCCWrCtl^:=Register1;
IF BTst(SCCRdCtl^, CRCErrBit) THEN BEGIN
ReceiveFrame:=badFrameCRC;
{$IFC RDEBUG}
dummy:='';
EavesHist('BadCRC', dummy);
{$ENDC}
LEAVE;
END;
framedone:=TRUE;
ReceiveFrame:=closedFrame;
END;
SCCWrCtl^:=Register1;
IF BTst(SCCRdCtl^, OverRun) THEN BEGIN
ReceiveFrame:=overrunError; framedone:=FALSE;
{$IFC RDEBUG}
dummy:='';
EavesHist('Overrun', dummy);
{$ENDC}
LEAVE;
END;
{ now we can read the character }
incomingLength:=incomingLength+1;
inChar:=chr(SCCRdData^);
IF incomingLength<=BytesToRead THEN
incomingPacket^.DATA[incomingLength]:=inChar;
{ set the status and terminate}
IF incomingLength>=BytesToRead THEN
IF NoDiscard AND NOT framedone THEN BEGIN
ReceiveFrame:=continuedFrame;
framedone:=TRUE;
END
END
ELSE BEGIN
ReceiveFrame:=underrunError;
LEAVE;
END;
UNTIL framedone;
{$IFC RDEBUG}
PtrEavesHist('R', incomingLength,
charPtr(incomingPacket));
{$ENDC}
IF NOT framedone THEN
PurgeRest; { on error clear SCC stuff }
END;
END; { ReceiveFrame }
{ *************************************************************** }
PROCEDURE ReceiveHeader;
{ receive header of a data packets and control frames }
CONST
HeaderSize = 5;
VAR
MyGlobals: GlobalPtr;
incomingPacket: FramePtr;
TransmitResult: TransmitStatus;
BytesRead: INTEGER;
MyNumber: ISDNNumber;
{$IFC DEBUG}
dummy: Str255;
{$ENDC}
BEGIN
MyGlobals:=GlobalPtr(@Globals);
WITH MyGlobals^ DO BEGIN
{$IFC RDEBUG}
dummy:='';
EavesHist('RFrame', dummy);
{$ENDC}
LastTransmission:=0;
incomingPacket:=FramePtr(@MPPVars^.toRHA);
WITH incomingPacket^ DO
CASE ReceiveFrame(FramePtr(incomingPacket), HeaderSize, BytesRead, TRUE) OF
continuedFrame:
IF LengthHigh*256+LengthLow<=maxDataSize THEN
CASE lapType OF
$1..$80: BEGIN
{ dispatch to LAP Manager and protocol handler}
SavePreservedRegs;
ReadDispatch(Ptr(@DATA[6]), LengthHigh*256+LengthLow-2, lapType, MPPVars);
RestorePreservedRegs;
{$IFC RDEBUG}
EavesHist('Return', dummy);
{$ENDC}
END;
lapRND: BEGIN
{ extract number from RND packet }
MyNumber[0]:=lookupNumber[0];
IF ReceiveFrame(FramePtr(@MyNumber[1]), ORD(MyNumber[0]), BytesRead, FALSE)
=closedFrame THEN BEGIN
{$IFC DDEBUG}
PtrEavesHist('Number',
ORD(MyNumber[0]),
charPtr(@MyNumber[1]));
{$ENDC}
ActualNumber:=MyNumber;
END; { IF }
END;
OTHERWISE BEGIN
{$IFC RDEBUG}
EavesHist('BadType', dummy);
{$ENDC}
PurgeRest;
END;
END { CASE }
ELSE BEGIN
{$IFC RDEBUG}
EavesHist('BadLen', dummy);
{$ENDC}
PurgeRest;
END;
closedFrame:
IF BytesRead>=minFrameSize THEN
CASE lapType OF
lapENQ: BEGIN
IF IsUp=inProcess THEN BEGIN
Cache.StoredID:=srcAddr;
HisAddress:=srcAddr;
END;
IsUp:=called;
TransmitResult:=TransmitMessage(srcAddr,
lapACK);
END;
lapACK: BEGIN
IF IsUp=inProcess THEN
HisAddress:=srcAddr;
IsUp:=connected;
IF HisAddress=GetNodeID THEN
AddrStatus:=inUse
ELSE AddrStatus:=valid;
END;
lapHUP: BEGIN
{$IFC DDEBUG}
dummy:='';
EavesHist('HUP', dummy);
{$ENDC}
HangUp(FALSE);
END;
OTHERWISE BEGIN
{$IFC RDEBUG}
EavesHist('BadType', dummy);
{$ENDC}
PurgeRest;
END;
END; { CASE }
OTHERWISE;
END; { CASE }
Write_SCC(0, RHIUS);
END; { WITH }
END; { ReceiveHeader }
{ *************************************************************** }
PROCEDURE Terminator; { My VBLTask }
{ this VBL task terminates the connection }
{ and must not be called before the SCC is initialized }
VAR
StartTime: LONGINT;
MyGlobals: GlobalPtr;
{$IFC DDEBUG}
dummy: Str255;
{$ENDC}
BEGIN
MyGlobals:=GlobalPtr(@Globals);
WITH MyGlobals^ DO BEGIN
LastTransmission:=LastTransmission+1;
IF (LastTransmission>TerminateDelay)
AND
(IsUp<notConnected) THEN BEGIN
{ timer expires the release connection }
{$IFC DDEBUG}
dummy:=''; EavesHist('Termin', dummy);
{$ENDC}
HangUp(TRUE);
END;
VBLEntry.vblCount:=TaskTime; { restart timer }
END;
END; { Terminator }
{ *************************************************************** }
PROCEDURE ReceiveCall;
{ service an incoming call and extract the call information }
VAR
i: INTEGER;
inChar: BYTE;
MyGlobals: GlobalPtr;
ConnectedTo: Str255; { The call identification }
Count, Finalticks: LONGINT;
BEGIN
MyGlobals:=GlobalPtr(@Globals);
WITH MyGlobals^ DO BEGIN
ConnectedTo:=''; Count:=0; inChar :=SYN;
{$IFC DDEBUG}
EavesHist('Called', ConnectedTo);
{$ENDC}
REPEAT { wait for incoming call }
Count:=Count+1;
IF BTst(SCCRdCtl^, GOTCHAR) THEN
inChar:=BAND(SCCRdData^, CharacterMask);
UNTIL (inChar=BEL) OR (Count>TakeOffTimeOut);
IF Count<=TakeOffTimeOut THEN BEGIN
{ accept call, DTR high, RTS high }
IF IsMPPOpen THEN Write_SCC(5, $AA);
{ receive connection information }
i:=0; Count:=0;
REPEAT
Count:=Count+1;
IF BTst(SCCRdCtl^, GOTCHAR) THEN BEGIN
inChar:=BAND(SCCRdData^, CharacterMask);
IF (chr(inChar) IN VisibleChars) AND (i<255)
THEN BEGIN
i:=i+1; ConnectedTo[i]:=chr(inChar);
END;
END;
UNTIL (inChar IN [NULL, ONEs]) OR
(Count>TakeOffTimeOut);
ConnectedTo[0]:=chr(i);
IF pos('*', ConnectedTo)<>0 THEN BEGIN
LastTransmission:=0;
DELAY(1, Finalticks);
InitHDLCStuff; IsUp:=InProcess; { enter HDLC mode }
FilterNumber(ConnectedTo);
{ extract number of calling station }
Cache.StoredNumber:=ConnectedTo;
{ and keep it in mind }
END
ELSE HangUp(FALSE);
END
ELSE HangUp(FALSE);
{$IFC DDEBUG}
EavesHist('CallRes', ConnectedTo);
{$ENDC}
{ Rest Highest Interrupt Under Service }
Write_SCC(0, RHIUS);
END;
END; { ReceiveCall }
{ *************************************************************** }
PROCEDURE InitHDLCStuff;
{ setup the SCC for the transmision of HDLC frames }
VAR
ch: CHAR;
L2TabPtr: ^Level2IntTable;
MyGlobals: GlobalPtr;
{$IFC DDEBUG}
dummy: Str255;
{$ENDC}
BEGIN
{$IFC DDEBUG}
dummy:=''; EavesHist('HDLCInit', dummy);
{$ENDC}
MyGlobals:=GlobalPtr(@Globals);
WITH MyGlobals^ DO BEGIN
ch:=chr(SCCRdCtl^); { clear the SCC's register pointer }
IF MyPort=PRINTER THEN { reset our port }
Write_SCC(9, $40)
ELSE Write_SCC(9, $80);
{ set up the HDLC Mode }
Write_SCC(4, $20); { HDLC mode }
Write_SCC(10, $80); { CRC preset 1 }
Write_SCC(11, $28); { clock is TRxC from outer space }
Write_SCC(6, GetNodeID); { set my address }
Write_SCC(7, HDLCFlag); { 01111110 flag }
{ install the new interrupt service routine }
L2TabPtr:=pointer(Lvl2DT);
WITH L2TabPtr^ DO
IF MyPort=MODEM THEN BEGIN
ChannelARavailable:=@ReceiveHeader;
ChannelAScondition:=@ReceiveHeader;
END
ELSE BEGIN
ChannelBRavailable:=@ReceiveHeader;
ChannelBScondition:=@ReceiveHeader;
END;
Write_SCC(5, $EB); { Enable Tx, RTS high, DTR high }
Write_SCC(3, $DD); { Enable Rx, Address Search Mode }
{ now enable the interrupts }
Write_SCC(15, $8); { DCD interupt enabled for mouse }
Write_SCC(1, $11);
{ Rx int on all char, external interrupt enabled }
Write_SCC(9, $0A); { MIE, etc. }
END;
END; { InitHDLCStuff }
{ *************************************************************** }
PROCEDURE InitSCCStuff(First: BOOLEAN);
{ setup the SCC for receiving calls }
VAR
ch: CHAR;
L2TabPtr: ^Level2IntTable;
SCCWBasePtr: SCCHandle;
SCCRBasePtr: SCCHandle;
MyGlobals: GlobalPtr;
{$IFC DDEBUG}
dummy: Str255;
{$ENDC}
BEGIN
{$IFC DDEBUG}
dummy:=''; EavesHist('InitSCC', dummy);
{$ENDC}
MyGlobals:=GlobalPtr(@Globals);
WITH MyGlobals^ DO BEGIN
{ initializing the SCC destroys connection }
IsUp:=notConnected; HisAddress:=0;
IF First THEN BEGIN { this must be done exactly once }
SCCWBasePtr:=SCCHandle(SCCWr); { get pointer to SCC }
SCCRBasePtr:=SCCHandle(SCCRd);
IF MyPort=PRINTER THEN BEGIN
SCCWrCtl:=@SCCWBasePtr^^.bCtl;
SCCRdCtl:=@SCCRBasePtr^^.bCtl;
SCCWrData:=@SCCWBasePtr^^.bData;
SCCRdData:=@SCCRBasePtr^^.bData;
END
ELSE BEGIN
SCCWrCtl:=@SCCWBasePtr^^.aCtl;
SCCRdCtl:=@SCCRBasePtr^^.aCtl;
SCCWrData:=@SCCWBasePtr^^.aData;
SCCRdData:=@SCCRBasePtr^^.aData;
END;
END;
ch:=chr(SCCRdCtl^); { clear the SCC's register pointer }
IF MyPort=PRINTER THEN { reset our port }
Write_SCC(9, $40)
ELSE Write_SCC(9, $80);
Write_SCC(4, $1);
{ 0 Synchon Mode, 1 Sync Char(s), Parity odd }
Write_SCC(10, $0); { NRZ encoding }
Write_SCC(6, $FF); { send default $FF }
Write_SCC(7, SYN); { 00010110 Flag }
Write_SCC(11, $28); { clock is TRxC form outer space }
Write_SCC(14, $0); { enable DTR }
{ install interrupt service routine for receiving calls }
L2TabPtr:=pointer(Lvl2DT);
WITH L2TabPtr^ DO
IF MyPort=MODEM THEN BEGIN
IF First THEN BEGIN
OldReceiveInterruptVector:=ChannelARavailable;
OldReceiveSpecialVector:=ChannelAScondition;
END;
ChannelARavailable:=@ReceiveCall;
ChannelAScondition:=@ReceiveCall;
END
ELSE BEGIN
IF First THEN BEGIN
OldReceiveInterruptVector:=ChannelBRavailable;
OldReceiveSpecialVector:=ChannelBScondition;
END;
ChannelBRavailable:=@ReceiveCall;
ChannelBScondition:=@ReceiveCall;
END;
Write_SCC(5, $2A);
{ Tx is 7 Bits, Tx enable, No RTS, DTR low }
Write_SCC(3, $41);
{ Rx is 7 Bits, Enable Rx, SYN not inhibited }
{ now let's enable the interrupts }
Write_SCC(15, $8); { DCD interupt enabled for mouse }
Write_SCC(1, $09);
{ Rx int on first Char, external interupt enable }
Write_SCC(9, $0A); { MIE etc. }
END;
END; { InitSCCStuff }
{ *************************************************************** }
PROCEDURE RestoreOldInterruptService;
{ restore the interrupt status before ISDNLAP was installed }
VAR
L2TabPtr: ^Level2IntTable;
MyGlobals: GlobalPtr;
BEGIN
MyGlobals:=GlobalPtr(@Globals);
WITH MyGlobals^ DO BEGIN
Write_SCC(1, $1); { disable SCC interrupts}
L2TabPtr:=pointer(Lvl2DT);
WITH L2TabPtr^ DO
IF MyPort=MODEM THEN BEGIN
ChannelARavailable:=OldReceiveInterruptVector;
ChannelAScondition:=OldReceiveSpecialVector;
END
ELSE BEGIN
ChannelBRavailable:=OldReceiveInterruptVector;
ChannelBScondition:=OldReceiveSpecialVector;
END;
Write_SCC(5, $0); { Tx disable, RTS low, DTR low }
Write_SCC(9, $8); { MIE enable, DLC, VIS, NV low }
Write_SCC(1, $1); { Rx diable }
Write_SCC(15, $8); { DCD interrupt enabled for mouse }
END;
END; { RestoreOldInterruptService }
{ *************************************************************** }
FUNCTION InitLAP: BOOLEAN; { initialize the ISDNLAP }
{ the Mac toolbox stuff is allready initialized! }
VAR
MyGlobals: GlobalPtr;
BEGIN
MyGlobals:=GlobalPtr(@Globals);
WITH MyGlobals^ DO BEGIN
{$IFC DEBUG}
EavesInit;
{$ENDC}
GetNumber(NameServerNumber);
WITH VBLEntry DO BEGIN { prepare Termitator task }
qLink:=NIL; qType:=ORD(vType);
vblAddr:=@Terminator; vblCount:=TaskTime;
vblPhase:=0;
END;
InitLAP:=Vinstall(@VBLEntry)=NoErr;
MSecQueue.tmAddr := @TimeOutTask;
InsTime(@MSecQueue); { prepare Timeout task }
IF GetNodeID<=0 THEN SetNodeID(1, FALSE);
IsUp:=notConnected; HisAddress:=0;
ClearCache(Cache);
{$IFC DEBUG}
EavesHist('ISDNInit', NameServerNumber);
{$ENDC}
END;
END; { InitLAP }
{ *************************************************************** }
FUNCTION RestoreOldLap: BOOLEAN; { clean up the mess }
VAR
MyGlobals: GlobalPtr;
PortUsePtr: Ptr;
BEGIN
MyGlobals:=GlobalPtr(@Globals);
WITH MyGlobals^ DO BEGIN
IF IsUp<notConnected THEN HangUp(TRUE);
RestoreOldInterruptService;
RmvTime(@MSecQueue); { remove Timeout task }
RestoreOldLap:=VRemove(@VBLEntry)=NoErr;
{$IFC DEBUG}
DisposHandle(globzeux.histHandle);
{$ENDC}
END;
{ force the next AppleTalk client to open the .MPP }
PortUsePtr:=Ptr(PortBUse);
PortUsePtr^:=$FF;
END; { RestoreOldLap }
END. { this is the end of ISDNLap and the hopefull begin of PluriLAP }
{ *********************** End of ISDNLap ************************ }
*********************************************************************
*
* ISDN ATLK for CDEV Network
*
* by Alfred Lupper, University of Augsburg
*
* Version 1.5 24. December 1989
*
*********************************************************************
STRING ASIS ; take string AS it IS
PRINT OFF
INCLUDE 'LAPMgrEqu.a' ; get constants of LAP Manager
INCLUDE 'Traps.a' ; get system stuff
INCLUDE 'SysEqu.a'
PRINT ON
IMPORT (InitLAP, InitSCCStuff, RestoreOldLAP):CODE
IMPORT (PurgeRest, TransmitPacket, ReceiveFrame):CODE
EXPORT Globals ; block of global variables
TRUE EQU $01
Zero EQU $00
NoErr EQU $00
CTSErr EQU -28 ; excessCollsns, unable to contact
dest node
NoDiscard EQU $FFFF ; do not discard rest of packet
Discard EQU $0000 ; discard rest of packet
PortBInt EQU $00 ; port B interrupts enabled
Guard EQU $04 ; offset in globals to guard
MAIN ; this is the altk-Dispatch Table
atlkStart Bra.S LAPWrite ; first entry is the LAP write code
Cmpi.L #AInstall,D0 ; if it is an install call
Beq.S doAInstall ; do the installation
Cmpi.L #AShutdown,D0 if is a shut down call
Beq.S doAShutDown ; then shut down
Moveq #-1,D0 ; if it is an unknown parameter
Rts ; go home
DC.B 'ATLKSTAR'
doAInstall Move.L D1,-(SP) ; initialize ISDNLAP
Clr.W -(A7) ; space for function result
Jsr InitLAP ; call our lap initialization code
Move.B (A7)+,D0 ; get result
Beq.S error
Move #LWrtInsert,D0 ; if init ok then call Lap Manager
error Lea atlkStart,A0 ; start of our lap in A0
Move.B #PortBInt,D1 ; port B interrupts are NOT disabled
Move #1,D2 ; do 1 try to get an unused node ID
Move.L LAPMgrPtr,A1 ; call the code in the AtlkHk2,
Jsr LAPMgrCall(A1) ; that is the LAP Manager
Move.L (SP)+,D1 ; restore D1
Rts ; go home
DC.B 'DOINSTAL'
doAShutDown ; quit ISDNLAP
MoveM.L A0/D1-D2,-(SP) ; save some registers
Clr.W -(A7) ; reserve space for function result
Jsr RestoreOldLAP ; call the restore code of ISDNLAP
Move.B (A7)+,D0 ; get the result
Beq.S notOk ; jump if error
Move #LWrtRemove,D0 ; do LWrtRemove call to LAP Manager
notOk MoveM.L (SP)+,A0/D1-D2 ; restore registers
Move.L LAPMgrPtr,A1 ; call the code in the AtlkHk2,
Jsr LAPMgrCall(A1) ; that is the LAP Manager
Rts ; go home
DC.B 'DOSHUTDO'
****************************************
LAPWrite MoveM.L D1-D2/A0-A1/A3,-(A7) ; save registers, but not D4
Bclr #$06,VBLQueue ; reset VBLTask in process for
enabling mouse in Chooser
Lea Globals(PC),A3
Move.L A2,(A3) ; get pointer to MPPVars
Tst.B D0 ; is it an ENQ packet
Bne.S enqs ; then jump to the enq processing
Tst.B Guard(A3) ; are we still sending?
Bne.S task
Clr.W -(A7) ; this is for our function result
Move.L A1,-(A7) ; push pointer to WDS
ST Guard(A3) ; lock out async tasks
Jsr TransmitPacket ; perform the transmission
SF Guard(A3) ; allow calls to LAP
Tst.B (A7)+ ; get result
Beq.S itsOk ; if transmitok then exit
task Move.L #CTSErr,D0 ; signal CTSErr to LAP Manager
Bra.S exit
itsOk Move.L #NoErr,D0 ; signal noErr to LAP Manager
Bra.S exit
enqs SF Guard(A3) ; reset guard
Move.B #TRUE,-(A7) ; call SCCInitStuff with TRUE
Jsr InitSCCStuff ; call SCC initialization code
Move.L #Zero,D4 ; kill enquiry loop of .MPP
exit MoveM.L (A7)+,D1-D2/A0-A1/A3 ; restore registers
Jmp (A0) ; return to sender
DC.B 'LAPWRITE'
ENDMAIN
****************************************
Read PROC EXPORT ; this is my Read Dispatch Table
Bra.S ReadPacket ; call the ReadPacket code
Bra.S ReadRest ; readRest must start two byte after ReadPacket
ReadPacket
MoveM.L D1-D2/A0-A2,-(A7) ; save some registers
Subq #4,A7 ; space for BytesGot of ReceivePacket & result
Move.L A3,-(A7) ; push pointer to buffer
Move D3,-(A7) ; push number of bytes to read
Pea 8(A7) ; address of local variable
Move.W #NoDiscard,-(A7) ; read exactly the count of bytes
Jsr ReceiveFrame ; read in requested count of bytes
Move.B (A7)+,D0 ; get result of function
Move (A7)+,D2 ; get BytesGot
Move.L (A7)+,D1 ; D1 must not be modified
Sub D2,D3 ; calculate bytesToRead - BytesGot
Sub D2,D1 ; rest of bytes - BytesGot
Add D2,A3 ; pointer behind last byte read
MoveM.L (A7)+,D2/A0-A2 ; restore registers, not D1
Sub.B #1,D0 ; is it a continued frame?
Beq.S yes ; Yes => jump (Z-flag set)
Move.L #-1,D3 ; call failed (Z-flag clear)
yes Rts ; go back to PH
DC.B 'READPACK'
****************************************
ReadRest MoveM.L D2/A0-A2,-(A7) ; save some registers
Subq #4,A7 ; for BytesGot & result
Move.L A3,-(A7) ; push pointer to buffer
Move D3,-(A7) ; push number of bytes to read
Cmp D3,D1 ; if more bytes to read than avail.
Bge.S more
Move D1,(A7) ; then read bytes left in packet
more Pea 8(A7) ; addr of local variable BytesGot
Move #Discard,-(A7) ; and discard the rest of bytes
Jsr ReceiveFrame ; read rest of packet
Move.B (A7)+,D0 ; D0 must contain result for PH !
Move (A7)+,D2 ; get BytesGot
Subq #2,D2 ; subtract CRC bytes
Cmp.W D2,D3 ; more bytes read than buffer size
Ble.S toomuch ; then add buffer size
Add.W D3,A3 ; else add bytes read
Bra.S goon
toomuch Add.W D2,A3 ; pointer behind last byte read
goon Sub.W D2,D3 ; calculate bufferSize - bytesGot
MoveM.L (A7)+,D2/A0-A2 ; restore register and go home
Tst.B D0 ; if LAP data frame, set zero flag
Rts ; go back to PH
DC.B 'READREST'
ENDP
****************************************
ReadDispatch PROC EXPORT ; Call LAP Manager to dispatch to
Protocol Handler
RHA EQU 14 ; parameters on stack
Rest EQU 10
LAPType EQU 8
MPPVars EQU 4
Lea Read(PC),A4 ; load address of read procedures
Move.L RHA(A7),A3 ; get pointer to RHA
Move.L MPPVars(A7),A2 ; get pointer to MPPVars
Move LAPType(A7),D2 ; get LAPType
Move.L Rest(A7),D1 ; get length of stuff to read
Move.L (A7),RHA(A7) ; return address at position of RHA
Add #14,A7 ; get rid off parameters
Moveq #LRdDispatch,D0 ; code for LRdDispatch
Move.L LAPMgrPtr,A1 ; code of ATlkHook2
Jsr 2(A1) ; jump to the LAP Manager
Jsr PurgeRest ; if there was no PH, purge rest
Rts ; go back to ReceiveHeader
DC.B 'READDISP'
ENDP
****************************************
NewHandleClrSys PROC EXPORT ; new handle filled with zeros
Move.L 4(A7),D0 ; get size
_NewHandle SYS,CLEAR ; create handle on sysheap
Move.L A0,8(A7) ; return handle
Move D0,MemErr ; result of trap
Move.L (A7)+,(A7) ; clear stack pointer
Rts ; go home
DC.B 'NEWHAND '
ENDP
****************************************
STRING ASIS ; take string AS it IS
GLOBALS PROC ; datablock of global variables
DC.B '**************************************************'
DC.B '**************************************************'
DC.B '**************************************************'
DC.B '**************************************************'
DC.B '**************************************************'
DC.B '**************************************************'
DC.B '**************************************************'
DC.B '**************************************************'
DC.B '**************************************************'
DC.B '**************************************************'
DC.B '**************************************************'
DC.B '**************************************************'
DC.B '**************************************************'
DC.B '**************************************************'
DC.B '**************************************************'
DC.B '**************************************************'
DC.B '**************************************************'
DC.B '**************************************************'
DC.B '**************************************************'
DC.B '**************************************************'
DC.B '**************************************************'
DC.B '**************************************************'
DC.B 'GLOBALS '
ENDP
END
*********************************************************************
*********************************************************************
*
* ISDN ADEV for CDEV Network
*
* by Alfred Lupper, University of Augsburg
*
* Version 1.5 24. December 1989
*
*********************************************************************
PRINT OFF
INCLUDE 'LAPMgrEqu.a'
PRINT ON
IMPORT SETNUMBER:CODE; form Pascal module ISDNLAP
adevStart MAIN
Cmpi.L #GetADEV,D0 ; is it a GetADEV call
Beq.S doGetADEV ; then doGetADEV
Cmpi.L #SelectADEV,D0; is it a SelectADEV call
Beq.S doSelectADEV ; then doSelectADEV
Rts
doGetADEV Addq #1,D2 ; increase slot number
Cmp.B #$10,D2 ; if it is the second call
Beq.S nomore ; then let's get out of here
Move.B #0,D0 ; the Mac Plus needs this result
Move.B #$F,D2 ; return our slot ID
Lea iconString,A0 ; the pointer to the icon name
Asr.L #8,D1 ; decode the selected LAP ID
Cmp.B D2,D1 ; is it ours
Bne.S notours ; if not then return
Move.B #-1,D0 ; else indicate it
notours Rts ; go home
nomore Move.B #1,D0 ; indicate no more LAP in here
Rts ; go home
doSelectADEV ; execute when selected
MoveM.L A0-A1/D0/D2,-(SP) ; save some registers
Jsr SETNUMBER ; set number by dialog box
MoveM.L (SP)+,A0-A1/D0/D2 ; restore registers
Asl.L #8,D2 ; decode slot ID
Move.L D2,D1 ; and return it in D1
Rts ; go home
STRING PASCAL ; create pascal strings
iconString DC.B 'ISDNLAP' ; name of our ADEV
ENDMAIN
END
*********************************************************************
/* ISDNLAP.r */
/* Written by Alfred Lupper, University of Augsburg */
/* Version 1.5 24.December 1989 */
#include "Types.r" /* from library */
include "ISDNadev" 'adev' (126) AS 'adev' (126, locked);
include "ISDNatlk" 'atlk' (126) AS 'atlk' (126, sysheap, locked);
resource 'BNDL' (-4032) {
'ISDN',
0,
{ /* array TypeArray: 2 elements */
/* [1] */
'ICN#',
{ /* array IDArray: 1 elements */
/* [1] */
0, -4032
},
/* [2] */
'FREF',
{ /* array IDArray: 1 elements */
/* [1] */
0, -4032
}
}
};
resource 'FREF' (-4032) {
'adev',
0,
""
};
resource 'ICN#' (-4032) {
{
$"0000 0000 0000 0000 0000 0000 0000 7F80"
$"0003 C070 000E 0008 0018 0004 0030 0002"
$"0020 0001 005D DC6F 004A 4A25 0049 0935"
$"0048 892D 004A 4A25 005F 9C75 0020 0001"
$"0017 0002 000E 0006 001C 001C 03DB 8070"
$"0FFF FDC0 0FFF C780 1FFF 8E00 1FFF 3800"
$"1FFF 0000 1FFF 8000 1FFF E000 1FFF E000"
$"1FFF E000 0FFF C000 0FFF C000 07CF 8000",
$"0000 0000 0000 0000 0000 0000 0000 7F80"
$"0003 FFF0 000F FFF8 001F FFFC 003F FFFE"
$"003F FFFF 007F FFFF 007F FFFF 007F FFFF"
$"007F FFFF 007F FFFF 007F FFFF 003F FFFF"
$"001F FFFE 000F FFFE 001F FFFC 03DF FFF0"
$"0FFF FFC0 0FFF C780 1FFF 8E00 1FFF 3800"
$"1FFF 0000 1FFF 8000 1FFF E000 1FFF E000"
$"1FFF E000 0FFF C000 0FFF C000 07CF 8000"
}
};
resource 'STR ' (-4032) {
"ISDNLAP"
};
resource 'STR ' (128, "NSNumber") {
"213"
};
type 'ISDN' {
pstring;
};
resource 'ISDN' (0) {
"ISDNLAP Version 1.5\nWritten by Alfred Lupper, December 1989"
};
resource 'DLOG' (128) {
{100, 80, 150, 430},
dBoxProc,
visible,
noGoAway,
0x0,
128,
""
};
resource 'DITL' (128) {
{ /* array DITLarray: 4 elements */
/* [1] */
{14, 271, 34, 331},
Button {
enabled,
"OK"
},
/* [2] */
{16, 8, 33, 74},
StaticText {
disabled,
"Number:"
},
/* [3] */
{16, 88, 32, 251},
EditText {
enabled,
""
}
}
};
*********************************************************************
*
* LAP Manager Equates for CDEV Network
*
* by Alfred Lupper, University of Augsburg
*
* Version 1.0 24. December 1989
*
*********************************************************************
LRdDispatch EQU 1
LWrtInsert EQU 2
LWrtRemove EQU 3
LWrtGet EQU 4
LSetInUse EQU 5
LGetSelfSend EQU 6
LAARPAttach EQU 7
LAARAPDetach EQU 8
LGetATalkInfo EQU 9
LWSelfSend EQU 7
LWEnableSCC EQU 8
LWSrvrWks EQU 5
AInstall EQU 1
AShutdown EQU 2
atlkCall EQU 2
GetADEV EQU 101
SelectADEV EQU 102
LAPMgrPtr EQU $B18
LAPMgrCall EQU 2
ATalkPRAM EQU $E0
LAPMgrBate EQU $60
adevBaseId EQU -4032
POptions = -d TDEBUG=TRUE -d RDEBUG=FALSE -d DDEBUG=TRUE
ISDNadev.a.o ƒ ISDNLAP.make ISDNadev.a
ISDNatlk.a.o ƒ ISDNLAP.make ISDNatlk.a
ISDNLAP.p.o ƒ ISDNLAP.make ISDNLAP.p
ISDNLAP.r.o ƒ ISDNLAP.make ISDNLAP.r
LAPMgrEqu.a.o ƒ ISDNLAP.make LAPMgrEqu.a
ISDNLAP ƒƒ ISDNLAP.r ISDNadev ISDNatlk
Rez ISDNLAP.r -o ISDNLAP
Setfile -a B -t 'adev' -c 'ISDN' ISDNLAP
duplicate -y ISDNLAP "{SystemFolder}"ISDNLAP
ISDNadev ƒƒ ISDNadev.a.o ISDNLAP.p.o
LINK ∂
-rt adev=126 ∂
-t rsrc ∂
ISDNadev.a.o ∂
ISDNLAP.p.o ∂
"{Libraries}"Interface.o ∂
-o ISDNadev
ISDNatlk ƒƒ ISDNatlk.a.o ISDNLAP.p.o
LINK ∂
-rt atlk=126 ∂
-t rsrc ∂
ISDNatlk.a.o ∂
ISDNLAP.p.o ∂
"{Libraries}"Interface.o ∂
"{PLibraries}"PasLib.o ∂
-o ISDNatlk
Der Quelltext wurde aufgrund seines Umfangs nicht abgedruckt, kann aber auf Wunsch gerne eingesehen werden.
Der Quelltext wurde aufgrund seines Umfangs nicht abgedruckt, kann aber auf Wunsch gerne eingesehen werden.
Programm zur Erzeugung eines Taktes mit einem IBM-PC
PROGRAM Takter; {
24.4.89 }
{$I+,K-}
CONST
modemcontr : integer = $3FC;
VAR
cr : byte;
kch : integer;
delcnt,i : integer;
BEGIN
Write('Frequenz: '); ReadLn(delcnt);
lcr:=port[modemcontr];
kch:=port[$60];
inline($FA); { CLI }
REPEAT
port[modemcontr]:=lcr AND $FE; { drop DTR }
FOR i:=0 TO delcnt DO;
IF (port[$60] AND $7F) = 0 THEN;
port[modemcontr]:=lcr OR 1; { set DTR again }
FOR i:=0 TO delcnt DO;
UNTIL (port[$60] AND $7f)<>kch;
inline($FB); { STI }
END. { Takter }