My code uses the Prologix W command to send the cal RAM address (0-255). It also uses the escape sequence when the address is a Prologix reserved character <CR><LF><ESC> and +.
It does look like there is a problem with the binary write or escape sequence logic.
print #main.Terminal,"Reading calibration data."
print #comm,"D2READING CAL" '"READING CAL" message on meter display
call sleep 10 'Fix for "John AR488" Firmware
y=0
for x = 0 to 255 'Read 256 nibbles
cp$=chr$(x)
'<ESC> sequence to send reserved binary chars to Prologix adapter
select case x
case 13 '<CR>
cp$=esc$+cp$
case 10 '<LF>
cp$=esc$+cp$
case 27 '<ESC>
cp$=esc$+cp$
case 43 '"+"
cp$=esc$+cp$
end select
'Read instrument config data. Each char contains one nibble.
ICal$(x)=QuerySERB$("W"+cp$,cr$,1,1)
if len(ICal$(x))<>1 then
if DBug then print #main.Terminal,"RC:Fail query W :";ICal$(x);" Len:";len(ICal$(x))
print #main.Terminal,"Instrument com fail."
if handle$ <> "NoSave" then
notice "Instrument com fail. Calibration not read."
else
notice "Instrument com fail during calibration data backup!"
end if
InstOK=0:goto [CalAbort] 'Instrument com fail
end if
y=y+1:if y>24 then print #main.Terminal,"*";:y=0
next x
'print #main.Terminal,":";ICal$(0);":";asc(ICal$(0)) 'Test for Girlando 0x00 binary send bug
print #main.Terminal,cr$;"Verify checksums."
CRSum=1 'init read data checsum is valid
for x = 0 to 18 'Checksum for 19 cal entries
cs=0 'Checksum
for y= 0 to 10 '11 nibbles data in each entry
nib=asc(ICal$((x*13)+y+1))
nib=nib and 15 'mask hi nibble
print #main.Terminal,ICal$((x*13)+y+1);
cs=cs+nib
cs=cs and 255 'Truncate to 8 bits
next y
dcs=cs
nib=asc(ICal$((x*13)+12))
nib=nib and 15 'mask hi nibble
print #main.Terminal,ICal$((x*13)+12);
nib=nib * 16 'Shift left 4 bits
cs=cs+nib
cs=cs and 255 'Truncate to 8 bits
nibh=nib
nib=asc(ICal$((x*13)+13))
nib=nib and 15 'mask hi nibble
print #main.Terminal,ICal$((x*13)+13);" : CkSum = (";
print #main.Terminal,nib+nibh;" ";
cs=cs+nib
cs=cs and 255 'Truncate to 8 bits
if dcs>10 then 'Format text
print #main.Terminal,"+ ";dcs;") ";
else
print #main.Terminal,"+ ";dcs;") ";
end if
if cs=255 then
print #main.Terminal,"Checksum OK."
else
if x=5 or x=16 or x=18 then
print #main.Terminal,"Checksum fail unused loc-ignore."
else
print #main.Terminal,"Checksum Fail."
CRSum=0 'Checksum fail
end if
end if
next x
print #main.Terminal,cr$;
print #main.Terminal,"Reading calibration data complete."
if CRSum=1 then
print #main.Terminal,"Calibration data checksum valid."
' if handle$<> "NoSave" then '
print #main.Terminal,"Calibration data saved to:";CalFileU$
open CalFileU$ for output as #5
for x = 0 to 255
print #5,ICal$(x);
next x
close #5
' end if
else
if handle$<> "NoSave" then
print #main.Terminal,"Calibration data not saved. Invalid checksum!"
notice "Calibration data not saved. invalid checksum!"
else
print #main.Terminal,"Invalid checksum during calibration data read!"
notice "Invalid checksum during calibration data backup!"
end if
end if
'====================================================
function QuerySERB$(icmd$,irsp$,blen,timeout)
'This function sends a command, then waits for a response or timeout
'Allows blen # of binary chars to be retrieved.
'icmd$ = command to send
'irsp$ = expected response
'blen = binary data flag >0 = number of expected bytes
'timeout = # seconds to abort (ms resolution)
if icmd$<>"" then if lof(#comm) > 0 then rs$ = input$(#comm, lof(#comm)) 'Flush buffer
if icmd$<>"" then print #comm,icmd$ 'Send command if present
if VTD>0 then call sleep VTD 'Time delay for Arduino adapter
' if DBug then print #main.Terminal,"QuerySERB: READ EOI"
if blen>0 then
print #comm,"++read eoi" 'Request response wait for EOI
' if DBug then print #main.Terminal,"QuerySERB:++read eoi"
else
print #comm,"++read eoi"
' in QueryserB Girlando adapter chokes on this:
' just use read eoi for now
' print #comm,"++read ";asc(right$(irsp$,1)) 'Request response no EOI wait for last char in irsp$
' if DBug then print #main.Terminal,"QuerySERB:++read "; asc(right$(irsp$,1));":"
end if
' if DBug then print #main.Terminal,"QuerySERB: READ EOIx"
ok = 0 'Start with error flag set
dl=0 'Binary data length
er$ = "" 'Instrument response
RTimeS=time$("ms") 'Init the timer
while ETime(RTimeS) < (timeout*1000) and ok = 0
if lof(#comm) > 0 then
rs$ = input$(#comm, lof(#comm))
er$ = er$ + rs$
dl=len(er$)
if blen<>0 then
'Use length if length > 0
if dl>=blen then ok=1 'Got all # bytes?
else
'Use ASCII terminator if length = 0
if instr(er$,irsp$) > 0 then ok = 1 'Found terminating string?
end if
RTimeS=time$("ms") 'Init the timer
end if
call sleep 1 'Don't be a CPU hog
wend
' if counter >0 then print #main.Terminal, "RespQS$: ";counter
QuerySERB$=er$ 'Return string
if ok = 0 then QuerySERB$="" 'Return null for error
' if DBug then print #main.Terminal,"QuerySERB Send:";qt$;icmd$;qt$;"QSB Reply:";qt$;er$;qt$;"QSB Delay:";VTD;"ms"
' if DBug then
' for n=1 to len(er$):print #main.Terminal, asc(mid$(er$,n,1));"%";:next
' end if
if lof(#comm) > 0 then er$ = input$(#comm, lof(#comm)) 'Clear any remaining from buffer
end function