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;
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:
DS segment register as well as BP, SP, and SSThe 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.