在 Turbo Pascal 中通过汇编编程 QB 4.5 "rset"

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

我正在使用汇编在 Turbo Pascal 中编写程序,以完成 QB 4.5 中的“rset”语句。 “Rset”会将字符串对齐到变量中的最后一个字节,这意味着字符串将保存在变量的末尾而不是保存在第一个字节中。这是我编写的代码,但我没有看到任何反应:

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;

BASIC 中的 RSet 语句使用 两个 字符串。您的代码适用于单个字符串,如果该字符串的右端有一些 whitespace ,则它是有意义的。因为这样就可以 RTrim 字符串并将剩余的字符向右移动,在左侧插入 space 个字符。
在下面的程序中,我在 RSet 过程中实现了这种方法。

如果我们要忠实地复制 BASIC 的 RSet 语句是如何工作的,那么我们需要使用两个字符串,因为语法是:RSet lvalue = rvalue,其中 lvalue是一个字符串变量,rvalue可以是任何字符串表达式。
在下面的程序中,我在 qbRSet 过程中实现了这种方式。

RSetqbRSet 都是纯 assembler 过程。它们不需要通常的 beginend; 语句,只需 asmend; 就足够了。看看通过 ldsles 汇编指令引用变量是多么容易。请注意汇编代码应该:

  • 始终保留 DS 段寄存器以及 BPSPSS
  • 永远不要设置方向标志

演示程序是用 Turbo Pascal 6.0 编写的,允许您使用各种输入测试建议的代码。这很重要,因此您可以检查它在字符串为空、非常小或非常长的情况下是否能正常工作。

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.