Marco van de Voort wrote:
In our previous episode, Mark Morgan Lloyd said:
Efficient implementation of coroutines requires CPU-specific code in the RTL and possibly the compiler. However http://www.chiark.greenend.org.uk/~sgtatham/coroutines.html suggests a way that coroutines can be implemented in a portable fashion in C, how can this be done in Object Pascal?

Seems more an oddity than a system, but it relies heavily on preprocessor
and fallthrough case.

The preprocessor part can be done, just use whatever preprocessor
(maybe even cpp) and then haul the resulting code through fpc.

But there is no fallthrough case (and personally I think that is a good
thing)

Generally agreed. I'm not particularly bothered about the syntax, although obviously having it fairly compact would be an advantage. I don't think it's possible to use a case/goto arrangement since this wouldn't be happy jumping into repeat or while loops, but it does look as though it's possible to use LongJmp() (insomnia has its advantages):


program coroutines;

uses SysUtils;

type    TState= record
           env: jmp_buf;
           line: cardinal
        end;

var     state: TState;
        once: boolean= false;
        scratch: char;


  function getchar(): char;

  var   sanity: jmp_buf;

  begin

    // Check that we're not trying to jump into exception blocks etc.

    if state.line <> 0 then begin
      SetJmp(sanity);
      Assert(PtrUInt(state.env.sp) + PtrUInt(state.env.bp) =
                PtrUInt(sanity.sp) + PtrUInt(sanity.bp),
                'Bad SP or BP at xfer to line ' + IntToStr(state.line));
      LongJmp(state.env, 1)
    end;

    SetJmp(state.env);
    if state.line = 0 then begin
      state.line := StrToInt( (*$I %LINE% *) );
      exit('A')
    end else
      state.line := 0;

..

    repeat
      SetJmp(state.env);
      if state.line = 0 then begin
        state.line := StrToInt( (*$I %LINE% *) );
        exit(#$ff)
      end else
        state.line := 0;
      once := true
    until once
  end { getChar } ;


begin
  FillByte(state, SizeOf(state), 0);
  scratch := getChar();
  while scratch <> #$ff do begin
    WriteLn(scratch);
    scratch := getChar()
  end
end.


The sanity check at the start is obviously processor-specific, but it doesn't use anything hidden and can at a pinch be omitted. It's obviously excessively verbose, but it is comparatively regular and does appear to handle at least some loop types properly.

--
Mark Morgan Lloyd
markMLl .AT. telemetry.co .DOT. uk

[Opinions above are the author's, not those of his employers or colleagues]
_______________________________________________
fpc-pascal maillist  -  fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal

Reply via email to