; module FORTH NOVA DEBUG
; Guillaume Tello
; guillaume.tello@orange.fr
; d‚cembre 2024: 1.00 NOVA + ST HAute ou ST Moyenne
; juin 2025    : 1.01 Sans carte graphique, swap d'‚crans
; juin 2025		: 1.02 menu de configuration Dconfig
; juillet 2025 : 1.03 d‚tournement bombes

GEMDOS MACRO    ; fn,pile
   move #\1,-(sp)
   trap #1
   if \2<=8
      addq.l #\2,sp
   else
      add.w #\2,sp
   endif
   ENDM
   
XBIOS MACRO    ; fn,pile
   move #\1,-(sp)
   trap #14
   if \2<=8
      addq.l #\2,sp
   else
      add.w #\2,sp
   endif
   ENDM

		section	text
		
debut:	
	dc.b "READ_FOM"	; identifiant module g‚n‚ral FORTH
	dc.b "DBUG"			; objets support‚s
	dc.w 16				; type n=nbr de redef diff‚rentes de modexe
	dc.b "NOVADBUG"	; nom court
	dc.w 103				; version
	dc.b "Nova 2nd Screen Debug ½GT 2025",0 ; long name (30 caractŠres + z‚ro)
	dc.b 8+4+2+1		; masque de bits:
							;   1 si do_param pr‚sent
							;   2 si mots red‚finis
							;   4 si ne pas renvoyer d0 sur la pile (sauf pour do_param)
							;   8 si do_exit pr‚sent
	bra Dfont			; 
	bra Dauto			; 
	bra modexe			; ensemble des fonctions
	bra do_param		; initialise 
	bra do_exit			; d‚sinstalle
	
	dc.b "Dfont",0		; adresse d'une fonte ou 0 pour chercher fonte systŠme
	dc.b "Dauto",0		; fixer space auto et cr auto
	dc.b "Dcls",0		; fonction 1 : fixe Monochrome et efface l'‚can
	dc.b "Dcr",0		; fonction 2 : saute une ligne
	dc.b "Dspace",0	; fonction 3 : met un espace
	dc.b "D.",0			; fonction 4 : valeur d‚cimale
	dc.b "Dh.",0		; fonction 5 : valeur hexad‚cimale
	dc.b "Dtype",0		; fonction 6 : chaine
	dc.b "Dkey",0		; fonction 7 : affiche "Press CapsLock" puis l'efface si touche
	dc.b "Dnewl",0		; fonction 8 : efface la ligne en cours et curseur au d‚but
	dc.b "Dump",0		; fonction 9 : affiche un dump m‚moire de n lignes de 16 octets
	dc.b "Dump+",0		; fonction 10: avance de n lignes dans le Dump
	dc.b "Dump-",0		; fonction 11: recule de n lignes dans le Dump
	dc.b "Dsave",0		; fonction 12: sauve la position du cureur
	dc.b "Dback",0		; fonction 13: retourne … la position sauv‚e
	dc.b "Dconfig",0	; fonction 14: menu de configuration (mieux que Dauto)	
	dc.b "Df.",0		; fonction 15: affiche un r‚el
	dc.b "D.s",0		; fonction 16: affiche la pile

	
	even					; assure la parit‚	
	
	; en 4(SP)on trouve SNDB
	; sur A6 la pile FORTH

	; adr Dfont
	; si adr=8		cherche la fonte 8*8 du systŠme
	; si adr=16		cherche la fonte 8*16 du systŠme
	; si adr>16		adresse d'un header de fonte 8*h

Dfont:	
modinfo:
	moveq #0,d6			; flag passage 8->16 en hauteur
	lea fonte(pc),a1
	moveq #0,d0			; renvoie 0 si fonte refus‚e
	moveq #8,d2
	move.l (a6)+,a0	; adresse header fonte
	cmp.l d2,a0
	bne.s .lb0
	; ici cherche si la fonte 8*8 est dispo
	move.l (a1),d2
	beq.s .fin			; fonte non pr‚sente
	moveq #7,d1
	bra.s .syst
.lb0:
	moveq #16,d2
	cmp.l d2,a0
	bne.s .lb1
	; ici on cherche si la fonte 8*16 est dispo
	move.l 4(a1),d2
	beq.s .fin
	moveq #15,d1
	cmp 12(a1),d1			; est-ce d‚j… du 16?
	sne d6					; si non, on marque !
.syst:
	move.l d2,8(a1)		; fonte courante
	move d1,12(a1)			; fonth
	bra.s .ok	
.lb1:
	; ici on v‚rifie le header de la fonte utilisateur
	cmp #8,52(a0)			; largeur 8?
	bne.s .fin
	cmp #256,80(a0)	; 256 octets de large (tous les caractŠres?)
	bne.s .fin
	move 82(a0),d2		; hauteur
	cmp #8,d2
	beq.s .hautok		; la hauteur doit etre 8 ou 16
	cmp #16,d2
	bne.s .fin
.hautok:
	move d2,d0
	subq #1,d0			; -1
	move.l 76(a0),d1	; les donn‚es ou offset
	cmp.l usradr(pc),d1
	bpl.s .lb2			; si > la plus basse adresse, alors consid‚r‚ comme adresse valide
	add.l a0,d1			; sinon, consid‚r‚ comme offset, on ajoute l'adresse header	
.lb2:	
	move.l d1,8(a1)	; les donn‚es
	cmp #15,d0
	bne.s .lb3			; ce n'est pas du 16 maintenant
	cmp 12(a1),d0		; mais si c'en est, ‚tait-ce d‚j… du 16 avant?
	sne d6
.lb3:	
	move d0,12(a1)			; hauteur-1
.ok:
	tst.b d6				; passage 8 … 16 ?
	beq.s .lb4			; non
	bsr verif_ligne	; si oui, s'assurer d'etre sur une ligne paire	
.lb4
	moveq #2,d0			; renvoie 2 si ok
.fin:
	move.l d0,-(a6)
	rts

	; ici on passe d'une fonte 8 … une fonte 16
	; v‚fifie qu'on est sur une ligne paire de 8 (si oui, ok)
	; (si non, r‚ajuste la ligne)

verif_ligne:
	moveq #0,d0
	lea dline(pc),a0
	move (a0)+,d0		; taille d'une ligne
	move.l 8(a0),d2	; curptr
	sub.l (a0),d2		; curptr-physbase: offset en octets
	divu d0,d2			; offset en lignes d'‚cran
	lsr #3,d2			; offset en ligne de texte 8 de haut
	btst #0,d2			; ligne paire?
	beq.s .ok			; oui, rien … faire, on conserve les pointeurs
	lsl.l #3,d0			; nombre d'octets pour reculer d'une ligne de texte
	addq.l #8,a0
	sub.l d0,(a0)+		; curptr-1, revient sur la pr‚c‚dente ligne paire
	sub.l d0,(a0)+		; curend-1
	bsr Dcr				; et saute une ligne de 16 de haut
.ok:
	rts

	; bit0 : auto space … chaque ‚criture? (defaut OUI)
	; bit1 : auto cr … chaque ‚criture? (defaut NON)
	; bit2 : auto DUP pour conserver les valeurs? (defaut OUI)
	; bit3 : auto DUP pour les chaines? (defaut NON)
	; bit4 : auto Dback avant chaque Dump/+/- (d‚faut NON)
	; bit5 : d‚tourner erreurs bombes (d‚faut non)

autobits: dc.w %000101
	
	; masque Dauto fixe nouveau
	; si masque = -1, ne fait que renvoyer, pas de modif

Dauto:	
modpal:
	lea autobits(pc),a0
	move.l (a6)+,d0	; nouveau
	bmi.s .read
	move d0,(a0)		; fixe le masque
	bsr bomb_modif
	rts
.read:
	moveq #0,d0
	move (a0),d0		; lit le masque
	move.l d0,-(a6)	; et renvoie
	rts

	; initialisation lors de modload
	
do_param:
	bsr save_forth_values
	pea .init_screen(pc)
	move #38,-(sp)
	trap #14
	addq.l #6,sp
	bsr Dcls					; efface ‚cran et place les pointeurs du curseur
	bsr Dsave				; et sauvegarde le curseur en haut par d‚faut
	dc.w $A000				; lineA
	lea fonte(pc),a2
.lb0:
	move.l (a1)+,d0		; une fonte
	beq.s .fin				; liste finie
	move.l d0,a0			; header
	move.l (a0),d1
	cmp.l #$00010009,d1	; fonte 8*8 ?
	bne.s .lb1
	cmp #8,52(a0)			; largeur 8?
	bne.s .lb0
	cmp #8,82(a0)			; hauteur 8?
	bne.s .lb0
	move.l 76(a0),(a2)	; valide la font8, pointeur sur les donn‚es
	bra.s .lb0
.lb1:
	cmp.l #$0001000A,d1	; fonte 8*16 ?
	bne.s .lb0
	cmp #8,52(a0)			; largeur 8?
	bne.s .lb0
	cmp #16,82(a0)			; hauteur 16?
	bne.s .lb0
	move.l 76(a0),4(a2)	; valide font16
	bra.s .lb0
.fin:
	moveq #0,d7				; masque … renvoyer
	move mode(pc),d0
	bpl.s .f1
	bset #3,d7				; bit #3 si carte graphique
.f1:
	tst.b d0
	bpl.s .f2
	bset #2,d7				; bit #2 si monochrome, sinon ST Moyenne
.f2:
	tst.l (a2)
	beq.s .f3
	bset #0,d7				; bit #0 si fonte 8 pr‚sente
.f3:
	tst.l 4(a2)
	beq.s .f4
	bset #1,d7				; bit #1,si fonte 16 pr‚sente
.f4:
	moveq #0,d0				; d‚faut pas de fonte
	moveq #0,d1
	btst #2,d7				; mode ‚cran
	beq.s .stmoy

	; ici monochrome
	btst #1,d7				; fonte 16 ?
	beq.s .mn0
	moveq #15,d1
	move.l 4(a2),d0
	bra.s .lb2				; fonte 16 pr‚sente, on pr‚fŠre
.mn0:
	btst #0,d7
	beq.s .lb2
	moveq #7,d1
	move.l (a2),d0			; fonte 8, c'est d‚j… ‡a
	bra.s .lb2

.stmoy:
	; ici ST Moyenne
	btst #0,d7				; fonte 8 ?
	beq.s .mn1
	moveq #7,d1
	move.l (a2),d0
	bra.s .lb2				; fonte 8 pr‚sente, on pr‚fŠre
.mn1:
	btst #0,d7
	beq.s .lb2
	moveq #16,d1
	move.l 4(a2),d0		; fonte 16, c'est d‚j… ‡a
	
.lb2:
	move.l d7,-(sp)		; sauve masque
	move.l d0,8(a2)		; fonte par d‚faut
	move.w d1,12(a2)		; et sa hauteur-1
	beq.s .nofont
	lea debut+24(pc),a0	; chaine du nom long
	bsr string_display	; affiche le titre !
	bsr Dcr					; ligne suivante
.nofont:
	move.l (sp)+,d0		; r‚cupŠre le masque pour retour
	rts
.init_screen:
	moveq #0,d1					; defaut video = 0 (ST)
	move.l $5a0.w,d0			; cookies
	beq.s .is1
	move.l d0,a0
.is0:
	cmp.l #'_VDO',(a0)
	bne.s .is2
	move.l 4(a0),d1		; 0-0 (st) 1-0 (ste) 2-0 (TT) 3-0 (Falcon) 4-0 (Milan)
	bra.s .is1
.is2:
	addq.l #8,a0
	tst.l (a0)
	bne.s .is0
.is1:
	lea video(pc),a0
	move.l d1,(a0)
	lea logbase(pc),a0
	move.l $44e.w,d0			; logbase
	move.l d0,(a0)
	moveq #80,d6				; d‚calage par ligne par d‚faut (monochrome)
	lea mode(pc),a0
	cmp.l $42e.w,d0			; ‚cran au dessus de la ST Ram?
	scc (a0)+					; mode = FF si carte graphique
	bcs.s .is5						; si pas de carte graphique, on doit r‚server 32000 octets
	swap d1
	cmp #2,d1					; un TT ?
	bne.s .is4					; non, on saute
	st (a0)						; mode+1 = FF monochrome
	bsr goto_tt_mono
	bra.s .is3
.is4:								; ici carte sur ST(e)
	move.b $FFFF8260.w,d0	; mode graphique
	cmp.b #2,d0					; monochrome?
	seq (a0)						; mode+1 = FF si monochrome
	beq.s .is3					; et dans ce cas, rien … faire de plus
	bsr goto_ste_mid
	add d6,d6					; 160 pour le d‚calage par ligne
.is3:
	moveq #0,d0
	move.b $FFFF8201.w,d0
	swap d0
	move.b $FFFF8203.w,d0
	lsl #8,d0
	move video(pc),d1
	beq.s .is3a					; ST/Mega ST, pas de 3e registre
	move.b $FFFF820d.w,d0	; video base address
.is3a:
	lea dline(pc),a0
	move d6,(a0)+				; d‚calage par ligne
	move.l d0,(a0)+		; conserve l'adresse physbase
	add.l #32000,d0
	move.l d0,(a0)+		; physend, fin d'‚cran
	lea usradr(pc),a0
	move.l $432.w,(a0)	; 1ere adresse libre (voir Dfont)
   move.l $4f2.w,a0       ; d‚but ROM
   move 2(a0),d0          ; version
	cmp #$0100,d0
	beq.s .lb3
	lea kbshift(pc),a1
	move.l 36(a0),(a1)	; pour TOS>1.00 on actualise la variable
.lb3:
	rts		
	; ici pas de carte graphique, r‚serve 32000 octets en ST Ram
.is5:
	move.l #32256,d0
	swap d1
	cmp #2,d1					; un TT ?
	bne.s .is6					; non, on saute
	st (a0)						; mode+1 = FF monochrome
	clr -(sp)					; only ST Ram
	move.l d0,-(sp)
	GEMDOS 68,8					; Mxalloc
	bra.s .iscomm
.is6:								; ici ST(e)
	move.b $FFFF8260.w,d0	; mode graphique
	cmp.b #2,d0					; monochrome?
	seq (a0)						; mode+1 = FF si monochrome
	beq.s .is6a
	add d6,d6					; double bytes/ligne pour ST Moyenne
.is6a:
	move.l d0,-(sp)
	GEMDOS 72,6					; Malloc
.iscomm:
	lea block(pc),a0
	move.l d0,(a0)+			; sauve pour Mfree
	move.l $502.w,(a0)+		; sauve ancienne routine alt-help
	lea mon_alt_help(pc),a1
	move.l a1,$502.w			; et place la mienne !
	add.l #255,d0
	clr.b d0						; aligne sur 256 octets
	bra .is3a

save_forth_values:
	clr.l -(sp)
	GEMDOS 32,6				; superviseur
	lea forth_stack(pc),a0
	lea 12(sp),a3			; pile+12(bsr d'ici + bsr do_param + bsr modload)
	move.l a3,(a0)+		; en as d'erreurs de bombes pour une valeur de pile acceptable
	move.l d0,(a0)+		; et valeur de pile systŠme acceptable
	move.l d0,-(sp)
	GEMDOS 32,6				; retour utilisateur
	lea debut(pc),a3		; r‚cupŠre les donn‚es envoy‚es par MODLOAD
	move.l -4(a3),a0		; adresse mots forth
	lea adresse(pc),a2
	move.l a0,(a2)+			; conserve la base
	move #151,d0			; code .s
	lsl.w #2,d0
	move.l 0(a0,d0.w),a1	; adresse .s
	subq.l #4,a1			; adresse flag standard pour sens affichage pile
	move.l a1,(a2)+
	move #635,d0			; code mot "f."
	lsl.w #2,d0
	move.l 0(a0,d0.w),a0	; adresse du mot "f."
	move 2(a0),d0			; offset vers subaff
	lea 2(a0,d0.w),a1		; adresse subaff
	move.l a1,(a2)+
	move.l 6(a0),(a2)+	; adresse buffer texte avec le nombre r‚el
	move.l -24(a3),a0		; extra data
	move.l (a0)+,(a2)+	; ordres
	move.l (a0)+,(a2)+	; diko
	lea 12(a0),a0
	move.l (a0)+,d0
	move.l d0,(a2)+		; debug prog
	add.l (a0)+,d0			; + taille
	move.l d0,(a2)+		; fin prog
	move.l (a0)+,(a2)+	; adresse des flags FORTH
	move.l (a0)+,(a2)+	; adresse du WORD du total de mots
	move #172,d0			; top
	bsr exec_forth
	move.l (a6)+,(a2)+	; adresse variable topprg	
	move #844,d0			; basepage
	bsr exec_forth
	move.l (a6)+,a0
;	lea 256+6(a0),a0		; adresse routine "d‚but"
	move.l a0,(a2)+		; adresse basepage
	rts
	
exec_forth:
	lea adresse(pc),a0
	move.l (a0),a0			; base des adresses
	lsl.w #2,d0
	move.l 0(a0,d0.w),a0	; adresse du mot
;	jsr (a0)					; execute
;	rts
	jmp (a0)					; plus simple !

kbshift: dc.l $E1B	; adresse kbshift pour TOS 1.00, chang‚e au d‚marrage sinon.

mon_ecran:
	lea physbase_save(pc),a0
	lea $FFFF8201.w,a1
	move.b (a1),(a0)+
	move.b 2(a1),(a0)+
	move video(pc),d1
	beq.s .is3a					; ST/Mega ST, pas de 3e registre	
	move.b 12(a1),(a0)+
.is3a:
	lea physbase+1(pc),a0
	move.b (a0)+,(a1)
	move.b (a0)+,2(a1)
	tst d1
	beq.s .is3b
	move.b (a0)+,12(a1)
.is3b:
	rts
	
user_ecran:
	lea physbase_save(pc),a0
	lea $FFFF8201.w,a1
	move.b (a0)+,(a1)
	move.b (a0)+,2(a1)
	move video(pc),d1
	beq.s .is3a					; ST/Mega ST, pas de 3e registre
	move.b (a0)+,12(a1)
.is3a:
	rts	
	
	
sauve_etat_tt:
	lea save_screen(pc),a0
	move $FFFF8262.w,(a0)+
	move $FFFF8400.w,(a0)+
	move $FFFF85Fe.w,(a0)+
	move $FFFF85FC.w,(a0)+
	rts
	
restaure_etat_tt:
	lea save_screen(pc),a0
	move (a0)+,$FFFF8262.w
	move (a0)+,$FFFF8400.w
	move (a0)+,$FFFF85Fe.w
	move (a0)+,$FFFF85FC.w
	rts

goto_tt_mono:
	move #$0200,$FFFF8262.w	; ici, carte sur TT, passe la vid‚o standard en mono
	move #$0fff,$FFFF8400.w	; cadre noir et Noir sur blanc
	move #$0FFF,$FFFF85Fe.w	; ‚criture noire
	move #$0000,$FFFF85FC.w	; fond blanc
	rts

sauve_etat_ste:
	lea save_screen+1(pc),a0
	move.b $FFFF8260.w,(a0)+
	lea $FFFF8240.w,a1
	move (a1)+,(a0)+
	move (a1)+,(a0)+
	move (a1)+,(a0)+
	move (a1)+,(a0)+
	rts

restaure_etat_ste:
	lea save_screen+1(pc),a1
	move.b (a1)+,$FFFF8260.w
	lea $FFFF8240.w,a0
	move (a1)+,(a0)+
	move (a1)+,(a0)+
	move (a1)+,(a0)+
	move (a1)+,(a0)+
	rts

goto_ste_mid:
	move.b #1,$FFFF8260.w	; passe en ST Moyenne
	lea $FFFF8240.w,a1
	clr (a1)+
	move #$0FFF,(a1)+
	clr (a1)+
	move #$0FFF,(a1)+			; une couleur sur 2 blanche, l'autre noire
	rts

; pile 4(SP):sndb, inutilis‚

modexe:	
	cmp.l #'XFOM',d1
	bne.s .nul				; ici choisir que faire si appel direct … modexe
								; message d'erreur ou un traitement par d‚faut
	
	lea routines(pc),a0	; pointe sur le tableau
	add.l d0,d0				; pointe sur des words
	move.w -2(a0,d0.l),d0	; offset … partir de "base" de la routine
	lea base(pc),a0
	add d0,a0				; ajoute offset
	jmp (a0)					; saute … la routine
.nul:
	rts						; si appel hors des mots, ne fait rien

	dc.b "DoEx"
	dc.l 0
do_exit:
	bsr Dcr
	lea sortie(pc),a0
	bsr string_display
	bsr Dkey
	lea block(pc),a0
	move.l (a0)+,d0		; une zone allou‚e?
	beq.s .lb0				; non, on quitte
	move.l d0,-(sp)		; pour mfree
	pea .restore_screen(pc)
	XBIOS 38,6
	GEMDOS 73,6				; Mfree
.lb0:
	lea autobits+1(pc),a0
	bclr #5,(a0)			; efface le bit bombes
	bsr bomb_modif			; et d‚sinstalle les vecteurs ‚ventuellement
.lb1:
	rts
.restore_screen
	lea old_alt_help(pc),a0
	move.l (a0),$502.w	; restaure l'ancien alt-help
	lea alt_help_flag(pc),a0
	tst.b (a0)
	beq.s .ok				; si 00, on est d‚j… sur l'‚cran utilisateur
	sf (a0)
	bsr bascule_ecran_normal
.ok:
	rts

mon_alt_help:
	move #$FFFF,$4ee.w	; remet le compteur alt-help … -1
	lea alt_help_flag(pc),a0
	tst.b (a0)
	beq.s .vers_debug
	; ici, on est en debug et on revient … l'‚cran normal
	sf (a0)					; reset flag
	bsr bascule_ecran_normal
	rts
.vers_debug:
	st (a0)					; flag debug on
	bsr bascule_ecran_debug
	rts

bascule_ecran_debug:
	move.l mode(pc),d0   ; xx MM 00 0c	(MM=mode FF High, 00 medium, et c=2 pour TT)
	cmp #2,d0
	beq.s .tt
	swap d0
	tst.b d0
	bne.s .comm			; d‚j… en ST Haute, rien … faire … part adresse ‚cran
	bsr sauve_etat_ste
	bsr goto_ste_mid
	bra.s .comm
.tt:
	bsr sauve_etat_tt
	bsr goto_tt_mono
.comm:
	bsr mon_ecran
	rts

bascule_ecran_normal:
	move.l mode(pc),d0   ; xx MM 00 0c	(MM=mode FF High, 00 medium, et c=2 pour TT)
	cmp #2,d0				; TT ?
	beq.s .tt
	swap d0
	tst.b d0
	bne.s .comm				; d‚j… en ST Haute
	bsr restaure_etat_ste
	bra.s .comm
.tt:
	bsr restaure_etat_tt
.comm:
	bsr user_ecran
	rts	

routines: dc.w Dcls-base,Dcr-base,Dspace-base,Dp-base,Dhp-base,Dtype-base
	dc.w Dkey-base,Dnewl-base,Dump-base,Dumpp-base,Dumpm-base,Dsave-base
	dc.w Dback-base,Dconfig-base,Dfp-base,Dps-base



base:

	; sans paramŠtre, efface l'‚cran et curseur en haut
	
Dcls:
	lea dline(pc),a0
	move (a0)+,d0			; dline
	move.l (a0)+,a1		; physbase
	move.l (a0)+,a2		; physend
	move.l a1,(a0)+		; curptr
	lea 0(a1,d0),a3
	move.l a3,(a0)+		; curend
	bsr clear_line
	rts

	; passe … la ligne suivante et scrolle s'il le faut
	; d7 libre
	
Dcr:
	lea dline(pc),a0
	move (a0)+,d0
	move.l (a0)+,a1			; physbase
	move.l (a0)+,a2			; physend
	addq.l #4,a0
	move.l (a0)+,a3			; curend
	move fonth(pc),d1
	muls d0,d1
	lea 0(a3,d1.l),a0			; nouveau curseur possible
	cmp.l a2,a0					; par rapport … la fin de l'‚cran...
	bpl.s .scroll				; on d‚passe, scroll attendu
	lea 0(a0,d0.w),a1			; nouveau curend
	lea curptr(pc),a2
	move.l a0,(a2)+			; curptr
	move.l a1,(a2)+			; curend
	rts
.scroll:
	move.l a3,a0
	sub.w d0,a0					; curptr remis au d‚but de ligne qui ne change pas
	lea curptr(pc),a3
	move.l a0,(a3)				; curptr remis
	lea 0(a1,d1.l),a3
	add.w d0,a3					; physbase+une ligne de texte
.scr0:
	movem.l (a3),d2-d6		; 80 octets
	lea 20(a3),a3
	movem.l d2-d6,(a1)
	lea 20(a1),a1
	movem.l (a3),d2-d6
	lea 20(a3),a3
	movem.l d2-d6,(a1)
	lea 20(a1),a1	
	movem.l (a3),d2-d6
	lea 20(a3),a3
	movem.l d2-d6,(a1)
	lea 20(a1),a1	
	movem.l (a3),d2-d6
	lea 20(a3),a3
	movem.l d2-d6,(a1)
	lea 20(a1),a1
	cmp.l a2,a3					; physend atteint?
	bmi.s .scr0
clear_line:
	moveq #0,d2
	moveq #0,d3
	moveq #0,d4
	moveq #0,d5
	moveq #0,d6
.scr1:
	movem.l d2-d6,(a1)		; efface derniŠre ligne
	lea 20(a1),a1
	movem.l d2-d6,(a1)
	lea 20(a1),a1	
	movem.l d2-d6,(a1)
	lea 20(a1),a1		
	movem.l d2-d6,(a1)
	lea 20(a1),a1
	cmp.l a2,a1					; physend atteint?
	bmi.s .scr1
	rts
	
Dspace:
	lea espace(pc),a0
	bsr string_display
	rts

Dp:
	bsr.s int_to_str
	moveq.l #4,d7		; pour drop
	bra nombre_comm

int_to_str:
	lea nombre(pc),a0
	move.l a0,a1
	lea table(pc),a2
	move.l (a6),d0
	bpl.s .lb0
	move.b #'-',(a1)+	; si n‚gatif, commence par le signe
	neg.l d0
.lb0:
	bne.s .lb1
	move.b #'0',(a1)+	; si nul, remplit et on termine
	bra.s .end
.lb1:
	move.l (a2)+,d1	; cherche l'ordre de gandeur
	cmp.l d1,d0
	bmi.s .lb1
.lb2:
	moveq #'0',d2
.lb3:
	sub.l d1,d0			; enlŠve un ordre de grandeur
	bmi.s .lb4			; trop... on s'arrete
	addq.b #1,d2		; sinon, augmente le chiffre
	bra.s .lb3
.lb4:
	add.l d1,d0			; revient en arriŠre
	move.b d2,(a1)+	; ajoute le chiffre dans la chaine
	move.l (a2)+,d1	; ordre suivant
	bne.s .lb2			; et au boulot
.end:
	clr.b (a1)
	rts
	
	; valeur Dh.		affiche le nombre en hexad‚cimal sur 32 bits
	
Dhp:
	move.l (a6),d0
	bsr.s d0_in_hex
	moveq #4,d7		; pour drop
nombre_comm:
	bsr string_display
	move autobits(pc),d0
	btst #2,d0		; autodup pour les nombres?
	bne.s .lb0
	add.l d7,a6		; sinon d‚pile (4 pour les entiers, 8 pour les r‚els)
.lb0:
	btst #1,d0		; auto cr ?
	beq.s .lb1
	bsr Dcr	
	rts				; si CR pas de space
.lb1:
	btst #0,d0		; auto space?
	beq.s .lb2
	bsr Dspace
.lb2:
	rts


Dfp:
;	trap #10
;	rts
	
	move.l fpt(pc),a0		; adresse subaff
	jsr (a0)
	subq.l #8,a6			; ne d‚pile pas par d‚faut
	moveq #8,d7				; pour d‚piler ‚ventuellement
	move.l fpt+4(pc),a0	; adresse chaine
	bra nombre_comm

d0_in_hex:
	lea nombre+40(pc),a0
	clr.b -(a0)
	moveq #7,d1
	moveq #15,d3
.lb0:
	move.l d0,d2
	and.l d3,d2		; les 4 chiffres du bas
	move.b chiffres(pc,d2.l),-(a0)
	lsr.l #4,d0		; et d‚cale
	dbf d1,.lb0
	rts
chiffres: dc.b "0123456789ABCDEF"

	; ici pour tous: A1 d‚part, D1 nombre de lignes
Dump_comm:	
	move.l d1,d3
	move.l a1,a3
	lea autobits+1(pc),a0
	btst #4,(a0)		; auto Dback ?
	beq.s .lb2
	bsr Dback			; si oui, retour … la position sauv‚e
.lb2:
	clr.l -(sp)
	GEMDOS 32,6
	lea stack(pc),a0
	move.l d0,(a0)		; conserve stack
	move.l a3,a1
	move.l d3,d1
	bra.s .loop
.encore:
	move.l d1,-(sp)
	move.l a1,-(sp)
	bsr Dcr
	move.l (sp)+,a1
	lea nombre(pc),a2
	move.l a1,d0			; d'abord l'adresse
	moveq #15,d1
	moveq #7,d2
.adr:
	rol.l #4,d0
	move.l d0,d3
	and.l d1,d3
	move.b chiffres(pc,d3.l),(a2)+
	dbf d2,.adr
	move.w #' |',(a2)+
	move.b #' ',(a2)+
	lea 50(a2),a3			; zone pour caractŠres
	moveq #15,d2
	moveq #0,d0
.lb0:
	moveq #32,d3			; par d‚faut, 32 pour remplacer z‚ro
	move.b (a1)+,d0		; l'octet
	beq.s .lb1
	move.b d0,d3			; si non nul, on l'affiche dans la zone caractŠres
.lb1:
	move.b d3,(a3)+		; zone caractŠres
	move.b d0,d3
	and.l d1,d3
	lsr #4,d0
	move.b chiffres(pc,d0.l),(a2)+	; zone hexa
	move.b chiffres(pc,d3.l),(a2)+
	move.b #' ',(a2)+
	dbf d2,.lb0
	clr.b (a3)				; fin de zone caractŠres
	move.b #'|',(a2)+
	move.b #' ',(a2)+		; et relie les deux zones
	move.l a1,-(sp)
	lea nombre(pc),a0
	bsr string_display
	move.l (sp)+,a1
	move.l (sp)+,d1
.loop:
	dbf d1,.encore
	move.l stack(pc),-(sp)	; r‚cupŠre stack
	GEMDOS 32,6				; retour au mode utilisateur
	rts


	; chaine Dtype		(d‚pile selon bit3)
		
Dtype:
	move.l (a6),a0
	bsr string_display
	lea autobits(pc),a0
	btst #3,1(a0)			; auto dup pour les chaines ?
	bne.s .fin
	addq.l #4,a6			; pas de auto dup, d‚pile !
.fin:
	rts
	
	; pour Dkey et Dconfig, on doit basculer sur l'‚cran Debug
	; rien ne se passe si carte graphique.

enter_debug_screen:
	move.b mode(pc),d0	; si FF, pas de bascule car carte graphique
	bne.s .ok
	lea alt_help_flag(pc),a0
	tst.b (a0)	; si FF d‚j… sur l'‚cran Debug
	bne.s .ok
	; ici mode 2 ‚crans, on rebascule sur ‚cran debug
	; pour faire l'attente de la touche
	move.b #$FE,(a0)				; flag DEBUG on, mais tout … fait FF
	pea bascule_ecran_debug(pc)
	XBIOS 38,6						; ex‚cute en superviseur
.ok:
	rts

leave_debug_screen
	move.b mode(pc),d0	; si FF, pas de bascule car carte graphique
	bne.s .fin
	lea alt_help_flag(pc),a0
	cmp.b #$FE,(a0)		; est-ce rest‚ FE?
	bne.s .fin				; non, donc il y a eu d'autres bascules utilisateur
	; ici Dkey a bascul‚ sur ‚cran Debug et rien n'a ‚t‚ touch‚
	; donc on revien … l'‚cran utilisateur
	sf (a0)
	pea bascule_ecran_normal(pc)
	XBIOS 38,6
.fin:
	rts

	; affiche une flŠche et attend un changement de CapLock
	; puis remet Capslock dans son ‚tat
		
Dkey:
	bsr.s enter_debug_screen
	moveq #16,d0
	bsr _Dsave						; conserve la position
	lea fleche(pc),a0
	bsr string_display
	move.l kbshift(pc),a0
	btst #4,(a0)
	beq.s .bas
.haut:				; ici CapsLock ‚tait mis
	btst #4,(a0)
	bne.s .haut		; attend qu'on l'enlŠve
	bset #4,(a0)	; et le remet
	bra.s .out
.bas:					; ici CapsLock pas mis
	btst #4,(a0)	; attend qu'on le mette
	beq.s .bas
	bclr #4,(a0)	; et l'enlŠve
.out:
	moveq #16,d0
	bsr _Dback				; remet le curseur
	lea spaces(pc),a0
	bsr string_display	; efface la flŠche par des espaces
	moveq #16,d0
	bsr _Dback				; remet encore le curseur
	bsr leave_debug_screen
	rts

	; efface la ligne en cours et revient au d‚but
		
Dnewl:
	move dline(pc),d0
	lea curend(pc),a0
	move.l (a0),a1			; curend
	move.l a1,a2
	sub d0,a1			; d‚but de ligne
	move.l a1,-(a0)	; nouveau curseur en d‚but de ligne
	muls fonth(pc),d0	; *7 ou 15 lignes de plus
	add.l d0,a2			; fin complŠte de la ligne
	bsr clear_line
	rts

	; Dump+ avance dans le Dump et affiche
Dumpp:
	lea dumpadr+4(pc),a0
	move (a0),d1			; nombre de lignes
	move.l -(a0),a1
	move d1,d0
	lsl #4,d0				; *16
	add d0,a1
	move.l a1,(a0)			; et l'ajoute … l'adresse de d‚part
	bra Dump_comm

	; Dump- avance dans le Dump et affiche
Dumpm:
	lea dumpadr+4(pc),a0
	move (a0),d1			; nombre de lignes
	move.l -(a0),a1		; adresse d‚part
	move d1,d0
	lsl #4,d0				; *16
	sub d0,a1
	move.l a1,(a0)			; et l'enlŠve … l'adresse de d‚part
	bra Dump_comm

	; adr n Dump  : dump n lignes de 16 caractŠres … partir de adr
	;					conserve adr et n pour Dump+/-

Dump:
	lea dumpadr(pc),a0
	move.l (a6)+,d1		; nombre de lignes
	move.l (a6)+,a1
	move.l a1,(a0)+	; adresse de d‚part
	move d1,(a0)+			; et nombre de lignes
	bra Dump_comm

; a0: chaine
; dline: d‚calage d'une ligne … l'autre
; curptr: adresse courante du curseur
; curend: adresse fin de ligne courante
; fonth: hauteur de fonte-1
; physbase: adresse ‚cran

string_display:
	movem.l a4-a5,-(sp)
	move.w dline(pc),d0		; d‚calage par ligne
	move.l curptr(pc),a1
	move.l curend(pc),a2
	move.l fonte+8(pc),a3
.encore:
	moveq #0,d1
	move.b (a0)+,d1			; caractŠre
	beq.s .fin
	cmp.l a1,a2					; fin de ligne?
	bne.s .lb0
	movem.l d0-d1/a0/a3,-(sp)
	lea curptr(pc),a0
	move.l a1,(a0)+			; sauvegarde les pointeurs
	move.l a2,(a0)+
	bsr Dcr						; saut le ligne et scroll ‚ventuel
	lea curptr(pc),a0
	move.l (a0)+,a1			; nouveau pointeur curseur
	move.l (a0)+,a2			; nouvelle fin de ligne	
	movem.l (sp)+,d0-d1/a0/a3
.lb0:
	lea 0(a3,d1),a4			; pointe sur le bon caractŠre
	move fonth(pc),d1
	move.l a1,a5
.lb1:
	move.b (a4),(a5)			; copie les n lignes du caractŠre
	add #256,a4
	add d0,a5
	dbf d1,.lb1
	addq.l #1,a1				; d‚cale d'un caractŠre … droite
	move.b mode+1(pc),d1
	bne.s .encore				; en ST Mono, tout en bon
	move.l a1,d1				; en ST Moyenne, faut voir...
	btst #0,d1
	bne.s .encore				; adresse impaire OK
	addq.l #2,a1				; sinon, saute le second plan
	bra.s .encore	
.fin:
	lea curptr(pc),a0
	move.l a1,(a0)+			; nouveau pointeur curseur
	move.l a2,(a0)+			; nouvelle fin de ligne
	movem.l (sp)+,a4-a5
	rts			

Dsave:
	moveq #8,d0
_Dsave:
	lea curptr(pc),a0
	lea 0(a0,d0.l),a1
	move.l (a0)+,(a1)+	; sauve curptr
	move.l (a0),(a1)		; et curend
	rts
	
Dback:
	moveq #8,d0
_Dback:
	lea curptr(pc),a0
	lea 0(a0,d0.l),a1
	move.l (a1)+,(a0)+	; restaure curptr
	move.l (a1),(a0)		; et curend
	rts
	
Dconfig:
	movem.l a4-a6,-(sp)
	bsr Dcls
	bsr enter_debug_screen
	lea nombre(pc),a6		; sauvera les pointeurs ‚cran des diff‚rentes lignes
	lea menu(pc),a5		; adresses des lignes
	move menu_end(pc),d7 ; pour la boucle
	move d7,d6
.aff_init:					; ici affiche les lignes du menu
	bsr Dcr
	lea curptr(pc),a0
	move.l (a0)+,(a6)+
	move.l (a0)+,(a6)+	; conserve curptr et curend de cette ligne
	lea menu(pc),a0
	add.w (a5)+,a0			; adresse chaine
	bsr string_display
	dbf d6,.aff_init
	moveq #0,d5				; ligne avec curseur par d‚faut, celle du haut
.update_flags:
	lea nombre+8(pc),a6	; pointe sur la premiŠre ligne
	moveq #0,d6				; idem
.lb0:
	lea curptr(pc),a0
	move.l (a6)+,(a0)+	; curptr
	move.l (a6)+,(a0)+	; curend
	lea nombre(pc),a0
	moveq #32,d0			; espace
	cmp d6,d5				; ligne en cours?
	bne.s .lb1				; non
	moveq #'>',d0			; oui, marquer
.lb1:
	move.b d0,(a0)+
	move.b #'O',(a0)+
	move.w #'FF',d0		; OFF par d‚faut
	lea autobits+1(pc),a1
	btst d6,(a1)
	beq.s .lb2
	move #'N ',d0			; sinon ON
.lb2:
	move d0,(a0)+
	clr.b (a0)
	subq.l #4,a0			; retour au d‚but de chaine
	bsr string_display
	addq #1,d6				; ligne/bit suivant
	cmp d6,d7				; fin?
	bne.s .lb0				; on affiche la suite
.key:
	move.l #$20002,-(sp)
	trap #13					; attend une touche
	addq.l #4,sp
	cmp.b #$1b,d0			; ESC?
	beq.s .quit
	cmp.b #$0d,d0			; Enter?
	beq.s .modif_bit
	cmp.b #$20,d0			; espace?
	beq.s .modif_bit
	tst d0					; touche $xx0000 ?
	bne.s .key				; non, donc touche non valide
	swap d0					; r‚cupŠre code clavier
	cmp.b #$4d,d0			; ->
	beq.s .modif_bit
	cmp.b #$4b,d0
	bne.s .lb3
.modif_bit:
	lea autobits+1(pc),a0
	bchg d5,(a0)			; change l'‚at du bit courant
	bra.s .update_flags	; et r‚affiche
.lb3:
	cmp.b #$48,d0			; flŠche haut
	bne.s .lb4
	tst d5
	beq.s .key				; d‚j… z‚ro, donc on ne monte plus
	subq #1,d5
	bra .update_flags
.lb4:
	cmp.b #$50,d0			; flŠche bas
	bne.s .key				; touche non valide
	addq #1,d5
	cmp d5,d7				; arriv‚ au bout?
	bne .update_flags		; non, on descend et met … jour
	subq #1,d5				; sinon, retour...
	bra.s .key	
.quit:
	bsr Dcr
	bsr leave_debug_screen
	bsr.s bomb_modif		; est-ce que le bit "bombs" a ‚t‚ chang‚?
	movem.l (sp)+,a4-a6
	rts

	; affiche la pile
Dps:
	moveq #11,d0			; mot depth
	bsr exec_forth
	move.l (a6)+,d7		; taille pile
	move.l a6,-(sp)
	move.l standard(pc),a0
	tst.b (a0)				; 00 si du sommet vers la base
	beq.s .boucles2b
	move.l d7,d0
	lsl.l #2,d0
	lea 0(a6,d0.l),a6		; pointe sur la base
	bra.s .boucleb2s
.lb1:
	subq.l #4,a6
	bsr int_to_str
	bsr string_display
	bsr Dspace
.boucleb2s:
	dbf d7,.lb1
	bra.s .exit	
.lb0:
	bsr int_to_str
	bsr string_display
	bsr Dspace
	addq.l #4,a6
.boucles2b:
	dbf d7,.lb0
.exit:
	move.l (sp)+,a6
	rts

bomb_modif:
	lea bomb_flag(pc),a0
	move autobits(pc),d0
	btst #5,d0				; demande de bombes?
	bne.s .lb0				; oui !
	tst.b (a0)				; non, et pas install‚?
	beq.s .fin				; tout en place
	; ici on d‚sinstalle
	sf (a0)					; annule le flag
	pea .uninstall(pc)
	bra.s .lb1
.lb0: tst.b (a0)			; bombes install‚es?
	bne.s .fin				; tout est d‚j… en place
	; ici on installe les bombes	
	st (a0)					; met le flag
	pea .install(pc)
.lb1:
	XBIOS 38,6
.fin:
	rts
.install:
;	lea bus_error(pc),a1
;	move.l a1,$a8.w
;	rts

	lea 8.w,a0
	lea vector_save(pc),a2
	lea bus_error(pc),a1
	move.l (a0),(a2)+
	move.l a1,(a0)+
	lea adress_error(pc),a1
	move.l (a0),(a2)+
	move.l a1,(a0)+
	lea illegal_instruction(pc),a1
	move.l (a0),(a2)+
	move.l a1,(a0)+
	lea div0_error(pc),a1
	move.l (a0),(a2)+
	move.l a1,(a0)+
	lea priv_error(pc),a1
	move.l (a0),(a2)+
	move.l a1,8(a0)	
	rts
.uninstall:
;	rts
	
	lea 8.w,a0
	lea vector_save(pc),a2
	move.l (a2)+,(a0)+	; bus
	move.l (a2)+,(a0)+	; addr
	move.l (a2)+,(a0)+	; ill
	move.l (a2)+,(a0)+	; div0
	move.l (a2)+,8(a0)	; priv
	rts

bus_error:
	move.l d0,-(sp)
   moveq #'2',d0
   bra.s error_comm
   
adress_error:
	move.l d0,-(sp)
   moveq #'3',d0
   bra.s error_comm

illegal_instruction:
	move.l d0,-(sp)
   moveq #'4',d0
   bra.s error_comm

div0_error:
	move.l d0,-(sp)
   moveq #'5',d0
   bra.s error_comm
   
priv_error:
	move.l d0,-(sp)
	moveq #'8',d0

error_comm:
	move.l a0,-(sp)
	lea registre(pc),a0
	move.l (sp)+,32(a0)		; sauve A0
	move.l (sp)+,(a0)			; sauve D0
   move.l flags(pc),a0
   tst.b 14(a0)				; version 68030 ?
   bne.s .lb0					; oui, on passe
	cmp #'3',d0					; sur 68000, 2 ou 3 ont un format sp‚cial
	bhi.s .lb1
	addq.l #8,sp				; vire les infos inutiles
	bra.s .lb1	
.lb0:
   and.b #$f,6(sp)			; sur 68030, format 0 de sauvegarde!
.lb1:
	lea registre(pc),a0
  	move.l 2(sp),64(a0)		; le PC !
   lea supervisor(pc),a0
   bclr #5,(sp)				; vire le bit superviseur au cas o—..
   sne (a0)						; marque superviseur
   beq.s .normal				; en mode utilisateur, tout va
   move.l d0,a0				; sauve le nø d'erreur
   move (sp),d0				; r‚cupŠre le sr
   move.l system_stack(pc),a7		; reprend la pile systŠme
   subq.l #6,sp
   move d0,(sp)				; remet le sr
   move.l a0,d0				; r‚cupŠre l'erreur
.normal:
	lea traite_error(pc),a0
   move.l a0,2(sp) 			; mon PC
	rte

traite_error:
	lea registre(pc),a0
	movem.l d1-d7,4(a0)
	movem.l a1-a7,36(a0)
	move.l forth_stack(pc),a7	; valeur acceptable
	move.l d0,-(sp)
	bsr Dcr
	move.l (sp)+,d0
	lea err0(pc),a0
	move.b d0,(a0)				; nombre de bombes
	lea err2(pc),a1
	sub #'2',d0
	beq.s .ok
	lea err3(pc),a1
	subq #1,d0
	beq.s .ok
	lea err4(pc),a1
	subq #1,d0
	beq.s .ok
	lea err5(pc),a1
	subq #1,d0
	beq.s .ok
	lea err8(pc),a1
.ok:
	move.l a1,-(sp)
	bsr string_display		; combien de bombes
	move.l (sp)+,a0
	bsr string_display		; type d'erreur
	lea err6(pc),a0
	bsr string_display		; "… l'adresse pc="
	move.l registre+64(pc),d0	; adresse de l'erreur
	bsr d0_in_hex
	bsr string_display		; et l'affiche !
	bsr Dcr
	lea cpu_state(pc),a0		; cpu was in...
	bsr string_display
	lea cpu_user(pc),a0		; ... user mode
	move.b supervisor(pc),d0
	beq.s .user
	lea cpu_super(pc),a0		; ... supervisor mode
.user:
	bsr string_display
	bsr Dcr
	lea registre(pc),a6
	moveq #16,d6
	lea reg(pc),a0
	move.b #'D',1(a0)
	move.b #'0',2(a0)
.loop:
	lea reg(pc),a0
	bsr string_display		; nom du registre
	move.l (a6)+,d0
	bsr d0_in_hex
	bsr string_display		; son contenu
	lea reg(pc),a0
	addq.b #1,2(a0)			; registre suivant
	subq #1,d6
	cmp #8,d6
	bne.s .lb0
	move.b #'A',1(a0)			; aprŠs les 8 Dn, ce sont les An
	move.b #'0',2(a0)
.lb0:
	move d6,d0
	and.b #$3,d0
	bne.s .loop					; pas un multiple de 4, retour normal
	move.l d6,-(sp)			; pr‚serve D6 ‚cras‚ lors d'un scroll
	bsr Dcr						; sinon saut de ligne
	move.l (sp)+,d6
	bne.s .loop					; si pas fini, boucle!
	lea pc_loc(pc),a0
	bsr string_display		; pc is located ...
	move.l registre+64(pc),a1
	bsr locate_address
	move.l d0,-(sp)
	bsr string_display
	bsr Dcr
	move.l (sp)+,d0			; code de localisation
	moveq #1,d7					; 1 pour PC
	bsr address_info			; cherche si on peut donner plus d'infos sur PC
	bsr Dcr
	lea a5_loc(pc),a0
	bsr string_display		; a5 is located ...
	move.l registre+52(pc),a1
	bsr locate_address
	move.l d0,-(sp)
	bsr string_display
	bsr Dcr
	move.l (sp),d0
	moveq #0,d7					; 0 pour A5
	bsr address_info			; cherche plus d'infos sur A5
	move.l (sp)+,d0			; code zone
	bsr last_next_words		; si A5 correct, done le dernier mot et le suivant	
	bsr Dcr		
	bsr Dkey						; attends une touche
	moveq #23,d0
	bsr exec_forth				; sp!
	moveq #19,d0
	bsr exec_forth				; rp!
	move.l basepage(pc),a0
	jmp 256+6(a0)				; routine d‚but pour r‚initialiser le prompt

	; a1 adresse … inspecter
	; renvoie dans D0:
	; 0 en dehors des zones FORTH
	; 1 zone TEXT
	; 2 zone DATA
	; 3 zone BSS
	; 4 dicco allou‚
	; 5 dicco libre
	; A1 non modifi‚
	; a0 pointe sur la chaine pour affichage
locate_address:
	lea adresse(pc),a3
	cmp.l 24(a3),a1		; debut_prog
	bcs.s .pas_prog
	cmp.l 28(a3),a1		; fin prog
	bcc.s .pas_prog
	move.l 40(a3),a3		; adresse topprg
	moveq #4,d0				; d‚faut dans la zone user utilis‚e
	lea pc_loc4(pc),a0	
	cmp.l (a3),a1
	bcs.s .ok				; en dessous c'est bon
	moveq #5,d0				; sinon, en zone libre
	lea pc_loc5(pc),a0	
.ok:
	rts
.pas_prog:
	moveq #0,d0				; defaut "en dehors"
	lea pc_loc0(pc),a0	
	move.l 44(a3),a3		; basepage
	cmp.l 8(a3),a1			; adresse TEXT
	bcs.s .ok				; en dessous, fini
	moveq #1,d0				; suppose en zone TEXT
	lea pc_loc1(pc),a0	
	cmp.l 16(a3),a1		; adresse DATA
	bcs.s .ok
	moveq #2,d0				; suppose en zone DATA
	lea pc_loc2(pc),a0	
	cmp.l 24(a3),a1		; adresse BSS
	bcs.s .ok
	moveq #3,d0				; suppose en zone BSS
	lea pc_loc3(pc),a0	
	move.l 24(a3),d1
	add.l 28(a3),d1		; fin BSS
	cmp.l d1,a1
	bcs.s .ok
	moveq #0,d0				; si en dehors du BSS, alors "outside FORTH"
	lea pc_loc0(pc),a0	
	bra.s .ok

	; d7=1 PC, d7=0 A5
	; D0 code zone
address_info:
	tst d0
	bne.s .lb0
	rts								; en dehors, rien … analyser
.lb0:
	tst d7
	bne.s .is_pc
	move.l registre+52(pc),a5	; A5 !
	cmp #3,d0						; zone BSS?
	bne.s .lb1
	lea comment1(pc),a0			; affiche "exebuf"
	bra.s .disp_exit
.lb1:
	cmp #2,d0						; zone DATA?
	bne.s .lb2
	move.l flags(pc),a0
	tst.b 13(a0)					; sommes nous sous l'interpr‚teur?
	bne.s .unexp					; oui, pas normal!
.lb3:
	lea comment0(pc),a0
	bsr string_display			; possibly in word...
	bsr cherche_mot_user
	bra.s .disp_exit	
.lb2:
	cmp #4,d0						; zone USER ?
	beq.s .lb3
	; sinon, unexpected !
.unexp:
	lea comment2(pc),a0	
.disp_exit:
	bsr string_display
	rts
.is_pc:
	move.l registre+64(pc),a5	; le PC
	cmp #1,d0						; zone TEXT ?
	bne.s .lb4	
	lea comment0(pc),a0			; possibly in word...
	bsr string_display
	bsr cherche_mot_forth
	bra.s .disp_exit
.lb4:
	cmp #2,d0						; zone DATA?
	bne.s .lb5
	move.l flags(pc),a0
	tst.b 13(a0)					; sommes nous sous l'interpr‚teur?
	bne.s .unexp					; oui, pas normal!		
	bra.s .lb3						; sinon, cherche mot user	
.lb5:
	cmp #4,d0						; zone USER
	beq.s .lb3						; oui, cherche mot user
	bra.s .unexp					; autres cas, pas normal

cherche_mot_forth:
	move.l diko(pc),d7			; limite des mots … chercher
	move.l adresse(pc),a0		; d‚but du tableau
	bra.s _cherche

cherche_mot_user:
	move.l adresse(pc),a0
	move.l diko(pc),d0
	moveq #0,d7
	move.l forth(pc),a1
	move (a1),d7					; total de mots
	sub d0,d7						; total de mots user	
	lsl.l #2,d0
	add.l d0,a0						; d‚but des mots user
	
_cherche:
	sub.l a1,a1						; meilleure adresse
	bra.s .loop
.lb0:
	move.l (a0)+,d0				; nouvelle adresse
	cmp.l d0,a5						; il faut a5>=(a0)
	bcs.s .loop
	cmp.l d0,a1						; et a1<(a0) (meilleure approche)	
	bcc.s .loop
	move.l d0,a1					; alors, on prend (a0) comme meilleure approximation
	lea -4(a0),a2					; conserve l'adresse de l'adresse
.loop:
	dbf d7,.lb0
	cmp.l #0,a1						; a1 toujours nul?
	bne.s .lb1
	lea comment3(pc),a0			; si oui, not found
	rts
.lb1:
	sub.l adresse(pc),a2
	move.l a2,d0
	lsr.l #2,d0						; num‚ro du mot trouv‚
	bsr d0_in_word
	rts	

	; d0 = num‚ro du mot
	; renvoie A0 la chaine du mot
d0_in_word:
	move.l ordres(pc),a0
	moveq #0,d1
	bra.s .loop
.lb0:
	move.b (a0)+,d1		; saute d0 mots
	add.l d1,a0	
.loop:
	dbf d0,.lb0
	lea nombre(pc),a1
	move.b (a0)+,d1
	bra.s .copy
.lb1:
	move.b (a0)+,(a1)+	; copie le mot trouv‚
.copy:
	dbf d1,.lb1
	clr.b (a1)				; fin de chaine
	lea nombre(pc),a0
	rts

last_next_words:
	cmp #4,d0
	bhi.s .exit				; pas la bonne zone
	cmp #2,d0
	bcs.s .exit				; idem
	bne.s .ok				; si pas DATA, toujours valide
	move.l flags(pc),a0
	tst.b 13(a0)
	bne.s .exit				; DATA et interpr‚teur, pas valide
.ok:
	move.l registre+52(pc),d0	; pointeur A5
	btst #0,d0
	bne.s .exit				; si impair, invalide
	move.l d0,a5			; sinon, valide, on affiche !
	subq.l #2,a5
	lea a5_last(pc),a0
	bsr .one_line
	lea a5_next(pc),a0
	bsr .one_line
.exit:
	rts
.one_line:
	move.l a0,-(sp)
	bsr Dcr	
	move.l (sp)+,a0
	bsr string_display
	move (a5)+,d0
	bsr d0_in_word
	bsr string_display
	rts
	
	
	data
	
	; ne pas s‚parer
block:  dc.l 0				; adresse second ‚cran si allocation
old_alt_help: dc.l 0		; et ici on sauvegarde l'adresse Alt-Help
	; jusqu'ici

fleche: dc.b 32,3,0
spaces: dc.b 32
espace: dc.b 32,0
	even
table:  dc.l 1000000000
		  dc.l 100000000
		  dc.l 10000000
		  dc.l 1000000
		  dc.l 100000
		  dc.l 10000
		  dc.l 1000
		  dc.l 100
		  dc.l 10
		  dc.l 1
		  dc.l 0
sortie:
	dc.b "DEBUG module uninstalled, press CapsLock",0

	; bit0 : auto space … chaque ‚criture? (defaut OUI)
	; bit1 : auto cr … chaque ‚criture? (defaut NON)
	; bit2 : auto DUP pour conserver les valeurs? (defaut OUI)
	; bit3 : auto DUP pour les chaines? (defaut NON)
	; bit4 : auto Dback avant chaque Dump/+/- (d‚faut NON)
	; bit5 : capturer erreurs bombes

conf0:
	dc.b "-- Configuration (Esc to Quit) --",0
conf1:
	dc.b ">OFF Auto space",0
conf2:
	dc.b ">OFF Auto CR",0
conf3:
	dc.b ">OFF Auto DUP values",0
conf4:
	dc.b ">OFF Auto DUP strings",0
conf5:
	dc.b ">OFF Auto Dback before Dump",0
conf6:
	dc.b ">OFF Catch BOMB errors",0
	
err0: dc.b "x BOMBS : ",0
err2: dc.b "Bus error",0
err3: dc.b "Address error",0
err4: dc.b "Illegal instruction",0
err5: dc.b "Divide by zero",0
err8: dc.b "Privilege Violation",0
err6: dc.b " at address PC=",0
reg: dc.b " D0 = ",0
pc_loc: dc.b "PC is located ",0
pc_loc0: dc.b "outside FORTH",0
pc_loc1: dc.b "in TEXT zone",0
pc_loc2: dc.b "in DATA zone",0
pc_loc3: dc.b "in BSS zone",0
pc_loc4: dc.b "in USER zone",0
pc_loc5: dc.b "in USER free zone",0
a5_loc: dc.b "Interpretation pointer A5 is located ",0
a5_last: dc.b "  Last executed word was   : ",0
a5_next: dc.b "  Next word to be executed : ",0
comment0: dc.b "  -> possibly in word ",0
comment1: dc.b "  -> possibly in exec buffer (command line for example)",0
comment2: dc.b "     This is unexpected!",0
comment3: dc.b "(not found)",0
cpu_state: dc.b "  CPU was in ",0
cpu_user: dc.b "User mode",0
cpu_super: dc.b "Supervisor mode",0

	
alt_help_flag: dc.b 0	; 0 si ‚cran normal, FF si ‚cran debug (en mode 1 seul ‚cran)
bomb_flag: dc.b 0			; 0 pas d'interception, FF bombes intercept‚es
supervisor: dc.b 0		; 00 bombes depuis User, FF depuis Superviseur

	even

menu:	dc.w conf0-menu,conf1-menu,conf2-menu,conf3-menu,conf4-menu,conf5-menu,conf6-menu
menu_end: dc.w (menu_end-menu)/2-1

	bss

; ne pas s‚parer
usradr: ds.l 1		; 1ere adresse libre dans le systŠme
fonte: ds.l 1		; adresse fonte 8*8 systŠme
		 ds.l 1		; adresse fonte 8*16 systŠme
		 ds.l 1		; adresse fonte courante
fonth: ds.w 1		; hauteur-1 de la fonte
; jusqu'ici
; ne pas s‚parer
dline: ds.w 1		; d‚calage en octets d'une ligne … l'autre
physbase: ds.l 1	; adresse base ‚cran
physend:	ds.l 1	; adresse fin ‚cran
curptr: ds.l 1		; pointeur du curseur dans l'‚cran
curend: ds.l 1		; pointeur de fin de ligne dans l'‚cran
curptr_sav: ds.l 1 ; pointeur sauv‚
curend_sav: ds.l 1 ; idem	
curptr_sav_dkey: ds.l 1 ; idem pour Dkey et effa‡age de la flŠche
curend_sav_dkey: ds.l 1 ;
; jusque l…
nombre: ds.b 80	; pour afficher un nombre ou un dump
						; nombre sert aussi dans Dconfig pour sauver des pointeurs
dumpadr: ds.l 1	; adresse de d‚part du dump
dumpn: ds.w 1		; nombre de lignes … afficher
stack: ds.l 1
	; ne pas s‚parer
mode:	 ds.w 1		; mode graphique
						; Hbyte = FF si carte graphique en plus, OO si un seul ‚cran
						; Lbyte = FF si monochrome sur 2e ecran, 00 si ST Medium
video: ds.l 1		; le cookie pour s‚parer TT et autres
	; jusque l…
logbase: ds.l 1	; adresse ‚cran logique
save_screen: ds.w 5	; pour sauver les paramŠtres ‚cran lors de la bascule Alt+HELP
physbase_save: ds.l 1	; adresse ‚cran utilisateur pour bascule

	; ne pas s‚parer
adresse: ds.l 1	; + 00 base des mots forth
standard: ds.l 1	; + 04 adresse flag pour le sens d'affichage de la pile
fpt: ds.l 2			; + 08 adresse subaff + buffer texte pour affichage r‚el
ordres:	ds.l 1	; + 16 mots du dictionnaire
diko:	ds.l 1		; + 20 nombre de mots de base dans le FORTH
debut_prog:	ds.l 1; + 24 d‚but du bloc dictionnaire
fin_prog: ds.l 1	; + 28 et sa fin (octet qui suit)
flags:	ds.l 1	; + 32 adresse des 16 flags (bytes)
forth:	ds.l 1	; + 36 adresse du WORD contenant le nombre total de mots

topprg:	ds.l 1	; + 40 adresse variable pointeur courant dans dictionnaire
basepage: ds.l 1	; + 44 adresse basepage
	; jusque l…

forth_stack: ds.l 1	; pile FORTH … restaurer
system_stack: ds.l 1	; pile systŠme … restaurer (si appel superviseur)
registre: ds.l 17	; d0-d7, a0-a7 et PC
vector_save: ds.l 5	; 5 adresses d'erreur BOMBS 2 … 5 + 8

	end