Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.forth > #26334

Re: Co-routines a la Knuth

Show all headers | View raw

On Saturday, October 5, 2013 11:15:02 PM UTC+2, Paul Rubin wrote:
> mhx@iae.nl writes:
>
> > I found a co-routine implementation that doesn't use the R-stack
> > at all and only needs a single variable. (It is a special case.)
>
> The GA144 has a machine instruction for that.  It just swaps R (the 
> top of the return stack) with the program counter.

Well, that needlessly limits use of the R-stack.
The word CO does *not* use the R-stack, actually you can see that 
the R-stack mechanism is a nuisance (start: in the below update). 

I think CO is best described as a restricted GOTO, where the 
restriction comes from the fact that (in my implementation) only 
two specified words are involved. It is possible to see to and 
from which word CO goes, respectively comes from. In more 
complicated examples with more than two COR's and maybe multiple
entries of the same COR, it might be necessary to use a 
double-linked list (or a cyclic stack).

[..]
> A traditinal example is getting rid of the control inversion that it
> takes to process a i/o stream using ordinary subroutine calls, while
> keeping the i/o separate from the processing code:
>   http://www.chiark.greenend.org.uk/~sgtatham/coroutines.html

Very good, instructive, and amusing. However, I don't think that
that C code supports multiple exits and entries to each of the
linked routines.

-marcel

-- updated code ------------------------
(*
 * LANGUAGE    : ANS Forth with extensions
 * PROJECT     : Forth Environments
 * DESCRIPTION : From Donald E. Knuth's Chapter 1.4.2 in 'Fundamental 
               :  Algorithms' 2nd Ed. 
 * CATEGORY    : Contrived Coroutine example
 * AUTHOR      : Marcel Hendrix 
 * LAST CHANGE : October 5, 2013, Marcel Hendrix 
 *)


	NEEDS -miscutil

	REVISION -coroutines "--- Coroutine example   Version 0.02 ---"

	PRIVATES

DOC
(*
  Task:
  Translate one code in another.
  Input code is a sequence of alphameric characters terminated by a 
  period, e.g.,
     
     A2B5E3426FGOZYW3210PQ69R.	  (1)

  Blanks are ignored. Input is understood as follows, left to right:
  If the next character is a digit (i.e., 0, 1, ..,9), say n, it 
  indicates (n+1) repetitions of the following character, whether 
  the following character is a  digit or not. A nondigit simply 
  denotes itself. The output of the program is to consist of a 
  sequence indicated in this manner and separated into groups of 
  three characters each (where the last group may have less than 
  three characters). For example, (1) should be translated by our 
  program into

  ABB  BEE  EEE  E44  446  66F  GZY  W22  220  OPQ  999  999  999  R.

  The output consists of a maximum of 16 groups per line.

  See also: http://www.chiark.greenend.org.uk/~sgtatham/coroutines.html .
*)
ENDDOC

-- Co-routines & Stuff --------------------------------

0 VALUE #out	PRIVATE

: ?CR	#out #80 >= IF  CR  CLEAR #out  ENDIF ; PRIVATE

VARIABLE remember  PRIVATE
0 VALUE start

: start: 	HERE TO start ; IMMEDIATE
: start		start remember ! ;

: CO  	-OPT ]] remember @ [[
	$12345678 POSTPONE LITERAL ]] remember ! [[  HERE 4 - >R
	-OPT $5B C, $FF C, $E3 C, ( jmpI, ) HERE R> 32B! ; IMMEDIATE 

-- ----------------------------------------------------

0 VALUE ^input	PRIVATE
0 VALUE #input	PRIVATE
CREATE input 	PRIVATE  ,"   A2B5E3426  FG0ZYW3210PQ89R  ."


0 [IF] -- straightforward approach


: INIT ( -- ) input C@+ TO #input TO ^input  #80 TO #out ; PRIVATE 

-- Fetch next nonblank character.
-- Should only return valid chars. 
: GETCHAR ( -- char ok? ) 
	BEGIN  ^input C@  1 +TO ^input	
	       DUP BL = 
	WHILE  DROP  
	REPEAT DUP '.' <> ; PRIVATE

-- Assume that line-length is multiple of 5 chars.
: ~EMIT~ ( char -- )
	?CR
	#out 5 MOD 3 = IF  2 SPACES 2 +TO #out  ENDIF  
	EMIT  1 +TO #out  ; PRIVATE

-- Assume that all codes are valid, i.e. "3." doesn't happen.
: .CODE ( char -- ) 
	DUP  'A' 'Z' 1+  WITHIN IF  ~EMIT~ EXIT  ENDIF
	'0' - 1+ GETCHAR DROP >S 0 ?DO  S ~EMIT~  LOOP -S ; PRIVATE

: TEST	INIT  BEGIN  GETCHAR WHILE  .CODE  REPEAT  ?CR EMIT ;

[ELSE] -- Knuth's approach

0 VALUE mychar    PRIVATE

-- Should only return valid chars (never 0)
: GETCHAR ( -- ) 
	BEGIN  ^input C@  1 +TO ^input	
	       DUP BL = 
	WHILE  DROP  
	REPEAT TO mychar ; PRIVATE

: OUTS ( -- )
	BEGIN 
	   ?CR	
	   CO  mychar '.' <> WHILE mychar EMIT 
	   CO  mychar '.' <> WHILE mychar EMIT 
	   CO  mychar '.' <> WHILE mychar EMIT 
	   2 SPACES 5 TO #out
	REPEATED ; PRIVATE

: INS ( -- )
start:	BEGIN  GETCHAR  mychar '.' <>
	WHILE  mychar 'A' 'Z' 1+  WITHIN 
		  IF  CO  
	        ELSE  mychar '0' - 1+  GETCHAR  0 ?DO  CO  LOOP 
	       ENDIF
	REPEAT '.' EMIT ; PRIVATE

: TEST ( -- ) 
	input CHAR+ TO ^input  
	#80 TO #out  
	start OUTS ; 

[THEN]

:ABOUT	CR ." Contrived example from D.E. Knuth's 'Fundamental 
	CR ."   Algorithms,' Chapter 1.4.2, Coroutines, 2nd Ed." 
	CR ." Try: TEST " 
	CR ." Result should be: "
	CR ." ABB  BEE  EEE  E44  446  66F  GZY  W22  220  0PQ  "
	   ." 999  999  999  R." ;

		.ABOUT -coroutines CR
		DEPRIVE

                              (* End of Source *)

Back to comp.lang.forth | Previous | Next — Previous in thread | Next in thread | Find similar | Unroll thread

Thread

Co-routines a la Knuth mhx@iae.nl - 2013-10-05 11:50 -0700
  Re: Co-routines a la Knuth Paul Rubin <no.email@nospam.invalid> - 2013-10-05 14:15 -0700
    Re: Co-routines a la Knuth mhx@iae.nl - 2013-10-06 03:22 -0700
      Re: Co-routines a la Knuth mhx@iae.nl - 2013-10-06 09:58 -0700
  Re: Co-routines a la Knuth anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2013-10-07 12:33 +0000
    Re: Co-routines a la Knuth m.a.m.hendrix@tue.nl - 2013-10-07 07:17 -0700
      Re: Co-routines a la Knuth mhx@iae.nl - 2013-10-07 13:43 -0700
        Re: Co-routines a la Knuth "Elizabeth D. Rather" <erather@forth.com> - 2013-10-07 12:58 -1000
          Re: Co-routines a la Knuth mhx@iae.nl - 2013-10-08 23:58 -0700
            Re: Co-routines a la Knuth "Elizabeth D. Rather" <erather@forth.com> - 2013-10-08 21:08 -1000
      Re: Co-routines a la Knuth anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2013-10-08 15:05 +0000
        Re: Co-routines a la Knuth mhx@iae.nl - 2013-10-09 13:23 -0700

csiph-web