Path: utzoo!attcan!uunet!wuarchive!zaphod.mps.ohio-state.edu!uwm.edu!bionet!agate!ucbvax!CGEUGE54.BITNET!BARTHO
From: BARTHO@CGEUGE54.BITNET ("PAUL BARTHOLDI, OBSERVATOIRE DE GENEVE")
Newsgroups: comp.lang.forth
Subject: RE" How do I do this in forth ?  (-> stacks)
Message-ID: <16D0A3308E9F001B3C@cgeuge54.bitnet>
Date: 22 Oct 90 13:05:00 GMT
Sender: daemon@ucbvax.BERKELEY.EDU
Organization: The Internet
Lines: 126

Hi,

> Intereseting you should mention this.  I'm doing exactly the same
> thing with an othello playing program.  I haven't gotten very far, as
> I only last week found a un*x forth to run.  The way I think I'll
> handle it is to define a seperate stack for alpha, beta, depth.
> Set it up analogously to the return stack, ie: define words like
> alpha-pop, alpha-push, alpha@  <==>  r>, >r, r@
>

May I suggest an other syntax, both to define and use extra stacks:

      <stack-length> STACK <stack-name>
and
      <value> INTO <stack-name>   pushes the value on the named stack ...
      <stack-name>                pop the top of the named stack
                                  onto the normal stack ...
      RESET <stack-name>          clear the named stack

Here is my old version on my HP1000-F, with some comments added.

0 VARIABLE %%VAR    \ this is controled by INTO and RESET
                    \ and used by stacks objects as message

                    \ %%VAR is reset to 0 each time a stack is used
                    \ %%VAR is set to 1 by  INTO
                    \ %%VAR is set to 2 by  RESET
NB If you use often the top of stack, without willing to remove it, just
add a third command like TOS:
                    \ %%VAR is set to 3 by  TOS

1 %%VAR SET INTO
2 %%VAR SET RESET
\ 3 %%VAR SET TOS

\ the following two lines are error message used by the assembler bellow.

ORC5  & .  WORD,  Special stack underflow .   FORTH
ORC6  & .  WORD,  Special stack overflow .    FORTH

\ Now the definition of STACK, using HP1000 assembler ...  sorry for that
\ it should not be that difficult to understand and port to another cpu.
\ the B register points initially to the cfa,  INB, then make it to the pfa
\ Note that the HP1000 is a 16 bits WORD addressing machine.

                       +--------------------+
                       +    Header(name)    +
                       +--------------------+
                       +         lfa        +
                       +--------------------+
                       +         cfa        +
                       +--------------------+
                       +    stack pointer   +-----+
                       +--------------------+     |
                ^      +                    +     |
                |      +--------------------+     |
                |      +                    +     |
                |      +--------------------+     |
                |      +                    +     |
     stack size |      +--------------------+     |
                |      +                    +     |
                |      +--------------------+     |
                |      +    top of stack    +<----+
                |      +--------------------+     :
                v      +        ...         +     :
                       +--------------------+     :
                                             <----+   (initially)

: STACK <BUILD DUP HERE + DUP ,  1+ ,  0 DO  0 ,  LOOP
         ;CODE  %%VAR LDA,
                A0, IF,                       \  -- pop value from stack
                          INB, B) LDA, INB, CMA, B) ADA,
                          A0, IF,             \  -- stack underflow
                                   -1 # ADB,  B) LDA,  INA,  INB,  B) STA,
                                   P-V5 @  LDB,  ABORT,  THEN,
                          B) LDA, INA, B) STA,
                          -1 # ADA, A) LDA, PUSH,
                    THEN,
                          -1 # ADA,
                A0, IF,   CLA,  %%VAR STA,    \  -- push value into stack
                          INB, INB, B LDA, CMA, B) ADA,
                          A0, IF,             \  -- stack overflow
                                   -1 # ADB,  B) LDA,  INA,  INB,  B) STA,
                                   P-V6 @  LDB,  ABORT,  THEN,
                          B) LDA, -1 # ADA, B) STA,
                          S) LDB, A) STB, POP,
                    THEN, CLA,  %%VAR STA,    \  -- reset stack
                          INB,  B) LDA,  INA,  INB,  B) STA,  NEXT,

\ end of code.  NB The TOS command is NOT implemented here yet!

then use them in

  15 STACK alpha  15 STACK beta   32 STACK depth

  17 INTO alpha   31 INTO alpha 13 INTO alpha ...
  alpha INTO beta        ( move the top of alpha into beta)
  RESET depth            ( for some reason ...)
and, when available,
  TOS alpha INTO depth   ( will copy top of alpha into depth, without)
                         ( altering alpha )
etc.

NB. You may want to patch ABORT in such a way that is does an automatic
RESET for all defined stacks still present in the dictionnary.  I choose
not to do that, because I found it better to find the stacks in the state
they were at abort, and then do a manual RESET.

I like the 'TO' concept, that I introduced back in 1978.  This is just
another of its application.  You can implemented in other ways (quant, value
etc. I dont care!), and you may find that it is finally quite efficient
(just because you use the minimum of operations !).

Good luck with your projects,  just tell me when it works!

                             Best regards,      Paul.

     +--------------------------------------------------------------+
     |  Dr Paul Bartholdi             bartho@cgeuge54.bitnet        |
     |  Observatoire de Geneve        bartho@obs.unige.ch           |
     |  51, chemin des Maillettes     02284682161350::bartho (psi)  |
     |  CH-1290 Sauverny              20579::ugobs::bartho          |
     |  Switzerland                   +41 22 755 39 83       (fax)  |
     |                                +41 22 755 26 11     (phone)  |
     |                                +45 419 209 obsg ch  (telex)  |
     +--------------------------------------------------------------+