assemblypascalx86-16turbo-pascalquickbasic

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


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;

Solution

  • 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.