[Lazarus] Single-stepping assembler

Martin lazarus at mfriebe.de
Sun Sep 11 21:57:22 CEST 2011


On 11/09/2011 18:23, Martin wrote:
> On 11/09/2011 16:44, Mark Morgan Lloyd wrote:
>>
>> Lazarus is still building for ARM, I'll report back when I know how 
>> that looks. I'll also check the exact kernel versions that the test 
>> systems have running, in case there's some problem.
>>
>
> I'll see if I find the time => it should be simple to copy the code 
> from unit GDBMIClasses) TPseoudoTerminal.Open /Read and make a small 
> test app, that will open a pseudo terminal, set the handle to 
> none-blocking read, and call read on it => and test if read will block 
> or not.

Ok, the below code, imualtes the pseudoterminal handling => the read is 
supposed to bne none blocking.

maybe some of the constants are indeed wrong for your system (endianess)?


program Project1;
{$mode objfpc}{$H+}
{$packrecords c}

// from unit IDEMiniLibC
uses
   ctypes
   //,libc
   ;

const
   clib = 'c';
   InvalHandle = -1;
   ICANON    = $0000002;
   ECHO      = $0000008;
   VMIN = 6;
   VTIME = 5;
   TCSANOW = 0;
   F_DUPFD   = 0;
   F_GETFD   = 1;
   F_SETFD   = 2;
   F_GETFL   = 3;
   F_SETFL   = 4;
   O_NONBLOCK = &04000;
   EINTR = 4;
   NCCS = 32;

type
   error_t = cint;
   tcflag_t = cuint;
   cc_t = cchar;
   speed_t = cuint;
   size_t = cuint;
   ssize_t = cint;

   Ptermios = ^termios;
   termios = record
     c_iflag : tcflag_t;
     c_oflag : tcflag_t;
     c_cflag : tcflag_t;
     c_lflag : tcflag_t;
     c_line : cc_t;
     c_cc : array[0..(NCCS)-1] of cc_t;
     c_ispeed : speed_t;
     c_ospeed : speed_t;
   end;

function __errno_location: pcint; cdecl;external clib name 
'__errno_location';
function tcgetattr(__fd:cint; __termios_p: Ptermios):cint;cdecl;external 
clib name 'tcgetattr';
function tcsetattr(__fd:cint; __optional_actions:cint; __termios_p: 
Ptermios):cint;cdecl;external clib name 'tcsetattr';
function __read(Handle: cint; var Buffer; Count: size_t): ssize_t; 
cdecl;external clib name 'read';
function __write(Handle: cint; const Buffer; Count: size_t): ssize_t; 
cdecl;external clib name 'write';
function __close(Handle: cint): cint; cdecl;external clib name 'close';
function getpt:cint;cdecl;external clib name 'getpt';
function grantpt(__fd:cint):cint;cdecl;external clib name 'grantpt';
function unlockpt(__fd:cint):cint;cdecl;external clib name 'unlockpt';
function ptsname_r(__fd:cint; __buf:Pchar; 
__buflen:size_t):cint;cdecl;external clib name 'ptsname_r';
function fcntl(Handle: cint; Command: cint; Arg: clong): cint; 
cdecl;external clib name 'fcntl';


function errno : error_t;
begin
   Result:=__errno_location()^;
end;

// From TPseudoTerminal / unit GDBMIClasses

const
   BufLen = 100;
var
   ios: termios;
   i,int1: integer;
     FDeviceName: string;
     FPTy: Integer;
     FReadBuf: String;

begin
   FPTy := getpt;
   if FPTy < 0 then begin
     writeln('error getpt');
     exit;
   end;

   if (grantpt(FPTy) < 0) or (unlockpt(FPTy) < 0) then begin
     writeln('error grantpt / unlock');
     exit;
   end;

   setlength(FDeviceName, BufLen);
   if ptsname_r(FPTy, @FDeviceName[1], BufLen) < 0 then begin
     writeln('error ptsname');
     exit;
   end;

   setlength(FDeviceName,length(pchar(FDeviceName)));
   if tcgetattr(FPTy, @ios) <> 0 then begin
     writeln('error tcgetattr');
     exit;
   end;

   ios.c_lflag:= ios.c_lflag and not (icanon); // or echo);
   ios.c_cc[vmin]:= 1;
   ios.c_cc[vtime]:= 0;
   if tcsetattr(FPTy, tcsanow, @ios) <> 0 then begin
     writeln('error tcsetattr');
     exit;
   end;

   int1 := fcntl(FPTy, f_getfl, 0);
   if int1 = InvalHandle then begin
     writeln('error fcntlgetpt');
     exit;
   end;
   if fcntl(FPTy, f_setfl, int1 or o_nonblock) = InvalHandle then
   begin
     writeln('error fcntl');
     exit;
   end;

   writeln('now read');


   SetLength(FReadBuf, BufLen + 1);
   i := __read(FPTy, FReadBuf[1], BufLen);
   writeln(i);

end.





More information about the Lazarus mailing list