?

5i24/utils/dos/ENV.BAT

@@ -0,0 +1,5 @@
+set interface=pcimem
+set protocol=bus
+
+
+

5i24/utils/dos/source/25MLOWP.PAS

@@ -0,0 +1,169 @@
+{m25pxx serial eeprom access stuff }
+const
+
+ComLength    = 8;
+AddLength    = 24;
+DataLength   = 8;
+
+{ Instructions }
+WriteEnaCom   = $06;
+WriteDisCom  = $04;
+ReadStatCom  = $05;
+WriteStatCom = $01;
+ReadCom      = $03;
+PageProgCom  = $02;
+SectorEraCom = $D8;
+BulkEraCom   = $C7;
+PowerDown    = $B9;
+ReadIDCom    = $AB;
+
+{ status Reg Bits }
+WIP = $01;
+WEL = $02;
+BP0 = $04;
+BP1 = $08;
+SRWD = $80;
+
+OneMegID = $10;
+TwoMegID = $11;
+FourMegID = $12;
+EightMegID = $13;
+SixteenMegID = $14;
+
+type
+
+PageBufferType = array[0..255] of byte;
+PageBufferPointer = ^PageBufferType;
+
+
+{
+procedure SetCSHigh;
+begin
+end;
+
+procedure SetCSLow;
+begin
+end;
+
+
+
+procedure LDisableInterrupts;
+begin
+  inline($FA);
+end;
+
+procedure LEnableInterrupts;
+begin
+  inline($FB);
+end;
+}
+procedure PutByte25(data: byte);
+begin
+  SendSPIByte(data);
+end;
+
+function GetByte25 : byte;
+begin
+  Getbyte25 := RecvSPIByte(0);
+end;
+
+procedure PutAddress25(add : longint);
+begin
+  PutByte25(WordRec(LongIntRec(add).HighWord).LowByte);
+  PutByte25(WordRec(LongIntRec(add).LowWord).HighByte);
+  PutByte25(WordRec(LongIntRec(add).LowWord).LowByte);
+end;
+
+procedure Prefix25;
+begin
+  SetCSLow;
+end;
+
+procedure Suffix25;
+begin
+  SetCSHigh;
+end;
+
+function ReadByte25(add: longint) : byte;
+begin
+  Prefix25;
+  PutByte25(ReadCom);
+  PutAddress25(add);
+  ReadByte25 := GetByte25;
+  Suffix25;
+end;
+
+function ReadStatus25 : byte;
+begin
+  Prefix25;
+  PutByte25(ReadStatCom);
+  ReadStatus25 := GetByte25;
+  Suffix25;
+end;
+
+function ReadID25: byte;
+begin
+  Prefix25;
+  PutByte25(ReadIDCom);
+  PutAddress25(0); { three dummy bytes}
+  ReadID25 := GetByte25;
+  Suffix25;
+end;
+
+procedure WriteEnable25;
+begin
+  Prefix25;
+  PutByte25(WriteEnaCom);
+  Suffix25;
+end;
+
+procedure WaitForWrite25;
+begin
+  while (ReadStatus25 and WIP) <> 0 do;
+end;
+
+procedure WriteByte25(add : longint; data : byte);
+begin
+  WriteEnable25;
+  Prefix25;
+  PutByte25(PageProgCom);
+  PutAddress25(add);
+  PutByte25(data);
+  Suffix25;
+  WaitForWrite25;
+end;
+
+procedure WritePage25(add : longint; pageBuf : PageBufferPointer);
+var
+index : word;
+begin
+  WriteEnable25;
+  Prefix25;
+  PutByte25(PageProgCom);
+  PutAddress25(add); { note that add 0..7 should be 0}
+  for index := 0 to 255 do
+  begin
+    PutByte25(PageBuf^[index]);
+  end;
+  Suffix25;
+  WaitForWrite25;
+end;
+
+procedure EraseChip25;
+begin
+  WriteEnable25;
+  Prefix25;
+  PutByte25(BulkEraCom);
+  Suffix25;
+  WaitForWrite25;
+end;
+
+procedure EraseSector25(add: longint);
+begin
+  WriteEnable25;
+  Prefix25;
+  PutByte25(SectorEraCom);
+  PutAddress25(add);
+  Suffix25;
+  WaitForWrite25;
+end;

5i24/utils/dos/source/9030.PAS

@@ -0,0 +1,30 @@
+const
+N030VendorID = $10B5;
+N030DeviceID = $9030;
+
+N030PCIBaseAddress0 = $10;  { memory access to local config regs }
+N030PCIBaseAddress1 = $14;  { I/O access to local config regs }
+N030PCIBaseAddress2 = $18;  { local address space 0 }
+N030PCIBaseAddress3 = $1C;  { local address space 1 }
+N030PCIBaseAddress4 = $20;  { local address space 2 }
+N030PCIBaseAddress5 = $24;  { local address space 3 }
+N030PCIIntRegister  = $3C;  { interrupt routing register }
+N030InitControlReg = $50;
+N030InitControlRegTop = $52;
+N030GPIOControlReg = $54;
+N030GPIOControlRegTop = $56;
+
+N030EECLKMask : word = $0100;
+N030EECSMask : word = $0200;
+N030EEDIMask : word = $0400;
+N030EEDOMask : word = $0800;
+
+{ 5I20 Specific masks for access to PCI bridge GPIO bits... }
+
+
+DoneMask : word = $0800; { Read at N030GPIOControlReg - bit 11 = GPIO3 data}
+InitMask : word = $4000; { Read at N030GPIOControlReg - bit 14 = GPIO4 data}
+LEDMask : word = $0002; { Written at N030GPIOControlRegTop - bit 17 = GPIO5 data}
+WriteMask : word = $0080; { Written at N030GPIOControlRegTop - bit 23 = GPIO7 data}
+ProgramMask: word = $0400; { Written at N030GPIOControlRegTop - bit 26 = GPIO8 data}
+

5i24/utils/dos/source/9054.PAS

@@ -0,0 +1,48 @@
+const
+N054VendorID = $10B5;
+N054DeviceID = $9054;
+
+N054PCICR = $04;            { PCI Status and control Register }
+N054PCIBaseAddress0 = $10;  { memory access to local config regs }
+N054PCIBaseAddress1 = $14;  { I/O access to local config regs }
+N054PCIBaseAddress2 = $18;  { local address space 0 }
+N054PCIBaseAddress3 = $1C;  { local address space 1 }
+N054PCIIntRegister  = $3C;  { interrupt routing register }
+N054GPIOControlReg = $6C;
+N054GPIOControlRegTop = $6E;
+
+{ at N054GPIOControlRegTop }
+N054UserOMask = $0001;
+N054UserIMask = $0002;
+N054UserIIsInputMask : word = $0004;
+N054UserOIsOutputMask : word = $0008;
+
+N054EECLKMask : word = $0100;
+N054EECSMask : word = $0200;
+N054EEDIMask : word = $0400;
+N054EEDOMask : word = $0800;
+
+{ 4I68/5I21/5I22/5I23 Specific masks for access to PCI bridge GPIO bits... }
+
+DoneMask_54 : word    = N054UserIMask; { Read at N054GPIOControlRegTop}
+ProgramMask_54 : word = N054UserOMask; { Written at N054GPIOControlRegTop}
+
+{DMA registers}
+
+N054DMAMode0Register = $80;
+N054DMAPAdr0Register = $84;
+N054DMALAdr0Register = $88;
+N054DMASiz0Register = $8C;
+N054DMADPr0Register = $90;
+N054DMACSR0Register = $A8;  {Byte register!}
+N054DMADAC0Register = $B4;
+
+N054DMAMode1Register = $94;
+N054DMAPAdr1Register = $98;
+N054DMALAdr1Register = $9C;
+N054DMASiz1Register = $A0;
+N054DMADPr1Register = $A4;
+N054DMACSR1Register = $A9;  {Byte register!}
+N054DMADAC1Register = $B8;
+
+N054DMAThrRegister = $B0;

5i24/utils/dos/source/9056.PAS

@@ -0,0 +1,55 @@
+const
+N056VendorID = $10B5;
+N056DeviceID = $9056;
+
+N056PCICR = $04;            { PCI Status and control Register }
+N056PCIBaseAddress0 = $10;  { memory access to local config regs }
+N056PCIBaseAddress1 = $14;  { I/O access to local config regs }
+N056PCIBaseAddress2 = $18;  { local address space 0 }
+N056PCIBaseAddress3 = $1C;  { local address space 1 }
+N056PCIIntRegister  = $3C;  { interrupt routing register }
+N056GPIOControlReg = $6C;
+N056GPIOControlRegTop = $6E;
+
+{ at N056GPIOControlRegTop }
+N056UserOMask = $0001;
+N056UserIMask = $0002;
+N056UserIIsInputMask : word = $0004;
+N056UserOIsOutputMask : word = $0008;
+
+N056EECLKMask : word = $0100;  { will probably just use VPD access }
+N056EECSMask : word = $0200;   { due to the fact that the 9056s muxed  }
+N056EEDIMask : word = $0400;   { EEDI/EEDO messes up normal EEPROM access}
+N056EEDOMask : word = $0800;
+
+N056VPDIDNDC : word = $4C;
+N056VPDAddr  : word = $4E;
+N056VPDData  : word = $50;
+N056VPDFMask : word = $8000;   {F bit in VPD address register }
+
+N056LCSPROT  : word = $0E;
+
+{ 3X20 Specific masks for access to PCI bridge GPIO bits... }
+
+DoneMask_56 : word    = N056UserIMask; { Read at N056GPIOControlRegTop}
+ProgramMask_56 : word = N056UserOMask; { Written at N056GPIOControlRegTop}
+
+{DMA registers}
+
+N056DMAMode0Register = $80;
+N056DMAPAdr0Register = $84;
+N056DMALAdr0Register = $88;
+N056DMASiz0Register = $8C;
+N056DMADPr0Register = $90;
+N056DMACSR0Register = $A8;  {Byte register!}
+N056DMADAC0Register = $B4;
+
+N056DMAMode1Register = $94;
+N056DMAPAdr1Register = $98;
+N056DMALAdr1Register = $9C;
+N056DMASiz1Register = $A0;
+N056DMADPr1Register = $A4;
+N056DMACSR1Register = $A9;  {Byte register!}
+N056DMADAC1Register = $B8;
+
+N056DMAThrRegister = $B0;

5i24/utils/dos/source/CRC8.PAS

@@ -0,0 +1,39 @@
+function GetCRC8(inbyte : byte) : byte;
+const
+CRC8table : array[0..$FF] of byte =
+($00, $5e, $bc, $e2, $61, $3f, $dd, $83,
+$c2, $9c, $7e, $20, $a3, $fd, $1f, $41, 
+$9d, $c3, $21, $7f, $fc, $a2, $40, $1e, 
+$5f, $01, $e3, $bd, $3e, $60, $82, $dc, 
+$23, $7d, $9f, $c1, $42, $1c, $fe, $a0, 
+$e1, $bf, $5d, $03, $80, $de, $3c, $62, 
+$be, $e0, $02, $5c, $df, $81, $63, $3d, 
+$7c, $22, $c0, $9e, $1d, $43, $a1, $ff, 
+$46, $18, $fa, $a4, $27, $79, $9b, $c5,
+$84, $da, $38, $66, $e5, $bb, $59, $07, 
+$db, $85, $67, $39, $ba, $e4, $06, $58, 
+$19, $47, $a5, $fb, $78, $26, $c4, $9a, 
+$65, $3b, $d9, $87, $04, $5a, $b8, $e6, 
+$a7, $f9, $1b, $45, $c6, $98, $7a, $24, 
+$f8, $a6, $44, $1a, $99, $c7, $25, $7b, 
+$3a, $64, $86, $d8, $5b, $05, $e7, $b9, 
+$8c, $d2, $30, $6e, $ed, $b3, $51, $0f,
+$4e, $10, $f2, $ac, $2f, $71, $93, $cd, 
+$11, $4f, $ad, $f3, $70, $2e, $cc, $92, 
+$d3, $8d, $6f, $31, $b2, $ec, $0e, $50, 
+$af, $f1, $13, $4d, $ce, $90, $72, $2c, 
+$6d, $33, $d1, $8f, $0c, $52, $b0, $ee, 
+$32, $6c, $8e, $d0, $53, $0d, $ef, $b1, 
+$f0, $ae, $4c, $12, $91, $cf, $2d, $73, 
+$ca, $94, $76, $28, $ab, $f5, $17, $49,
+$08, $56, $b4, $ea, $69, $37, $d5, $8b, 
+$57, $09, $eb, $b5, $36, $68, $8a, $d4, 
+$95, $cb, $29, $77, $f4, $aa, $48, $16, 
+$e9, $b7, $55, $0b, $88, $d6, $34, $6a, 
+$2b, $75, $97, $c9, $4a, $14, $f6, $a8, 
+$74, $2a, $c8, $96, $15, $4b, $a9, $f7, 
+$b6, $e8, $0a, $54, $d7, $89, $6b, $35);
+
+begin
+  GetCRC8 := CRC8table[inbyte];
+end;

5i24/utils/dos/source/DATAREC.PAS

@@ -0,0 +1,40 @@
+type LongIntRec = record
+  LowWord  : word;
+  HighWord : word;
+end;
+
+type LongIntByteRec = record
+  Byte0 : byte;
+  Byte1 : byte;
+  Byte2 : byte;
+  Byte3 : byte;
+end;
+
+type DoubleIntRec = record
+  Word0  : word;
+  Word1  : word;
+  Word2  : word;
+  Word3  : word;
+end;
+
+type DoubleByteRec = record
+  Byte0  : byte;
+  Byte1  : byte;
+  Byte2  : byte;
+  Byte3  : byte;
+  Byte4  : byte;
+  Byte5  : byte;
+  Byte6  : byte;
+  Byte7  : byte;
+end;
+
+type DoublelongRec = record
+  long0  : longint;
+  long1  : longint;
+end;
+
+type WordRec = record
+  LowByte : byte;
+  HighByte : byte;
+end;
+

5i24/utils/dos/source/EPP.PAS

@@ -0,0 +1,135 @@
+const
+{ printer status bits @base + 1 }
+PError = $08;
+PSelect = $10;
+PPaperOut = $20;
+Pack = $40;
+NPbusy = $80;
+EPPTimeout = $01;
+
+{ printer control bits @base + 2 }
+NPstb = $01;
+NPafd = $02;
+Pinit = $04;
+NPslin = $08;
+EPPIdleControl = $04;
+
+LPT1Base        = $3BC;
+LPT2Base        = $378;
+LPT3Base        = $278;
+ContOfs = 2;
+StatOfs = 1;
+EPPDataOfs = 4;
+EPPAddressOfs = 3;
+
+var
+EPPBasePort : word;
+BaseAddr : longint;
+DataPort : word;
+ContPort : word;
+StatPort : word;
+EPPDataPort : word;
+EPPAddressPort : word;
+Shadow : byte;
+ShadowAdd : byte;
+UARTBaseAddress : word;
+
+procedure EPPWriteData(d: byte);
+begin
+  port[EPPDataPort] := d;
+  Shadow := d;
+end;
+
+procedure EPPWriteAddress(a : byte);
+begin
+  port[EPPAddressPort] := a;
+  ShadowAdd := a;
+end;
+
+function EPPReadData : byte;
+begin
+  EPPReadData := port[EPPDataPort];
+end;
+
+function EPPReadAddress : byte;
+begin
+  EPPReadAddress := port[EPPAddressPort];
+end;
+
+procedure EPPInit(ourport:word);
+var foodata : byte;
+begin
+  DataPort := ourport;
+  ContPort := ourport + ContOfs;
+  StatPort := ourport + StatOfs;
+  EPPDataPort := ourport + EPPDataOfs;
+  EPPAddressPort := ourport + EPPAddressOfs;
+  port[ContPort] := EPPIdleControl;
+  port[StatPort] := EPPTimeout;
+  EPPWriteAddress($FF);
+  EPPWriteAddress($FF);
+  foodata := EPPReadData;
+end;
+
+procedure WriteEPP32(addr : word; data : longint);
+var foodata : byte;
+begin
+  EPPWriteAddress($FF);
+  EPPWriteAddress($FF);
+  foodata := EPPReadData;
+  EPPWriteAddress(lo(addr));
+  EPPWriteAddress(hi(addr) or $80);
+  EPPWriteData(LongIntByteRec(data).Byte0);
+  EPPWriteData(LongIntByteRec(data).Byte1);
+  EPPWriteData(LongIntByteRec(data).Byte2);
+  EPPWriteData(LongIntByteRec(data).Byte3);
+end;
+
+function ReadEPP32(addr : word) : longint;
+var foodata : longint;
+begin
+  EPPWriteAddress($FF);
+  EPPWriteAddress($FF);
+  foodata := EPPReadData;
+  EPPWriteAddress(lo(addr));
+  EPPWriteAddress(hi(addr) or $80);
+  LongIntByteRec(foodata).Byte0  := EPPReadData;
+  LongIntByteRec(foodata).Byte1  := EPPReadData;
+  LongIntByteRec(foodata).Byte2 := EPPReadData;
+  LongIntByteRec(foodata).Byte3 := EPPReadData;
+  ReadEPP32 := foodata;
+end;
+
+procedure FastWriteEPP32(addr : word; data : longint);
+begin
+  EPPWriteAddress(lo(addr));
+  EPPWriteAddress(hi(addr) or $80);
+  EPPWriteData(LongIntByteRec(data).Byte0);
+  EPPWriteData(LongIntByteRec(data).Byte1);
+  EPPWriteData(LongIntByteRec(data).Byte2);
+  EPPWriteData(LongIntByteRec(data).Byte3);
+end;
+
+function FastReadEPP32(addr : word) : longint;
+var
+foodata : longint;
+begin
+  EPPWriteAddress(lo(addr));
+  EPPWriteAddress(hi(addr) or $80);
+  LongIntByteRec(foodata).Byte0  := EPPReadData;
+  LongIntByteRec(foodata).Byte1  := EPPReadData;
+  LongIntByteRec(foodata).Byte2 := EPPReadData;
+  LongIntByteRec(foodata).Byte3 := EPPReadData;
+  FastReadEPP32 := foodata;
+end;
+
+function EPPCheckTimeout : boolean;
+begin
+  if port[Statport] and EPPTimeout = 0 then EPPCheckTimeout := false else EPPChecktimeout := true;
+end;
+
+procedure EPPZeroPort;  {parallel port outputs are all set to zero}
+begin                   {so the remote card is not powered by the port}
+  port[DataPort] := 0;
+  port[ContPort] := 0;
+end;

5i24/utils/dos/source/HM2ID.PAS

@@ -0,0 +1,332 @@
+const
+
+IDROMSize = 256;
+IDROMHeaderSize = 16;
+MaxModules = 32;
+MaxPins = 144;
+IDROMStyle0 = 2;
+IDROMStyle1 = 3;
+Boards = 16;
+MaxConns = 6;
+
+type
+
+IDROMAsArrayType = Array[0 ..IDROMSize-1] of longint;
+IDROMHeaderAsArrayType = Array[0 ..IDROMHeaderSize-1] of longint;
+
+ModulesAsArrayType = array[0.. MaxModules*3-1] of longint;
+ModuleType = array[0 .. MaxModules-1] of record
+  GTag : byte;
+  Version : byte;
+  Clock : byte;
+  NumInstances : byte;
+  BaseAddr : word;
+  NumRegisters : byte;
+  Strides : byte;
+  MultRegs : longint;
+end;
+
+PinDescType = array[1..MaxPins] of record
+  PNumber : byte;
+  GTag : byte;
+  Chan : byte;
+  PTag : byte;
+end;
+
+PinDescAsArrayType = array[0..MaxPins-1] of longint;
+
+FNameType = record
+  FName : string[40];
+  FTag  : byte;
+end;
+
+PinNameType = record
+  FTag : byte;
+  Names : array[1..10] of string[20];
+end;
+
+IDROMHeaderType = record
+  IDROMType : longint;
+  ModulePointer : longint;
+  PinDescPointer : longint;
+  BoardNameLow : longint;
+  BoardNameHigh : longint;
+  FPGASize : longint;
+  FPGAPins : longint;
+  IOPorts : longint;
+  IOWidth : longint;
+  PortWidth : longint;
+  ClockLow : longint;
+  ClockHigh : longint;
+  InstStride0 : longint;
+  InstStride1 : longint;
+  RegStride0 : longint;
+  RegStride1 : longint;
+end;
+
+ConnectorNamesType = array[1..Boards] of record
+  BoardName : longint;
+  ConName : array[1..MaxConns] of string[20];
+end;
+
+const
+HM2Cookie : longint = $55AACAFE;
+HostMotName = 'HOSTMOT2';
+
+IDOffset = $100;
+HM2CookieOffset = IDOffset + 0;
+HostMotNameLowOffset  = IDOffset+4;
+HostMotNameHighOffset = IDOffset+8;
+IDROMPointer =  IDOffset+ 12;
+
+HostMotClockLowOffset = $428;
+HostMotClockHighOffset = $42C;
+
+ClockLowTag= $01;
+ClockHighTag= $02;
+
+MaxTags = 33;
+NullTag = $00;
+IRQLogicTag = $01;
+WatchDogTag = $02;
+IOPortTag = $03;
+QCountTag = $04;
+StepGenTag = $05;
+PWMTag = $06;
+SPITag = $07;
+SSITag = $08;
+UARTTXTag = $09;
+UARTRXTag = $0A;
+AddrXTag = $0B;
+MuxedQCountTag = $0C;
+MuxedQCountSelTag =$0D;
+BSPITag = $0E;
+DBSPITag = $0F;
+MuxedQCountMIMTag = $11;
+MuxedQCountSelMIMTag =$12;
+TPPWMTag = $13;
+WaveGenTag = $14;
+DAQFIFOTag =$15;
+BinOscTag =$16;
+DMDMATag =$17;
+BISSTag =$18;
+FAbsTag =$19;
+DPLLTag = $1A;
+PktUARTTXTag = $1B;
+PktUARTRXTag = $1C;
+SSDATag = $1E;
+ResModTag = $C0;
+SSerialTag = $C1;
+TwiddlerTag = $C2;
+
+LEDTag = $80;
+
+BoardName4I65 = $35364934;		{  4I65 }
+BoardName4I74 = $34374934;		{  4I74 }
+BoardName4I68 = $38364934;		{  4I68 }
+BoardName4I69 = $39364934;		{  4I69 }
+BoardName5I20 = $30324935;		{  5I20 }
+BoardName5I22 = $32324935;		{  5I22 }
+BoardName5I23 = $33324935;		{  5I23 }
+BoardName5I24 = $34324935;		{  5I24 }
+BoardName5I25 = $35324935;		{  5I25 }
+BoardName6I25 = $35324936;		{  6I25 }
+BoardName7I43 = $33344937;		{  7I43 }
+BoardName7I90 = $30394937;		{  7I90 }
+BoardName7I80 = $30384937;		{  7I80 }
+BoardName7I76 = $36374937;		{  7I76 }
+BoardName7I60 = $30364937;		{  7I60 }
+BoardName3X20 = $30325833;		{  3X20 }
+
+OutputMarker = $80;
+GlobalMarker = $80;
+OutputMask = $7F;
+
+FNames : array[1..MaxTags] of FNameType =
+(
+(FName : 'Null'; Ftag : NullTag),
+(FName : 'IRQLogic'; Ftag : IRQLogicTag),
+(FName : 'WatchDog'; Ftag : WatchDogTag),
+(FName : 'IOPort'; Ftag : IOPortTag),
+(FName : 'QCount'; Ftag : QCountTag),
+(FName : 'StepGen'; Ftag : StepGenTag),
+(FName : 'PWMGen'; Ftag : PWMTag),
+(FName : 'SPI'; Ftag : SPITag),
+(FName : 'SSI'; Ftag : SSITag),
+(FName : 'UARTTX'; Ftag : UARTTXTag),
+(FName : 'UARTRX'; Ftag : UARTRXTag),
+(FName : 'AddrX'; Ftag : AddrXTag),
+(FName : 'MuxedQCount'; Ftag : MuxedQCountTag),
+(FName : 'MuxedQCountSel'; Ftag : MuxedQCountSelTag),
+(FName : 'BufSPI'; Ftag : BSPITag),
+(FName : 'DBufSPI'; Ftag : DBSPITag),
+(FName : 'DPLL'; Ftag : DPLLTag),
+(FName : 'PktUARTTX'; Ftag : PktUARTTXTag),
+(FName : 'PktUARTRX'; Ftag : PktUARTRXTag),
+(FName : 'MuxQCntM'; Ftag : MuxedQCountMIMTag),
+(FName : 'MuxQSelM'; Ftag : MuxedQCountSelMIMTag),
+(FName : 'TPPWM'; Ftag : TPPWMTag),
+(FName : 'WaveGen'; Ftag : WaveGenTag),
+(FName : 'DAQFIFO'; Ftag : DAQFIFOTag),
+(FName : 'SSDA'; Ftag : SSDATag),
+(FName : 'BinOsc'; Ftag : BinOscTag),
+(FName : 'DMDMA'; Ftag : DMDMATag),
+(FName : 'BISS'; Ftag : BISSTag),
+(FName : 'FanucAbs'; Ftag : FAbsTag),
+(FName : 'ResolverMod'; Ftag : ResModTag),
+(FName : 'SSerial'; Ftag : SSerialTag),
+(FName : 'Twiddler'; Ftag : TwiddlerTag),
+(FName : 'LED'; Ftag : LEDTag)
+);
+
+FNamesX : array[1..MaxTags] of FNameType =
+(
+(FName : 'Null'; Ftag : NullTag),
+(FName : 'IRQLogic'; Ftag : IRQLogicTag),
+(FName : 'Watchdog'; Ftag : WatchDogTag),
+(FName : 'IOPort'; Ftag : IOPortTag),
+(FName : 'Encoder'; Ftag : QCountTag),
+(FName : 'StepGen'; Ftag : StepGenTag),
+(FName : 'PWMGen'; Ftag : PWMTag),
+(FName : 'SPI'; Ftag : SPITag),
+(FName : 'SSI'; Ftag : SSITag),
+(FName : 'UARTTX'; Ftag : UARTTXTag),
+(FName : 'UARTRX'; Ftag : UARTRXTag),
+(FName : 'AddrX'; Ftag : AddrXTag),
+(FName : 'MuxedQCount'; Ftag : MuxedQCountTag),
+(FName : 'MuxedQCountSel'; Ftag : MuxedQCountSelTag),
+(FName : 'BufSPI'; Ftag : BSPITag),
+(FName : 'DBufSPI'; Ftag : DBSPITag),
+(FName : 'DPLL'; Ftag : DPLLTag),
+(FName : 'PktUARTTX'; Ftag : PktUARTTXTag),
+(FName : 'PktUARTRX'; Ftag : PktUARTRXTag),
+(FName : 'MuxQCntM'; Ftag : MuxedQCountMIMTag),
+(FName : 'MuxQSelM'; Ftag : MuxedQCountSelMIMTag),
+(FName : 'TPPWM'; Ftag : TPPWMTag),
+(FName : 'WaveGen'; Ftag : WaveGenTag),
+(FName : 'DAQFIFO'; Ftag : DAQFIFOTag),
+(FName : 'SSDA'; Ftag : SSDATag),
+(FName : 'BinOsc'; Ftag : BinOscTag),
+(FName : 'DMDMA'; Ftag : DMDMATag),
+(FName : 'BISS'; Ftag : BISSTag),
+(FName : 'FanucAbs'; Ftag : FAbsTag),
+(FName : 'ResolverMod'; Ftag : ResModTag),
+(FName : 'SSerial'; Ftag : SSerialTag),
+(FName : 'Twiddler'; Ftag : TwiddlerTag),
+(FName : 'LED'; Ftag : LEDTag)
+);
+
+PNames : array[1..MaxTags] of PinNameType =
+(
+(FTag : NullTag; Names : ('Null1','Null2','Null3','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : IRQLogicTag; Names : ('Null1','Null2','Null3','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : WatchdogTag; Names : ('Null1','Null2','Null3','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : IOPortTag; Names : ('Null1','Null2','Null3','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : QCountTag; Names : ('Quad-A','Quad-B','Quad-IDX','Quad-IDXM','Quad-Probe','Null6','Null7','Null8','Null9','Null10')),
+(FTag : MuxedQCountTag; Names : ('MuxQ-A','MuxQ-B','MuxQ-IDX','MuxQ-IDXM','Quad-ProbeM','Null6','Null7','Null8'
+,'Null9','Null10')),
+(FTag : MuxedQCountSelTag; Names : ('MuxSel0','MuxSel1','Null3','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : MuxedQCountMIMTag; Names : ('MuxQ-A','MuxQ-B','MuxQ-IDX','MuxQ-IDXM','Quad-ProbeM','Null6','Null7','Null8'
+,'Null9','Null10')),
+(FTag : MuxedQCountSelMIMTag; Names : ('MuxSel0','MuxSel1','Null3','Null4','Null5','Null6','Null7','Null8'
+,'Null9','Null10')),
+(FTag : StepGenTag; Names : ('Step','Dir','Table3','Table4','Table5','Table6','SGindex','SGProbe'
+,'Null9','Null10')),
+(FTag : PWMTag; Names :     ('PWM','Dir','/Enable','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : TPPWMTag; Names :   ('PWMA','PWMB','PWMC','NPWMA','NPWMB','NPWMC','/ENA','FAULT','Null9','Null10')),
+(FTag : WaveGenTag; Names : ('PDMA','PDMB','Trig0','Trig1','Trig2','Trig3','Null7','Null8','Null9','Null10')),
+(FTag : DAQFIFOTag; Names : ('Data','Strobe','Full','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : SSDATag; Names :    ('ICK','DI','ILD','SY','SClk','SData','Null7','Null8','Null9','Null10')),
+(FTag : BinOscTag; Names : ('OscOut','Null2','Null3','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : DMDMATag; Names : ('Null1','Null2','Null3','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : BISSTag; Names : ('Clock','ClockEn','Data','DAv','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : FAbsTag; Names : ('Req','ReqEn','Data','DAv','TestClk','Null6','Null7','Null8','Null9','Null10')),
+(FTag : ResModTag; Names : ('PwrEn','PDMP','PDMM','ADChan0','ADChan1','ADChan2','SPICS','SPIClk','SPIDI0','SPIDI1')),
+(FTag : SSerialTag; Names : ('RXData','TXData','TXEn','TestPin','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : TwiddlerTag; Names : ('InBit','IOBit','OutBit','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : SPITag; Names :     ('/Frame','DOut','SClk','DIn','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : BSPITag; Names :    ('/Frame','DOut','SClk','DIn','CS0','CS1','CS2','CS3','Null9','Null10')),
+(FTag : DBSPITag; Names :   ('Null1','DOut','SClk','DIn','/CS-FRM0','/CS-FRM1','/CS-FRM2','/CS-FRM3','Null9','Null10')),
+(FTag : DPLLTag; Names :    ('Syncin','RefOut','Timer1','Timer2','Timer3','Timer4','Null7','Null8','Null9','Null10')),
+(FTag : SSITag; Names :     ('SClk','SClkEn','Data','DAv','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : UARTTXTag; Names :  ('TXData','TXEna','Null3','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : UARTRXTag; Names :  ('RXData','Null2','Null3','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : PktUARTTXTag; Names :  ('TXData','TXEna','Null3','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : PktUARTRXTag; Names :  ('RXData','Null2','Null3','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : AddrxTag; Names :   ('Null1','Null2','Null3','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : LEDTag; Names :     ('Null1','Null2','Null3','Null4','Null5','Null6','Null7','Null8','Null9','Null10')));
+
+PNamesXML : array[1..MaxTags] of PinNameType =
+(
+(FTag : NullTag; Names : ('Null1','Null2','Null3','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : IRQLogicTag; Names : ('Null1','Null2','Null3','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : WatchdogTag; Names : ('Null1','Null2','Null3','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : IOPortTag; Names : ('Null1','Null2','Null3','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : QCountTag; Names : ('Phase A','Phase B','Index','Quad-IDXM','Quad-Probe','Null6','Null7','Null8','Null9','Null10')),
+(FTag : MuxedQCountTag; Names : ('Muxed Phase A','Muxed Phase B','Muxed Index','MuxQ-IDXM',
+'Quad-ProbeM','Null6','Null7','Null8','Null9','Null10')),
+(FTag : MuxedQCountSelTag; Names : ('Muxed Encoder Select 0','Muxed Encoder select 1','Null3','Null4',
+'Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : MuxedQCountMIMTag; Names : ('MuxQ-A','MuxQ-B','MuxQ-IDX','MuxQ-IDXM','Quad-ProbeM','Null6','Null7','Null8'
+,'Null9','Null10')),
+(FTag : MuxedQCountSelMIMTag; Names : ('MuxSel0','MuxSel1','Null3','Null4','Null5','Null6','Null7','Null8'
+,'Null9','Null10')),
+(FTag : StepGenTag; Names : ('Step','Dir','Table3','Table4','Table5','Table6','SGindex','SGProbe'
+,'Null9','Null10')),
+(FTag : PWMTag; Names :     ('PWM/Up','Dir/Down','/Enable','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : TPPWMTag; Names :   ('PWMA','PWMB','PWMC','NPWMA','NPWMB','NPWMC','/ENA','FAULT','Null9','Null10')),
+(FTag : WaveGenTag; Names : ('PDMA','PDMB','Trig0','Trig1','Trig2','Trig3','Null7','Null8','Null9','Null10')),
+(FTag : DAQFIFOTag; Names : ('Data','Strobe','Full','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : SSDATag; Names :    ('ICK','DI','ILD','SY','SClk','SData','Null7','Null8','Null9','Null10')),
+(FTag : BinOscTag; Names : ('OscOut','Null2','Null3','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : DMDMATag; Names : ('Null1','Null2','Null3','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : BISSTag; Names : ('Clock','ClockEn','Data','DAv','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : FAbsTag; Names : ('Req','ReqEn','Data','DAv','TestClk','Null6','Null7','Null8','Null9','Null10')),
+(FTag : ResModTag; Names : ('PwrEn','PDMP','PDMM','ADChan0','ADChan1','ADChan2','SPICS','SPIClk','SPIDI0','SPIDI1')),
+(FTag : SSerialTag; Names : ('RXData','TXData','TXEn','TestPin','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : TwiddlerTag; Names : ('InBit','IOBit','OutBit','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : SPITag; Names :     ('/Frame','DOut','SClk','DIn','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : BSPITag; Names :    ('/Frame','DOut','SClk','DIn','CS0','CS1','CS2','CS3','Null9','Null10')),
+(FTag : DBSPITag; Names :   ('Null1','DOut','SClk','DIn','/CS-FRM0','/CS-FRM1','/CS-FRM2','/CS-FRM3','Null9','Null10')),
+(FTag : DPLLTag; Names :    ('Syncin','RefOut','Timer1','Timer2','Timer3','Timer4','Null7','Null8','Null9','Null10')),
+(FTag : SSITag; Names :     ('SClk','SClkEn','DIn','DAv','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : UARTTXTag; Names :  ('TXData','TXEna','Null3','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : UARTRXTag; Names :  ('RXData','Null2','Null3','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : PktUARTTXTag; Names :  ('TXData','TXEna','Null3','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : PktUARTRXTag; Names :  ('RXData','Null2','Null3','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : AddrxTag; Names :   ('Null1','Null2','Null3','Null4','Null5','Null6','Null7','Null8','Null9','Null10')),
+(FTag : LEDTag; Names :     ('Null1','Null2','Null3','Null4','Null5','Null6','Null7','Null8','Null9','Null10')));
+
+ConnectorNames : ConnectorNamesType =
+(
+(BoardName : BoardName4I65; ConName : ('P1','P3','P4','Null1','Null2','Null3')),
+(BoardName : BoardName4I68; ConName : ('P1','P2','P3','Null1','Null2','Null3')),
+(BoardName : BoardName4I69; ConName : ('P1','P3','P4','Null1','Null2','Null3')),
+(BoardName : BoardName4I74; ConName : ('PX','PY','PZ','Null1','Null2','Null3')),
+(BoardName : BoardName5I20; ConName : ('P2','P3','P4','Null1','Null2','Null3')),
+(BoardName : BoardName5I22; ConName : ('P2','P3','P4','P5','Null1','Null2')),
+(BoardName : BoardName5I23; ConName : ('P2','P3','P4','Null1','Null2','Null3')),
+(BoardName : BoardName5I24; ConName : ('P2','P3','P4','Null1','Null2','Null3')),
+(BoardName : BoardName5I25; ConName : ('P3','P2','Null1','Null2','Null3','Null4')),
+(BoardName : BoardName6I25; ConName : ('P3','P2','Null1','Null2','Null3','Null4')),
+(BoardName : BoardName7I43; ConName : ('P4','P3','Null1','Null2','Null3','Null4')),
+(BoardName : BoardName7I90; ConName : ('P1','P2','P3','Null2','Null3','Null4')),
+(BoardName : BoardName7I80; ConName : ('P1','P2','P3','Null2','Null3','Null4')),
+(BoardName : BoardName7I80; ConName : ('P1','P2','P3','P4','Null3','Null4')),
+(BoardName : BoardName7I60; ConName : ('P7','P8','P5','P4','Null1','Null3')),
+(BoardName : BoardName3X20; ConName : ('P4','P5','P6','P9','P8','P7')));
+
+var
+Modules : ModuleType;
+PinDescs : PinDescType;
+PinDescsAsArray : PinDescAsArrayType;
+IDROMOffset : longint;
+ModuleOffset : longint;
+PinDescOffset : longint;
+IDROMAsArray : IDROMAsArrayType;
+IDROMHeaderAsArray : IDROMHeaderAsArrayType;
+ModulesAsArray : ModulesAsArrayType;
+IDROMHeader : IDROMHeaderType;
+ClockLow : longint;
+ClockHigh : longint;
+Outputmasks : array[0..MaxConns-1] of longint;

5i24/utils/dos/source/HM2LOW.PAS

@@ -0,0 +1,161 @@
+{$I HM2ID.pas}
+
+procedure FillHM2Array;
+var
+data,index : longint;
+connector,pin : byte;
+begin
+  data := Read32(HM2CookieOffset);
+  if data <> HM2Cookie then
+  begin
+    Writeln('No HM2 Hardware Found');
+    halt(2);
+  end;
+  data := Read32(IDROMPointer);
+  IDROMOffset := data;
+  for index := 0 to IDROMSize-1 do
+  begin
+    data := Read32(IDROMOffset+index*4);
+    IDROMAsArray[index] := data
+  end;
+  for index := 0 to IDROMHeaderSize-1 do
+  begin
+    IDROMHeaderAsArray[index] := IDROMAsArray[index];
+  end;
+  IDROMHeader := IDROMHeaderType(IDROMHeaderAsArray);
+  ModuleOffset := IDROMHeader.ModulePointer div 4;
+  PinDescOffset := IDROMHeader.PinDescPointer div 4;
+end;
+
+procedure MakeOutputMasks(ourgtag : byte;ourchan : byte);
+var
+index : word;
+mask : longint;
+maskptr : word;
+begin
+  for index := 0 to MaxPins-1 do
+  begin
+    PinDescsAsArray[index] := IDROMAsArray[index+PinDescOffset];
+  end;
+  PinDescs := PinDescType(PinDescsAsArray);
+  for index := 1 to IDROMHeader.IOWidth do
+  begin
+    with PinDescs[index] do
+    begin
+      {writeln(Gtag,' ',Pnumber);}
+      if ((index-1) mod IDROMHeader.PortWidth) = 0 then mask := 1;
+      if (GTag = ourgtag) and (Chan = ourchan) and (Pnumber and byte(OutputMarker) <> 0) then
+      begin
+        maskptr := (index-1) div IDROMHeader.PortWidth;
+        OutputMasks[maskptr] := OutputMasks[maskptr] or mask;
+      end;
+    end;
+    mask := mask shl 1;
+  end;
+end;
+
+procedure SetAllHM2OutputMasks;
+var
+index : word;
+mask : longint;
+maskptr : word;
+begin
+  for index := 0 to MaxPins-1 do
+  begin
+    PinDescsAsArray[index] := IDROMAsArray[index+PinDescOffset];
+  end;
+  PinDescs := PinDescType(PinDescsAsArray);
+  for index := 1 to IDROMHeader.IOWidth do
+  begin
+    with PinDescs[index] do
+    begin
+      if ((index-1) mod IDROMHeader.PortWidth) = 0 then mask := 1;
+      if (Pnumber and byte(OutputMarker) <> 0) then
+      begin
+        maskptr := (index-1) div IDROMHeader.PortWidth;
+        OutputMasks[maskptr] := OutputMasks[maskptr] or mask;
+      end;
+    end;
+    mask := mask shl 1;
+  end;
+end;
+
+procedure UpdateAllHM2OutputMasks;
+var
+index : word;
+begin
+  for index := 0 to MaxConns -1 do
+  begin
+    if OutputMasks[index] <> 0 then
+    begin
+      Write32($1100+index*4,OutputMasks[index]); { ddr }
+      Write32($1200+index*4,OutputMasks[index]); { altsource }
+    end;
+  end;
+end;
+
+procedure ZeroMasks;
+var index : word;
+begin
+  for index := 0 to MaxConns -1 do OutputMasks[index] := 0;
+end;
+
+function GetModuleInfo(module : byte; var base : word; var numregs : byte) : boolean;
+var
+foundit : boolean;
+index : word;
+begin
+  foundit := false;
+  base := 0;
+  numregs := 0;
+  for index := 0 to MaxModules*3 -1 do
+  begin
+    ModulesAsArray[index] := IDROMAsArray[index+ModuleOffset];
+  end;
+  Modules := ModuleType(ModulesAsArray);
+  for index := 0 to MaxModules -1 do
+  begin
+    if Modules[index].GTag = module then
+    begin
+      foundit := true;
+      base := Modules[index].BaseAddr;
+      numregs := Modules[index].NumRegisters;
+    end;
+  end;
+  GetModuleInfo := foundit;
+end;
+
+function GetModuleStrides(module : byte; var regstride : word; var inststride : word) : boolean;
+var
+foundit : boolean;
+mstrides : byte;
+index : word;
+begin
+  foundit := false;
+  inststride := 0;
+  regstride := 0;
+  for index := 0 to MaxModules*3 -1 do
+  begin
+    ModulesAsArray[index] := IDROMAsArray[index+ModuleOffset];
+  end;
+  Modules := ModuleType(ModulesAsArray);
+  for index := 0 to MaxModules -1 do
+  begin
+    if Modules[index].GTag = module then
+    begin
+      foundit := true;
+      mstrides := Modules[index].Strides;
+    end;
+  end;
+  if (mstrides and $0F) = 0 then
+    regstride := IDROMHeader.RegStride0
+  else
+    regstride := IDROMHeader.RegStride1;
+  if (mstrides and $F0) = 0 then
+    inststride := IDROMHeader.InstStride0
+  else
+    inststride := IDROMHeader.InstStride1;
+
+  GetModuleStrides := foundit;
+end;
+

5i24/utils/dos/source/HPRINT.PAS

@@ -0,0 +1,32 @@
+procedure HexPrint(theData : longint; nibbles : byte);
+var
+shiftCount : integer;
+const
+hexChars : array[0..15] of char = ('0','1','2','3','4','5','6','7',
+                                   '8','9','A','B','C','D','E','F');
+begin
+shiftCount := (nibbles * 4) -4;
+  while shiftCount >= 0 do
+  begin
+    write(hexChars[((thedata shr shiftCount) and $000F)]);
+    shiftCount := shiftCount - 4;
+  end;
+end;
+
+function HexString(theData : longint; nibbles : byte) : string;
+var
+shiftCount : integer;
+s : string;
+const
+hexChars : array[0..15] of char = ('0','1','2','3','4','5','6','7',
+                                   '8','9','A','B','C','D','E','F');
+begin
+  s := '';
+  shiftCount := (nibbles * 4) -4;
+  while shiftCount >= 0 do
+  begin
+    s:=s+(hexChars[((thedata shr shiftCount) and $000F)]);
+    shiftCount := shiftCount - 4;
+  end;
+  HexString := s;
+end;

5i24/utils/dos/source/HREAD.PAS

@@ -0,0 +1,192 @@
+type HRDoubleIntRec = record
+  Word0  : word;
+  Word1  : word;
+  Word2  : word;
+  Word3  : word;
+end;
+
+
+type HRDoublelongRec = record
+  long0  : longint;
+  long1  : longint;
+end;
+
+function HexWordRead(hexstring : string; var hexnumber : word): boolean;
+var
+hindex : byte;
+charVal : integer;
+{placeVal : integer;}
+validhex : boolean;
+const
+hexChars : string = '0123456789ABCDEF';
+begin
+  hexNumber :=0;
+  validhex := true;
+  for hindex := 1 to length(hexstring) do
+  begin
+    if validhex then hexNumber := HexNumber * $10;
+    charval := pos(upcase(hexstring[hindex]),hexChars) -1;
+    if charval < 0 then
+    begin
+      validhex := false;
+    end
+    else
+    begin
+      hexnumber := hexnumber + charVal;
+    end;
+  end;
+  HexWordRead := validhex;
+end;
+
+function HexByteRead(hexstring : string; var hexnumber : byte): boolean;
+var
+hindex : byte;
+charVal : integer;
+{placeVal : integer;}
+validhex : boolean;
+const
+hexChars : string = '0123456789ABCDEF';
+begin
+  hexNumber :=0;
+  validhex := true;
+  for hindex := 1 to length(hexstring) do
+  begin
+    if validhex then hexNumber := HexNumber * $10;
+    charval := pos(upcase(hexstring[hindex]),hexChars) -1;
+    if charval < 0 then
+    begin
+      validhex := false;
+    end
+    else
+    begin
+      hexnumber := hexnumber + charVal;
+    end;
+  end;
+  HexByteRead := validhex;
+end;
+
+function HexLongRead(hexstring : string; var hexnumber : longint): boolean;
+var
+hindex : byte;
+charVal : integer;
+validhex : boolean;
+const
+hexChars : string = '0123456789ABCDEF';
+begin
+  hexNumber :=0;
+  validhex := true;
+  for hindex := 1 to length(hexstring) do
+  begin
+    hexNumber := HexNumber * $10;
+    charval := pos(upcase(hexstring[hindex]),hexChars) -1;
+    if charval < 0 then
+    begin
+      validhex := false;
+    end
+    else
+    begin
+      hexnumber := hexnumber + charVal;
+    end;
+  end;
+  HexLongRead := validhex;
+end;
+{$IFDEF COPROC}
+function FPHexDoubleRead(hexstring : string; var hexnumber : comp): boolean;
+var
+hindex : byte;
+charVal : integer;
+validhex : boolean;
+const
+hexChars : string = '0123456789ABCDEF';
+begin
+  hexNumber :=0;
+  validhex := true;
+  for hindex := 1 to length(hexstring) do
+  begin
+    hexNumber := hexnumber * $10;
+    charval := pos(upcase(hexstring[hindex]),hexChars) -1;
+    if charval < 0 then
+    begin
+      validhex := false;
+    end
+    else
+    begin
+      hexnumber := hexnumber + charVal;
+    end;
+  end;
+
+  FPHexDoubleRead := validhex;
+end;
+function HexDoubleRead(hexstring : string; var hexnumber : comp): boolean;
+var
+word0,word1,word2,word3 : word;
+hindex,index : byte;
+charVal : word;
+validhex : boolean;
+const
+hexChars : string = '0123456789ABCDEF';
+begin
+  hexNumber := 0;
+  word0 := 0;
+  word1 := 0;
+  word2 := 0;
+  word3 := 0;
+  validhex := true;
+  for hindex := length(hexstring) downto 1 do
+  begin
+    index := length(hexstring) - hindex + 1;
+    charval := pos(upcase(hexstring[hindex]),hexChars) -1;
+    if charval < 0 then validhex := false;
+    case index of
+      1  : Word0 := word0 + (charval * $1   );
+      2  : Word0 := Word0 + (charval * $10  );
+      3  : Word0 := Word0 + (charval * $100 );
+      4  : Word0 := Word0 + (charval * $1000);
+      5  : Word1 := word1 + (charval * $1   );
+      6  : Word1 := Word1 + (charval * $10);
+      7  : Word1 := Word1 + (charval * $100);
+      8  : Word1 := Word1 + (charval * $1000);
+      9  : Word2 := word2 + (charval * $1   );
+      10 : Word2 := Word2 + (charval * $10);
+      11 : Word2 := Word2 + (charval * $100);
+      12 : Word2 := Word2 + (charval * $1000);
+      13 : Word3 := word3 + (charval * $1   );
+      14 : Word3 := Word3 + (charval * $10  );
+      15 : Word3 := Word3 + (charval * $100 );
+      16 : Word3 := Word3 + (charval * $1000);
+    end;
+  end;
+  HRDoubleIntRec(HexNumber).Word0  := word0;
+  HRDoubleIntRec(HexNumber).Word1  := word1;
+  HRDoubleIntRec(HexNumber).Word2  := word2;
+  HRDoubleIntRec(HexNumber).Word3  := word3;
+  HexDoubleRead := validhex;
+end;
+
+function BugHexDoubleRead(hexstring : string; var hexnumber : comp): boolean;
+{can't set msb}
+var
+hindex : byte;
+charVal : integer;
+validhex : boolean;
+const
+hexChars : string = '0123456789ABCDEF';
+begin
+  hexNumber :=0;
+  validhex := true;
+  for hindex := 1 to length(hexstring) do
+  begin
+    hexNumber := HexNumber * $10;
+    charval := pos(upcase(hexstring[hindex]),hexChars) -1;
+    if charval < 0 then
+    begin
+      validhex := false;
+    end
+    else
+    begin
+      hexnumber := hexnumber + charVal;
+    end;
+  end;
+  BugHexDoubleRead := validhex;
+end;
+{$ENDIF}

5i24/utils/dos/source/LBP.PAS

@@ -0,0 +1,106 @@
+const
+{ Little Binary Protocol }
+{ Copyright (C) 2008 MESA Electronics.  All rights reserved. }
+{ TOKEN			VALUE	TYPE	FUNCTION }
+{ Direct }
+LBPADDDATA_byte          =      $0;             { Address or Data }
+LBPCOMMAND_byte          =      $40;            { Command function }
+LBPWRITE_byte            =      $20;            { Write command }
+LBPD1_byte               =      $0;             { One byte data }
+LBPD2_byte               =      $1;             { Two byte data }
+LBPD4_byte               =      $2;             { Four byte data }
+LBPD8_byte               =      $3;             { Eight byte data }
+LBPA0_byte               =      $0;             { No address included, Last address used }
+LBPA2_byte               =      $4;             { Two byte address included }
+LBPINC_byte              =      $8;             { Increment address }
+LBPRPCINCDATA_byte       =      $10;            { Write includes data within RPC }
+{ FIFO Wait token for FIFO with timeout }
+LBPFIFO_byte             =      $50;            { FIFO command }
+LBPQRH_byte              =      $0;             { Wait for Queued Readback FIFO half full }
+LBPQRE_byte              =      $1;             { Wait for Queued Readback FIFO not empty }
+LBPIRH_byte              =      $2;             { Wait for Immediate Readback FIFO half full }
+LBPIRE_byte              =      $3;             { Wait for Immediate Readback FIFO not empty }
+LBPQFH_byte              =      $4;             { Wait for Queued Command/data FIFO not half full }
+LBPQFF_byte              =      $5;             { Wait for Queued Command/data FIFO not full }
+LBPIFH_byte              =      $6;             { Wait for Immediate Command/data FIFO not half full }
+LBPIFF_byte              =      $7;             { Wait for Immediate Command/data FIFO not full }
+{ Rpc }
+LBPRPC_byte              =      $80;            { Rpc commands 0..63 }
+LBPRPCEND_byte           =      $0;             { End of Rpc marker }
+LBPLOCAL_byte            =      $C0;            { LBP Local Functions 0..31 }
+{ LBP Local R/W locations Read at Cx Write at Ex }
+LBPLISTEN_byte           =      $C0;            { Unit to listen }
+LBPSTATUS_byte           =      $C1;            { Error status 0 for no errors }
+LBPENACRC_flag           =      $C2;            { Non-zero to enable CRCs }
+LBPCRCERRS_byte          =      $C3;            { Number of CRC errors }
+{ LBPENASEQ	C4h	%flag	Non-zero to enable Sequence }
+{ LBPSEQ		C5h	%byte	Sequence number }
+LBPREMSWMODE_byte        =      $C6;            { Software mode of remote device }
+LBPREMCLRFAULT_flag      =      $C7;            { Write true to clear faults, false when complete }
+LBPRPCMEM_flag           =      $CA;            { Non-zero to allow access to RPC memory  }
+LBPCHARTIMEOUT_byte      =      $CB;            { Command frame timeout in (n + 1 Milliseconds USB) }
+LBPNONVOL_flag           =      $CC;            { Set to access Non Volatile memory }
+{ LBP Special locations }
+{ Read only }
+LBPCARDNAME0_byte        =      $D0;            { Cardname character0, Read only }
+LBPCARDNAME1_byte        =      $D1;            { Cardname character1, Read only }
+LBPCARDNAME2_byte        =      $D2;            { Cardname character2, Read only }
+LBPCARDNAME3_byte        =      $D3;            { Cardname character3, Read only }
+LBPCAPABILITY_byte       =      $D4;            { Capability bits }
+LBPREMREVISION_byte      =      $D5;            { Software revision of remote device }
+LBPREMHWMODE_byte        =      $D6;            { Hardware Mode of remote device }
+LBPREMFAULT_byte         =      $D7;            { Fault status of remote device }
+LBPADDRESSL_byte         =      $D8;            { Current address Low byte, Read only }
+LBPADDRESSH_byte         =      $D9;            { Current address High byte, Read only }
+LBPVERSION_byte          =      $DA;            { Software Version, Read only }
+LBPUNITID_byte           =      $DB;            { UnitId Read only 	 }
+LBPRPCPITCH_byte         =      $DC;            { RPC pitch, Read only }
+LBPRPCSIZEL_byte         =      $DD;            { RPC Memory size Low byte, Read only }
+LBPRPCSIZEH_byte         =      $DE;            { RPC Memory size High byte, Read only }
+LBPREADCOOKIE_byte       =      $DF;            { Returns 5Ah }
+{ Write only }
+{ LBPSETLOCK0	F0h	%byte	Reset by protected function }
+{ LBPSETLOCK1	F1h	%byte	Reset by protected function }
+{ LBPSETLOCK2	F2h	%byte	Reset by protected function }
+{ LBPSETLOCK3	F3h	%byte	Reset by protected function }
+LBPSETLEDS_byte          =      $F7;            { Set LEDS }
+LBPSETADDRESSL_byte      =      $F8;            { Current address Low byte, Write only }
+LBPSETADDRESSH_byte      =      $F9;            { Current address High byte, Write only }
+LBPADDADDRESS_byte       =      $FA;            { Add byte to Current address, Write only }
+LBPSETUNITID_byte        =      $FD;            { Non-Volatile Listen Unit ID, Write only  }
+LBPPROCRESET_byte        =      $FE;            { Resets processor when 5A hex is written }
+LBPWRITERESET_byte       =      $FF;            { Resets parser }
+LBPFUNCTIONMASK_byte     =      $C0;            
+LBPRWMASK_byte           =      $F0;            
+LBPRPCNUMMASK_byte       =      $3F;            
+LBPLOCALNUMMASK_byte     =      $1F;            
+LBPLOCALSPECIAL_byte     =      $10;            
+LBPFIFOSELMASK_byte      =      $7;             
+LBPRESETCODE_byte        =      $5A;            { Must write this to reset }
+LBPCOOKIECODE_byte       =      $5A;            { Returned by LBPREADCOOKIE }
+LBPTRUE_flag             =      $FF;            { Byte true }
+LBPFALSE_flag            =      $0;             { Byte false }
+{ NonVol types }
+LBPNONVOLEEPROM_byte     =      $1;             
+LBPNONVOLFLASH_byte      =      $2;             
+LBPFLASHERASE_byte       =      $FE;            
+LBPFLASHWRITE_byte       =      $FD;            
+LBPFLASHOFFSET_ptr       =      $8000;          
+LBPFLASHERASESIZE_ptr    =      $8004;          
+LBPFLASHWRITESIZE_ptr    =      $8005;          
+LBPFLASHCOMMIT_ptr       =      $8007;          
+{ Capability codes }
+LBPCRCCAPABLE            =      $1;             
+LBPFIFOCAPABLE           =      $2;             
+LBPEEPROMCAPABLE         =      $4;             
+LBPFLASHCAPABLE          =      $8;             
+LBPINDIRECTCAPABLE       =      $10;            
+{ LBP Status bits }
+LBPCRCERR                =      $1;             
+{ LBPTXCSUMERR		02h	 }
+{ LBPSEQERR		04h }
+LBPWDOGERR               =      $8;             
+LBPBUFFERERR             =      $10;            
+LBPINVALIDADDERR         =      $20;            { Access to protected memory or I/O }
+LBPTIMEOUTERR            =      $40;            { Timeout waiting for complete Command }
+LBPFIFOTIMEOUTERR        =      $80;            { Timeout waiting for FIFO }

5i24/utils/dos/source/M32UART.PAS

@@ -0,0 +1,340 @@
+{ mesa fpga UART 32 BIT }
+{I HM2LOW}
+
+const
+MesaUARTBaseAdd  = $6000;
+
+{ registers }
+MesaUARTRxTxStride   = $10;
+MesaUARTRegStride    = $04;
+
+MesaUARTTxData1      = $00; { 1 byte push }
+MesaUARTTxData2      = $04; { 2 byte push }
+MesaUARTTxData3      = $08; { 3 byte push }
+MesaUARTTxData4      = $0C; { 4 byte push }
+
+MesaUARTRxData1      = $400; { 1 byte pop }
+MesaUARTRxData2      = $404; { 2 byte pop }
+MesaUARTRxData3      = $408; { 3 byte pop }
+MesaUARTRxData4      = $40C; { 4 byte pop }
+
+MesaUARTTxFIFOCount  = $100;
+MesaUARTTxMode       = $300;
+
+MesaUARTRxFIFOCount  = $500;
+MesaUARTRxMode       = $700;
+
+{ setup mode register map }
+MesaUARTTxBitRate    = $200;
+MesaUARTRxBitRate    = $600;
+MesaUARTBitRateMask= $FFFFF; { 20 bits }
+
+MesaUARTRxFIFOSize   = 16; { bytes }
+MesaUARTTxFIFOSize   = 16; { slots }
+MesaUARTNumUARTs     = 8;
+MesaUARTFIFOMask     = $1F;
+
+{ bits }
+MesaUARTTxFIFOError        = $0010; { fifo push overflow }
+MesaUARTTxDriveEnableAuto  = $0020;
+MesaUARTDriveEnableBit     = $0040;
+
+MesaUARTRxFalseStartBit    = $0001;
+MesaUARTRxOverRun          = $0002;
+MesaUARTRxMaskEnableBit    = $0004;
+MesaUARTRxFIFOError        = $0010; { read more than there }
+MesaUARTRxLostData         = $0020;
+MesaUARTRxMask             = $0040;
+MesaUARTRxFIFOHasData      = $0080;
+
+var
+MesaUARTClock : longint;
+
+function BrAccumval(br,bm : real) : longint;
+var  baud : real;
+begin
+  baud := ((br*1048576.0)/MesaUARTClock)/bm;
+  {writeln('MesaUARTClock ',MesaUARTClock);
+  writeln('Braccum ',baud:10:3);}
+  BrAccumval := trunc(baud);
+end;
+
+function RxCharsAvailable : integer;
+var ouraddress : word;
+begin
+  ouraddress :=TheComport*MesaUartRegStride+MesaUARTBaseAdd+MesaUARTRxFIFOCount;
+  RxCharsAvailable := Read32(ouraddress) and MesaUARTFIFOMask;
+end;
+
+function TxSlotsAvailable : integer;
+var ouraddress : word;
+begin
+  ouraddress := TheComport*MesaUartRegStride+MesaUARTBaseAdd+MesaUARTTxFIFOCount;
+  TxSlotsAvailable := MesaUARTTxFIFOSize - (Read32(ouraddress) and MesaUARTFIFOMask);
+end;
+
+procedure MesaSerTossChars(comport : word);
+begin
+  Write32(comport*MesaUartRegStride+MesaUARTBaseAdd+MesaUARTRxFifoCount,0);
+end;
+
+procedure MesaUARTSetBitrate(comPort : word; bitrate : longint);
+begin
+  Write32((comport*MesaUartRegStride)+MesaUARTBaseAdd+MesaUARTTxBitRate,bitrate);
+  Write32((comport*MesaUartRegStride)+MesaUARTBaseAdd+MesaUARTRxBitRate,bitrate);
+end;
+
+procedure MesaUARTGetBitrate(comport : word; var bitrate : longint);
+begin
+  bitrate := MesaUartBitrateMask and Read32((comport*MesaUartRegStride)+MesaUARTBaseAdd+MesaUARTTxBitRate);
+end;
+
+procedure MesaUARTSetBaud(comport : word;br,bm : real);
+begin
+  MesaUARTSetBitrate(comport,BrAccumval(br,bm));
+end;
+
+function MesaBaudRateValid(br,bm : real) : boolean;
+var ourbaud,testbaud,ratio : real;
+value : real;
+begin
+  MesaBaudRateValid := true;
+  ourbaud := br / bm;
+  value := BrAccumval(br,bm);
+  testbaud := MesaUARTClock * value / 65536.0;
+  ratio := ourbaud / testbaud;
+  if (ratio > 1.0) and (ratio > 1.03) then MesaBaudRateValid := false;
+  if (ratio < 1.0) and (ratio < 0.97) then MesaBaudRateValid := false;
+end;
+
+function MesaSerRecvChar(var c : char) : boolean;
+var timeout : longint;
+ouraddress : word;
+begin
+  timeout := CharTimeout;
+  while  ((RxCharsAvailable = 0) and (timeout<>0)) do timeout:=timeout-1;
+  if timeout <> 0 then
+  begin
+    ouraddress := TheComport*MesaUartRxTxStride+MesaUARTBaseAdd+MesaUARTRxData1;
+    c := char(Read32(ouraddress));
+    MesaSerRecvChar := true;
+  end
+  else MesaSerRecvChar := false;
+end;
+
+function MesaSerRecvString(n : integer;var s : string) : boolean;
+var
+count : integer;
+is : string;
+timeout : longint;
+begin
+  timeout := CharTimeout;
+  MesaSerRecvString := false;
+  is := '';
+  while ((RxCharsAvailable < n)  and (timeout<>0))  do timeout:=timeout-1;
+  if timeout <> 0 then
+  begin
+    for count := 1 to n do
+    begin
+      is := is + char(Read32((TheComport*MesaUartRxTxStride)+MesaUARTBaseAdd+MesaUARTRxData1));
+    end;
+    MesaSerRecvString := true;
+  end
+  else for count := 1 to n do is := is + 'E';
+  s := is;
+end;
+
+procedure MesaSerSendChar(c : char);
+begin
+  while MesaUARTTxFIFOSize = Read32((TheComport*MesaUartRegStride)+MesaUARTBaseAdd+MesaUARTTxFIFOCount) do;
+  Write32((TheComport*MesaUartRxTxStride)+MesaUARTBaseAdd+MesaUARTTxData1,word(byte(c)));
+end;
+
+procedure MesaSnailSerSendChar(c : char);
+begin
+  Write32((TheComport*MesaUartRxTxStride)+MesaUARTBaseAdd+MesaUARTTxData1,word(byte(c)));
+end;
+
+procedure MesaSnailSendString(s : string);
+var index : byte;
+begin
+  DisableInterrupts;
+  for index := 1 to length(s) do
+  begin
+    MesaSnailSerSendChar(s[index]);
+  end;
+  EnableInterrupts;
+end;
+
+procedure FastMesaSendString(s : string);
+var len,index,lindex : integer;
+data : longint;
+longs,remains,rem : integer;
+begin
+  DisableInterrupts;
+  len := length(s);
+  longs := len div 4;
+  remains := len mod 4;
+  index := 1;
+  if remains <> 0 then rem := 1 else rem := 0;
+  while TxSlotsAvailable < longs+rem do;
+  for lindex := 1 to longs do
+  begin
+    LongIntByteRec(data).Byte0 := byte(s[index+0]);
+    LongIntByteRec(data).Byte1 := byte(s[index+1]);
+    LongIntByteRec(data).Byte2 := byte(s[index+2]);
+    LongIntByteRec(data).Byte3 := byte(s[index+3]);
+    index := index + 4;
+    Write32((TheComport*MesaUartRxTxStride)+MesaUARTBaseAdd+MesaUARTTxData4,data);
+  end;
+  case remains of
+    3 :
+      begin
+        LongIntByteRec(data).Byte0 := byte(s[index+0]);
+        LongIntByteRec(data).Byte1 := byte(s[index+1]);
+        LongIntByteRec(data).Byte2 := byte(s[index+2]);
+        Write32((TheComport*MesaUartRxTxStride)+MesaUARTBaseAdd+MesaUARTTxData3,data);
+      end;
+    2 :
+      begin
+        LongIntByteRec(data).Byte0 := byte(s[index+0]);
+        LongIntByteRec(data).Byte1 := byte(s[index+1]);
+        Write32((TheComport*MesaUartRxTxStride)+MesaUARTBaseAdd+MesaUARTTxData2,data);
+      end;
+    1 :
+      begin
+        LongIntByteRec(data).Byte0 := byte(s[index+0]);
+        Write32((TheComport*MesaUartRxTxStride)+MesaUARTBaseAdd+MesaUARTTxData1,data);
+      end;
+  end;
+  EnableInterrupts;
+end;
+
+procedure SlowMesaSendString(s : string);
+var len,index,lindex : integer;
+data : longint;
+longs,remains : integer;
+begin
+  DisableInterrupts;
+  len := length(s);
+  longs := len div 4;
+  remains := len mod 4;
+  index := 1;
+  for lindex := 1 to longs do
+  begin
+    while TxSlotsAvailable = 0 do;
+    LongIntByteRec(data).Byte0 := byte(s[index+0]);
+    LongIntByteRec(data).Byte1 := byte(s[index+1]);
+    LongIntByteRec(data).Byte2 := byte(s[index+2]);
+    LongIntByteRec(data).Byte3 := byte(s[index+3]);
+    index := index + 4;
+    Write32((TheComport*MesaUartRxTxStride)+MesaUARTBaseAdd+MesaUARTTxData4,data);
+  end;
+  while TxSlotsAvailable = 0 do;
+  case remains of
+    3 :
+      begin
+        LongIntByteRec(data).Byte0 := byte(s[index+0]);
+        LongIntByteRec(data).Byte1 := byte(s[index+1]);
+        LongIntByteRec(data).Byte2 := byte(s[index+2]);
+        Write32((TheComport*MesaUartRxTxStride)+MesaUARTBaseAdd+MesaUARTTxData3,data);
+      end;
+    2 :
+      begin
+        LongIntByteRec(data).Byte0 := byte(s[index+0]);
+        LongIntByteRec(data).Byte1 := byte(s[index+1]);
+        Write32((TheComport*MesaUartRxTxStride)+MesaUARTBaseAdd+MesaUARTTxData2,data);
+      end;
+    1 :
+      begin
+        LongIntByteRec(data).Byte0 := byte(s[index+0]);
+        Write32((TheComport*MesaUartRxTxStride)+MesaUARTBaseAdd+MesaUARTTxData1,data);
+      end;
+  end;
+  EnableInterrupts;
+end;
+
+procedure MesaSendString(s : string);
+begin
+  if length(s) > 64 then SlowMesaSendString(s) else FastMesaSendString(s);
+end;
+
+procedure oldMesaSendString(s : string);
+var len,i : integer;
+slots : word;
+data : word;
+begin
+  DisableInterrupts;
+  len := length(s);
+  i := 1;
+  while i < (len+1) do
+  begin
+    slots := TXSlotsAvailable;
+    while (slots <> 0) and (i < (len+1)) do
+    begin
+      if len-i > 0 then
+      begin
+        WordRec(data).LowByte := byte(s[i]);
+        i := i + 1;
+        WordRec(data).HighByte := byte(s[i]);
+        i := i + 1;
+        Write32((TheComport*MesaUartRxTxStride)+MesaUARTBaseAdd+MesaUARTTxData2,word(data));
+        slots := slots-1;
+      end
+      else
+      begin
+        WordRec(data).LowByte := byte(s[i]);
+        i := i + 1;
+        Write32((TheComport*MesaUartRxTxStride)+MesaUARTBaseAdd+MesaUARTTxData1,data);
+        slots := slots-1;
+      end;
+    end;
+  end;
+  EnableInterrupts;
+end;
+
+function MesaComportThere(comport : word) : boolean;
+var data : longint;
+ok : boolean;
+index : word;
+begin
+  ok := false;
+  FillHM2Array;
+  MesaUARTClock := Read32(HostMotClockLowOffset);
+  ZeroMasks;
+  MakeOutputMasks(UARTTXTag,comport);
+  for index := 0 to MaxConns -1 do
+  begin
+    if OutputMasks[index] <> 0 then
+    begin
+      Write32($1100+index*4,OutputMasks[index]); { ddr }
+      Write32($1200+index*4,OutputMasks[index]); { altsource }
+      ok := true
+    end;
+  end;
+  MesaComPortThere := ok;
+  { check for uart present }
+end;
+
+procedure MesaSerOpen(TheComport : word; br,bm : real);
+  begin
+    Write32((TheComport*MesaUartRegStride)+MesaUARTBaseAdd+MesaUARTTxMode,MesaUARTDriveEnableBit + $0); { no delay }
+    Write32((TheComport*MesaUartRegStride)+MesaUARTBaseAdd+MesaUARTTxFIFOCount,0); { clear Tx FIFO}
+    MesaSerTossChars(TheComport); { make real sure there are no pending chars }
+    MesaUARTSetBaud(TheComport,br,bm);
+
+    Write32((TheComport*MesaUartRegStride)+MesaUARTBaseAdd+MesaUARTRxMode,$0000); { full duplex }
+end;
+
+function MesaCanRead(ms : integer) : boolean;
+var ctimeout : longint;
+begin
+  if ms <> 0 then
+  begin
+    ctimeout := LoopsPermS * longint(ms);
+    while ((RxCharsAvailable = 0) and (ctimeout <> 0)) do ctimeout := ctimeout -1;
+    if ctimeout <> 0 then MesaCanRead := true else MesaCanRead := false;
+  end
+  else if (RxCharsAvailable <> 0) then MesaCanRead := true else MesaCanRead := false
+end;
+

5i24/utils/dos/source/MESAPCI.PAS

@@ -0,0 +1,9 @@
+const
+MesaVendorID = $2718;
+N4I74DeviceID = $4174;
+N5I24DeviceID = $5124;
+N5I25DeviceID = $5125;
+N6I25DeviceID = $6125;
+
+MesaPCIBaseAddress0 = $10;  { memory access }
+

5i24/utils/dos/source/NMFLASH.PAS

@@ -0,0 +1,501 @@
+program nmflash;
+
+{$IFDEF WINDOWS}
+uses synaser,synautil,synaip,blcksock,dos,crt;
+var
+ser:TBlockSerial;
+TheComPort : string;
+IPAddr : string;
+Socket : TUDPBlockSocket;
+{$ELSE}
+uses dos,crt;
+var TheComPort : word;
+{$ENDIF}
+
+{$I SELECTC}
+{$I SELECTIO}
+{I SELECTP}
+{$I SELECTPR}
+{$I INTERFCE}
+
+const
+DataStride = 4; {bytes}
+
+procedure Error(err : integer);
+begin
+  writeln(errorrecord[err].errstr);
+  halt(2);
+end;
+
+procedure Barfout(es:string);
+begin
+  writeln;
+  writeln(es);
+  halt(2);
+end;
+
+type
+configfile = file;
+
+const
+
+FileBufferSize = 8192;
+PageSize = 256;
+SPICSPort = $70;
+SPISregPort = $74;
+DAVMask = $04;
+FallbackSA = $10000;    { fallback start address is sector 1 }
+BootSA = $00000;        { boot start address is sector 0 }
+BBSize = 64;
+NSAMSBOffset = 25;      { offset of Normal Start Address MS Byte in boot block }
+CBootBlock : array[0..BBSize-1] of byte = ($FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
+                                           $FF,$FF,$AA,$99,$55,$66,$31,$E1,
+                                           $FF,$FF,$32,$61,$00,$00,$32,$81,
+                                           $0B,$08,$32,$A1,$00,$00,$32,$C1,
+                                           $0B,$01,$30,$A1,$00,$00,$33,$01,
+                                           $21,$00,$32,$01,$00,$1F,$30,$A1,
+                                           $00,$0E,$20,$00,$20,$00,$20,$00,
+                                           $20,$00,$20,$00,$20,$00,$20,$00);
+
+var
+BootBlock : array[0..BBSize-1] of byte;
+NormalSA : longint;      { normal start address is 1/2 way up }
+NSAMSB : byte;
+VerifyOnly : boolean;
+CardNumber : word;
+Parms : word;
+StartAddress : longint;
+
+
+FileName : string;
+CFile : configfile;
+CFileSize : longint;
+Timeout : longint;
+Fallback : boolean;
+BBuf: array[0..FileBufferSize-1] of byte;
+
+function OpenForRead(var fp: configfile; name: string): boolean;
+begin
+  Assign(fp,Name);
+  {$I-}
+  Reset(fp,1);
+  {$I+}
+  OpenForRead := IOResult = 0;
+end { Open };
+
+procedure Usage;
+begin
+  writeln;
+  writeln(' NMFLASH - Writes config data to 5I24/5I25/6I25/7I90 EEPROM');
+  writeln;
+  writeln(' USAGE - NMFLASH file  [V]');
+  writeln(' Where file is a VALID FPGA configuration file');
+  writeln(' Trailing V invoke Verify only option');
+  halt(2);
+end;
+
+procedure SetCSHigh;
+begin
+  Write32(BaseAddr+SPICSPort,1);
+end;
+
+procedure SetCSLow;
+begin
+  Write32(BaseAddr+SPICSPort,0);
+end;
+
+function WaitForSPIData : boolean;
+var
+loops: integer;
+data : longint;
+begin
+  data := 0;
+  loops := 0;
+  while ((data and DAVMask) = 0) and (loops < 5000) do
+  begin
+    data := Read32(BaseAddr+SPICSPort);
+    loops := loops +1;
+  end;
+  if loops = 5000 then WaitForSPIData := false else WaitForSPIData := true;
+end;
+
+procedure SendSPIByte( d: byte);
+begin
+  Write32(BaseAddr+SPISRegPort,d);
+  if not WaitForSPIData then BarfOut('Timeout waiting for SPI Shift Register');
+end;
+
+
+function RecvSPIByte(d: byte) : byte;
+var
+data: longint;
+begin
+  Write32(BaseAddr+SPISRegPort,d);
+  if not WaitForSPIData then BarfOut('Timeout waiting for SPI Shift Register');
+  data := Read32(BaseAddr+SPISRegPort);
+  RecvSPIByte := byte(data and $FF);
+end;
+
+
+{$I 25Mlowp.pas }
+
+procedure Dump(sa:longint);
+var
+index : longint;
+
+begin
+  for index := sa to sa+255 do
+  begin
+    if (index and 15) = 0 then
+    begin
+      writeln;
+      Hexprint(index,8);
+      write(': ');
+    end;
+    Hexprint(ReadByte25(index),2);
+    write(' ');
+  end;
+  writeln;
+end;
+
+procedure WriteBlock(add:longint;bufidx:word);
+var
+index : word;
+
+begin
+  WriteEnable25;
+  Prefix25;
+  PutByte25(PageProgCom);
+  PutAddress25(add); { note that add 0..7 should be 0}
+  for index :=  0 to PageSize -1 do
+  begin
+    PutByte25(BBuf[bufidx+index]);
+  end;
+  Suffix25;
+  WaitForWrite25;
+end;
+
+function NextByte(n: byte) : byte;
+var
+index,abyte : byte;
+bytesread : word;
+begin
+  for index := 1 to n do Blockread((CFile),abyte,1,bytesread);
+  NextByte := abyte;
+end;
+
+function ReadString : string;
+var
+sleng,count : word;
+tstring : string;
+abyte: byte;
+begin
+  sleng := NextByte(1) * 256;
+  sleng := sleng + NextByte(1);
+  if (sleng > 255) then sleng := 255;
+  tstring := '';
+  for count := 1 to sleng do
+  begin
+    abyte := NextByte(1);
+    if (abyte <> 0) then tstring := tstring + chr(abyte);
+  end;
+  ReadString := tstring;
+end;
+
+procedure PrintBitFileHeader;
+var
+sleng,bytesread : word;
+tstring : string;
+conflength : longint;
+fbyte : byte;
+ft : (bit,bin,unk);
+begin
+  ft := unk;
+  if (NextByte(1) = 0) then
+  begin
+    if (Nextbyte(1) = 9) then
+    begin
+      writeln('Looks like a BIT file');
+      fbyte := NextByte(9);  {skip over 9 header bytes}
+      if (NextByte(1) = 0) then
+      begin
+        if (NextByte(1) = 1) then
+        begin
+          if (NextByte(1) = $61) then
+          begin
+            writeln('Design name: ',ReadString);
+            fbyte := NextByte(1); {Skip over 'b'}
+            writeln('Part name: ',ReadString);
+            fbyte := NextByte(1); {Skip over 'c'}
+            writeln('Design date: ',ReadString);
+            fbyte := NextByte(1); {Skip over 'd'}
+            writeln('Design time: ',ReadString);
+            fbyte := NextByte(1);; {Skip over 'e'}
+            conflength := longint(NextByte(1))*16777216;
+            conflength := conflength +longint(NextByte(1))*65536;
+            conflength := conflength +longint(NextByte(1))*256;
+            conflength := conflength +longint(NextByte(1));
+            writeln('Config Length: ',conflength);
+            ft := bit;
+          end; {valid bitfile header}
+        end;
+      end;
+    end; {starting to look like a bit file }
+  end; {looks like a bit file}
+  if ft = unk then
+  begin
+    if (NextByte(1) = $FF) and (NextByte(1) = $FF)  and (NextByte(1) = $FF) and  (NextByte(1) = $FF) then
+    begin
+      writeln('Looks like a BIN file');
+      Reset(Cfile,1);
+      ft := bin;
+    end;
+  end;
+  if ft = unk then
+  begin
+    writeln('Invalid bitfile header!');
+    halt(2);
+  end;
+end;
+
+procedure GetParms;
+var
+thefile : string;
+begin
+  Fallback := false;
+  VerifyOnly := false;
+  if ParamCount < 1 then Usage;
+  thefile := paramStr(1);
+  FileName := thefile;
+  if Length(ParamStr(2)) <> 0 then
+  begin
+    if UpString(ParamStr(2)) = 'V' then VerifyOnly := true;
+  end;
+  if Length(ParamStr(3)) <> 0 then
+  begin
+    if UpString(ParamStr(3)) = 'V' then VerifyOnly := true;
+  end;
+  if Length(ParamStr(2)) <> 0 then
+  begin
+    if (ParamStr(2)) = 'FallBack' then Fallback := true;
+  end;
+  if Length(ParamStr(3)) <> 0 then
+  begin
+    if (ParamStr(3)) = 'FallBack' then Fallback := true;
+  end;
+  if not OpenForRead(CFile,FileName) then
+  begin
+    writeln('Can''t open configuration file');
+    halt(2);
+  end;
+end;
+
+procedure IdentifyEEPROM;
+var
+eepromid : byte;
+begin
+  SetCSHigh;
+  eepromid:= ReadID25;
+  if (eepromid <> OneMegID) and (eepromid <> TwoMegID) and
+     (eepromid <> FourMegID) and (eepromid <> EightMegID) and
+     (eepromid <> SixteenMegID) then
+  begin
+    write('Bad EEPROM ID, expected ');
+    HexPrint(FourMegID,2);
+    write(' or ');
+    HexPrint(EightMegID,2);
+    write(' or ');
+    HexPrint(SixteenMegID,2);
+    write(' but got ');
+    HexPrint(eepromid,2);
+    writeln;
+    halt(2);
+  end;
+  if eepromid = FourMegID then
+  begin
+    writeln('4M Bit EEPROM Found');
+    NormalSA := $40000;
+  end;
+  if eepromid = EightMegID then
+  begin
+    writeln('8M Bit EEPROM Found');
+    NormalSA := $80000;
+  end;
+  if eepromid = SixteenMegID then
+  begin
+    writeln('16M Bit EEPROM Found');
+    NormalSA := $100000;
+  end;
+  NSAMSB := (NormalSA shr 16);
+end;
+
+procedure MakeBootBlock;
+var index : word;
+begin
+  for index := 0 to BBSize -1 do BootBlock[index] := CBootBlock[index];
+  BootBlock[NSAMSBOffset] := NSAMSB;  { insert top address byte to match EEPROM size }
+end;
+
+procedure StartProgramming(sa: longint);
+var
+sectorsize,esectors,sector,secadd,esspace : longint;
+begin
+  SetCSHigh;
+  sectorsize := 65536;
+  esspace := (NormalSA div sectorsize);
+  if sa = FallBackSA then esspace := esspace - 1;
+  writeln('About to erase EEPROM sectors =>  ');
+  esectors := (CFilesize-1) div sectorsize;
+  if esectors > esspace then BarfOut('File Size too large to fit');
+  secadd := sa;
+  for sector := 0 to esectors do
+  begin
+    EraseSector25(secadd);
+    secadd := secadd + sectorsize;
+    write('Sector ',sector+(sa div sectorsize),' erased   ',chr(13));
+  end;
+  writeln;
+  if sa = FallBackSA then
+     writeln('Fallback area of EEPROM erased')
+  else
+     writeln('Configuration area of EEPROM erased');
+  SetCSHigh;
+end;
+
+procedure DoneProgramming;
+begin
+  SetCSHigh;
+end;
+
+procedure VerifyIt;
+var
+index,bindex : longint;
+bytesread : word;
+rdata : byte;
+begin
+  if OpenForRead(CFile,FileName) then
+  begin
+    IdentifyEEPROM;
+    reset(CFile,1);
+    CFileSize := FileSize(CFile);
+    PrintBitFileHeader;
+    if Fallback then index := FallbackSA else index := NormalSA;
+    while not EOF(CFile) do
+    begin
+      bytesread := 0;
+      blockread(CFile,BBuf,FileBufferSize,bytesread);
+      bindex := 0;
+      while bindex < bytesread do
+      begin
+        rdata := ReadByte25(bindex+index);
+        if BBuf[bindex] <> rdata then
+        begin
+          write('Error at ');
+          HexPrint(index+bindex,8);
+          write(' expected: ');
+          Hexprint(BBuf[bindex],2);
+          write(' but read: ');
+          HexPrint(rdata,2);
+          writeln;
+          dump(bindex+index);
+          halt(2);
+        end;
+        bindex := bindex + 1;
+      end;
+    index := index + FileBufferSize;
+    write('V ');
+    end;
+  end
+  else
+  begin
+    writeln('Can''t open configuration file');
+    halt(2);
+  end;
+end;
+
+procedure WriteBoot;
+var index : word;
+begin
+  writeln('Erasing sector 0 for boot block');
+  EraseSector25(BootSA);
+  for index := 0 to BBSize -1 do BBuf[index] := BootBlock[index];
+  for index := BBsize to PageSize-1 do BBuf[index] := 0;
+  WriteBlock(0,0);
+  writeln('BootBlock installed');
+end;
+
+function CheckBoot : boolean;
+var
+index : longint;
+bootok: boolean;
+begin
+  bootok := true;
+  for index := 0 to BBSize -1 do
+  begin
+    if ReadByte25(index) <> BootBlock[index] then bootok := false;
+  end;
+  CheckBoot := bootok;
+end;
+
+
+procedure WriteIt;
+var
+cbyte : byte;
+bytesread,index : word;
+bytecount : longint;
+eepromadd : longint;
+begin
+  if OpenForRead(CFile,FileName) then
+  begin
+    IdentifyEEPROM;
+    MakeBootBlock;
+    if not CheckBoot then WriteBoot else writeln('BootSector OK');
+    if not CheckBoot then  BarfOut('Failed to write valid boot sector');
+    reset(CFile,1);
+    CFileSize := FileSize(CFile);
+    PrintBitfileHeader;
+    if Fallback then
+    begin
+      StartAddress := FallbackSA;
+      writeln('Writing fallback configuration');
+    end
+    else
+    begin
+      StartAddress := NormalSA;
+      writeln('Writing user configuration');
+    end;
+    StartProgramming(StartAddress);
+    writeln(':');
+    eepromadd:= StartAddress;
+    while not EOF(CFile) do
+    begin
+      bytesread := 0;
+      blockread(CFile,BBuf,FileBufferSize,bytesread);
+      index := 0;
+      write('W ');
+      while index < bytesread do
+      begin
+        WriteBlock(eepromadd,index);
+        index := index + PageSize;
+        eepromadd := eepromadd + Pagesize;
+      end;
+    end;
+  end
+  else
+  begin
+    writeln('Can''t open configuration file');
+    halt(2);
+  end;
+  writeln;
+  DoneProgramming;
+end;
+
+begin
+  GetParms;
+  GetOurEnv;
+  if not InitializeInterface(message) then bumout(message);
+  if VerifyOnly then VerifyIt else WriteIt;
+  writeln('Done');
+  CloseInterface;
+  halt(0);
+end.

5i24/utils/dos/source/PARSEP.PAS

@@ -0,0 +1,144 @@
+
+function PadWithSpaces(sstring: string;padlength : integer): string;
+var
+tstring : string;
+index : byte;
+tooshort : integer;
+
+begin
+  tstring := sstring;
+  tooshort := padlength - length(sstring);
+  if tooshort > 0 then
+  begin
+    for index := 1 to tooshort do tstring := tstring + ' ';
+  end;
+  PadWithSpaces := tstring;
+end;
+
+procedure StripLeadingBlanks(var st: string);
+begin
+  while (((st[1] =' ') or (st[1] = chr(9))) and (length(st) >0)) do delete(st,1,1);
+end { StripLeadingBlanks };
+
+procedure StripLeadingChar(var st: string;achar :char);
+begin
+  while ((st[1] = achar) and (length(st) >0)) do delete(st,1,1);
+end { StripLeadingChar };
+
+procedure StripTrailingBlanks(var st: string);
+begin
+  while (copy(st,length(st),1)=' ') or (copy(st,length(st),1)=chr(9)) do delete(st,length(st),1);
+end { StripTraiLingBlanks };
+
+function ScanTillWhite(astr : string) : byte;
+{ returns pos preceding first white space found, returns 0 for zero }
+{ length string, or string length if no white space is found        }
+var index,len : byte;
+begin
+  index := 0;
+  len := length(astr);
+  if len > 0 then
+  begin
+    while (astr[index +1] <> chr(32)) and (astr[index +1] <> chr(09)) and (index < len) do
+    begin
+      index := index +1;
+    end;
+  end;
+  ScanTillWhite := index;
+end;
+
+function ScanTillChar(astr : string; achar : char) : byte;
+{ returns pos preceding first white space found, returns 0 for zero }
+{ length string, or string length if no white space is found        }
+var index,len : byte;
+begin
+  index := 0;
+  len := length(astr);
+  if len > 0 then
+  begin
+    while (astr[index +1] <> achar) and (index < len) do
+    begin
+      index := index +1;
+    end;
+  end;
+  ScanTillchar := index;
+end;
+
+function Strip(var rest: string): string;
+var
+first: string;
+endst: integer;
+begin
+  StripLeadingBlanks(rest);
+  endst := ScanTillWhite(rest);              { find position of first white space }
+  first := copy(rest,1,endst);               { copy until white space or end }
+  rest := copy(rest,endst+1,length(rest));   { delete stripped from rest }
+  Strip := first;
+end  { Strip };
+
+function StripTillChar(var rest : string;achar : char): string;
+var
+first: string;
+endst: integer;
+begin
+  StripLeadingChar(rest,achar);
+  endst := ScanTillChar(rest,achar);         { find position of first achar}
+  first := copy(rest,1,endst);               { copy until next achar or end }
+  rest := copy(rest,endst+1,length(rest));   { delete stripped from rest }
+  StripTillChar := first;
+end  { StripTillChar };
+
+function LowCase(c:char) : char;
+var ourb : byte;
+begin
+  ourb := byte(c);
+  if (ourb >64) and (ourb <= 90) then ourb := ourb + 32;
+  LowCase := char(ourb);
+end;
+
+function UpString(s:string) : string;
+var
+index : byte;
+begin
+  for index := 1 to length(s) do
+  s[index] := upcase(s[index]);
+  UpString := s;
+end;
+
+function LowString(s:string) : string;
+var
+index : byte;
+begin
+  for index := 1 to length(s) do
+  s[index] := LowCase(s[index]);
+  LowString := s;
+end;
+
+function StripNumber( var astring : string): integer;
+var
+index : byte;
+returnvar : integer;
+retcode : integer;
+begin
+  index := 1;
+  while ((astring[index] >= '0') and (astring[index] <= '9'))  do
+  begin
+    index := index + 1;
+  end;
+  val(copy(astring,1,index-1),returnvar,retcode);
+  astring := copy(astring,index,length(astring)-(index-1));
+  StripNumber := returnvar
+end { StripNumber };
+
+function StripLetter( var astring : string): string;
+var
+index : integer;
+begin
+  index := 1;
+  while ((astring[index] < '0') or (astring[index] > '9'))  do
+  begin
+    index := index + 1;
+  end;
+  StripLetter := copy(astring,1,index-1);
+  astring := copy(astring,index,length(astring)-(index-1));
+end { StripLetter };

5i24/utils/dos/source/PCI.PAS

@@ -0,0 +1,138 @@
+const
+{PCI function identifier in AH }
+
+PCI_Function_ID : byte = $B1;
+
+{ PCI function number in AL }
+
+PCI_BIOS_Present : byte = $01;
+PCI_Find_PCI_Device : byte = $02;
+PCI_Find_PCI_ClassCode : byte = $03;
+PCI_Generate_Special_Cycle : byte = $06;
+PCI_Read_Config_Byte : byte = $08;
+PCI_Read_Config_Word : byte = $09;
+PCI_Read_Config_DWord : byte = $0A;
+PCI_Write_Config_Byte : byte = $0B;
+PCI_Write_Config_Word : byte = $0C;
+PCI_Write_Config_DWord : byte = $0D;
+PCI_Get_IRQ_Routing_Options : byte = $0E;
+PCI_Set_PCI_IRQ : byte = $0F;
+
+{ function results in AH }
+
+PCI_Result_Successful : byte = $00;
+PCI_Function_Not_Supported : byte = $81;
+PCI_Bad_Vendor_ID : byte = $83;
+PCI_Device_Not_Found : byte = $86;
+PCI_Bad_Register_Number : byte = $87;
+PCI_Set_Failed : byte = $88;
+PCI_Buffer_Too_Small : byte = $89;
+
+PCIStr : word = $4350; {'CP'}
+
+{PCI Command register bits }
+PCICommandRegOffset = 4;
+PCICommandRegIOEnable : word = $0001;
+PCICommandRegMEMEnable : word = $0002;
+PCICommandRegMasterEnable : word = $0004;
+
+function PCIBIOSPresent : boolean;
+var flag : boolean;
+begin
+  asm
+    mov ah,PCI_Function_ID
+    mov al,PCI_BIOS_Present
+    int $1A
+    mov flag,false;
+    or  ah,ah
+    jnz @exit
+    cmp dx,PCIStr;
+    jnz @exit
+    mov flag,true
+    @exit:
+  end;
+  PCIBIOSPresent := flag;
+end;
+
+function FindPCIDevice(deviceid,vendorid,index : word;var busnum,devnum: byte) : boolean;
+var
+flag : boolean;
+lbusnum,ldevnum : byte;
+
+begin
+  asm
+    mov ah,PCI_Function_ID
+    mov al,PCI_Find_PCI_Device
+    mov cx,deviceid
+    mov dx,vendorid
+    mov si,index
+    int $1A
+    mov flag,false;
+    or  ah,ah
+    jnz @exit
+    mov lbusnum,bh
+    mov ldevnum,bl
+    mov flag,true
+    @exit:
+  end;
+  busnum := lbusnum;
+  devnum := ldevnum;
+  FindPCIDevice := flag;
+end;
+
+function ReadPCIConfigWord(busnum,devnum: byte;regnum:word; var configdata :word) : boolean;
+var
+flag : boolean;
+lbusnum,ldevnum : byte;
+lregnum,lconfigdata : word;
+
+begin
+  lbusnum := busnum;
+  ldevnum := devnum;
+  lregnum := regnum;
+  asm
+    mov ah,PCI_Function_ID
+    mov al,PCI_Read_Config_Word
+    mov bh,lbusnum
+    mov bl,ldevnum
+    mov di,lregnum
+    int $1A
+    mov flag,false;
+    or  ah,ah
+    jnz @exit
+    mov lconfigdata,cx
+    mov flag,true
+    @exit:
+  end;
+  configdata := lconfigdata;
+  ReadPCIConfigWord := flag;
+end;
+
+function WritePCIConfigWord(busnum,devnum: byte;regnum:word;configdata :word) : boolean;
+var
+flag : boolean;
+lbusnum,ldevnum : byte;
+lregnum,lconfigdata : word;
+
+begin
+  lbusnum := busnum;
+  ldevnum := devnum;
+  lregnum := regnum;
+  lconfigdata := configdata;
+  asm
+    mov ah,PCI_Function_ID
+    mov al,PCI_Write_Config_Word
+    mov bh,lbusnum
+    mov bl,ldevnum
+    mov di,lregnum
+    mov cx,lconfigdata
+    int $1A
+    mov flag,false;
+    or  ah,ah
+    jnz @exit
+    mov flag,true
+    @exit:
+  end;
+  WritePCIConfigWord := flag;
+end;
+

5i24/utils/dos/source/PCIBRID.PAS

@@ -0,0 +1,540 @@
+{$I 9030}
+{$I 9054}
+{$I 9056}
+{$I MesaPCI}
+{$I XIO2001}
+function SetupPCIWithMessage(cardnum : word;var base : word; var message : string) : boolean;
+var
+busnum,devnum: byte;
+configbase : word;
+FoundPCIBridge : boolean;
+hstring : string;
+begin
+  FoundPCIBridge := false;
+  if PCIBIOSPresent then
+  begin
+    if FindPCIDevice(N030DeviceID,N030VendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,N030PCIBaseAddress2,ConfigBase) then
+      begin
+        ConfigBase := ConfigBase and $FFFE;
+        base := ConfigBase;
+        FoundPCIBridge := true;
+        hstring := HexString(base,4);
+        message := 'Found 9030 based PCI card -- base address is: 0x'+hstring;
+      end;
+    end;
+  end;
+  if FindPCIDevice(N054DeviceID,N054VendorID,cardnum,busnum,devnum) then
+  begin
+    if ReadPCIConfigWord(busnum,devnum,N054PCIBaseAddress2,ConfigBase) then
+    begin
+      ConfigBase := ConfigBase and $FFFE;
+      base := ConfigBase;
+      FoundPCIBridge := true;
+      hstring := HexString(base,4);
+      message := 'Found 9054 based PCI card -- base address is: 0x'+hstring;
+    end;
+  end;
+  if FindPCIDevice(N056DeviceID,N056VendorID,cardnum,busnum,devnum) then
+  begin
+    if ReadPCIConfigWord(busnum,devnum,N056PCIBaseAddress2,ConfigBase) then
+    begin
+      ConfigBase := ConfigBase and $FFFE;
+      base := ConfigBase;
+      FoundPCIBridge := true;
+      hstring := HexString(base,4);
+      message := 'Found 9056 based PCI card -- base address is: 0x'+hstring;
+    end;
+  end;
+  if FoundPCIBridge = false then message := 'Didn''t find any PCI cards';
+  SetupPCIWithMessage := FoundPCIBridge;
+  { we really should look for the secondary ID for 5I20, 4I65, 5I21, 4I68 etc}
+end;
+
+function SetupPCI(cardnum: word; var base : word) : boolean;
+var
+busnum,devnum: byte;
+configbase : word;
+FoundPCIBridge : boolean;
+hstring : string;
+begin
+  FoundPCIBridge := false;
+  if PCIBIOSPresent then
+  begin
+    if FindPCIDevice(N030DeviceID,N030VendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,N030PCIBaseAddress2,ConfigBase) then
+      begin
+        ConfigBase := ConfigBase and $FFFE;
+        base := ConfigBase;
+        FoundPCIBridge := true;
+        hstring := HexString(base,4);
+        Writeln('Found 9030 based PCI card -- base address is: 0x'+hstring);
+      end;
+    end;
+    if FindPCIDevice(N054DeviceID,N054VendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,N054PCIBaseAddress2,ConfigBase) then
+      begin
+        ConfigBase := ConfigBase and $FFFE;
+        base := ConfigBase;
+        FoundPCIBridge := true;
+        hstring := HexString(base,4);
+        Writeln('Found 9054 based PCI card -- base address is: 0x'+hstring);
+      end;
+    end;
+    if FindPCIDevice(N056DeviceID,N056VendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,N056PCIBaseAddress2,ConfigBase) then
+      begin
+        ConfigBase := ConfigBase and $FFFE;
+        base := ConfigBase;
+        FoundPCIBridge := true;
+        hstring := HexString(base,4);
+        Writeln('Found 9056 based PCI card -- base address is: 0x'+hstring);
+      end;
+    end;
+  end;
+  if FoundPCIBridge = false then Writeln('Didn''t find any PCI cards');
+  SetupPCI := FoundPCIBridge;
+  { we really should look for the secondary ID for 5I20, 4I65, 5I21, 4I68 etc}
+end;
+
+function QuietSetupPCI(cardnum: word; var base : word) : boolean;
+var
+busnum,devnum: byte;
+configbase : word;
+FoundPCIBridge : boolean;
+{hstring : string;}
+begin
+  FoundPCIBridge := false;
+  if PCIBIOSPresent then
+  begin
+    if FindPCIDevice(N030DeviceID,N030VendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,N030PCIBaseAddress2,ConfigBase) then
+      begin
+        ConfigBase := ConfigBase and $FFFE;
+        base := ConfigBase;
+        FoundPCIBridge := true;
+        {hstring := HexString(base,4);}
+      end;
+    end;
+    if FindPCIDevice(N054DeviceID,N054VendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,N054PCIBaseAddress2,ConfigBase) then
+      begin
+        ConfigBase := ConfigBase and $FFFE;
+        base := ConfigBase;
+        FoundPCIBridge := true;
+        {hstring := HexString(base,4);}
+      end;
+    end;
+    if FindPCIDevice(N056DeviceID,N056VendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,N056PCIBaseAddress2,ConfigBase) then
+      begin
+        ConfigBase := ConfigBase and $FFFE;
+        base := ConfigBase;
+        FoundPCIBridge := true;
+        {hstring := HexString(base,4);}
+      end;
+    end;
+  end;
+  QuietSetupPCI := FoundPCIBridge;
+  { we really should look for the secondary ID for 5I20, 4I65, 5I21, 4I68 etc}
+end;
+
+function QuietSetupPCI_IO32(cardnum: word; var base : word) : boolean;
+var
+busnum,devnum: byte;
+configbase : word;
+FoundPCIBridge : boolean;
+{hstring : string;}
+begin
+  FoundPCIBridge := false;
+  if PCIBIOSPresent then
+  begin
+    if FindPCIDevice(N030DeviceID,N030VendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,N030PCIBaseAddress3,ConfigBase) then
+      begin
+        ConfigBase := ConfigBase and $FFFE;
+        base := ConfigBase;
+        FoundPCIBridge := true;
+        {hstring := HexString(base,4);}
+      end;
+    end;
+    if FindPCIDevice(N054DeviceID,N054VendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,N054PCIBaseAddress2,ConfigBase) then
+      begin
+        ConfigBase := ConfigBase and $FFFE;
+        base := ConfigBase;
+        FoundPCIBridge := true;
+        {hstring := HexString(base,4);}
+      end;
+    end;
+    if FindPCIDevice(N056DeviceID,N056VendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,N056PCIBaseAddress2,ConfigBase) then
+      begin
+        ConfigBase := ConfigBase and $FFFE;
+        base := ConfigBase;
+        FoundPCIBridge := true;
+        {hstring := HexString(base,4);}
+      end;
+    end;
+  end;
+  QuietSetupPCI_IO32 := FoundPCIBridge;
+  { we really should look for the secondary ID for 5I20, 4I65, 5I21, 4I68 etc}
+end;
+
+function SetupPCIM(cardnum: word;var base : longint): boolean;
+var
+busnum,devnum: byte;
+configbase : longint;
+FoundPCIBridge : boolean;
+hstring : string;
+begin
+  FoundPCIBridge := false;
+  if PCIBIOSPresent then
+  begin
+    if FindPCIDevice(N030DeviceID,N030VendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,N030PCIBaseAddress5,LongIntRec(configbase).LowWord) then
+      begin
+        if ReadPCIConfigWord(busnum,devnum,N030PCIBaseAddress5+2,LongIntRec(configbase).HighWord) then
+        begin
+          base := ConfigBase;
+          FoundPCIBridge := true;
+          hstring := HexString(base,8);
+          Writeln('Found 9030 based PCI card -- memory base address is: 0x'+hstring);
+        end;
+      end;
+    end;
+    if FindPCIDevice(N4I74DeviceID,MesaVendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,MesaPCIBaseAddress0,LongIntRec(configbase).LowWord) then
+      begin
+        if ReadPCIConfigWord(busnum,devnum,MesaPCIBaseAddress0+2,LongIntRec(configbase).HighWord) then
+        begin
+          base := ConfigBase;
+          FoundPCIBridge := true;
+          hstring := HexString(base,8);
+          Writeln('Found Mesa 4I74 card -- memory base address is: 0x'+hstring);
+        end;
+      end;
+    end;
+    if FindPCIDevice(N5I24DeviceID,MesaVendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,MesaPCIBaseAddress0,LongIntRec(configbase).LowWord) then
+      begin
+        if ReadPCIConfigWord(busnum,devnum,MesaPCIBaseAddress0+2,LongIntRec(configbase).HighWord) then
+        begin
+          base := ConfigBase;
+          FoundPCIBridge := true;
+          hstring := HexString(base,8);
+          Writeln('Found Mesa 5I24 card -- memory base address is: 0x'+hstring);
+        end;
+      end;
+    end;
+    if FindPCIDevice(N5I25DeviceID,MesaVendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,MesaPCIBaseAddress0,LongIntRec(configbase).LowWord) then
+      begin
+        if ReadPCIConfigWord(busnum,devnum,MesaPCIBaseAddress0+2,LongIntRec(configbase).HighWord) then
+        begin
+          base := ConfigBase;
+          FoundPCIBridge := true;
+          hstring := HexString(base,8);
+          Writeln('Found Mesa 5I25 card -- memory base address is: 0x'+hstring);
+        end;
+      end;
+    end;
+    if FindPCIDevice(N6I25DeviceID,MesaVendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,MesaPCIBaseAddress0,LongIntRec(configbase).LowWord) then
+      begin
+        if ReadPCIConfigWord(busnum,devnum,MesaPCIBaseAddress0+2,LongIntRec(configbase).HighWord) then
+        begin
+          base := ConfigBase;
+          FoundPCIBridge := true;
+          hstring := HexString(base,8);
+          Writeln('Found Mesa 6I25 card -- memory base address is: 0x'+hstring);
+        end;
+      end;
+    end;
+    if FindPCIDevice(N054DeviceID,N054VendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,N054PCIBaseAddress3,LongIntRec(ConfigBase).LowWord) then
+      begin
+        if ReadPCIConfigWord(busnum,devnum,N054PCIBaseAddress3+2,LongIntRec(ConfigBase).HighWord) then
+        begin
+          base := ConfigBase;
+          FoundPCIBridge := true;
+          hstring := HexString(base,8);
+          Writeln('Found 9054 based PCI card -- memory base address is: 0x'+hstring);
+        end;
+      end;
+    end;
+    if FindPCIDevice(N056DeviceID,N056VendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,N056PCIBaseAddress3,LongIntRec(ConfigBase).LowWord) then
+      begin
+        if ReadPCIConfigWord(busnum,devnum,N056PCIBaseAddress3+2,LongIntRec(ConfigBase).HighWord) then
+        begin
+          base := ConfigBase;
+          FoundPCIBridge := true;
+          hstring := HexString(base,8);
+          Writeln('Found 9056 based PCI card -- memory base address is: 0x'+hstring);
+        end;
+      end;
+    end;
+  end;
+  if FoundPCIBridge = false then Writeln('Didn''t find any PCI cards');
+  SetupPCIM := FoundPCIBridge;
+  { we really should look for the secondary ID for 5I20, 4I65, 5I21, 4I68 etc}
+end;
+
+function SetupXIO2001(cardnum: word;var base : longint; var message : string): boolean;
+var
+busnum,devnum: byte;
+configbase : longint;
+FoundPCIBridge : boolean;
+hstring : string;
+begin
+  FoundPCIBridge := false;
+  if PCIBIOSPresent then
+  begin
+    if FindPCIDevice(XIO2001DeviceID,XIO2001VendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,XIO2001PCIBaseAddress0,LongIntRec(configbase).LowWord) then
+      begin
+        if ReadPCIConfigWord(busnum,devnum,XIO2001PCIBaseAddress0+2,LongIntRec(configbase).HighWord) then
+        begin
+          base := ConfigBase;
+          FoundPCIBridge := true;
+          hstring := HexString(base,8);
+          message := 'Found XIO2001Bridge card -- memory base address is: 0x'+hstring;
+        end;
+      end;
+    end;
+  end;
+  if FoundPCIBridge = false then message :='Didn''t find a XIO2001';
+  SetupXIO2001 := FoundPCIBridge;
+end;
+
+function QuietSetupPCIM(cardnum: word;var base : longint) : boolean;
+var
+busnum,devnum: byte;
+configbase : longint;
+FoundPCIBridge : boolean;
+begin
+  FoundPCIBridge := false;
+  if PCIBIOSPresent then
+  begin
+    if FindPCIDevice(N030DeviceID,N030VendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,N030PCIBaseAddress5,LongIntRec(configbase).LowWord) then
+      begin
+        if ReadPCIConfigWord(busnum,devnum,N030PCIBaseAddress5+2,LongIntRec(configbase).HighWord) then
+        begin
+          base := ConfigBase;
+          FoundPCIBridge := true;
+        {  writeln('BaseAddress ');
+          hexprint(base,8);
+          writeln; }
+        end;
+      end;
+    end;
+    if FindPCIDevice(N4I74DeviceID,MesaVendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,MesaPCIBaseAddress0,LongIntRec(configbase).LowWord) then
+      begin
+        if ReadPCIConfigWord(busnum,devnum,MesaPCIBaseAddress0+2,LongIntRec(configbase).HighWord) then
+        begin
+          base := ConfigBase;
+          FoundPCIBridge := true;
+        end;
+      end;
+    end;
+    if FindPCIDevice(N5I24DeviceID,MesaVendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,MesaPCIBaseAddress0,LongIntRec(configbase).LowWord) then
+      begin
+        if ReadPCIConfigWord(busnum,devnum,MesaPCIBaseAddress0+2,LongIntRec(configbase).HighWord) then
+        begin
+          base := ConfigBase;
+          FoundPCIBridge := true;
+        end;
+      end;
+    end;
+    if FindPCIDevice(N5I25DeviceID,MesaVendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,MesaPCIBaseAddress0,LongIntRec(configbase).LowWord) then
+      begin
+        if ReadPCIConfigWord(busnum,devnum,MesaPCIBaseAddress0+2,LongIntRec(configbase).HighWord) then
+        begin
+          base := ConfigBase;
+          FoundPCIBridge := true;
+        end;
+      end;
+    end;
+    if FindPCIDevice(N6I25DeviceID,MesaVendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,MesaPCIBaseAddress0,LongIntRec(configbase).LowWord) then
+      begin
+        if ReadPCIConfigWord(busnum,devnum,MesaPCIBaseAddress0+2,LongIntRec(configbase).HighWord) then
+        begin
+          base := ConfigBase;
+          FoundPCIBridge := true;
+        end;
+      end;
+    end;
+    if FindPCIDevice(N054DeviceID,N054VendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,N054PCIBaseAddress3,LongIntRec(ConfigBase).LowWord) then
+      begin
+        if ReadPCIConfigWord(busnum,devnum,N054PCIBaseAddress3+2,LongIntRec(ConfigBase).HighWord) then
+        begin
+          base := ConfigBase;
+          FoundPCIBridge := true;
+        end;
+      end;
+    end;
+    if FindPCIDevice(N056DeviceID,N056VendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,N056PCIBaseAddress3,LongIntRec(ConfigBase).LowWord) then
+      begin
+        if ReadPCIConfigWord(busnum,devnum,N056PCIBaseAddress3+2,LongIntRec(ConfigBase).HighWord) then
+        begin
+          base := ConfigBase;
+          FoundPCIBridge := true;
+        end;
+      end;
+    end;
+  end;
+  QuietSetupPCIM := FoundPCIBridge;
+  { we really should look for the secondary ID for 5I20, 4I65, 5I21, 4I68 etc}
+end;
+
+function QuietSetupPCIMC(cardnum: word;var base : longint) : boolean;
+var
+busnum,devnum: byte;
+configbase : longint;
+FoundPCIBridge : boolean;
+begin
+  FoundPCIBridge := false;
+  if PCIBIOSPresent then
+  begin
+    if FindPCIDevice(N030DeviceID,N030VendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,N030PCIBaseAddress0,LongIntRec(configbase).LowWord) then
+      begin
+        if ReadPCIConfigWord(busnum,devnum,N030PCIBaseAddress0+2,LongIntRec(configbase).HighWord) then
+        begin
+          base := ConfigBase;
+          FoundPCIBridge := true;
+        end;
+      end;
+    end;
+    if FindPCIDevice(N054DeviceID,N054VendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,N054PCIBaseAddress0,LongIntRec(ConfigBase).LowWord) then
+      begin
+        if ReadPCIConfigWord(busnum,devnum,N054PCIBaseAddress0+2,LongIntRec(ConfigBase).HighWord) then
+        begin
+          base := ConfigBase;
+          FoundPCIBridge := true;
+        end;
+      end;
+    end;
+    if FindPCIDevice(N056DeviceID,N056VendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,N056PCIBaseAddress0,LongIntRec(ConfigBase).LowWord) then
+      begin
+        if ReadPCIConfigWord(busnum,devnum,N056PCIBaseAddress0+2,LongIntRec(ConfigBase).HighWord) then
+        begin
+          base := ConfigBase;
+          FoundPCIBridge := true;
+        end;
+      end;
+    end;
+  end;
+  QuietSetupPCIMC := FoundPCIBridge;
+  { we really should look for the secondary ID for 5I20, 4I65, 5I21, 4I68 etc}
+end;
+
+function ReadBridgeConfigWord(cardnum: word; regnum : word; var data : word): boolean;
+var
+busnum,devnum: byte;
+tword,treg : word;
+FoundPCIBridge : boolean;
+begin
+  treg := regnum;
+  FoundPCIBridge := false;
+  if PCIBIOSPresent then
+  begin
+    if FindPCIDevice(N030DeviceID,N030VendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,treg,tword) then
+      begin
+        FoundPCIBridge := true;
+      end;
+    end;
+    if FindPCIDevice(N054DeviceID,N054VendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,treg,tword) then
+      begin
+        FoundPCIBridge := true;
+      end;
+    end;
+    if FindPCIDevice(N056DeviceID,N056VendorID,cardnum,busnum,devnum) then
+    begin
+      if ReadPCIConfigWord(busnum,devnum,treg,tword) then
+      begin
+        FoundPCIBridge := true;
+      end;
+    end;
+  end;
+  data := tword;
+  ReadBridgeConfigWord := FoundPCIBridge;
+end;
+
+function WriteBridgeConfigWord(cardnum: word; regnum : word; data : word): boolean;
+var
+busnum,devnum: byte;
+tword,treg : word;
+FoundPCIBridge : boolean;
+begin
+  tword := data;
+  treg := regnum;
+  FoundPCIBridge := false;
+  if PCIBIOSPresent then
+  begin
+    if FindPCIDevice(N030DeviceID,N030VendorID,cardnum,busnum,devnum) then
+    begin
+      if WritePCIConfigWord(busnum,devnum,treg,tword) then
+      begin
+        FoundPCIBridge := true;
+      end;
+    end;
+    if FindPCIDevice(N054DeviceID,N054VendorID,cardnum,busnum,devnum) then
+    begin
+      if WritePCIConfigWord(busnum,devnum,treg,tword) then
+      begin
+        FoundPCIBridge := true;
+      end;
+    end;
+    if FindPCIDevice(N056DeviceID,N056VendorID,cardnum,busnum,devnum) then
+    begin
+      if WritePCIConfigWord(busnum,devnum,treg,tword) then
+      begin
+        FoundPCIBridge := true;
+      end;
+    end;
+  end;
+  WriteBridgeConfigWord := FoundPCIBridge;
+end;

5i24/utils/dos/source/READHMID.PAS

@@ -0,0 +1,577 @@
+
+program ReadHM2IDROM;
+
+
+{$IFDEF WINDOWS}
+uses synaser,synautil,synaip,blcksock,dos,crt;
+var
+ser:TBlockSerial;
+TheComPort : string;
+IPAddr : string;
+Socket : TUDPBlockSocket;
+{$ELSE}
+uses dos,crt;
+var TheComPort : word;
+{$ENDIF}
+
+
+{$I SELECTC}
+{$I SELECTIO}
+{I SELECTP}
+{$I SELECTPR}
+{$I INTERFCE}
+
+procedure Error(err : integer);
+begin
+  writeln(errorrecord[err].errstr);
+  halt(2);
+end;
+
+var
+DoXML : boolean;
+XMLIndent : word;
+CardNumber : integer;
+const
+XMLTab = 4;
+
+procedure Barfout(es:string);
+begin
+  writeln;
+  writeln(es);
+  halt(2);
+end;
+
+procedure FixCRT;
+{ Fix re-direction when using CRT unit }
+begin
+  assign(input,'');
+  reset(input);
+  assign(output,'');
+  rewrite(output);
+end;
+
+procedure XTab(indent:integer);
+var spaces : integer;
+begin
+  for spaces := 1 to indent do write(' ');
+end;
+
+procedure WriteLF(indent: integer);
+begin
+  write(chr(10));
+  XMLIndent := XMLIndent + indent;
+  XTab(XMLIndent*XMLTab);
+end;
+
+procedure PrintAsText(d: longint);
+begin
+  write(char(LongIntByteRec(d).Byte0));
+  write(char(LongIntByteRec(d).Byte1));
+  write(char(LongIntByteRec(d).Byte2));
+  write(char(LongIntByteRec(d).Byte3));
+end;
+
+procedure PrintAsLCText(d: longint);
+var ns : string;
+begin
+  ns :='';
+  ns := ns +char(LongIntByteRec(d).Byte0);
+  ns := ns +char(LongIntByteRec(d).Byte1);
+  ns := ns +char(LongIntByteRec(d).Byte2);
+  ns := ns +char(LongIntByteRec(d).Byte3);
+  write(LowString(ns));
+end;
+
+procedure PrintModuleName(gtag,pad:byte);
+var
+index : byte;
+foundit : boolean;
+begin
+  foundit := false;
+  for index := 1 to MaxTags do
+  begin
+    if FNames[index].FTag = gtag then
+    begin
+      write(PadWithSpaces(FNames[index].FName,pad));
+      foundit := true;
+    end;
+  end;
+  if foundit = false then write(PadWithSpaces('Unknown',pad));
+end;
+
+procedure PrintModuleNameX(gtag,pad:byte);
+var
+index : byte;
+foundit : boolean;
+begin
+  foundit := false;
+  for index := 1 to MaxTags do
+  begin
+    if FNamesX[index].FTag = gtag then
+    begin
+      write(PadWithSpaces(FNamesX[index].FName,pad));
+      foundit := true;
+    end;
+  end;
+  if foundit = false then write(PadWithSpaces('Unknown',pad));
+end;
+
+procedure PrintPinName(gtag,n,pad : byte);
+var
+index,num,chan : byte;
+chans : string;
+foundit : boolean;
+
+begin
+  foundit := false;
+  { normal modules are like this }
+  num := n and OutputMask;
+  for index := 1 to MaxTags do
+  begin
+    if PNames[index].FTag = gtag then
+    begin
+      if gtag = SSerialTag then
+      begin
+        chan := n and $0F;
+        str(chan,chans);
+        if n and $F0 = $00 then write(PadWithSpaces(PNames[index].Names[1]+chans,pad));
+        if n and $F0 = $80 then write(PadWithSpaces(PNames[index].Names[2]+chans,pad));
+        if n and $F0 = $90 then write(PadWithSpaces(PNames[index].Names[3]+chans,pad));
+        if n = $A1         then write(PadWithSpaces(PNames[index].Names[4],pad));
+        foundit := true;
+      end;
+      if gtag = DAQFIFOTag then
+      begin
+        chan := n and $1F;
+        str(chan,chans);
+        if n and $E0 = $00 then write(PadWithSpaces(PNames[index].Names[1]+chans,pad));
+        if n = $41 then write(PadWithSpaces(PNames[index].Names[2],pad));
+        if n = $81 then write(PadWithSpaces(PNames[index].Names[3],pad));
+        foundit := true;
+      end;
+      if gtag = TwiddlerTag then
+      begin
+        chan := n and $1F;
+        str(chan,chans);
+        if n and $C0 = $00 then write(PadWithSpaces(PNames[index].Names[1]+chans,pad));
+        if n and $C0 = $C0 then write(PadWithSpaces(PNames[index].Names[2]+chans,pad));
+        if n and $C0 = $80 then write(PadWithSpaces(PNames[index].Names[3]+chans,pad));
+        foundit := true;
+      end;
+      if gtag = BinOscTag then
+      begin
+        chan := n and $1F;
+        str(chan,chans);
+        if n and $80 = $80 then write(PadWithSpaces(PNames[index].Names[1]+chans,pad));
+        foundit := true;
+      end;
+      if foundit = false then
+      begin
+        write(PadWithSpaces(PNames[index].Names[num],pad));
+        foundit := true;
+      end;
+    end;
+  end;
+  if foundit = false then write(PadWithSpaces('Unknown',pad));
+end;
+
+procedure PrintPinNameX(gtag,n,pad : byte);
+var
+index,num,chan : byte;
+chans : string;
+foundit : boolean;
+
+begin
+  foundit := false;
+  { normal modules are like this }
+  num := n and OutputMask;
+  for index := 1 to MaxTags do
+  begin
+    if PNamesXML[index].FTag = gtag then
+    begin
+      if gtag = SSerialTag then
+      begin
+        chan := n and $0F;
+        str(chan,chans);
+        if n and $F0 = $00 then write(PadWithSpaces(PNamesXML[index].Names[1]+chans,pad));
+        if n and $F0 = $80 then write(PadWithSpaces(PNamesXML[index].Names[2]+chans,pad));
+        if n and $F0 = $90 then write(PadWithSpaces(PNamesXML[index].Names[3]+chans,pad));
+        if n = $A1         then write(PadWithSpaces(PNamesXML[index].Names[4],pad));
+        foundit := true;
+      end;
+      if gtag = DAQFIFOTag then
+      begin
+        chan := n and $1F;
+        str(chan,chans);
+        if n and $E0 = $00 then write(PadWithSpaces(PNamesXML[index].Names[1]+chans,pad));
+        if n = $41 then write(PadWithSpaces(PNamesXML[index].Names[2],pad));
+        if n = $81 then write(PadWithSpaces(PNamesXML[index].Names[3],pad));
+        foundit := true;
+      end;
+      if gtag = TwiddlerTag then
+      begin
+        chan := n and $1F;
+        str(chan,chans);
+        if n and $C0 = $00 then write(PadWithSpaces(PNamesXML[index].Names[1]+chans,pad));
+        if n and $C0 = $C0 then write(PadWithSpaces(PNamesXML[index].Names[2]+chans,pad));
+        if n and $C0 = $80 then write(PadWithSpaces(PNamesXML[index].Names[3]+chans,pad));
+        foundit := true;
+      end;
+      if gtag = BinOscTag then
+      begin
+        chan := n and $1F;
+        str(chan,chans);
+        if n and $80 = $80 then write(PadWithSpaces(PNamesXML[index].Names[1]+chans,pad));
+        foundit := true;
+      end;
+      if foundit = false then
+      begin
+        write(PadWithSpaces(PNamesXML[index].Names[num],pad));
+        foundit := true;
+      end;
+    end;
+  end;
+  if foundit = false then write(PadWithSpaces('Unknown',pad));
+end;
+
+procedure PrintConnectorName(bn : longint;p:byte);
+var index : byte;
+begin
+  for index := 1 to Boards do
+  begin
+    if ConnectorNames[index].BoardName = bn then
+    begin
+      write(ConnectorNames[index].ConName[p]);
+    end;
+  end;
+end;
+
+function PinNumber(io,pw: byte) : integer;
+var pn,mio : byte;
+begin
+  pn := 0;
+  if pw = 24 then pn := (((io-1) mod pw)*2) +1; { for 50 pin 24 I/O pinout}
+  if pw = 17 then                               { for printer port 17 I/O pinout }
+  begin
+    mio := (io-1) mod pw;
+    if mio > 7 then pn := mio -3 else
+    begin
+      if (mio and 1) = 0 then pn := (mio div 2)+1 else pn := (mio div 2) +14;
+    end;
+  end;
+  PinNumber := pn;
+end;
+
+procedure PrintBoardName;
+begin
+  with IDROMHeader do
+  begin
+    write('  BoardName : ');
+    PrintAsText(BoardNameLow);
+    PrintAsText(BoardNameHigh);
+  end;
+end;
+
+procedure PrintHeader;
+begin
+  with IDROMHeader do
+  begin
+    if (IDROMType <> IDROMStyle0) and (IDROMType <> IDROMStyle1) then Barfout('Wrong IDROM Format!');
+    ModuleOffset := ModulePointer div 4;
+    PinDescOffset := PinDescPointer div 4;
+    writeln;
+    writeln('General configuration information:');
+    writeln;
+    PrintBoardName;
+    writeln;
+    writeln('  FPGA Size: ',FPGASize,' KGates');
+    writeln('  FPGA Pins: ',FPGAPins);
+    writeln('  Number of IO Ports: ',IOPorts);
+    writeln('  Width of one I/O port: ',PortWidth);
+    writeln('  Clock Low frequency: ',ClockLow/1e6:3:4,' MHz') ;
+    writeln('  Clock High frequency: ',ClockHigh/1e6:3:4,' MHz') ;
+    writeln('  IDROM Type: ',IDROMType) ;
+    writeln('  Instance Stride 0: ',InstStride0) ;
+    writeln('  Instance Stride 1: ',InstStride1) ;
+    writeln('  Register Stride 0: ',RegStride0) ;
+    writeln('  Register Stride 1: ',RegStride1) ;
+    writeln('  IDROM Type: ',IDROMType) ;
+  end;
+end;
+
+procedure PrintModules;
+var index : integer;
+begin
+  for index := 0 to MaxModules*3 -1 do
+  begin
+    ModulesAsArray[index] := IDROMAsArray[index+ModuleOffset];
+  end;
+  Modules := ModuleType(ModulesAsArray);
+  index := 0;
+  writeln;
+  writeln('Modules in configuration: ');
+  repeat
+    with Modules[index] do
+    begin
+      writeln;
+      write('  Module: ');
+      PrintModuleName(GTag,0);
+      writeln;
+      write('  There are ',NumInstances,' of ');
+      PrintModuleName(GTag,0);
+      writeln(' in configuration');
+      writeln('  Version: ',Version);
+      writeln('  Registers: ',NumRegisters);
+      write('  BaseAddress: ');
+      HexPrint(BaseAddr,4);
+      writeln;
+      if Clock = ClockLowTag then
+        writeln('  ClockFrequency: ',IDROMHeader.ClockLow/1e6:3:3,' MHz')
+      else
+        writeln('  ClockFrequency: ',IDROMHeader.ClockHigh/1e6:3:3,' MHz');
+      index := index+1;
+      if (Strides and $0F) = 0 then
+         writeln('  Register Stride: ',IDROMHeader.RegStride0,' bytes')
+      else
+         writeln('  Register Stride: ',IDROMHeader.RegStride1,' bytes');
+      if (Strides and $F0) = 0 then
+         writeln('  Instance Stride: ',IDROMHeader.InstStride0,' bytes')
+      else
+         writeln('  Instance Stride: ',IDROMHeader.InstStride1,' bytes');
+    end;
+  until Modules[index].GTag = 0;
+end;
+
+procedure PrintPins;
+var index : integer;
+begin
+  for index := 0 to MaxPins-1 do
+  begin
+    PinDescsAsArray[index] := IDROMAsArray[index+PinDescOffset];
+  end;
+  PinDescs := PinDescType(PinDescsAsArray);
+  writeln;
+  writeln('Configuration pin-out: ');
+  for index := 1 to IDROMHeader.IOWidth do
+  begin
+    with PinDescs[index] do
+    begin
+      if ((index-1) mod IDROMHeader.PortWidth) = 0 then
+      begin
+        writeln;
+        write('IO Connections for ');
+        PrintConnectorName(IDROMHeader.BoardNameHigh,((index -1) div IDROMHeader.PortWidth+1));
+        writeln;
+        writeln('Pin#  I/O   Pri. func    Sec. func       Chan      Pin func        Pin Dir');
+        writeln;
+      end;
+      write(PinNumber(index,IDROMHeader.PortWidth):2);
+      write('    ',index-1:3,'   ');
+      PrintModuleName(PTag,8);
+      write('     ');
+      if GTag <> $00 then
+      begin
+        PrintModuleName(Gtag,15);
+        if (Chan and GlobalMarker) <> 0 then
+        begin
+          write('     Global    ');
+        end
+        else
+        begin
+          write(' ',Chan:2,'        ');
+        end;
+        PrintPinName(Gtag,PNumber,12);
+        if PNumber and OutputMarker <> 0 then writeln('    (Out)') else writeln('    (In)');
+      end
+      else writeln('None');
+    end;
+  end;
+end;
+
+procedure PrintHeaderX;
+begin
+  with IDROMHeader do
+  begin
+    if (IDROMType <> IDROMStyle0) and (IDROMType <> IDROMStyle1) then Barfout('Wrong IDROM Format!');
+    ModuleOffset := ModulePointer div 4;
+    PinDescOffset := PinDescPointer div 4;
+    XMLIndent := 0;
+    write('<?xml version="1.0"?>');
+    writeLF(0);
+    write('<hostmot2>');
+    writeLF(1);
+    write('<boardname>');
+    PrintAsLCText(BoardNameHigh);
+    write('</boardname>');
+    writeLF(0);
+    write('<ioports>',IOPorts,'</ioports>');
+    writeLF(0);
+    write('<iowidth>',IOWidth,'</iowidth>');
+    writeLF(0);
+    write('<portwidth>',PortWidth,'</portwidth>');
+    writeLF(0);
+    write('<clocklow>',ClockLow:8,'</clocklow>');
+    writeLF(0);
+    write('<clockhigh>',ClockHigh:8,'</clockhigh>');
+    writeLF(0);
+  end;
+end;
+
+procedure PrintModulesX;
+var index : integer;
+begin
+  for index := 0 to MaxModules*3 -1 do
+  begin
+    ModulesAsArray[index] := IDROMAsArray[index+ModuleOffset];
+  end;
+  Modules := ModuleType(ModulesAsArray);
+  index := 1;
+  write('<modules>');
+  writeLF(1);
+  repeat
+    with Modules[index] do
+    begin
+      write('<module>');
+      writeLF(1);
+      write('<tagname>');
+      PrintModuleNameX(GTag,0);
+      write('</tagname>');
+      writeLF(0);
+      write('<numinstances>',NumInstances:2,'</numinstances>');
+      writeLF(-1);
+      write('</module>');
+      index := index +1;
+      if Modules[index].GTag <> 0 then writeLF(0);
+    end;
+  until Modules[index].GTag = 0;
+  write('<module>');
+  writeLF(1);
+  write('<tagname>None</tagname>');
+  writeLF(0);
+  write('<numinstances> 1</numinstances>');
+  writeLF(-1);
+  write('</module>');
+  index := index +1;
+  writeLF(-1);
+  write('</modules>');
+  writeLF(0);
+end;
+
+procedure PrintPinsX;
+var
+index : integer;
+pindir : string;
+begin
+  for index := 0 to MaxPins-1 do
+  begin
+    PinDescsAsArray[index] := IDROMAsArray[index+PinDescOffset];
+  end;
+  PinDescs := PinDescType(PinDescsAsArray);
+  write('<pins>');
+  writeLF(1);
+  for index := 1 to IDROMHeader.IOWidth do
+  begin
+    with PinDescs[index] do
+    begin
+      write('<pin>');
+      writeLF(1);
+      write('<connector>');
+      PrintConnectorName(IDROMHeader.BoardNameHigh,((index -1) div IDROMHeader.PortWidth+1));
+      write('</connector>');
+      writeLF(0);
+      if PNumber and OutputMarker <> 0 then pindir := '(out)' else pindir := '(in)';
+      if GTag <> $00 then
+      begin
+        write('<secondarymodulename>');
+        PrintModuleName(GTag,0);
+        write('</secondarymodulename>');
+        writeLF(0);
+        write('<secondaryfunctionname>');
+        PrintPinNameX(Gtag,PNumber,0);
+        write(' ',pindir,'</secondaryfunctionname>');
+        writeLF(0);
+        write('<secondaryinstance>',chan:2,'</secondaryinstance>');
+      end
+      else
+      begin
+        write('<secondarymodulename>None</secondarymodulename>');
+        writeLF(0);
+        write('<secondaryfunctionname>0</secondaryfunctionname>');
+        writeLF(0);
+        write('<secondaryinstance>',0,'</secondaryinstance>');
+      end;
+      writeLF(-1);
+      write('</pin>');
+      if index <>  IDROMHeader.IOWidth then writeLF(0)
+    end;
+  end;
+  writeLF(-1);
+  write('</pins>');
+  writeLF(-1);
+  write('</hostmot2>');
+end;
+
+procedure ScanParms;
+var
+data,index : longint;
+connector,pin : byte;
+begin
+  data := Read32(HM2CookieOffset);
+  if data <> HM2Cookie then BarfOut('No HM2 Hardware Found');
+  data := Read32(HostMotNameLowOffset);
+  if not DoXML then
+  begin
+    write('Configuration Name: ');
+    PrintAsText(data);
+    data := Read32(HostMotNameHighOffset);
+    PrintAsText(data);
+    writeln;
+  end;
+  data := Read32(IDROMPointer);
+  IDROMOffset := data;
+  for index := 0 to IDROMSize-1 do
+  begin
+    data := Read32(IDROMOffset+index*4);
+    IDROMAsArray[index] := data
+  end;
+  for index := 0 to IDROMHeaderSize-1 do
+  begin
+    IDROMHeaderAsArray[index] := IDROMAsArray[index];
+  end;
+  IDROMHeader := IDROMHeaderType(IDROMHeaderAsArray);
+  if DoXML then
+  begin
+    PrintHeaderX;
+    PrintModulesX;
+    PrintPinsX;
+  end
+  else
+  begin
+    PrintHeader;
+    PrintModules;
+    PrintPins;
+  end;
+end;
+
+procedure GetParm;
+var retcode : integer;
+begin
+  DoXML := false;
+  if ParamCount >0 then
+  begin
+    val(ParamStr(1),CardNumber,retcode);
+    if retcode <> 0 then BarfOut('Invalid card #');
+  end;
+  if ParamCount >1 then
+  begin
+    if UpString(ParamStr(2)) = 'XML' then DoXML := true;
+  end;
+end;
+
+begin
+  FixCRT;
+  GetOurEnv;
+  if not InitializeInterface(message) then bumout(message);
+  GetParm;
+  ScanParms;
+end.

5i24/utils/dos/source/RP32.PAS

@@ -0,0 +1,70 @@
+program ReadParam32;
+
+{$IFDEF WINDOWS}
+uses synaser,synautil,synaip,blcksock,dos,crt;
+var
+ser:TBlockSerial;
+TheComPort : string;
+IPAddr : string;
+Socket : TUDPBlockSocket;
+{$ELSE}
+uses dos,crt;
+var TheComPort : word;
+{$ENDIF}
+
+
+{$I SELECTC}
+{$I SELECTIO}
+{I SELECTP}
+{$I SELECTPR}
+{$I INTERFCE}
+
+
+
+procedure Usage;
+begin
+  writeln('Usage: rp32 HexRegisterOffset ');
+  writeln;
+  halt(2);
+end;
+
+procedure Error(err : integer);
+begin
+  writeln(errorrecord[err].errstr);
+  halt(2);
+end;
+
+procedure ScanParms;
+var
+parm : word;
+validparm : boolean;
+didit : boolean;
+themem : longint;
+thedata : longint;
+begin
+  parm := 1;
+  validparm := true;
+  didit := false;
+  while validparm and (parm <= ParamCount) do
+  begin
+    validparm := false;
+    if HexLongRead(Paramstr(parm),themem) then
+    begin
+      parm := parm +1;
+      thedata := Read32(themem);
+      validparm := true;
+      didit := true;
+      HexPrint(TheData,8);
+      write('  ');
+    end;
+  end;
+  if not didit then write('Nothing done!!!');
+  writeln;
+end;
+
+begin
+  GetOurEnv;
+  if not InitializeInterface(message) then bumout(message);
+  if ParamCount < 1 then Usage;
+  ScanParms;
+end.

5i24/utils/dos/source/SELECTC.PAS

@@ -0,0 +1,42 @@
+{$IFDEF SOFTDMC}
+  {$I MOTCON5}
+  {$DEFINE FIFO}
+{$ELSE}
+  {$IFDEF THREEC20}
+    {$DEFINE EEPROM}
+    {$I MOTCOND.PAS}
+    {$DEFINE FIFO}
+  {$ELSE}
+    {$IFDEF EIGHTI20}
+      {$I 8I20con.PAS}
+      {$DEFINE EEPROM}
+    {$ELSE}
+      {$IFDEF SEVENI43}
+        {$I MOTCON5.PAS}
+        {$DEFINE FIFO}
+      {$ELSE}
+        {$IFDEF EIGHTC20}
+          {$I 8C20CON.PAS}
+          {$DEFINE EEPROM}
+        {$ELSE}
+          {$IFDEF EIGHTI40}
+            {$I MOTBITSD.PAS}
+            {I 8I40BITS.PAS}
+            {$DEFINE EEPROM}
+          {$ELSE}
+            {$IFDEF SEVENI64}
+              {$I 7I64con.PAS}
+              {$IFDEF GENERIC}
+                {}
+                {$DEFINE EEPROM}
+              {$ELSE}
+
+              {BUMOUT CARD NOT DEFINED }
+              {$ENDIF}
+            {$ENDIF}
+          {$ENDIF}
+        {$ENDIF}
+      {$ENDIF}
+    {$ENDIF}
+  {$ENDIF}
+{$ENDIF}

5i24/utils/dos/source/SELECTIO.PAS

@@ -0,0 +1,45 @@
+{$IFDEF SOFTDMC}
+  {$I MOTIO5.PAS}
+  {$DEFINE FIFO}
+{$ELSE}
+  {$IFDEF THREEC20}
+    {I MOTPARMD.PAS} { for 3C20 }
+    {$DEFINE EEPROM}
+  {$ELSE}
+    {$IFDEF EIGHTI20}
+      {$I 8I20PARM.PAS}
+      {$DEFINE EEPROM}
+    {$ELSE}
+      {$IFDEF SEVENI43}
+        {$I MOTIO5.PAS}
+        {$DEFINE FIFO}
+      {$ELSE}
+        {$IFDEF EIGHTC20}
+          {$I 8C20PARM.PAS}
+          {$DEFINE EEPROM}
+        {$ELSE}
+          {$IFDEF EIGHTI40}
+            {$I 8I40PARM.PAS}
+            {$DEFINE EEPROM}
+          {$ELSE}
+            {$IFDEF SEVENI64}
+              {$I 7I64PARM.PAS}
+            {$ELSE}
+              {$IFDEF GENERIC}
+                {}
+              {$ELSE}
+                {$IFDEF GENPIC}
+                  {}
+                {$ELSE}
+
+              BUMOUT CARD NOT DEFINED
+
+                {$ENDIF}
+              {$ENDIF}
+            {$ENDIF}
+          {$ENDIF}
+        {$ENDIF}
+      {$ENDIF}
+    {$ENDIF}
+  {$ENDIF}
+{$ENDIF}

5i24/utils/dos/source/SELECTPR.PAS

@@ -0,0 +1,46 @@
+
+{$IFDEF SOFTDMC}
+  {$I parmrec5}
+  {$DEFINE FIFO}
+{$ELSE}
+  {$IFDEF THREEC20}
+    {$I parmrecD}
+    {$DEFINE EEPROM}
+  {$ELSE}
+    {$IFDEF EIGHTI20}
+      {$I 8I20PREC.PAS}
+      {$DEFINE EEPROM}
+    {$ELSE}
+      {$IFDEF SEVENI43}
+        {$I Parmrec5.PAS}
+        {$DEFINE FIFO}
+      {$ELSE}
+        {$IFDEF EIGHTC20}
+          {$I 8C20PREC.PAS}
+          {$DEFINE EEPROM}
+        {$ELSE}
+          {$IFDEF EIGHTI40}
+            {$I 8I40PREC.PAS}
+            {$DEFINE EEPROM}
+        {$ELSE}
+            {$IFDEF SEVENI64}
+              {$I 7I64PREC.PAS}
+            {$ELSE}
+              {$IFDEF GENERIC}
+                {$DEFINE EEPROM}
+                {$I GENERICP.PAS}
+              {$ELSE}
+                {$IFDEF GENPIC}
+                  {$DEFINE EEPROM}
+                  {$I GENPICP.PAS}
+                {$ELSE}
+                  BUMOUT CARD NOT DEFINED
+                {$ENDIF}
+              {$ENDIF}
+            {$ENDIF}
+          {$ENDIF}
+        {$ENDIF}
+      {$ENDIF}
+    {$ENDIF}
+  {$ENDIF}
+{$ENDIF}

5i24/utils/dos/source/SERCMDS4.PAS

@@ -0,0 +1,67 @@
+const
+  CR = chr(13);
+  NAK = '?';
+  FlashBlockSize = 4096;
+{$IFDEF EIGHTI20}
+  GroupSize = 512*4;
+{$ELSE}
+  GroupSize = 32*4;
+{$ENDIF}
+
+  SerReadPicWordCom =      'RW';
+  SerReadChecksumCom =     'RC';
+  SerReadEEPROMCom =       'RE';
+  SerReadFlashCom =        'RF';
+  SerReadProtectCom =      'RP';
+  SerReadROMCom =          'RR';
+  SerReadGroupCom =        'RG';
+
+  SerReadIFIFOCom =        'RI';
+  SerReadQFIFOCom =        'RQ';
+  SerReadIFIFOMultipleCom ='RM';
+  SerReadQFIFOMultipleCom ='Rm';
+  SerReadFIFOStatusCom =   'Rs';
+  SerReadDirectWordCom =   'Rd'; { for fifoed interface }
+  SerReadDirectByteCom =   'RD';
+  SerReadStatusCom =       'RS';  { for PPM }
+  SerReadAnalogCom =       'RA';  { for PPM }
+  SerSelectChanCom =       'LS';  { for ppm }
+
+  SerWriteFlashCom =       'WF';
+  SerWriteProtectCom =     'WP';
+  SerWriteOscCom     =     'WO';
+  SerWriteROMCom =         'WR';
+  SerWriteDirectWordCom =  'Wd';  { for fifoed interface }
+  SerWriteDirectByteCom =  'WD';
+  SerWriteGroupCom =       'WG';
+  SerWriteEEPROMCom =      'WE';
+  SerWritePicWordCom =     'WW';
+
+  SerWriteIFIFOCom =       'WI';
+  SerWriteQFIFOCom =       'WQ';
+
+  SerEraseFlashCom =       'EF';
+  SerEraseChecksumCom =    'EC';
+  SerEraseGroupCom =       'EG';
+
+  SerInquireIDCom  =       'II';
+  SerInquireRevCom =       'IR';
+
+  SerPICGoCom      =       'GP';
+  SerConfigCom     =       'GC';
+
+  SerClearICDFIFOCom =     'CI';   { not 7I60 yet }
+  SerClearIRBFIFOCom =     'Ci';
+  SerClearQCDFIFOCom =     'CQ';
+  SerClearQRBFIFOCom =     'Cq';
+
+  SerCountICDFIFOCom =     'cI';   { not 7I60 yet }
+  SerCountIRBFIFOCom =     'ci';
+  SerCountQCDFIFOCom =     'cQ';
+  SerCountQRBFIFOCom =     'cq';
+
+  SerWriteEEPROMWordCom =  'We';
+  SerReadEEPROMWordCom =   'Re';
+  SerListenCom =           'LS';
+  SerMesaStartCom =        'MESASTART';
+  SerMesaStopCom =         'MESASTOP';

5i24/utils/dos/source/SERHOST4.PAS

@@ -0,0 +1,872 @@
+{for fifo'ed 7I60}
+{$R-}    {Range checking be off }
+{$I-}    {No I/O checking }
+{$S-}    {No stack checking}
+
+type buffer = array[1.. FlashBlockSize] of byte; { largest size }
+     bufptr = ^buffer;
+     DataBuffertype = array[0..255] of word;
+     DataBuffPtr = ^DataBuffertype;
+
+var  DataBuffer : DataBuffertype;
+
+{*****************************************************************************}
+procedure SerMesaStart;
+var
+sstring : string;
+begin
+  SerSetRTSHigh;
+  sstring := CR {sync} + SerMesaStartCom + CR;
+  SerSendString(sstring);
+end;
+
+procedure SerMesaStop;
+var
+sstring : string;
+begin
+  SerSetRTSLow;
+  sstring := SerMesaStopCom + CR;
+  SerSendString(sstring);
+end;
+
+procedure SerListen(addr : byte);
+var
+sstring : string;
+begin
+  sstring := SerListenCom + HexString(addr,2) + CR;
+  SerSendString(sstring);
+end;
+
+function InquireID : string;
+var
+rstring,sstring : string;
+retchar : char;
+begin
+  sstring := SerInquireIDCom +CR;
+  SerSendString(sstring);
+  SerRecvString(4,rstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  InquireID := rstring;
+end;
+
+function SerProbe(addr : byte) : boolean;
+var
+sstring : string;
+begin
+  SerProbe := false;
+  SerListen(addr);
+  sstring := InquireID;
+  if sstring = '3C20' then SerProbe := true;
+end;
+
+procedure CloseSerialPort;
+begin
+{$IFDEF THREEC20}
+  SerMesaStop;
+{$ENDIF}
+  SerClose;
+end;
+(*
+procedure InitializeSerInterface;
+begin
+  DefaultComInit(TheComPort);
+  EnableFifos(TheComPort); { don't check if fifos are there because it sends garbage }
+  SetBaudRate(TheComPort,UartBaudrate);
+  TossChars(TheComPort,130);
+end;
+  *)
+procedure SerWritePicWord(address:word; data:word);
+var
+sstring : string;
+retchar : char;
+begin
+  sstring := SerWritePicWordCom+HexString(address,4)+HexString(data,4)+CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+function SerReadPicWord(address:word) : word;
+var
+sstring : string;
+retchar : char;
+data : word;
+begin
+  sstring := SerReadPicWordCom+HexString(address,4)+CR;
+  SerSendString(sstring);
+  SerRecvString(4,sstring);  { get 4 char hex string }
+  if not SerRecvChar(retchar) then SerError := true; { get CR }
+  HexWordRead(sstring,data);
+  SerReadPicWord := data;
+end;
+
+procedure SerWriteDirectByte(address:byte; data:byte);
+var
+sstring : string;
+retchar : char;
+begin
+  sstring := SerWritedirectByteCom+HexString(address,2)+HexString(data,2)+CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+procedure SerWriteDirectWord(address:byte; data:word);
+var
+sstring : string;
+retchar : char;
+begin
+  sstring := SerWritedirectWordCom+HexString(address,2)+HexString(data,4)+CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+procedure WriteGroup( group : word;ourbuffer : bufptr);
+var
+sstring : string;
+retchar : char;
+index : word;
+begin
+  sstring := SerWriteGroupCom+ HexString(group,4)+CR;
+  SerSendString(sstring);
+  for index := 1 to GroupSize do SerSendString(HexString(ourbuffer^[index],2));
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+function SerCountICDFIFO : word;
+var
+data : word;
+rstring,sstring : string;
+retchar : char;
+begin
+  sstring := SerCountICDFIFOCom + CR;
+  SerSendString(sstring);
+  SerRecvString(4,rstring);  { get 4 char hex string }
+  if not SerRecvChar(retchar) then SerError := true; { get CR }
+  HexWordRead(rstring,data);
+  SerCountICDFIFO := data;
+end;
+function SerCountIRBFIFO : word;
+var
+data : word;
+rstring,sstring : string;
+retchar : char;
+begin
+  sstring := SerCountIRBFIFOCom + CR;
+  SerSendString(sstring);
+  SerRecvString(4,rstring);  { get 4 char hex string }
+  if not SerRecvChar(retchar) then SerError := true; { get CR }
+  HexWordRead(rstring,data);
+  SerCountIRBFIFO := data;
+end;
+
+function SerCountQCDFIFO : word;
+var
+data : word;
+rstring,sstring : string;
+retchar : char;
+begin
+  sstring := SerCountQCDFIFOCom + CR;
+  SerSendString(sstring);
+  SerRecvString(4,rstring);  { get 4 char hex string }
+  if not SerRecvChar(retchar) then SerError := true; { get CR }
+  HexWordRead(rstring,data);
+  SerCountQCDFIFO := data;
+end;
+
+function SerCountQRBFIFO : word;
+var
+data : word;
+rstring,sstring : string;
+retchar : char;
+begin
+  sstring := SerCountQRBFIFOCom + CR;
+  SerSendString(sstring);
+  SerRecvString(4,rstring);  { get 4 char hex string }
+  if not SerRecvChar(retchar) then SerError := true; { get CR }
+  HexWordRead(rstring,data);
+  SerCountQRBFIFO := data;
+end;
+
+function SerReadIFIFO : word;
+var
+data : word;
+rstring,sstring : string;
+retchar : char;
+begin
+  sstring := SerReadIFIFOCom + CR;
+  SerSendString(sstring);
+  SerRecvString(4,rstring);  { get 4 char hex string }
+  if not SerRecvChar(retchar) then SerError := true; { get CR }
+  HexWordRead(rstring,data);
+  SerReadIFIFO := data;
+end;
+
+procedure SerReadQFIFOMultiple(n : word; bufptr : DataBuffPtr);
+var
+data : word;
+index : byte;
+rstring,sstring : string;
+retchar : char;
+begin
+  sstring := SerReadQFIFOMultipleCom + HexString(n,2) + CR;
+  SerSendString(sstring);
+  for index := 0 to n-1 do
+  begin
+    SerRecvString(4,rstring);
+    HexWordRead(rstring,data);
+    bufptr^[index] := data;
+  end;
+  if not SerRecvChar(retchar) then SerError := true; { get CR }
+end;
+
+function SerReadQFIFO : word;
+var
+data : word;
+rstring,sstring : string;
+retchar : char;
+begin
+  sstring := SerReadQFIFOCom + CR;
+  SerSendString(sstring);
+  SerRecvString(4,rstring);  { get 4 char hex string }
+  if not SerRecvChar(retchar) then SerError := true; { get CR }
+  HexWordRead(rstring,data);
+  SerReadQFIFO := data;
+end;
+
+function SerReadDirectByte(address: byte) : byte;
+var
+data : word;
+rstring,sstring : string;
+retchar : char;
+begin
+  sstring := SerReadDirectByteCom + HexString(address,2) +CR;
+  SerSendString(sstring);
+  SerRecvString(2,rstring);  { get 4 char hex string }
+  if not SerRecvChar(retchar) then SerError := true; { get CR }
+  HexWordRead(rstring,data);
+  SerReadDirectByte := data;
+end;
+
+function SerReadDirectWord(address: byte) : word;
+var
+data : word;
+rstring,sstring : string;
+retchar : char;
+begin
+  sstring := SerReadDirectWordCom + HexString(address,2) +CR;
+  SerSendString(sstring);
+  SerRecvString(4,rstring);  { get 4 char hex string }
+  if not SerRecvChar(retchar) then SerError := true; { get CR }
+  HexWordRead(rstring,data);
+  SerReadDirectWord := data;
+end;
+
+function SerReadParamWord(command:word) : word;
+var
+data : word;
+rstring,sstring : string;
+retchar : char;
+begin
+  sstring := SerWriteIFIFOCom + HexString(command,4) + CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true; { get CR }
+  sstring := SerReadIFIFOCom + CR;
+  SerSendString(sstring);
+  SerRecvString(4,rstring);  { get 4 char hex string }
+  if not SerRecvChar(retchar) then SerError := true; { get CR }
+  HexWordRead(rstring,data);
+  SerReadParamWord := data;
+end;
+
+function SerReadParam(command:word) : longint;
+var
+sstring : string;
+rlstring : string;
+rhstring : string;
+ldata : longint;
+retchar : char;
+begin
+  sstring := SerWriteIFIFOCom + HexString(command,4) + CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  sstring := SerReadIFIFOCom + CR;
+  SerSendString(sstring);
+  SerRecvString(4,rlstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  SerSendString(sstring);
+  SerRecvString(4,rhstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  HexLongRead(rhstring+rlstring,ldata);
+  SerReadParam := ldata;
+end;
+
+{$IFDEF COPROC}
+function SerReadParamDouble(command:word) : comp;
+var
+sstring : string;
+r0string,r1string,r2string,r3string : string;
+cdata : comp;
+retchar : char;
+begin
+  sstring := SerWriteIFIFOCom + HexString(command,4) + CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  sstring := SerReadIFIFOCom + CR;
+  SerSendString(sstring);
+  SerRecvString(4,r0string);
+  if not SerRecvChar(retchar) then SerError := true;
+  SerSendString(sstring);
+  SerRecvString(4,r1string);
+  if not SerRecvChar(retchar) then SerError := true;
+  SerSendString(sstring);
+  SerRecvString(4,r2string);
+  if not SerRecvChar(retchar) then SerError := true;
+  SerSendString(sstring);
+  SerRecvString(4,r3string);
+  if not SerRecvChar(retchar) then SerError := true;
+  HexLongRead(r1string+r0string,DoubleLongRec(cdata).Long0);
+  HexLongRead(r3string+r2string,DoubleLongRec(cdata).Long1);
+  SerReadParamDouble := cdata;
+end;
+{$ENDIF}
+
+procedure SerWriteParamWord(command:word;data:word);
+var
+sstring : string;
+retchar : char;
+begin
+  sstring := SerWriteIFIFOCom+HexString(command,4)+CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  sstring := SerWriteIFIFOCom+HexString(data,4)+CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+procedure SerWriteCommand(command:word);
+var
+sstring : string;
+retchar : char;
+begin
+  sstring := SerWriteIFIFOCom+HexString(command,4)+CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+procedure SerWriteCommandQ(command:word);
+var
+sstring : string;
+retchar : char;
+begin
+  sstring := SerWriteQFIFOCom+HexString(command,4)+CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+procedure SerWriteParam(command: word;ldata:longint);
+var
+sstring : string;
+retchar : char;
+begin
+  sstring := SerWriteIFIFOCom + HexString(command,4)+ CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  sstring := SerWriteIFIFOCom + HexString(LongIntRec(ldata).LowWord,4) + CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  sstring := SerWriteIFIFOCom + HexString(LongIntRec(ldata).HighWord,4) + CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+{$IFDEF COPROC}
+procedure SerWriteParamDouble(command: word;cdata:comp);
+var
+sstring : string;
+retchar : char;
+begin
+  sstring := SerWriteIFIFOCom + HexString(command,4)+ CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  sstring := SerWriteIFIFOCom + HexString(DoubleIntRec(cdata).Word0,4) + CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  sstring := SerWriteIFIFOCom + HexString(DoubleIntRec(cdata).Word1,4) + CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  sstring := SerWriteIFIFOCom + HexString(DoubleIntRec(cdata).Word2,4) + CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  sstring := SerWriteIFIFOCom + HexString(DoubleIntRec(cdata).Word3,4) + CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+{$ENDIF}
+
+function SerReadParamWordQ(command:word) : word;
+var
+data : word;
+rstring,sstring : string;
+retchar : char;
+begin
+  sstring := SerWriteQFIFOCom + HexString(command,4) + CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true; { get CR }
+  sstring := SerReadQFIFOCom + CR;
+  SerSendString(sstring);
+  SerRecvString(4,rstring);  { get 4 char hex string }
+  if not SerRecvChar(retchar) then SerError := true; { get CR }
+  HexWordRead(rstring,data);
+  SerReadParamWordQ := data;
+end;
+
+function SerReadParamQ(command:word) : longint;
+var
+sstring : string;
+rlstring : string;
+rhstring : string;
+ldata : longint;
+retchar : char;
+begin
+  sstring := SerWriteQFIFOCom + HexString(command,4) + CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  sstring := SerReadQFIFOCom + CR;
+  SerSendString(sstring);
+  SerRecvString(4,rlstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  SerSendString(sstring);
+  SerRecvString(4,rhstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  HexLongRead(rhstring+rlstring,ldata);
+  SerReadParamQ := ldata;
+end;
+
+{$IFDEF COPROC}
+function SerReadParamDoubleQ(command:word) : comp;
+var
+sstring : string;
+r0string,r1string,r2string,r3string : string;
+cdata : comp;
+retchar : char;
+begin
+  sstring := SerWriteQFIFOCom + HexString(command,4) + CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  sstring := SerReadQFIFOCom + CR;
+  SerSendString(sstring);
+  SerRecvString(4,r0string);
+  if not SerRecvChar(retchar) then SerError := true;
+  SerSendString(sstring);
+  SerRecvString(4,r1string);
+  if not SerRecvChar(retchar) then SerError := true;
+  SerSendString(sstring);
+  SerRecvString(4,r2string);
+  if not SerRecvChar(retchar) then SerError := true;
+  SerSendString(sstring);
+  SerRecvString(4,r3string);
+  if not SerRecvChar(retchar) then SerError := true;
+  HexLongRead(r0string+r1string,DoubleLongRec(cdata).Long0);
+  HexLongRead(r2string+r3string,DoubleLongRec(cdata).Long1);
+  SerReadParamDoubleQ := cdata;
+end;
+{$ENDIF}
+procedure SerWriteParamWordQ(command:word;data:word);
+var
+sstring : string;
+retchar : char;
+begin
+  sstring := SerWriteQFIFOCom+HexString(command,4)+CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  sstring := SerWriteQFIFOCom+HexString(data,4)+CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+procedure SerWriteParamQ(command: word;ldata:longint);
+var
+sstring : string;
+retchar : char;
+begin
+  sstring := SerWriteQFIFOCom + HexString(command,4)+ CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  sstring := SerWriteQFIFOCom + HexString(LongIntRec(ldata).LowWord,4) + CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  sstring := SerWriteQFIFOCom + HexString(LongIntRec(ldata).HighWord,4) + CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+{$IFDEF COPROC}
+procedure SerWriteParamDoubleQ(command: word;cdata:comp);
+var
+sstring : string;
+retchar : char;
+begin
+  sstring := SerWriteQFIFOCom + HexString(command,4)+ CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  sstring := SerWriteQFIFOCom + HexString(DoubleIntRec(cdata).Word0,4) + CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  sstring := SerWriteQFIFOCom + HexString(DoubleIntRec(cdata).Word1,4) + CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  sstring := SerWriteQFIFOCom + HexString(DoubleIntRec(cdata).Word2,4) + CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  sstring := SerWriteQFIFOCom + HexString(DoubleIntRec(cdata).Word3,4) + CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+{$ENDIF}
+
+procedure ReadGroup( group : word;ourbuffer : bufptr);
+var
+rstring,sstring : string;
+retchar : char;
+index : word;
+begin
+  sstring := SerReadGroupCom+ HexString(group,4)+CR;
+  SerSendString(sstring);
+  for index := 1 to GroupSize do
+  begin
+    SerRecvString(2,rstring);
+    HexByteRead(rstring,ourbuffer^[index]);
+  end;
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+procedure ClearChecksum;
+var
+sstring : string;
+retchar : char;
+begin
+  sstring := SerEraseChecksumCom+CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+function ReadChecksum : byte;
+var
+rstring,sstring : string;
+data : byte;
+retchar : char;
+begin
+  sstring := SerReadChecksumCom + CR;
+  SerSendString(sstring);
+  SerRecvString(2,rstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  HexbyteRead(rstring,data);
+  ReadChecksum := data;
+end;
+
+procedure oldSerUnlock;
+var
+sstring : string;
+retchar : char;
+begin
+  sstring := SerWriteProtectCom+'00'+CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+function SerUnlock : boolean;
+var
+sstring : string;
+retchar : char;
+begin
+  SerUnlock := false;
+  sstring := SerWriteProtectCom+'00'+CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  if retchar = CR then SerUnlock := true;
+end;
+
+procedure oldSerLock;
+var
+sstring : string;
+retchar : char;
+begin
+  sstring := SerWriteProtectCom+ 'FF'+CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+function SerLock : boolean;
+var
+sstring : string;
+retchar : char;
+begin
+  SerLock := false;
+  sstring := SerWriteProtectCom+ 'FF'+CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  if retchar = CR then SerLock := true;
+end;
+
+procedure SerPicGo(address:word);
+var
+sstring : string;
+begin
+  SerUnlock;
+  sstring := SerPicGoCom+HexString(address,4)+CR;
+  SerSendString(sstring);
+ { if not SerRecvChar(retchar) then SerError := true;}
+end;
+
+procedure SerClearICDFIFO;
+var
+sstring : string;
+retchar : char;
+begin
+  sstring := SerClearICDFIFOCom+CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+procedure SerClearQCDFIFO;
+var
+sstring : string;
+retchar : char;
+begin
+  sstring := SerClearQCDFIFOCom+CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+procedure SerClearIRBFIFO;
+var
+sstring : string;
+retchar : char;
+begin
+  sstring := SerClearIRBFIFOCom+CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+procedure SerClearQRBFIFO;
+var
+sstring : string;
+retchar : char;
+begin
+  sstring := SerClearQRBFIFOCom+CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+procedure WriteFlashBlock( block : byte;ourbuffer : bufptr);
+var
+sstring : string;
+retchar : char;
+index : word;
+begin
+  sstring := SerWriteFlashCom + HexString(block,2)+CR;
+  SerSendString(sstring);
+  for index := 1 to FlashBlockSize do
+  begin
+    SerSendString(HexString(ourbuffer^[index],2))
+  end;
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+procedure WriteNewFlashBlock( block : word; size : word; ourbuffer : bufptr);
+var
+sstring : string;
+retchar : char;
+index : word;
+begin
+  sstring := SerWriteFlashCom+ HexString(block,4)+CR;
+  SerSendString(sstring);
+  for index := 1 to size do
+  begin
+    SerSendString(HexString(ourbuffer^[index],2));
+  end;
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+procedure EraseFlashBlock( block : byte);
+var
+sstring : string;
+retchar : char;
+begin
+  sstring := SerEraseFlashCom+ HexString(block,2)+CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+procedure ReadFlashBlock( block : byte;ourbuffer : bufptr);
+var
+rstring,sstring : string;
+retchar : char;
+index : word;
+begin
+  sstring := SerReadFlashCom+ HexString(block,2)+CR;
+  SerSendString(sstring);
+  for index := 1 to FlashBlockSize do
+  begin
+    SerRecvString(2,rstring);
+    HexByteRead(rstring,ourbuffer^[index]);
+  end;
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+procedure ReadNewFlashBlock( block : byte; size : word; ourbuffer : bufptr);
+var
+rstring,sstring : string;
+retchar : char;
+index : word;
+begin
+  sstring := SerReadFlashCom+ HexString(block,4)+CR;
+  SerSendString(sstring);
+  for index := 1 to size do
+  begin
+    SerRecvString(2,rstring);
+    HexByteRead(rstring,ourbuffer^[index]);
+  end;
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+function InquireRev : byte;
+var
+rstring,sstring : string;
+data : byte;
+retchar : char;
+begin
+  sstring := SerInquireRevCom +CR;
+  SerSendString(sstring);
+  SerRecvString(2,rstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  HexbyteRead(rstring,data);
+  InquireRev := data;
+end;
+
+procedure SerWriteEEPROM(addr: byte;data:byte);
+var
+sstring : string;
+retchar : char;
+begin
+  sstring := SerWriteEEPROMCom + HexString(addr,2)+ HexString(data,2) + CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+function SerReadEEPROM(add:byte) : byte;
+var
+rstring,sstring : string;
+data : byte;
+retchar : char;
+begin
+  sstring := SerReadEEPROMCom +HexString(add,2)+ CR;
+  SerSendString(sstring);
+  SerRecvString(2,rstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  HexbyteRead(rstring,data);
+  SerReadEEPROM := data;
+end;
+
+procedure SerWriteEEPROMWord(addr: word;data:word);
+var
+sstring : string;
+retchar : char;
+begin
+  sstring := SerWriteEEPROMWordCom + HexString(addr,4)+ HexString(data,4) + CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+function SerReadEEPROMWord(add:word) : word;
+var
+rstring,sstring : string;
+data : word;
+retchar : char;
+begin
+  sstring := SerReadEEPROMWordCom +HexString(add,4)+ CR;
+  SerSendString(sstring);
+  SerRecvString(4,rstring);
+  if not SerRecvChar(retchar) then SerError := true;
+  HexWordRead(rstring,data);
+  SerReadEEPROMWord := data;
+end;
+
+procedure EraseGroup(block : word);
+var
+sstring : string;
+retchar : char;
+begin
+  sstring := SerEraseGroupCom+ HexString(block,4)+CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+procedure WritePLL(data:byte);
+var
+sstring : string;
+retchar : char;
+begin
+  sstring := SerWriteOscCom + HexString(data,2) + CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+procedure ConfigureFPGA;
+var
+sstring : string;
+retchar : char;
+begin
+  sstring := SerConfigCom+CR;
+  SerSendString(sstring);
+  if not SerRecvChar(retchar) then SerError := true;
+end;
+
+function SerSync : boolean;
+var
+i : longint;
+retchar : char;
+sstring : string;
+begin
+{  forceRTSLow(TheComPort); bogus - dos only}
+  SerSync := false;
+  SerTossChars;
+  SerSetRTSHigh;
+  SerSendChar('x'); { send invalid command or data }
+  SerSendChar(CR);
+  if SerRecvChar(retchar) then
+  begin
+    delay(10); { wait for chars to arrive }
+    SerTossChars;
+    SerSendChar('x'); { send invalid command or data }
+    SerSendChar(CR);
+    if SerRecvChar(retchar) then
+    begin
+     delay(10); { wait for chars to arrive }
+     SerTossChars;
+      if retchar = '?' then
+      begin
+{ checking changed to avoid SerWriteProtect }
+        sstring := InquireID;
+        begin
+          if length(sstring) = 4 then
+          begin
+            SerSync := true;
+            SerError := false;
+          end
+        end;
+      end;
+    end;
+  end;
+end;
+
+function SerialCheck : boolean;
+begin
+  SerialCheck := true;
+  if SerError then
+  begin
+    SerialCheck := false;
+    SerSync;
+  end;
+end;
+
+{ changed group size to word 11-30-06 ge }

5i24/utils/dos/source/SERIAL.PAS

@@ -0,0 +1,575 @@
+{ low level 16C450 + 16C550 type serial port routines }
+
+const
+Com1       =$03F8;
+Com2       =$02F8;
+Com3       =$03E8;
+Com4       =$02E8;
+RecReg     =$00;
+TrHReg     =$00;
+DivLatLSB  =$00;
+DivLatMSB  =$01;
+IntEn      =$01;
+IntId      =$02;
+FIFOCont   =$02;
+LineCont   =$03;
+ModemCont  =$04;
+LineStat   =$05;
+ModemStat  =$06;
+Scratch    =$07;
+
+StdBRClock = 1.8432E6;         { IBM's dumb rate }
+HiBRClock  = 8.0000E6;         { for newer 16C550's }
+RealHIBRClock = 2.4000E7;      { for some 16C552's ... Wheee! }
+DoubleBRClock = 3.6864E6;
+QuadBRClock = DoubleBRClock*2;
+
+{ Line control register stuff }
+WLen5      =$00;
+WLen6      =$01;
+WLen7      =$02;
+WLen8      =$03;
+StopBits   =$04;
+ParityEn   =$08;
+EvenParity =$10;
+StickParity=$20;
+SetBreak   =$40;
+DLAB       =$80;
+NoDLAB     =$7F;
+
+DefaultLCR = 0 or WLen8;
+
+{ Line status register stuff }
+DataReady  =$01;
+OverRunErr =$02;
+ParityErr  =$04;
+FrameErr   =$08;
+BreakInt   =$10;
+THRE       =$20;
+TSRE       =$40;
+
+{ Interrupt ID register stuff }
+
+{ read masks }
+IntPending  =$01;
+RecChar     =$04;
+XmitRdy     =$02;
+RecErr      =$06;
+
+{ FIFO control register stuff }
+
+FIFOEnable     =$01;
+RecvFIFORst    =$02;
+XmitFIFORst    =$04;
+DMAMode        =$08;
+RecvTrig1      =$00;
+RecvTrig4      =$40;
+RecvTrig8      =$80;
+RecvTrig14     =$C0;
+FIFOsOn        =$C0;
+
+{ Interrupt enable register stuff }
+
+DAvIntEn    =$01;
+TXRdyIntEn  =$02;
+RXErrIntEn  =$04;
+LineChIntEn =$08;
+
+DefaultIER = 0;
+
+{ Modem control register stuff }
+DTRBit      =$01;
+RTSBit      =$02;
+Out1Bit     =$04;
+Out2Bit     =$08;
+LoopBack    =$10;
+
+defaultMCR = 0 or DTRBit or RTSBit or Out1Bit;
+
+{ Modem status register stuff }
+DelCTS      =$01;
+DelDSR      =$02;
+DelRI       =$04;
+DelCD       =$08;
+CTSBit      =$10;
+DSRBit      =$20;
+RIBit       =$40;
+CDBit       =$80;
+
+type
+
+PortType  =(CP8250,CP16450,CP16550);
+
+SerialSetupType = record
+  BaudRate : real;
+  IntEnImage : byte;
+  LineContImage : byte;
+  ModemContImage : byte;
+end;
+
+FifteenCharFIFO = record
+  PutPointer : word;
+  GetPointer : word;
+  DataBuffer  : array [0..15] of byte;
+  ErrorBuffer : array [0..15] of byte;
+end;
+
+
+function BRDivisorFromBaud(BRC : real;baudrate : longint) : word;
+begin
+  BRDivisorFromBaud := word(trunc(STDBRClock/(baudrate*16)+0.5));
+end;
+
+procedure SetBRDivisor(comPort : word; divisor : word);
+var
+portSave : byte;
+begin
+  portSave := port[comPort + LineCont];
+  port[comPort + LineCont] := portSave or DLAB;
+  port[comPort + DivLatLSB] := lo(divisor);
+  port[comPort + DivLatMSB] := hi(divisor);
+  port[comPort + LineCont] := portSave and NoDLAB;
+end;
+
+procedure GetBRDivisor(comPort : word; var divisor : word);
+var
+portSave : byte;
+begin
+  portSave := port[comPort + LineCont];
+  port[comPort + LineCont] := portSave or DLAB;
+  divisor := port[comPort + DivLatLSB];
+  divisor := divisor or (port[comPort + DivLatMSB] * $0100);
+  port[comPort + LineCont] := portSave and NoDLAB;
+end;
+
+
+procedure  SetOptBaudRate(comPort : word; baudRate : real; brclock : real);
+var
+divisor : word;
+begin
+  divisor := word(trunc((brclock/baudRate)/16 + 0.5));
+  SetBRDivisor(comPort,divisor);
+end;
+
+procedure  SetBaudRate(comPort : word; baudRate : real);
+begin
+  SetOptBaudRate(comport,baudrate,StdBRClock);
+end;
+
+procedure EnableIntDriver(comPort : word);
+var
+portSave : word;
+
+begin
+  portSave := port[comPort + ModemCont];
+  port[comPort + ModemCont] := portSave or Out2Bit;
+end;
+
+procedure DisableIntDriver(comPort : word);
+var
+portSave : word;
+
+begin
+  portSave := port[comPort + ModemCont];
+  port[comPort + ModemCont] := portSave and ($FF xor Out2Bit);
+end;
+
+procedure ForceDTRLow(comPort : word);
+var dtemp : byte;
+begin
+  dtemp := port[comPort + ModemCont];
+  port[comPort + ModemCont] :=  dtemp and ($FF xor DTRBit);
+end;
+
+procedure ForceDTRHigh(comPort : word);
+var dtemp : byte;
+begin
+  dtemp := port[comPort + ModemCont];
+  port[comPort + ModemCont] := (dtemp or DTRBit);
+end;
+
+procedure ForceRTSLow(comPort : word);
+var dtemp : byte;
+begin
+  dtemp := port[comPort + ModemCont];
+  port[comPort + ModemCont] :=  dtemp and ($FF xor RTSBit);
+end;
+
+procedure ForceRTSHigh(comPort : word);
+var dtemp : byte;
+begin
+  dtemp := port[comPort + ModemCont];
+  port[comPort + ModemCont] := (dtemp or RTSBit);
+end;
+
+procedure ForceOut1Low(comPort : word);
+var dtemp : byte;
+begin
+  dtemp := port[comPort + ModemCont];
+  port[comPort + ModemCont] :=  dtemp and ($FF xor Out1Bit);
+end;
+
+procedure ForceOut1High(comPort : word);
+var dtemp : byte;
+begin
+  dtemp := port[comPort + ModemCont];
+  port[comPort + ModemCont] := (dtemp or Out1Bit);
+end;
+
+procedure EnableFIFOs(comport : word);
+begin
+  port[comPort + FIFOCont] := (FIFOEnable or RecvTrig8);
+end;
+
+procedure DisableFIFOs(comport : word);
+begin
+  port[comPort + FIFOCont] := 0;
+end;
+
+{ These 6I23 routines assume that the card jumpering is set }
+{ for software enabled RS485 drive with power-up off drive enable polarity}
+
+procedure DriveOn6I23(comPort: word);
+begin
+  ForceOut1Low(comPort);
+end;
+
+procedure DriveOff6I23(comPort: word);
+begin
+  ForceOut1High(comPort);
+end;
+
+{ These 4I23 routines assume that the card jumpering is set }
+{ for software enabled RS485 drive with power-up off drive enable polarity}
+
+procedure DriveOn4I23(comPort: word);
+begin
+  ForceRTSHigh(comPort);
+end;
+
+procedure DriveOff4I23(comPort: word);
+begin
+  ForceRTSLow(comPort);
+end;
+
+
+procedure PolledGetComChar(comPort : word; var cchar : char);
+begin
+  while (port[comPort + LineStat] and DataReady) = 0 do {wait for rec char} ;
+  cchar := char(port[comPort + RecReg]);
+end;
+
+function PolledGetComCharWithTimeout(comPort : word; var cchar : char; ctimeout : longint) : longint;
+begin
+  while ((port[comPort + LineStat] and DataReady) = 0)
+  and (ctimeout <> 0) do ctimeout := ctimeout -1;
+  {wait for rec char} ;
+  if ctimeout <> 0 then cchar := char(port[comPort + RecReg]);
+  PolledGetComCharWithTimeout := ctimeout;
+end;
+
+procedure TossChars(comPort : word;n: byte);
+var count : byte;
+thechar : char;
+begin
+  {old for count := 1 to n do thechar := port[comPort+RecReg]; }
+  for count := 1 to n do PolledGetComCharWithTimeout(comPort,thechar,100); { for 4i63 }
+end;
+
+procedure DefaultComInit(comPort : word);
+begin
+  DisableIntDriver(comPort);
+  port[comPort + LineCont]  := DefaultLCR;
+  port[comPort + IntEn]     := DefaultIER;
+  port[comPort + ModemCont] := DefaultMCR;
+  TossChars(comPort,18);
+  { make real sure there are no pending chars }
+end;
+
+function SKeyPressed : boolean;
+var flag : boolean;
+begin
+  asm
+    mov ah,01
+    int $16
+    mov flag,false
+    jz @nokey
+    mov flag,true
+    @nokey:
+  end;
+  SKeyPressed := flag;
+end;
+
+function CTSHighQ(comport : word): boolean;
+begin
+  if port[comport +ModemStat] and CTSBit = 0 then CTSHighQ := false else CTSHighQ := true;
+end;
+
+procedure WaitForCTSHigh(comport : word);
+begin
+  while not CTSHighQ(comport) do;
+end;
+
+procedure WaitForCTSHighWithTimeout(comport : word;var timeout : longint);
+var loops : longint;
+begin
+  loops := 0;
+  while not CTSHighQ(comport) and (loops < timeout) do loops := loops +1;
+  timeout := loops;
+end;
+
+function PolledGetComCharWithKeyAbort(comPort : word; var cchar : char): boolean;
+begin
+  while ((port[comPort + LineStat] and DataReady) = 0)
+  and (not SKeyPressed) do ;
+  { wait for rec char or key pressed }
+  if not SKeyPressed then
+  begin
+    cchar := char(port[comPort + RecReg]);
+    PolledGetComCharWithKeyAbort := false;
+  end
+  else
+  begin
+    PolledGetComCharWithKeyAbort := true;
+  end;
+end;
+
+procedure PolledPutComChar(comPort : word; cchar : char);
+begin
+  while (port[comPort + LineStat] and THRE) = 0 do {wait for xmit char} ;
+  port[comPort + TrHReg] := byte(cchar);
+end;
+
+procedure WaitForXmitDone(comport : word);
+begin
+  while (port[comPort + LineStat] and (TSRE or THRE)) = 0 do {wait for all xmit chars to be gone };
+end;
+
+
+procedure Polled485PutComChar(comPort : word; cchar : char);
+begin
+  ForceRTSHigh(comPort);
+  while (port[comPort + LineStat] and THRE) = 0 do {wait for xmit char} ;
+  port[comPort + TrHReg] := byte(cchar);
+  WaitForXmitDone(comPort);
+  ForceRTSLow(comPort);
+end;
+
+procedure PolledPutComCharWithHandshake(comPort : word; cchar : char);
+begin
+  while ((port[comPort + ModemStat] and CTSBit) = 0)
+  and (not SKeyPressed) do ;
+  { wait for cts or key pressed }
+  if not SKeyPressed then
+  begin
+    port[comPort + TrHReg] := byte(cchar); {write the char}
+    while (port[comPort + LineStat] and TSRE) = 0 do {wait for xmit char} ;
+  end;
+end;
+
+procedure PolledPutComCharWithCTSHandshakeAndTimeout(comPort : word; cchar : char; timeout : longint);
+begin
+  WaitForCTSHighWithTimeout(comPort,timeout);
+  begin
+    port[comPort + TrHReg] := byte(cchar); {write the char}
+    while (port[comPort + LineStat] and TSRE) = 0 do {wait for xmit char} ;
+  end;
+end;
+
+procedure PutOneComChar(comPort : word; cchar : char);
+begin
+  port[comPort + TrHReg] := byte(cchar);
+  WaitForXmitDone(comport);
+end;
+
+procedure SetUpForRecInt(comPort : word);
+var loop,temp : byte;
+begin
+  port[comPort + IntEn] := DAvIntEn or RxErrIntEn;
+  for loop := 0 to 15 do
+  begin
+    temp := port[comPort + RecReg];
+    temp := port[comPort + LineStat];
+    temp := port[comPort + IntId];
+    temp := port[comPort + ModemStat];
+  end;
+  EnableIntDriver(comPort);
+end;
+
+procedure SetUpForXmitInt(comPort : word);
+var loop,temp : byte;
+begin
+  EnableIntDriver(comPort);
+  for loop := 0 to 15 do
+  port[comPort + IntEn] := TXRdyIntEn;
+  begin
+    temp := port[comPort + IntId];
+    temp := port[comPort + RecReg];
+    temp := port[comPort + LineStat];
+    temp := port[comPort + ModemStat];
+  end;
+end;
+
+procedure ForceIRQLow(comPort : word);
+begin
+  EnableIntDriver(comPort);
+  port[comPort + IntEn] := 0;
+end;
+
+{**** Software FIFO stuff for int driven examples ****}
+
+procedure InitFIFO(fifo : FifteenCharFIFO);
+begin
+  with fifo do
+  begin
+    PutPointer := 0;
+    GetPointer := 0;
+  end;
+end;
+
+function FIFOHasData(fifo : FifteenCharFIFO): boolean;
+begin
+  FIFOHasData := false;
+  with fifo do
+  begin
+    if GetPointer <> PutPointer then FIFOHasData := true;
+  end;
+end;
+
+function FIFOIsFull(fifo : FifteenCharFIFO): boolean;
+begin
+  FIFOIsFull := false;
+  with fifo do
+  begin
+    { if hypothetical put put would smash get data then fifo is full! }
+    { + 2 is to avoid empty=full case (and why its only 15 chars long }
+    if ((PutPointer + 2) and $0F)  = GetPointer then FIFOIsFull := true;
+  end;
+end;
+
+function FIFOGet(fifo : FifteenCharFIFO) : word;
+begin
+  if FIFOHasData(fifo) then
+  begin
+    with fifo do
+    begin
+      FIFOGet := DataBuffer[GetPointer] or (ErrorBuffer[GetPointer] * 256);
+      GetPointer := (GetPointer +1) and $0F;
+    end;
+  end;
+end;
+
+procedure FIFOPut(fifo : FifteenCharFIFO;data :word);
+begin
+  if not FIFOIsFull(fifo) then
+  begin
+    with fifo do
+    begin
+      DataBuffer[PutPointer]  := byte(data);
+      ErrorBuffer[PutPointer] := byte(data shr 8);
+      PutPointer := (PutPointer +1) and $0F;
+    end;
+  end;
+end;
+
+function GetRecIntChar(comPort : word;var achar : char) : boolean;
+var
+temp : byte;
+begin
+  temp := port[comPort+IntId];
+  if temp and $7 = 4 then { valid rec char or FIFO timeout on '550 }
+  begin
+    achar := char(port[comPort + RecReg]);
+    GetRecIntChar := true;
+  end
+  else
+  begin
+    temp := port[comPort +LineStat];
+    GetRecIntChar := false;
+  end;
+  port[comPort + IntEn] := 0;                  { make sure we generate a new IRQ edge }
+  port[comPort + IntEn] := DAvIntEn or RxErrIntEn;     { by disabling then re-enabling the IRQ }
+end;
+
+function COMPortThere(comport : word) : boolean;
+var
+tdata : byte;
+bdata : word;
+olddivisor :word;
+begin
+  GetBRDivisor(comport,olddivisor);
+  COMPortThere := true;
+  { used to start at 0 but Exar UARTs wont allow 0 in divisor reg }
+  for tdata := 1 to 100 do
+  begin
+    SetBRDivisor(comport,tdata*631);
+    GetBRDivisor(comport,bdata);
+    if bdata <> (tdata * 631) then ComPortThere := false;
+  end;
+  SetBRDivisor(comport,olddivisor);
+end;
+
+function CarefulCOMPortThere(comport : word) : boolean;
+var
+tdata : byte;
+bdata : word;
+olddivisor :word;
+oldscratch : byte;
+begin
+  CarefulComPortThere := false;
+  oldscratch := port[comport + $07];
+  port[comport+$07] := $55;
+  tdata := port[comport +$07];
+  port[comport+$07] := (tdata xor $FF);
+  if tdata = $AA then
+  begin
+    GetBRDivisor(comport,olddivisor);
+    CarefulCOMPortThere := true;
+    { used to start at 0 but Exar UARTs wont allow 0 in divisor reg }
+    for tdata := 1 to 100 do
+    begin
+      SetBRDivisor(comport,tdata*631);
+      GetBRDivisor(comport,bdata);
+      if bdata <> (tdata * 631) then CarefulComPortThere := false;
+    end;
+    SetBRDivisor(comport,olddivisor);
+  end;
+  port[comport + $0F] := oldscratch
+
+end;
+
+function COMPortType(comport : word) : PortType;
+var
+tdata : byte;
+thetype : PortType;
+begin
+  thetype := CP16450;
+  for tdata := 0 to 255 do
+  begin
+    port[comport+Scratch] := tdata;
+    port[comport+ModemStat] := $FF xor tdata;
+    if port[comport + Scratch] <> tdata then thetype := CP8250;
+  end;
+  if thetype <> CP8250 then
+  begin
+    port[comport+FIFOCont] := 0;
+    if (port[comport+FIFOCont] and FIFOsOn) = 0 then
+    begin
+      port[comport+FIFOCont] := FIFOEnable;
+      if (port[comport+FIFOCont] and FIFOsOn) <> 0 then thetype := CP16550;
+      port[comport+FIFOCont] := 0;
+    end;
+  end;
+  COMPortType := thetype;
+end;
+
+procedure PrintComPortType(comport : word);
+begin
+  writeln;
+  case ComPortType(comport) of
+    CP8250  : writeln('COM port type is 8250');
+    CP16450 : writeln('COM port type is 16450');
+    CP16550 : writeln('COM port type is 16550');
+  end;
+end;
+

5i24/utils/dos/source/SSLBPLOW.PAS

@@ -0,0 +1,900 @@
+{ SSLBPLOW.PAS}
+{ can't include because of duplicate names SSLBPINC.PAS}
+{I sslbpinc}
+
+type
+CSRRec = record
+  Error : byte;
+  Status : byte;
+  State : byte;
+  WhatIam : byte;
+end;
+
+const
+AxisStride = 4;
+TheBasePort = $378;
+Requestbit = $2000;
+Writebit   = $8000;
+Doitbit =    $1000;
+Startbit =   $0800;
+StandardRPC = 0; { for standardstart }
+AltRpc      = 1;
+
+SSLBPMajorRevisionLoc = 2;
+SSLBPMinorRevisionLoc = 3;
+SSLBPChannelStartLoc =  4;
+SSLBPChannelStrideLoc = 5;
+SSLBPProcessorType =    6;
+SSLBPNumberOfChannels = 7;
+
+SSLBPClock         = $230;
+SSLBPDividend       =  50;
+
+{ChanDisableCRCOffset = 30;}
+{ChanBaudrateOffset = 42;}
+chanrecvstringOffset        =      0;              { (ptr) 16 bytes, first to be able to use offsets }
+chanstateOffset             =      16;             { (byte) state }
+chanerrorOffset             =      17;             { (byte) bitfield of error bits }
+chanerrorlogOffset          =      18;             { (byte) bitfield of sticky errorbits }
+chanstatusOffset            =      19;             { (byte) status }
+chancrccountOffset          =      20;             { (byte)  }
+chancookiecountOffset       =      21;             { (byte)  }
+chanoverruncountOffset      =      22;             { (byte)  }
+chantimeoutcountOffset      =      23;             { (byte)  }
+chanextracharcountOffset    =      24;             { (byte)  }
+chanbreakcountOffset        =      25;             { (byte)  }
+chanremfaultcountOffset     =      26;             { (byte)  }
+chanerrorcountOffset        =      27;             { (byte) required number of errors to cause status error }
+chanLBPdatasizeOffset       =      28;             { (byte)  }
+chanidOffset                =      29;             { (byte) id byte for 8I20,7I64  }
+chandisablecrcOffset        =      30;             { (byte)  }
+chanclrfaultcountOffset     =      31;             { (byte)  }
+{ NUchandatabase		$	%uint	base for data discovery }
+chanchktoomanyerrsOffset    =      32;             { (byte) true at startup, false after blather }
+chanstarttimeOffset         =      33;             { (uint) start of timeout }
+chantimeoutOffset           =      35;             { (byte) error when deltatime is greater }
+changenericOffset           =      36;             { (byte) nonzero if generic }
+chanremfaultOffset          =      37;             { (byte)  }
+chanwhatiamOffset           =      38;             { (ulong)  }
+chanbaudrateOffset          =      42;             { (ulong)  }
+chanRPCrecvsizeOffset       =      46;             { (byte)  }
+chanRPCxmitsizeOffset       =      47;             { (byte)  }
+chanmeasuredtimeOffset      =      48;             { (byte)  }
+NUchanLBPcompatOffset       =      49;             { (byte) read from remote }
+
+type
+StateParamRec =
+record
+  ParmName : string[24];
+  ParmLoc  : longint;
+end;
+
+const
+StateLastParm = 68;
+StateParams : array[1 .. StateLastParm] of StateParamRec =
+((ParmName : 'reset'; ParmLoc : 0),
+(ParmName : 'starttimer'; ParmLoc : 1),
+(ParmName : 'waittimeout'; ParmLoc : 2),
+(ParmName : 'requestcookie'; ParmLoc : 3),
+(ParmName : 'getcookie'; ParmLoc : 4),
+(ParmName : 'setlbptimeout'; ParmLoc : 5),
+(ParmName : 'checksetlbptimeout'; ParmLoc : 6),
+(ParmName : 'clrlbpstatus'; ParmLoc : 7),
+(ParmName : 'checkclrlbpstatus'; ParmLoc : 8),
+(ParmName : 'requestlbpstatus'; ParmLoc : 9),
+(ParmName : 'getlbpstatus'; ParmLoc : 10),
+(ParmName : 'checklbpstatus'; ParmLoc : 11),
+(ParmName : 'requestunitnumber'; ParmLoc : 12),
+(ParmName : 'getunitnumber'; ParmLoc : 13),
+(ParmName : 'requestid0'; ParmLoc : 14),
+(ParmName : 'getid0'; ParmLoc : 15),
+(ParmName : 'requestid1'; ParmLoc : 16),
+(ParmName : 'getid1'; ParmLoc : 17),
+(ParmName : 'requestid2'; ParmLoc : 18),
+(ParmName : 'getid2'; ParmLoc : 19),
+(ParmName : 'requestid3'; ParmLoc : 20),
+(ParmName : 'getid3'; ParmLoc : 21),
+(ParmName : 'checkid0'; ParmLoc : 22),
+(ParmName : 'checkid1'; ParmLoc : 23),
+(ParmName : 'clear7I64faults'; ParmLoc : 24),
+(ParmName : 'check7I64faults'; ParmLoc : 25),
+(ParmName : 'setswmode'; ParmLoc : 26),
+(ParmName : 'checkswmode'; ParmLoc : 27),
+(ParmName : 'requestdiscovery'; ParmLoc : 28),
+(ParmName : 'getdiscovery'; ParmLoc : 29),
+(ParmName : 'cleargen'; ParmLoc : 30),
+(ParmName : 'checkcleargen'; ParmLoc : 31),
+(ParmName : 'setgenclrfaults'; ParmLoc : 32),
+(ParmName : 'chksetgenclrfaults'; ParmLoc : 33),
+(ParmName : 'reqgenclrfaults'; ParmLoc : 34),
+(ParmName : 'getgenclrfaults'; ParmLoc : 35),
+(ParmName : 'reqgenfaults'; ParmLoc : 36),
+(ParmName : 'getgenfaults'; ParmLoc : 37),
+(ParmName : 'chkgenfaults'; ParmLoc : 38),
+(ParmName : 'setclrfaults'; ParmLoc : 39),
+(ParmName : 'checksetclrfaults'; ParmLoc : 40),
+(ParmName : 'requestclrfaults'; ParmLoc : 41),
+(ParmName : 'getclrfaults'; ParmLoc : 42),
+(ParmName : 'requestfaults'; ParmLoc : 43),
+(ParmName : 'getfaults'; ParmLoc : 44),
+(ParmName : 'checkfaults'; ParmLoc : 45),
+(ParmName : 'clearsetpoint'; ParmLoc : 46),
+(ParmName : 'checkclearsetpoint'; ParmLoc : 47),
+(ParmName : 'setpidena'; ParmLoc : 48),
+(ParmName : 'checksetpidena'; ParmLoc : 49),
+(ParmName : 'requestpidon'; ParmLoc : 50),
+(ParmName : 'getpidon'; ParmLoc : 51),
+(ParmName : 'checkpidon'; ParmLoc : 52),
+(ParmName : 'requestpidonfaults'; ParmLoc : 53),
+(ParmName : 'getpidonfaults'; ParmLoc : 54),
+(ParmName : 'checkpidonfaults'; ParmLoc : 55),
+(ParmName : 'setwatchdog'; ParmLoc : 56),
+(ParmName : 'checksetwatchdog'; ParmLoc : 57),
+(ParmName : 'blather0'; ParmLoc : 58),
+(ParmName : 'blather1'; ParmLoc : 59),
+(ParmName : 'send8I20'; ParmLoc : 60),
+(ParmName : 'recv8I20'; ParmLoc : 61),
+(ParmName : 'send7I64'; ParmLoc : 62),
+(ParmName : 'recv7I64'; ParmLoc : 63),
+(ParmName : 'sendLBP'; ParmLoc : 64),
+(ParmName : 'recvLBP'; ParmLoc : 65),
+(ParmName : 'sendgeneric'; ParmLoc : 66),
+(ParmName : 'recvgeneric'; ParmLoc : 67));
+
+StopMode =    $000;
+StopAllMode = $0FF;
+NormalMode =  $100;
+SetupMode =   $700;
+
+Doitcommand  = Doitbit;
+
+Stopcommand = Startbit+StopMode;
+StopAllcommand = Startbit+StopMode;
+
+Startcommand = Startbit+NormalMode;
+StartSetupcommand = Startbit+SetupMode;
+
+CommandShift = 24;
+{ChannelReadyMask = $80;}
+
+ReadByteCommand = (LBPCOMMAND_byte+LBPA2_byte+LBPD1_byte) shl CommandShift;
+ReadWordCommand = (LBPCOMMAND_byte+LBPA2_byte+LBPD2_byte) shl CommandShift;
+ReadLongCommand = (LBPCOMMAND_byte+LBPA2_byte+LBPD4_byte) shl CommandShift;
+ReadDoubleCommand = (LBPCOMMAND_byte+LBPA2_byte+LBPD8_byte) shl CommandShift;
+
+WriteByteCommand = (LBPCOMMAND_byte+LBPWRITE_byte+LBPA2_byte+LBPD1_byte) shl CommandShift;
+WriteWordCommand = (LBPCOMMAND_byte+LBPWRITE_byte+LBPA2_byte+LBPD2_byte) shl CommandShift;
+WriteLongCommand = (LBPCOMMAND_byte+LBPWRITE_byte+LBPA2_byte+LBPD4_byte) shl CommandShift;
+WriteDoubleCommand = (LBPCOMMAND_byte+LBPWRITE_byte+LBPA2_byte+LBPD8_byte) shl CommandShift;
+
+var
+SSerial : byte; { for 2nd module }
+CommandPort : word;
+OurDataPort : word;
+CSRPort : word;
+InterfacePort0 : word;
+InterfacePort1 : word;
+InterfacePort2 : word;
+NumberOfBases : byte;
+SSLBPChannelStride : byte;
+SSLBPChannelStart : byte;
+SSLBPMajorRevision : byte;
+SSLBPMinorRevision : byte;
+
+procedure ShowSSLBPState(enum : longint);
+var
+index : integer;
+state : string;
+begin
+  state := 'Invalid State';
+  index := 1;
+  while (((StateParams[index].ParmLoc <> enum)) and
+        (index <= StateLastParm)) do index := index +1;
+  if index < StateLastParm then  state := StateParams[index].ParmName; { cannonical name}
+  writeln('State = ',state);
+end;
+
+
+
+procedure ShowSSLBPRemoteFaults(err : byte);
+begin
+  if err <> 0 then
+  begin
+    write('RemoteFaults:');
+    if err and $01 <> 0 then write(' Watchdog');
+    if err and $02 <> 0 then write(' Noenable');
+    if err and $04 <> 0 then write(' Overtemp');
+    if err and $08 <> 0 then write(' Overcurrent');
+    if err and $10<> 0 then write(' HighVoltage');
+    if err and $20 <> 0 then write(' LowVoltage');
+    if err and $40 <> 0 then write(' ModeSetting');
+    if err and $80 <> 0 then write(' LBPRemComm');
+    writeln;
+  end;
+end;
+
+procedure ShowSSLBPErrors( errstring : string; err : byte);
+begin
+  if err <> 0 then
+  begin
+    write(errstring,' Errors:');
+    if err and $01 <> 0 then write(' CRC');
+    if err and $02 <> 0 then write(' Cookie');
+    if err and $04 <> 0 then write(' Overrun');
+    if err and $08 <> 0 then write(' Timeout');
+    if err and $10<> 0 then write(' Extrachar');
+    if err and $20 <> 0 then write(' Breakchar');
+    if err and $40 <> 0 then write(' Remfault');
+    if err and $80 <> 0 then write(' Toomany');
+    writeln;
+  end;
+end;
+
+procedure ShowAllSSLBPErrors(csrval : longint);
+begin
+  ShowSSLBPErrors('',byte(csrval));
+  if (byte(csrval) and $40) <> 0 then ShowSSLBPRemoteFaults(longintbyterec(csrval).byte3);
+end;
+
+
+procedure ShowSSLBPStatus(s : byte);
+begin
+  if s <> 0 then
+  begin
+    write('Status:');
+    if s and $80 <> 0 then write(' NoBlather');
+    if s and $40 <> 0 then write(' NoID');
+    if s and $20 <> 0 then write(' Error');
+    if s and $01 <> 0 then write(' RemoteFault');
+    writeln;
+  end;
+end;
+
+procedure SSLBPDump(theaxis : byte);
+begin
+  write('Command Port ');
+  hexprint(Read32(CommandPort+(theaxis*AxisStride)),4);
+  writeln;
+  write('Data Port ');
+  hexprint(Read32(OurDataPort+(theaxis*AxisStride)),2);
+  writeln;
+  write('CSR Port ');
+  hexprint(Read32(CSRPort+(theaxis*AxisStride)),8);
+  writeln;
+  write('User0 ');
+  hexprint(Read32(InterfacePort0+(theaxis*AxisStride)),8);
+  writeln;
+  write('User1 ');
+  hexprint(Read32(InterfacePort1+(theaxis*AxisStride)),8);
+  writeln;
+  write('User2 ');
+  hexprint(Read32(InterfacePort2+(theaxis*AxisStride)),8);
+  writeln;
+end;
+
+function SSLBPReadCardName(theaxis : byte) : string;
+var
+  namenumber : longint;
+  name : string[4];
+begin
+  name := '';
+  namenumber := Read32(InterfacePort1+(theaxis*AxisStride));
+  name := name + char(LongIntByteRec(namenumber).Byte0);
+  name := name + char(LongIntByteRec(namenumber).Byte1);
+  name := name + char(LongIntByteRec(namenumber).Byte2);
+  name := name + char(LongIntByteRec(namenumber).Byte3);
+  SSLBPReadCardName := name;
+end;
+
+function CheckForReady(theaxis : byte) : boolean;
+var
+csr : longint;
+begin
+  csr := Read32(CSRPort+(theaxis*AxisStride));
+  if CSRRec(csr).Status = 0 then CheckForReady := true else CheckForReady := false;
+end;
+
+function CheckForErrors(theaxis : byte) : boolean;
+var
+csr : longint;
+begin
+  csr := Read32(CSRPort+(theaxis*AxisStride));
+  if CSRRec(csr).Error <> 0 then CheckForErrors := true else CheckForErrors := false;
+end;
+
+procedure Waitfordone; { timed }
+var
+done : longint;
+loops,time : longint;
+begin
+  loops := 100000;
+  time := 0;
+  repeat
+    begin
+      done := Read32(CommandPort);
+      loops := loops -1;
+      time := time +1;
+      {delay(1);}
+    end;
+  until (done = 0) or (loops = 0);
+{$IFDEF DEBUG}
+  writeln('WaitForDone Time in ms ',time,' Loops= ',loops);
+{$ENDIF DEBUG}
+  if loops = 0 then
+  begin
+    writeln('Timeout waiting for done');
+    SSLBPDump(Axis);
+    halt(2);
+  end;
+end;
+
+function WaitforStart : boolean; { false if timed out }
+var
+done : longint;
+loops,time : longint;
+begin
+  loops := 1000; { for bootstrap }
+  time := 0;
+  repeat
+    begin
+      done := Read32(CommandPort);
+      loops := loops -1;
+      time := time +1;
+      delay(1);
+    end;
+  until (done = 0) or (loops = 0);
+{$IFDEF DEBUG}
+  writeln('WaitForStart Time in ms ',time,' Loops= ',loops);
+{$ENDIF DEBUG}
+  if loops = 0 then WaitForStart := false else WaitForStart := true;
+end;
+
+function WaitforStartSetup : boolean; { false if timed out }
+var
+done : longint;
+loops,time : longint;
+begin
+  loops := 200;
+  time := 0;
+  repeat
+    begin
+      done := Read32(CommandPort);
+      loops := loops -1;
+      time := time +1;
+      delay(1);
+    end;
+  until (done = 0) or (loops = 0);
+{$IFDEF DEBUG}
+  writeln('StartSetup Time in ms ',time,' Loops= ',loops);
+{$ENDIF DEBUG}
+  if loops = 0 then WaitForStartSetup := false else WaitForStartSetup := true;
+end;
+
+function Start(bitmask : byte) : byte;
+begin
+  Write32(CommandPort,Startcommand+bitmask);
+  if not WaitForStart then Start := $FF else Start := byte(Read32(OurDataPort));
+end;
+
+function StartSetup(bitmask : byte) : byte;
+begin
+  Write32(CommandPort,StartSetupcommand+bitmask);
+  if not WaitForStartSetup then StartSetup := $FF else StartSetup := byte(Read32(OurDataPort));
+end;
+
+function AxisStartSetup(theaxis : byte) : boolean; { true if success }
+var bitaxis,returnbyte : byte;
+begin
+  bitaxis := 1 shl theaxis;
+  returnbyte := StartSetup(bitaxis);
+
+  AxisStartSetup := (returnbyte = 0);
+end;
+
+function AxisStart(theaxis : byte) : boolean; { true if success }
+var bitaxis,returnbyte : byte;
+begin
+  bitaxis := 1 shl theaxis;
+  returnbyte := Start(bitaxis);
+  AxisStart := (returnbyte and bitaxis = 0);
+end;
+
+procedure SSLBPStop(bitmask : byte);
+begin
+  Write32(CommandPort,StopCommand+bitmask);
+  Waitfordone;
+end;
+
+procedure SSLBPStopAll;
+var i : integer;
+begin
+  Write32(CommandPort,StopAllCommand);
+  Waitfordone;
+  for i := 0 to 7 do Write32(CSRport+(i*AxisStride),0);
+end;
+
+procedure AxisStop(theaxis : byte);
+var bitaxis : byte;
+begin
+  bitaxis := 1 shl theaxis;
+  Write32(CommandPort,StopCommand+bitaxis);
+  Waitfordone;
+  Write32(CSRport+(theaxis*AxisStride),0);
+end;
+
+function DoItNoWait(bitmask : byte) : byte;
+begin
+  if Read32(CommandPort) <>0 then
+  begin
+    writeln('Not ready for command ');
+    SSLBPDump(Axis);
+    halt(2);
+  end;
+  Write32(CommandPort,Doitcommand+bitmask);
+  DoitNoWait := byte(Read32(OurDataPort));
+end;
+
+function DoIt(bitmask : byte) : byte;
+var cmdreg : longint;
+begin
+  cmdreg := Read32(CommandPort);
+  if cmdreg <>0 then
+  begin
+    write('Not ready for command, ','Command port reads 0x');
+    hexprint(cmdreg,8);
+    writeln;
+    SSLBPDump(Axis);
+    halt(2);
+  end;
+  Write32(CommandPort,Doitcommand+bitmask);
+  WaitforDone;
+  Doit := byte(Read32(OurDataPort));
+end;
+
+function AlwaysDoIt(bitmask : byte) : byte;
+var
+testbitmask : byte;
+begin
+  if Read32(CommandPort) <>0 then
+  begin
+    writeln('Not ready for command ');
+    SSLBPDump(Axis);
+    halt(2);
+  end;
+  Write32(CommandPort,Doitcommand+bitmask);
+  Waitfordone;
+  AlwaysDoit := byte(Read32(OurDataPort));
+end;
+
+function AxisDoItNoWait(theaxis : byte) : boolean;
+var bitaxis : byte;
+begin
+  bitaxis := 1 shl theaxis;
+  AxisDoItNoWait := (DoItNoWait(bitaxis) and bitaxis) =0;
+end;
+
+function AxisDoIt(theaxis : byte) : boolean;
+var bitaxis : byte;
+begin
+  bitaxis := 1 shl theaxis;
+  AxisDoIt := (DoIt(bitaxis) and bitaxis) =0;
+end;
+
+procedure SSLBPInit;
+begin
+  Write32(CommandPort,$4000);
+  Write32(CommandPort,$0000);
+end;
+
+
+function SSLBPReadLBP(theaxis : byte;cmd : byte) : byte;
+var acommand : longint;
+begin
+  LongIntByteRec(acommand).Byte3 := cmd;
+  LongIntByteRec(acommand).Byte2 := 0;
+  LongIntByteRec(acommand).Byte1 := 0;
+  LongIntByteRec(acommand).Byte0 := 0;
+  Write32(CSRport+(theaxis*AxisStride),acommand);
+  if not(AxisDoIt(theaxis)) then Error(SSLBPTransferFailed);
+  SSLBPReadLBP := byte(Read32(InterfacePort0+(theaxis*AxisStride)));
+  Write32(CSRport+(theaxis*AxisStride),0);
+end;
+
+function SSLBPReadWord(theaxis : byte;add : word) : word;
+begin
+  Write32(CSRport+(theaxis*AxisStride),ReadWordCommand+add);
+  if not(AxisDoIt(theaxis)) then Error(SSLBPTransferFailed);
+  SSLBPReadWord := word(Read32(InterfacePort0+(theaxis*AxisStride)));
+  Write32(CSRport+(theaxis*AxisStride),0);
+end;
+
+function SSLBPReadByte(theaxis : byte;add : word) : byte;
+begin
+  Write32(CSRport+(theaxis*AxisStride),ReadByteCommand+add);
+  if not(AxisDoIt(theaxis)) then Error(SSLBPTransferFailed);
+  SSLBPReadByte := byte(Read32(InterfacePort0+(theaxis*AxisStride)));
+  Write32(CSRport+(theaxis*AxisStride),0);
+end;
+
+function SSLBPReadLong(theaxis : byte;add : word) : longint;
+begin
+  Write32(CSRPort+(theaxis*AxisStride),ReadLongCommand+add);
+  if not(AxisDoIt(theaxis)) then Error(SSLBPTransferFailed);
+  SSLBPReadLong := Read32(InterfacePort0+(theaxis*AxisStride));
+  Write32(CSRport+(theaxis*AxisStride),0);
+end;
+
+function SSLBPReadDouble(theaxis : byte;add : word) : comp;
+var bigdata : comp;
+datal,datah : longint;
+begin
+  Write32(CSRPort+(theaxis*AxisStride),ReadDoubleCommand+add);
+  if not(AxisDoIt(theaxis)) then Error(SSLBPTransferFailed);
+  DoubleLongRec(BigData).Long0 := Read32(InterfacePort0+(theaxis*AxisStride));
+  DoubleLongRec(BigData).Long1 := Read32(InterfacePort1+(theaxis*AxisStride));
+  SSLBPReadDouble := bigdata;
+  Write32(CSRport+(theaxis*AxisStride),0);
+end;
+
+procedure SSLBPWriteLBP(theaxis : byte;cmd : byte; data : byte);
+var acommand : longint;
+begin
+  LongIntByteRec(acommand).Byte3 := LBPWRITE_byte+cmd;
+  LongIntByteRec(acommand).Byte2 := 0;
+  LongIntByteRec(acommand).Byte1 := 0;
+  LongIntByteRec(acommand).Byte0 := 0;
+  Write32(CSRPort+(theaxis*AxisStride),acommand);
+  Write32(InterfacePort0+(theaxis*AxisStride),data);
+  if not(AxisDoIt(theaxis)) then Error(SSLBPTransferFailed);
+  Write32(CSRport+(theaxis*AxisStride),0);
+end;
+
+procedure SSLBPWriteByte(theaxis : byte;add : word; data : byte);
+begin
+  Write32(CSRPort+(theaxis*AxisStride),WriteByteCommand+add);
+  Write32(InterfacePort0+(theaxis*AxisStride),data);
+  if not(AxisDoIt(theaxis)) then Error(SSLBPTransferFailed);
+  Write32(CSRport+(theaxis*AxisStride),0);
+end;
+
+procedure SSLBPWriteWord(theaxis : byte;add : word; data : word);
+begin
+  Write32(CSRPort+(theaxis*AxisStride),WriteWordCommand+add);
+  Write32(InterfacePort0+(theaxis*AxisStride),data);
+  if not(AxisDoIt(theaxis)) then Error(SSLBPTransferFailed);
+  Write32(CSRport+(theaxis*AxisStride),0);
+end;
+
+procedure SSLBPWriteLong(theaxis : byte;add : word; data: longint);
+begin
+  Write32(CSRPort+(theaxis*AxisStride),WriteLongCommand+add);
+  Write32(InterfacePort0+(theaxis*AxisStride),data);
+  if not(AxisDoIt(theaxis)) then Error(SSLBPTransferFailed);
+  Write32(CSRport+(theaxis*AxisStride),0);
+end;
+
+procedure SSLBPWriteDouble(theaxis : byte;add : word; data: comp);
+begin
+  Write32(CSRPort+(theaxis*AxisStride),WriteDoubleCommand+add);
+  Write32(InterfacePort0+(theaxis*AxisStride),DoubleLongRec(data).Long0);
+  Write32(InterfacePort1+(theaxis*AxisStride),DoubleLongRec(data).Long1);
+  if not(AxisDoIt(theaxis)) then Error(SSLBPTransferFailed);
+  Write32(CSRport+(theaxis*AxisStride),0);
+end;
+
+procedure SSLBPWriteEEPROMLong(theaxis : byte;add : word;data : longint);
+var old : byte;
+begin
+  {SSLBPDump(Axis);}
+  SSLBPWriteLBP(theaxis,LBPNONVOL_flag,LBPNONVOLEEPROM_byte);
+  SSLBPWriteLong(theaxis,add,data);
+  SSLBPWriteLBP(theaxis,LBPNONVOL_flag,0);
+  { test for old }
+  old := SSLBPReadLBP(theaxis,LBPNONVOL_flag);
+  if old <> 0 then
+  begin
+    writeln('Old buggy bit file in use');
+    delay(100);
+    SSLBPWriteLBP(theaxis,LBPNONVOL_flag,0);
+    old := SSLBPReadLBP(theaxis,LBPNONVOL_flag);
+    if old <> 0 then
+    begin
+      writeln('Broken Old buggy bit file in use cycle 8I20 power');
+      halt(2);
+    end;
+  end;
+end;
+
+procedure SSLBPWriteEEPROMWord(theaxis : byte;add : word;data : word);
+var old : byte;
+begin
+  {SSLBPDump(Axis);}
+  SSLBPWriteLBP(theaxis,LBPNONVOL_flag,LBPNONVOLEEPROM_byte);
+  SSLBPWriteWord(theaxis,add,data);
+  SSLBPWriteLBP(theaxis,LBPNONVOL_flag,0);
+  { test for old }
+  old := SSLBPReadLBP(theaxis,LBPNONVOL_flag);
+  if old <> 0 then
+  begin
+    writeln('Old buggy bit file in use');
+    delay(100);
+    SSLBPWriteLBP(theaxis,LBPNONVOL_flag,0);
+    old := SSLBPReadLBP(theaxis,LBPNONVOL_flag);
+    if old <> 0 then
+    begin
+      writeln('Broken Old buggy bit file in use cycle 8I20 power');
+      halt(2);
+    end;
+  end;
+end;
+
+procedure SSLBPWriteEEPROMByte(theaxis : byte;add : word;data : byte);
+var old : byte;
+begin
+  {SSLBPDump(Axis);}
+  SSLBPWriteLBP(theaxis,LBPNONVOL_flag,LBPNONVOLEEPROM_byte);
+  SSLBPWriteByte(theaxis,add,data);
+  SSLBPWriteLBP(theaxis,LBPNONVOL_flag,0);
+  { test for old }
+  old := SSLBPReadLBP(theaxis,LBPNONVOL_flag);
+  if old <> 0 then
+  begin
+    writeln('Old buggy bit file in use');
+    delay(100);
+    SSLBPWriteLBP(theaxis,LBPNONVOL_flag,0);
+    old := SSLBPReadLBP(theaxis,LBPNONVOL_flag);
+    if old <> 0 then
+    begin
+      writeln('Broken Old buggy bit file in use cycle 8I20 power');
+      halt(2);
+    end;
+  end;
+end;
+
+function SSLBPReadEEPROMLong(theaxis : byte;add : word): longint;
+var temp : longint;
+begin
+  SSLBPWriteLBP(theaxis,LBPNONVOL_flag,LBPNONVOLEEPROM_byte);
+  temp := SSLBPReadLong(theaxis,add);
+  SSLBPWriteLBP(theaxis,LBPNONVOL_flag,0);
+  SSLBPReadEEPROMLong := temp;
+end;
+
+function SSLBPReadEEPROMWord(theaxis : byte;add : word): word;
+begin
+  SSLBPWriteLBP(theaxis,LBPNONVOL_flag,LBPNONVOLEEPROM_byte);
+  SSLBPReadEEPROMWord := SSLBPReadWord(theaxis,add);
+  SSLBPWriteLBP(theaxis,LBPNONVOL_flag,0);
+end;
+
+function SSLBPReadEEPROMByte(theaxis : byte;add : word): byte;
+begin
+  SSLBPWriteLBP(theaxis,LBPNONVOL_flag,LBPNONVOLEEPROM_byte);
+  SSLBPReadEEPROMByte := SSLBPReadByte(theaxis,add);
+  SSLBPWriteLBP(theaxis,LBPNONVOL_flag,0);
+end;
+{
+function badSSLBPReadLocal(theaxis : byte;cmd : byte) : byte;
+var ourcmd : longint;
+begin
+  ourcmd := cmd;
+  ourcmd := ourcmd shl CommandShift;
+  Write32(CSRPort+(theaxis*AxisStride),ourcmd);
+  if not(AxisDoIt(theaxis)) then Error(SSLBPTransferFailed);
+  SSLBPReadLocal := byte(Read32(InterfacePort0+(theaxis*AxisStride)));
+  Write32(CSRport+(theaxis*AxisStride),0);
+end;
+ }
+{
+procedure badSSLBPWriteLocal(theaxis : byte;cmd : byte;data : byte);
+var ourcmd : longint;
+begin
+  ourcmd := cmd;
+  ourcmd := ourcmd shl commandshift;
+  Write32(CSRPort+(theaxis*AxisStride),ourcmd);
+  Write32(InterfacePort0+(theaxis*AxisStride),data);
+  if not(AxisDoIt(theaxis)) then Error(SSLBPTransferFailed);
+  Write32(CSRport+(theaxis*AxisStride),0);
+end;
+}
+function oldSSLBPReadLocal(theaxis : byte;cmd : byte) : byte;
+begin
+  { may be broken }
+  Write32(CSRPort+(theaxis*AxisStride),cmd);
+  if not(AxisDoIt(theaxis)) then Error(SSLBPTransferFailed);
+  oldSSLBPReadLocal := byte(Read32(InterfacePort0+(theaxis*AxisStride)));
+  Write32(CSRport+(theaxis*AxisStride),0);
+end;
+
+procedure WriteSSRAM(add : word; data : byte);
+begin
+  Write32(OurDataPort,data);
+  Write32(CommandPort,RequestBit+WriteBit+add);
+  WaitForDone;
+end;
+
+function ReadSSRAM(add : word):  byte;
+var
+d : byte;
+begin
+  Write32(CommandPort,RequestBit+add);
+  WaitForDone;
+  d := Read32(OurDataPort);
+  ReadSSRAM := d;
+  end;
+
+function ReadSSRAMWord(add : word):  word;
+var
+d : word;
+begin
+  Write32(CommandPort,RequestBit+add+0);
+  WaitForDone;
+  WordRec(d).LowByte := Read32(OurDataPort);
+  Write32(CommandPort,RequestBit+add+1);
+  WaitForDone;
+  WordRec(d).HighByte := Read32(OurDataPort);
+  ReadSSRAMWord := d;
+end;
+
+function ReadSSRAMLong(add : word):  longint;
+var
+d : longint;
+begin
+  LongIntByteRec(d).Byte0 := ReadSSRam(add+0);
+  LongIntByteRec(d).Byte1 := ReadSSRam(add+1);
+  LongIntByteRec(d).Byte2 := ReadSSRam(add+2);
+  LongIntByteRec(d).Byte3 := ReadSSRam(add+3);
+  ReadSSRAMLong := d;
+end;
+
+function ReadChanSSRAM(chan : byte; add : word):  byte;
+begin
+  ReadChanSSRAM := ReadSSRAM((chan*SSLBPChannelStride)+SSLBPChannelStart+add);
+end;
+
+function ReadChanSSRAMWord(chan : byte; add : word):  word;
+begin
+  ReadChanSSRAMWord := ReadSSRAMWord((chan*SSLBPChannelStride)+SSLBPChannelStart+add);
+end;
+
+function ReadChanSSRAMLong(chan : byte; add : word):  longint;
+begin
+  ReadChanSSRAMLong := ReadSSRAMLong((chan*SSLBPChannelStride)+SSLBPChannelStart+add);
+end;
+
+procedure SSLBPSetNoCRC(theaxis : byte;crc : byte);
+begin
+  WriteSSRAM((theaxis*SSLBPChannelStride)+SSLBPChannelStart+ChanDisableCRCOffset+0,crc);
+ { SSLBPStopAll;}
+end;
+
+procedure SSLBPSetBaud(theaxis : byte;baud : longint);
+begin
+  WriteSSRAM((theaxis*SSLBPChannelStride)+SSLBPChannelStart+ChanBaudRateOffset+0,LongIntByteRec(baud).Byte0);
+  WriteSSRAM((theaxis*SSLBPChannelStride)+SSLBPChannelStart+ChanBaudRateOffset+1,LongIntByteRec(baud).Byte1);
+  WriteSSRAM((theaxis*SSLBPChannelStride)+SSLBPChannelStart+ChanBaudRateOffset+2,LongIntByteRec(baud).Byte2);
+  WriteSSRAM((theaxis*SSLBPChannelStride)+SSLBPChannelStart+ChanBaudRateOffset+3,LongIntByteRec(baud).Byte3);
+  SSLBPStopAll;
+end;
+
+function SSLBPGetBaud(theaxis : byte) : longint;
+begin
+  SSLBPGetBaud := ReadChanSSRAMLong(theaxis,ChanBaudRateOffset);
+end;
+
+
+function InitializeSSBaseAddr : boolean;
+var
+base : word;
+nregs : byte;
+begin
+  InitializeSSBaseAddr := GetModuleInfo(SSerialTag,base,nregs);
+  base := base + SSerial * $40;
+  CommandPort    := base+$000;
+  OurDataPort    := base+$100;
+  CSRPort        := base+$200;
+  InterfacePort0 := base+$300;
+  InterfacePort1 := base+$400;
+  InterfacePort2 := base+$500;
+  NumberOfBases := nregs;
+{  hexprint(base,4);
+  writeln('  regs  ',nregs);}
+end;
+
+function SSLBPReadCookie(axis : byte) : byte;
+begin
+  SSLBPReadCookie := SSLBPReadLBP(axis,LBPREADCOOKIE_byte);
+end;
+
+function SSLBPProgSync(theaxis : byte): boolean;
+var ok : boolean;
+cookie : byte;
+begin
+  cookie := SSLBPReadCookie(theaxis);
+  ok := cookie = LBPCOOKIECODE_byte;
+  SSLBPProgSync := ok;
+end;
+
+procedure SSLBPCommitErase(theaxis : byte);
+begin
+  SSLBPWriteByte(theaxis,LBPFLASHCOMMIT_ptr,LBPFLASHERASE_byte);
+  if not SSLBPProgSync(axis) then BumOut('Sync error');
+end;
+
+procedure SSLBPCommitWrite(theaxis : byte);
+begin
+  SSLBPWriteByte(theaxis,LBPFLASHCOMMIT_ptr,LBPFLASHWRITE_byte);
+  if not SSLBPProgSync(axis) then BumOut('Sync error');
+end;
+
+procedure SSLBPFlashStart(theaxis : byte);
+begin
+  SSLBPWriteLBP(theaxis,LBPNONVOL_flag,LBPNONVOLFLASH_byte);
+end;
+
+procedure SSLBPFlashStop(theaxis : byte);
+begin
+  SSLBPWriteLBP(theaxis,LBPNONVOL_flag,0);
+end;
+
+function SSLBPGetWriteSize(theaxis : byte) : word;
+begin
+  SSLBPGetWriteSize := 1 shl SSLBPReadByte(theaxis,LBPFLASHWRITESIZE_ptr);
+end;
+
+function SSLBPGetEraseSize(theaxis : byte) : word;
+begin
+  SSLBPGetEraseSize := 1 shl SSLBPReadByte(theaxis,LBPFLASHERASESIZE_ptr);
+end;
+
+procedure SSLBPSetOffset(theaxis : byte;off : longint);
+begin
+  SSLBPWriteLong(theaxis,LBPFLASHOFFSET_ptr,off);
+end;
+
+function SSLBPGetOffset(theaxis : byte) :  longint;
+begin
+  SSLBPGetOffset := SSLBPReadLong(theaxis,LBPFLASHOFFSET_ptr);
+end;
+
+procedure SSLBPChannelAccessInit;
+begin
+  SSLBPMajorRevision := ReadSSRAM(SSLBPMajorRevisionLoc);
+  SSLBPMinorRevision := ReadSSRAM(SSLBPMinorRevisionLoc);
+  SSLBPChannelStart  := ReadSSRAM(SSLBPChannelStartLoc);
+  SSLBPChannelStride := ReadSSRAM(SSLBPChannelStrideLoc);
+end;
+
+
+(*
+procedure SSLBPWriteBlock(theaxis,add:word; ourbuffer : BBufPtrType);
+var ourdouble : comp;
+begin
+  DoubleByteRec(ourdouble).Byte0 := (ourbuffer^[0]);
+  DoubleByteRec(ourdouble).Byte1 := (ourbuffer^[1]);
+  DoubleByteRec(ourdouble).Byte2 := (ourbuffer^[2]);
+  DoubleByteRec(ourdouble).Byte3 := (ourbuffer^[3]);
+  DoubleByteRec(ourdouble).Byte4 := (ourbuffer^[4]);
+  DoubleByteRec(ourdouble).Byte5 := (ourbuffer^[5]);
+  DoubleByteRec(ourdouble).Byte6 := (ourbuffer^[6]);
+  DoubleByteRec(ourdouble).Byte7 := (ourbuffer^[7]);
+  SSLBPWriteDouble(theaxis,add,ourdouble);
+end;
+
+procedure SSLBPReadBlock(theaxis,add:word; ourbuffer : RBufPtrType);
+var data : comp;
+begin
+  data := SSLBPReadDouble(theaxis,add);
+  ourbuffer^[0] := CompByteRec(data).Byte0;
+  ourbuffer^[1] := CompByteRec(data).Byte1;
+  ourbuffer^[2] := CompByteRec(data).Byte2;
+  ourbuffer^[3] := CompByteRec(data).Byte3;
+  ourbuffer^[4] := CompByteRec(data).Byte4;
+  ourbuffer^[5] := CompByteRec(data).Byte5;
+  ourbuffer^[6] := CompByteRec(data).Byte6;
+  ourbuffer^[7] := CompByteRec(data).Byte7;
+end;
+  *)
+{ENDIF}
+{ added clearing of CSRPort after each write}
+{ added flash support }

5i24/utils/dos/source/ULBPHOST.PAS

@@ -0,0 +1,392 @@
+{for LBP}
+
+const
+OurRPC = 32; { out of the way half way up }
+{$IFDEF FIFO}
+
+procedure LBPInitSoftDMC(TheBasePort : word);
+begin
+  IFIFOPort   := TheBasePort + IFIFOPortOffset;
+  QFIFOPort   := TheBasePort + QFIFOPortOffset;
+  StatusPort  := TheBasePort + StatusRegOffset;
+  ROMAddPort  := TheBasePort + ROMAddOffset;
+  ROMDataPort := TheBasePort + ROMDataOffset;
+end;
+
+function LBPReadFIFOStatus : word;
+begin
+    LBPReadFIFOStatus := LBPReadWord(StatusPort);
+end;
+(*
+procedure LBPWaitForIRBFIFONotEmpty;
+var loop : longint;
+begin
+  loop := 0;
+  repeat
+    loop := loop +1;
+  until ((LBPReadFIFOStatus and IRE = 0) or (loop > PollTimeOut));
+  if loop > PollTimeOut then Error(TimeoutIRBFIFONotEmpty);
+end;
+
+procedure LBPWaitForICDFIFONotFull;
+var loop : longint;
+begin
+  loop := 0;
+  repeat
+    loop := loop +1;
+  until ((LBPReadFIFOStatus and IFF = 0) or (loop > PollTimeOut));
+  if loop > PollTimeOut then Timeouterror(' ICD FIFO not full');
+end;
+
+procedure LBPWaitForICDFIFONotHalfFull;
+var loop : longint;
+begin
+  loop := 0;
+  repeat
+    loop := loop +1;
+  until ((LBPReadFIFOStatus and IFH = 0)  or (loop > PollTimeOut));
+  if loop > PollTimeOut then Timeouterror(' ICD FIFO not half full');
+end;
+
+procedure LBPWaitForQRBFIFONotEmpty;
+var loop : longint;
+begin
+  loop := 0;
+  repeat
+    loop := loop +1;
+  until ((LBPReadFIFOStatus and QRE = 0)  or (loop > PollTimeOut));
+  if loop > PollTimeOut then Timeouterror(' QRB data');
+end;
+
+procedure LBPWaitForQCDFIFONotFull;
+var loop : longint;
+begin
+  loop := 0;
+  repeat
+    loop := loop +1;
+  until ((LBPReadFIFOStatus and QFF = 0)  or (loop > PollTimeOut));
+  if loop > PollTimeOut then Timeouterror(' QCD FIFO not full');
+end;
+
+procedure LBPWaitForQCDFIFONotHalfFull;
+var loop : longint;
+begin
+  loop := 0;
+  repeat
+    loop := loop +1;
+  until ((LBPReadFIFOStatus and QFH = 0)  or (loop > PollTimeOut));
+  if loop > PollTimeOut then Timeouterror(' QCD FIFO not half full');
+end;
+
+procedure LBPWaitForQRBFIFOHalfFull;
+var loop : longint;
+begin
+  loop := 0;
+  repeat
+    loop := loop +1;
+  until ((LBPReadFIFOStatus and QRH <> 0)  or (loop > PollTimeOut));
+  if loop > PollTimeOut then Timeouterror(' QRB FIFO half full');
+end;
+*)
+procedure LBPWriteIFIFO(data: word);
+begin
+  LBPWriteWord(IFIFOPort,data);
+end;
+
+procedure LBPWriteQFIFO(data: word);
+begin
+  LBPWriteWord(QFIFOPort,data);
+end;
+
+function LBPReadIFIFO : word;
+begin
+  LBPReadIFIFO := LBPReadWord(IFIFOPort);
+end;
+
+function LBPReadQFIFO : word;
+begin
+  LBPReadQFIFO := LBPReadWord(QFIFOPort);
+end;
+
+procedure LBPWriteParamWord(command,thedata : word);
+{16 bit only parameter write}
+begin
+  LBPWriteIFIFO(command);
+  LBPWriteIFIFO(word(thedata));
+end;
+
+procedure LBPWriteCommand(command: word);
+{token write}
+begin
+  LBPWriteIFIFO(command);
+end;
+
+procedure LBPWriteParam(command: word;thedata : longint);
+{ full 32 bit parameter write - 2 words }
+begin
+  LBPWriteIFIFO(command);
+  LBPWriteIFIFO(LongIntRec(thedata).LowWord);
+  LBPWriteIFIFO(LongIntRec(thedata).HighWord);
+end;
+
+procedure LBPWriteParamDouble(command: word;thedata : comp);
+{ 64 bit parameter write - 4 words }
+begin
+  LBPWriteIFIFO(command);
+  LBPWriteIFIFO(DoubleIntRec(thedata).word0);
+  LBPWriteIFIFO(DoubleIntRec(thedata).word1);
+  LBPWriteIFIFO(DoubleIntRec(thedata).word2);
+  LBPWriteIFIFO(DoubleIntRec(thedata).word3);
+end;
+
+procedure LBPWriteParamBlock(axis,address,length : word; thedata : ParamArray);
+var idx : word;
+{16 bit multiple parameter write}
+begin
+  { Note: this will fail horribly if length > (FIFOSize/2 -2) }
+  LBPWriteIFIFO(BlockFlag or (length-1) or (axis shl AxisOffset));
+  LBPWriteIFIFO(address);
+  for idx := 1 to length do
+  begin
+    LBPWriteIFIFO(thedata[idx]);
+  end;
+end;
+
+function LBPReadParamWord(command: word):word;
+{ 16 bit parameter read }
+var
+rdata : longint;
+begin
+  LBPWriteIFIFO(command);
+  rdata := LBPReadIFIFO;
+  LBPReadParamWord :=rdata;
+end;
+
+function LBPReadParam(command: word) : longint;
+{full 32 bit parameter read }
+var
+rdata : longint;
+begin
+  LBPWriteIFIFO(command);
+  LongIntRec(rdata).LowWord := LBPReadIFIFO;  { read first }
+{  LBPWaitForIFIFONotEmpty; }
+{ theoretically this is needed but no interface currently is fast }
+{ enough to read faster than the DSP can write }
+  LongIntRec(rdata).HighWord :=LBPReadIFIFO;
+  LBPReadParam:= rdata;
+end;
+
+{$IFDEF COPROC}
+function LBPReadParamDouble(command: word) : comp;
+{64 bit parameter read }
+var
+rdata : comp;
+begin
+  LBPWriteIFIFO(command);
+  DoubleIntRec(rdata).word0 := LBPReadIFIFO;  { read first }
+  DoubleIntRec(rdata).word1 := LBPReadIFIFO;
+  DoubleIntRec(rdata).word2 := LBPReadIFIFO;
+  DoubleIntRec(rdata).word3 := LBPReadIFIFO;
+  LBPReadParamDouble := rdata;
+end;
+{$ENDIF}
+
+procedure LBPWriteParamWordQ(command,thedata : word);
+{16 bit only parameter write}
+begin
+  LBPWriteQFIFO(command);
+  LBPWriteQFIFO(thedata);
+end;
+
+procedure LBPWriteCommandQ(command : word);
+{token write}
+begin
+  LBPWriteQFIFO(command);
+end;
+
+procedure LBPWriteParamQ(command: word;thedata : longint);
+{ full 32 bit parameter write - 2 words }
+begin
+  LBPWriteQFIFO(command);
+  LBPWriteQFIFO(word(thedata));
+  LBPWriteQFIFO(word(thedata shr 16));
+end;
+
+procedure LBPWriteParamDoubleQ(command: word;thedata : comp);
+{ 64 bit parameter write - 4 words }
+begin
+  LBPWriteQFIFO(command);
+  LBPWriteQFIFO(DoubleIntRec(thedata).word0);
+  LBPWriteQFIFO(DoubleIntRec(thedata).word1);
+  LBPWriteQFIFO(DoubleIntRec(thedata).word2);
+  LBPWriteQFIFO(DoubleIntRec(thedata).word3);
+end;
+
+function LBPReadParamWordQ(command: word):word;
+{ 16 bit parameter read }
+var
+rdata : longint;
+begin
+  LBPWriteQFIFO(command);
+  rdata := LBPReadQFIFO;
+  LBPReadParamWordQ :=rdata;
+end;
+
+function LBPReadParamQ(command: word) : longint;
+{full 32 bit parameter read }
+var
+rdata : longint;
+firstword : word;
+begin
+  LBPWriteQFIFO(command);
+  firstword := LBPReadQFIFO;  { read first }
+{  LBPWaitForQFIFONotEmpty; }
+{ theoretically this is needed but no interface currently is fast }
+{ enough to read faster than the DSP can write }
+  rdata := (LBPReadQFIFO) *65536 + firstword;
+  LBPReadParamQ:= rdata;
+end;
+
+{$IFDEF COPROC}
+function LBPReadParamDoubleQ(command: word) : comp;
+{64 bit parameter read }
+var
+rdata : comp;
+begin
+  LBPWriteQFIFO(command);
+  DoubleIntRec(rdata).word0 := LBPReadQFIFO;  { read first }
+  DoubleIntRec(rdata).word1 := LBPReadQFIFO;
+  DoubleIntRec(rdata).word2 := LBPReadQFIFO;
+  DoubleIntRec(rdata).word3 := LBPReadQFIFO;
+  LBPReadParamDoubleQ:= rdata;
+end;
+{$ENDIF}
+
+procedure LBPReadQFIFO64N(n : word;bufptr : LBPDataBuffPtr);
+var
+data : word;
+index : word;
+oloop,iloop : word;
+begin
+  index := 0;
+  for oloop := 1 to n do
+  begin
+    SerSendChar(char(LBPRPC_byte or OurRPC));
+    for iloop := 0 to 63 do
+    begin
+      SerRecvChar(char(WordByteRec(data).Byte0));
+      SerRecvChar(char(WordByteRec(data).Byte1));
+      bufptr^[index] := data;
+      index := index + 1;
+    end;
+  end;
+end;
+
+{$IFDEF WINDOWS}
+procedure LBPSetupReadQFIFO64N;
+var
+index : byte;
+rpctarget : word;
+
+begin
+  rpctarget := OurRPC * LBPReadRPCPitch;
+  {This routine builds up a RPC to read 64 words from the QFIFO at OurRPC}
+
+  XmitBufferIndex :=1;
+  AddByteToXmitBuffer(LBPWRITE_byte or LBPRPCMEM_flag);
+  AddByteToXmitBuffer(LBPTRUE_flag);   { enable RPC memory access }
+
+  AddByteToXmitBuffer(LBPCOMMAND_byte or LBPWRITE_byte or LBPA2_byte or LBPINC_byte or LBPD4_byte);
+  AddByteToXmitBuffer(WordRec(rpctarget).lowbyte);
+  AddByteToXmitBuffer(WordRec(rpctarget).highbyte);
+  AddByteToXmitBuffer(LBPCOMMAND_byte or LBPA2_byte or LBPD2_byte);
+  AddByteToXmitBuffer(WordRec(QFIFOPort).lowbyte);
+  AddByteToXmitBuffer(WordRec(QFIFOPort).highbyte);
+  AddByteToXmitBuffer(LBPCOMMAND_byte or LBPD2_byte); {2 read commands in RPC buffer}
+
+  for index := 1 to 7 do
+  begin
+    AddByteToXmitBuffer(LBPCOMMAND_byte or LBPWRITE_byte or LBPINC_byte or LBPD8_byte);
+    AddByteToXmitBuffer(LBPCOMMAND_byte or LBPD2_byte);
+    AddByteToXmitBuffer(LBPCOMMAND_byte or LBPD2_byte);
+    AddByteToXmitBuffer(LBPCOMMAND_byte or LBPD2_byte);
+    AddByteToXmitBuffer(LBPCOMMAND_byte or LBPD2_byte);
+    AddByteToXmitBuffer(LBPCOMMAND_byte or LBPD2_byte);
+    AddByteToXmitBuffer(LBPCOMMAND_byte or LBPD2_byte);
+    AddByteToXmitBuffer(LBPCOMMAND_byte or LBPD2_byte);
+    AddByteToXmitBuffer(LBPCOMMAND_byte or LBPD2_byte); { 58 }
+  end;
+
+  AddByteToXmitBuffer(LBPCOMMAND_byte or LBPWRITE_byte or LBPINC_byte or LBPD4_byte);
+  AddByteToXmitBuffer(LBPCOMMAND_byte or LBPD2_byte);
+  AddByteToXmitBuffer(LBPCOMMAND_byte or LBPD2_byte);
+  AddByteToXmitBuffer(LBPCOMMAND_byte or LBPD2_byte);
+  AddByteToXmitBuffer(LBPCOMMAND_byte or LBPD2_byte); {62}
+
+  AddByteToXmitBuffer(LBPCOMMAND_byte or LBPWRITE_byte or LBPINC_byte or LBPD2_byte);
+  AddByteToXmitBuffer(LBPCOMMAND_byte or LBPD2_byte);
+  AddByteToXmitBuffer(LBPCOMMAND_byte or LBPD2_byte); {64}
+
+  AddByteToXmitBuffer(LBPCOMMAND_byte or LBPWRITE_byte);
+  AddByteToXmitBuffer(LBPRPCEND_byte);
+
+  AddByteToXmitBuffer(LBPWRITE_byte or LBPRPCMEM_flag);
+  AddByteToXmitBuffer(LBPFALSE_flag);   { disable RPC memory access }
+
+  ser.SendBuffer(@XmitBuffer,XmitBufferIndex-1);
+  ser.Flush;
+end;
+
+{$ELSE}
+procedure LBPSetupReadQFIFO64N;
+var
+rpctarget : word;
+index : integer;
+  {This routine builds up a RPC to read 64 words from the QFIFO at OurRPC}
+begin
+  rpctarget := OurRPC * LBPReadRPCPitch;
+
+  SerSendChar(char(LBPWRITE_byte or LBPRPCMEM_flag));
+  SerSendChar(char(LBPTRUE_flag));   { enable RPC memory access }
+
+  SerSendChar(char(LBPCOMMAND_byte or LBPWRITE_byte or LBPA2_byte or LBPINC_byte or LBPD4_byte));
+  SerSendChar(char(WordRec(rpctarget).lowbyte));
+  SerSendChar(char(WordRec(rpctarget).highbyte));
+  SerSendChar(char(LBPCOMMAND_byte or LBPA2_byte or LBPD2_byte));
+  SerSendChar(char(WordRec(QFIFOPort).lowbyte));
+  SerSendChar(char(WordRec(QFIFOPort).highbyte));
+  SerSendChar(char(LBPCOMMAND_byte or LBPD2_byte)); {2 read commands in RPC buffer}
+
+  for index := 1 to 7 do
+  begin
+    SerSendChar(char(LBPCOMMAND_byte or LBPWRITE_byte or LBPINC_byte or LBPD8_byte));
+    SerSendChar(char(LBPCOMMAND_byte or LBPD2_byte));
+    SerSendChar(char(LBPCOMMAND_byte or LBPD2_byte));
+    SerSendChar(char(LBPCOMMAND_byte or LBPD2_byte));
+    SerSendChar(char(LBPCOMMAND_byte or LBPD2_byte));
+    SerSendChar(char(LBPCOMMAND_byte or LBPD2_byte));
+    SerSendChar(char(LBPCOMMAND_byte or LBPD2_byte));
+    SerSendChar(char(LBPCOMMAND_byte or LBPD2_byte));
+    SerSendChar(char(LBPCOMMAND_byte or LBPD2_byte)); { 58 }
+  end;
+
+  SerSendChar(char(LBPCOMMAND_byte or LBPWRITE_byte or LBPINC_byte or LBPD4_byte));
+  SerSendChar(char(LBPCOMMAND_byte or LBPD2_byte));
+  SerSendChar(char(LBPCOMMAND_byte or LBPD2_byte));
+  SerSendChar(char(LBPCOMMAND_byte or LBPD2_byte));
+  SerSendChar(char(LBPCOMMAND_byte or LBPD2_byte)); {62}
+
+  SerSendChar(char(LBPCOMMAND_byte or LBPWRITE_byte or LBPINC_byte or LBPD2_byte));
+  SerSendChar(char(LBPCOMMAND_byte or LBPD2_byte));
+  SerSendChar(char(LBPCOMMAND_byte or LBPD2_byte)); {64}
+
+  SerSendChar(char(LBPCOMMAND_byte or LBPWRITE_byte));
+  SerSendChar(char(LBPRPCEND_byte));
+  SerSendChar(char(LBPWRITE_byte or LBPRPCMEM_flag));
+  SerSendChar(char(LBPFALSE_flag));   { disable RPC memory access }
+end;
+
+{$ENDIF}
+
+{$ENDIF FIFO}
+

5i24/utils/dos/source/ULBPLOW.PAS

@@ -0,0 +1,583 @@
+{for LBP}
+
+{I LBP.pas}
+{$I CRC8.pas}
+
+
+const
+XmitBufferSize = 1024;
+NullCRC = char(0);
+
+type
+LBPDataBuffertype = array[0..4095] of word;
+LBPDataBuffPtr = ^LBPDataBuffertype;
+
+var
+LBPDataBuffer : LBPDataBuffertype;
+XmitBuffer : array[1 .. XmitBufferSize] of byte;
+XmitBufferIndex : integer;
+ExitOnCRCError : boolean;
+LBPCRCEnabled : boolean;
+LBPCRCError : boolean;
+LBPCRC : byte;
+rb : byte;
+type
+WordByteRec = record
+  Byte0  : byte;
+  Byte1  : byte;
+end;
+
+CompByteRec = record
+  Byte0  : byte;
+  Byte1  : byte;
+  Byte2  : byte;
+  Byte3  : byte;
+  Byte4  : byte;
+  Byte5  : byte;
+  Byte6  : byte;
+  Byte7  : byte;
+end;
+
+procedure AppendCRC(var s : string);
+var i : integer;
+thebyte,lookupbyte : byte;
+begin
+  if LBPCRCEnabled then
+  begin
+    LBPCRC := 0;
+    for i := 1 to length(s) do
+    begin
+      thebyte := byte(s[i]);
+      lookupbyte := LBPCRC xor thebyte;
+      LBPCRC := GetCRC8(lookupbyte);
+    end;
+    s := s + char(LBPCRC);
+{$IFDEF CRCDEBUG}
+    write('Appended ');
+    hexprint(LBPCRC,2);
+    Writeln
+{$ENDIF CRCDEBUG}
+  end;
+end;
+
+function CheckCRC(is : string) : boolean;
+var i : integer;
+thebyte,lookupbyte : byte;
+tout : boolean;
+begin
+  LBPCRCError := false;
+  if LBPCRCEnabled then
+  begin
+    LBPCRC := 0;
+    for i := 1 to length(is) do
+    begin
+      thebyte := byte(is[i]);
+      lookupbyte := LBPCRC xor thebyte;
+      LBPCRC := GetCRC8(lookupbyte);
+    end;
+    tout := not SerRecvChar(char(thebyte));
+    if (tout and ExitOnCRCError) then Bumout('Serial Timeout Error Waiting for CRC!');
+    CheckCRC := (theByte = LBPCRC);
+{$IFDEF CRCDEBUG}
+      write(' Got CRC  ');
+      HexPrint(thebyte,2);
+      write(' CRC should be  ');
+      HexPrint(LBPCRC,2);
+      writeln;
+{$ENDIF CRCDEBUG}
+    if theByte <> LBPCRC then
+    begin
+      LBPCRCError := true;
+      if ExitOnCRCError then Bumout('CRC Error!');
+    end;
+  end;
+end;
+
+procedure AddByteToXmitBuffer(d: byte);
+begin
+  XmitBuffer[XmitBufferIndex] := d;
+  XmitBufferIndex := XmitBufferIndex + 1;
+end;
+
+function LBPReadByte(add : word) : byte;
+var s, is : string;
+begin
+  s := char(LBPCOMMAND_byte or LBPA2_byte or LBPD1_byte);
+  s := s + char(WordByteRec(add).Byte0);
+  s := s + char(WordByteRec(add).Byte1);
+  AppendCRC(s);
+  SerSendString(s);
+  SerError := not SerRecvString(1,is);
+  LBPCRCError := CheckCRC(is);
+  LBPReadByte := byte(is[1]);
+end;
+
+function LBPReadWord(add : word) : word;
+var
+s, is : string;
+data : word;
+begin
+  s := char(LBPCOMMAND_byte or LBPA2_byte or LBPD2_byte);
+  s := s + char(WordByteRec(add).Byte0);
+  s := s + char(WordByteRec(add).Byte1);
+  AppendCRC(s);
+  SerSendString(s);
+  if not SerRecvString(2,is) then
+  begin
+    if ExitOnTimeout then Error(CharTimeoutErr);
+  end;
+  WordByteRec(data).Byte0 := byte(is[1]);
+  WordByteRec(data).Byte1 := byte(is[2]);
+  LBPCRCError := CheckCRC(is);
+  LBPReadWord := data;
+end;
+
+function LBPReadLong(add : word) : longint;
+var data : longint;
+s, is : string;
+tout : boolean;
+begin
+  s := char(LBPCOMMAND_byte or LBPA2_byte or LBPD4_byte);
+  s := s + char(WordByteRec(add).Byte0);
+  s := s + char(WordByteRec(add).Byte1);
+  AppendCRC(s);
+  SerSendString(s);
+  {SerError := not SerRecvString(4,is);}
+  tout := not SerRecvString(4,is);
+  SerError := SerError or tout;
+  if tout then Bumout('Serial Timeout Error Waiting for Long!');
+  LongIntByteRec(data).Byte0 := byte(is[1]);
+  LongIntByteRec(data).Byte1 := byte(is[2]);
+  LongIntByteRec(data).Byte2 := byte(is[3]);
+  LongIntByteRec(data).Byte3 := byte(is[4]);
+  LBPCRCError := CheckCRC(is);
+  LBPReadLong := data;
+end;
+
+function LBPReadDouble(add : word) : comp;
+var data : comp;
+s, is : string;
+tout : boolean;
+begin
+  s := char(LBPCOMMAND_byte or LBPA2_byte or LBPD8_byte);
+  s := s + char(WordByteRec(add).Byte0);
+  s := s + char(WordByteRec(add).Byte1);
+  AppendCRC(s);
+  SerSendString(s);
+  tout := not SerRecvString(8,is);
+  if tout then Bumout('Serial Timeout Error Waiting Double!');
+
+  CompByteRec(data).Byte0 := byte(is[1]);
+  CompByteRec(data).Byte1 := byte(is[2]);
+  CompByteRec(data).Byte2 := byte(is[3]);
+  CompByteRec(data).Byte3 := byte(is[4]);
+  CompByteRec(data).Byte4 := byte(is[5]);
+  CompByteRec(data).Byte5 := byte(is[6]);
+  CompByteRec(data).Byte6 := byte(is[7]);
+  CompByteRec(data).Byte7 := byte(is[8]);
+  LBPCRCError := CheckCRC(is);
+  LBPReadDouble := data;
+end;
+
+procedure LBPWriteByte(add:word; data: byte);
+var s : string;
+begin
+  s := char(LBPCOMMAND_byte or LBPWRITE_byte or LBPA2_byte or LBPD1_byte);
+  s := s + char(WordByteRec(add).Byte0);
+  s := s + char(WordByteRec(add).Byte1);
+  s := s + char(data);
+  AppendCRC(s);
+  SerSendString(s);
+  CheckCRC(NullCRC);
+end;
+
+procedure LBPWriteWord(add:word; data: word);
+var s : string;
+begin
+  s := char(LBPCOMMAND_byte or LBPWRITE_byte or LBPA2_byte or LBPD2_byte);
+  s := s + char(WordByteRec(add).Byte0);
+  s := s + char(WordByteRec(add).Byte1);
+  s := s + char(WordByteRec(data).Byte0);
+  s := s + char(WordByteRec(data).Byte1);
+  AppendCRC(s);
+  SerSendString(s);
+  CheckCRC(NullCRC);
+end;
+
+procedure LBPWriteLong(add:word; data: longint);
+var s : string;
+begin
+  s := char(LBPCOMMAND_byte or LBPWRITE_byte or LBPA2_byte or LBPD4_byte);
+  s := s + char(WordByteRec(add).Byte0);
+  s := s + char(WordByteRec(add).Byte1);
+  s := s + char(LongIntByteRec(data).Byte0);
+  s := s + char(LongIntByteRec(data).Byte1);
+  s := s + char(LongIntByteRec(data).Byte2);
+  s := s + char(LongIntByteRec(data).Byte3);
+  AppendCRC(s);
+  SerSendString(s);
+  CheckCRC(NullCRC);
+end;
+
+procedure LBPWriteDouble(add:word; data: comp);
+var s : string;
+begin
+  s := char(LBPCOMMAND_byte or LBPWRITE_byte or LBPA2_byte or LBPD8_byte);
+  s := s + char(WordByteRec(add).Byte0);
+  s := s + char(WordByteRec(add).Byte1);
+  s := s + char(CompByteRec(data).Byte0);
+  s := s + char(CompByteRec(data).Byte1);
+  s := s + char(CompByteRec(data).Byte2);
+  s := s + char(CompByteRec(data).Byte3);
+  s := s + char(CompByteRec(data).Byte4);
+  s := s + char(CompByteRec(data).Byte5);
+  s := s + char(CompByteRec(data).Byte6);
+  s := s + char(CompByteRec(data).Byte7);
+  AppendCRC(s);
+  SerSendString(s);
+  CheckCRC(NullCRC);
+end;
+
+function LBPLocalRead(command : byte) : byte;
+var s,is : string;
+begin
+  s := char(command);
+  AppendCRC(s);
+  SerSendString(s);
+  SerError := not SerRecvString(1,is);
+  LBPCRCError := CheckCRC(is);
+  LBPLocalRead := byte(is[1]);
+end;
+
+procedure LBPLocalWrite(command,data : byte);
+var s : string;
+begin
+  s := char(LBPWRITE_byte or command);
+  s := s + char(data);
+  AppendCRC(s);
+  SerSendString(s);
+  CheckCRC(NullCRC);
+end;
+
+function LBPReadCookie: byte;
+begin
+  LBPReadCookie := LBPLocalRead(LBPREADCOOKIE_byte);
+end;
+
+function LBPReadRPCPitch: byte;
+begin
+  LBPReadRPCPitch := LBPLocalRead(LBPRPCPITCH_byte);
+end;
+
+function LBPReadCardName : string;
+var
+s : string;
+begin
+  s := '';
+  s := s + char(LBPLocalRead(LBPCARDNAME0_byte));
+  s := s + char(LBPLocalRead(LBPCARDNAME1_byte));
+  s := s + char(LBPLocalRead(LBPCARDNAME2_byte));
+  s := s + char(LBPLocalRead(LBPCARDNAME3_byte));
+  LBPReadCardName := s;
+end;
+
+function LBPReadUnitNumber : longint;
+var data : longint;
+s, is : string;
+tout : boolean;
+begin
+  s := char($BC);
+  AppendCRC(s);
+  SerSendString(s);
+
+  tout := not SerRecvString(4,is);
+  SerError := SerError or tout;
+  if tout then Bumout('Serial Timeout Error Waiting for Long!');
+  LongIntByteRec(data).Byte0 := byte(is[1]);
+  LongIntByteRec(data).Byte1 := byte(is[2]);
+  LongIntByteRec(data).Byte2 := byte(is[3]);
+  LongIntByteRec(data).Byte3 := byte(is[4]);
+  LBPCRCError := CheckCRC(is);
+  LBPReadUnitNumber := data;
+end;
+
+function LBPDiscover : longint;
+var data : longint;
+s, is : string;
+tout : boolean;
+begin
+  s := char($BB);
+  AppendCRC(s);
+  SerSendString(s);
+  tout := not SerRecvString(6,is);
+  SerError := SerError or tout;
+  if tout then Bumout('Serial Timeout Error Waiting for Long!');
+  { skip wsize and rsize }
+  LongIntByteRec(data).Byte0 := byte(is[3]);
+  LongIntByteRec(data).Byte1 := byte(is[4]);
+  LongIntByteRec(data).Byte2 := byte(is[5]);
+  LongIntByteRec(data).Byte3 := byte(is[6]);
+  LBPCRCError := CheckCRC(is);
+  LBPDiscover := data;
+end;
+
+procedure LBPEnableCRC;
+begin { do manually because crcs are enabled after command }
+  SerSendChar(char(LBPWRITE_byte or LBPENACRC_FLAG));
+  SerSendChar(char(LBPTRUE_flag));
+  LBPCRCEnabled := true;
+  CheckCRC(NullCRC);
+end;
+
+procedure LBPDisableCRC;
+begin
+  LBPLocalWrite(LBPENACRC_flag,LBPFALSE_flag);
+end;
+
+function LBPReadVersion : byte;
+begin
+  LBPReadVersion := LBPLocalRead(LBPVERSION_byte);
+end;
+
+function LBPReadStatus: byte;
+begin
+  LBPReadStatus := LBPLocalRead(LBPSTATUS_byte);
+end;
+
+procedure LBPWriteStatus(data : byte);
+begin
+  LBPLocalWrite(LBPSTATUS_byte,data);
+end;
+
+procedure LBPClearStatus;
+begin
+  LBPLocalWrite(LBPSTATUS_byte,0);
+end;
+
+function LBPReadRPCSize : word;
+var data : word;
+begin
+  WordByteRec(data).Byte0 := LBPLocalRead(LBPRPCSIZEL_byte);
+  WordByteRec(data).Byte1 := LBPLocalRead(LBPRPCSIZEH_byte);
+  LBPReadRPCSize := data;
+end;
+
+procedure LBPWriteLEDS(data : byte);
+begin
+  LBPLocalWrite(LBPSETLEDS_byte,data);
+end;
+
+procedure LBPWriteAddToAddress(n : byte);
+begin
+  LBPLocalWrite(LBPADDADDRESS_byte,n);
+end;
+
+procedure LBPProcReset;
+begin
+  LBPLocalWrite(LBPPROCRESET_byte,LBPRESETCODE_byte);
+end;
+
+procedure LBPSoftDMCResetOn;
+begin
+  LBPWriteWord(ROMAddPort,$8000); { Reset on }
+end;
+
+procedure LBPSoftDMCResetOff;
+begin
+  LBPWriteWord(ROMAddPort,$0000); { Reset Off }
+end;
+
+procedure LBPWriteRom(add : word;data : word);
+begin
+  LBPWriteWord(ROMAddPort,(add or ProcResetBit));
+  LBPWriteWord(ROMDataPort,data);
+end;
+
+function LBPReadRom(add : word): word;
+begin
+  LBPWriteWord(ROMAddPort,(add or ProcResetBit));
+  LBPReadRom := LBPReadWord(ROMDataPort);
+end;
+
+
+procedure LBPFlashStart;
+begin
+  LBPLocalWrite(LBPNONVOL_flag,LBPNONVOLFLASH_byte);
+end;
+
+procedure LBPFlashStop;
+begin
+  LBPLocalWrite(LBPNONVOL_flag,0);
+end;
+
+function LBPGetWriteSize : word;
+begin
+  LBPGetWriteSize := 1 shl LBPReadByte(LBPFLASHWRITESIZE_ptr);
+end;
+
+function LBPGetEraseSize : word;
+begin
+  LBPGetEraseSize := 1 shl LBPReadByte(LBPFLASHERASESIZE_ptr);
+end;
+
+procedure LBPSetOffset(off : longint);
+begin
+  LBPWriteLong(LBPFLASHOFFSET_ptr,off);
+end;
+
+function LBPGetOffset:  longint;
+begin
+  LBPGetOffset := LBPReadLong(LBPFLASHOFFSET_ptr);
+end;
+
+function LBPProgSync: boolean;
+var ok : boolean;
+cookie : byte;
+begin
+  cookie := $FF;
+  ok := false;
+  cookie := LBPReadCookie;
+  ok := (not SerError) and (cookie = LBPCOOKIECODE_byte);
+  LBPProgSync := ok;
+end;
+
+procedure LBPCommitErase;
+begin
+  LBPWriteByte(LBPFLASHCOMMIT_ptr,LBPFLASHERASE_byte);
+  if not LBPProgSync then BumOut('Sync error');
+end;
+
+procedure LBPCommitWrite;
+begin
+  LBPWriteByte(LBPFLASHCOMMIT_ptr,LBPFLASHWRITE_byte);
+  if not LBPProgSync then BumOut('Sync error');
+end;
+
+procedure LBPWriteEEPROM(add : word;data : byte);
+begin
+  LBPLocalWrite(LBPNONVOL_flag,LBPNONVOLEEPROM_byte);
+  LBPWriteByte(add,data);
+  if not LBPProgSync then BumOut('EEPROM Byte Write Sync error');
+  LBPLocalWrite(LBPNONVOL_flag,0);
+end;
+
+function LBPReadEEPROM(add : word): byte;
+begin
+  LBPLocalWrite(LBPNONVOL_flag,LBPNONVOLEEPROM_byte);
+  LBPReadEEPROM := LBPReadByte(add);
+  LBPLocalWrite(LBPNONVOL_flag,0);
+end;
+
+procedure LBPWriteEEPROMWord(add : word;data : word);
+begin
+  LBPLocalWrite(LBPNONVOL_flag,LBPNONVOLEEPROM_byte);
+  LBPWriteWord(add,data);
+  if not LBPProgSync then BumOut('EEPROM Word Write Sync error');
+  LBPLocalWrite(LBPNONVOL_flag,0);
+end;
+
+function LBPReadEEPROMWord(add : word): word;
+begin
+  LBPLocalWrite(LBPNONVOL_flag,LBPNONVOLEEPROM_byte);
+  LBPReadEEPROMWord := LBPReadWord(add);
+  LBPLocalWrite(LBPNONVOL_flag,0);
+end;
+
+procedure LBPWriteEEPROMLong(add : word;data : longint);
+begin
+  LBPLocalWrite(LBPNONVOL_flag,LBPNONVOLEEPROM_byte);
+  LBPWriteLong(add,data);
+  if not LBPProgSync then BumOut('EEPROM Long Write Sync error');
+  LBPLocalWrite(LBPNONVOL_flag,0);
+end;
+
+function LBPReadEEPROMLong(add : word): longint;
+begin
+  LBPLocalWrite(LBPNONVOL_flag,LBPNONVOLEEPROM_byte);
+  LBPReadEEPROMLong := LBPReadLong(add);
+  LBPLocalWrite(LBPNONVOL_flag,0);
+end;
+
+(*
+procedure LBPWriteBlock(add:word; ourbuffer : BBufPtrType);
+var s : string;
+i : integer;
+begin
+  s := '';
+  s := s + char(LBPCOMMAND_byte or LBPWRITE_byte or LBPA2_byte or LBPD8_byte);
+  s := s + char(WordByteRec(add).Byte0);
+  s := s + char(WordByteRec(add).Byte1);
+  s := s + char(ourbuffer^[0]);
+  s := s + char(ourbuffer^[1]);
+  s := s + char(ourbuffer^[2]);
+  s := s + char(ourbuffer^[3]);
+  s := s + char(ourbuffer^[4]);
+  s := s + char(ourbuffer^[5]);
+  s := s + char(ourbuffer^[6]);
+  s := s + char(ourbuffer^[7]);
+  AppendCRC(s);
+  SerSendString(s);
+  CheckCRC(NullCRC);
+end;
+
+procedure LBPReadBlock(add:word; ourbuffer : RBufPtrType);
+var data : comp;
+begin
+  data := LBPReadDouble(add);
+  ourbuffer^[0] := CompByteRec(data).Byte0;
+  ourbuffer^[1] := CompByteRec(data).Byte1;
+  ourbuffer^[2] := CompByteRec(data).Byte2;
+  ourbuffer^[3] := CompByteRec(data).Byte3;
+  ourbuffer^[4] := CompByteRec(data).Byte4;
+  ourbuffer^[5] := CompByteRec(data).Byte5;
+  ourbuffer^[6] := CompByteRec(data).Byte6;
+  ourbuffer^[7] := CompByteRec(data).Byte7;
+end;
+*)
+function LBPSync(var message : string) : boolean;
+var origchartimeout : longint;
+begin
+  SerError := false;
+  ExitOnTimeout := false;
+  ExitOnCRCError := false;
+  LBPSync := false;
+  LBPCRCEnabled := false;
+  LBPCRC := 0;
+  message := 'LBP Serial Communication failed !';
+  SerTossChars;
+  delay(MaxParserTimeout); { worst case resync timeout delay }
+  SerTossChars;
+  origchartimeout := CharTimeout;
+  CharTimeout := CharTimeout div 20;
+  if LBPProgSync then
+  begin
+    LBPSync := true;
+    message := 'Using LBP Serial Interface';
+  end
+  else
+  begin { try with crcs enabled }
+    SerTossChars;
+    delay(MaxParserTimeout); { worst case resync timeout delay }
+    SerTossChars;
+    SerError := false;
+{$IFDEF DEBUG}
+    writeln('Trying with CRC''s');
+{$ENDIF DEBUG}
+    LBPCRCEnabled := true;
+    if LBPProgSync then
+    begin
+      LBPClearStatus;
+      LBPSync := true;
+      message := 'Using LBP Serial Interface With CRCs';
+    end
+    else
+    begin
+      LBPCRCEnabled := false;
+    end;
+  end;
+  CharTimeout := origchartimeout;
+  ExitOnTimeout := true;
+  ExitOnCRCError := true;
+end;
+
+{ fixed eeprom write with progsync }

5i24/utils/dos/source/USERIAL.PAS

@@ -0,0 +1,360 @@
+{ USerial : Windows/DOS 16C450 or 16C550 or Mesa Serial port routines }
+
+type
+ComPortHardwareTypes = (STDComPort,MESAComPort,SSLBPPort,NOPort);
+
+var
+CharTimeOut : longint; { milliseconds }
+ExitOnTimeout  : boolean;
+TheBaudRateMul : real;
+TheBaudRate : longint;
+SerError : boolean;
+ComPortHardwareType : ComPortHardwareTypes;
+
+{$IFNDEF WINDOWS}
+  {$I serial.pas }
+  {I MesaUart.pas }
+  {$I M32Uart.pas }
+{$ENDIF}
+
+procedure SerSetRTSHigh;
+begin
+{$IFDEF WINDOWS}
+  Ser.RTS := true;
+{$ELSE}
+  case ComPortHardwareType of
+    STDComPort: ForceRTSHigh(TheComPort);
+  end;
+{$ENDIF}
+end;
+
+procedure SerSetRTSLow;
+begin
+{$IFDEF WINDOWS}
+  Ser.RTS := false;
+{$ELSE}
+  case ComPortHardwareType of
+    STDComPort: ForceRTSLow(TheComPort);
+  end;
+{$ENDIF}
+end;
+
+
+{$IFDEF WINDOWS}
+procedure SerTossChars;
+var dummychar : char;
+begin
+  ser.Purge;
+  repeat
+    delay(10);
+    if ser.WaitingData <> 0 then
+    begin
+      dummychar := char(ser.RecvByte(CharTimeOut));
+    end;
+    delay(10);
+  until ser.WaitingData = 0;
+end;
+
+{$ELSE NOT WINDOWS}
+
+
+procedure SerTossChars;
+begin
+  case ComPortHardwareType of
+    STDComPort: TossChars(TheComPort,20);
+    MESAComPort: MesaSerTossChars(TheComport);
+  end;
+end;
+
+function STDBaudRateValid(comport : word; br,bm : real) : boolean;
+var ourbaud,testbaud,ratio : real;
+divisor : word;
+begin
+  STDBaudRateValid := true;
+  ourbaud := br/bm;
+  divisor := round(STDBRClock/round(br/bm*16.0));
+  testbaud := StdBRClock / divisor /16.0;
+  ratio := ourbaud / testbaud;
+  if (ratio > 1.0) and (ratio > 1.03) then STDBaudRateValid := false;
+  if (ratio < 1.0) and (ratio < 0.97) then STDBaudRateValid := false;
+end;
+
+function STDSetBaud(comport : word; br,bm : real) : boolean;
+var ourbaud : real;
+begin
+  if STDBaudRateValid(comport,br,bm) then
+  begin
+    ourbaud := br/bm;
+{$IFDEF WINDOWS}
+    ser.Config(round(ourbaud),8,'N',0,false,false);
+{$ELSE} { DOS }
+    SetBaudRate(comport,round(ourbaud));
+{$ENDIF}
+    STDSetBaud := true;
+  end
+  else
+  begin
+    STDSetBaud := false;
+    writeln('Invalid Baud Rate');
+  end;
+end;
+
+{ dos }
+
+function DosSerRecvChar(var c : char) : boolean;
+var timeout : longint;
+ourchar : char;
+begin
+  timeout := CharTimeOut;
+  while ((port[TheComPort + LineStat] and DataReady) = 0) and (timeout <> 0) do timeout := timeout -1;
+  if timeout <> 0 then
+  begin
+    ourchar := char(port[TheComPort + RecReg]);
+    DosSerRecvChar := true;
+    c := ourchar;
+{$IFDEF SDEBUG}
+    Hexprint(byte(ourchar),2);
+    write(' ');
+{$ENDIF}
+  end
+  else
+  begin
+    DosSerRecvChar := false;
+    SerError := true;
+    if ExitOnTimeout then Error(CharTimeoutErr);
+  end;
+end;
+
+function DosSerRecvString(n : integer;var s : string) : boolean;
+var
+count : integer;
+is : string;
+timeout : longint;
+ourchar : char;
+charok : boolean;
+begin
+  DosSerRecvString := false;
+  charok := true;
+  is := '';
+  for count := 1 to n do
+  begin
+    if DosSerRecvChar(ourchar) then
+    begin
+      is := is + ourchar;
+    end else charok := false;
+  end;
+  DosSerRecvString := charok;
+  s := is;
+end;
+
+procedure DosSerSendChar(c : char);
+var dummy : char;
+begin
+  if SerType = TwoWire then
+  begin
+    ForceRTSHigh(TheComPort);
+    {delay(1);}
+  end;
+  while (port[TheComPort + LineStat] and THRE) = 0 do {wait for xmit char} ;
+  port[TheComPort + TrHReg] := byte(c);
+{$IFDEF SDEBUG}
+    DebugString := DebugString + HexString(longint(c),2) + ' ';
+{$ENDIF}
+
+  if SerType = TwoWire then
+  begin
+   WaitForXmitDone(TheComPort);
+   ForceRTSLow(TheComPort);
+   DosSerRecvChar(dummy);
+  end;
+end;
+
+procedure DosSerSendString(s : string);
+var i : integer;
+begin
+  DisableInterrupts;
+  for i := 1 to length(s) do
+  begin
+    DosSerSendChar(s[i]);
+  end;
+  EnableInterrupts;
+end;
+
+procedure DosSerOpen(comport : word; br,bm : real);
+begin
+  DefaultComInit(comport);
+  EnableFifos(comport); { don't check if fifos are there because it sends garbage }
+  STDSetBaud(comport,br,bm);
+  TossChars(comport,20); { make real sure there are no pending chars }
+end;
+
+function DosCanRead(ms : integer) : boolean;
+var ctimeout : longint;
+begin
+  if ms <> 0 then
+  begin
+    ctimeout := LoopsPermS * longint(ms);
+    while ((port[TheComPort + LineStat] and DataReady = 0) and (ctimeout <> 0)) do ctimeout := ctimeout -1;
+    if ctimeout <> 0 then DosCanRead := true else DosCanRead := false;
+  end
+  else if ((port[TheComPort + LineStat] and DataReady) <> 0) then DosCanRead := true else DosCanRead := false
+end;
+{$ENDIF WINDOWS}
+
+{ all }
+
+function SerOpen(var message : string) : boolean;
+var openok : boolean;
+begin
+  message := '';
+  SerOpen := false;
+  openok := false;
+{$IFDEF WINDOWS}
+
+  {Writeln('Attempt to open serial port: ',TheComPort); }
+  ser:=TBlockserial.Create;
+  {ser.RaiseExcept:=True;}
+  ser.Connect(TheComPort);
+  ser.Config(round(TheBaudrate/TheBaudRateMul),8,'N',0,false,false);
+  if ser.LastError = 0 then openok := true else message := TheComPort;
+  SerTossChars;
+  {$ELSE} { DOS }
+  case ComPortHardwareType of
+    MESAComPort:
+    begin
+      if MesaComportThere(TheComPort) then
+      begin
+        MesaSerOpen(TheComPort,TheBaudRate,TheBaudRateMul);
+        openok := true;
+      end;
+      message := 'MesaCom port'
+    end;
+
+    STDComPort:
+    begin
+      if ComPortThere(TheComport) then
+      begin
+        DosSerOpen(TheComPort,TheBaudRate,TheBaudRateMul);
+        openok := true;
+      end;
+      message := 'Dos Com port'
+    end;
+  end; { case }
+{$ENDIF}
+  if openok then
+  begin
+    message := message + ' open ok';
+    SerOpen := true;
+  end else message := message + ' open failed';
+end;
+
+procedure SerClose;
+begin
+{$IFDEF WINDOWS}
+  ser.free;
+{$ELSE} { DOS }
+{$ENDIF}
+end;
+
+function SerRecvChar(var c : char) : boolean;
+begin
+{$IFDEF WINDOWS}
+  SerError := true;
+  c := char(ser.RecvByte(CharTimeOut));
+  if ser.LastError = ErrTimeout then
+  begin
+    SerRecvChar := false;
+    if ExitOnTimeout then Error(CharTimeoutErr);
+  end
+  else
+  begin
+    SerRecvChar := true;
+    SerError := false;
+  end;
+{$ELSE} { DOS }
+  case ComPortHardwareType of
+    MESAComPort: SerRecvChar := MesaSerRecvChar(c);
+    STDComPort: SerRecvChar := DosSerRecvChar(c);
+  end;
+{$ENDIF}
+{$IFDEF SERDEBUG}
+    Hexprint(byte(c),2);
+    writeln;
+{$ENDIF}
+
+end;
+
+function SerRecvString(n : integer;var s : string) : boolean;
+var index : integer;
+begin
+  s := '';
+{$IFDEF WINDOWS}
+  s := ser.RecvBufferStr(n,CharTimeOut);
+  if ser.LastError = ErrTimeout then SerRecvString := false else SerRecvString := true;
+{$ELSE} { DOS }
+  case ComPortHardwareType of
+    MESAComPort: SerRecvString := MesaSerRecvString(n,s);
+    STDComPort: SerRecvString := DosSerRecvString(n,s);
+  end;
+{$ENDIF}
+{$IFDEF SERDEBUG}
+  write('Recv Data: ');
+  for index := 1 to length(s) do
+  begin
+    hexprint(byte(s[index]),2);
+    write(',');
+  end;
+  writeln;
+{$ENDIF}
+end;
+
+procedure SerSendChar(c : char);
+begin
+{$IFDEF WINDOWS}
+  ser.SendByte(byte(c));
+{$ELSE} { DOS }
+  case ComPortHardwareType of
+    MESAComPort: MesaSerSendChar(c);
+    STDComPort: DosSerSendChar(c);
+  end;
+{$ENDIF}
+end;
+
+procedure SerSendString(s : string);
+var index : integer;
+begin
+{$IFDEF SERDEBUG}
+  write('Send Data: ');
+  for index := 1 to length(s) do
+  begin
+    hexprint(byte(s[index]),2);
+    write(',');
+  end;
+  writeln;
+{$ENDIF}
+
+
+{$IFDEF WINDOWS}
+  ser.SendString(s);
+{$ELSE}
+  case ComPortHardwareType of
+    MESAComPort: MesaSendString(s);
+    STDComPort: DosSerSendString(s);
+  end;
+{$ENDIF}
+end;
+
+function SerCanRead(ms: longint) : boolean;
+begin
+{$IFDEF WINDOWS}
+  SerCanRead := ser.CanReadEx(ms);
+{$ELSE} { DOS }
+  case ComPortHardwareType of
+    MESAComPort: SerCanRead := MesaCanRead(ms);
+    STDComPort: SerCanRead := DosCanRead(ms);
+  end;
+{$ENDIF}
+end;
+
+{fixed toss char reversed paramaters range check error 12-16-2009}
+{don't setrtshigh/low in mesa mode 2-3-2010 }

5i24/utils/dos/source/WP32.PAS

@@ -0,0 +1,70 @@
+program WriteParam32;
+
+{$IFDEF WINDOWS}
+uses synaser,synautil,synaip,blcksock,dos,crt;
+var
+ser:TBlockSerial;
+TheComPort : string;
+IPAddr : string;
+Socket : TUDPBlockSocket;
+{$ELSE}
+uses dos,crt;
+var TheComPort : word;
+{$ENDIF}
+
+{$I SELECTC}
+{$I SELECTIO}
+{I SELECTP}
+{$I SELECTPR}
+{$I INTERFCE}
+
+procedure Error(err : integer);
+begin
+  writeln(errorrecord[err].errstr);
+  halt(2);
+end;
+
+
+procedure Usage;
+begin
+  writeln('Usage: wp32 HexRegisterOffset Hexdata32');
+  writeln;
+  halt(2);
+end;
+
+
+procedure ScanParms;
+var
+parm : word;
+validparm : boolean;
+didit : boolean;
+themem : longint;
+thedata : longint;
+begin
+  parm := 1;
+  validparm := true;
+  didit := false;
+  while validparm and (parm <= ParamCount) do
+  begin
+    validparm := false;
+    if HexLongRead(Paramstr(parm),themem) then
+    begin
+      parm := parm +1;
+      if HexLongRead(Paramstr(parm),thedata) then
+      begin
+        parm := parm +1;
+        Write32(themem,thedata);
+        validparm := true;
+        didit := true;
+      end;
+    end;
+  end;
+  if not didit then writeln('Nothing done!!!');
+end;
+
+begin
+  GetOurEnv;
+  if not InitializeInterface(message) then bumout(message);
+  if paramcount <2 then Usage;
+  ScanParms;
+end.

5i24/utils/dos/source/XIO2001.PAS

@@ -0,0 +1,7 @@
+const
+XIO2001VendorID = $104C;
+XIO2001DeviceID = $8240;
+XIO2001SBADStatReg = $00B2;
+XIO2001GPIODDRReg  = $00B4;
+XIO2001GPIODataReg  = $00B6;
+XIO2001PCIBaseAddress0 = $10;  { memory access to local config regs }