584 lines
14 KiB
Plaintext
Executable File
584 lines
14 KiB
Plaintext
Executable File
{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 }
|