( {c} PPC Paris et l'Auteur, 1988 )

HEX

: PR-WORD ( nfa -- )
  DUP COUNT 1F AND
  ( affichage lettre par lettre du nom )
  2* OVER + SWAP DO
    I C@ 7F AND EMIT
  2 +LOOP
  SPACE
  ( test des mots protÅgÅs )
  DUP 5- FENCE @ <
  IF ." *" ELSE SPACE THEN
  ( test des mots immÅdiats )
  SPACE DUP C@ 40 AND
  IF ." i" ELSE SPACE THEN
  SPACE
  1 TRAVERSE 2+ DUP @ E7160 =
  ( dÅcryptage d'un mot vocabulaire )
  IF ." vo: " 9 + DUP
    ( le tester par rapport au voc. courant )
    CONTEXT @ =
    IF ." ct. " ELSE 4 SPACES THEN
    CURRENT @ =
    IF ." cu." ELSE 3 SPACES THEN
  ELSE DROP ." w."
  THEN ;

: CATALOG  ( -- )
  ( empÁcher l'interruption ON )
  F 2F441 N!
  ( dÅplacer la pile )
  S0 >R SP@ SP0 !
  ( on remonte la chaÑne È partir du dernier NFA )
  CONTEXT @ @
  BEGIN
    DUP PR-WORD
    KEY CASE
     E OF ( [ON] )
       SP! R> SP0 ! 0 2F441 !
     -1 ENDOF CR
     12 OF  ( [^] )
       CONTEXT @ OVER U<
      IF DUP 5- @ DUP 0=
       IF DROP THEN THEN
     0 ENDOF
     13 OF ( [v] )
      DEPTH 1 > IF DROP THEN
     0 ENDOF
     0 SWAP
    ENDCASE
  UNTIL ;

: MEM ( -- n )
  ( MEM donne le nombre de quartets disponibles )
  SP@ 1C1 - HERE - ;

: SYSCAT ( n -- )
  ( destinÅ È lister le systÉme )
  ( on teste que 0 < n < 12 )
  DUP 0< NOT ABS *
  DUP B - DUP 0> * +
  ( on se positionne dans la table )
  5 * E0005 +
  ( on sauvegarde la variable CONTEXT )
  CONTEXT DUP @ ROT ROT !
  CATALOG CONTEXT ! ;

DECIMAL