;11-Jun-1999                                                    Alain Brobecker
;Reverse the stack
;Show the stack
;Exchange two numbers

  15 ! 14 ! 13 ! 12 ! 11 ! 10 ! 9 ! ;Fill stack
  8 ! 7 ! 6 ! 5 ! 4 ! 3 ! 2 ! 1 !
  "Stack looks like..." CR
  ShowStack
  ReverseStack
  "After ReverseStack function..." CR
  ShowStack
END


#! COPY 1 - COPY SKIP<>0 !End ! * END .!End DROP END


;IN         eN ... e1 or no elts
;OUT        Display them
#ShowStack
  SIZE 0                ;eN ... e1 SIZE C
.ShowStackLoop
  1 +                   ;Increment C
  COPY "  " HPRINT ": "
  COPY COPY             ;eN ... eC ... e1 SIZE C C C
  3 +                   ;eN ... eC ... e1 SIZE C C C+3
  SWAP                  ;eN ... C ... e1 SIZE C eC
  COPY HPRINT CR
  SWAP2                 ;eN ... C ... e1 SIZE eC C
  2 +                   ;eN ... C ... e1 SIZE eC C+2
  SWAP                  ;eN ... eC ... e1 SIZE C
  COPY2 SKIP= ShowStackLoop
  DROP2
END

;IN         eN ... e1 or no elts
;OUT        e1 ... eN or no elts
#ReverseStack
  SIZE 1                ;e1 ... eN C1 C2
  COPY2 SKIP> ReverseStackEnd ;While C1>C2
.ReverseStackLoop
  COPY2 2 +             ;eN ... eC1 ... eC2 ... e1 C1 C2 C1 C2+2
  SWAP2 2 +             ;eN ... eC1 ... eC2 ... e1 C1 C2 C2+2 C1+2
  EXCHG
  1 +                   ;eN ... eC2 ... eC1 ... e1 C1 C2+1
  SWAP2 1 -             ;eN ... eC2 ... eC1 ... e1 C2+1 C1-1
  SWAP2                 ;eN ... eC2 ... eC1 ... e1 C1-1 C2+1
  COPY2 SKIP<= ReverseStackLoop
.ReverseStackEnd
  DROP2
END

;IN         eN ... eB ... eA ... e1 B A
;OUT        eN ... eA ... eB ... e1
#EXCHG
  COPY                  ;eN ... eB ... eA ... e1 B A A
  4 SWAP                ;eN ... eB ... eA ... A B A e1
  SWAP2                 ;eN ... eB ... eA ... A B e1 A
  2 +                   ;eN ... eB ... eA ... A B e1 A+2
  SWAP                  ;eN ... eB ... e1 ... A B eA
  SWAP2                 ;eN ... eB ... e1 ... A eA B
  1 +                   ;eN ... eB ... e1 ... A eA B+1
  SWAP                  ;eN ... eA ... e1 ... A eB
  SWAP2                 ;eN ... eA ... e1 ... eB A
  SWAP                  ;eN ... eA ... eB ... e1
END
