2595 - Długie skoki

Wiemy wszyscy, że używanie instrukcji "goto" w Pascalu nie przynosi zaszczytu programiście, a nawet może ściągnąć na niego opinię niedouczonego i nieudolnego. Jesteśmy też wszyscy świadomi, że dowolny algorytm o jednym wejściu i jednym wyjściu można zapisać bez posługiwania się skokiem, jeśli tylko stosowany język programowania zawiera w sobie instrukcje "if" i "while".

Ale nawet mając taką wiedzę, nie możemy czasem oprzeć się wrażeniu, że jedno "goto" mogłoby znacznie skrócić bardzo rozbudowaną procedurę, a nawet, o zgrozo, uczynić ją bardziej czytelną. Wszak nawet sam Niklaus Wirth w swojej fundamentalnej książce "Algorytmy + Struktury danych = Programy" często posiłkuje się skokiem, choć podkreślić należy, że jest to zawsze skok w przód i najczęściej służy wyłącznie do wydostania się z wnętrza zagnieżdżonej pętli.

Jednym z przypadków, gdzie skok może uprościć program, a właściwie użyty - poprawić także jego czytelność, jest następująca sytuacja. Aby wykonać pewną czynność, o której wiemy, że może się nie powieść, wywołujemy procedurę A. Ta z kolei wywołuje procedurę B, B wywołuje C, C wywołuje D, ta zaś stwierdza, że operacja się nie powiodła. Cóż teraz ? Procedura D sygnalizuje błąd i zwraca sterowanie do C, analogicznie postępuje C, a następnie B i A, i tak oto nasz program dowiaduje się wreszcie, że jego życzenie nie może być spełnione. Czy nie było by prościej, gdyby procedura D po stwierdzeniu, że wystąpił błąd, wymusiła natychmiastowy powrót do tego miejsca, z którego wywołano procedurę A ? O ile uprościłoby to procedury A, B i C ? Tu jednak pojawia się problem: Turbo Pascal, w odróżnieniu od języka standardowego pozwala na użycie skoku tylko do przemieszczenia się wewnątrz bloku - innymi słowy, nie można "wyskoczyć" z procedury. Oprogramowanie takiego skoku spada zatem na programistę.

W celu wykonania tego zadania posłużyłem się pomysłem zaimplementowanym w języku C, a znanym jako longjump (długi skok). Koncepcja jest następująca: przed rozpoczęciem pewnej sekwencji instrukcji należy zapamiętać bieżący stan procesora (w C wykonuje to funkcja setjump()), a gdy zajdzie taka potrzeba, odtworzyć go (funkcją longjump()). Ta ostatnia operacja wywoła efekt bezpośredniego powrotu (skoku) do miejsca, do którego uprzednio powróciła funkcja setump(). Pozostaje jeszcze tylko problem rozpoznania, czy powrót z funkcji setjump() nastąpił po zapamiętaniu stanu procesora (czyli po "rzeczywistym" wywołaniu), czy też w wyniku długiego skoku (po wywołaniu "pozorowanym"). Rozstrzyga się to na podstawie rezultatu zwracanego przez setjmp: jeśli jest on równy 0, oznacza to powrót po zapamiętaniu stanu procesora; jeśli jest różny od zera, oznacza to powrót po wykonaniu długiego skoku.

Co należy w przypadku Turbo Pascala uznać za stan procesora ? Przyjmijmy, nieco nadmiarowo, że są nim bieżące wartości rejestrów DS, ES, CS, SS, SP, BP, IP oraz rejestru znaczników. Do przechowywania ich zawartości służy rekord o ośmiu polach typu Word oznaczony jako tJmpBuf. Do wypełnienia tegoż bufora wartościami,  tym samym do zapamiętania stanu procesora, służy funkcja SetJmp o nagłówku :

Function SetJmp(Var JmpBuf: tJmpBuf): Word;

Z kolei odtworzeniem stanu procesora zapamiętanego w buforze zajmuje się procedura LongJump o nagłówku :

Procedure LongJmp(Var JmpBuf: tJmpBuf; Result: Word);

Wartość parametru Result zostanie użyta jako rezultat funkcji SetJmp po wykonaniu dalekiego skoku. Ze względu na opisane wcześniej zachowanie funkcji SetJmp, jej rezultat w tym wypadku musi być różny od zera. Stąd wywołanie LongJmp(JmpBuf, 0) będzie traktowane jak wywołanie LongJmp(JmpBuf, 1); opisane elementy znalazły się w module o nazwie LongJump przedstawionym na wydruku 1.

Wydruk 2 demonstruje użycie mechanizmu długiego skoku. Bufor B służy do zapamiętania stanu procesora. Samo zapamiętanie wykona funkcja SetJmp. Ponieważ w tym wypadku jej rezultatem będzie 0, warunek w instrukcji If będzie spełniony i zostanie wywołana procedura Proc. W jej wnętrzu, po wykryciu błędu (symulowane sekwencją If True Then), zostanie wywołana z koleji procedura LongJmp, co będzie stanowić żądanie odtworzenia stanu procesora zapamiętanego w buforze B. Zostanie wykonany długi skok do miejsca poprzedniego powrotu SetJmp, ale w taki sposób, jakby rezultatem było 1. W tym przypadku warunek If nie będzie spełniony i rozpocznie się wykonanie instrukcji umieszczonych za Else.

Inne zastosowanie mechanizmu długiego skoku to pisanie tzw. współprocedur, czyli wykonujących się fragmentami naprzemiennie. Ale to już temat na zupełnie inny artykuł.

  Wydruk 1.

 (* ------------------------------------------------- *)
 (*                  UNIT LongJump                    *)
 (*                                                   *)
 (*       LongJump w Pascalu - Turbo Pascal v7.0      *)
 (*            Sławomir Wernikowski, 1994             *)
 (*                                                   *)
 (* ------------------------------------------------- *)

 Interface

 Type tJmpBuf = Record
        DS, ES, CS, SS, SP, BP, Flags, IP : Word;
      End;

 Function SetJmp(Var JmpBuf: tJmpBuf): Word;
 (* ------------------------------------------------- *)
 (* Przygotowanie bufora "długiego skoku"             *)
 (* Wyjście: JmpBuf - wypełniony bufor skoku          *)
 (* Wynik: = 0 po wypełnieniu bufora,                 *)
 (*        <> 0 po wykonaniu skoku                    *)
 (* ------------------------------------------------- *)


 Procedure LongJmp(Var JmpBuf: tJmpBuf; Result: Word);
 (* ------------------------------------------------- *)
 (* - wykonanie "długiego" skoku                      *)
 (* Wejście: JmpBuf - bufor skoku                     *)
 (*          Result - wartość dla SetJmp              *)
 (*          (jeśli Result = 0 to SetJm -> 1)         *)
 (* ------------------------------------------------- *)

 Implementation

 Function SetJmp(Var JmpBuf: tJmpBuf): Word; Assembler;
 Asm
   push   es            { przechowaj es }
   mov    bx,es         { bx := es      }
   pushf
   pop    cx            { cx := flags   }
   les    di,[JmpBuf]   { es:di := Adr(JmpBuf) }
   cld
   mov    ax,ds
   stosw                { JmpBuf.DS := ds }
   mov    ax,bx
   stosw                { JmpBuf.ES := oryginalny es }
   mov    ax,[bp+$04]   { ax := Seg(adres powrotu)   }
   stosw                { JmpBuf.CS := oryginalny cs }
   mov    ax,ss
   stosw                { JmpBuf.SS := ss }
   lea    ax,[bp+$0A]
   stosw                { JmpBuf.SP := oryginalny sp }
   mov    ax,[bp]
   stosw                { JmpBuf.BP := oryginalny bp }
   mov    ax,cx         { w cx flags }
   stosw                { JmpBuf.Flags := oryg. flags }
   mov    ax,[bp+$02]   { ax := ofs(adres powrotu)   }
   stosw                { JmpBuf.IP := oryginalny ip }
   pop    es            { odtwórz es }
   xor    ax,ax         { wynik=0 przygotowano bufor }
 End;
 Wydruk 1 Cd.

 Procedure LongJmp(Var JmpBuf: tJmpBuf; Result: Word); Assembler;
 Asm
   mov    ax,[Result]   { ax := Result          }
   cmp    ax,$0001      { if ax=0 then ax := 1  }
   adc    ax,$0000
   lds    si,[JmpBuf]   { ds:si := addr(JmpBuf) }
   pushf                { bx := flags }
   pop    bx
   cli                  { wyłącz przerwania na czas }
                        { ustanawiania stosu        }
   mov    ss,[si+$06]   { ss := JmpBuf.SS }
   mov    sp,[si+$08]   { sp := JmpBuf.SP }
   push   bx            { flags := bx     }
   popf
   mov    bx,[si+$0C]   { push JmpBuf.Flags }
   push   bx
   mov    bx,[si+$04]   { push JmpBuf.CS    }
   push   bx
   mov    bx,[si+$0E]   { push JmpBuf.IP    }
   push   bx
   mov    es,[si+$02]   { es := JmpBuf.ES   }
   mov    bp,[si=$0A]   { bp := JmpBuf.BP   }
   mov    ds,[si+$00]   { ds := JmpBuf.DS   }
   iret                 { pop ip; pop cs; pop Flags }
 End;
 {}
End.

 Wydruk 2.

Uses LongJump;

Var B : tJmpBuf;

Procedure Proc;
Begin
  WriteLn('Proc - Start');
  If True Then
  Begin
    WriteLn('Proc - wystapił błąd!');
    LongJmp(B,1)
  End;
  WriteLn('Proc - Stop');
End;

Begin
  If SetJmp(B) = 0 Then
  Begin
    WriteLn('Uruchomienie procedury Proc');
    Proc;
    WriteLn('Pomyślnewykonanie procedury Proc')
  End Else
  Begin
    WriteLn('Błąd wykonywania procedury Proc')
  End
End.

Sławomir Wiernikowski, PC Kurier 25/95, 7 Grudnia 1995r.