OpenEuphoria

Re: Goto (Was Re: Open Source)

• Posted by Juergen Luethje <j.lue at gm??de> Oct 25, 2007
• 823 views

Pete Lomax wrote:

> Juergen Luethje wrote:
> > 
> > This whole discussion is not logical for me. Someone asks for intrducing
> > GOTO into Euphoria, and other people make suggestions how to limit the
> > damage then.
> > The first question should be: Why does someone want GOTO, and exactly
> > _for what purposes_? I'm pretty sure then we can find more appropriate
> > constructs for the desired purposes -- high level constructs for the
> > high level language Euphoria.
> > 
> Since you ask, I would say to translate a working program written in another
> language to Eu.

This is a concrete reason which provides a solid basis for discussing, thanks.

> As I recently said, I am not advocating goto, just not standing
> against it. Here is one case you probably already saw:
> 
> int parse()
> {
>     Token   tok;
> 
> reading:
>     tok = gettoken();
>     if (tok == END)
>         return ACCEPT;
> shifting:
>     if (shift(tok))
>         goto reading;
> reducing:
>     if (reduce(tok))
>         goto shifting;
>     return ERROR;
> }

If I didn't make a mistake, this translates to the following Eu program:

procedure foo ()
   Token tok
   
   while 1 do
      -- reading
      tok = gettoken()
      if tok = END then
         return ACCEPT
      end if
      
      while 1 do
         -- shifting
         if shift(tok) then
            exit
         end if
         -- reducing
         if not reduce(tok) then
            return ERROR
         end if
      end while
   end while
end procedure

> And here is that cobol fragment I spoke of last week:
> 
> PAGE "Optimised best-fit algorithm"
> PROGRAM BEST
> DATA DIVISION
> 77 REQUIRED PIC 9(12) COMP
> 	VALUE 1659  * Size of G1A
> *
> 77 LIMIT    PIC 9(4) COMP
> 	VALUE 6     * Length of table
> *
> 01 SIZES
>   02 SIZE OCCURS 250	PIC 9(12) COMP
> 	    VALUE  798
> 	    VALUE  344
> 	    VALUE  650
> 	    VALUE  410
> 	    VALUE  382
> 	    VALUE  734
> *
> 01 TS
>   02 FILLER PIC 9(4) COMP
> 	VALUE 6     * Entry length in bytes
>   02 TSMAX  PIC 9(4) COMP   * No of entries
>   02 FILLER PIC 9(4) COMP   * Work field for sort
>   02 FILLER PIC 9(4) COMP
> 	VALUE 1     * Start of sort key
>   02 FILLER PIC 9(4) COMP
> 	VALUE 6     * Length of sort key
> *
> 01 INCSET
>   02 INCLUDE OCCURS 250 PIC X	* 1..250
> *
> 77 LOW-BEST PIC 9(12) COMP
> 77 LOW-LEVEL	PIC 9(4) COMP
> 77 LOWSET   PIC X(250)
> *
> 77 HIGH-BEST	PIC 9(12) COMP
> 77 HIGH-LEVEL	PIC 9(4) COMP
> 77 HIGHSET  PIC X(250)
> *
> 77 WORK-TOT PIC 9(12) COMP
> 77 BA-TOT   PIC 9(12) COMP
> *
> 77 LEVEL    PIC 9(4) COMP
> 77 BA-LEVEL PIC 9(4) COMP
> *
> 77 ITEM     PIC 9(4) COMP
> *
> 01 FILLER REDEFINES ITEM
>   02 FILLER PIC X
>   02 ITB2   PIC X	* 1..250
> *
> 77 BA-ITEM  PIC 9(4) COMP
> *
> 01 FILLER REDEFINES BA-ITEM
>   02 FILLER PIC X
>   02 BA-ITB2	PIC X	    * 1..250
> *
> 77 INDEX    PIC 9(4) COMP
> 77 BA-IDX   PIC 9(4) COMP
> *
> PROCEDURE DIVISION
>     MOVE LIMIT TO TSMAX
>     CALL TSRT$ USING TS SIZES          -- a sort()
>     PERFORM DA-FIND-COMBINATION
>     ON NO EXCEPTION                    -- eg "EXIT 1" gives exception;
> 	DO                             --  (In Eu just use a flag)
> 	MOVE WORK-TOT TO BA-TOT
> 	MOVE LEVEL TO BA-LEVEL
> 	PERFORM BA-DISPLAY
> 	PERFORM DA200
> 	ON EXCEPTION FINISH
> 	ENDDO
>     END
>     MOVE LOWSET TO INCSET
>     MOVE LOW-LEVEL TO BA-LEVEL
>     MOVE LOW-BEST TO BA-TOT
>     DISPLAY "Lower figure"
>     PERFORM BA-DISPLAY
>     MOVE HIGHSET TO INCSET
>     MOVE HIGH-LEVEL TO BA-LEVEL
>     MOVE HIGH-BEST TO BA-TOT
>     DISPLAY "Higher figure"
>     PERFORM BA-DISPLAY
> EXIT
>  
> SECTION BA-DISPLAY
>     DISPLAY BA-TOT
>     DO FOR BA-IDX = 1 TO BA-LEVEL
> 	MOVE 0 TO BA-ITEM
> 	MOVE INCLUDE(BA-IDX) TO BA-ITB2       -- uses () for subscripts!
> 	DISPLAY BA-ITEM
> 	DISPLAY "  " SAMELINE
> 	DISPLAY SIZE(BA-ITEM) SAMELINE
>     ENDDO
>     DISPLAY "       Key <CR>"
>     SVC 6 USING 1                   -- wait_key()
>     ON EXCEPTION
>     END
> EXIT
>  
> SECTION DA-FIND-COMBINATION
> *
> * This section tries to find a set of sizes which add up to the
> * required amount exactly.
> *
>     MOVE 1 TO LEVEL
>     MOVE 0 TO LOW-BEST
>     MOVE 999999999 TO HIGH-BEST
>     MOVE LIMIT TO ITEM
> DA100.
>     MOVE ITB2 TO INCLUDE(LEVEL)
> *
> * Add size(item) to work-tot
> *
>     $LOAD SIZE(ITEM)     -- you can follow this, I trust. acc = size[item].
>     $ADDS WORK-TOT                               --  work_tot+=acc
>     $SUB REQUIRED                    -- acc = size[item]+work_tot-required
>     $EXIT EQ		* Found exact fit
>     $JUMP GT DA200	    * Too big
> *
> * This set is smaller than required - save it if it is best so far
> *
>     IF WORK-TOT > LOW-BEST
> 	$ADDS LOW-BEST
> 	MOVE LEVEL TO LOW-LEVEL
> 	MOVE INCSET TO LOWSET
>     END
>     IF ITEM > 1 	* More to be tested
> 	$STORE ITEM
> 	ADD 1 TO LEVEL	    * Leave item in table;
> 	GOTO DA100
> DA200.
> *
> * This set is larger than required - save it if it is best so far
> *
> 	IF WORK-TOT < HIGH-BEST
> 	$ADDS HIGH-BEST
> 	MOVE LEVEL TO HIGH-LEVEL
> 	MOVE INCSET TO HIGHSET
> 	END
>     END
> DA300.
> *
> * Now we need to backtrack;  remove item from running total and look
> * at the next instead.
> *
> * Subtract size(item) from work-tot
> *
>     $LOAD 0
>     $SUB SIZE(ITEM)
>     $ADDS WORK-TOT
>     IF ITEM > 1 	* More to be tested
> 	$STORE ITEM	* Look at next (overwrite item in table)
> 	GOTO DA100
>     END
> *
> * We have exhausted all possibilities at this level; backtrack to
> * a previous level.
> *
>     MOVE #00 TO INCLUDE(LEVEL)
>     ADD -1 TO LEVEL
>     $EXIT EQ 1		* All done
>     MOVE 0 TO ITEM
>     MOVE INCLUDE(LEVEL) TO ITB2
>     GOTO DA300
>  
> ENDPROG
> 
> I found it quite a challenge to get that working in Eu.

Sorry, I do not know anything about COBOL.

Regards,
   Juergen