Programming "rset" of QB 4.5 by assembly in Turbo Pascal

Question

I'm programming a procedure in Turbo Pascal with assembly to make a close job of "rset" statement in QB 4.5. "Rset" will justify a string to the last bytes in the variable by mean that the string will be saved in the variable at the end of it instead of saving in first bytes. This is the code I made but I see no reaction:

procedure rset(var s:string);

var
s_copy:string;
index,
s_size:integer;
s_offset,
s_seg,
s_copy_offset,
s_copy_seg:word;

l:byte;

label
again;

begin

l:=length(s);

if l=0 then exit;

index:=1;
while copy(s,index,1)='' do
inc(index);

s_copy:=copy(s,index,l);

s:='';
s_size:=sizeof(s);
s_offset:=ofs(s)+s_size-1;
s_copy_offset:=ofs(s_copy)+l-1;
s_copy_seg:=seg(s_copy);
s_seg:=seg(s);

asm
mov cl, [l]
mov si, [s_copy_offset]
mov di, [s_offset]

again:
mov es, [s_copy_seg]
mov al, [byte ptr es:si]
mov es, [s_seg]
mov [byte ptr es:di], al

dec si
dec di

dec cl
jnz again
end;

end;

Answer 1

The RSet statement in BASIC works with two strings. Your code works from a single string and can make sense if that string has some whitespace at its right end. Because then it is possible to RTrim the string and shift the remaining characters to the right inserting space characters on the left.
In below program I have implemented this approach in the RSet procedure.

If we were to faithfully replicate how BASIC's RSet statement works, then we need to use two strings, for the syntax is: RSet lvalue = rvalue, where lvalue is a string variable and rvalue can be any string expression.
In below program I have implemented this way of doing it in the qbRSet procedure.

Both RSet and qbRSet are pure assembler procedures. They don't require the usual begin and end; statements, just asm and end; are enough. And see how easy it is to refer to a variable via the lds and les assembly instructions. Do notice that assembly code should:

• always preserve the DS segment register as well as BP, SP, and SS
• never leave the direction flag set

The demo program is written in Turbo Pascal 6.0 and allows you to test the proposed codes with a variety of inputs. This is important so you can check out if it will work correctly in cases where strings are empty, very small, or very long.

program MyRSet;
type
  str20 = string[20];

var
  S, B : string;
  A    : str20;

procedure RSet(var S : string); assembler;
  asm
        les  di, S        (* ES:DI points at length byte of S *)
        xor  cx, cx
        mov  cl, [es:di]  (* CX is length of S *)
        cmp  cx, 1
        jbe  @@3
        add  di, cx       (* ES:DI points at last char of S *)
        mov  si, di       (* ES:SI points at last char of S *)

        { Collecting space characters starting at the end }
        mov  al, ' '
  @@1:  cmp  [es:si], al
        jne  @@2          (* Found a non-space character *)
        dec  si
        dec  cx
        jnz  @@1
        jz   @@3          (* Done, S is spaces only *)

        { Copying the RTrimmed content to the rear of the string}
  @@2:  std
        rep seges movsb

        { Left padding with spaces }
        mov  cx, di
        sub  cx, si
        rep stosb
        cld
  @@3:
  end;

procedure qbRSet(var Dst : str20; Src : string); assembler;
  asm
        push ds
        les  di, Dst      (* ES:DI points at length byte of Dst *)
        lds  si, Src      (* DS:SI points at length byte of Src *)
        xor  dx, dx
        mov  dl, [es:di]  (* DX is length of Dst *)
        xor  cx, cx
        mov  cl, [si]     (* CX is length of Src *)
        add  di, dx       (* ES:DI points at last char of Dst *)
        add  si, cx       (* DS:SI points at last char of Src *)
        sub  dx, cx
        jnb  @@1          (* Src is not longer than Dst *)
        add  cx, dx       (* else we use Copy(Src,1,Length(Dst)) *)
        add  si, dx
        xor  dx, dx       (*      and no leading whitespace *)
  @@1:  std
        rep movsb         (* Copying all or part of Src *)
        mov  al, ' '
        mov  cx, dx
        rep stosb         (* Prepending space characters *)
        cld
        pop  ds
  end;

BEGIN
  writeln('1. RSet A$ - Input text that ends with some whitespace');
  writeln('======================================================');
  repeat
    writeln('Input the A$. Use * to stop.');
    readln(S);
    if S <> '*' then
    begin
      RSet(S);
      writeln('|', S, '|')
    end;
  until S = '*';

  writeln;

  writeln('2. RSet A$=B$ - Length of A$ is 20');
  writeln('==================================');
  repeat
    fillchar(A[1],20,'?'); A[0] := #20;
    writeln('Input the B$. Use * to stop');
    readln(B);
    if B <> '*' then
    begin
      qbRSet(A, B);
      writeln('|', A, '|')
    end;
  until B = '*'
END.