Jupiter Ace Forth (Extractor de Diccionario)

Elurdio
Mensajes: 510
Registrado: 07 Dic 2021 21:33
Ubicación: Barcelona
Agradecido : 115 veces
Agradecimiento recibido: 95 veces

Jupiter Ace Forth (Extractor de Diccionario)

Mensajepor Elurdio » 02 Feb 2022 22:51

Extractor de Diccionario

Como ya comenté en otros hilos, he hecho un extractor de diccionario totalmente automático. Se carga el programa encima del diccionario que se quiere extraer y se ejecuta. Para ello se le suministra el CFA de la palabra de la que se quiere generar el diccionario. El programa automáticamente dejará en el diccionario solo la palabra en cuestión y todas las que necesita para funcionar. Las demás desaparecen. NO hay que hacer nada más, queda listo para grabarse con un SAVE.

Si se quieren extraer varias palabras que son independientes entre sí en el mismo diccionario, lo más sencillo es crear una palabra tipo COLON con las palabras en cuestión (aunque ni siquiera funcione) y extraer ésta. Ej:

Queremos un diccionario con las palabras METAL y AZULENO y todas las que utilizan. Para ello creamos una palabra, sea TEST, así:

: TEST METAL AZULENO ;

y le damos al programa el CFA de TEST. Cuando termine, BORRAMOS o REDEFINIMOS TEST.

Bueno, esta era mi intención. La cruda realidad: Hace unos días que terminé el programa y tras muchas pruebas para encontrar porqué fallaba en muchas ocasiones, empiezo a creer que hay algún bug en el uso combinado de FORGET/REDEFINE (si el programa solo hace forgets o solo redefines, todo va bien). Incluso tengo diccionarios que imitando el proceso A MANO con el FORGET y el REDEFINE originales (no mis versiones OLVIDA/REDEF) se me cuelga en la misma palabra que con el programa.... y por más que lo miro y remiro, no encuentro el motivo: Están bien linkados (tanto en secuencia de arriba a abajo como al revés). No tienen mal ni la cabecera ni los cuerpos... voy a hacer un comprobador automático que haga esto para todas las palabras de un diccionario. Tampoco hay fallos en el tamaño (HERE) ni en los stacks... estoy frito!!

jltursan
Mensajes: 4728
Registrado: 20 Sep 2011 13:59
Ubicación: Madrid
Agradecido : 703 veces
Agradecimiento recibido: 1552 veces
Contactar:

Re: Jupiter Ace Forth (Extractor de Diccionario)

Mensajepor jltursan » 03 Feb 2022 11:34

Estás forzando la máquina con aplicaciones que imagino, no se esperaba que se exprimieran tanto -grin

Otra de esas preguntas del millón, ¿si empleas el ZesarUX y el Jupiter permite debug, no podrías depurar la ejecución y ver cual es el problema de ese cuelgue?. No tengo esa experiencia concreta; pero te aseguro que en otras máquinas/debuggers, sin eso, habría problemas a los que sería virtualmente imposible dar solución.

Elurdio
Mensajes: 510
Registrado: 07 Dic 2021 21:33
Ubicación: Barcelona
Agradecido : 115 veces
Agradecimiento recibido: 95 veces

Re: Jupiter Ace Forth (Extractor de Diccionario)

Mensajepor Elurdio » 03 Feb 2022 16:12

EigthyOne tiene debuger. Pero REDEFINE es quizás una de las rutinas (coma flotante aparte) más complejas del JA, por lo que rastrearla con el debugger lo dejo como último recurso.

Hoy ya he visto un rayo de luz al final del túnel. Hay dos tipos de fallos. Los reproducibles a mano y los que a mano funcionan. Los primeros se deben a que el diccionario, por causa que aún desconozco, está "estropeado" cara a cierta combinación de palabras a REDEFINIR o bien, hay un bug en REDEFINE que solo se ve en condiciones muy concretas. El diccionario sobre el que probé es uno muy, pero que muy tocado.

Los fallos reproducibles a mano, de momento los doy por perdidos (no se puede aplicar el programa a estos diccionarios sin corregirlos primero). Seguiré investigando más adelante.

Luego empecé a probar con otro diccionario: El del assembler/disassembler de Boldfield (unas 50 palabras). En según que extracciones me fallaban también pero el fallo NO era reproducible a mano. Así que lo achaco a mi programa. Como comprobar que ha pasado con los datos en un programa que lo primero que hace es borrarse a sí mismo, es muy tedioso, me hice una versión (tocando muy poca cosa) que se carga ANTES del programa a extraer, por lo que no necesito borrarlo (no es lo que persigo, pero me facilita mucho las comprobaciones) y aquí sucedió que los fallos NO reproducibles NO sucedían... tras varias pruebas concluí que el fallo está en el Programa Fantasma (el que se borra no más empezar).

Tras más pruebas creo que ya sé que pasa: El COLCHON lo hice para impedir que la pila me sobreescribiera las palabras fantasma, pero no tuve en cuenta que REDEFINE parece ser que hace uso de la memoria no usada más allá de la pila.... Así que espero solucionarlo con un COLCHÓN mucho mayor (tan grande como el diccionario a extraer).

jltursan
Mensajes: 4728
Registrado: 20 Sep 2011 13:59
Ubicación: Madrid
Agradecido : 703 veces
Agradecimiento recibido: 1552 veces
Contactar:

Re: Jupiter Ace Forth (Extractor de Diccionario)

Mensajepor jltursan » 03 Feb 2022 16:16

Ah, la pila, que haríamos sin ella...:roll:

Elurdio
Mensajes: 510
Registrado: 07 Dic 2021 21:33
Ubicación: Barcelona
Agradecido : 115 veces
Agradecimiento recibido: 95 veces

Re: Jupiter Ace Forth (Extractor de Diccionario)

Mensajepor Elurdio » 03 Feb 2022 23:29

Dejando aparte el caso del error reproducible a mano, que de momento no localizo la causa, al menos el otro caso ya está resuelto.

Al ejecutarse REDEFINE utiliza temporalmente el espacio que hay después del HERE para copiar allí la última palabra del diccionario. Si la diferencia de tamaño entre la que se redefine y la última del diccionario es lo suficientemente grande a favor de la última (unos 200 bytes para el colchón que usaba), se sobreescribe el programa fantasma...
Ahora usaré un colchón mucho mayor y antes de redefinir cualquier palabra el programa comprobará que el colchón sea suficiente. Si no lo es, avisará de la situación (proponiendo un nuevo tamaño de colchón para el siguiente intento).

NOTA: Tuve suerte en una de las pruebas con el diccionario del assembler/dis de Boldfield, pues la palabra que causó el error era enorme (8000 y pico de bytes) y sobreescribió la totalidad el programa fantasma, pues siendo más pequeñas podrían no haber sobreescrito nada o solo la parte del programa que no se utiliza durante el proceso de forgets/redefines y no haber detectado el error, como sucedía con otras pruebas (depende de la palabra que seleccione para extraer el dic.)

EDIT 11-08-2022: Lo que hace REDEFINE es hacer hueco para que quepa la última palabra del diccionario cuando la mueva al hueco de la que se redefine. Si la que se redefine tiene tamaño 100 y la última del diccionario tiene tamaño 900, tiene que mover la parte del diccionario encima de la que se redefine 900-100=800 bytes. Una vez hecho el hueco, COPIAR la última allí y ya puede borrarla del final del diccionario.
Como vemos, solo en el caso que la última palabra es mayor que la que se redefine se expandirá el diccionario temporalmente en tantos bytes como la diferencia de tamaños. Luego, cuando borre la original después de copiarla a su nueva posición, el diccionario será más pequeño.

Elurdio
Mensajes: 510
Registrado: 07 Dic 2021 21:33
Ubicación: Barcelona
Agradecido : 115 veces
Agradecimiento recibido: 95 veces

Re: Jupiter Ace Forth (Extractor de Diccionario)

Mensajepor Elurdio » 05 Feb 2022 16:12

Volviendo al tema del posible Bug en la palabra REDEFINE del Jupiter Ace, ya lo he encontrado... lo tenía en mi cabeza! -banghead
Perdona Steven por haber dudado de tu soberbia obra, el glorioso ROM del Jupiter Ace :oops:

Dándole vueltas al problema, caí en la cuenta que hacer FORGETS y REDEFINES a mano NO garantiza que no haya problemas en mi programa, pues son herramientas muy peligrosas si se usan mal (ya te lo avisa el manual). Un posible problema me vino en qué pasa si borro una palabra definidora y hay palabras definidas con ella en el diccionario... cuando se haga un redefine con una palabra por debajo de ellas y se muevan... me lo imagino, pero no lo sé con seguridad, no sé que hace exactamente el redefine internamente... en fin, que para evitar ese tipo de problemas (y quizás otros) opté por hacer lo siguiente:

Después que el programa ha extraído la lista de palabras que se han de preservar (las que conformarán el diccionario que se extrae), convertir todas las demás palabras del diccionario en palabras tipo CREATE antes de empezar el proceso de reducción del diccionario. Esto, además de quitarle muchísimo trabajo al REDEFINE (pues los PF de estas palabras NO se han de analizar durante una redefinición), evita problemas con palabras generadas con palabras tipo DEFINER/COMPILER en particular y cualquier otra en general. Lo acabo de probar y ... FUNCIONA!!.

Igual me he precipitado en dar el problema por resuelto, pero por primera vez el programa me funciona con el susodicho diccionario.... -drinks

Elurdio
Mensajes: 510
Registrado: 07 Dic 2021 21:33
Ubicación: Barcelona
Agradecido : 115 veces
Agradecimiento recibido: 95 veces

Re: Jupiter Ace Forth (Extractor de Diccionario)

Mensajepor Elurdio » 06 Feb 2022 15:55

Extractor de Diccionario

Continuación del primer post del hilo: (no repito lo allí dicho)

La palabra es DICEXTRACT y espera en la pila el CFA de la palabra a convertir en diccionario

Advertencias:

  1. Muy poco probado
  2. Solo debe haber el vocabulario FORTH (el que viene por defecto)
  3. NO debe haber ninguna palabra cuyo nombre empiece con el carácter de "copyright" (código ascii 127 en el JA)
  4. Extrae palabras Recursivas
  5. Consta de 76 palabras todas programadas en FORTH (sin código máquina)

Antes de cargar el programa encima del diccionario a extraer, encontrar el CFA de la palabra a extraer y apuntarlo (o guardarlo en una constante) pues al usar LOAD se borra la pila. Esto es por si, casualmente, la palabra a extraer tiene el mismo nombre que alguna de las del programa extractor. Si no es el caso, no hace falta.

NOTA: Si se produce un error de PUSH Overflow, es que la palabra STACK1 se ha quedado corta. Hacer un más grande y repetir el proceso. La que viene por defecto es de 200 bytes, suficiente para extraer una palabra que genere un diccionario de 98 palabras. Para hacer la nueva, después de cargar el programa hacer:

CREATE STACK1 n ALLOT
REDEFINE STACK1

n es el nuevo valor (mayor de 200), 2 bytes por palabra que albergará (+2 para el puntero)

NOTA del código: Los valores de las variables son los que había cuando Extraje el Código fuente, no significan nada.

Código: Seleccionar todo


DECIMAL

CREATE COLCHON 10000 ALLOT

15435   CONSTANT FINDLIMIT
4360    CONSTANT COMPILING
4229    CONSTANT DEFINING
3779    CONSTANT COLON
-32168  VARIABLE NEXTRED
18749   VARIABLE ACTUALWORD
16      VARIABLE STACK1COUNTER
0       VARIABLE COLCHONSIZE
CREATE STACK1 200 ALLOT


: H.
 BASE DUP C@ SWAP 16
 OVER C! ROT U. C!
;
 
: PF_SIZE
 DUP 7 - @ ?DUP
 0=
 IF
  HERE OVER -
 ELSE
  7 -
 THEN
 SWAP DROP
;
 
: POLYDUP
 ( n1,n2 - n1...n1 n2 times)
 1- DUP 1 <
 IF
  DROP EXIT
 THEN
 0
 DO
  DUP
 LOOP
;
 
: H2.
 DUP 16 U<
 IF
  ASCII 0 EMIT
 THEN
 H.
;
 
: CLKEY
 BEGIN
  INKEY 0=
 UNTIL
;
 
: +!
 DUP @ ROT + SWAP
 !
;
 
: PUSHFLOW
 DUP PF_SIZE 2- SWAP @
 =
 IF
  ." PUSH Overflow"
  ABORT
 THEN
;
 
: ULOOP+2
 R> R> 2+ >R >R
 I' J U< 0= DUP
 IF
  R> R> R> DROP DROP
  >R
 THEN
;
 
: 2DROP
 DROP DROP
;
 
: UDO
 R> ROT >R SWAP >R
 >R
;
 
: OFN?
 ( adr,CFA - {n},f)
 DUP 5014 = SWAP 4985
 = OR
 IF
  DUP 2+ @ 2+ 1
 ELSE
  0
 THEN
;
 
: OF4?
 ( CFA - {4},f)
 4196 =
 IF
  4 1
 ELSE
  0
 THEN
;
 
: OF2?
 ( CFA - {2},f)
 8 POLYDUP 4113 = 8
 ROLL 4739 = 8 ROLL
 4721 = 8 ROLL 4749
 = 8 ROLL 4744 =
 8 ROLL 4726 = 8
 ROLL 4914 = 8 ROLL
 4924 = OR OR OR
 OR OR OR OR
 IF
  2 1
 ELSE
  0
 THEN
;
 
: OF1?
 ( CFA - {1},f)
 4171 =
 IF
  1 1
 ELSE
  0
 THEN
;
 
: 2DROP
 DROP DROP
;
 
: W_SIZE
 DUP 5 - @ ?DUP
 0=
 IF
  HERE OVER - 5 +
 THEN
 SWAP 1- C@ 63 AND
 +
;
 
: LASTWORD
 ( - CFA)
 CURRENT @ @ 1+
;
 
: ERROR
 15421 C! ABORT
;
 
: ULOOP+2
 R> R> 2+ >R >R
 I' J U< 0= DUP
 IF
  R> R> R> DROP DROP
  >R
 THEN
;
 
: ULEAVE
 R> R> DROP R> DUP
 >R >R >R
;
 
: UDO
 R> ROT >R SWAP >R
 >R
;
 
: PF_SIZE
 DUP 7 - @ ?DUP
 0=
 IF
  HERE OVER -
 ELSE
  7 -
 THEN
 SWAP DROP
;
 
: VCOUNT
 ( CFA - n)
 1- 0 SWAP
 BEGIN
  SWAP 1+ SWAP 2- @
  DUP 15434 U<
 UNTIL
 DROP
;
 
: SHOWNAME
 ( CFA - )
 DUP 1- C@ 63 AND
 DUP ROT 5 - SWAP
 - SWAP 0
 DO
  DUP I + C@ 127
  AND EMIT
 LOOP
 SPACE DROP
;
 
: H4.
 DUP 4096 U<
 IF
  ASCII 0 EMIT DUP 256 U<
  IF
   ASCII 0 EMIT
  THEN
 THEN
 H2.
;
 
: RKEY
 CLKEY
 BEGIN
  INKEY ?DUP
 UNTIL
 CLKEY
;
 
: ENDWORD
 ( adr1, CFA,f - adr2,f)
 IF
  1206 =
  IF
   1
  ELSE
   5 + 0
  THEN
 ELSE
  DROP 0
 THEN
;
 
: ISFIN?
 DUP 1206 = SWAP DUP
 4328 = SWAP 4416 =
 OR OR
;
 
: FFSTEP
 ( adr - n)
 2+ @ 2+
;
 
: GETSTEP
 ( CFA - n)
 3 - C@
;
 
: ISCOMPILING?
 ( CFA - f)
 @ 4418 =
;
 
: PUSH
 ( n,adr - )
 DUP PUSHFLOW 2 OVER +!
 DUP @ + !
;
 
: NOTINSTACK?
 ( CFA,adr - f)
 DUP @ 0=
 IF
  2DROP 1 EXIT
 THEN
 DUP @ 2+ OVER +
 SWAP 2+ UDO
 BEGIN
  I @ OVER =
  IF
   R> R> 2DROP DROP 0
   EXIT
  THEN
  ULOOP+2
 UNTIL
 DROP 1
;
 
: COMP_PARENT
 ( CFA1 - CFA2)
 2- DUP @ + 1+
 BEGIN
  DUP C@ 128 >
  IF
   1
  ELSE
   1+ 0
  THEN
 UNTIL
 6 +
;
 
: FORTHSTEP
 ( CFA - n)
 DUP OF1?
 IF
  SWAP DROP
 ELSE
  DUP OF2?
  IF
   SWAP DROP
  ELSE
   DUP OF4?
   IF
    SWAP DROP
   ELSE
    OFN?
    IF
    ELSE
     0
    THEN
   THEN
  THEN
 THEN
;
 
: ISFORTH?
 ( CFA - f)
 FINDLIMIT U<
;
 
: COMPILER?
 ( CFA - f)
 COMPILING =
;
 
: DEFINER?
 ( CFA - f)
 DEFINING =
;
 
: SHOWNAME
 ( CFA - )
 DUP 1- C@ 63 AND
 DUP ROT 5 - SWAP
 - SWAP 0
 DO
  DUP I + C@ 127
  AND EMIT
 LOOP
 SPACE DROP
;
 
: +!
 DUP @ ROT + SWAP
 !
;
 
: DEPTH
 15419 @ HERE 12 +
 - 2 /
;
 
: RED_SIZE
 LASTWORD W_SIZE NEXTRED @ W_SIZE
 OVER OVER U<
 IF
  2DROP 0
 ELSE
  -
 THEN
;
 
: CFADEL
 ( n,adr - )
 OVER OVER @ SWAP U<
 IF
  21 ERROR
 THEN
 + 0 SWAP !
;
 
: STACKSEARCH
 ( CFA,adr-n)
 DUP @ 0=
 IF
  2DROP 0
 THEN
 DUP >R 0 ROT ROT
 DUP @ OVER + 2+
 SWAP 2+ UDO
 BEGIN
  I @ OVER =
  IF
   DROP 1+ I ULEAVE
  THEN
  ULOOP+2
 UNTIL
 SWAP 0=
 IF
  R> 2DROP 0
 ELSE
  R> -
 THEN
;
 
: NEXTUP
 5 - DUP @ +
 BEGIN
  DUP C@ 127 >
  IF
   6 + 1
  ELSE
   1+ 0
  THEN
 UNTIL
;
 
: STACKMOVE
 CURRENT @ @ 3 +
 DUP PF_SIZE + >R 15419
 @ HERE - 12 =
 IF
  R> DUP 15415 ! 12
  + 15419 ! EXIT
 THEN
 R> DUP 12 + 15419
 @ 4 - HERE 12
 + UDO
 BEGIN
  I @ OVER ! 2+
  ULOOP+2
 UNTIL
 SWAP 15415 ! 15419 !
;
 
: EXTSIZE
 STACK1 @ 2 /
;
 
: DICSIZE
 ( - n)
 LASTWORD VCOUNT
;
 
: SHOWSTACK
 0 SWAP DUP @ CR
 ." count: "
 2 / U. DUP @
 2+ 2
 DO
  CR SWAP 1+ DUP 20
  =
  IF
   DROP 0 RKEY DROP
  THEN
  SWAP I OVER + DUP
  H4. @ DUP H4. DUP
  U. ?DUP 0= 0=
  IF
   SHOWNAME
  THEN
  2
 +LOOP
 DROP DROP
;
 
: DEF_PARENT
 ( CFA1 - CFA2)
 @ 2- DUP @ +
 1+
 BEGIN
  DUP C@ 128 >
  IF
   1
  ELSE
   1+ 0
  THEN
 UNTIL
 6 +
;
 
: IS_DEFINED?
 ( CFA - f)
 @ 4 - @ 4328
 =
;
 
: ANALYZER2
 ( adr - )
 DUP @ DUP DEFINER? SWAP
 COMPILER? OR
 IF
  2+
 THEN
 2+
 BEGIN
  DUP @ ISFORTH?
  IF
   DUP @ FORTHSTEP
  ELSE
   DUP @ DUP ISCOMPILING?
   IF
    COMP_PARENT
   THEN
   DUP ACTUALWORD @ = 0=
   IF
    DUP STACK1 NOTINSTACK?
    IF
     DUP STACK1 PUSH
    THEN
   THEN
   DROP DUP @ ISCOMPILING?
   IF
    DUP @ GETSTEP DUP 255
    =
    IF
     DROP DUP FFSTEP
    THEN
   ELSE
    0
   THEN
  THEN
  OVER 2+ + SWAP @
  DUP ISFIN? ENDWORD
 UNTIL
 DROP
;
 
: LISTABLE?
 ( adr - f)
 DUP ISFORTH?
 IF
  DROP 0 EXIT
 THEN
 @ DUP COLON =
 IF
  DROP 1 EXIT
 THEN
 DUP DEFINING =
 IF
  DROP 1 EXIT
 THEN
 COMPILING =
 IF
  1
 ELSE
  0
 THEN
;
 
: ACTUALONE
 5 1 AT 24 SPACES
 5 5 AT SHOWNAME
;
 
: STACK1COPY
 ( - CFA)
 2 STACK1COUNTER +! STACK1COUNTER @
 STACK1 + @
;
 
: REDEF
 ( CFA - )
 DUP 4076 SWAP ! DUP
 1- DUP C@ 63 AND
 - 4 - DUP C@
 128 AND 128 * 127
 + SWAP C! CLS 20
 1 AT SHOWNAME 9856 15396
 ! REDEFINE
;
 
: DESPLA
 ( n,adr - )
 DUP @ 0=
 IF
  DROP DROP EXIT
 THEN
 DUP @ OVER + 2+
 SWAP 2+ UDO
 BEGIN
  I DUP @ 0=
  IF
   DROP
  ELSE
   OVER SWAP +!
  THEN
  ULOOP+2
 UNTIL
 DROP
;
 
: DELTA
 ( CFA_r- n)
 LASTWORD W_SIZE SWAP W_SIZE -
;
 
: CFAUR
 ( CFAr - CFAur)
 CURRENT @ @ C@ 63
 AND OVER 1- C@ 63
 AND - +
;
 
: RED_OVERFLOW_TEST
 ( - )
 COLCHONSIZE @ RED_SIZE DEPTH DUP
 + + OVER OVER U<
 IF
  CLS 10 0 AT ." WARNING: COLCHON size "
  SWAP U. CR ." Need to be "
  U. ABORT
 ELSE
  2DROP
 THEN
;
 
: NEXT>REDEF
 NEXTRED @
 BEGIN
  DUP HERE SWAP U<
  IF
   DROP 0 NEXTRED ! 1
  ELSE
   NEXTUP DUP STACK1 STACKSEARCH ?DUP
   0=
   IF
    NEXTRED ! 1
   ELSE
    STACK1 CFADEL 0
   THEN
  THEN
 UNTIL
;
 
: OLVIDA
 ( CFA - )
 3 - @ CURRENT @
 ! STACKMOVE
;
 
: DICYA?
 ( - f)
 DICSIZE EXTSIZE =
;
 
: PRE_DELETE
 ( - )
 15434
 BEGIN
  NEXTUP DUP STACK1 STACKSEARCH 0=
  IF
   DUP 4076 SWAP !
  THEN
  LASTWORD OVER =
 UNTIL
 DROP
;
 
: EXTRACT2
 ( CFA - )
 CLS DUP ISFORTH?
 IF
  ." Not a user word"
  ABORT
 THEN
 0 STACK1COUNTER ! 0 STACK1
 ! STACK1 PUSH
 BEGIN
  STACK1COUNTER @ STACK1 @ <
 WHILE
  STACK1COPY DUP ACTUALONE DUP LISTABLE?
  IF
   DUP ACTUALWORD ! ANALYZER2
  ELSE
   DUP IS_DEFINED?
   IF
    DEF_PARENT DUP STACK1 NOTINSTACK?
    IF
     STACK1 PUSH
    THEN
   ELSE
    DROP
   THEN
  THEN
 REPEAT
 CR STACK1 SHOWSTACK CR ." Press a Key to continue"
 RKEY DROP
;
 
: DICEXTRACT
 ( CFA - )
 COLCHON 2- DUP W_SIZE COLCHONSIZE
 ! OLVIDA EXTRACT2 STACK1 @
 0=
 IF
  EXIT
 THEN
 DICYA?
 IF
  EXIT
 THEN
 CLS ." predeleting... "
 PRE_DELETE 15434 NEXTRED !
 BEGIN
  DICYA? 0=
 WHILE
  LASTWORD DUP CLS 10 10
  AT SHOWNAME STACK1 STACKSEARCH ?DUP
  0=
  IF
   LASTWORD OLVIDA
  ELSE
   NEXT>REDEF RED_OVERFLOW_TEST STACK1 CFADEL NEXTRED
   @ CFAUR NEXTRED @ DELTA
   STACK1 DESPLA NEXTRED @ SWAP
   NEXTRED ! REDEF
  THEN
 REPEAT
;
 


Actualizado (9-2-2022) Corrección Bugs

NOTA: (12-06-2022): Un BUG aparente, pues no es tal sino una limitación del programa, es cuando el diccionario extraído precisa que las palabras estén en un orden concreto. Obviamente DICEXTRACT no es capaz de detectar esto y el resultado puede estar en cualquier orden. Un ejemplo lo es el propio DICEXTRACT que, entre otras, exige que la palabra COLCHON sea la primera del programa para funcionar (if loaded on a empty Dict. it has to be the first one after FORTH).

In this case it is your responsability to reorder it manually. Normally is not hard to do, but in some cases can be more difficult.

However, it is not a common situation.
Adjuntos
dicextract.TZX
(14.45 KiB) Descargado 10 veces

Elurdio
Mensajes: 510
Registrado: 07 Dic 2021 21:33
Ubicación: Barcelona
Agradecido : 115 veces
Agradecimiento recibido: 95 veces

Re: Jupiter Ace Forth (Extractor de Diccionario)

Mensajepor Elurdio » 06 Feb 2022 16:16

Funcionamiento Interno:

El programa utiliza una versión reducida del extractor de palabras, pues genera una lista NO ordenada. Tiene varias ventajas respecto a la completa:

  1. Solo usa una pila interna y más pequeña que las dos de la versión completa
  2. Es mucho más rápido
  3. Puede extraer todo tipo de palabras recursivas

Utiliza la técnica de Palabras Fantasma que comenté en el hilo de "Utilidades", lo que le permite mover palabras del diccionario que están por debajo del programa y, además, no dejar huella en el resultado.

Utiliza la palabra OLVIDA en vez de FORGET. Es una versión de FORGET hecha en FORTH que evita el problema con el FORGET, a saber, que detiene el programa en curso cuando se ejecuta. Lo que hace es decirle al JA que la última palabra es la anterior a la que se borra y luego reajusta el valor de HERE a la nueva situación además de mover la pila a su nueva posición. Espera en la pila el CFA de la palabra a borrar.

Utiliza la palabra REDEF en vez de REDEFINE. Es una versión de REDEFINE realizada en FORTH que toma de la pila el CFA de la palabra a redefinir y permite redefinir palabras tipo DEFINER y COMPILER con otras que no lo son. Realmente es un truco para que REDEFINE (que es la palabra que acaba realizando la operación) pueda funcionar así. Es debido a la manera en que funciona esta palabra, que NO puede haber en el diccionario ninguna palabra cuyo nombre empiece con el carácter de copyright.

El proceso es:

  1. Con el extractor de palabras se genera un listado con todas la palabras que compondrán el diccionario
  2. Inicia un bucle de reducción hasta dejar solo las palabras del listado anterior

El bucle es:

- Mira la última palabra del diccionario.
- Si no está en la lista de palabras, la borra
- Si está en la lista de palabras, redefine la primera palabra (empezando por el principio del diccionario, o sea, por la primera palabra que hay después de la palabra FORTH) que NO esté en la lista
- El proceso se repite hasta que queden tantas palabras como hay en la lista.

Elurdio
Mensajes: 510
Registrado: 07 Dic 2021 21:33
Ubicación: Barcelona
Agradecido : 115 veces
Agradecimiento recibido: 95 veces

Re: Jupiter Ace Forth (Extractor de Diccionario)

Mensajepor Elurdio » 09 Feb 2022 12:27

BUGS encontrados (no corregidos aún)

Corregidos los últimos encontrados. Pendiente de más...

Elurdio
Mensajes: 510
Registrado: 07 Dic 2021 21:33
Ubicación: Barcelona
Agradecido : 115 veces
Agradecimiento recibido: 95 veces

Re: Jupiter Ace Forth (Extractor de Diccionario)

Mensajepor Elurdio » 12 Feb 2022 16:46

Bug Reproducible Localizada la causa

El hecho que una determinada combinación de FORGET y REDEFINE en un diccionario concreto hiciera que se colgara el JA me tenía intrigado, hoy me he pasado la mañana analizándolo a fondo:

Situación:

El diccionario sería algo así antes de empezar:

>CR
·
·
ERROR
STATE
W_SIZE
S->D
·
·
·
·
SP!
FORTH

Un diccionario con unas 80 palabras. Borro a mano con FORGET la palabra STATE (le precedían unas 30 palabras). La última ahora es W_SIZE. A continuación hago:

REDEFINE SP!

donde SP! es la primera palabra de usuario del diccionario (justo después de FORTH). Todo bien, se imprime OK. Pero en cuanto hago VLIST o cualquier cosa, se cuelga.

Después del borrado/redefinido quedaría: (pero no puedo verlo, pues a la que hago algo, se cuelga el JA)

S->D
·
·
·
·
W_SIZE
FORTH

Si antes de hacer el REDEFINE convierto todas las palabras no implicadas en éste (todas excepto W_SIZE y SP!) a tipo CREATE el proceso va bien y no se produce error al ejecutar lo que sea.

El convertir una palabra a tipo CREATE hace que REDEFINE no la analice para cambiar los CFA de las palabras que la componen si corresponden a palabras que se han movido en el diccionario. Tal como he hecho la REDEFINICION (SP! está al principio del diccionario y es de tamaño distinto a W_SIZE) se habrán movido TODAS.

Esto parece implicar que el error se produce en este proceso del REDEFINE (el análisis del PF de la palabras movidas). Pues he forzado que no haya análisis de palabras al hacer la conversión a CREATE (solo se analiza la que ocupa el lugar de SP!, o sea, W_SIZE y ésta no contiene ninguna palabra de usuario en su definición)

He hecho un programa que me convierte a tipo CREATE todas las palabras entre dos que le doy y usando el Regula Falsi (o bisección), he localizado las palabras que generan el error. Son dos y están un poco más abajo de S->D. Las he analizado y están bien, sin fallos, etc.

Pero resulta que ambas palabras tienen en su definición a ERROR y a STATE (ambas quedan borradas tras el FORGET STATE). El hecho que una palabra haga referencia a una borrada, en general no impide que REDEFINE la analice sin problemas (lo he comprobado y es lo que se espera que suceda). Haciendo pruebas, he visto que el problema viene por ERROR. Y la conclusión a la que he llegado es:

REDEFINEpuede fallar si una palabra del diccionario se mueve durante la redefinición y tiene una referencia a una palabra borrada recientmente y que ocupaba la zona de memoria que ahora ocupa la pila (o por ahí) después del borrado. De hecho, he conseguido producir este error con otro proceso FORGET/REDEFINE afectando a otras palabras pero que cumplen este requisito. Algo hace REDEFINE durante el análisis que, en esta circunstancia lleva a este error. Lo que no me imagino qué, pues, por más que lo pienso, no veo el por qué. Pero lo que está claro es que suprimiendo los análisis de las palabras que cumplen ese requisito (mediante su conversión a tipo CREATE) el problema desaparece.

Me quedo tranquilo al menos respecto al Extractor de Diccionario, pues NO se puede dar el caso que una palabra que va a formar parte del diccionario haga referencia a una que se ha borrado, puesto que entonces no se borraría (formaría parte del nuevo diccionario). Y como ya dije, las que no van a formar parte del nuevo diccionario, ya las ha convertido el programa a tipo CREATE antes de empezar el proceso.

Elurdio
Mensajes: 510
Registrado: 07 Dic 2021 21:33
Ubicación: Barcelona
Agradecido : 115 veces
Agradecimiento recibido: 95 veces

Re: Jupiter Ace Forth (Extractor de Diccionario)

Mensajepor Elurdio » 12 Feb 2022 21:59

Esto tiene toda la pinta de ser un bug del REDEFINE

Un caso forzado por mí es el siguiente:

En lugar de usar mis diccionarios, lo hago con el diccionario del Assembler/Disasembler de Boldfield (que se puede bajar del JA archive) y lo cargo en el JA vacío/limpio.


CODE
ENDC
·
·
·
TAB
INSTR
COUNT
·
·
·
\\
CH
FORTH

la palabra COUNT es:

: COUNT
DUP 1+ SWAP C@
;

la modifico cambiando el SWAP por TAB y redefiniéndola. Este cambio la deja del mismo tamaño y no se mueve nada en el diccionario. De todos modos, por si hubiera dudas que esto podría ser causa del problema (y no debería pues es una operación super normal y típica de REDEFINE: modificar una palabra y redefinir la vieja)
también he hecho lo mismo pero directamente, o sea, cambiar el SWAP por TAB cambiando el CFA en memoria manualmente así:

FIND TAB FIND COUNT 6 + !

en ambos casos, listando COUNT vemos que el SWAP ha sido cambiado por TAB

Ahora hago:

FORGET TAB
REDEFINE CH

y aquí, justo después de hacerse el redefine, sale el OK pero la pantalla ya se estropea (algunas letras se han modificado, por lo que se ha afectado la zona con la definición de los caracteres) y aunque no se cuelga, ya no reconoce los comandos que escribo... ni la multiplicación, ni la suma ni el VLIST, etc.

Otras veces se cuelga directamente, o se borra el diccionario, etc,

Si en vez de cambiar el SWAP de COUNT por TAB, lo cambio por ENDC que está mucho más lejos, al hacer lo mismo:

FIND ENDC FIND COUNT 6 + !
FORGET TAB
REDEFINE CH

Todo va como la seda...

Elurdio
Mensajes: 510
Registrado: 07 Dic 2021 21:33
Ubicación: Barcelona
Agradecido : 115 veces
Agradecimiento recibido: 95 veces

Re: Jupiter Ace Forth (Extractor de Diccionario)

Mensajepor Elurdio » 12 Feb 2022 22:20

Ahora lo acabo de probar con el ZEsarUX y parece que no da el fallo.... a ver si es un fallo del emulador EigthyOne!!!

En cambio el ZEsarUX sí me reproduce el fallo original con el diccionario mío...

Elurdio
Mensajes: 510
Registrado: 07 Dic 2021 21:33
Ubicación: Barcelona
Agradecido : 115 veces
Agradecimiento recibido: 95 veces

Re: Jupiter Ace Forth (Extractor de Diccionario)

Mensajepor Elurdio » 28 Feb 2022 16:57

Un error que cometo a menudo cuando utilizo cargadorf y necesito crear una palabra auxiliar para que me extraiga dos o más palabras a la vez es que defino la palabra auxiliar DESPUES de haber cargado cargadorf yse ha de hacer ANTES de cargar cargadorf.

La carga de cargadorf es lo último que hay que hacer. Como cargadorf se autoborra justo al empezar a funcionar, la palabra auxiliar se borra también. El programa funciona igualmente pero mete una palabra que no corresponde en la extracción en el lugar de la auxiliar.

No gano para sustos cuando veo que cargadorf ha ido mal y me digo: otro p... bug!!, hasta que me doy cuenta de mi propio fallo -banghead

Elurdio
Mensajes: 510
Registrado: 07 Dic 2021 21:33
Ubicación: Barcelona
Agradecido : 115 veces
Agradecimiento recibido: 95 veces

Re: Jupiter Ace Forth (Extractor de Diccionario)

Mensajepor Elurdio » 05 May 2022 12:48

Prueba/Demo de Dicextract(I)

Voy a hacer una serie de pruebas/demostraciones del programa.

Esta prueba (I) consiste en crear una palabra que utilice palabras de distinto tipo para comprobar que Dicextract se maneja bien con varios tipos de palabras.

Comienzo en mi diccionario habitual (un compendio de palabras que utilizo a menudo) al que he añadido el diccionario que contiene las palabras del bucle ULOOP/NEXT.

Defino la palabra CONLOOP que no hace nada interesante salvo usar diferentes tipos de palabras, algunas de ellas son del diccionario habitual y otras las he definido para la ocasión.

Ahora cargo un pequeño diccionario encima (3 palabras). El diccionario total queda así:
(solo se muestran las palabras de usuario)

screen1.jpg
screen1.jpg (141.19 KiB) Visto 447 veces

Cargo encima el diccionario DICEXTRACT y ejecuto:

FIND CONLOOP DICEXTRACT

A fin de "extraer" el diccionario de CONLOOP y todas las palabras que necesita para funcionar.

Primero se ejecuta el extractor reducido de palabras que, tras terminar, presenta este resultado:

screen2.jpg
screen2.jpg (94.36 KiB) Visto 447 veces


Vemos que el diccionario que se va a extraer constará de 15 palabras (CONLOOP y 14 más). La definición de CONLOOP es:

screen3.jpg
screen3.jpg (29.63 KiB) Visto 447 veces

Si nos fijamos, vemos que CONLOOP se compone de 6 palabras de usuario:

CONLOOP, CINCO, NEXT, DIEZ, ULOOP y ABORT"

Las 9 palabras restantes son palabras usadas por éstas o por algunas de las que éstas usan, etc.

Si pulsamos una tecla comienza el proceso de reducción que nos dejará un diccionario compuesto solamente por las 15 palabras de la lista:

screen4.jpg
screen4.jpg (34.84 KiB) Visto 447 veces

En la imagen se aprecia que solo hay las 15 palabras de la lista. Luego ya vienen las primitivas de FORTH (solo muestro una línea de las mismas). Se ve que el orden de las palabras en el diccionario final no coincide con el que ocupaban en el diccionario original. Esto es debido a que la reducción implica no solo FORGETs sino también REDEFINESs que, como sabemos, alteran la posición de las palabras en el diccionario.

Aquí DICEXTRACT ya ha terminado.

Esto es un listado que nos muestra de qué tipo es cada palabra:

screen5.jpg
screen5.jpg (53.89 KiB) Visto 447 veces

Ahí vemos que la mayoría de las palabras son tipo ":" o sea, tipo COLON
Tenemos la palabra 2CONSTANT que es tipo DEFINER con la que se han definido las dos palabras CINCO y DIEZ
También tenemos tres palabras tipo COMPILER (e inmediatas, indicado con la I en video inverso)
También las hay tipo Código Máquina (de Boldfield o tipo primitivas)

Mirando las definiciones de algunas palabras veo que:

La palabra ERROR la utilizan ULOOP, NEXT y ROLLD
Las palabras ENCRUST y SEARCH>10 las utiliza NEXT
La palabra ROLLD la utiliza ENCRUST
La palabra DEPTH la utiliza ROLLD
etc.

Así, en este ejemplo, en el caso de DEPTH se ha llegado hasta profundidad (4) durante el análisis de CONLOOP:

(0)CONLOOP --> (1)NEXT --> (2)ENCRUST --> (3)ROLLD --> (4)DEPTH

La comprobación definitiva es ejecutar CONLOOP y ver que se comporta como era de esperar.

Si tuviéramos que hacer este proceso a mano, sería bastante pesado:

Primero tendríamos que listar CONLOOP y ver qué palabras usa. Luego listar cada una de las palabras que usa y ver las palabras que usan y así sucesivamente. Así confeccionamos la lista de las 15 palabras (eliminando las repetidas)

Luego tendríamos que ir haciendo FORGETs y REDEFINES a mano hasta dejar solo las palabras de la lista anterior.

Aquí eran 15 palabras, pero, por ejemplo, la extracción del programa DICEXTRACT del diccionario en el que estaba cuando se desarrolló, generó una lista de 76 palabras. Hacer a mano los dos pasos (obtención de la lista y eliminación de palabras que no están en la misma) sería un rollo impresionante.

Prueba/Demo de Dicextract(II)

Ahora he rizado el rizo. He modificado CONLOOP para que tome los límites de la pila en vez de tener el 20 0 fijos y alguna tontería más. Luego he creado una palabra defindora de usuario que en su parte compilante incluye un bucle +ULOOP (que es una compilante de usuario) y en su parte de ejecución contiene CONLOOP. Esta definidora espera los límites que luego usará CONLOOP en la pila. He generado dos palabras con ella y definido la palabra RIZADO con estas dos.

Tras aplicar DICEXTRACT a RIZADO, ha ido como se esperaba. Todo bien. Ha generado un diccionario de 21 palabras y RIZADO funciona perfectamente.

Prueba/Demo de Dicextract(III)

Ahora he creado la palabra DINBEL que en su definición incluye CONLOOP y a sí misma (DINBEL) y luego he modificado CONLOOP para que incluya a DINBEL en su definición. Así tengo dos RECURRENCIAs, una normal y otra cruzada. He aplicado DICEXTRACT a RIZADO y todo funcionó como era de esperar. El nuevo diccionario incluye una palabra más (DINBEL).

Elurdio
Mensajes: 510
Registrado: 07 Dic 2021 21:33
Ubicación: Barcelona
Agradecido : 115 veces
Agradecimiento recibido: 95 veces

Re: Jupiter Ace Forth (Extractor de Diccionario)

Mensajepor Elurdio » 07 May 2022 12:09

He detectado palabras repetidas en DICEXTRACT:

+!
2DROP
PF_SIZE
SHOWNAME
UDO
ULOOP+2


Además de eliminar las repeticiones he aprovechado para:

  • Substituir SHOWNAME por NTYPE (más compacta y rápida)
  • Substituir ULEAVE con la primitiva LEAVE que hace exactamente lo mismo

Código: Seleccionar todo

DECIMAL

CREATE COLCHON 10000 ALLOT

15435   CONSTANT FINDLIMIT
4360    CONSTANT COMPILING
4229    CONSTANT DEFINING
3779    CONSTANT COLON
-32168  VARIABLE NEXTRED
18749   VARIABLE ACTUALWORD
16      VARIABLE STACK1COUNTER
0       VARIABLE COLCHONSIZE
CREATE STACK1 200 ALLOT

: DEPTH
 15419 @ HERE 12 +
 - 2 /
;

: H.
 BASE DUP C@ SWAP 16
 OVER C! ROT U. C!
;
 
: PF_SIZE
 DUP 7 - @ ?DUP
 0=
 IF
  HERE OVER -
 ELSE
  7 -
 THEN
 SWAP DROP
;
 
: POLYDUP
 ( n1,n2 - n1...n1 n2 times)
 1- DUP 1 <
 IF
  DROP EXIT
 THEN
 0
 DO
  DUP
 LOOP
;
 
: H2.
 DUP 16 U<
 IF
  ASCII 0 EMIT
 THEN
 H.
;
 
: CLKEY
 BEGIN
  INKEY 0=
 UNTIL
;
 
: +!
 DUP @ ROT + SWAP
 !
;
 
: PUSHFLOW
 DUP PF_SIZE 2- SWAP @
 =
 IF
  ." PUSH Overflow"
  ABORT
 THEN
;
 
: ULOOP+2
 R> R> 2+ >R >R
 I' J U< 0= DUP
 IF
  R> R> R> DROP DROP
  >R
 THEN
;
 
: 2DROP
 DROP DROP
;
 
: UDO
 R> ROT >R SWAP >R
 >R
;
 
: OFN?
 ( adr,CFA - {n},f)
 DUP 5014 = SWAP 4985
 = OR
 IF
  DUP 2+ @ 2+ 1
 ELSE
  0
 THEN
;
 
: OF4?
 ( CFA - {4},f)
 4196 =
 IF
  4 1
 ELSE
  0
 THEN
;
 
: OF2?
 ( CFA - {2},f)
 8 POLYDUP 4113 = 8
 ROLL 4739 = 8 ROLL
 4721 = 8 ROLL 4749
 = 8 ROLL 4744 =
 8 ROLL 4726 = 8
 ROLL 4914 = 8 ROLL
 4924 = OR OR OR
 OR OR OR OR
 IF
  2 1
 ELSE
  0
 THEN
;
 
: OF1?
 ( CFA - {1},f)
 4171 =
 IF
  1 1
 ELSE
  0
 THEN
;

: W_SIZE
 DUP 5 - @ ?DUP
 0=
 IF
  HERE OVER - 5 +
 THEN
 SWAP 1- C@ 63 AND
 +
;
 
: LASTWORD
 ( - CFA)
 CURRENT @ @ 1+
;
 
: ERROR
 15421 C! ABORT
;
 
: VCOUNT
 ( CFA - n)
 1- 0 SWAP
 BEGIN
  SWAP 1+ SWAP 2- @
  DUP 15434 U<
 UNTIL
 DROP
;
 
: NTYPE
 DUP DUP 1- C@ 63
 AND DUP ROT 5 -
 SWAP - SWAP 1- TYPE
 6 - C@ 127 AND
 EMIT SPACE
;
 
: H4.
 DUP 4096 U<
 IF
  ASCII 0 EMIT DUP 256 U<
  IF
   ASCII 0 EMIT
  THEN
 THEN
 H2.
;
 
: RKEY
 CLKEY
 BEGIN
  INKEY ?DUP
 UNTIL
 CLKEY
;
 
: ENDWORD
 ( adr1, CFA,f - adr2,f)
 IF
  1206 =
  IF
   1
  ELSE
   5 + 0
  THEN
 ELSE
  DROP 0
 THEN
;
 
: ISFIN?
 DUP 1206 = SWAP DUP
 4328 = SWAP 4416 =
 OR OR
;
 
: FFSTEP
 ( adr - n)
 2+ @ 2+
;
 
: GETSTEP
 ( CFA - n)
 3 - C@
;
 
: ISCOMPILING?
 ( CFA - f)
 @ 4418 =
;
 
: PUSH
 ( n,adr - )
 DUP PUSHFLOW 2 OVER +!
 DUP @ + !
;
 
: NOTINSTACK?
 ( CFA,adr - f)
 DUP @ 0=
 IF
  2DROP 1 EXIT
 THEN
 DUP @ 2+ OVER +
 SWAP 2+ UDO
 BEGIN
  I @ OVER =
  IF
   R> R> 2DROP DROP 0
   EXIT
  THEN
  ULOOP+2
 UNTIL
 DROP 1
;
 
: COMP_PARENT
 ( CFA1 - CFA2)
 2- DUP @ + 1+
 BEGIN
  DUP C@ 128 >
  IF
   1
  ELSE
   1+ 0
  THEN
 UNTIL
 6 +
;
 
: FORTHSTEP
 ( CFA - n)
 DUP OF1?
 IF
  SWAP DROP
 ELSE
  DUP OF2?
  IF
   SWAP DROP
  ELSE
   DUP OF4?
   IF
    SWAP DROP
   ELSE
    OFN?
    IF
    ELSE
     0
    THEN
   THEN
  THEN
 THEN
;
 
: ISFORTH?
 ( CFA - f)
 FINDLIMIT U<
;
 
: COMPILER?
 ( CFA - f)
 COMPILING =
;
 
: DEFINER?
 ( CFA - f)
 DEFINING =
;
 
: RED_SIZE
 LASTWORD W_SIZE NEXTRED @ W_SIZE
 OVER OVER U<
 IF
  2DROP 0
 ELSE
  -
 THEN
;
 
: CFADEL
 ( n,adr - )
 OVER OVER @ SWAP U<
 IF
  21 ERROR
 THEN
 + 0 SWAP !
;
 
: STACKSEARCH
 ( CFA,adr-n)
 DUP @ 0=
 IF
  2DROP 0
 THEN
 DUP >R 0 ROT ROT
 DUP @ OVER + 2+
 SWAP 2+ UDO
 BEGIN
  I @ OVER =
  IF
   DROP 1+ I LEAVE
  THEN
  ULOOP+2
 UNTIL
 SWAP 0=
 IF
  R> 2DROP 0
 ELSE
  R> -
 THEN
;
 
: NEXTUP
 ( CFA1 - CFA2)
 5 - DUP @ +
 BEGIN
  DUP C@ 127 >
  IF
   6 + 1
  ELSE
   1+ 0
  THEN
 UNTIL
;
 
: STACKMOVE
 CURRENT @ @ 3 +
 DUP PF_SIZE + >R 15419
 @ HERE - 12 =
 IF
  R> DUP 15415 ! 12
  + 15419 ! EXIT
 THEN
 R> DUP 12 + 15419
 @ 4 - HERE 12
 + UDO
 BEGIN
  I @ OVER ! 2+
  ULOOP+2
 UNTIL
 SWAP 15415 ! 15419 !
;
 
: EXTSIZE
 STACK1 @ 2 /
;
 
: DICSIZE
 ( - n)
 LASTWORD VCOUNT
;
 
: SHOWSTACK
 0 SWAP DUP @ CR
 ." count: "
 2 / U. DUP @
 2+ 2
 DO
  CR SWAP 1+ DUP 20
  =
  IF
   DROP 0 RKEY DROP
  THEN
  SWAP I OVER + DUP
  H4. @ DUP H4. DUP
  U. ?DUP 0= 0=
  IF
   NTYPE
  THEN
  2
 +LOOP
 DROP DROP
;
 
: DEF_PARENT
 ( CFA1 - CFA2)
 @ 2- DUP @ +
 1+
 BEGIN
  DUP C@ 128 >
  IF
   1
  ELSE
   1+ 0
  THEN
 UNTIL
 6 +
;
 
: IS_DEFINED?
 ( CFA - f)
 @ 4 - @ 4328
 =
;
 
: ANALYZER2
 ( adr - )
 DUP @ DUP DEFINER? SWAP
 COMPILER? OR
 IF
  2+
 THEN
 2+
 BEGIN
  DUP @ ISFORTH?
  IF
   DUP @ FORTHSTEP
  ELSE
   DUP @ DUP ISCOMPILING?
   IF
    COMP_PARENT
   THEN
   DUP ACTUALWORD @ = 0=
   IF
    DUP STACK1 NOTINSTACK?
    IF
     DUP STACK1 PUSH
    THEN
   THEN
   DROP DUP @ ISCOMPILING?
   IF
    DUP @ GETSTEP DUP 255
    =
    IF
     DROP DUP FFSTEP
    THEN
   ELSE
    0
   THEN
  THEN
  OVER 2+ + SWAP @
  DUP ISFIN? ENDWORD
 UNTIL
 DROP
;
 
: LISTABLE?
 ( adr - f)
 DUP ISFORTH?
 IF
  DROP 0 EXIT
 THEN
 @ DUP COLON =
 IF
  DROP 1 EXIT
 THEN
 DUP DEFINING =
 IF
  DROP 1 EXIT
 THEN
 COMPILING =
 IF
  1
 ELSE
  0
 THEN
;
 
: ACTUALONE
 5 1 AT 24 SPACES
 5 5 AT NTYPE
;
 
: STACK1COPY
 ( - CFA)
 2 STACK1COUNTER +! STACK1COUNTER @
 STACK1 + @
;
 
: REDEF
 ( CFA - )
 DUP 4076 SWAP ! DUP
 1- DUP C@ 63 AND
 - 4 - DUP C@
 128 AND 128 * 127
 + SWAP C! CLS 20
 1 AT NTYPE 9856 15396
 ! REDEFINE
;
 
: DESPLA
 ( n,adr - )
 DUP @ 0=
 IF
  DROP DROP EXIT
 THEN
 DUP @ OVER + 2+
 SWAP 2+ UDO
 BEGIN
  I DUP @ 0=
  IF
   DROP
  ELSE
   OVER SWAP +!
  THEN
  ULOOP+2
 UNTIL
 DROP
;
 
: DELTA
 ( CFA_r- n)
 LASTWORD W_SIZE SWAP W_SIZE -
;
 
: CFAUR
 ( CFAr - CFAur)
 CURRENT @ @ C@ 63
 AND OVER 1- C@ 63
 AND - +
;
 
: RED_OVERFLOW_TEST
 ( - )
 COLCHONSIZE @ RED_SIZE DEPTH DUP
 + + OVER OVER U<
 IF
  CLS 10 0 AT ." WARNING: COLCHON size "
  SWAP U. CR ." Need to be "
  U. ABORT
 ELSE
  2DROP
 THEN
;
 
: NEXT>REDEF
 NEXTRED @
 BEGIN
  DUP HERE SWAP U<
  IF
   DROP 0 NEXTRED ! 1
  ELSE
   NEXTUP DUP STACK1 STACKSEARCH ?DUP
   0=
   IF
    NEXTRED ! 1
   ELSE
    STACK1 CFADEL 0
   THEN
  THEN
 UNTIL
;
 
: OLVIDA
 ( CFA - )
 3 - @ CURRENT @
 ! STACKMOVE
;
 
: DICYA?
 ( - f)
 DICSIZE EXTSIZE =
;
 
: PRE_DELETE
 ( - )
 15434
 BEGIN
  NEXTUP DUP STACK1 STACKSEARCH 0=
  IF
   DUP 4076 SWAP !
  THEN
  LASTWORD OVER =
 UNTIL
 DROP
;
 
: EXTRACT2
 ( CFA - )
 CLS DUP ISFORTH?
 IF
  ." Not a user word"
  ABORT
 THEN
 0 STACK1COUNTER ! 0 STACK1
 ! STACK1 PUSH
 BEGIN
  STACK1COUNTER @ STACK1 @ <
 WHILE
  STACK1COPY DUP ACTUALONE DUP LISTABLE?
  IF
   DUP ACTUALWORD ! ANALYZER2
  ELSE
   DUP IS_DEFINED?
   IF
    DEF_PARENT DUP STACK1 NOTINSTACK?
    IF
     STACK1 PUSH
    THEN
   ELSE
    DROP
   THEN
  THEN
 REPEAT
 CR STACK1 SHOWSTACK CR ." Press a Key to continue"
 RKEY DROP
;
 
: DICEXTRACT
 ( CFA - )
 COLCHON 2- DUP W_SIZE COLCHONSIZE
 ! OLVIDA EXTRACT2 STACK1 @
 0=
 IF
  EXIT
 THEN
 DICYA?
 IF
  EXIT
 THEN
 CLS ." predeleting... "
 PRE_DELETE 15434 NEXTRED !
 BEGIN
  DICYA? 0=
 WHILE
  LASTWORD DUP CLS 10 10
  AT NTYPE STACK1 STACKSEARCH ?DUP
  0=
  IF
   LASTWORD OLVIDA
  ELSE
   NEXT>REDEF RED_OVERFLOW_TEST STACK1 CFADEL NEXTRED
   @ CFAUR NEXTRED @ DELTA
   STACK1 DESPLA NEXTRED @ SWAP
   NEXTRED ! REDEF
  THEN
 REPEAT
;


Versión del mismo fuente pero reordenado y extensamente comentando en "mi" inglés.

Código: Seleccionar todo


\ This Listing has been generated with EXTRACTSOU, hand modified later
\ and extensively commented.
\ WARNING:
\ A deep understanding of the word structure of Ace Forth is needed
\ to understand how DICEXTRACT works.

\ All the Words are refered by its CFA. In general, "the word is ..."
\ normally means "the word with this CFA is ..."

\ General Notation:
\ addr      -> 16 bits address
\ n         -> 16 bits integer (signed or not)
\ f         -> 16 bits flag number
\ PF/PFA    -> Parameter Field/Parameter Field Address
\ OF/OFA    -> Operand Field/Operand Field Address
\ CF/CFA    -> Code Field/Code Field Addressx
\ NF/NFA    -> Name Field/Name Field Address
\ (CFA)=CF  -> 16 bits number stored at CFA
\ (NFA)=NF  -> 8 bits number stored at NFA
\ In general, 16 bits addr enclosed in parenthesis means the content
\             stored at this addr. e.g. (CFA) = content stored at CFA = CF
\ "stack"   -> refers to the internal stack STACK1
\ Stack     -> refers to the Data Stack (where JA push numbers)

DECIMAL

CREATE COLCHON 10000 ALLOT      \ Word used as a buffer to avoid that JA, while running, overwrites any portion of
                                \ DICEXTRACT since DICEXTRACT works unlinked from the dictionary.

15435   CONSTANT FINDLIMIT      \ CFA of FORTH Word + 1
 4360   CONSTANT COMPILING      \ 4360 = $1108 = CFA Compiling Word (COMPILER)
 4229   CONSTANT DEFINING       \ 4229 = $1085 = CFA Defining Word  (DEFINER)
 3779   CONSTANT COLON          \ 3779 = $0EC3 = CFA Colon Word
    0   VARIABLE NEXTRED        \ Holds the CFA of the next word to be redefined. Initialized by DICEXTRACT.
    0   VARIABLE ACTUALWORD     \ CFA of the Word being analyzed.
    0   VARIABLE STACK1COUNTER  \ #Bytes to add to STACK2 to point to item k
                                \ #Bytes = 2*k. First item -> k=1
    0   VARIABLE COLCHONSIZE    \ Initialized by DICEXTRACT
   
CREATE STACK1 200 ALLOT         \ First 2 bytes will store actual size in bytes.

: 2DROP ( n1,n2 - )
 DROP DROP
;

: UDO ( n1,n2 - )
\ Unsigned DO used with ULOOP/+2 and BEGIN/UNTIL

 R> ROT >R SWAP >R
 >R
;

: ULOOP+2 ( - )
 \ Unsigned +LOOP with increment of 2. Used with UDO and BEGIN/UNTIL
 
 R> R> 2+ >R >R
 I' J U< 0= DUP
 IF
  R> R> R> DROP DROP
  >R
 THEN
;

: DEPTH ( - n)
\ Returns the size of the Data Stack (not including n)

 15419 @ HERE 12 +
 - 2 /
;

: PF_SIZE ( PFA - [PF size])
 \ From a given PFA returns the PF size of the corresponding Word
 
 DUP 7 - @ ?DUP     \ get Length Field LF
 0=
 IF
  HERE OVER -       \ If LF=0 -> Last word -> we have to calculate word's length.
 ELSE
  7 -               \ PF's length = LF-7
 THEN
 SWAP DROP
;

: W_SIZE ( CFA - Word Size)
\ From a given CFA returns the Word's size.

 DUP 5 - @ ?DUP
 0=
 IF
  HERE OVER - 5 +
 THEN
 SWAP 1- C@ 63 AND
 +
;

: +! ( n,addr - )
 \ Adds n to the number in addr and stores result at that addr.
 \ (addr)=(addr)+n
 
 DUP @ ROT + SWAP
 !
;

: LASTWORD ( - CFA)
\ Returns the CFA of the last word in the dictionary.

 CURRENT @ @ 1+
;

: VCOUNT ( CFA - n)
\ Returns the position n that the word with CFA occupies in the dictionary. The first after FORTH is n=1

 1- 0 SWAP
 BEGIN
  SWAP 1+ SWAP 2- @
  DUP 15434 U<
 UNTIL
 DROP
;

: PUSHFLOW ( addr - )
 \ Check that there is enough space in the "stack" beginning at addr to hold
 \ a new item. If not -> Error "PUSH Overflow" -> "stack"[address] need to bee bigger.
 
 DUP PF_SIZE 2- SWAP @
 =
 IF
  ." PUSH Overflow"
  ABORT
 THEN
;

: PUSH ( n,addr - )
\ "push" number n to the "stack" beginning at addr.

 DUP PUSHFLOW 2 OVER +!
 DUP @ + !
;

: NOTINSTACK? ( CFA,adr - f)
\ Returns 1 if the given CFA is not in the "stack" beginning at adr.

 DUP @ 0=
 IF
  2DROP 1 EXIT
 THEN
 DUP @ 2+ OVER +
 SWAP 2+ UDO
 BEGIN
  I @ OVER =
  IF
   R> R> 2DROP DROP 0
   EXIT
  THEN
  ULOOP+2
 UNTIL
 DROP 1
;

: H. ( n - )
\ Prints the number n in Stack in Hexadecimal unsigned format

 BASE DUP C@ SWAP 16
 OVER C! ROT U. C!
;

: H2. ( n - )
 \ Prints number n in hexadecimal unsigned format of at least two digits.
 
 DUP 16 U<
 IF
  ASCII 0 EMIT
 THEN
 H.
;

: H4. ( n - )
\ Prints n in hexadecimal unsigned format of at least four digits.

 DUP 4096 U<
 IF
  ASCII 0 EMIT DUP 256 U<
  IF
   ASCII 0 EMIT
  THEN
 THEN
 H2.
;

: CLKEY ( - )
\ Waits until no key is being pressed

 BEGIN
  INKEY 0=
 UNTIL
;
 

: RKEY ( - ascii code of key pressed)
\ Returns the ascii code of the key being pressed
\ CLKEY acts as a kind of "Cleanup of unwanted keystrokes"

 CLKEY
 BEGIN
  INKEY ?DUP
 UNTIL
 CLKEY
;

: POLYDUP ( n1,n2 - n1...n1 n2 times)
 1- DUP 1 <
 IF
  DROP EXIT
 THEN
 0
 DO
  DUP
 LOOP
;

: NTYPE ( CFA - )
\ Prints the name of the word with that CFA
\ NTYPE has replaced the original SHOWNAME Word. It is faster and more compact.
 
 DUP DUP 1- C@ 63
 AND DUP ROT 5 -
 SWAP - SWAP 1- TYPE
 6 - C@ 127 AND
 EMIT SPACE
;

: EXTSIZE ( - n)
\ Returns the size of STACK1 in number of CFAs stored (not in bytes)

 STACK1 @ 2 /
;
 
: DICSIZE  ( - n)
\ Returns the number of user words in the dictionary.

 LASTWORD VCOUNT
;

: ERROR ( n - )
\ Abort and  emit ERROR number n

 15421 C! ABORT
;

: DEF_PARENT ( CFA1 - CFA2)
\ Being CFA1 the CFA of a word defined with a defining Word, returns
\ CFA2, the CFA of the defining word that defined it.
\ e.g. we define MYCONS with 2CONSTANT, then FIND MYCONS DEF_PARENT
\ will return the CFA of 2CONSTANT

 @ 2- DUP @ +
 1+
 BEGIN
  DUP C@ 128 >
  IF
   1
  ELSE
   1+ 0
  THEN
 UNTIL
 6 +
;

: ISFORTH? ( CFA - f)
\ Checks if a Word is one of the default Forth dictionary words.
\ That is, one of the words hardcoded in Ace's ROM.
\ FINDLIMIT is a constant = CFA(FORTH)+1.

 FINDLIMIT U<
;

: OFN? ( adr,CFA - {n},f)
\ OFN comes from "Operand Field n" where n is the size of a variable-size OF.
\ 4985 ($1379) is the CFA of [(]
\ 5014 ($1396) is the CFA of [."]
\ These Words are the only Primitives that have a variable OF size.
\ NOTATION (··· - {n},f)
\   The number n inside {} is only pushed on the stack if f is true.
\   Otherwise, only f is pushed.

 DUP 5014 = SWAP 4985
 = OR
 IF
  DUP 2+ @ 2+ 1
 ELSE
  0
 THEN
;
 
: OF4? ( CFA - {4},f)
\ See NOTATION in OFN?
\ OF4 comes from "Operand Field 4". That is, OF size = 4 bytes
\ 4196 ($1064) is the CFA for a Floating point number enclosed in a definition

 4196 =
 IF
  4 1
 ELSE
  0
 THEN
;
 
: OF2? ( CFA - {2},f)
\ See NOTATION in OFN?
\ OF2 comes from "Operand Field 2". That is, OF size = 2 bytes.
\ There are 8 primitives compiling words with an OF size of two bytes
\ 4113 ($1011) is the CFA of LITERAL
\ 4739 ($1283) is the CFA of IF
\ 4721 ($1271) is the CFA of ELSE
\ 4749 ($128D) is the CFA of UNTIL
\ 4744 ($1288) is the CFA of WHILE
\ 4726 ($1276) is the CFA of REPEAT
\ 4914 ($1332) is the CFA of LOOP
\ 4924 ($133C) is the CFA of +LOOP
\ NOTE: All these CFAs are the CFA of the Runtime.

 8 POLYDUP 4113 = 8
 ROLL 4739 = 8 ROLL
 4721 = 8 ROLL 4749
 = 8 ROLL 4744 =
 8 ROLL 4726 = 8
 ROLL 4914 = 8 ROLL
 4924 = OR OR OR
 OR OR OR OR
 IF
  2 1
 ELSE
  0
 THEN
;
 
: OF1? ( CFA - {1},f)
\ See NOTATION in OFN?
\ OF comes from "Operand Field 1". That is OF size = 1 byte.
\ 4171 ($104B) is the CFA of ASCII.

 4171 =
 IF
  1 1
 ELSE
  0
 THEN
;

: IS_DEFINED? ( CFA - f)
\ Test if a word (given its CFA) is a word defined with a defining word.
\ Any word of this kind has ((CFA)-4)=4328 ($10E8)

 @ 4 - @ 4328
 =
;
 
 : ISFIN? ( CFA - f)
 \ f true -> CFA corresponds to an ending word. (see ENDWORD)
 
 DUP 1206 = SWAP DUP
 4328 = SWAP 4416 =
 OR OR
;

: ENDWORD ( adr1,CFA,f1 - adr2,f2)
\ This word returns addr of the next compiled CFA in the word's PF (the word
\ beign analyzed). If it corresponds to ";" then word analysis has ended.
\ If not, it returns the addr of the next CFA compiled in that PF (adr2).

\ ENDWORD is always executed after ISFIN?: f1 corresponds to the f from ISFIN?
\ adr1 is the addr of the actual CFA (compiled in a word's PF) being analyzed
\ CFA=(adr1) that is, the CFA stored at adr1
\ Flag1 true -> CFA is of an "ending word". There are three cases:
\ 1- End section before DOES> -> CFA=4328 ($10E8)
\ 2- End section before RUNS> -> CFA=4416 ($1140)
\ 3- End of definition ; ------> CFA=1206 ($04B6)
\ adr2 is the addr of the next CFA to be analyzed except when it is case 3
\ when this address has no importance, since we have reached the
\ End of the Word's definition -> ;
\ f2 true  -> We have reached the End of the Word's definition (;)
\ f2 false -> We have to analyze CFA stored at adr2

 IF
  1206 =
  IF
   1        \ Case 3: End of definition (;) -> f2=true & adr2=adr1
  ELSE
   5 + 0    \ Case 1 or 2 -> f2=false & adr2=adr1+5 (***)
  THEN
 ELSE
  DROP 0    \ Not an ending word -> f2=false & adr1=adr2
 THEN
 
 \ (***) in cases 1 and 2, the next CFA compiled in the word's PF is
 \ always 5 bytes past the address of the Ending CFA.
 
;

: GETSTEP ( CFA - n)
\ Get the size of the OF (Operand Field) of a compiled COMPILER word.

 3 - C@
;

: FFSTEP ( adr - n)
\ If the OF of the compiled COMPILER word is variable (not fix) then FFSTEP
\ returns n=[OF size]+2

 2+ @ 2+
;
 
: ISCOMPILING? ( CFA - f)
\ Test if CFA corresponds to a COMPILING word (defined with COMPILER)
\ When such a word is compiled in the PF of a user word, the compiled CFA
\ is not its CFA but the address of that COMPILING word that contains
\ 4418 ($1142) stored.

 @ 4418 =
;
 
: COMP_PARENT ( CFA1 - CFA2)
\ Given a compiled CFA returns the CFA of the corresponding compiling Word
\ that defined it (its parent)

 2- DUP @ + 1+
 BEGIN
  DUP C@ 128 >
  IF
   1
  ELSE
   1+ 0
  THEN
 UNTIL
 6 +
;
 
: FORTHSTEP ( CFA - n)
\ Returns the number of bytes to skip in the PF being analyzed to get the next
\ compiled CFA. That is, the size of the OF of the compiling word.
\ Used when CFA is of a Forth word (not a User defined one)

 DUP OF1?
 IF
  SWAP DROP
 ELSE
  DUP OF2?
  IF
   SWAP DROP
  ELSE
   DUP OF4?
   IF
    SWAP DROP
   ELSE
    OFN?
    IF
    ELSE
     0
    THEN
   THEN
  THEN
 THEN
;
 
: COMPILER? ( CF - f)
\ The value stored at the CFA of a compiling word (CFA)=CF is 4360($1108)

 COMPILING =
;
 
: DEFINER? ( CF - f)
\ The value stored at the CFA of a defining word (CFA)=CF is 4229($1085)

 DEFINING =
;

: RED_SIZE ( - n)
\ If the last word size in the dictionary is:
\ Less than the size of the next word to be Redefined -> 0
\ More than the size of the next word to be Redefined -> size difference

 LASTWORD W_SIZE NEXTRED @ W_SIZE
 OVER OVER U<
 IF
  2DROP 0
 ELSE
  -
 THEN
;
 
: CFADEL ( n,adr - )
\ The CFA at n bytes shift from beggining of "stack" beginning at adr. is put to 0.

 OVER OVER @ SWAP U<    \ Checks that the given shift n is not greater than "stack"'s size.
 IF
  21 ERROR
 THEN
 + 0 SWAP !
;
 
: STACKSEARCH ( CFA,adr - n)
\ Returns shift n (in bytes) for the first time CFA is found inside "stack" at adr. If not found -> n=0

 DUP @ 0=
 IF
  2DROP 0
 THEN
 DUP >R 0 ROT ROT
 DUP @ OVER + 2+
 SWAP 2+ UDO
 BEGIN
  I @ OVER =
  IF
   DROP 1+ I LEAVE
  THEN
  ULOOP+2
 UNTIL
 SWAP 0=
 IF
  R> 2DROP 0
 ELSE
  R> -
 THEN
;
 
: NEXTUP ( CFA1 - CFA2)
\ Returns CFA2 = CFA of the next word in the dictionay (going up in memory) after the one with CFA=CFA1

 5 - DUP @ +
 BEGIN
  DUP C@ 127 >
  IF
   6 + 1
  ELSE
   1+ 0
  THEN
 UNTIL
;
 
: STACKMOVE ( - )
\ Move the Data Stack to its new position after a word has been deleted with OLVIDA.

 CURRENT @ @ 3 +
 DUP PF_SIZE + >R 15419
 @ HERE - 12 =
 IF
  R> DUP 15415 ! 12
  + 15419 ! EXIT
 THEN
 R> DUP 12 + 15419
 @ 4 - HERE 12
 + UDO
 BEGIN
  I @ OVER ! 2+
  ULOOP+2
 UNTIL
 SWAP 15415 ! 15419 !
;
 
: SHOWSTACK ( addr. - )
\ Shows the content of "stack" at addr. Each word's name is preceded with
\ three numbers: $addr. of its position on memory, $CFA, CFA.

 0 SWAP DUP @ CR
 ." count: "
 2 / U. DUP @
 2+ 2
 DO
  CR SWAP 1+ DUP 20
  =
  IF
   DROP 0 RKEY DROP
  THEN
  SWAP I OVER + DUP
  H4. @ DUP H4. DUP
  U. NTYPE 2
 +LOOP
 DROP DROP
;
 
: ANALYZER2 ( adr - )
\ ANALYZER2 searchs all compiled CFAs in a word and copy them to STACK1 only if it has not been added before.
\ ANALYZER2 is a versión of ANALYZER (which is used in SOURCE EXTRACTOR "Extractsou".
\ It can cope with both kind of recursions (simple and cross) and any word is analyzed only once.

 DUP @ DUP DEFINER? SWAP
 COMPILER? OR
 IF
  2+    \ Compiling/defining words' two first bytes are not any compiled CFA
 THEN
 2+     \ CFA+2=PFA.
 BEGIN
  DUP @ ISFORTH?
  IF
   DUP @ FORTHSTEP  \ FORTH words are not analyzed. Only OF size is needed to
  ELSE              \ get next compiled CFA address.
   DUP @ DUP ISCOMPILING?   \ If it is a compiling word -> its parent will be
   IF                       \ analyzed, not the actual compiling word.
    COMP_PARENT
   THEN
   DUP ACTUALWORD @ = 0=        \ ACTUALWORD is the word being analyzed. Compiled
   IF                           \ CFA is only copied if not equal to ACTUALWORD.
    DUP STACK1 NOTINSTACK?      \ This way we avoid infinite loop during simple
    IF                          \ recursion words analysis.
     DUP STACK1 PUSH
    THEN
   THEN
   DROP DUP @ ISCOMPILING?      \ If word is a compiling one, OF size is used to
   IF                           \ skip it and point to next compiled CFA
    DUP @ GETSTEP DUP 255
    =
    IF
     DROP DUP FFSTEP
    THEN
   ELSE
    0
   THEN
  THEN
  OVER 2+ + SWAP @      \ If next compiled CFA corresponds to ";" the word analysis ends.
  DUP ISFIN? ENDWORD
 UNTIL
 DROP
;
 
: LISTABLE? ( CFA - f)
\ Only Colon definitions, Compiling and Defining words are listable with LIST
\ so they are the only ones analyzable.

 DUP ISFORTH?
 IF
  DROP 0 EXIT
 THEN
 @ DUP COLON =
 IF
  DROP 1 EXIT
 THEN
 DUP DEFINING =
 IF
  DROP 1 EXIT
 THEN
 COMPILING =
 IF
  1
 ELSE
  0
 THEN
;
 
: ACTUALONE ( CFA - )
\ Prints on screen the name of the word.

 5 1 AT 24 SPACES
 5 5 AT NTYPE
;
 
: STACK1COPY
\ Increments STACK1COUNTER variable by 2 so it points to next item in STACK1.
\ Then push that item to the Data Stack.

 ( - CFA)
 2 STACK1COUNTER +! STACK1COUNTER @
 STACK1 + @
;
 
: REDEF ( CFA - )
\ Same as REDEFINE but it takes the CFA of the word to be redefined from the Data stack.
\ It allows redefinition of forbidden words.

 DUP 4076 SWAP ! DUP
 1- DUP C@ 63 AND
 - 4 - DUP C@
 128 AND 128 * 127
 + SWAP C! CLS 20
 1 AT NTYPE 9856 15396
 ! REDEFINE
;
 
: DESPLA ( n,adr - )
\ Given a shift on n bytes, all CFAs stored at "stack" at adr will be added n to them: CFA = CFA+n for each one.

 DUP @ 0=
 IF
  DROP DROP EXIT
 THEN
 DUP @ OVER + 2+
 SWAP 2+ UDO
 BEGIN
  I DUP @ 0=
  IF
   DROP
  ELSE
   OVER SWAP +!
  THEN
  ULOOP+2
 UNTIL
 DROP
;
 
: DELTA ( CFA_r - n)
\ Returns [Last Word size] - [Word with CFA=CFA_r]
\ CFA_r is the CFA of the word to be redefined.
\ The returned number is the increment/decrement in size expected after the redefinition.

 LASTWORD W_SIZE SWAP W_SIZE -
;
 
: CFAUR ( CFAr - CFAur)
\ CFAr  is the CFA of the Word to be redefined
\ CFAur is the value it will have, after the redefinition has taken place, due to a difference in Names' length.
\ If the length of the names of the two words involved in a redefinition are the same, then, after the
\ redefinition has taken place, the new CFA of the moved word would be the same as the CFA of the redefined word.

 CURRENT @ @ C@ 63
 AND OVER 1- C@ 63
 AND - +
;
 
: RED_OVERFLOW_TEST ( - )
\ Check before a redefinition takes place, that the size of COLCHON is enough to hold the dictionary shift in
\ memory before the last word has been deleted.
\ REDEFINE, when the size of the Last Word is greater than the size of the word that is redefined, expands
\ temporarily the dictionary by as many bytes as the difference in sizes to make space to copy Last Word
\ over the redefined one. If COLCHON can not hold this expansion -> Error.

 COLCHONSIZE @ RED_SIZE DEPTH DUP
 + + OVER OVER U<
 IF
  CLS 10 0 AT ." WARNING: COLCHON size "
  SWAP U. CR ." Need to be "
  U. ABORT
 ELSE
  2DROP
 THEN
;
 
: NEXT>REDEF ( - )
\ Set NEXTRED with the CFA of the next word to be redefined.
\ In the process, any CFA in STACK1 found while searching is deleted (set to 0) since its corresponding word
\ occupies its definitve place.

 NEXTRED @
 BEGIN
  DUP HERE SWAP U<
  IF
   DROP 0 NEXTRED ! 1
  ELSE
   NEXTUP DUP STACK1 STACKSEARCH ?DUP
   0=
   IF
    NEXTRED ! 1
   ELSE
    STACK1 CFADEL 0
   THEN
  THEN
 UNTIL
;
 
: OLVIDA ( CFA - )
\ Same as FORGET but it takes the CFA of the word to be FORGETTED from the Data Stack.
\ It does not stop program run after it, as FOGET do.

 3 - @ CURRENT @
 ! STACKMOVE
;
 
: DICYA? ( - f)
\ When the number of CFAs in STACK1 is the same as the number of words in the dictionary -> Extraction complete.
\ Bear in mind that CFAs deleted from STACK1 count as word although its CFA is 0.

 DICSIZE EXTSIZE =
;
 
: PRE_DELETE ( - )
\ Convierte en tipo CREATE todas las palabras que no están en STACK1.
\ O sea, todas las palabras que serán borradas o Redefinidas son convertidas antes en tipo CREATE.
\ Esto tiene tres efectos:
\ 1- Permite redefinir palabras que de otro modo no se podrían redefinir.
\ 2- Evita errores con las redefiniciones (no está muy claro el porqué, pero es así).
\ 3- Acelera mucho las redefiniciones, pues las palabras tipo CREATE no han de corregir su PF cuando se mueven.

 15434
 BEGIN
  NEXTUP DUP STACK1 STACKSEARCH 0=
  IF
   DUP 4076 SWAP !
  THEN
  LASTWORD OVER =
 UNTIL
 DROP
;
 
: EXTRACT2 ( CFA - )
\ Generate a list of all the user words needed so the user word with the given CFA can run.
\ This list is stored in STACK1 as a list of CFAs.

 CLS DUP ISFORTH?
 IF
  ." Not a user word"
  ABORT
 THEN
 0 STACK1COUNTER ! 0 STACK1
 ! STACK1 PUSH
 BEGIN
  STACK1COUNTER @ STACK1 @ <
 WHILE
  STACK1COPY DUP ACTUALONE DUP LISTABLE?
  IF
   DUP ACTUALWORD ! ANALYZER2
  ELSE
   DUP IS_DEFINED?  \ If word was defined with a defining word then that defining word is added to the list
   IF               \ except when it already is in the list.
    DEF_PARENT DUP STACK1 NOTINSTACK?
    IF
     STACK1 PUSH
    THEN
   ELSE
    DROP
   THEN
  THEN
 REPEAT
 CR STACK1 SHOWSTACK CR ." Press a Key to continue"
 RKEY DROP
;
 
: DICEXTRACT ( CFA - )
\ Realiza el proceso de extracción:
\ 1- Se autoborra (Técnica Palabras Fantasma). Al borrarse siguen en memoria todas las palabras que componen el
\    programa separada la primera tantos bytes del diccionario como bytes tiene COLCHON. Así evitamos que la pila
\    o la expansión del diccionario en según que redefiniciones puedan sobreescribir las palabras del programa borrado.
\    Esta técnica permite que las palabras por debajo del programa se puedan borrar, mover, redefinir sin problemas,
\    puesto que el programa ya no forma parte del diccionario.

\ 2- Ejecuta el extractor de palabras que nos genera una lista de todos los CFAs de las palabras de usuario necesarias
\    para que la del CFA suministrado pueda funcionar. Esta lista está en STACK1 como lista de CFAs.

\ 3- Una vez tenemos la lista de palabras a conservar en STACK1 empieza el proceso de reducción examinando las palbras
\    del diccionario empezando por la última.
   
\       a- Si la última palabra no está en la lista se elimina con OLVIDA (un FORGET modificado).
\       b- Si la última palabra está en la lista se redefine la que está más al principio (más cerca de FORTH) que
\          no esté en la lista.
\       c- Se repite el proceso hasta que el diccionario contenga tantas palabras como la lista.


 COLCHON 2- DUP W_SIZE COLCHONSIZE
 ! OLVIDA EXTRACT2 STACK1 @
 0=
 IF
  EXIT
 THEN
 DICYA?
 IF
  EXIT
 THEN
 CLS ." predeleting... "
 PRE_DELETE 15434 NEXTRED !
 BEGIN
  DICYA? 0=
 WHILE
  LASTWORD DUP CLS 10 10
  AT NTYPE STACK1 STACKSEARCH ?DUP
  0=
  IF
   LASTWORD OLVIDA
  ELSE
   NEXT>REDEF RED_OVERFLOW_TEST STACK1 CFADEL NEXTRED
   @ CFAUR NEXTRED @ DELTA
   STACK1 DESPLA NEXTRED @ SWAP
   NEXTRED ! REDEF
  THEN
 REPEAT
;


dicextract.TZX
(14.16 KiB) Descargado 9 veces

Elurdio
Mensajes: 510
Registrado: 07 Dic 2021 21:33
Ubicación: Barcelona
Agradecido : 115 veces
Agradecimiento recibido: 95 veces

Re: Jupiter Ace Forth (Extractor de Diccionario)

Mensajepor Elurdio » 15 Ago 2022 13:43

Hoy me he topado con otro caso en el que REDEFINE falla.

Examinando el programa Turtle Graphics Pack 1985 Boldfield he visto que crea sus propias versiones de palabras como OVER, ROT, etc.

He querido ver la diferencia de velocidad entre éstas y las originales del JA. Escogí empezar con ROT. Así que procedo así:

Cargo el diccionario TURTLE.TAP y para aislar ROT primero borro todas la anteriores (OVER es la anterior) y luego redefino la última del diccionario que es C:

FORGET OVER
REDEFINE C

Hago VLIST y se cuelga el JA (EigthyOne).

Hago lo mismo en el emulador ZEsarUX y lo mismo, se cuelga también.

Entonces reseteo todo, vuelvo a cargar TURTEL.TAP y cargo encima el Extractor de Diccionario DICEXTRACT para extraer ROT:

FIND ROT DICEXTRACT

y obtengo ROT sin problemas.

Lo que hace DICEXTRACT de convertir a tipo CREATE todas las palabras que se van a borrar/redefinir funciona bien. Al menos hasta la fecha.


Volver a “Jupiter Ace”

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 1 invitado