; --- maniŠre de noter une ligne devenue inutile
; du moins on le suppose...


STE equ 0  ; 1 pour STE, 0 pour TT et Falcon

LANG equ 0 ; 0 = francais, 1 = anglais

DEFNUM	equ 8 ; limite des premiers mots cr‚ant d'autres (variable..)

VERSION macro
	dc.b "0.8.3"
	endm

DATE macro
	if LANG=0
		dc.b "16/05/2026"
	else
		dc.b "05/16/2026"
	endif
	endm


;*************************************
;*                                   *
;*       F O R T H     1989          *
;*                                   *
;*************************************


	if STE=0
		if LANG=0
   		OUTPUT "FORTH.PRG"
   	else
   		OUTPUT "ENGLISH\FORTH.PRG"
   		opt D-
   	endif
   	opt w+,P=68030,P=68882
   else
   	if LANG=0
      	OUTPUT "FORTHSTE.PRG"
      else
      	OUTPUT "ENGLISH\FORTHSTE.PRG"
      	opt D-
      endif
   	opt w+,P=68000
   endif

TRC MACRO
   movem.l d0-d2/a0-a1,-(sp)
	move #7,-(sp)
	move #2,-(sp)
	move #3,-(sp)
	trap #13
	addq.l #6,sp
	move.l #$20002,-(sp)
	trap #13
	addq.l #4,sp
	movem.l (sp)+,d0-d2/a0-a1
	ENDM

NON MACRO
   dc.w 0
   ENDM

GOSUB MACRO
	if STE=0
		bsr.l \1
	else
		jsr \1
	endif
	ENDM

GOSUB2 MACRO
	if STE=0
		bsr \1
	else
		jsr \1
	endif
	ENDM

	; dernier label utilis‚ y235
COPIE MACRO         ; debut, fin [ , flag-FORTH.LIB ]
   ifd   LIB
      if \#=3
         dc.w 3   ; si LIB et 3 arguments, pas de copie mais SAUT
      else
         dc.w ((\2-\1)/2-1)
         dc.w 2
      endif
   else
      dc.w ((\2-\1)/2-1)   ; nombre de mots moins 1 ( dbra )
      dc.w 2
   endif
   ENDM

; copie optimis‚e si l'instruction pr‚c‚dente est une constante
; and/or/xor

COPIE_OPT4 MACRO         ; debut, fin, code instruction
	dc.w \3			 ; instruction rempla‡ant move.l #xxx,-(a6)
   dc.w ((\2-\1)/2-1)   ; nombre de mots moins 1 ( dbra )
   dc.w $4002
   ENDM

; optimisation pour add/sub (avec addq/subq possible)

COPIE_OPT5 MACRO         ; debut, fin, code instruction
	dc.w \3			 ; instruction rempla‡ant move.l #xxx,-(a6)
   dc.w ((\2-\1)/2-1)   ; nombre de mots moins 1 ( dbra )
   dc.w $5002
   ENDM

; optimisation pour <,>,=,<>

COPIE_OPT6 MACRO         ; debut, fin
   dc.w ((\2-\1)/2-1)   ; nombre de mots moins 1 ( dbra )
   dc.w $6002
   ENDM

SAUT MACRO
   dc.w 3
   ENDM

ASS MACRO
   dc.w \1
   ENDM

UP MACRO
   addq.l #4,a6
   ENDM

DW MACRO
   subq.l #4,a6
   ENDM

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

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

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

VCONTROL MACRO      ; fn,pts,int,subfn
	if STE=0
	   lea (control.l,pc),a0
	else
		lea control,a0
	endif
   move #\1,(a0)+
   move #\2,(a0)
   addq.l #4,a0
   move #\3,(a0)
   addq.l #4,a0
   move #\4,(a0)+
   move handle,(a0)
   ENDM

VDI MACRO
   move.l #vdipb,d1
   moveq #$73,d0
   trap #2
   ENDM

AES MACRO
   move.l #aespb,d1
   move.l #$c8,d0
   trap #2
   ENDM

ACONTROL MACRO         ;   fn,int,into,add
   if STE=0
	   lea (control.l,pc),a0
	else
		lea control,a0
	endif
   move #\1,(a0)+
   move #\2,(a0)+
   move #\3,(a0)+
   move #\4,(a0)+
   clr (a0)
   ENDM

GEM_AES MACRO
   move.l #\1,d1
   move.l #$c8,d0
   trap #2
   ENDM

GEM_VDI MACRO
   move.l #\1,a0
   move.l a0,d1
   move.l (a0),a0
   move i_handle,12(a0)
   moveq #$73,d0
   trap #2
   ENDM

 data
 even

	; ne pas s‚parer
aespb: dc.l control,global,intin,intout,addrin,addrout
vdipb: dc.l control,intin,ptsin,intout,ptsout
	; jusqu'ici

shel_find2: dc.l sf_cont,global,dum,intout,rsc_name,dum
sf_cont: dc.w 124,0,1,1,0
rsc_name: dc.l chedef

; --- vdiedit: dc.l contedit,intedit,dum,dum,dum
; --- vdifen: dc.l contedit,intfen,dum,dum,dum
shel_write2: dc.l sw_cont,global,sw_int,dum,sw_addrin,dum
sw_cont: dc.w 121,3,1,2,0
sw_int: dc.w 0,0,0

appl_find2: dc.l af_cont,global,dum,stguide,af_addr,dum
af_cont: dc.w 13,0,1,1,0
af_addr: dc.l acc2
acc1: dc.b "ST-GUIDE",0
acc2: dc.b "HYPVIEW ",0
	even

	if STE=0
info: dc.b "FORTH.INF",0
	else
info: dc.b "FORTHSTE.INF",0
	endif
	if LANG=0
w_titre: dc.b "Mon Bon FORTH "
	VERSION
	dc.b 0,0
w_edit: dc.b "Mon Bon Editeur",0,0
bloc0: dc.b " Aucun bloc n'est marqu‚",0
bloc1: dc.b " Un bloc est marqu‚",0
helpc: dc.b " [Esc] -> retour, -nn [Enter] pour un lien",0

 even
avert: dc.b "[2][ Inserer la diquette     | … formater | dans le lecteur "
avertd: dc.b "A ][Ca y est|Annuler]",0
avert1: dc.b "[1][ L'imprimante n'est pas | | prete … recevoir. ]"
        dc.b "[Annuler|Imprimer]",0
		even
exep0: dc.b "[1][ Alerte: x BOMBES | "
		dc.b	"                     | (Pointeur d'ex‚cution | sur la pile )][ Stop | Analyse ]",0
		even
exep2: dc.b "erreur de bus       "
exep3: dc.b "erreur d'adresse    "
exep4: dc.b "instruction ill‚gale"
exep5: dc.b "division par z‚ro   "

pasbon: dc.b "Ce n'est pas un mot utitlisateur",0

	; point en +12/13
	; x en +21
	; y en +52
alert_getp: dc.b "[2][ Point #xx : |"
		dc.b " x=xxxxxxxxxxxxxxxxxxxxxxxxxxx|"
		dc.b " y=yyyyyyyyyyyyyyyyyyyyyyyyyyy| ][ Empiler | Quitter | Vu ! ]",0

	else
w_titre: dc.b "My Good FORTH "
	VERSION
	dc.b 0,0
w_edit: dc.b "My Good Editor",0,0
bloc0: dc.b " No block selected",0
bloc1: dc.b " A block is selected",0
helpc: dc.b " [Esc] -> back, -nn [Enter] for a link",0

 even
avert: dc.b "[2][ Insery the floopy disk   | to be fomatted | into drive "
avertd: dc.b "A ][ Done | Cancel ]",0
avert1: dc.b "[1][ Printer is not | | ready. ]"
        dc.b "[ Cancel | Print ]",0
		even
exep0: dc.b "[1][ Alert : x BOMBS  | "
		dc.b	"                     | (execution pointer | left on the stack)][ Stop ][ Analysis ]",0
		even
exep2: dc.b "bus error           "
exep3: dc.b "address error       "
exep4: dc.b "illegal instruction "
exep5: dc.b "division by zero    "

pasbon: dc.b "This is not a user word",0
alert_getp: dc.b "[2][ Point #xx : |"
		dc.b " x=xxxxxxxxxxxxxxxxxxxxxxxxxxx|"
		dc.b " y=yyyyyyyyyyyyyyyyyyyyyyyyyyy| ][ Stack it |  Quit  | Ok ! ]",0

	endif

 even

pilptr: dc.l pile+4100
topedit: dc.w 0
retptr: dc.l retour+4100
base: dc.l 10
indptr: dc.l indice
; laisser cons‚cutifs
debutb: dc.w -1
finb: dc.w -1
ligne: dc.w -1
; jusque l…
editb: dc.w 0
trc: dc.w 0
trcmot: dc.w 0
ecran: dc.w 0
formptr: dc.l form+80
opt_count: dc.l 0					; global-4 compte les optimisations de compilb
global: dc.l 0,0,0,0,0,0,0,0
	dc.l 0	; valeur supp … global indiquant le type d'AES
				; 0: normal, 1 MyAES, 2 XaAES, 3 NAES
sizeptr: dc.w 2	; .l size par d‚faut
lstptr: dc.l arrptr+4
arrptr: dc.l lstdata
        dcb.l 10,0
lst: dc.l 0
remb: dc.l remdata
stt: dc.w 0
accuptr: dc.l accudat
isfast: dc.w 0						; par d‚faut, mode slow
isbomb: dc.w 1						; par d‚faut, vecteurs bombes d‚tourn‚s
alert_mask: dc.w -1				; toutes les alerts valid‚es par d‚faut
							; bit 0 avertir si ‚crasement fichier en sauvegarde
							; bit 1 avertir si bloc … sauvegarder au lieu de tout
							; bit 2 avertir si on quitte et que l'‚dition a chang‚ depuis
							; bit 3 warnings de compilation
dpth: dc.w 53
dpthln: dc.w 52
dpthex: dc.w 50
pilbase: dc.l pile+4100
isret: dc.w 0
help: dc.w 0
screen_percent: dc.w 100		; defaut 100% ‚cran
langage: dc.w -1				; fix‚ par FORTH.INI ou … d‚faut par la ROM


 bss
 even
			; taille pour environ 300 mots de 9 caractŠres + taille
          ds.b 3000        ; pour les ordres en fin de zone data
fin_new_names:


; ne pas s‚parer
mod_options: ds.l 1
chemin_mod:	ds.b 128
; jusqu'ici^^^

; ne pas s‚parer
;			ds.l 1	; pointeur vers retptr pour type de structure ouverte
;						; 0(do), 1(dolist), 2(ndo), 3(begin), 4(if), 5(->), 6(list)
loopnest: ds.b 12	; (0)do/(1)ndo/(2)dolist/(3)list comptage ouverture fermeture lors de la compilation
						; puis (4)begin/(5)while, (6)->, (7)if, 8(case), 9(of) et (11)warning dolist
; jusqu'ici

_argc:	ds.l 1	; nombre d'arguments sur la ligne de commande
_argv:	ds.l 64	; tableau de 64 pointeurs vers les 64 arguments
surfptr: ds.l 1	; pointeur x,y de trac‚ de surfaces dans le dictionaire
inc_ptr: ds.l 1	; pointeur sur la chaine des bloc d'>include FOR ou z‚ro
						;chaque bloc, 256 octets:
						; LONG pointeur bloc suivant
						; WORD handler fichier ouvert
						; WORD nbr de lignes restantes
						; LONG taille fichier puis sauvegarde compilptr
						; le reste correspond … une ligne du fichier + WORD taille ligne suivant
						; dernier octet du bloc = 00 (FOR), FF (DEF)
slider: ds.w 2		; valeurs de ligne d‚but et nbr lignes du slider sous l'‚diteur
in_data: ds.w 1	; garde valeur topedit en entrant dans edit
			ds.l 1	; garde valeur pointeur de fin de texte
change_flag: ds.w 1 ; FF si les donn‚es ont chang‚ entre entr‚e et sortie de edit
						; remis … z‚ro par saveb/export sur l'ensemble du fichier
zone:     ds.l 16	; sauvegarde de registres dans compil
topsav2:  ds.l 1
topsave:  ds.l 1
form:     ds.b 80
; --- trcreg:   ds.l 16
bfsize:   ds.l 1
bfptr:    ds.l 1
ksize:    ds.w 1
savpil:   ds.l 1
handle:   ds.w 1
i_handle: ds.w 1
g_handle: ds.w 1
intin:    ds.w 128
intout:   ds.w 272
i_intout: ds.w 128
addrin:   ds.l 64
addrout:  ds.l 64
ptsin:    ds.w 128
ptsout:   ds.w 128
vt_int:	ds.w 128 ; avant d‚clar‚ par dessus les 514 w de intedit
lignes:   ds.w 1
demi_ecran: ds.w 1
colonnes: ds.w 1
dum:      ds.w 2
	; un tread est organis‚ ainsi:
	; +0		*WORD code du mot … ex‚cuter	(les 4 lignes * sont la partie ex‚cutable!)
	; +2		*WORD 0 (=empiler valeur)
	; +4		*LONG id (celui pass‚ … thread, id=0 pour le mode direct)
	; +8		*WORD code thkill
	; +10		LONG next (adr next thread ou z‚ro si fin)
	; +14		LONG state (masque de bits)
	; +18		LONG a4,a5
	; +26		WORD base actuelle
	; +28    WORD station VDI ‚ventuelle...
	; +30		LONG indptr
	; +34		LONG adresse pile (pass‚e … thread)
	; +38		LONG adresse retours
	; +42		LONG adresse page(pass‚e … thread)
	; +46		128 longs (la structure indptr)
	; +558	1025 longs (la pile des retours)
	; +4658  fin retours
	; debut thread0
	; state: xxxxxxxx xxxxxxxx xxxxxxxx smtt xxvr
	; r=1 running, 0=pause (ou synch)
	; v=1 si station VDI ouverte
	; s=1 sync, m=1 syncmain, tt=indice tableau synchro 0 … 3
thread0:	ds.b 46
indice:   ds.l 128
retour:   ds.l 1025
	; fin thread0
	
vd_mesag: ds.b 16		; buffer AES pour M_PLAYER
vd_retour: ds.b 72	; infos retour M_PLAYER
vd_dialog: ds.l 7 	; routine/frame#/buffer/flag+zoom/adr mot/A6/A4
vd_id:	ds.l 1		; identifiant de M_PLAYER.ACC
stguide: ds.w 1		; ID de st-guide ou -1 si absent
thhead:	ds.l 1		; pointeur sur la tˆte de liste des threads (ou 0)
thptr:	ds.l 1		; pointeur thread courant (ou 0)
thsynctab: ds.b 4		; tableau de 4 valeurs de synchro
pile:     ds.l 1025
;debut_prog: ds.l 1	; transf‚r‚ dans extra data
program:  ds.l 1
topprg:   ds.l 1
edbuf:    ds.b 1724
edsav:    ds.b 512*4		; 4 buffers de sauvegarde
edoffset: ds.w 1			; pointeur 0,512,1024,1536 dans les buffers de sauvegarde
def:      ds.w 1
forth:    ds.w 1
forthsav: ds.w 1
dicco:    ds.w 1
sommet:   ds.l 1			; pointeur 1er libre dans la liste des mots (pointe sur un z‚ro)
somsave:  ds.l 1
mot:      ds.b 42
erreur:   ds.w 1
exebuf:   ds.b 1604
doesreg:  ds.l 2
regist:   ds.l 16
tamp:     ds.b 40
pad:      ds.b 1028
dtabuf:   ds.b 44
; laisser cons‚cutifs
fhdl:     ds.w 1
ldbuf:    ds.b 6
cmplptr:  ds.l 1
fincomp:  ds.w 1
; jusque l…
formbuf:  ds.l 1
uspile:   ds.l 1
vectbuf:  ds.l 4		; 4 vecteurs bombes
old_joyst: ds.l 1		; le vecteur joystick
old_mouse: ds.l 1
lstdata:  ds.l 256
remdata:  ds.l 50
basesav:  ds.l 1
sttdata:  ds.b 1024
sttptr:   ds.l 1
accudat:  ds.b 1024
setdat:   ds.b 8198	; ensemble de 65536 ‚l‚ments maxi
setdeb:   ds.w 1
setnbr:   ds.w 1
signe:    ds.b 1
modulo:   ds.b 1
affbuf:   ds.b 28
fixn:     ds.w 1
courant:  ds.w 1
save:     ds.l 3
szone:    ds.l 1
topmem:   ds.l 1
botmem:   ds.l 1
in_def:	 ds.w 1
; ne pas s‚parer (flags de compilation)
ass:      ds.w 1	; flag si dans un mot assembl‚
find:     ds.b 1	; flag si find au pr‚c‚dent mot
forg:		 ds.b 1	; flag si forget au pr‚c‚dent mot
; -----
but:      ds.l 2
indexadr: ds.l 1
indextab: ds.b 128
mfdb_s:   ds.w 10
mfdb_d:   ds.w 10
copy_pts: ds.w 8
mf1:      ds.w 18
mf2:      ds.w 18
edit_haut: ds.w 8
edit_bas: ds.w 8
end_keys: ds.l 1
; ne pas s‚parer
agi_intout: ds.w 5			; capacit‚s de l'AES
planes: ds.w 1
work_out: ds.w 57
; jusqu'ici
redrawdat: ds.w 6 ; flag, handle, x,y,x',y'
bspage: ds.l 1
_app_flag: ds.l 1
wd_table: ds.l 20		; 20 dialogues en fenˆtres simultan‚s
trace_win: ds.w 11	; fenetre TRACE + nombre de caractŠres par ligne
trc_aff: ds.b 200		; 160 caractŠres en 1280x960.
watchlist: ds.w 32	; 32 codes possibles … surveiller dans trace
; ne pas s‚parer
trace_flags: ds.b 4		; 0:flag R (jusqu'au retour du mot), 1:flag L (jusqu'… quitter boucle ou mot)
								; 2:flag S (single step, s'arrete au suivant)
trace_data: ds.l 1		; un long selon le flag
; jusqu'ici
commande_buf: ds.b 512	; pour >exec et >export
chedef: ds.b 80		; chemin pour *.DEF
fichdef: ds.b 100
chemin: ds.b 80		; chemin *.for
fichier: ds.b 100
source: ds.b 100
chetxt: ds.b 80		; chemin *.txt
fichtxt: ds.b 100
chehlp: ds.b 80		; chemin FORTH.HLP/HYP
hlpptr:	ds.l 1		; pointeur sur L/Y dans chehlp
chestg:	ds.b 80		; chemin de STGUIDE.APP ou HYPVIEW.APP
clipbrd: ds.b 100		; chemin d'accŠs au clipboard (avec SCRAP.TXT ajout‚)
sw_addrin: ds.l 2
gcard: ds.l 1			; vaut 0 pour un mode Shifter compatile Atari, 1 si c'est unmode de carte graphique
cpu_value: ds.l 1		; CPU cookie
mch_value: ds.l 1		; MCH cookie
snd_value: ds.l 1		; SND cookie
apk_value: ds.l 1		; APK cookie
gr3_angle: ds.l 22	; cos et sin de l'angle de rotation,-dy*sin,dy*cos,dx*cos,dx*sin,vary,varx,fakey,fakex,ymin,xmin
							; utilis‚ aussi dans gr_sbar/gr_sbarg pour la liste des tableaux.
sndb:	ds.b 128			; soundbuffer pour les modules RSN
							; 000 long type, size, uncompsize, handle
							; 016 31+0 "titre"
							; 048 31+0 "auteur"
							; 080 … voir...
							
mouse_on: ds.b 1		; flag pour laisser la souris "on"
ass_const: ds.b 1		; si constante empil‚e pour optimiser instruction suivante
is_saga:	ds.b 1
gr_plot: ds.b 1		; 00 si coupure dans une courbe, FF si relier
gr_type: ds.b 1		; 00 x,y(t)  FF y(x)
gr_3d:	ds.b 1		; FF si fonction 3d
gr_view:	ds.b 1		; 0,1,2 pour xyz, zxy, yzx
gr_rot:	ds.b 1		; FF si rotation<>0
w_flag:  ds.b 1		; FF si fenetre ouverte, 0 sinon
	even

	

 text

   jmp initial
   
	; toujours laisser cette routine aprŠs le 1er jump
	; utilis‚ par le module DEBUG entre autres.
	; debut = basepage+256+6
	
debut:
   bsr cr
   lea ok(pc),a0
   bsr write_str
   move.l edb(pc),a0     ; buffer de ligne
   tst erreur
   bne.s .suite          ; il y a eu une erreur, remet la mˆme ligne
   bsr treat_saveline
.suite: clr erreur
   clr def
   move #510,d6          ; taille maxi
   ext.l d6
   move.l #prompt_list,end_keys
   bsr edition           ; edition.
   cmp #$5400,d0			 ; Shift F1 = Help
   beq.s .lb1a
   cmp #$6200,d0			 ; help?
   bne.s .lb1
.lb1a:
   jsr help_display_prompt
   move #1,erreur			 ; astuce pour qu'il recopie la ligne en cours!
   bra.s debut
.lb1:
   cmp #$6100,d0         ; UNDO ?
   beq debut	          ; si oui, ne fait rien de cette ligne
   cmp #$5500,d0			 ; Shift F2 simule UNDO
   beq debut
   cmp #$5D00,d0			 ; Shift F10 = Shift Insert
   beq.s .lb1b
   cmp #$5230,d0         ; shift INSERT
   bne.s .quoi           ; non, ligne normale
.lb1b:
	bsr treat_shiftins
   bra.s .suite
.quoi:
   bsr cr                ; saut de ligne
ici: movem.l a4-a6,-(a7) ; sauve l'essentiel
   move.l edb(pc),a0
   move finb,ligne
   bsr compil            ; compile
   tst erreur
   bne.s .lb1
   cmp.l pilptr,a6       ; d‚passement de pile ?
   beq.s .lb1
   move #1,erreur        ; si oui, on le signale
   bsr cr
   lea bugpil(pc),a0
   bsr write_str
.lb1:
   movem.l (a7)+,a4-a6
   tst erreur
   bne debut
   tst trc
   beq.s .exe1
   bsr exetrc
   bra debut
.exe1: bsr execut
   bra debut

treat_shiftins:
	move edoffset,d5
	move.b #'',okmem+2
.lb1bb:
	move.l d5,-(sp)
   bsr cr
   lea okmem(pc),a0
   addq.b #1,2(a0)
   cmp.b #'',2(a0)
   bmi.s .lb0
   move.b #'',2(a0)
.lb0:
   bsr write_str
   move.l (sp)+,d5
   move.l #edsav,a1
   sub #512,d5
   and #$7ff,d5
   add.w d5,a1
   move.l edb(pc),a0	 ; lea ([edb,pc]),a0
   move.l a0,a2
.copie:
   move.b (a1)+,(a2)+
   bne.s .copie
   move.l d5,-(sp)
   bsr write_str
   move.l (sp)+,d5
.shift:
	bsr.s .get_time
	move.l d0,d4
	add.l #200,d4
.wait:
	move.l kbshift,a0
	move.b (a0),d0
	and.b #$03,d0				; shift toujours appuy‚?
	beq.s .exit					; non, on quitte
	bsr.s .get_time
	cmp.l d0,d4
	bpl.s .wait					; attendre une seconde
	bra.s .lb1bb				; sinon, remettre ligne d'avant
.exit:
   bsr cr
   lea ok(pc),a0
   bsr write_str
	move.l edb(pc),a0
	rts
.get_time:
	pea .timer(pc)
	XBIOS 38,6
	rts
.timer:
	move.l $4ba.w,d0
	rts

; a0 pointe sur la ligne de commande … sauver
; rien n'est modifi‚ si la ligne est vide ou
; si elle et ‚gale … une ligne d‚j… sauv‚e (deux fois la mˆme commande entr‚e)

treat_saveline:
	tst.b (a0)				; vide?
	beq.s .exit				; oui, rien … sauver
	move.l #edsav,a1		; zone de sauvegarde
	moveq #3,d0
.again:
	move.l a1,a2
.comp:
	cmp.b (a0)+,(a2)+
	bne.s .pas_egal
	tst.b -1(a0)			; chaine finie?
	bne.s .comp
	bra.s .exit1			; chaines ‚gales, on ne sauve pas !
.pas_egal:
	move.l edb(pc),a0		; retour au d‚but
	lea 512(a1),a1			; chaine suivante
	dbf d0,.again			; compare aux 4 chaines....
   move.l #edsav,a1     ; sinon, on recopie le tout dans le buffer annexe
   move edoffset,d0
   add.w d0,a1
   add #512,d0				; buffer suivant
   and #$7FF,d0			; boucle
   move d0,edoffset
.lb0: move.b (a0)+,(a1)+
   bne.s .lb0
.exit1:
   move.l edb(pc),a0
   clr.b (a0)
.exit:
	rts

; retour au bureau
	SAUT
fin:
	tst change_flag
	beq.s .lb0					; pas de changement, on quitte
	btst #2,alert_mask+1		; voulait-on l'alerte?
	beq.s .lb0					; non, on quitte!
   lea saveb3,a0
   jsr forth_alert
   beq.s .lb0					; l'utilisateur confime, on quitte|
	rts							; sinon retour, comme une fonction normale
	
.lb0:
	moveq #0,d3					; d3=0 pour tous les modules
	GOSUB call_doexit			; appelle les routines de fermeture des modules
	bsr mouse			; remet vecteur joystick et r‚glages souris
   move #2,-(sp)
   move #15,-(sp)
   XBIOS 35,6

	tst.w isbomb			; vecteurs d‚tourn‚s?
	beq.s .no_detour
   clr.l -(sp)
   GEMDOS 32,6
   move.w  #8,a0
   move.l  #vectbuf,a1
   moveq #3,d1
.hgf: move.l (a1)+,(a0)+
   dbf d1,.hgf
   move.l  d0,-(sp)
   GEMDOS 32,6
.no_detour:

   bsr fastclose				; ferme la fenˆtre
   bsr fastdel					; et l'efface.
   GEM_VDI show_mouse
   GEM_VDI close_work     ; ferme la station interne
   move handle,i_handle
   GEM_VDI close_work     ; puis ferme l'externe
   GEM_AES appl_exit

   move.l uspile,a7
   lea ret_val(pc),a0
   move (a0)+,d0				; valeur … renvoyer?
   beq.s .zero
	move d0,-(sp)				; return code
   move.l (a0)+,d1			; taille … conserver
   bne.s .resident
	GEMDOS 76,4					; pterm, bye et valeur renvoy‚e   
.resident:
	move.l d1,-(sp)			; taille … conserver depuis baasepage
	GEMDOS 49,8					; ptermres, bye et rester en m‚moire
.zero:
   GEMDOS 0,2              ; pterm0, bye, renvoie z‚ro
ret_val: dc.w 0				; par d‚faut 0
	dc.l 0						; taille … conserver ptermres



debug:
	movem.l d0-d7/a0-a6,-(sp)
	lea .chaine(pc),a0
	addq.b #1,(a0)
	pea (a0)
	GEMDOS 9,6
	move #2,-(sp)
	BIOS 2,4
	movem.l (sp)+,d0-d7/a0-a6
	rts
.chaine: dc.b "A ",13,10,0
	even


; procedures d'exeption nø2 … 5

gloups2: move.l #exep2,a0
	moveq #'2',d0
   bra.s gloups_com

gloups3: move.l #exep3,a0
	moveq #'3',d0
   bra.s gloups_com

gloups4: move.l #exep4,a0
	moveq #'4',d0
   bra.s gloups_com

gloups5: move.l #exep5,a0
	moveq #'5',d0

gloups_com:
	lea exep0,a1
	move.l a1,addrin		; pour l'alerte
	lea 13(a1),a1
	move.b d0,(a1)+		; num‚ro de bombes
	move.l #' BOM',(a1)+
	if LANG=0
		move.l #'BES ',(a1)+
	else
		move.l #'BS  ',(a1)+
	endif
	addq.l #2,a1			; le d‚tail
	move.l (a0)+,(a1)+
	move.l (a0)+,(a1)+
	move.l (a0)+,(a1)+
	move.l (a0)+,(a1)+
	move.l (a0)+,(a1)+	; copie 20 caractŠres
	move.l uspile,a1
   move a1,usp
   move.l #aff_gloups,2(sp) ; mon PC
   and.b #$f,6(sp)			; format 0 de sauvegarde!
   move.l a4,retptr
   move.l a6,d0
   bclr #0,d0
   move.l d0,a6
   move.l a5,-(a6)		; le pointeur d'ex‚cution (pour info)
   move.l a6,pilptr
   rte

aff_gloups:
	jsr _forth_alert
	bra debut

ok:      dc.b "Ok > ",0
okmem:	dc.b " {0} ",0

 even

	if LANG=0

eedd: dc.b " Ligne: 00000   Libre: 000 Ko",0

help_txt:
			dc.b  "F1 cette aide    F9 aide mot curseur",0 
			dc.b  " F1 d‚but texte    F10 fin texte",0
			dc.b  " F2 page haut      F9 page bas",0
			dc.b  " F3 d‚but bloc     F4 fin bloc",0
			dc.b  "F3 <<aller bloc  F4 aller bloc>>",0
			dc.b  " F5 cache bloc    F5 efface bloc",0
			dc.b  "F6 d‚place bloc  F7 colle bloc",0
			dc.b  " F7 cherche      F8 cherche suivant",0
			dc.b  " Esc quitte  F2\UNDO annule ligne",0
			dc.b  "^Del efface ligne  F6 aller ligne",0
			dc.b  "TAB tab bloc +/- selon Dr ou Ga",0
			dc.b 0

help_prompt: dc.b " ENTER   ex‚cute la ligne",0
				dc.b  " UNDO    (F2 ou Esc)annule la ligne",0
				dc.b  " Ins    (F10)rappelle ligne sauv‚e",0
				dc.b  "         garder Shift=autres lignes",0
				dc.b  " edit    passe sous l'‚diteur",0
				dc.b  " system  quitte l'interpr‚teur",0
				dc.b  " loadb   charge un fichier",0
				dc.b  " saveb   sauve un fichier",0
				dc.b  " buf!    efface texte ‚dit‚",0
				dc.b  " compilb compile le source",0
				dc.b  " desk    accŠs menu/acc/fenˆtre",0
				dc.b  " 'x help affiche la syntaxe du mot x",0
				dc.b 0

bugass: dc.b "  --->  Mot non assemblable",0
bugundef: dc.b " Placer >comp avant :: xxx ; pour d‚finir les variables !",0
cbug0: dc.b " Format d'un nombre r‚el incorrect",0
cbug1: dc.b " Mot manquant aprŠs un mot de d‚finition",0
cbug2: dc.b " Chaine absente ou incomplŠte aprŠs .",34," ou ",34,0
cbug3: dc.b " Mot inconnu ou nombre exprim‚ dans une mauvaise base : ",0
cbug4: dc.b " Buffer d'ex‚cution plein ( utiliser >comp ) -> ",0
cbug5: dc.b " L'inclusion doit se faire dans une d‚finition!",0
cbug6: dc.b " D‚finitions … inclure hors d'une d‚finition!",0
cbug7: dc.b " Erreur >include: format PRG/FOR/DEF non reconnu!",0
cbug8: dc.b " Erreur >include: chargement impossible!",0
cbug9: dc.b " Erreur >include: masque d'options absent sur la pile!",0
cbug10: dc.b " Erreur >include: chaine fichier mal ferm‚e!",0
cbug11: dc.b " Erreur >include: m‚moire insuffisante!",0
cbug12: dc.b " Erreur >ask/>true/>false: nø de flag incorrect!",0
cbug13: dc.b " Erreur >prgflags: trois constantes attendues sur la pile!",0
cbug14: dc.b " Red‚finition d'un mot existant : ",0
cbug15: dc.b " Erreur >ask,>accname : mauvaise chaine!",0
troplong: dc.b " Mot trop long ( 40 caractŠres maximum )",0
bugpil: dc.b " Then, repeat, ->. ou endcase manquant",0
cbug16: dc.b " +loop/ifloop/loop sans do",0
cbug17: dc.b " nloop sans ndo",0
cbug18: dc.b " lloop sans dolist",0
cbug19: dc.b " watch sans list",0
cbug20: dc.b " Un do/ndo/dolist/list non ferm‚"
cbug21:	dc.b " en rencontrant ",0
cbug22: dc.b " again/while/until sans begin",0
cbug23: dc.b " repeat sans while",0
cbug23a: dc.b " while sans repeat",0
cbug24: dc.b " begin sans again/while/until"
cbug25: dc.b " en rencontrant ",0
cbug26: dc.b " D‚finition non ferm‚e par ;",0
cbug27: dc.b " D‚finition dans une d‚finition",0
cbug28: dc.b " ; sans d‚but de d‚finition (: ou ::)",0
cwarn29: dc.b " Attention: dolist sans list (usage d'un tableau?)",0
cbug30: dc.b " Plus de place pour les noms des nouveaux mots",0
cbug31: dc.b " Plus de place pour les adresses des nouveaux mots",0
cbug32: dc.b " ->. sans ->",0
cbug33: dc.b " and->/or-> sans ->",0
cbug34: dc.b " -> sans ->."
cbug35: dc.b " en recontrant ",0
cbug36: dc.b " then sans if",0
cbug37: dc.b " else sans if",0
cbug38: dc.b " if/else sans then"
cbug39: dc.b " en recontrant ",0
cbug40: dc.b " endcase/of/<>of/>of/<of sans case",0
cbug41: dc.b " endof sans of/<>of/>of/<of",0
cbug42: dc.b " case/of sans endcase/endof"
cbug43: dc.b " en rencontrant ",0
cbug44: dc.b " exe+ doit ˆtre dans une d‚finition",0

	else

eedd: dc.b " Line : 00000   Free : 000 Ko",0

help_txt: 
			dc.b  "F1 this help    F9 help word at cursor",0
			dc.b  " F1 text start    F10 text end",0
			dc.b  " F2 page up       F9 page down",0
			dc.b  " F3 block start   F4 block end",0
			dc.b  "F3 <<go block   F4 go block>>",0
			dc.b  " F5 hide block   F5 delete block",0
			dc.b  "F6 move block   F7 paste block",0
			dc.b  " F7 find        F8 find next",0
			dc.b  " Esc quit   F2\UNDO cancel line",0
			dc.b  "^Del delete line  F6 goto line",0
			dc.b  "TAB block tab + (Ri) or - (Le)",0
			dc.b 0

help_prompt: dc.b " ENTER   execute current line",0
				dc.b  " UNDO    (F2/Esc)del current ligne",0
				dc.b  " Ins    (F10)recall saved line",0
				dc.b  "         Shift pressed=other lines",0
				dc.b  " edit    enter the editor",0
				dc.b  " system  exit to desktop",0
				dc.b  " loadb   load a file",0
				dc.b  " saveb   save a file",0
				dc.b  " buf!    delete text from editor",0
				dc.b  " compilb compile text",0
				dc.b  " desk    access to menu/acc/window",0
				dc.b  "'x help  gives syntax of word x",0
				dc.b 0

bugass: dc.b "  --->  Can't be assembled",0
bugundef: dc.b " Place >comp before :: xxx ; to define variables !",0
cbug0: dc.b " Bad format for a real number",0
cbug1: dc.b " Missing word after a definition word",0
cbug2: dc.b " Missing or not ending string after .",34," or ",34,0
cbug3: dc.b " Unknown word or bad number in current base : ",0
cbug4: dc.b " Execution buffer is full ( use >comp ) -> ",0
cbug5: dc.b " You must include the file within a definition!",0
cbug6: dc.b " You can't include definition within a definition!",0
cbug7: dc.b " Error >include: bad PRG/FOR/DEF format!",0
cbug8: dc.b " Error >include: can't load file!",0
cbug9: dc.b " Error >include: missing option mask on stack!",0
cbug10: dc.b " Error >include: file string not closed!",0
cbug11: dc.b " Error >include: not enough memory!",0
cbug12: dc.b " Error >ask/>true/>false: bad flag number!",0
cbug13: dc.b " Error >prgflags: three constants are expected on stack!",0
cbug14: dc.b " Attempt to redefine an existing word : ",0
cbug15: dc.b " Error >ask,>accname : bad string!",0
troplong: dc.b " Word too long ( 40 characters maximum )",0
bugpil: dc.b " Missing Then, repeat, ->. or endcase",0
cbug16: dc.b " +loop/ifloop/loop without do",0
cbug17: dc.b " nloop without ndo",0
cbug18: dc.b " lloop without dolist",0
cbug19: dc.b " watch without list",0
cbug20: dc.b " One do/ndo/dolist/list not closed"
cbug21: dc.b " when encountring ",0
cbug22: dc.b " again/while/until without begin",0
cbug23: dc.b " repeat without while",0
cbug23a: dc.b " while without repeat",0
cbug24: dc.b " begin without again/while/until"
cbug25: dc.b " when encountring ",0
cbug26: dc.b " Definition is not closed with ;",0
cbug27: dc.b " Definition inside a definition",0
cbug28: dc.b " ; without a : or ::",0
cwarn29: dc.b " Warning: dolist without list (using and array?)",0
cbug30: dc.b " No more room for the names of new words",0
cbug31: dc.b " No more room for the addresses of new words",0
cbug32: dc.b " ->. without ->",0
cbug33: dc.b " and->/or-> without ->",0
cbug34: dc.b " -> without ->."
cbug35: dc.b " when encountring ",0
cbug36: dc.b " then without if",0
cbug37: dc.b " else without if",0
cbug38: dc.b " if/else without then"
cbug39: dc.b " when encountring ",0
cbug40: dc.b " endcase/of/<>of/>of/<of without case",0
cbug41: dc.b " endof without of/<>of/>of/<of",0
cbug42: dc.b " case/of without endcase/endof"
cbug43: dc.b " when encountring ",0
cbug44: dc.b " exe+ must be used inside a definition",0

	endif

 even

; en mode direct, les touches ENTER,sh INSERT et UNDO mettent fin … l'‚dition
; HELP
; la touche BACKSPACE sur la prmiŠre colonne non.
; emulation: Shift F1 = HELP et Shift F10 = Shift Insert, Shift F2 = UNDO

prompt_list: dc.w 0,$1c0d,$720d,$6100,$5230,$6200,$5400,$5D00,$5500,0

; sous l'‚diteur, ENTER, UNDO, ESC, UP, DOWN, ^DEL, F1 …F10, F15 … F17
; et F11 pour simuler Help, F12 UNDO
; la touche BACKSPACE sur la premiŠre colonne oui
; HELP, F13/F14, Ctrl-C, Ctrl-V, Shift+TAB dans les 3 cas
; Ctrl-F, Ctrl-G, Ctrl-L

edit_list: dc.w 1,$1c0d,$720d,$6100,$011b,$4800,$4838,$5000,$5032,$531f
           dc.w $3b00,$3c00,$3d00,$3e00,$3f00,$4000,$4100,$4200,$4300,$4400
           dc.w $5800,$5900,$5a00,$5500,$6200,$5600,$5700,$5400,$5C00
           dc.w $2E03,$2F16,$1F09,$2F09,$3F09
           dc.w $2106,$2207,$260C,0

; execution d'une phrase

execut:  move.l #exebuf,a5
         move.l pilptr,a6
         move.l retptr,a4
         tst isfast
         beq slowexe
fastexe: move (a5)+,d1
         cmp #diko,d1
         bpl.s .lab1
			if STE=0
	         jsr ([adresse,pc,d1.w*4])
	      else
	      	move.w d1,d0
	      	asl #2,d0
	      	lea adresse,a0
	      	move.l (a0,d0.w),a0
	      	jsr (a0)
	      endif
         bra.s fastexe
.lab1:   move.l a5,-(a4)
			if STE=0
	         move.l (adresse,pc,d1.w*4),a5
	      else
	      	asl #2,d1
	      	lea adresse,a0
	      	move.l (a0,d1.w),a5
	      endif
         bra.s fastexe

; execution en mode trace

exetrc:  move.l #exebuf,a5
         move.l pilptr,a6
         move.l retptr,a4
         bsr aff_trace_title
         clr.l trace_flags
tracexe: 
			lea trace_flags,a0
         move #diko,d2
         tst.b 2(a0)						; flag S ? (single step)
         beq.s .lb0						; non
			sf 2(a0)							; oui! on vire le flag (ne sert qu'une fois)         
			move (a5)+,d4
	      ext.l d4
			bra.s .afficher				; et on force la pause
.lb0:
			tst.b (a0)						; flag R ? (until return)
			beq.s .lba
			cmp.l 4(a0),a5					; si revenu au point de retour (compare avec trace_data)
			bne.s .skip_trace				; pas encore
			sf (a0)							; si oui, on vire le flag
			bra.s .lbz						; et reprend l'ex‚cution normale de trace
.lba:
			tst.b 1(a0)						; flag L ? (leave loop/word)
			beq.s .lbz
			cmp.l 4(a0),a4					; teste si la pile des retours a ‚t‚ vid‚e depuis
			bls.s .skip_trace				; pas encore
			sf 1(a0)							; si oui, vire le flag
			bra.s .lbz						; et reprend le mode trace
.skip_trace:
			move (a5)+,d4
			ext.l d4
			cmp d2,d4
			bpl.s .non2					; mot utilisateur
			bra.s .non					; mot forth														
			
.lbz:
			move (a5)+,d4
	      ext.l d4
			lea .exclude(pc),a1	; liste des codes sans pause
			moveq #(.exclude_end-.exclude)/2-1,d0
.lbex:
			cmp (a1)+,d4
			dbeq d0,.lbex			; compare aux codes … exclure
			beq.s .non				; si on a trouv‚, alors on saute la pause
	      lea watchlist,a1	; a t-on une liste de mots … surveiller?
	      tst (a1)
	      beq.s .normal
.wlist:
			move (a1)+,d0			; mot … surveiller
			beq.s .pas_trouve
			cmp d0,d4
			bne.s .wlist
.afficher:
			cmp d2,d4				; ici mot … surveiller
			bpl .lb1					; si user, on saute pour l'afficher
			bra.s .mot_forth		; sinon mot forth … afficher
.pas_trouve:	      
			cmp d2,d4				; pas dans les mots … surveiller
			bpl.s .non2				; si user on l'ex‚cute
			bra.s .non				; si mot forth on l'execute
.normal:
         cmp d2,d4
         bpl .lb1					; mot utilisateur, on y va
         tst trcmot
         beq.s .non
.mot_forth:
			bsr.s aff_trc			; et traite les touches
         beq.s exefin			; si Esc
.non:    move d4,d1				; utile pour routines tos
			lsl.l #2,d4
			lea adresse,a1
         move.l  0(a1,d4.l),a1
         jsr (a1)
         bra tracexe
.lb1:									; ici un mot utilisateur
			bsr.s aff_trc			; traite les touches
			beq.s exefin			; si Esc
.non2:
         move.l a5,-(a4)
         lsl.l #2,d4
         lea adresse,a1
         move.l  0(a1,d4.l),a5
         bra tracexe
         ; liste des mots qui ne provoquent pas de pause
         ; [empl] ; untrace trace ." " [var] [var] [cst] [arr] [str] [ar$] [tab] [qt] compilb 
         ; [ass] [thv] [f] [&] [fl] [war] trace_win edit
.exclude:
	dc.w 0,79,107,106,138,139,140,141,142,143,144,145,146,170,437,530,580,628,637,706,861,157
.exclude_end:

exefin:  move.l a4,retptr
         move.l a6,pilptr
         rts


         
aff_trc:
         lea ordres,a3
         lea trc_aff,a2		; chaine de sortie
			move d4,d0
.lb:
         move.b (a3)+,d1
         ext.w d1
         ext.l d1
         subq #1,d0
         bmi.s .lb0
         add.l d1,a3
         bra.s .lb
.lb0:    moveq #15,d0				; nombre maxi de caractŠres
			sub d1,d0
			bpl.s .lb2
			moveq #15,d1
			moveq #0,d0
.lb2:
			subq #1,d1
.lb1:    move.b (a3)+,(a2)+
         dbf d1,.lb1
.lb3:
         move.b #32,(a2)+
         dbf d0,.lb3
         move.b #':',(a2)+
         move.b #32,(a2)+
         move.l d4,-(sp)
         move.l fenetre,-(sp)
         move.l a2,-(sp)
         lea trace_win,a0
         GOSUB _setp
         bsr cr
         move.l (sp)+,a2
         move.l a6,-(sp)		; sauve la pile
         st ecran					; ne pas afficher encore
         move #198,d7			; taille maxi de la chaine
         cmp trace_win+20,d7	; largeur maxi … l'‚cran
         bmi.s .lb6				; en dessous, ‡a va
         move trace_win+20,d7
.lb6:
			sub #17,d7				; le mot est d‚j… dans la chaine
.lb5:
         cmp.l pilbase,a6
         bpl.s .lb4
     		jsr point
			move.l a1,d0			; chaine renvoy‚e
.lb7:
			tst.b (a1)+
			bne.s .lb7
			sub.l d0,a1
			subq.l #1,a1
			cmp a1,d7
			bmi.s .lb4				; plus assez de place, on sort
			sub a1,d7
			move.l d0,a1			; reprend la chaine
.lb8:
			move.b (a1)+,(a2)+	; copie
			bne.s .lb8
			subq.l #1,a2			; ote le z‚ro
			move.b #32,(a2)+
			subq #1,d7				; moins l'espace
			bmi.s .lb4
			beq.s .lb4
			bra.s .lb5
.lb4:
			sf ecran
			clr.b -(a2)				; enlŠve le dernier espace
			move.l (sp)+,a6		; r‚cupŠre la pile
         lea trc_aff,a0
         move trace_win+20,d7
         cmp #199,d7
         bmi.s .lb9
         move #199,d7
.lb9:
         clr.b 0(a0,d7.w)		; par s‚curit‚, termine la chaine
         bsr write_str
         move.l (sp)+,a0
         if STE=1
         	jsr _setp
         else
	         bsr _setp
	      endif
         move.l (sp)+,d4
.wait:   move #$ff,-(sp)
         GEMDOS 6,4
         tst.l d0
         beq.s .wait
         lea trace_flags,a0
         cmp.l #$1001b,d0		; escape ???
         beq.s .quit
			or.w #$20,d0
			cmp.b #'r',d0        ; until Return?
			bne.s .lba
			move.l a5,4(a0)		; trace data = pointeur d'interpr‚tation
			st (a0)					; flag R on
			bra.s .lbz
.lba:
			cmp.b #'b',d0			; breakpoint?
			bne.s .lbb
			st (a0)					; flag R on
			lea -2(a5),a1			; juste avant
			move.l a1,4(a0)		; 
			bra.s .lbz
.lbb:
			cmp.b #'s',d0			; single step ?
			bne.s .lbc
			st 2(a0)					; juste le flag, pas de data
			bra.s .lbz
.lbc:
			cmp.b #'l',d0			; leave?
			bne.s .lbz
			move.l a4,4(a0)		; conserve la pile retours
			st 1(a0)					; flag L on
.lbz:
			moveq #1,d0				; renvoie NE si pas Esc
.quit:
         rts

aff_trace_title:
			move.l fenetre,-(sp)
	      lea trace_win,a0
         GOSUB _setp
         bsr cr
         bsr cr
         lea .titre(pc),a0
         bsr write_str
         move.l (sp)+,a0
         GOSUB _setp
         rts
.titre:
	if LANG=0
	dc.b "Suivant [Enter] : Pile     (B-R-L-S-Esc)",0
	else
	dc.b "Next [enter]    : Stack    (B-R-L-S-Esc)",0
	endif
	even

slowexe: move (a5)+,d1
         lea adresse,a1
         moveq #15,d0
         move.l kbshift,a0
         and.b (a0),d0
         cmp.b #15,d0
         beq.s .break
         cmp.l pilbase,a6
         bgt.s .bug
         cmp #diko,d1
         bpl.s .lab1
         lsl #2,d1
         move.l  0(a1,d1.w),a1
         lsr #2,d1
         jsr (a1)
         bra.s slowexe
.lab1:   move.l a5,-(a4)
         lsl #2,d1
         move.l  0(a1,d1.w),a5
         bra.s slowexe
.break:  pea .brktext(pc)
         bra.s .lab2
.bug:    pea .bug0(pc)
         move.l pilbase,a6
.lab2:
			lea exep0,a0
			lea 13(a0),a1
			move.l #'    ',d0
			move.b d0,(a1)+
			move.l d0,(a1)+
			move.l d0,(a1)+	; efface les ‚ventuelles bombes
			addq.l #2,a1
			move.l (sp)+,a2
			move.l (a2)+,(a1)+	; copie le message dans l'alerte
			move.l (a2)+,(a1)+
			move.l (a2)+,(a1)+
			move.l (a2)+,(a1)+
			move.l (a2)+,(a1)+
         move.l a5,-(a6)
         jsr forth_alert
         beq exefin			; l'utilisateur a cliqu‚ STOP
         ; sinon, analyse de la pile des retours!
         bsr rzer
         move.l (a6)+,a5	; pointeur sur pile retours
.analyse:
         bsr cr
         cmp.l a5,a4
         bpl exefin			; on a fini la pile
         move.l -(a5),a3	; adresse opcode suivant
         moveq #0,d0
         move (a3),d0		; le mot aprŠs
         move.l d0,-(a6)	; pour affichage ensuite
         lea .truc(pc),a0
         move -(a3),d0		; le mot juste avant
         cmp #58,d0			; do
         beq.s .3long
         cmp #575,d0			; dolist
         beq.s .3long
         cmp #572,d0			; ndo
         bne.s .lb0
.3long:
			subq.l #8,a5		; passe les indices de boucle
			bra.s .lb1
.lb0:
			cmp #60,d0
			bne.s .lb2
.lb1:
			addq.l #4,a0		; chaine truc2
.lb2:
			move.l a0,-(a6)	; truc/2
			move.l d0,-(a6)
			jsr word				; le mot avant
			bsr type
			bsr type				; affiche truc
			jsr word				; le mot aprŠs
			bsr type
			bra.s .analyse

.truc: dc.b 32,2,32,0		; taille paire !			         
	dc.b 32,3,32,0				; ici truc 2
         
	if LANG=0
.brktext: dc.b "Arrˆt utilisateur ! "
.bug0:   dc.b  "La pile est vide !  "
	else
.brktext: dc.b "User interruption ! "
.bug0:	dc.b  "Stack is empty !    "
	endif

 even

; recherche du mot suivant dans la phrase

motsuiv: move.l #mot,a1
         moveq #0,d1
         moveq #32,d2
.loop:   tst.b (a0)			; fin de ligne ?
         bne.s .lb0
         tst.l inc_ptr		; nous incluons un autre fichier depuis le disque?
         beq.s .ram
			bsr _load_line		; oui, on charge la ligne suivante!
			bra.s .loop
.ram:
         move ligne,d0
         cmp finb,d0
         beq.s .fin
         tst (a0)
         beq.s .fin
         addq.l #3,a0
         addq #1,ligne
         bra.s .loop
.lb0:    cmp.b (a0)+,d2
         beq.s .loop
         subq.l #1,a0
.lab1:   move.b (a0)+,d2
         bne.s .lab2
         subq.l #1,a0
         bra.s .sortie
.lab2:   cmp.b #32,d2
         beq.s .sortie
         move.b d2,(a1)+
         addq #1,d1
         cmp #41,d1
         bne.s .lab1
         bra.s .bug
.fin:    move #-1,fincomp
.sortie: clr.b (a1)
         move.b d1,d7
         cmp.b #1,d1
         bne.s .out
         cmp.b #'\',-(a1)
         bne.s .out
.lab3:   tst.b (a0)+
         bne.s .lab3
         subq.l #1,a0
         bra.s motsuiv
.out:    rts
.bug:    lea troplong(pc),a0
         bsr write_str
         addq.l #4,a7
         move #1,erreur
         move.l basesav,base
         move.l somsave,a6
         clr.b (a6)
         move.l a6,sommet
         move forthsav,forth
         move.l topsave,topprg
         rts

	; charge une nouvelle ligne
	; (a0) pointe sur le mot "taille" $00ss
	; en retour a0 pointe sur la nouvelle ligne (1er caractŠre r‚el)
	;           EQ si dans le mˆme fichier
	;				NE si on a d– fermer.

_load_line:
			movem.l d0-d4/a1-a3,-(sp)
			move.l inc_ptr,a3
			addq.l #4,a3		; skip chain address
			move (a3)+,d4		; file handle
			subq #1,(a3)+		; one line less
			bmi.s .ll1			; no more, close file !
			addq.l #4,a3		; skip saved compilptr
			move.l a3,-(sp)	; pour charger
			move (a0),d0		; size of next line
			ext.l d0
			move.l d0,-(sp)
			move d4,-(sp)
			GEMDOS 63,12		; fread
			tst.b 255-12(a3)	; dernier octet du buffer
			beq.s .for			; si 00, fichier FOR
			lea 128(a3),a0		; ici un DEF, va construire une ligne FOR
			move #$0010,-(a0)	; marqueur de fin de ligne 00 16
			moveq #32,d1		; espace
			move.b d1,-(a0)
			lea 16(a3),a3		; fin de ligne DEF
			moveq #7,d2
.copy_name:
			move.b -(a3),d0
			bne.s .ll3
			move.b d1,d0
.ll3:
			move.b d0,-(a0)	; copie le nom en repla‡ant les 00 par des espaces
			dbf d2,.copy_name
			move.b d1,-(a0)
			move.l #'tant',-(a0)
			move.l #'cons',-(a0)
			move.b d1,-(a0)
			move.b -3(a3),d1	; valeur de la constante !
			moveq #2,d2
.ll4:
			divs #10,d1			; la valeur sur 3 octets
			swap d1
			add.b #'0',d1
			move.b d1,-(a0)
			clr d1
			swap d1
			dbf d2,.ll4			; au final a0 pointe sur "nnn constant XXXXXXXX "+00+16
			moveq #0,d0
			bra.s .ll2			; renvoie EQ, mˆme fichier !			
.for:
			clr.b 0(a3,d0.l)	; ajoute un z‚ro en cas de derniŠre ligne vide
			lea 1(a3),a0		; skip "tab" byte in source code
			moveq #0,d0			; renvoie EQ si mˆme fichier
			bra.s .ll2
.ll1:
			move.l (a3),-(sp)	; original compilptr
			jsr depile_inc		; remove block from chain and close file
			move.l (sp)+,a0	; back on original compilptr
			moveq #1,d0			; renvoie NE si fichier ferm‚
.ll2:
			movem.l (sp)+,d0-d4/a1-a3
			rts

; compilation d'une phrase
; en entr‚e : a0 adresse du buffer
;             ligne : nombre de lignes d‚j… faites
;             finb :  nombre maxi de lignes … faire - 1

	; instructions cod‚es avec un offset … suivre sur 2 octets
	;              of,<>of,>of,<of,and->,or->,if,while,do,ndo,dolist
plus_offset: dc.w 66,700,701,702,712,714,69,62,58,572,575,0
	; instructions qui doivent calculer l'offset pr‚c‚dent
	;              then,repeat,loop,nloop,lloop,ifloop,+loop
dest_offset: dc.w 71,63,56,573,576,156,57,0
	
compil:  ;move.l a0,-(sp)
			;move.l (sp)+,a0
			lea loopnest,a1
			clr.l (a1)+
			clr.l (a1)+
			clr.l (a1)+	; les comptages ouvertures/fermetures de boucle
			clr.l ass	; ainsi que find/forg
			clr in_def
			sf ass_const
         move.l #exebuf,a2
         move.l pilptr,a6
         move.l #exebuf+1588,but
         move.l botmem,but+4
         move forth,forthsav
         move.l sommet,somsave
         move.l topprg,topsave
.suite:  cmp.l but,a2		; fin buffer ?
         bpl .bug4			; erreur
         bsr motsuiv			; sinon mot suivant
         moveq #0,d4
         tst.b d1				; trouv‚?
         bne.s .lab1			; oui, on traite
.sortie: 
			move #146,(a2)		; sinon code [qt]
         move.l a0,cmplptr	; et on s'en va!
         tst in_def			; encore dans une d‚finition?
         bne .bugnoenddef	; oui, erreur manque ";"
         lea loopnest,a1
	tst.b 11(a1)			; warning list/dolist?
	beq.s .bl3b
	btst #3,alert_mask+1	; warnings demand‚s?
	beq.s .bl3b			; non...
	move.l a1,-(sp)
	lea cwarn29(pc),a0	; avertit sinon!
	bsr write_str
	bsr cr
	move.l (sp)+,a1
.bl3b:         
         tst.l (a1)			; les compteurs
         bne .bugloop3		; des boucles encore ouvertes, erreur !
         tst.l 4(a1)
         bne .bugloop3
			tst.w 8(a1)
			bne .bugloop3
         bsr cache_off
         rts
.lab1:   cmp.b #1,d1			; 1 seul caractere?
			beq.s .pasquote
			lea mot,a4
			cmp.b #39,(a4)		; commence par quote?
			bne.s .pasquote
			subq #1,d1			; un caratere de moins
			st find
.decale:
			move.b 1(a4),(a4)+
			bne.s .decale
.pasquote:
			bsr find_word		; cherche le mot dans le dicco D4 = code mot
			beq .findic			; if EQ, then not found
			tst.b forg			; pr‚c‚d‚ de forget?
			beq.s .lb6i			; non
			sf forg				; annule le flag
.lb6k:
			move d4,(a2)+		; si oui, on ajoute sans aucun traitement
			bra .suite		; et mot suivant !
.lb6i:			
         tst.b find				; c'est un 'xxx ?
         beq.s .lb66			; non
         sf find				; mode find xxx -> on va empiler
         move.l base,basesav
         move d4,d5			; code … empiler
         ext.l d5
         bra .lab5
.lb66:   cmp #171,d4    ; >comp
         beq .sortie
         cmp #116,d4		; forget
         bne.s .lb6j
         st forg			; le flag … FF
         bra.s .lb6k		; range le code et continue
.lb6j:	
         cmp #113,d4    ; find
         bne.s .lb60
         st find
         bra .suite
.lb60:   cmp #862,d4		; >include
			bne.s .lb6o
			bsr inclure
			beq .bug			; si 0, une erreur, a0 d‚j… charg‚ avec la chaine
			bra .suite
.lb6o:
			cmp #863,d4		; >true
			bne.s .lb6a
.lb6b:
			bsr flag_cond
			beq .bug
			bra .suite
.lb6a:
			cmp #864,d4		; >false
			beq.s .lb6b
			cmp #865,d4		; >export
			bne.s .lb6c
			bsr export_source
			beq .bug
			bra .suite
.lb6c:
			cmp #866,d4
			bne.s .lb6d		; >exec
			bsr exec_prog
			beq .bug
			bra .suite
.lb6d:
			cmp #867,d4		; >prgflags (ignor‚ ici!)
			bne.s .lb6e
			bsr prg_flags
			bne .bug13		; manque les constantes !
			bra .suite
.lb6e:
			cmp #868,d4		; >ifflag
			bne.s .lb6f
			bsr ifflag		; saute jusqu'au >endf si if flag est faux, sinon compile en s‚quence
			beq .bug
			bra .suite
.lb6f:
			cmp #919,d4		; >fom
			bne.s .lb6g
			bsr fom_words	; d‚finit les mots … importer depuis un module
			beq .suite		; si EQ, tout va bien
			bhi .bug14		; si >0, alors mot d‚j… existant qu'on red‚finit
			btst #0,d2		
			beq .bug_fulla	; si -2, plus de place pour l'adresse
			bra .bug_full	; si -1, plus de place pour le nom
.lb6g:
			cmp #922,d4		; >ifflag2
			bne.s .lb6h
			bsr ifflag2		; passe … >endf si l'un des 2 flags est faux, sinon compile en s‚quence
			beq .bug
			bra .suite
.lb6h:			
			cmp #902,d4		; >ask
			beq .lb6b
			cmp #916,d4		; >accname
			beq .lb6b
			cmp #869,d4		; >endf
			beq .suite		; simplement ignor‚
			cmp #501,d4
			beq .suite
			cmp #502,d4
			beq .suite		; ( ) ignor‚s, servent … la lisibilit‚
			cmp #78,d4     ; :
         beq.s .lb61
         cmp #571,d4    ; ::
         bne .lab2
         move #1,ass
.lb61:   move forth,courant
			lea in_def,a1
			tst (a1)
			bne .bugdef			; d‚finition dans d‚finition
			move #1,(a1)		; au milieu d'une def
			lea loopnest,a1
			tst.l (a1)			; les compteurs de boucle
			bne .bugloop2		; des boucles encore ouvertes lors d'une d‚finiton
			tst.l 4(a1)
			bne .bugloop2
			tst.w 8(a1)
			bne .bugloop2
.nouvo:  bsr motsuiv			; mot … cr‚er
         tst.b d1
         beq .bug1			; vide, erreur
         movem.l d4,-(sp)
         bsr find_word		; mot d‚j… existant?
         movem.l (sp)+,d4
         bne .bug14			; si NE c'est que le mot existe d‚j…|
         cmp #78,d4
         beq.s .bon
         cmp #571,d4
         beq.s .bon
         move forth,(a2)+	; code du nouveau mot (variable)
.bon:    bsr add_word		; ajoute le mot … partir de sommet
			bne .bug_full		; plus de place
         cmp #78,d4
         beq.s .lb71
         cmp #571,d4
         bne.s .lb1
.lb71:   move.l a2,topsav2
         move.l #but,a2
         move.l (a2)+,d0
         move.l (a2),-4(a2)
         move.l d0,(a2)
         move.l topprg,a2
.lb1:    move forth,d0
         lsl #2,d0
         lea adresse,a3
         lea 4(a3,d0.w),a1
         cmp.l #fin_new_adr,a1
         bhi .bug_fulla		; plus de place pour les adresses
         move.l a2,-(a1)
         addq #1,forth
         cmp #78,d4			; une def?
         beq .suite			; oui, tout est ok
         cmp #571,d4			; un assemblage?
         bne.s .lb1z			; non alors c'est une variable !!
         move #437,(a2)+	; pour assembleur, le code
         bra .suite
.lb1z:	move.l #.undef,(a1)	; met une adresse qui pointe vers un mot g‚n‚rique
			bra .suite
.undef:	dc.w $7FFF			; code pour undefined -> erreur d'assemblage et demander ">comp"
.lab2:   
			bsr .loop_count	; s'occupe de compter ouvertures fermetures boucles
			bmi .bugloop		; si <0, fermeture de boucle avant ouverture!			
			tst ass				; ici cas g‚n‚ral
         beq.s .lb21
         jsr assemblons
         tst erreur
         bmi .bugloop2		; si -1, erreurs de boucles encore ouvertes dans une def
         beq .suite
         bra .bugend
.lb21:   move d4,(a2)+		; on met notre code
         cmp #DEFNUM,d4			; cr‚e un mot? (comme variable...)
         bmi .nouvo
         move.b mot,d2
         cmp.b #"&",d2		; idem ceux commen‡ant par &xx cr‚ent un mot
         beq .nouvo
; ici cas particuliers de compilation
         cmp #79,d4			; le ";" qui termine une def
         bne.s .lb0
         lea in_def,a1
         tst (a1)				; sommes nous bien dans une d‚finition
         beq .bugnodef
         clr (a1)				; fin de def
         lea loopnest,a1
         tst.l (a1)		; des boucles encore ouvertes?
         bne .bugloop2			; oui, erreur !
         tst.l 4(a1)
         bne .bugloop2
			tst.w 8(a1)
			bne .bugloop2
         move.l a2,topprg
         move.l #but,a2
         move.l (a2)+,d0
         move.l (a2),-4(a2)
         move.l d0,(a2)
         move.l topsav2,a2
         bra .suite
.lb0:    
			lea plus_offset(pc),a1	; ici cherche les instructions cod‚es avec un offset en plus
.lb8:
			move.w (a1)+,d0
			beq.s .lb9			; fin de liste, suite
			cmp d0,d4
			bne.s .lb8
			move.l a2,-(a6) 	; if, while, of et ses d‚riv‚s, and->, or->, do,ndo,dolist
         addq.l #2,a2
         bra .suite
.lb9:    
			lea dest_offset(pc),a1
.lb10:
			move.w (a1)+,d0
			beq.s .lb11			; fin de liste
			cmp d0,d4
			bne.s .lb10
			move.l (a6)+,d0   ; then ou repeat ou loop et d‚riv‚es
         beq .suite        ; then suit un godo
         move.l a2,d4
         subq.l #2,d4
         sub.l d0,d4
         move.l d0,a3
         move d4,(a3)
         bra .suite
.lb11:   cmp #70,d4			; else
         beq.s .lb12
         cmp #67,d4			; endof
         bne.s .lb13
.lb12:   move.l a2,d4      ; else ou endof
         sub.l (a6),d4
         move.l (a6),a3
         move d4,(a3)
         move.l a2,(a6)
         addq.l #2,a2
         bra .suite
.lb13:   cmp #138,d4			; ."
         beq.s .lb14
         cmp #139,d4			; "
         bne.s .lb16
.lb14:   addq.l #2,a2   ; place pour la taille
			move.l a2,-(a6) ; … retenir
         tst.b (a0)  ; (") ou (.")
         beq .bug2
.lb15:   move.b (a0)+,d4
         beq .bug22			; fin de ligne, voir si elle se finit par \\
         cmp.l but,a2
         bpl .bug4			; buffer plein
         move.b d4,(a2)+
         cmp.b #34,d4		; guillement
         bne.s .lb15
         clr.b -1(a2)   ; un z‚ro terminal au lieu du "
         move.l a2,d4
         and #1,d4
         add.w d4,a2
         move.l a2,d4
         move.l (a6)+,a3
         sub.l a3,d4      ; taille de la chaine
         move d4,-(a3)    ; qu'on place
         bra .suite
.lb16:   cmp #65,d4			; case
         bne.s .lb17
.lab16:  clr.l -(a6)    ; case ou ->
         bra .suite
.lb17:   cmp #711,d4		; ->
         beq.s .lab16
         cmp #68,d4		; endcase
         beq.s .lb18
         cmp #713,d4		; ->.
         bne.s .lb20
.lb18:   tst.l (a6)+  ; ->. , endcase
         beq .suite
         move.l a2,d4
         subq.l #2,d4
         sub.l -(a6),d4
         move.l (a6)+,a3
         move d4,(a3)
         bra.s .lb18
.lb20:   cmp #368,d4      ; exe+
         bne.s .lb22
         tst in_def
         beq .bug44			; exe+ ne peut pas etre en dehors d'une def
         move courant,d1
         ext.l d1
         clr -2(a2)			; remplace exe+ par [empile]
         move.l d1,(a2)+	; mot courant
         move d4,(a2)+		; remet exe+
         bra .suite
.lb22:   bra .suite

; ici on cherche si un mot est un nombre
.findic: moveq #0,d5
         move.l base,basesav
         clr d6
         move d1,d4
         subq #1,d4
         move.l #mot,a4
         move.b (a4),d0
         cmp.b #"%",d0
         bne .f5
         addq.l #1,a4
         subq #2,d4
         move.b (a4)+,d0
         cmp.b #"f",d0
         beq.s .un_reel
         bra.s .f0
.reset_reel:
			lea mot,a4
.un_reel:
         movem.l d2-d7/a0-a3,zone
         move.l a4,a0
         bsr subval
         tst erreur
         bne .bug0
         movem.l zone,d2-d7/a0-a3
         move #637,d4
         tst ass
         beq.s .f00
         jsr assemblons
         bra .suite
.f00:    move d4,(a2)+
         move.l d1,(a2)+
         move.l d0,(a2)+
         bra .suite
.f0:     cmp.b #"b",d0
         bne.s .f2
         moveq #2,d0
         bra.s .f1
.f2:     cmp.b #"d",d0
         bne.s .f3
         moveq #10,d0
         bra.s .f1
.f3:     cmp.b #"o",d0
         bne.s .f4
         moveq #8,d0
         bra.s .f1
.f4:     cmp.b #"h",d0
         bne .bug3
         moveq #16,d0
.f1:     move.l d0,base
.f5:     move.b (a4),d0
         cmp.b #"-",d0
         bne.s .lab3
         addq.l #1,a4
         subq #1,d4
         move #1,d6
.lab3:   if STE=1
	         move.l base,-(a6)
				move.l d5,-(a6)
				bsr mul
				move.l (a6)+,d5
			else
				muls.l base,d5
			endif
         moveq #0,d3
         move.b (a4)+,d3
         cmp.b #'.',d3				; pr‚sence d'un point d‚cimal?
         beq .reset_reel			; oui, on reprend tout … z‚ro, c'est un r‚‚l.
         sub.l #"0",d3
         bmi.s .bug3
         cmp.l #10,d3
         bmi.s .lab4
         subq.l #7,d3
         cmp #36,d3
         bmi.s .lab4
         sub.l #32,d3
.lab4:   cmp.l base,d3
         bpl.s .bug3
         add.l d3,d5
         dbf d4,.lab3
         tst d6
         beq.s .lab5
         neg.l d5
.lab5:   tst ass						; ici empile une constante
         beq.s .lab23				; si c'est interpr‚t‚
         clr d4						; 0 pour constante
         jsr assemblons				; assembler le code
         bra.s .lab24
.lab23:  clr (a2)+					; sinon 0 pour empiler
         move.l d5,(a2)+			; valeur constante
.lab24:  move.l basesav,base
         bra .suite
.bug14:  lea cbug14(pc),a0
			bra.s .bug31
.bug13:	lea cbug13(pc),a0
			bra.s .bug
.bug0:   lea cbug0(pc),a0
         bra.s .bug
.bug1:   lea cbug1(pc),a0
         bra.s .bug
.bug2:   lea cbug2(pc),a0
         bra.s .bug
.bug4:   lea cbug4(pc),a0
         bra.s .bug31
.bug3:   lea cbug3(pc),a0
.bug31:  bsr write_str
         lea mot,a0
.bug:    bsr write_str
         move #1,erreur
.bugend: move.l basesav,base
         move.l somsave,a6
         clr.b (a6)
         move.l a6,sommet
         move forthsav,forth
         move.l topsave,topprg
         bsr cache_off
         rts
.bugdef: lea cbug27(pc),a0		; def dans def
			bra.s .bug
.bugnodef: lea cbug28(pc),a0	; ";" sans d‚but de def
			bra.s .bug
.bugnoenddef: lea cbug26(pc),a0	; en sortie si ";" manque
			bra.s .bug		
.bug_full:
			lea cbug30(pc),a0		; plus de place pour un nouveau mot
			bra.s .bug
.bug_fulla:
			lea cbug31(pc),a0
			bra.s .bug
.bug44:
			lea cbug44(pc),a0
			bra.s .bug			
.bug22:					; dans ." et " voir si la chaine se poursuit … la ligne suivante
	move.b -(a2),d0
	cmp.b #'\',d0
	beq.s .found
	cmp.b #32,d0
	beq.s .bug22
	bra .bug2			; ni espace ni \, mauvaise fin de chaine
.found:
	cmp.b #'\',-(a2)
	bne.s .bug			; pas le signe \\

	tst.l inc_ptr		; en inclusion?
	beq.s .no_inc

	subq.l #1,a0		; retour sur le mot de taille
	bsr _load_line
	bne .bug2			; chaine incomplete, pas de ligne suivante...
	bra.s .ok2			; a0 est d‚j… positionnn‚ aprŠs tabulations

.no_inc:
	move ligne,d0
	cmp finb,d0			; fin du bloc??
	beq .bug2			; chaine incomplete, bloc fini

	addq #1,ligne

	tst.b (a0)+			; taille ligne
	beq .bug2			; chaine incomplete, fin de texte
	addq.l #1,a0		; saute les tabulations
.ok2:
	bra .lb15
	
	; ici erreur en sortie de compil pour les structures encore ouvertes
	
.bugloop3:
	tst.w 8(a1)			; case + of
	beq.s .bl3x
	clr.b cbug43
	lea cbug42(pc),a0
	bra .bug31	
.bl3x:	
	tst.b 7(a1)			; if ?
	beq.s .bl3z
	clr.b cbug39
	lea cbug38(pc),a0
	bra .bug	
.bl3z:
	tst.b 6(a1)			; -> ?
	beq.s .bl3d
	clr.b cbug35
	lea cbug34(pc),a0
	bra .bug
.bl3d:
	tst.b 4(a1)			; begin?
	beq.s .bl3a
	clr.b cbug25		; oui, message d'erreur sur begin
	lea cbug24(pc),a0
	bra .bug
.bl3a:
	tst.b 5(a1)			; while?
	beq.s .bl3c
	lea cbug23a(pc),a0
	bra .bug
.bl3c:					; sinon ici message d'erreur sur "do"
	clr.b cbug21		; pour ne pas lier les deux chaines
	lea cbug20(pc),a0
	bra .bug
	
	; ici erreur si on commence une d‚finiton avec des structures ou def d‚j… ouvertes
	
.bugloop2:
	neg erreur			; si 0, idem, si -1 (erreur dans assemblons) ‡a redevient 1.
	tst.w 8(a1)			; case + of
	beq.s .bl32a
	move.b #' ',cbug43
	lea cbug42(pc),a0
	bra .bug31	
.bl32a:	
	tst.b 7(a1)			; if ?
	beq.s .bl32
	move.b #' ',cbug39
	lea cbug38(pc),a0
	bra .bug31	
.bl32:
	tst.b 6(a1)			; -> ?
	beq.s .bl3
	move.b #' ',cbug35
	lea cbug34(pc),a0
	bra .bug31
.bl3:
	tst.b 4(a1)			; begin?
	beq.s .bl2
	move.b #' ',cbug25	; ici erreur avec begin
	lea cbug24(pc),a0
	bra .bug31
.bl2:
	move.b #' ',cbug21	; pour lier deux chaines
	lea cbug20(pc),a0	; boucle non ferm‚e avec d‚but/fin de d‚finition
	bra .bug31
	
	; ici structures qui se ferment mais n'ont pas ‚t‚ ouvertes
	
.bugloop:				; une boucle ferm‚e avant d'ouvrir
	tst.b 9(a1)			; of ?
	beq.s .bl1c
	lea cbug41(pc),a0
	bra .bug
.bl1c:
	tst.b 8(a1)			; case ?
	beq.s .bl1d
	lea cbug40(pc),a0
	bra .bug
.bl1d:
	tst.b 7(a1)			; if ?
	beq.s .bl1b
	lea cbug36(pc),a0
	btst #0,7(a1)
	bne .bug
	lea cbug37(pc),a0
	bra .bug	
.bl1b:
	tst.b 6(a1)			; -> ?
	beq.s .bl1a
	lea cbug32(pc),a0	; par d‚faut ->. sans ->
	btst #0,6(a1)		; -1 ?
	bne .bug				; oui
	lea cbug33(pc),a0	; sinon and/or sans ->
	bra .bug
.bl1a:
	lea cbug22(pc),a0
	move.w 4(a1),d0	; sans begin?
	bmi .bug
	lea cbug23(pc),a0		; repeat sans while?
	tst.b d0
	bmi .bug
	lea cbug16(pc),a0
	move.l (a1),d0		; pour chercher le compteur … -1
	bmi .bug
	lea cbug18(pc),a0
	tst d0
	bmi .bug
	lea cbug19(pc),a0
	tst.b d0
	bmi .bug
	lea cbug17(pc),a0
	bra .bug
	
	; ici gŠre la coh‚rence des ouvertures et fermetures de boucles	
	
.loop_count:
	lea loopnest,a1	; les 8 compteurs
	cmp #69,d4			; if
	bne.s .lc20
	addq.b #1,7(a1)
	rts
.lc20:
	cmp #71,d4			; then
	bne.s .lc21
	subq.b #1,7(a1)
	rts
.lc21:
	cmp #70,d4			; else
	bne.s .lc23
	tst.b 7(a1)			; d‚j… un if?
	bne.s .lc22			; ok
	subq.b #2,7(a1)	; sinon -2		
.lc22:
	rts 
.lc23:
	cmp #572,d4			; ndo
	bne.s .lc5
	addq.b #1,1(a1)
	rts
.lc5:
	cmp #573,d4			; nloop
	bne.s .lc6
	subq.b #1,1(a1)	; renvoie MI si erreur
	rts
.lc6:
	cmp #58,d4			; do
	bne.s .lc7
	addq.b #1,(a1)
	rts
.lc7:
	cmp #56,d4			; loop
	bne.s .lc8
.lc9:
	subq.b #1,(a1)
	rts
.lc8:
	cmp #156,d4			; ifloop
	beq.s .lc9
	cmp #57,d4			; +loop	
	beq.s .lc9	
	cmp #574,d4			; list?
	bne.s .lc0
	addq.b #1,3(a1)
	rts
.lc0:
	cmp #928,d4		; watch?
	bne.s .lc1
.lc2:
	subq.b #1,3(a1)	; renvoie MI si erreur
	rts
.lc1:
	cmp #575,d4		; dolist
	bne.s .lc3
	addq.b #1,2(a1)
	tst.b 3(a1)		; avec un list?
	bne.s .lc2		; oui donc on l'annule
	st 11(a1)			; le signale pour un warning
	rts				; et ignore (‡a sera dolist avec un tableau)
.lc3:
	cmp #576,d4			; lloop
	bne.s .lc4
	subq.b #1,2(a1)	; renvoie MI si erreur
	rts
.lc4:
	cmp #60,d4			; begin
	bne.s .lc14
	addq.b #1,4(a1)
	rts
.lc14:
	cmp #59,d4			; again
	bne.s .lc10
.lc11:
	subq.b #1,4(a1)	
	rts
.lc10:
	cmp #61,d4			; until
	beq.s .lc11
	cmp #62,d4			; while
	bne.s .lc12
	addq.b #1,5(a1)
	bra.s .lc11
.lc12:
	cmp #63,d4			; repeat
	bne.s .lc13
	subq.b #1,5(a1)
	rts
.lc13:
	cmp #65,d4			; case
	bne.s .lc24
	addq.b #1,8(a1)
	rts
.lc24:
	cmp #68,d4			; endcase
	bne.s .lc25
.lc28:
	subq.b #1,8(a1)
	rts
.lc25:
	cmp #66,d4			; of
	beq.s .lc26
	cmp #700,d4			; <>of
	beq.s .lc26
	cmp #701,d4			; >of
	beq.s .lc26
	cmp #702,d4			; <of
	bne.s .lc27
.lc26:
	tst.b 8(a1)			; un case ouvert?
	beq.s .lc28			; non erreur
	addq.b #1,9(a1)
	rts
.lc27:
	cmp #67,d4			; endof
	bne.s .lc29
	subq.b #1,9(a1)
	rts
.lc29:
	cmp #711,d4			; ->
	bne.s .lc15
	addq.b #1,6(a1)
	rts
.lc15:
	cmp #713,d4			; ->.
	bne.s .lc16
	subq.b #1,6(a1)	; renvoie MI si erreur
	rts
.lc16:
	cmp #712,d4			; and->
	beq.s .lc17
	cmp #714,d4			; or->
	bne.s .lc19
.lc17:
	tst.b 6(a1)			; si -> d‚j… pr‚sent...
	bne.s .lc18			; tout va
	subq.b #2,6(a1)	; sinon renvoie MI, mais -2 et pas -1
.lc18:
	rts
.lc19:
	moveq #0,d1			; renvoie pas MI	
	rts	
	; mot dans #mot
	; taille en d1
	; renvoie EQ si tout va bien
	; renvoie NE si erreur (plus de place)
		
add_word:
	move.l sommet,a3	; va ajouter le mot au vocabulaire
	lea 3(a3,d1.w),a4	; adresse n‚cessaire
	cmp.l #fin_new_names,a4
	bhi.s .exit			; renvoie NE, plus de place !
   move.b d1,(a3)+	; sa taille
   subq #1,d1
   move.l #mot,a4
.lab7:
   move.b (a4)+,(a3)+	; copie le mot
   dbf d1,.lab7
   move.l a3,sommet
   clr.b (a3)			; marque la fin
.exit:
   rts

flags: dcb.b 14,-1			; true de 0 … 13 (13 vrai car interpr‚teur)
	if STE=0
		dc.b -1					; flag 14 vrai si 68030
	else
		dc.b 0					; faux si 68000
	endif
	if LANG=0
		dc.b -1					; flag 15 vrai si fran‡ais
	else
		dc.b 0					; faux si anglais
	endif

	; ici combine deux flags
ifflag2:
	move.l -(a2),d7
	swap d7						; +/- n dans le mot haut
	clr d7						; annule le bas
	move.l d7,(a2)+
	bsr mot_commande
	bne.s _iff_comm			; si erreur, bug1
	tst.l d7
	bmi.s ifflag				; si flag ok, on teste le second
	subq.l #6,a2				; sinon, ignore le second flag
									; mais on v‚rifie que c'‚tait une constante
	move.w (a2),d0				; 0 en interpr‚t‚ et move.l #...,-(a6) en compil‚
	tst ass
	beq.s .lb0
	cmp.w #$2D3C,d0			; move.l #
	bne.s _iff_comm			; erreur, pas une constante
	bra.s .lb1
.lb0:		tst d0				; doit etre 0 pour une constante
	bne.s _iff_comm
.lb1:
	moveq #0,d0					; simule EQ pour ‚viter bug1
	bra.s _iff_comm			; avec D7=0, va sauter au endf suivant

ifflag:
	move.l -(a2),d7
	swap d7						; +/- n dans le mot haut
	clr d7						; annule le bas
	move.l d7,(a2)+
	bsr mot_commande
_iff_comm:
	bne.s .bug1
	tst.l d7
	bmi.s .ok					; si le flag est VRAI, on ne fait rien, la compilation continue
.lb0:
	move.l #'endf',d0
	bsr une_ligne				; avancer jusqu'… >endf
	bne.s .lb0
	cmp #0,a1					; >comp trouv‚, ok
	beq.s .ok
	lea .ibug2(pc),a0
	cmp #1,a1					; pas de >comp
	beq.s .erreur
	lea .ibug3(pc),a0			; si a1=2, fin de bloc
	bra.s .erreur
.ok:
	moveq #1,d0					; NE ok
	rts
.bug1:
	lea .ibug1(pc),a0
.erreur:
	moveq #0,d0					; EQ erreur
	rts
	if STE=0
.ibug1: dc.b " Erreur >ifflag/2: mauvais mot de commande.",0
.ibug2: dc.b " Erreur >ifflag/2: >endf manquant!",0
.ibug3: dc.b " Erreur >ifflag/2: fin de bloc avant >endf !",0
	else
.ibug1: dc.b " Error >ifflag/2: bad command word!",0
.ibug2: dc.b " Error >ifflag/2: missing >endf !",0
.ibug3: dc.b " Error >ifflag/2: block end before >endf !",0
	endif
	even

; traite le mot de commande de la forme
; %h 000n dddd
; n=num‚ro de flag (0-15)
; dddd une donn‚e selon la commande
; si le mot est n‚gatif c'est pour valider si le flag est faux
; renvoie:
; NE si mauvais mot de commande
; EQ si ok et D7 = xxxx dddd
; xxxx = 0 si FAUX et FFFF si vrai
; dddd = valeur conserv‚e

mot_commande:
			move.l -(a2),d7	; mot de commande
			bpl.s .lb1			; si positif, normal
			neg.l d7				; sinon, on inversera l'‚tat du flag
.lb1:
			swap d7				; le num‚ro du flag
			and #$F,d7			; de 0 … 15
			move.l a2,-(sp)
			lea flags,a2
			move.b 0(a2,d7.w),d7	; true ou flase
			ext.w d7				; FFFF ou 0000
			move.l (sp)+,a2
			tst.b (a2)			; ‚tait n‚gatif ou non?
			bpl.s .lb2			; positif, flag normal
			not d7				; sinon, prendre le contraire
.lb2:
			swap d7
_is_constant:
			move.w -(a2),d0	; 0 en interpr‚t‚ et move.l #...,-(a6) en compil‚
			tst ass
			beq.s .lb0
			cmp.w #$2D3C,d0	; move.l #
			bra.s .ok
.lb0:		tst d0
.ok:		rts					; renvoit NE en cas de prob ou EQ si Ok

	; v‚rifie qu'il y a bien une constant juste avant
	; sinon aucune action

prg_flags:
			move.l -(a2),d0		; flags
			bsr.s _is_constant
			bne.s .oups
			move.l -(a2),d0		; % ‚cran
			bsr.s _is_constant
			bne.s .oups
			move.l -(a2),d0		; langue qu'on force
			move d0,langage
			bra.s _is_constant
.oups:	rts

inclure:
			bsr.s mot_commande
			bne .bug1
.ok:
			tst.b (a0)
			beq .bug2			; chaine mal form‚e
			cmp.b #34,(a0)+		; cherche le " de d‚part
			bne.s .ok
			move.l a0,a1		; d‚but du nom
.lb1:
			tst.b (a0)
			beq .bug2
			cmp.b #34,(a0)+		; cherche le " final
			bne.s .lb1

			tst.l d7					; le flag
			bpl .ignorer			; ignorer, le flag n'est pas … -1

			tst in_def
			bne.s .deja_dico

			move d7,d0
			and #$9,d0
			cmp #9,d0
			beq.s .deja_dico		; pas de changement si c'est l'inclusion d'un FOR

		 	move.l a2,topsav2
         move.l #but,a2
         move.l (a2)+,d0
         move.l (a2),-4(a2)
         move.l d0,(a2)
         move.l topprg,a2	; passe dans le dicco

.deja_dico:
			move.l a0,a4		; conserve la fin
			clr.b -(a4)			; vire le " momentan‚ment
			move.l a2,a3		; au cas o— GEMDOS le d‚truise!

			move.l a2,a0		; c'est topprg en cours si dans une def
			tst in_def
			bne.s .deja_dico2
			move.l topprg,a0	; zone libre pour le chemin+nom
.deja_dico2:
			sf (a0)				; chaine normale+0
			jsr expand_path	; ‚tend les % de (a1)  avec le chemin actuel

			clr -(sp)
			move.l a0,-(sp)
			GEMDOS 61,8			; fopen
			move.b #34,(a4)+
			move.l a4,a0		; en cas de bug33 revenir sur le z‚ro final = fin de ligne
			move d0,d4			; le handle!
			bmi .bug33

			btst #0,d7			; =0 programme PRG, =1 autre
			beq .prg

			move #2,-(sp)
			move d4,-(sp)
			clr.l -(sp)
			GEMDOS 66,10
			move.l d0,d5		; taille totale du fichier
			bmi .bug3			; erreur de lecture

			clr -(sp)
			move d4,-(sp)
			clr.l -(sp)
			GEMDOS 66,10		; revient au d‚but du fichier
			tst.l d0
			bmi .bug3

			btst #3,d7			; fichier FOR ? ou DEF (constantes RSC) ?
			beq .autre2

			move.l #256,-(sp)	; reserve un nouveau bloc
		   GEMDOS 72,6
		   move.l d0,a0		; nouvelle adresse
		   lea inc_ptr,a1
		   move.l (a1),(a0)+	; chaine
		   move.l d0,(a1)		; nouveau pointeur courant
		   move d4,(a0)+		; garde le handle

			pea (a0)
			moveq #8,d0
			move.l d0,-(sp)	; 8 octets du header
			move d4,-(sp)
			GEMDOS 63,12		; fread
			cmp #8,d0
			bne .bug3

			btst #4,d7			; bit … 0, c'est un simple fichier FOR
			beq.s .verif_for
			
			clr -(sp)			; ici c'est un DEF (constantes RSC)
			move d4,-(sp)
			clr.l -(sp)
			GEMDOS 66,10		; retour au d‚but du fichier !
			move.l inc_ptr,a0
			st 255(a0)			; dernier octet = FF (DEF)
			addq.l #6,a0		; nombre de constantes (ou de lignes)
			moveq #0,d0
			move (a0)+,d0
			lsl.l #4,d0			; *16 = taille du fichier
			move #$0010,4(a0)	; simule une fin de ligne avec 16 octets … suivre
			sub.l d5,d0
			bgt .bug4			; taille incorrecte, format inconnu.
			beq.s .vt0			; si z‚ro, taille parfaite
			cmp.l #-16,d0		; un suppl‚mente de 16 octets (OCRS ajoute une ligne fictive)
			bne .bug4			; non d‚calage inconnu...
			add.l d0,d5			; r‚duit la taille … d5-16
			bra.s .vt0
			
.verif_for:
			move.l inc_ptr,a0
			sf 255(a0)			; dernier octet = 00 (FOR)
			addq.l #8,a0		; saute chainage + handle + nbr ligne
			move.l (a0),d0		; normalement taille fichier - 6
			addq.l #6,d0
.verif_taille:
			cmp.l d0,d5
			bne .bug4			; format non reconnu
.vt0:
			move.l a4,(a0)+	; sauvegarde compilptr
			tst.b (a0)			; normalement nul, c'est le d‚but d'une ligne !
			bne .bug4			; format non reconnu
			move.l a3,a2		; celui qui a ‚t‚ sauv‚
			bra .ignorer		; sortie avec Ok !

.autre2:
			btst #4,d7			; un module PARX ?
			beq.s .quelconque
			tst ass
			bne.s .deja
			move #437,(a3)+	; marqueur ASSembleur
.deja:
			move.l #$41fa0026,(a3)+	; lea module(pc),a0
			move.l #$2d084e75,(a3)+	; move.l a0,-(a6) // rts
			moveq #7,d0
.clear32:
			clr.l (a3)+
			dbf d0,.clear32	; ajoute les 32 octets qui pr‚cŠdent le module
									; puis en s‚quence, on inclut !
.quelconque:
			lea 0(a3,d5.l),a2
			move.l a2,-(sp)
			move.l a2,-(sp)
			move.l a2,-(sp)	; pour rester compatible avec les autres cas
			bra.s .lire

.prg:
			move.l a3,-(sp)	; pour charger
			moveq #28,d0
			move.l d0,-(sp)	; 28 octets du header
			move d4,-(sp)
			GEMDOS 63,12		; fread
			cmp #28,d0
			bne .bug3

			cmp #$601a,(a3)	; header?
			bne .bug4
			move.l 2(a3),d5	; taille TEXT
			move.l a3,-(sp)	; sauve d‚but text
			pea 0(a3,d5.l)		; sauve d‚but data
			add.l 6(a3),d5		; taille text+data
			pea 0(a3,d5.l)		; sauve fin DATA
			add.l d5,d0			; text+data+header
			add.l 14(a3),d0	; plus symboles -> offset pour le relogement
			move.l d0,off_relog

.lire:
			lea 0(a3,d5.l),a2
			cmp.l but,a2
			bpl .bug7			; pas assez de m‚moire

			move.l a3,-(sp)
			move.l d5,-(sp)
			move d4,-(sp)
			GEMDOS 63,12		; fread

			cmp.l d5,d0
			beq .lb2
			lea 12(sp),sp		; vire les trois .L sauv‚s
			bra .bug3

.lb2:

			move.l (sp)+,d0	; fin data
			move.l (sp)+,a3	; d‚but data
			move.l (sp)+,a2	; d‚but TEXT

			btst #0,d7
			bne .raw			; chargement brut
			cmp.l #"ADD_",(a3)+
			bne .raw
			cmp.l #"DEFS",(a3)+
			bne .raw

			lea -8(a3),a0		; arret du relogement aux datas
			bsr reloge_ferme	; reloge ‚ventuellemnt et ferme le fichier
			move.l a4,a0		; restaure le pointeur de texte

			tst in_def
			bne .bug6			; def dans def!
.ok2:
			move.l a3,d0
			subq.l #8,d0		; d0 pointe sur d‚but DATA
			moveq #0,d1			; aucun mot par d‚faut
.lb3:
			move.l (a3)+,d2	; adresse
			bmi.s .lb4			; si <0, c'est la fin
			addq #1,d1			; un mot de plus
			add.l a2,d2			; offset TEXT
			lea adresse,a1
			move forth,d4
			lsl #2,d4
			move.l d2,0(a1,d4.w)	; range l'adresse
			addq #1,forth
			bra.s .lb3
.lb5:		move.l sommet,a2
			lea 1(a2),a1
.lb6:
			move.b (a3)+,(a1)+
			bne.s .lb6
			subq.l #1,a1
			move.l a1,sommet
			sub.l a2,a1
			subq #1,a1
			move a1,d2
			move.b d2,(a2)			; sa taille
.lb4:
			dbf d1,.lb5
			move.l d0,a2		; pointeur au d‚but des DATAS (ignor‚s donc!)
			bra.s .fin_ok
.raw:
			move.l d0,a0		; arret du relogement en fin de datas
			bsr reloge_ferme	; reloge ‚ventuellement et ferme le fichier
			move.l a4,a0		; restaure le pointeur de texte
			tst in_def
			beq .bug5
			move.l d0,a2		; pointeur en fin de DATAS
.fin_ok:
			btst #1,d7			; =1 ignorer parit‚ dicco, =0 assurer parit‚
			bne.s .pas_pair
			move.l a2,d0
			addq.l #1,d0
			bclr #0,d0
			move.l d0,a2		; rend a2 pair (avec ‚ventuellement +1)

.pas_pair:
			tst in_def
			bne.s .deja_dico_2

			move.l a2,topprg	; ressort du dicco
         move.l #but,a2
         move.l (a2)+,d0
         move.l (a2),-4(a2)
         move.l d0,(a2)
         move.l topsav2,a2

.deja_dico_2:
.ignorer:
			moveq #1,d0			; renvoit NE
			rts
.bug1:   lea cbug9(pc),a0
			bra.s .fin_bug
.bug2:   lea cbug10(pc),a0
			bra.s .fin_bug
.bug33:  cmp.b #$FF,edsav+1	; marqueur pour premier appel AUTOEXEC
			bne.s .bug3				; erreur normale
			clr.b edbuf				; pas de AUTOEXEC trouv‚ annuler ligne de commande
			sf edsav+1				; vire le marqueur
			bra.s .ignorer
.bug3:	lea cbug8(pc),a0
			bra.s .fin_bug
.bug4:   lea cbug7(pc),a0
			bra.s .fin_bug
.bug5:   lea cbug5(pc),a0
			bra.s .fin_bug
.bug6:	lea cbug6(pc),a0
			bra.s .fin_bug
.bug7:   move d4,-(sp)
			GEMDOS 62,4			; ferme le fichier
			lea cbug11(pc),a0
			bra.s .fin_bug

			nop
.fin_bug:
			sub d0,d0			; pour avoir EQ au retour
			rts

flag_cond:
	cmp #916,d4					; >accname?
	beq.s .skip
	bsr mot_commande
	bne .bug1					; mot de commande absent
	and #$f,d7
	beq .bug1
.skip:
	move.l a2,-(sp)
	lea flags,a2
	cmp #916,d4					; >accname?
	beq.s .demande
	cmp #902,d4					; ask ?
	bne.s .lb1
.demande:
	tst.b (a0)
	beq .bug2			; chaine mal form‚e
	cmp.b #34,(a0)+		; cherche le " de d‚part
	bne.s .demande
	move.l a0,a1		; d‚but du nom
.fin:
	tst.b (a0)
	beq .bug2
	cmp.b #34,(a0)+		; cherche le " final
	bne.s .fin
	cmp #916,d4
	beq.s .sortie		; >accname, simplement passer la chaine
	move.l a0,a4		; conserve la fin
	clr.b -(a4)			; vire le " momentan‚ment
	movem.l d1-d7/a0/a2-a6,-(sp)
	move.l a1,-(sp)
	bsr cr
	move.l (sp)+,a0
	bsr write_str
	lea .ask(pc),a0
	bsr write_str
	bsr cr
	move.l #$20002,-(sp)
	trap #13
	addq.l #4,sp
	movem.l (sp)+,d1-d7/a0/a2-a6
	move.b #34,(a4)	; remet la fin de chaine
	or.b #$20,d0		; minuscule
	if LANG=1
		cmp.b #'y',d0
	else
		cmp.b #'o',d0
	endif
	bra.s .lb2
.lb1:
	cmp #863,d4					; si=863, true sinon false
.lb2:
	seq 0(a2,d7.w)
.sortie:
	move.l (sp)+,a2
	moveq #1,d0
	rts
.bug2:
	move.l (sp)+,a2
	lea cbug15(pc),a0			; mauvaise chaine
	bra.s .exit
.bug1: lea cbug12(pc),a0
.exit:
	moveq #0,d0
	rts
	if LANG=1	
.ask:
	dc.b " (Y/N) ?",0
	else
.ask:
	dc.b " (O/N) ?",0
	endif
	even
	


	if 0
debal:
	move.l (sp)+,.truc			; adresse retour
	move.l (sp)+,.truc+4		; paramŠtre
	move.l .truc(pc),-(sp)	; remet le retour
	movem.l d0-d2/a0-a2,-(sp)
	move.l .truc+4,d0
	lea .val(pc),a0
	moveq #7,d1
.lb0:
	move d0,d2
	and #$F,d2
	add #'0',d2
	cmp #'9'+1,d2
	bmi.s .lb1
	add #'A'-'9'-1,d2
.lb1:
	move.b d2,-(a0)
	lsr.l #4,d0
	dbf d1,.lb0
	lea .alerte(pc),a0
	jsr forth_alert	
	movem.l (sp)+,d0-d2/a0-a2
	rts
.truc: dc.l 0,0
.alerte: dc.b "[1][ Valeur : 00000000"
.val:	dc.b " ][ Ok ]",0
	even
	
	endif

off_relog: dc.l 0			; offset de la table de relogement

; attend a0:finde la zone … reloger
;			a2:d‚but de la zone et debut de text aussi
;			d0:fin zone data (donc l… ou on peut charger la table)

reloge_ferme:
	movem.l d0/a3,-(sp)
	btst #0,d7
	bne.s .fin			; pas un programme! juste fermer
	move.l d0,a3		; adresse ou charger
	btst #2,d7
	bne.s .fin			; bit mis, pas de relogement
	move.l a0,-(sp)	; sauve critŠre de fin
	clr -(sp)			; … partir du d‚but du fichier
	move d4,-(sp)		; handle
	move.l off_relog,-(sp)
	GEMDOS 66,10
	move.l a3,-(sp)	; adresse ou charger
	move.l #$7fffffff,-(sp) ; jusqu'au bout
	move d4,-(sp)
	GEMDOS 63,12
	move.l (sp)+,a0	; le critŠre de fin
	move.l a2,a1
	move.l a2,d1
	tst.l (a3)			; pr‚sence d'une table ou non?
	beq.s .fin			; non...
	add.l (a3)+,a1		; premiŠre location
	moveq #0,d0
.loop:
	cmp.l a0,a1			; critŠre de fin
	bpl.s .fin			; on d‚passe de la zone … reloger
	add.l d1,(a1)		; reloge
.lb1:
	move.b (a3)+,d0
	beq.s .fin			; un z‚ro? c'est fini
	cmp #1,d0
	beq.s .lb0			; 1? il faut avancer de 254...
	add.w d0,a1			; sinon, c'est un offset
	bra.s .loop
.lb0:
	add.w #254,a1
	bra.s .lb1
.fin:
	move d4,-(sp)		; ferme le fichier
	GEMDOS 62,4
	movem.l (sp)+,d0/a3
	rts

export_source:
	bsr mot_commande
	bne .bug1					; mot de commande absent
	swap d7						; 0 ou -1
.ok:
	tst.b (a0)
	beq .bug2			; chaine mal form‚e
	cmp.b #34,(a0)+		; cherche le " de d‚part
	bne.s .ok
	move.l a0,a1		; d‚but du nom
.lb1:
	tst.b (a0)
	beq .bug2
	cmp.b #34,(a0)+		; cherche le " final
	bne.s .lb1

	tst d7
	beq.s .lb0			; pas d'export, on simule!

	move.l a0,a4		; conserve la fin
	clr.b -(a4)			; vire le " momentan‚ment

	movem.l a0/a2,-(sp)
	move.l topprg,a0	; zone libre pour path complet
	sf (a0)				; chaine normale + 0
	jsr expand_path

	clr -(sp)
	move.l a0,-(sp)
	GEMDOS 60,8			; fcreate
	move.b #34,(a4)	; remet "
	movem.l (sp)+,a0/a2
	move d0,d6			; handle
	bmi .bug3			; cr‚ation impossible

.lb0:
	move.l #'comp',d0	; critŠre de fin
	bsr une_ligne
	beq .fin
	tst d7 				; simuler ou sauver?
	beq .lb0

	movem.l a0/a2,-(sp)
	move.l a1,-(sp)	; adresse d‚but ligne
	move.l d1,-(sp)	; taille ligne
	move d6,-(sp)
	GEMDOS 64,12		; fwrite
	movem.l (sp)+,a0/a2
	tst d0
	bmi .bug4			; erreur d'‚criture
	bra.s .lb0

.fin:
	tst d7
	beq.s .lb2			; on simule

	movem.l a0-a2,-(sp)
	move d6,-(sp)
	GEMDOS 62,4
	movem.l (sp)+,a0-a2

	cmp #1,a1			; a1=1 si >comp manque!
	beq .bug5			; >comp manquant
	cmp #2,a1			; a1=2 si fin de bloc
	beq .bug6

.lb2:
	moveq #1,d0			; pas d'erreur!
	rts
.bug1: lea .ex_bug1(pc),a0
	bra.s .fin_bug
.bug2: lea .ex_bug2(pc),a0
	bra.s .fin_bug
.bug3: lea .ex_bug3(pc),a0
	bra.s .fin_bug
.bug4: lea .ex_bug4(pc),a0
	bra.s .fin_bug
.bug5: lea .ex_bug5(pc),a0
	bra.s .fin_bug
.bug6: lea .ex_bug6(pc),a0
.fin_bug:
	sub d0,d0
	rts

	if LANG=0
.ex_bug1: dc.b " Erreur >export: mauvais mot de commande!",0
.ex_bug2: dc.b " Erreur >export: chaine incomplŠte!",0
.ex_bug3: dc.b " Erreur >export: cr‚ation du fichier impossible!",0
.ex_bug4: dc.b " Erreur >export: ‚criture sur fichier impossible!",0
.ex_bug5: dc.b " Erreur >export: >comp manquant!",0
.ex_bug6: dc.b " Erreur >export: fin de bloc avant >comp!",0
	else
.ex_bug1: dc.b " Error >export: bad command word!",0
.ex_bug2: dc.b " Error >export: uncomplete string!",0
.ex_bug3: dc.b " Error >export: can't create file!",0
.ex_bug4: dc.b " Error >export: can't write to file!",0
.ex_bug5: dc.b " Error >export: missing >comp !",0
.ex_bug6: dc.b " Error >export: block end before >comp!",0
	endif
	even

une_ligne:
	move.l d0,.end_criter	; 'comp' ou 'endf'
.lb00:
	tst.b (a0)+
	bne.s .lb00				; avancer jusqu'… la ligne suivante
	tst.l inc_ptr			; sommes nous en inclusion?
	beq.s .no_inc
	subq.l #1,a0			; retour sur le mot de taille
	move (a0),d1			; taille ligne
	bsr _load_line
	bne.s .erreur			; fichier ferm‚ sans avoir trouv‚ le critŠre de fin
	subq.l #1,a0			; retour sur la tabulation
	bra.s .commun
.no_inc:
	move ligne,d0
	cmp finb,d0
	beq.s .bug_bloc
	addq #1,ligne
	subq.l #1,a0
	move.w (a0)+,d1		; taille ligne
	beq .erreur				; fin de source sans >comp!
.commun:
	moveq #0,d0
	move.b (a0)+,d0		; tabulation+1
	lea commande_buf,a1			; pour construire la ligne
	subq #1,d0
	bra.s .lb1
.lb0:
	move.b #' ',(a1)+
.lb1:
	dbf d0,.lb0				; les espaces au d‚but
	cmp.b #'>',(a0)
	bne.s .normal
	move.l .end_criter(pc),d0	; comp ou endf
	cmp.l 1(a0),d0
	beq.s .fin
.normal:
	subq #4,d1				; moins taille et tab
.copie:
	move.b (a0)+,(a1)+
	dbf d1,.copie
	cmp.b #32,-1(a1)
	bne.s .lb2
	subq.l #1,a1
.lb2:
	move.b #13,(a1)+
	move.b #10,(a1)+
	move.l a1,d1
	lea commande_buf,a1			; d‚but ligne
	sub.l a1,d1				; taille ligne
	moveq #1,d0				; renvoit NE, ok!
	rts
.fin:
	move #0,a1				; pas d'erreur, mais un >comp!, a0 reste sur >comp.
	bra.s .sortie
.bug_bloc:
	move #2,a1
	bra.s .sortie
.erreur:
	move #1,a1				; grosse erreur
.sortie:
	moveq #0,d0				; renvoit EQ
	rts
.end_criter:
	dc.l 0

exec_prog:
	bsr mot_commande
	bne .bug1				; pas de mot de commande
	lea commande_buf,a1			; les chaines
.ok:
	tst.b (a0)
	beq .bug2			; chaine mal form‚e
	cmp.b #34,(a0)+		; cherche le " de d‚part
	bne.s .ok
.lb1:
	move.b (a0)+,d0
	beq .bug2				; mal ternim‚e!
	cmp.b #34,d0		; cherche le " final
	beq.s .lb3
	move.b d0,(a1)+
	bra.s .lb1
.lb3:
	clr.b (a1)+

.lb4:
	tst.b (a0)+
	bne.s .lb4			; fin de cette ligne

	tst.l inc_ptr		; en inclusion?
	beq.s .no_inc

	subq.l #1,a0		; retour sur le mot de taille
	bsr _load_line
	bne .bug3			; chaine paramŠtres absente dans ce fichier
	bra.s .ok2			; a0 est d‚j… positionnn‚ aprŠs tabulations

.no_inc:
	move ligne,d0
	cmp finb,d0			; fin du bloc??
	beq .bug7

	addq #1,ligne

	tst.b (a0)+			; taille ligne
	beq .bug3			; chaine absente
	addq.l #1,a0		; saute les tabulations

.ok2:
	tst.b (a0)
	beq .bug2			; chaine mal form‚e
	cmp.b #34,(a0)+		; cherche le " de d‚part
	bne.s .ok2
	move.l a0,d1		; emplacement initial
.lb12:
	move.b (a0)+,d0
	beq .bug2				; mal ternim‚e!
	cmp.b #34,d0		; cherche le " final
	bne.s .lb12
	lea -1(a0),a4		; garde le "
	clr.b (a4)

	move.l a1,a0		; l… ou ‚tendre la chaine
	st (a0)				; chaine avec taille initiale
	move.l d1,a1		; chaine … ‚tendre
	jsr expand_path
	move.b #34,(a4)+	; remet la chaine
	exg.l a0,a4			; a0 redevient le pointeur de compilation
							; a4 adresse de la chaine ‚tendue

	tst.l d7
	bpl .lb5				; si non n‚gatif, flag invalid‚ on saute!

	movem.l a0/a2,-(sp)

	btst #3,d7
	bne.s .lb9			; ignorer fenˆtre

	tst.b w_flag
	beq.s .lb9			; d‚j… ferm‚e

	move.l a1,-(sp)
	lea wg_int,a0
	move.l (a0),d4
	move w_hand,(a0)+
	move #5,(a0)		; espace total
	GEM_AES wind_get0	; taille dans wg_out
	GEM_AES wind_close
	move.l (sp)+,a1
.lb9:
	pea -2(a1)			; environnement nul
	pea (a4)				; commande
	pea commande_buf	; programme
	clr -(sp)			; mode load and go
	GEMDOS 75,16
	movem.l (sp)+,a0/a2
	move.l d0,d6		; valeur renvoy‚e
	bpl.s .pas_bell
	move.l #$20007,-(sp)
	move #3,-(sp)
	trap #13
	addq.l #6,sp		; son de cloche, erreur PEXEC!
.pas_bell:
	moveq #0,d5			; pas d'arrˆt
	btst #0,d7
	bne.s .lb6			; pas de touche
	movem.l a0/a2,-(sp)
	move.l #$20002,-(sp)
	trap #13
	addq.l #4,sp
	cmp.b #27,d0
	seq d5				; d5=FF si touche escape
	movem.l (sp)+,a0/a2
.lb6:

	btst #3,d7
	bne.s .lb7			; ignorer fenˆtre

	tst.b w_flag
	beq.s .lb7			; n'‚tait pas ouverte avant...

	movem.l a0/a2,-(sp)
	move w_hand,wg_out
	move.l d4,wg_int
	GEM_AES wind_open
	jsr cls
	movem.l (sp)+,a0/a2

.lb7:
	tst.l d6
	bmi .bug4			; erreur GEMDOS au chargement

	btst #1,d7
	bne.s .lb8			; pas v‚rifier si renvoi < 0
	tst d6
	bmi .bug5			; valeur renvoy‚e n‚gative!
.lb8:
	btst #2,d7
	bne.s .lb5
	tst d6
	beq.s .lb15
	bpl.s .bug5
.lb15:
	tst.b d5
	bne .bug6			; arrˆt utilisateur!

.lb5:
	moveq #1,d0
	rts					; tout est ok!
.bug1: lea .ex_bug1(pc),a0
	bra.s .fin_bug
.bug2: lea .ex_bug2(pc),a0
	bra.s .fin_bug
.bug3: lea .ex_bug3(pc),a0
	bra.s .fin_bug
.bug4: lea .ex_bug4(pc),a0
	bra.s .fin_bug
.bug5:
	move.l pilptr,a6
	ext.l d6					; d‚poser code d'erreur sur la pile!
	move.l d6,-(a6)
	move.l a6,pilptr
	lea .ex_bug5(pc),a0
	bra.s .fin_bug
.bug6:
	lea .ex_bug6(pc),a0
	bra.s .fin_bug
.bug7:
	lea .ex_bug7(pc),a0
.fin_bug:
	moveq #0,d0
	rts
	if LANG=0
.ex_bug1: dc.b " Erreur >exec: mauvais mot de commande!",0
.ex_bug2: dc.b " Erreur >exec: chaine incomplŠte!",0
.ex_bug3: dc.b " Erreur >exec: chaine commande absente!",0
.ex_bug4: dc.b " Erreur >exec: impossible de lancer le programme!",0
.ex_bug5: dc.b " Erreur >exec: le programme lanc‚ signale une erreur!",0
.ex_bug6: dc.b " Message >exec: compilation interrompue.",0
.ex_bug7: dc.b " Erreur >exec: fin de bloc en milieu de commande!",0
	else
.ex_bug1: dc.b " Error >exec: bad command word!",0
.ex_bug2: dc.b " Error >exec: uncomplete string!",0
.ex_bug3: dc.b " Error >exec: missing command string!",0
.ex_bug4: dc.b " Error >exec: can't run program!",0
.ex_bug5: dc.b " Error >exec: the child process returns an error!",0
.ex_bug6: dc.b " Message >exec: compilation was stopped.",0
.ex_bug7: dc.b " Error >exec: unexpected end of block!",0
	endif
	even

	; cr‚e des mots dans le dicco d‚finis par
	; >fom mot,mot,mot 
	
	
fom_words:
	tst.b (a0)		; ici on cherche le d‚but du premier mot
	beq.s .fin		; fin de ligne !
	cmp.b #32,(a0)
	bne.s .boucle	; plus d'espace, on y est
	addq.l #1,a0
	bra.s fom_words
.boucle:
	bsr .mot_suiv
	bne.s .ok
.fin:
	rts				; si EQ, fin de liste
.ok:
	bsr find_word
	beq.s .ok2
	rts				; renvoie NE si mot d‚j… pr‚sent
.ok2:
	moveq #0,d0
	move forth,d0
	lsl.l #2,d0
	lea adresse,a1
	lea 4(a1,d0.l),a1
	cmp.l #fin_new_adr,a1
	bhi.s .bug_fulla
	move.l topprg,a3
	move.l a3,-(a1)		; adresse du nouveau mot
	move.l #$01B52D3C,(a3)+	; 437 marqueur mot assembl‚, 2d3c=move.l #...,-(a6)
	move.l sommet,(a3)+	; sera l'adresse de la taille du mot
	move #$4EF9,(a3)+			; jmp
	move.l #fom_undef,(a3)+
	addq.l #2,a3			; en cas de XFOM, pour l'instruction moveq #n,d0
	move.l a3,topprg		; nouvelle fin de dicco
	addq #1,forth			; un mot de plus
	bsr add_word			; ajoute le mot dans le dictionnaire
	beq.s .boucle			; suivant! (si EQ tout va bien)
	moveq #-1,d2			; erreur plus de place pour les noms
	rts
.bug_fulla:
	moveq #-2,d2			; erreur plus de place pour les adresses
	rts
.mot_suiv:
	move.b (a0),d0
	beq.s .finliste		; 1er caractŠre nul, plus de mots, renvoie EQ
	cmp #32,d0				; 1er caractŠre espace? plus de mots
	beq.s .finliste		; renvoie EQ
	lea mot,a3
	moveq #0,d1				; taille	
.ms0:
	move.b (a0)+,d0		; un caractŠre
	beq.s .termine0
	cmp.b #',',d0			; s‚parateur?
	beq.s .termine
	cmp.b #32,d0			; espace?
	beq.s .termine0
	move.b d0,(a3)+		; sinon, un caractŠre de plus dans le mot
	addq.l #1,d1
	bra.s .ms0	
.termine0:
	subq.l #1,a0			; revient sur le z‚ro ou espace pour garder fin de ligne	
.termine:
	clr.b (a3)
	tst.l d1					; renvoie NE si un mot trouv‚
.finliste:
	rts

fom_undef:
	move.l (a6)+,a0
	moveq #0,d0
	move.b (a0)+,d0		; taille du mot
	subq #1,d0				; pour la boucle
	lea .alerte2(pc),a1
	moveq #29,d1
	cmp.b d0,d1
	bpl.s .ok
	move.b d1,d0
.ok:
	move.b #32,(a1)+
	dbf d1,.ok				; efface la zone avec des espaces
	lea .alerte2(pc),a1
.copie:
	move.b (a0)+,(a1)+
	dbf d0,.copie			; ajoute le nom
	moveq #1,d0
	move.l d0,-(a6)
	lea .alerte(pc),a0
	move.l a0,-(a6)
	jsr form_alert
	clr.l -(a6)				; renvoie 0, comme si modxxxx avait plant‚
	rts

	if LANG=0
.alerte: 
	dc.b "[3][ Aucun module, via modload | n'a red‚fini le mot : | | "
	else
.alerte:
	dc.b "[3][ No module, via modload | has defined the word : | | "
	endif
.alerte2:
	dc.b "                               ][ Ok ]",0
	even
	

; ah, les jolies routines
; chacune pr‚c‚d‚e de 2 octets
;          code d'assemblage :
; 0 non
; 2 recopie du code : deux octets encore en amont indiquent la taille
;                     en mots moins 1
; 3 saut ( jsr vers cette routine )
; autres, assemblages particuliers

   NON
fff: bsr ttt
   move #580,(a2)+
   move forth,(a2)+
   move.l sommet,(a2)+
   addq.l #4,a2
   move.l a2,-4(a2)
   move.l a2,(a0)
   rts

 include "commun.s"

   NON
trace: move.l (a6)+,d1
   move d1,trcmot
   move #-1,trc
   clr.l trace_flags
   move.l #tracexe,(sp)
   rts

   NON
untrc: clr trc
	tst isfast
	bne.s .lb0
	move.l #slowexe,(sp)
   rts
.lb0:
	move.l #fastexe,(sp)
	rts

	NON
watch:
	lea watchlist,a1
	move.l lst,d0				; ancien pointeur avant la liste
	beq.s .end
.loop:
	cmp.l a6,d0
	beq.s .end
	move.l (a6)+,d1
	move d1,(a1)+
	bra.s .loop
.end:
	clr (a1)
	clr.l lst
	rts

   COPIE selplus,y300
selplus: move #-1,selmode
y300: rts

   COPIE selmoins,y301
selmoins: clr selmode
y301: rts


; a4-a5-a6 restent les pointeurs FORTH
; a0: pointe sur la chaine … ajouter
; a1: pointe sur la chaine temporaire
; a3: pointe sur la chaine en cours d'ajout depuis a0
; a2 : pointe dans le tableau des arbres analys‚s (quand on parse)
; d0-d1 … tout faire
; d2 bit 31 si au moins une fenˆtre, mot bas … tout faire
; d3-adresse du menu si pr‚sent
; d4: conserve le a2 en cas de retour sur les boutons EXIT d'un objet
; d5
; d6
; d7

; dans DEF:
; alerte:
; xx xx 12 00 xx xx xx 04 NOM



	SAUT
rsc2for: tst selmode
   bne.s .lb0
   move.l (a6)+,a0
   bra.s .lb1
.lb0:
	move.l #chedef,addrin
   move.l #fichdef,addrin+4
	bsr selecteur
	beq .fin
.lb1:
	if STE=0
		bsr.l remember
	else
		jsr remember
	endif
	move.l a5,-(a6)	; sauve pointer d'ex‚cution
	move.l a0,-(a6)	; keep name
	move.l topprg,a1
	move.l a1,-(a6)	; DEF address
	move.l a1,-(a6)	; for RSC address
	bsr .charge
	bmi .not_found
	add.l d0,(a6)		; update RSC pointer
	move.l 4(a6),a0	; DEF pointer
	moveq #0,d1
	move (a0),d1		; number of names
	lsl.l #4,d1			; *16
	sub.l d0,d1			; 16n-size
	beq.s .sizeok		; perfect size (INTERFACE)
	cmp.l #-16,d1		; ORCS add 16 extra bytes
	bne .not_found	; format error	because number of items > size
.sizeok:
	move.l 8(a6),a0	; filename
	move.l a0,a1
.lb2:
	tst.b (a1)+
	bne.s .lb2
	subq.l #1,a1
	move.b #'C',-(a1)
	move.b #'S',-(a1)
	move.b #'R',-(a1)	; turn DEF into RSC
	move.l (a6),a1		; RSC address
	; le RSC commence toujours par 00, donc termine la derniŠre chaine du DEF
	bsr .charge
	bmi .not_found
	move.l (a6),a3
	addq.l #1,d0
	bclr #0,d0
	add.l d0,a3			; fin paire aprŠs RSC
	move.l a3,topprg	; nouvelle zone libre
	pea .fl40(pc)
	moveq #0,d7
	bsr .add_comment
	bsr .add_rsc_load	; ligne rsrc_load avec nom du RSC
	bsr .add_include	; ligne d'inclusion du DEF
	bsr .add_cr			; saut
	pea .fl41(pc)
	moveq #0,d7
	bsr .add_comment	
	bsr .tools			; si le DEF contient des alertes, ajouter do_alert, et autres outils
	bsr .analyse		; construire la structure avec les arbres et leurs ‚l‚ments EXIT
;	bsr .track_errors	; cherche des object actifs sans nom et les signale
	bsr .drop_down		; recherche objets Exit+bit8 et marque les arbres dropdown en cons‚quence, ajoute les outils
							; signale aussi les erreurs de liens entre objet et dropdown
	bsr .add_comp
	pea .fl42(pc)
	moveq #0,d7
	bsr .add_comment
	bsr .def_tree		; ajouter les cr‚ations d'arbres et des fenˆtres
	bsr .add_comp
	bsr .init_strings	; ajoute l'initialisation des chaines pour les gem_list qui en ont
	bsr .manage_tree	; ajoute les routines de gestion des arbres ou des fenˆtres
	bsr .add_comp
	pea .fl43(pc)
	moveq #0,d7
	bsr .add_comment
	bsr .add_main		; routine principale
	bsr .add_comp
	pea .fl44(pc)
	moveq #0,d7
	bsr .add_comment
	bsr .add_structure	; en commentaire, toute la structure du DEF pour s'y retrouver !
	bra .exit
.charge:
	clr.l -(a6)	; offset 0
	moveq #-1,d0
	move.l d0,-(a6)	; all file
	move.l a0,-(a6)	; filename of DEF
	move.l a1,-(a6)	; address
	bsr loadbin
	move.l (a6)+,d0	; return
	rts
.not_found:
   ACONTROL 53,1,1,0
   move #2,intin	; file not found
   AES
.exit:
	move.l bfptr,a0
	clr (a0)			; marque la fin des lignes
	lea 12(a6),a6	; remove 3 pointers
	if STE=0
		bsr.l restore
	else
		jsr restore
	endif
	move.l (a6)+,a5	; retrouve pointeur d'ex‚cution
.fin: rts	
.start_vline:
	move.l topprg,a3
	move.l a3,a0
	rts
.add_rsc_load:
	bsr.s .start_vline
	move.w #$0122,(a3)+	; tab + "
	move.b #32,(a3)+
	move.l 8(a6),a1		; rsc name
	bsr .copy_a1_a3
	subq.l #1,a1
	move.b #'F',-(a1)
	move.b #'E',-(a1)
	move.b #'D',-(a1)
	lea .vl1(pc),a1
	bsr .copy_a1_a3
	bsr .add_var_line
	rts
.add_include:
	bsr.s .start_vline
	lea .vl0(pc),a1
	bsr .copy_a1_a3
	move.l 8(a6),a1		; DEF name
	bsr .copy_a1_a3
	move.b #34,(a3)+		; ferme "
	clr.b (a3)				; termine la chaŒne
	bsr .add_var_line
	rts
.tools:
	lea .fl25a(pc),a0		; obj_addr
	bsr .add_fixed_line
	lea .fl25(pc),a0
	bsr .add_fixed_line	; assign_string
	lea .fl26(pc),a0
	bsr .add_fixed_line	; assign_fstring
	lea .fl27(pc),a0
	bsr .add_fixed_line	; get_obstate
	lea .fl28(pc),a0
	bsr .add_fixed_line	; set_obstate
	lea .fl29(pc),a0
	bsr .add_fixed_line	; update_win
	lea .fl30a(pc),a0
	bsr .add_fixed_line	; update_button
	bsr .init_parse
	moveq #0,d1				; defaut pas d'alerte
.a0:
	cmp.b #4,7(a2)			; une alerte?
	bne.s .a1
	move #$1200,2(a2)		; type alerte
	moveq #1,d1
.a1:
	lea 16(a2),a2
	dbf d0,.a0
	tst.l d1
	beq.s .a2				; rien trouv‚
	lea .fl0(pc),a0		; il y a des alertes
	bsr .add_fixed_line	; ajouter do_alert
.a2:
	rts
.init_parse:
	move.l 4(a6),a2		; DEF
	move (a2),d0			; taille
	subq.l #1,d0			; pour la boucle
	rts
.copy_8a2_a3:
	lea 8(a2),a1
.copy_a1_a3:
	move.b (a1)+,(a3)+
	bne.s .copy_a1_a3
	subq.l #1,a3
	rts
.add_comp:
	bsr.s .add_cr
.add_comp2:
	lea .fl1(pc),a0
	bsr.s .add_fixed_line
	bra.s .add_cr
	; a0 adresse
.add_fixed_line:
	move.l bfptr,a1	; fin editeur
	move.w (a0)+,d0	; taille ligne
	move d0,(a1)+
	subq #3,d0
.afl0:
	move.b (a0)+,(a1)+	; ligne
	dbf d0,.afl0
.afl1:
	move.l a1,bfptr	; nouvelle fin
	addq #1,topedit	; une ligne de plus
	rts
.add_cr:
	move.l bfptr,a1
	move.l #$00040120,(a1)+	; ligne vide
	bra.s .afl1
	; a0 adresse juste des octets (avec tabulation)
.add_var_line:
	move.l bfptr,a1
	addq.l #2,a1	; saute la taille
.avl0:
	move.b (a0)+,(a1)+
	bne.s .avl0
	move.b #32,-1(a1)	; au cas o—...
	move.l a1,d0
	bclr #0,d0
	move.l d0,a1		; fin paire
	move.l bfptr,a0	; d‚but de ligne
	sub.l a0,d0			; taille
	move d0,(a0)		; qu'on range
	bra.s .afl1	

; l'analyse cr‚e cette structure en 256(a3)
; et modifie le DEF

; ii=num‚ro d'arbre, ou num‚ro de chaine

; le DEF---------------
; menu
; 00 00 10 00 00 ii 00 02 +nom
; dialogue
; 00 00 11 00 00 ii 00 03 +nom

; chaine libre: type fenetre, mmmm masque wincreate
; qui vient recouvrir les octets 4-5
; 00 00 0E 00 00 ii 00 05 +nom
; 00 00 0E 00 mm mm 00 05 +nom d‚cal‚ (sans _)

; chaine libre: type GEMLIST, 00 oo options qui
; viennent recouvrer les octets 4-5
; 00 00 0F 00 00 ii 00 05 +nom
; 00 00 0F 00 00 oo 00 05 +nom d‚cal‚ (sans _)

; la structure -------------
; structure pour chaque arbre ou menu:
; LONG adresse dans DEF
; LONG adresse dans RSC
; LONG adresse enfant 1 dans DEF
; ...
; LONG adresse enfant n dans DEF
; LONG 0

; pour une fenetre, ou une GEMLIST
; LONG adresse dans DEF
; LONG adresse chaine de d‚finition (F= ou W= ou G=)
; LONG 0

; pour une GEMLIST avec initialisation
; LONG adresse dans DEF
; LONG adresse chaine definition
; LONG adresse chaines initialisation
; LONG 0

; fin de la structure:
; LONG 0

.analyse:
	moveq #0,d3			; d‚faut pas de MENU !
	moveq #0,d2			; elŠve le bit 31 (pr‚sence de fenˆtres)
	bsr .start_vline
	lea 256(a3),a3		; zone de l'arbre et a0 ligne texte
	bsr .init_parse	; a2 = DEF et D0 la taille
	move.l a2,a1
	move.l d0,d7
.an0:
	cmp.b #2,7(a1)		; un menu?
	bne.s .an4
	move #$1000,2(a1)	; type menu
	move.l a1,d3		; un menu, garde l'adresse
	bra.s .an5
.an4:
	cmp.b #3,7(a1)		; un dialogue?
	bne.s .an1
	move #$1100,2(a1)
.an5:
	moveq #0,d1
	move.b 5(a1),d1	; num‚ro d'arbre
	move.l a1,(a3)+	; adresse dans DEF
	move.l (a6),a0		; RSC
	moveq #0,d4
	move 18(a0),d4		; offset vers table arbres
	add.l d1,d4
	add.l d1,d4
	add.l d1,d4
	add.l d1,d4
	move.l 0(a0,d4.l),d4	; offset de mon arbre
	add.l d4,a0			; son adresse
	move.l a0,(a3)+	; adresse arbre !!
	bsr .init_parse
.an2:
	cmp.b 4(a2),d1		; le bon arbre?
	bne.s .an3
	tst.b 7(a2)			; un objet (0) ?
	bne.s .an3
	move.l a2,(a3)+	; un enfant de plus
.an3:
	lea 16(a2),a2
	dbf d0,.an2
	clr.l (a3)+
.an1:
	cmp.b #5,7(a1)		; une chaŒne libre?
	bne .an6
	cmp.b #'_',8(a1)	; commen‡ant par "_" ?
	bne.s .an6			; non on saute
	move.l (a6),a0		; le RSC
	add.w 10(a0),a0	; pointe vers les chaines
	moveq #0,d0
	move.b 5(a1),d0	; index chaŒne
	asl.l #2,d0
	move.l 0(a0,d0.l),a0	; pointeur vers la chaine
	add.l (a6),a0		; plus le RSC
	cmp.b #'=',1(a0)	; du type X=... ?
	bne.s .an6
	cmp.b #'F',(a0)	; la FastWindow du Forth?
	bne.s .an8
	move.w #$8029,d0	; bit15=fastwindow, bits 11-0 du masque win create (Size, Mover, Name)
.an1a:
	move d0,4(a1)		; masque win create
	move #$0E00,2(a1)	; type fenˆtre
	move.l a1,(a3)+	; un objet de plus
	move.l a0,(a3)+	; avec son adresse RSC (pas trŠs utile...)
	clr.l (a3)+			; youpi
	bset #31,d2			; marque la pr‚sence d'au moins une fenˆtre.
	bra.s .an9
.an8:
	cmp.b #'W',(a0)
	bne.s .an8a
	movem.l d2/d6/a1,-(sp)
	pea win_opt(pc)
	bsr gemlist_options	; r‚cupŠre le masque options dans D6
	move.l d6,d0
	movem.l (sp)+,d2/d6/a1
	; renvoie le masque de cr‚ation de fenˆtre dans d0.w
	bra.s .an1a
.an8a:
	cmp.b #'G',(a0)	; GemList ?
	bne.s .an6
	move #$0F00,2(a1)	; type pseudo-fenˆtre sans flags
	clr.b 4(a1)			; et fenetre GEMLIST
	move.l a1,(a3)+	; un objet de plus
	move.l a0,(a3)+	; avec son adresse RSC
	clr.l (a3)+			; youpi
	bsr .format_gemlist	; retravaille la chaine <n,l,opt> en <n l " opt"> 
							; r‚cupŠre les options en d6
	move.b d6,5(a1)	; et range des options (8 bits possibles seulement !)
.an9:
	lea 8(a1),a0
.an7:
	move.b 1(a0),(a0)+	; d‚cale le nom pour enlever '_'
	bne.s .an7
.an6:
	lea 16(a1),a1		; suivant
	dbf d7,.an0
	clr.l (a3)			; termine l'arbre
	tst.l d2
	bpl.s .an10
	lea .fl38(pc),a0		; en cas de fenˆtres, un outil de plus !
	bsr .add_fixed_line	; : max_xywh ... ;
.an10:
	rts	
.def_tree:
	bsr .start_vline	; a0 = texte
	lea 256(a3),a2		; a2 = structure
.dt0:
	move.l (a2)+,d7
	beq .dt1			; fin de structure
	move.l d7,a1
	lea 8(a1),a5		; le nom pour expand
	cmp.b #14,2(a1)	; type window?
	bne.s .dt0c
	btst #7,4(a1)		; fast?
	beq.s .dt0e
	lea .vl39(pc),a1	; fasthdl constant XXX
	bra.s .dt0d
.dt0e:
	move 4(a1),d1
	lea .vl56(pc),a1	; %bmasque 0 0 0 0 wind_create intout w@ contsant XXXX
	lea 15(a1),a0		; pour remplir le masque de bits
	moveq #11,d0
.dt0f:	
	swap d0
	move.b #'0',d2
	lsr #1,d1
	addx.b d0,d2
	move.b d2,-(a0)
	swap d0
	dbf d0,.dt0f
.dt0d:
	bsr .expand_vline
	moveq #0,d0			; bit ‚l‚ment NAME?
	bsr .win_set
	moveq #4,d0			; bit ‚l‚ment INFO?
	bsr .win_set
	subq.l #8,d7
	bra .dt2				; suite, objet suivant
.dt0c:
	cmp.b #15,2(a1)	; type gemlist?
	bne.s .dt0a
	bsr .start_vline
	move.b #1,(a3)+	; tab
	move.l (a2),a1		; pointe sur n l
	bsr .copy_a1_a3
	move.b #34,-(a1)	; enlŠve le z‚ro pour lier avec opt
	lea .vl29(pc),a1
	bsr .copy_a1_a3	; array$
	addq.l #8,d7		; le nom
	move.l d7,a1
	bsr .copy_a1_a3
	lea .vl30(pc),a1
	bsr .copy_a1_a3	; "$ 0 "
	move.l d7,a1
	bsr .copy_a1_a3
	move.b #'$',(a3)+
	move.b #' ',(a3)+
	move.l (a2),a1
	bsr .copy_a1_a3	; n l " opt
	lea .vl31(pc),a1
	bsr .copy_a1_a3	; jusqu'ici 0 XXXX$ n l " opt" gemlist
	bsr .add_var_line
	lea .vl2b(pc),a1
	subq.l #8,d7
	bra.s .dt0b
.dt0a:					; ici menu ou dial
	moveq #0,d6
	move.b 5(a1),d6	; index arbre
	divs #10,d6
	lea .vl2(pc),a1
	add.l #$00300030,d6
	move.b d6,3(a1)	; dizaine
	swap d6
	move.b d6,4(a1)	; unit‚
	; aller ici pour fenetre
.dt0b:
	bsr .start_vline
	bsr .copy_a1_a3
	addq.l #8,d7		; vers le nom
	move.l d7,a1
	move.b -1(a1),d6	; 2 si menu
	cmp #$0FFF,-6(a1)	; est-ce une gemlist dropdown ?
	beq.s .dt0h
	cmp #$11FF,-6(a1)	; ou est-ce un arbre dropdown?
	bne.s .dt0g
.dt0h:
	move.b #2,d6		; si oui, agir comme MENU (pas de dup, pas de win_wreate
.dt0g:
	lea .vl2a(pc),a1
	subq.b #2,d6
	bne.s .dt4
	addq.l #4,a1		; si 0 (menu) alors sauter dup
.dt4:
	bsr .copy_a1_a3
	move.l d7,a1
	bsr .copy_a1_a3	; le nom
	tst.b d6				; un menu?
	beq.s .dt3			; oui, pas de wdial_create alors
	lea .vl3(pc),a1
	bsr .copy_a1_a3
	move.l d7,a1
	bsr .copy_a1_a3
.dt3:
	bsr .add_var_line
.dt2:
	tst.l (a2)+
	bne.s .dt2			; saute les objets
	bra .dt0
.dt1:
	lea .fl17(pc),a0
	bsr .add_fixed_line	; d‚finition de BUF
	lea .fl18(pc),a0
	bsr .add_fixed_line	; d‚finition de OUT
	lea .fl19(pc),a1
	bsr .add_fixed_line	; variable exit_flag
	rts
.init_strings:
	moveq #0,d6			; flag rien trouv‚
	bsr .start_vline
	lea 256(a3),a2		; structure
.is0:
	move.l (a2)+,d7
	beq.s .is1			; liste finie
	move.l d7,a0
	cmp.b #$0F,2(a0)	; une gemlist?
	bne.s .is2			; non, on saute
	btst #4,5(a0)		; avec une initialisation?
	beq.s .is2			; non, on saute
	addq.l #1,d6		; une liste trouv‚e
	lea 8(a0),a5		; nom
	lea .fl63(pc),a0
	bsr .add_fixed_line		; 0 >r list
	move.l 4(a2),a1	; chaine liste xxx,xxx,xxx...
.is3:
	bsr .start_vline
	move #$0422,(a3)+			; tab + "
	move.b #32,(a3)+			; espace
.is5:
	move.b (a1)+,d0		; un caractŠre
	beq.s .is4				; fin de chaine
	cmp.b #',',d0
	beq.s .is4				; itou
	move.b d0,(a3)+		; sinon, continue la chaŒne
	bra.s .is5
.is4:
	move.b #34,(a3)+		; guillements de fin
	clr.b (a3)+
	move.l a1,-(sp)
	bsr .add_var_line
	move.l (sp)+,a1
	tst.b -1(a1)			; ‚tait-ce z‚ro ou virgule?
	bne.s .is3				; virgule, encore une chaŒne
	lea .vl64(pc),a1
	bsr .expand_vline		; dolist.... lloop drop
	bsr .add_cr				; saut de ligne
.is2:
	tst.l (a2)+			; vide la liste
	bne.s .is2
	bra.s .is0			; arbre suivant
.is1:
	tst.l d6				; au moins une liste trouv‚e?
	beq.s .is6
	bsr .add_comp2		; oui, ajouter >comp
.is6:
	rts
.manage_tree:
	bsr .start_vline	; a0 = texte
	lea 256(a3),a2		; a2 = structure	
.mt0:
	move.l (a2)+,d7	; l'arbre
	beq .mt1				; c'est fini !
	move.l d7,a0
	cmp #$0FFF,2(a0)	; une gemlist dropdown?
	beq.s .mt0b
	cmp #$11FF,2(a0)	; ou un drop_down ?
	bne.s .mt0a			; non, donc bien installer routines
.mt0b:
	tst.l (a2)+			; oui, vider liste drop_down jusqu'au suivant
	bne.s .mt0b
	bra.s .mt0			; arbre suivant
.mt0a:
	bsr .add_comment
	move.l (a2)+,d6	; adresse arbre
	move.l a2,d4		; conserve pour la suite
.mt2:
	move.l (a2)+,d5	; un objet
	beq .mt3				; liste finie
	move.l d6,a0
	move.l d5,a1
	moveq #0,d0
	move.b 5(a1),d0	; num‚ro objet
	muls #24,d0			; offset
	cmp.l d7,d3			; sommes nous sur le menu?
	bne.s .mt7
	clr.w 2(a1)			; pas de type, pas de flag
	cmp #28,6(a0,d0)	; est-ce un type STRING? (entr‚e de menu)
	bne.s .mt8			; non, on marque comme neutre
	move.b #19,2(a1)	; type entr‚e menu
	bra.s .mt4
.mt7:
	move.b 7(a0,d0),2(a1)	; conserve le type d'objet
	move.b 9(a0,d0),3(a1)	; et son flag
	btst #2,9(a0,d0)	; type exit?
	bne.s .mt4			; oui !
.mt8:
	bset #7,-4(a2)		; sinon, marque l'objet comme neutre
	bra.s .mt2			; passe au suivant	
.mt4:
	addq.l #8,d5		; le nom
	move.l d5,a5
	lea .vl4(pc),a1
	bsr .expand_vline	; pr‚pare ": do_xxx"
	move.b -7(a5),d0	; un objet qui appelle un drop down?
	beq.s .mt4a			; non, fin de proc‚dure
	cmp.b #3,d0			; objet "autre" ?
	beq.s .mt4b			; oui, routine simplifi‚e
	lea .vl59(pc),a1
	bsr .expand_vline	; xxxx tree_pere tree_xxxx0 drop_down_s drop
;	lea .vl61(pc),a1
;	bsr .expand_vline	; win_pere update_win
	bra.s .mt4a			; fin procedure
.mt4b:
	lea .vl60(pc),a1
	bsr .expand_vline	; xxxx tree_pere tree_xxxx0 drop_down drop
.mt4a:
	lea .fl2(pc),a0	; ligne ";"
	bsr .add_fixed_line
	bsr .add_cr
	bra .mt2	
.mt3:
	cmp.l d3,d7			; le menu?
	bne.s .mt11
	bsr .start_vline
	lea .vl21(pc),a1
	bsr .copy_a1_a3	; : menunormal BUF 6 + w@ 1 tree_
	move.l d7,a1
	addq.l #8,a1
	bsr .copy_a1_a3	; nom arbre
	lea .vl22(pc),a1
	bsr .copy_a1_a3	; menu_tnormal ;
	bsr .add_var_line
	bsr .add_cr
.mt11:
	move.l d7,a1
	cmp.b #14,2(a1)	; une fenˆtre
	bne.s .mt9b
	move.l d7,a2
	bsr .add_window
	move.l d4,a2
;	addq.l #4,a2		; saute le z‚ro final pour passer … l'‚l‚ment suivant
	bra .mt6a	
.mt9b:	
	cmp.b #15,2(a1)	; une gemlist?
	bne.s .mt11a
	bsr .add_gemlist_routine	; flŠches? lignes s‚lectionnables?
.mt11a:
	move.l d7,a5
	addq.l #8,a5
	lea .vl4(pc),a1
	bsr .expand_vline	; ": do XXX"
	lea .fl3(pc),a0
	bsr .add_fixed_line	; "case"
	cmp.l d3,d7			; le menu?
	beq.s .mt9			; si oui, cette ligne est inutile
	bsr .start_vline
	lea .vl5(pc),a1
	bsr .copy_a1_a3
	move.l d7,a1
	addq.l #8,a1		; nom arbre
	bsr .copy_a1_a3
	lea .vl6(pc),a1
	bsr .copy_a1_a3
	bsr .add_var_line		; "-1 of win_XXX wdial_close endof"
.mt9:
	move.l d7,a2
	cmp.b #15,2(a2)		; une gemlist?
	bne .mt9a
	btst #0,5(a2)			; arrows?
	beq.s .mt12
	lea .vl35(pc),a1
	bsr .win_arrow			; 1 of up_XXXX endof
	lea .vl36(pc),a1
	bsr .win_arrow			; 2 of down_XXXX endof
.mt12:
	btst #1,5(a2)			; lignes selectables?
	beq .mt6b				; va ajouter drop/endcase
	bsr .start_vline
	move.b #7,(a3)+		; tab
	lea .vl37a(pc),a1
	bsr .copy_a1_a3		; "dup "
	btst #0,5(a2)
	beq.s .mt13
	move.b #'4',(a3)+
	move.b #' ',(a3)+		; 4 si boutons 1,2,3
	bra.s .mt14
.mt13:
	move.b #'1',(a3)+		; sinon 1!
.mt14:
	lea .vl37(pc),a1
	bsr .copy_a1_a3		; 1- ou 4 - lines_XXXX
	move.l d7,a1
	addq.l #8,a1
	bsr .copy_a1_a3
	lea .vl8(pc),a1
	bsr .copy_a1_a3		; win_
	move.l d7,a1
	addq.l #8,a1
	bsr .copy_a1_a3		; XXXX
	lea .vl38(pc),a1
	bsr .copy_a1_a3		; update_button
	bsr .add_var_line
	move.l d4,a2			; revient … la liste
	bra .mt6a				; va ajouter endcase
.win_arrow:
	bsr .start_vline		; 1 of up_ // 2 of down
	move.b 1(a1),d2		; "1" ou "2"
	bsr .copy_a1_a3
	move.l d7,a1
	addq.l #8,a1
	bsr .copy_a1_a3		; XXXX
	bsr .add_var_line
	bsr .start_vline
	move.b #10,(a3)+		; tab
	move.b d2,(a3)+		; "1" ou "2"
	lea .vl8(pc),a1
	bsr .copy_a1_a3		; win_
	move.l d7,a1
	addq.l #8,a1
	bsr .copy_a1_a3		; XXXX
	lea .vl9(pc),a1
	bsr .copy_a1_a3		; update_button endof
	bsr .add_var_line
	rts
.mt9a:
	move.l d4,a2			; reprend le d‚but de la liste!
.mt5:
	move.l (a2)+,d5
	bmi.s .mt5				; objet marqu‚ "non exit"
;	beq.s .mt6				; fin de liste
	beq.s .mt6b
	bsr .start_vline
	move.b #7,(a3)+		; tabulation
	addq.l #8,d5			; nom objet
	move.l d5,a1
	bsr .copy_a1_a3
	lea .vl7(pc),a1
	bsr .copy_a1_a3
	move.l d5,a1
	bsr .copy_a1_a3
	bsr .add_var_line		; "XXX of do_XXX"
	cmp.l d3,d7				; le menu?
	bne.s .mt10				; non donc update_button
	lea .fl24(pc),a0
	bsr .add_fixed_line	; menunormal endof
	bra.s .mt5	
.mt10:
	bsr .start_vline
	move.b #10,(a3)+		; tabulation
	move.l d5,a1
	bsr .copy_a1_a3		; XXX
	lea .vl8(pc),a1
	bsr .copy_a1_a3
	move.l d7,a1
	addq.l #8,a1		; nom arbre
	bsr .copy_a1_a3
	lea .vl9(pc),a1
	bsr .copy_a1_a3
	bsr .add_var_line		; "XXX win_WWW update_button endof"
	bra.s .mt5
.mt6b:
	move.l d4,a2			; retour … la liste (si gemlist)
.mt6:	
	lea .fl5(pc),a0
	move.b #7,2(a0)			; tab
	bsr .add_fixed_line	; "drop"
.mt6a:
	lea .fl4(pc),a0
	bsr .add_fixed_line	; "endcase"	
	lea .fl2(pc),a0
	bsr .add_fixed_line	; ";"
	bsr .add_cr
	bra .mt0b				; ***
.mt1:
	rts
.add_main:
	lea .fl6(pc),a0
	bsr .add_fixed_line		; main
	bsr .add_cr
	lea .fl48(pc),a0
	bsr .add_fixed_line		; comment	
	bsr .add_cr
	bsr .init_parse
	move.l d0,d7
.am0:
	cmp.b #5,7(a2)				; soit une fenetre/gemlist
	bne.s .am0a
	cmp.b #15,2(a2)			; une gemlist?
	beq.s .am0d
	btst #7,4(a2)				; la fenetre fast du forth?
	beq.s .am0e					; non, fenetre user
	lea .fl30(pc),a0
	bsr .add_fixed_line		; \ fastopen drop
	bra .am4
.am0e:
	lea 8(a2),a5
	lea .vl42(pc),a1			; \ XXXX 0 0 0 0 wind_open
	bsr .expand_vline
	bra.s .am4
.am0d:
	cmp.w #$0FFF,2(a2)		; gemlist dropdown?
	beq.s .am4					; oui, pas d'ouverture
	lea .vl10a(pc),a1			; \ 0 " title" win_
	moveq #'0',d0				; par d‚faut, index 0
	btst #2,5(a2)				; gemlist editable?
	beq.s .am0b					; non donc 0
	moveq #'1',d0				; si editable champ 1 par d‚faut
	btst #0,5(a2)				; gemlist avec flŠches?
	beq.s .am0b					; non, donc 1
	moveq #'4',d0				; si flŠches, premier champ en 4
.am0b:
	move.b d0,3(a1)
	bra.s .am0c
.am0a:
	cmp.b #3,7(a2)				; soit un dialogue
	bne.s .am1					; sinon on saute
	cmp #$11FF,2(a2)			; dialogue drop_down?
	beq.s .am4					; si oui, pas de ligne d'ouverture fenetre
	lea .vl10(pc),a1			; \ index " title" win_
.am0c:
	bsr .start_vline
	bsr .copy_a1_a3
	bsr .copy_8a2_a3			; xxx
	lea .vl11(pc),a1			; wdial_open
	bra.s .am5
.am1:
	cmp.b #2,7(a2)				; un menu?
	bne.s .am4
	bsr .start_vline
	lea .vl15(pc),a1
	bsr .copy_a1_a3			; 1 tree_
	bsr .copy_8a2_a3			; xxx
	lea .vl14(pc),a1			; menubar	
.am5:
	bsr .copy_a1_a3
	bsr .add_var_line	
.am4:
	lea 16(a2),a2
	dbf d7,.am0
	bsr .add_cr
	lea .fl20(pc),a0
	bsr .add_fixed_line		; 0 exit_flag !
	lea .fl7(pc),a0
	bsr .add_fixed_line		; begin
	lea .fl8(pc),a0
	bsr .add_fixed_line		; buf out wdial_event
	tst.l d3
	bne.s .am4a					; un menu ou une fenˆtre?
	tst.l d2	
	bpl .am6					; sinon on saute
.am4a:
	lea .fl22(pc),a0
	bsr .add_fixed_line		; BUF w@ case
	tst.l d3
	beq.s .am4b
	bsr .start_vline
	lea .vl16(pc),a1
	bsr .copy_a1_a3			; 10 of BUF 8 + w@ do_
	move.l d3,a1
	addq.l #8,a1				; nom du menu
	bsr .copy_a1_a3
	lea .vl13(pc),a1
	bsr .copy_a1_a3			; endof
	bsr .add_var_line
.am4b:
	tst.l d2						; au moins une fenˆtre ?
	bne .am4c		
	lea .fl5(pc),a0
	move.b #10,2(a0)			; tab
	bsr .add_fixed_line		; drop
	bra .am4d
.am4c:
	lea .fl33(pc),a0			; 20 28 <seg> if BUF 6 + w@
	bsr .add_fixed_line
	lea .fl12(pc),a0
	move.b #13,2(a0)			; assure la bonne tabulation
	bsr .add_fixed_line		; case	
	bsr .init_parse
.am4f:
	cmp.b #14,2(a2)			; type fenˆtre?
	bne.s .am4e
	bsr .start_vline
	move.b #16,(a3)+			; tab
	bsr .copy_8a2_a3			; XXXX
	lea .vl7(pc),a1
	bsr .copy_a1_a3			; of do_
	bsr .copy_8a2_a3			; XXXX
	lea .vl13(pc),a1
	bsr .copy_a1_a3			; endof
	bsr .add_var_line
.am4e:
	lea 16(a2),a2
	dbf d0,.am4f	
	lea .fl5(pc),a0
	move.b #16,2(a0)			; tab
	bsr .add_fixed_line		; drop
	lea .fl14(pc),a0
	move.b #13,2(a0)			; assure la tabulation … 7
	bsr .add_fixed_line		; endcase	
	lea .fl32(pc),a0
	move.b #10,2(a0)
	bsr .add_fixed_line		; then	
.am4d:
	lea .fl14(pc),a0
	move.b #7,2(a0)			; assure la tabulation … 7
	bsr .add_fixed_line		; endcase
.am6:
	lea .fl9(pc),a0
	bsr .add_fixed_line		; begin
	lea .fl10(pc),a0
	bsr .add_fixed_line		; buf out wdial_formdo
	lea .fl11(pc),a0
	bsr .add_fixed_line		; while
	lea .fl12(pc),a0
	move.b #10,2(a0)			; assure la bonne tabulation
	bsr .add_fixed_line		; case
	bsr .init_parse
	move.l d0,d7
.am2:
	cmp.w #$0FFF,2(a2)		; une gemlist dropdown, pas de gestion
	beq.s .am3
	cmp.b #15,2(a2)			; soit une gemlist
	beq.s .am2a
	cmp.b #3,7(a2)				; soit un dialogue
	bne.s .am3
	cmp #$11FF,2(a2)			; un drop down?
	beq.s .am3					; si oui, pas de gestion de fenˆtre
.am2a:
	bsr .start_vline
	lea .vl12(pc),a1			; win_
	bsr .copy_a1_a3
	bsr .copy_8a2_a3			; xxx
	lea .vl7(pc),a1
	bsr .copy_a1_a3			; of do_
	bsr .copy_8a2_a3			; xxx
	lea .vl13(pc),a1
	bsr .copy_a1_a3			; endof
	bsr .add_var_line
.am3:
	lea 16(a2),a2
	dbf d7,.am2
	lea .fl5(pc),a0
	move.b #10,2(a0)			; tab
	bsr .add_fixed_line		; drop
	lea .fl14(pc),a0
	move.b #10,2(a0)			; assure la tabulation … 10
	bsr .add_fixed_line		; endcase
	lea .fl15(pc),a0
	bsr .add_fixed_line		; repeat
	lea .fl21(pc),a0
	bsr .add_fixed_line		; exit_flag @
	lea .fl16(pc),a0
	bsr .add_fixed_line		; until
	bsr .init_parse
	move.l d0,d7
.am8:
	cmp.b #5,7(a2)				; soit une fenetre
	bne.s .am8a
	cmp.w #$0FFF,2(a2)		; une gemlist dropdown?
	beq.s .am11					; oui, pas de fermeture
	cmp.b #15,2(a2)			; une gemlist? Donc comme un dialogue
	beq.s .am8b
	btst #7,4(a2)				; la fast fenetre?
	beq.s .am8c
	lea .fl31(pc),a0
	bsr .add_fixed_line		; fasclose
	bra.s .am11					; la suite
.am8c:
	bsr .start_vline			; ici fenˆtre user
	move.b #4,(a3)+			; tab
	bsr .copy_8a2_a3			; nom
	lea .vl43(pc),a1			; wind_close
	bra.s .am9	
.am8a:
	cmp.b #3,7(a2)				; soit un dialogue
	bne.s .am10
	cmp #$11FF,2(a2)			; un drop_down?
	beq.s .am11					; si oui, pas de fermeture de fenˆtre
.am8b:
	bsr .start_vline
	move.b #4,(a3)+			; tab
	lea .vl8+1(pc),a1			; win_
	bsr .copy_a1_a3
	bsr .copy_8a2_a3			; xxx
	lea .vl23(pc),a1			; wdial_close
	bra.s .am9
.am10:
	cmp.b #2,7(a2)				; un menu?
	bne.s .am11
	bsr .start_vline
	lea .vl20(pc),a1
	bsr .copy_a1_a3			; 0 tree_
	bsr .copy_8a2_a3			; xxx
	lea .vl14(pc),a1			; menubar	
.am9:
	bsr .copy_a1_a3
	bsr .add_var_line	
.am11:
	lea 16(a2),a2
	dbf d7,.am8
	lea .fl23(pc),a0
	bsr .add_fixed_line		; rsrc_free
	lea .fl2(pc),a0
	bsr .add_fixed_line		; ";"
	rts
.add_structure:
	bsr .init_parse
	move.l d0,d7				; pour boucler
.as0:
	moveq #0,d6
	move.b 2(a2),d6			; type
	sub #14,d6
	bmi .as1					; pas connu
	bne.s .as8				; pas une fenˆtre
	btst #7,4(a2)			; la fast windows?
	bne.s .as8				; oui donc on garde 0
	subq #1,d6				; sinon -1 pour les user window
.as8:
	subq #2,d6					; -3 uwin, -2 fwin, -1 gemlist et positif pour les autres
	bsr .start_vline
	lea .vl24(pc),a1			; tabulation courte pour menu, dialog et alert
	cmp #3,d6
	bmi.s .as2
	lea .vl25(pc),a1			; longue pour les objets
.as2:
	bsr .copy_a1_a3
	move d6,d5					; conserve
;	cmp #$11FF,2(a2)			; un drop down?
;	bne.s .as2a
;	moveq #18,d6				; si oui changer dial en ddwn
;.as2a:
	muls #6,d6					; pour aller chercher le type
	lea .vl26(pc),a1
	add.l d6,a1
	bsr .copy_a1_a3
	move.b #32,(a3)+			; un espace
	bsr .copy_8a2_a3
	cmp #$11FF,2(a2)			; un dial drop down?
	beq.s .as3					; no flags
	cmp #$0FFF,2(a2)			; une gemlist dropdown?
	beq.s .as3					; no flags
	move.b 3(a2),d0			; flags
	and #$1F,d0
	beq.s .as3					; no flags
	moveq #4,d6					; bit number
	move.b #32,(a3)+
	move.b #"(",(a3)+
.as4:
	btst d6,3(a2)
	beq.s .as5
	lea .vl27(pc),a1
	move d6,d0
	muls #6,d0
	add.l d0,a1
	bsr .copy_a1_a3
	move.b #",",(a3)+
.as5:
	dbf d6,.as4
	move.b #")",-1(a3)
	clr.b (a3)
.as3:
	cmp #2,d5
	beq.s .as6					; pour les alertes c'est fini
	cmp #4,d5
	bmi.s .as7					; menu, dial, menuitem, fenˆtres il y a un do_XXXX
	btst #2,3(a2)				; objet exit?
	beq.s .as6					; non, rien … ajouter
.as7:
	cmp #$0FFF,2(a2)			; une gemlist dropdown?
	beq.s .as7b
	cmp #$11FF,2(a2)			; ou un dial dropdown?
	bne.s .as7a
.as7b:
	lea .vl63(pc),a1
	bsr .copy_a1_a3			; si oui, " (ddwn) -> tree_"
	bsr .copy_8a2_a3			; le nom
	bra.s .as6
.as7a:
	lea .vl28(pc),a1
	bsr .copy_a1_a3			; " -> do_"
	bsr .copy_8a2_a3			; le nom
	cmp #2,d5
	bmi.s .as77					; menu ou dial, on continue
	tst.b 1(a2)					; est-ce un objet appelant un drop down?
	beq.s .as6					; non, donc fini
	lea .vl62(pc),a1
	bsr .copy_a1_a3			; ", ddwn "
	bsr .copy_8a2_a3			; le nom
	move.b #"0",(a3)+
	clr.b (a3)
	bra.s .as6
.as77:
	bpl.s .as6					; autre que menu et dial, c'est fini
	cmp #-1,d5
	bmi.s .as6					; fenetres (-2 et -3) idem, fini
	lea .vl155(pc),a1
	bsr .copy_a1_a3			; " tree_"
	bsr .copy_8a2_a3			; le nom
	tst d5
	beq.s .as6					; autre que dial, c'est fini
	lea .vl8(pc),a1
	bsr .copy_a1_a3			; " win_"
	bsr .copy_8a2_a3	
.as6:
	bsr .add_var_line	
.as1:
	lea 16(a2),a2
	dbf d7,.as0
	rts	
.format_gemlist:
	lea 2(a0),a2			; saute G= dans G=n,l,opt
	moveq #2,d1				; nombre de virgules vues
.fg0:
	move.b (a2)+,d0
	beq.s .fg1
	cmp.b #',',d0
	bne.s .fg2
	move.b #32,d0			; virgule devient espace
	subq #1,d1
.fg2:
	move.b d0,(a0)+
	tst d1
	bne.s .fg0
	clr.b (a0)+				; termine la s‚rie "n l "
	move.b #' ',(a0)+		; ajoute espace
	movem.l d2/a0-a2,-(sp)
	move.l a2,a0
	pea glst_opt(pc)
	bsr gemlist_options	; r‚cupŠre le masque options dans D6
	btst #4,d6				; virgule pr‚sente?
	beq.s .fg3				; non, pas d'initialisation
	move.l a0,-4(a3)		; sinon ajoute de d‚but de chaine dans les infos de la GEMLIST
	clr.l (a3)+				; nouvelle fin
	clr.b -(a0)				; termine la chaine options
.fg3:
	movem.l (sp)+,d2/a0-a2
	moveq #-1,d1
	bra.s .fg0
.fg1:
	rts
.add_gemlist_routine:
	btst #0,5(a1)			; flag ARROW ?
	beq.s .agr0
	lea .vl32(pc),a1		; : up_XXXX ; + cr
	bsr.s .agr2
	lea .vl33(pc),a1		; : down_XXXX ; + cr
	bsr.s .agr2
.agr0:
	move.l d7,a1
	btst #1,5(a1)
	beq.s .agr1
	lea .vl34(pc),a1		; : lines_XXX ; + cr
	bsr.s .agr2
.agr1:
	rts
.agr2:
	bsr .start_vline
	bsr .copy_a1_a3
	move.l d7,a1
	lea 8(a1),a1
	bsr .copy_a1_a3
	bsr .add_var_line
	lea .fl2(pc),a0
	bsr .add_fixed_line
	bsr .add_cr
.rien:	
	rts
.win_set:
	move.l d7,a1
	btst d0,-3(a1)
	beq.s .rien			; bit absent, ne rien faire
	lea .vl40(pc),a1
	tst d0
	beq.s .ws1
	lea .vl41(pc),a1
.ws1:
	bsr .expand_vline	; XXXX " titre/info" 2/3 win_set
	rts
.win_slider:
	lea .vl46(pc),a1
	move.b d2,3(a1)	; h ou v
	bsr .expand_vline	; : ?slid_XXXX
	lea .vl47(pc),a1
	lsr.w #8,d2
	move.b d2,14(a1)	; 8 ou 9
	bsr .expand_vline	; XXXX BUF 8 + w@ ? wind_set
.win_trick:
	lea .fl2(pc),a0
	bsr .add_fixed_line	; ;
	bsr .add_cr
	rts
.add_window:
	lea 8(a2),a5			; nom pour expand
	lea .vl44(pc),a1
	bsr .expand_vline		; : redraw_XXXX
	lea .vl45(pc),a1
	bsr .expand_vline		; XXXX BUF 8 + w@ get_xywh set_redraw
	lea .fl46(pc),a0
	bsr .add_fixed_line	; comment
	lea .fl47(pc),a0
	bsr .add_fixed_line	; comment
	lea .fl34(pc),a0
	bsr .add_fixed_line	; begin redraw while v_recfl repeat
	bsr.s .win_trick
	btst #3,4(a2)			; horizontal slider?
	beq.s .aw0
	move.w #'8h',d2
	bsr .win_slider
.aw0:
	btst #0,4(a2)			; vertical slider?
	beq.s .aw1
	move.w #'9v',d2
	bsr .win_slider
.aw1:
	move 4(a2),d0
	and #$0FC0,d0			; un slider ou une flŠche au moins?
	beq.s .aw2
	lea .vl48(pc),a1
	bsr .expand_vline		; : arrows_XXXX
	lea .fl35(pc),a0
	bsr .add_fixed_line	; BUF 8 + w@
	lea .fl45(pc),a0
	bsr .add_fixed_line	; commentaire avec options 0 … 7
	lea .fl13(pc),a0
	bsr .add_fixed_line	; commentaire avec options 0 … 7
	bsr .win_trick			; ajoute ; et saut de ligne
.aw2:
	lea .vl4(pc),a1
	bsr .expand_vline		; : do_XXXX
	lea .fl36(pc),a0
	bsr .add_fixed_line	; BUF w@ case
	lea .vl49(pc),a1
	bsr .expand_vline		; 20 of redraw_XXXX endof
	lea .vl50(pc),a1
	bsr .expand_vline		; 21 of XXXX 10 wind_set endof
	btst #1,5(a2)			; Closer ?
	beq.s .aw3
	lea .vl51(pc),a1
	bsr .expand_vline		; 22 of XXXX wind_close endof
.aw3:	
	btst #2,5(a2)			; Fuller ?
	beq.s .aw4
	lea .vl52(pc),a1
	bsr .expand_vline		; 23 of ... endof
.aw4:	
	move 4(a2),d0
	and #$0FC0,d0			; un slider ou une flŠche au moins?
	beq.s .aw5
	lea .vl53(pc),a1
	bsr .expand_vline		; 24 of arrows_XXXX endof
.aw5:
	btst #3,4(a2)			; Horiz slider ?
	beq.s .aw6
	lea .vl54(pc),a1
	bsr .expand_vline		; 25 of hslid_XXXX endof
.aw6:
	btst #0,4(a2)			; Vertic slider?
	beq.s .aw7
	lea .vl55(pc),a1
	bsr .expand_vline		; 26 of vslid_XXXX endof
.aw7:
	move.b 5(a2),d0
	and.b #$28,d0			; Sizer ou Mover?
	beq.s .aw8
	lea .fl37(pc),a0
	bsr .add_fixed_line	; 27 28 <seg> if
	lea .vl57(pc),a1
	bsr .expand_vline		; XXXX BUF... wind_set
	btst #7,4(a2)			; fast win?
	beq.s .aw9
	lea .vl58(pc),a1		; si oui, adapter page0
	bsr .expand_vline		; XXXX 4 wind_... defpage
.aw9:
	lea .fl32(pc),a0		; then
.aw11:
	move.b #7,2(a0)		; tab
	bsr .add_fixed_line	; then ou drop
	bra.s .aw10
.aw8:
	lea .fl5(pc),a0		; drop (si pas de Sizer ou Mover)
	bra.s .aw11
.aw10:	
	rts
	; copie a1 vers a3
	; remplace les ~ par le nom point‚ par A5
	; remplace les Ý par le nom du pŠre point‚ par D7+8
.expand_vline:
	bsr .start_vline
.evl0:
	move.b (a1)+,d0
	cmp.b #'~',d0		; nom objet ?
	bne.s .evl1
	move.l a5,d0		; sauve
.evl2:
	move.b (a5)+,(a3)+
	bne.s .evl2
	subq.l #1,a3
	move.l d0,a5
	bra.s .evl0
.evl1:
	cmp.b #'Ý',d0		; nom arbre parent ?
	bne.s .evl3
	move.l a5,d0
	move.l d7,a5
	addq.l #8,a5
	bra.s .evl2
.evl3:
	move.b d0,(a3)+
	bne.s .evl0
	bsr .add_var_line
	rts
.add_comment:
	lea .fl39(pc),a0
	bsr .add_fixed_line	; ----
	tst.l d7					; if D7=0, fixed string on stack
	bne.s .ac0				; else address of a DEF block
	move.l 4(sp),a0
	bsr .add_fixed_line
	move.l (sp)+,(sp)		; remove param
	bra.s .ac1
.ac0:
	move.l d7,a5
	bsr .start_vline
	lea .vl24(pc),a1
	bsr .copy_a1_a3
	moveq #0,d0
	move.b 2(a5),d0		; 14-15-16-17
	sub #14,d0
	bne.s .ac2				; pas une fenˆtre
	btst #7,4(a5)			; la fast?
	bne.s .ac2
	subq #1,d0				; sinon descendre vers uwin
.ac2:
	subq #2,d0
	muls #6,d0
	lea .vl26(pc),a1
	add.l d0,a1				; type d'abre
	bsr .copy_a1_a3
	lea 8(a5),a1
	bsr .copy_a1_a3
	bsr .add_var_line		; \ type XXXX
.ac1:
	lea .fl39(pc),a0
	bsr .add_fixed_line	; ----	
	bsr .add_cr
	rts
.drop_down:
	movem.l a3/d2,-(sp)
	sf .compare-2			; par d‚faut, pas de drop down trouv‚
	bsr .start_vline
	lea 256(a3),a3			; zone de d‚finition des objets
.dd0:
	move.l (a3)+,d0		; adresse arbre dans DEF
	beq .ddfin				; recherche finie
	move.l (a3)+,a0		; adresse arbre
	move.l d0,a1			; teste s'il s'agit d'une GEMLIST
	cmp.b #$0F,2(a1)
	bne.s .dd1				; pas GEMLIST, traitement normal
	tst.l (a3)+				; si d‚j… 0, fin de bloc
	beq.s .dd0				; sinon ‡a permet de sauter l'adresse des init qui n'est pas un objet
								; et d'atteindre la fin de bloc dŠs l'instruction suivante
.dd1:
	move.l (a3)+,d1		; adresse objet
	beq.s .dd0				; fin bloc, on passe … l'arbre suivant
	bmi.s .dd1				; bit#31, donc inactif
	moveq #0,d2
	move.l d1,a1			; adresse dans DEF
	move.b 5(a1),d2
	muls #24,d2
	btst #2,9(a0,d2.l)	; type exit?
	beq.s .dd1				; non, on saute
	btst #0,10(a0,d2.l)	; type dropdown? (bit8 ‚tendu du flag)
	beq.s .dd1				; non on saute
	lea .compare(pc),a2
	move.l 8(a1),(a2)+
	move.l 12(a1),(a2)+	; copie le nom
	lea 0(a0,d2.l),a1		; garde adresse objet
.dd2:
	tst.b -(a2)				; recule sur les z‚ros
	beq.s .dd2
	addq.l #1,a2
	move.b #'0',(a2)+		; ajoute '0' au nom pour le nom du drop down
	clr.b (a2)
	movem.l .compare(pc),d1-d2	; r‚cupŠre le nom dans les registres
	bsr .init_parse
.dd3:
	cmp.w #$0F00,2(a2)	; une gemlist ?
	beq.s .dd3a
	cmp.w #$1100,2(a2)	; ou un arbre?
	bne.s .dd4
.dd3a:
	cmp.l 8(a2),d1
	bne.s .dd4				; le nom de convient pas
	cmp.l 12(a2),d2
	bne.s .dd4				; idem on saute
	st 3(a2)					; transforme $1100 en $11FF (ou $0F00 en $0FFF) pour un drop down
	bra .dd5					; et quitte la boucle !, arbre trouv‚
.dd4:
	lea 16(a2),a2
	dbf d0,.dd3
	bclr #0,10(a1)			; pas trouv‚, enlŠve le bit dropdown
	bra .dd1
.dd5:
	move 6(a1),d1			; type d'objet
	moveq #1,d0				; codage pour STRING
	cmp #28,d1				; un string?
	beq.s .dd6
	moveq #2,d0				; codage pour une TEDINFO
	cmp #21,d1				; TEXT
	beq.s .dd6
	cmp #22,d1				; BOXTEXT
	beq.s .dd6
	cmp #29,d1				; FTEXT
	beq.s .dd6
	cmp #30,d1				; FBOXTEXT
	beq.s .dd6
	moveq #3,d0				; codage pour autre
.dd6:
	move.l -4(a3),a1		; r‚cupŠre adresse dans DEF
	move.b d0,1(a1)		; et marque le source du drop_down
	st .compare-2			; octet de validation
	bra .dd1
.ddfin:
	tst.b .compare-2
	beq.s .ddexit
	move.l bfptr,a1
	lea .fl49(pc),a0		; d‚but des outils drop down
	move #(.fl63-.fl49)/2-1,d0	; nombre de mots
.ddtools:
	move (a0)+,(a1)+
	dbf d0,.ddtools
	move.l a1,bfptr	; nouvelle fin
	add #14,topedit	; 14 lignes de plus	
.ddexit:
	movem.l (sp)+,a3/d2
	rts
	dc.w00				; octet validation				
.compare: dc.l 0,0
	dc.b 0,0

	
.fl0: dc.w .fl1-.fl0
	dc.b 1,": do_alert 5 swap rsrc_gaddr addrout @ form_alert ;"
.fl1: dc.w .fl2-.fl1
	dc.b 1,">comp"
.fl2: dc.w .fl3-.fl2
	dc.b 1,";"
.fl3: dc.w .fl4-.fl3
	dc.b 4,"case "
.fl4: dc.w .fl5-.fl4
	dc.b 4,"endcase"
.fl5: dc.w .fl6-.fl5		; !!! tabulation variable
	dc.b 7,"drop "
.fl6: dc.w .fl7-.fl6	
	dc.b 1,": main "
.fl7: dc.w .fl8-.fl7
	dc.b 4,"begin"
.fl8: dc.w .fl9-.fl8	
	dc.b 7,"BUF OUT wdial_evnt "
.fl9: dc.w .fl10-.fl9	
	dc.b 7,"begin"
.fl10: dc.w .fl11-.fl10	
	dc.b 10,"BUF OUT wdial_formdo "
.fl11: dc.w .fl12-.fl11	
	dc.b 7,"while"
.fl12: dc.w .fl13-.fl12		; !!! tabulation variable	
	dc.b 10,"case "
.fl13: dc.w .fl14-.fl13	
	dc.b 4,"\ 0: 1: 2: 3: 4: 5: 6: 7:"
.fl14: dc.w .fl15-.fl14		; !!! tabulation variable	
	dc.b 10,"endcase"
.fl15: dc.w .fl16-.fl15	
	dc.b 7,"repeat "
.fl16: dc.w .fl17-.fl16	
	dc.b 4,"until"
.fl17: dc.w .fl18-.fl17
	dc.b 1,"16 allot constant BUF"
.fl18: dc.w .fl19-.fl18
	dc.b 1,"14 allot constant OUT"
.fl19: dc.w .fl20-.fl19
	dc.b 1,"variable exit_flag "
.fl20: dc.w .fl21-.fl20
	dc.b 4,"0 exit_flag !"
.fl21: dc.w .fl22-.fl21
	dc.b 4,"exit_flag @"
.fl22: dc.w .fl23-.fl22
	dc.b 7,"BUF w@ case"
.fl23: dc.w .fl24-.fl23
	dc.b 4,"rsrc_free"
.fl24: dc.w .fl25a-.fl24
	dc.b 10,"menunormal endof "
.fl25a: dc.w .fl25-.fl25a
	dc.b 1,":: obj_addr swap 24 w* + ; "
.fl25: dc.w .fl26-.fl25
	dc.b 1,": assign_string obj_addr 12 + over over @ swap gets ! ;"
.fl26: dc.w .fl27-.fl26
	dc.b 1,": assign_fstring obj_addr 12 + @ over over @ swap gets ! ; "
.fl27: dc.w .fl28-.fl27
	dc.b 1,": get_obstate obj_addr 11 + c@ ; "
.fl28: dc.w .fl29-.fl28
	dc.b 1,": set_obstate obj_addr 11 + c! ; "	
.fl29: dc.w .fl30a-.fl29
	dc.b 1,": update_win >r 3 0 0 0 0 r> 4 + get_xywh form_dial ;"
.fl30a: dc.w .fl30-.fl30a
	dc.b 1,": update_button dup >r wdial_change r> update_win ;"
.fl30: dc.w .fl31-.fl30
	dc.b 4,"\ fastopen drop"
.fl31: dc.w .fl32-.fl31
	dc.b 4,"fastclose"
.fl32: dc.w .fl33-.fl32
	dc.b 10,"then "					; !!! tabulation variable
.fl33: dc.w .fl34-.fl33
	dc.b 10,"20 28 <seg> if BUF 6 + w@"
.fl34: dc.w .fl35-.fl34
	dc.b 4,"begin redraw while v_recfl repeat"
.fl35: dc.w .fl36-.fl35
	dc.b 4,"BUF 8 + w@ "
.fl36: dc.w .fl37-.fl36
	dc.b 4,"BUF w@ case"
.fl37: dc.w .fl38-.fl37
	dc.b 7,"27 28 <seg> if "
.fl38: dc.w .fl39-.fl38
	dc.b 1,": max_xywh 0 4 wind_get intout 2+ get_xywh ; "
.fl39: dc.w .fl40-.fl39
	dc.b 1,"\ -------------"
	if  LANG=0
.fl40: dc.w .fl41-.fl40
	dc.b 1,"\  Chargements "
.fl41: dc.w .fl42-.fl41
	dc.b 1,"\ Outils utiles"
.fl42: dc.w .fl43-.fl42
	dc.b 1,"\  D‚finitions "
.fl43: dc.w .fl44-.fl43
	dc.b 1,"\ Prg principal"	
.fl44: dc.w .fl45-.fl44
	dc.b 1,"\ Structure RSC"
.fl45: dc.w .fl46-.fl45
	dc.b 4,"\ La valeur (0-7) empil‚e correspond au mouvement: "
.fl46: dc.w .fl47-.fl46
	dc.b 4,"\ entre while et repeat on a sur la pile x y x' y' "
.fl47: dc.w .fl48-.fl47
	dc.b 4,"\ zone … redessiner, ici v_recfl remplit un blanc"
.fl48: dc.w .fl49-.fl48
	dc.b 4,"\ Les ouvertures suivantes peuvent ˆtre plac‚es ailleurs:"
	else
.fl40: dc.w .fl41-.fl40
	dc.b 1,"\  Load files"
.fl41: dc.w .fl42-.fl41
	dc.b 1,"\  Cool tools"
.fl42: dc.w .fl43-.fl42
	dc.b 1,"\  Definitions "
.fl43: dc.w .fl44-.fl43
	dc.b 1,"\ Main routine "
.fl44: dc.w .fl45-.fl44
	dc.b 1,"\ RSC Structure"
.fl45: dc.w .fl46-.fl45
	dc.b 4,"\ The value on sthe stack (0-7) means this move: "
.fl46: dc.w .fl47-.fl46
	dc.b 4,"\ between while & repeat, x y x' y' are on the stack "
.fl47: dc.w .fl48-.fl47
	dc.b 4,"\ the zone to redraw, here v_recfl fills with white  "
.fl48: dc.w .fl49-.fl48
	dc.b 4,"\ The following openings can be placed elsewhere:"
	endif
.fl49: dc.w .fl50-.fl49
	dc.b 1,": w_dial >r 0 0 0 0 r> 16 + get_xywh form_dial ; "
.fl50: dc.w .fl51-.fl50
	dc.b 1,": drop_down0 "
.fl51: dc.w .fl52-.fl51
	dc.b 4,">r over over objc_offset intout 2+ @ r@ 16 + ! "
.fl52: dc.w .fl53-.fl52
	dc.b 4,"0 r@ w_dial 0 2 r@ 16 + get_xywh r@ objc_draw"
.fl53: dc.w .fl54-.fl53
	dc.b 4,"0 r@ form_do intout w@ %h7FFF and"
.fl54: dc.w .fl55-.fl54
	dc.b 4,"dup r@ get_obstate %hFE and over r@ set_obstate r> "
.fl55: dc.w .fl56-.fl55
	dc.b 1,";"
.fl56: dc.w .fl57-.fl56
	dc.b 1,": set_drop_down"
.fl57: dc.w .fl58-.fl57
	dc.b 4,"obj_addr 12 + @ pad gets obj_addr 6 + dup w@ swap 6 + @"
.fl58: dc.w .fl59-.fl58
	dc.b 4,"swap 28 <> if @ then pad swap puts ; "
.fl59: dc.w .fl60-.fl59
	dc.b 1,": drop_down_s"
.fl60: dc.w .fl61-.fl60
	dc.b 4,"drop_down0 >r dup 1 > if dup >r rot r> r@ set_drop_down"
.fl61: dc.w .fl62-.fl61
	dc.b 4,"else rot 2 dropm then 3 r> w_dial ;"
.fl62: dc.w .fl63-.fl62
	dc.b 1,": drop_down drop_down0 3 swap w_dial rot 2 dropm ; "
.fl63: dc.w .fl64-.fl63
	dc.b 1,"list "
.fl64:


.vl0: dc.b 1,"%b11101 >include ",34,0
.vl1: dc.b 34," rsrc_load",0
.vl2: dc.b 1,"0 xx rsrc_gaddr addrout @ ",0
.vl2b: dc.b 1,0
.vl2a: dc.b "dup constant tree_",0
.vl3: dc.b " &wdial_create win_",0
.vl4: dc.b 1,": do_~",0
.vl5: dc.b 7,"-1 of win_",0
.vl6: dc.b " wdial_close"
.vl13:						dc.b " endof",0
.vl7: dc.b " of do_",0
.vl8: dc.b " win_",0
.vl9: dc.b " update_button endof",0
	if LANG=0
.vl10: dc.b 4,"\ index ",34," titre",34," win_",0
.vl10a: dc.b 4,"\ 0 ",34," titre",34," win_",0
	else
.vl10: dc.b 4,"\ index ",34," title",34," win_",0
.vl10a: dc.b 4,"\ 0 ",34," title",34," win_",0
	endif
.vl11: dc.b " wdial_open drop",0
.vl12: dc.b 13,"win_",0
.vl14: dc.b " menu_bar",0
.vl15: dc.b 4,"1"
.vl155:			dc.b " tree_",0
.vl16: dc.b 10,"10 of BUF 8 + w@ do_",0
.vl20: dc.b 4,"0 tree_",0
.vl21: dc.b 1,": menunormal BUF 6 + w@ 1 tree_",0
.vl22: dc.b " menu_tnormal ;",0
.vl23: dc.b " wdial_close",0
.vl24: dc.b 1,"\ ",0
.vl25: dc.b 1,"\    ",0
	; ici 6 caractŠres par entr‚e
	dc.b "uwin ",0
	dc.b "fwin ",0
	dc.b "glst ",0
.vl26: dc.b "menu ",0,"dial ",0
		 dc.b "alrt ",0,"MItem",0,"Box  ",0,"Text ",0,"BText",0,"Image",0,"PrgDf",0,"IBox ",0
		 dc.b "Buttn",0,"BChar",0,"Strng",0,"FText",0,"FBTxt",0,"Icon ",0,"MTitl",0,"CIcon",0
.vl27: dc.b "Selct",0,"Deflt",0,"Exit ",0,"Edit ",0,"Radio",0
.vl28: dc.b " -> do_",0
.vl29: dc.b "array$ ",0
.vl30: dc.b "$ 0 ",0
.vl31: dc.b 34," gem_list",0
.vl32: dc.b 1,": up_",0
.vl33: dc.b 1,": down_",0
.vl34: dc.b 1,": lines_",0
.vl35: dc.b 7,"1 of up_",0
.vl36: dc.b 7,"2 of down_",0
.vl37a: dc.b "dup ",0
.vl37: dc.b "- lines_",0
.vl38: dc.b " update_button",0
.vl39: dc.b 1,"fasthdl constant ~",0

	if LANG=0
.vl40: dc.b 1,"~ ",34," Titre",34," 2 wind_set",0
	else
.vl40: dc.b 1,"~ ",34," Title",34," 2 wind_set",0
	endif
.vl41: dc.b 1,"~ ",34," Info",34," 3 wind_set",0
.vl42: dc.b 4,"\ ~ max_xywh wind_open",0
.vl43: dc.b " wind_close",0
.vl44: dc.b 1,": redraw_~",0
.vl45: dc.b 4,"~ BUF 8 + w@ get_xywh set_redraw",0
.vl46: dc.b 1,": ?slid_~",0
.vl47: dc.b 4,"~ BUF 8 + w@ ? wind_set",0
.vl48: dc.b 1,": arrows_~",0
.vl49: dc.b 7,"20 of redraw_~ endof",0
.vl50: dc.b 7,"21 of ~ 10 wind_set endof",0
.vl51: dc.b 7,"22 of ~ wind_close endof",0
.vl52: dc.b 7,"23 of ~ 5 wind_get ~ intout 2+ get_xywh 5 wind_set endof",0
.vl53: dc.b 7,"24 of arrows_~ endof",0
.vl54: dc.b 7,"25 of hslid_~ endof",0
.vl55: dc.b 7,"26 of vslid_~ endof",0
.vl56: dc.b 1,"%b000000000000 max_xywh wind_create intout w@ constant ~",0
.vl57: dc.b 10,"~ BUF 8 + get_xywh 5 wind_set",0
.vl58: dc.b 10,"~ 4 wind_get intout 2+ get_xywh page0 defpage",0
.vl59: dc.b 4,"~ tree_Ý tree_~0 drop_down_s drop",0
.vl60: dc.b 4,"~ tree_Ý tree_~0 drop_down drop",0
; .vl61: dc.b 4,"win_Ý update_win",0
.vl62: dc.b ", ddwn ",0
.vl63: dc.b " (ddwn) -> tree_",0
.vl64: dc.b 1,"dolist i r@ ~$ $! lloop",0


	

		
	even

   SAUT
loadb: tst selmode
   bne.s .lb0
   move.l (a6)+,a0
   bra lll7
.lb0:
	move.l #chemin,addrin
   move.l #fichier,addrin+4
	bsr selecteur
	beq finl
lll7: clr -(sp)
   move.l a0,-(sp)
   GEMDOS $3d,8
   tst.l d0
   bpl.s .lb2
   tst selmode
   beq.s .erreur
	lea .extension(pc),a0
	bsr retente				; force ".FOR" … la fin et retente...
	bpl.s .lb2   
.erreur:
   ACONTROL 53,1,1,0
   move #2,intin	; file not found
   AES
   bra finl
.extension: dc.b "FOR",0
.lb2: move d0,fhdl
	tst selmode
	beq.s .boucle
	move.l bfptr,-(a6)	; pour les statistiques
.boucle: move.l #ldbuf,-(sp)
   move.l #6,-(sp)
   move fhdl,-(sp)
   GEMDOS 63,12
   cmp #6,d0
   bne.s .fin
   move ldbuf,d6
   move.l ldbuf+2,d7
   move.l bfptr,-(sp)
   move.l d7,-(sp)
   move fhdl,-(sp)
   GEMDOS 63,12
   cmp.l d0,d7
   bne.s .fin
   add d6,topedit
   add.l d7,bfptr
   bra.s .boucle
.fin: 
	move.l bfptr,a0
   clr (a0)
   move fhdl,-(sp)
   GEMDOS 62,4
   tst selmode
   beq finl			; sans s‚lecteur, pas d'info affich‚e
load_stat:
   lea charg0(pc),a0
   GOSUB write_str
   move.l bfptr,d0
   sub.l (a6)+,d0	; diff‚rence par rapport … l'ancien pointeur
   move.l d0,-(a6)
   moveq #10,d4	; force base 10
   GOSUB pt			; octets ajout‚s
   lea charg1(pc),a0
   GOSUB write_str
   move.l addrin+4,a0	; adresse nom fichier
   GOSUB write_str
   GOSUB cr
   lea charg2(pc),a0
   GOSUB write_str
   move.l bfptr,d0
   sub.l beuf,d0		; taille utilis‚e
   move.l d0,-(a6)
   move.l d0,-(a6)
	moveq #10,d4
	GOSUB pt
	lea charg3(pc),a0
	GOSUB write_str
	move.l bfsize,d0
	sub.l (a6)+,d0		; taille restante   
	move.l d0,-(a6)
	moveq #10,d4
	GOSUB pt
	lea charg4(pc),a0
	GOSUB write_str
	GOSUB cr
finl: rts

	if LANG=0
charg0: dc.b "Chargement de ",0
charg1: dc.b " octets depuis le fichier ",0
charg2: dc.b "Editeur : ",0
charg3: dc.b " octets occup‚s et ",0
charg4: dc.b " libres.",0
	else
charg0: dc.b "Loaded ",0
charg1: dc.b " bytes from ",0
charg2: dc.b "Editor : ",0
charg3: dc.b " bytes used and ",0
charg4: dc.b " free.",0
	endif
	even

retente:
	move.l a0,-(a6)		; nouvelle extension
	move.l addrin+4,-(a6)	; le fichier
	bsr changeext
	move.l (a6)+,a0		; pad
	move.l addrin+4,a1
.copy:
	move.b (a0)+,(a1)+
	bne.s .copy
	bsr _colle_chemin_fichier
	clr -(sp)
   move.l a0,-(sp)
   GEMDOS $3d,8
   tst.l d0	
   rts

selmode: dc.w -1	; FFFF si ouvrir s‚lecteur, 0 si adresse sur pile
beuf:    dc.l 0

   SAUT
append: moveq #-1,d6
   bra.s ssav

   SAUT
saveb: moveq #0,d6
ssav: tst topedit
   bne.s .lb0
.fin: rts
.lb0: tst selmode
   bne.s .aes
   move.l (a6)+,d7
   bra .suite
.aes:
	move.l #chemin,addrin
   move.l #fichier,addrin+4
	bsr selecteur
	beq .fin
	move.l a0,d7
.suite:
	tst debutb			; un bloc marqu‚?
	bmi.s .suite2		; non !
	btst #1,alert_mask+1	; alerte demand‚e?
	beq.s .suite2		; non !
	lea saveb2(pc),a0
	bsr forth_alert			; on avertit!
	beq .fin				; annuler
	cmp #2,d0			; sauver bloc?
	beq.s .suite2		; oui, ne rien changer
	move.l #-1,debutb	; sinon, effacer marquage bloc pour sauver tout
.suite2:
   move #1,-(sp)
   move.l d7,-(sp)
   GEMDOS $3d,8		; d'abord on ouvre pour voir si il existe
   move d0,fhdl
   bmi.s .creer		; si le fichier n'existe pas, on cr‚e (append ou saveb)
   tst d6
   bmi.s .lb1			; si il existe et mode append=-1, continuer, c'est normal
   move d0,-(sp)		; en mode saveb=0, on referme le fichier
   GEMDOS $3e,4
   btst #0,alert_mask+1		; alerte demand‚e si effacement?
   beq.s .creer				; non, donc on efface sans demander
   lea saveb1(pc),a0
   bsr forth_alert
   beq .fin						; annuler
.creer: move #0,-(sp)
   move.l d7,-(sp)
   GEMDOS $3c,8
   move d0,fhdl
   bmi .fin
.lb1: clr d1
   move.l beuf(pc),a3
   move debutb,d0
   bmi.s .lb4
   cmp topedit,d0
   bpl .fin
   bra.s .lb3
.lb2: add.w (a3),a3
.lb3: dbf d0,.lb2
.lb4: move.l a3,a2
   move finb,d0
.lb5: move (a2),d2
   beq.s .lb6
   addq #1,d1
   add.w d2,a2
   dbf d0,.lb5
.lb6: move.l #ldbuf,a0
   move.l a0,-(sp)
   move.l #6,-(sp)
   move d1,(a0)+
   sub.l a3,a2
   move.l a2,(a0)
   move fhdl,-(sp)
   move #2,-(sp)
   move fhdl,-(sp)
   clr.l -(sp)
   GEMDOS $42,10
   GEMDOS $40,12
   move.l a3,-(sp)
   move.l a2,-(sp)
   move fhdl,-(sp)
   GEMDOS $40,12
   move fhdl,-(sp)
   GEMDOS $3e,4
   tst debutb			; si un bloc est marqu‚, rien changer
   bpl.s .exit
   sf change_flag		; sinon, reset le flag de modification
.exit:
   rts
forth_alert:
	move.l a0,addrin
_forth_alert:			; ici si addrin d‚j… charg‚
	GEM_VDI show_mouse
   ACONTROL 52,1,1,1
   move #1,intin		; premier bouton d‚faut (annuler)
   AES
   move intout,-(sp)
   GEM_VDI hide_mouse
   jsr souris_visible
   move (sp)+,d0
   cmp #1,d0			; renvoie EQ si annuler, NE si poursuivre
   rts

	if LANG=0
saveb1: dc.b "[1][ Le fichier existe ! | Doit-on l'‚craser? ][ Annuler | Ecraser ]",0
saveb2: dc.b "[1][ Un bloc est marqu‚, | que doit-on sauver ? ][ Annuler | Bloc | Tout ]",0
saveb3: dc.b "[1][ Le texte ‚dit‚ | a ‚t‚ modifi‚. | Vraiment quitter? ][ Oui | Non ]",0
helpbug1: dc.b "[1][ Le fichier FORTH.HLP | est introuvable. | Compl‚tez FORTH.INI ! ][ Ok ]",0
	else
saveb1: dc.b "[1][ The file exists ! | Should I ... ][ Cancel | Overwrite ]",0
saveb2: dc.b "[1][ A block is marked, | what should I save ? ][ Cancel | Block | All ]",0
saveb3: dc.b "[1][ The edited text | has been modified. | Really quit ? ][ Yes | Non ]",0
helpbug1: dc.b "[1][ Can't find FORTH.HLP | file ! Please check | FORTH.INI ! ][ Ok ]",0
	endif
	even

; ouvre le selecteur, renvoit EQ si Annuler
; renvoit NE et a0=source=adresse du chemin complet

selecteur:
   GEM_VDI show_mouse
   ACONTROL 90,0,2,2
   AES
   move intout+2,-(sp)
   GEM_VDI hide_mouse
   GOSUB cls
	jsr souris_visible
   tst (sp)+
   bne.s _colle_chemin_fichier
   moveq #0,d0				; renvoit EQ
   rts
_colle_chemin_fichier:
	move.l #source,a0
   move.l addrin,a1
.lb4: move.b (a1)+,(a0)+
   bne.s .lb4
   moveq #'\',d0
.lb1: cmp.b -(a0),d0
   bne.s .lb1
   addq.l #1,a0
   move.l addrin+4,a1
.lb11: move.b (a1)+,(a0)+
   bne.s .lb11
   move.l #source,a0
   moveq #1,d0				; renvoit NE
   rts



   NON
forget: move (a5)+,d1
   lea ordres,a0
   move d1,forth
   cmp dicco,d1
   bpl.s .lb1
   move d1,dicco
.lb1: lea adresse(pc),a1
   move d1,d2
   subq #1,d1
   ext.l d2
   lsl.l #2,d2
   move.l  0(a1,d2),d2
   move.l d2,topprg
   cmp.l program,d2
   bpl.s .lb2
   move.l program,topprg
.lb2: move.b (a0)+,d2
   ext.w d2
   add.w d2,a0
   dbf d1,.lb2
   clr.b (a0)
   move.l a0,sommet
   rts

   SAUT
vlist: move.l topprg,a1
   move dicco,d1
   lea ordres,a0
   subq #1,d1
.lb1: move.b (a0)+,d2
   ext.w d2
   add.w d2,a0
   dbf d1,.lb1
.lb2: move.b (a0)+,d1
   beq.s .lb4
   ext.w d1
   subq #1,d1
.lb3: move.b (a0)+,(a1)+
   dbf d1,.lb3
   move.b #32,(a1)+
   bra.s .lb2
.lb4: clr.b (a1)
   move.l topprg,a0
   GOSUB write_str
   rts

   ASS 18
quit: move.l a6,pilptr
   move.l a4,retptr
   addq.l #4,sp
   rts

   NON
qt1: move.l a6,pilptr
   move.l a4,retptr
   addq.l #4,sp
   rts

polyline: dc.l pl_cont,dum,pl_pts,dum,dum
pl_cont: dc.w 6,2,0,0,0,0,0,0,0,0,0,0
pl_pts: dc.w 0,0,0,0

vst_eff: dc.l vef_cont,vef_int,dum,dum,dum
vef_cont: dc.w 106,0,0,1,0,0,0,0,0,0,0,0
vef_int: dc.w 0

	; adresse texte sur la pile, enlev‚e ensuite
_texte_effet:
	movem.l d0-d2/a0-a2,-(sp)
	move.l 28(sp),a0	; adresse pass‚e sur la pile
	moveq #0,d0			; mode texte normal
.find_start:
	move.b (a0)+,d1
	beq.s .lb11a		; ligne finie, effet standard
	cmp.b #' ',d1
	beq.s .find_start	; encore un espace
	subq.l #1,a0		; sinon on revient sur le 1er caractŠre trouv‚
	cmp.b #'\',(a0)	; un commentaire?
	bne.s .lb10a
	cmp.b #' ',1(a0)	; valid‚ par l'espace?
	bne.s .lb11a		; non, ligne normale
	moveq #2+1,d0			; effet gris+gras
	bra.s .lb11a
.lb10a:
	cmp.b #':',(a0)	; d‚but de def ?
	bne.s .lb11a
	cmp.b #' ',1(a0)	; valid‚ par un espace?
	beq.s .lb10b
	cmp.b #':',1(a0)	; ou def assembleur
	bne.s .lb11a
	cmp.b #' ',2(a0)	; valid‚e par un espace?
	bne.s .lb11a
.lb10b:
	moveq #1,d0			; oui, ligne en gras
.lb11a:
	move d0,vef_int	; effet stock‚
   GEM_VDI vst_eff	; et valid‚ !
   movem.l (sp)+,d0-d2/a0-a2
   move.l (sp)+,(sp)	; et vire l'adresse pass‚e en paramŠtre
   rts

save_clipbrd:
	movem.l d0-d7/a0-a6,-(sp)
	movem.l regist+52,a4-a6
	move selmode,-(a6)
	clr selmode
	move.l kbshift,a0
	move.b (a0),d0
	and.b #$03,d0			; un shift appuy‚?
	sne selmode+1		; up 00 down FF si Shift
	lea clipbrd,a3
	tst.b (a3)
	beq.s .fin
	move.l a3,-(a6)
	bsr export
.fin:
	move (a6)+,selmode
	movem.l (sp)+,d0-d7/a0-a6
	rts
	
load_clipbrd:
	movem.l d1-d7/a0-a6,-(sp)
	movem.l regist+52,a4-a6
	move selmode,-(a6)
	clr selmode
	lea clipbrd,a3
	tst.b (a3)
	beq.s .fin
	move topedit,debutb	; bloc l… ou sera charg‚ le fichier
	move.l a3,-(a6)
	bsr import
	move #$2F16,d0			; par d‚faut, rien changer
	move topedit,d1
	sub debutb,d1			; si z‚ro, aucune ligne charg‚e
	bne.s .lb0
	move.l #-1,debutb		; dans ce cas annuler marquage du bloc
	bra.s .fin
.lb0:
	move d1,finb
	move #$5900,d0			; sinon simuler un Bloc Move
.fin:
	move (a6)+,selmode
	movem.l (sp)+,d1-d7/a0-a6
	rts

set_clipbrd:
	lea clipbrd,a3
	move.l a3,-(a6)
	GOSUB scrp_read
	tst.b (a3)
	beq.s .fin			; pas de chemin d‚fini, on abandonne
.lb0:
	tst.b (a3)+
	bne.s .lb0			; cherche la fin
	subq.l #2,a3		; dernier caractŠre
	cmp.b #'\',(a3)+
	beq.s .lb1			; ok
	move.b #'\',(a3)+
.lb1:
	lea .nom(pc),a0
.lb2:
	move.b (a0)+,(a3)+	; ajoute SCRAP.TXT
	bne.s .lb2
.fin:
	rts	
.nom: dc.b "SCRAP.TXT",0
	even

   SAUT
edit:
	bsr.s set_clipbrd		; pour Ctrl-C et Ctrl-V
	lea in_data,a1
	move topedit,(a1)+	; sauvegarde pour v‚rifier si le fichier a chang‚
	move.l bfptr,(a1)		; ainsi qu'adresse de fin
	move.l #$AAAAAAAA,slider		; valeur impossible pour forcer redessin
   move.l #edit_list,end_keys
   movem.l a4-a6,regist+52
        ; cr‚ation des diff‚rentes fenetres ( titres, s‚parations )
   move.l #fenetre0,-(a6) ; l'‚cran de base
   GOSUB setp             ; un bout de clipping, histoire de...
   GOSUB cls            ; vide l'‚cran
   lea fenetre0,a0
   lea edit_haut,a1   ; X Y     L h     0 0 l h
   lea edit_bas,a2    ; X Y+h+2 L H-h-2 0 ? l h
   lea pl_pts,a3      ; X Y+h+1 X+L-1 Y+h+1
   move 14(a0),d0     ; h
   move.l (a0),(a3)+
   move.l (a0),(a1)+
   move.l (a0)+,(a2)+
   add d0,-2(a2)
   addq #2,-2(a2)
   add d0,-2(a3)
   addq #1,-2(a3)
   move.l -4(a3),(a3)
   move (a0)+,d1
   add d1,(a3)
   subq #1,(a3)
   move d1,(a1)+
   move d0,(a1)+
   move d1,(a2)+
   move (a0)+,(a2)
   sub d0,(a2)
   subq #2,(a2)+
   clr.l (a1)+
   clr.l (a2)+
   addq.l #4,a0
   move.l (a0),(a1)
   move.l (a0),(a2)
   move.l #w_edit,wst_in+4
   GEM_AES wind_set_title  ; le titre de l'‚diteur
   GEM_VDI polyline

         ; calcul des lignes et colonnes disponibles

   lea edit_bas,a0
   moveq #0,d0
   move 6(a0),d0      ; hauteur d'‚dition
   divs 14(a0),d0     ; nombre de lignes utiles
   subq #1,d0
   move d0,lignes     ; lignes utiles-1
   asr #1,d0
   move d0,demi_ecran
   moveq #0,d0
   move 4(a0),d0      ; largeur totale
   divs 12(a0),d0     ; nombre de colonnes
   move d0,colonnes

       ; la ligne … ‚diter

   move editb,d5 ; ligne ‚dit‚e
   move #-1,ksize ; taille maxi

.lb1reset:
   moveq #0,d7
   moveq #0,d4  ; et sur la premiŠre colonne

       ; efface tout l'‚cran, calcule la ligne du haut
       ; et v‚rifie celle ‚dit‚e
.lb1:
   move.l #edit_bas,fenetre
   GEM_VDI hide_mouse
   GOSUB cls
   move.l beuf(pc),a6
   cmp topedit,d5
   bmi.s .lb2
   move topedit,d5  ; nø ligne trop grand
.lb2: move d5,d0
   bpl.s .lb3
   clr d5           ; nø ligne trop petit
   clr d0
.lb3: sub demi_ecran,d0
   bpl.s .lb4
   clr d0
.lb4: move d0,d6    ; ligne du haut
   bra.s .lb6
.lb5: add (a6),a6
.lb6: dbf d0,.lb5   ; a6:adr de la ligne du haut
   move.l a6,a5
   move d5,d0
   sub d6,d0
   bra.s .lb8
.lb7: add (a5),a5
.lb8: dbf d0,.lb7   ; a5:adr de la ligne ‚dit‚e

       ; affichage des lignes ( ‚cran entier )

   move lignes,d2     ; indice pour les lignes
   movem.l d4-d7,regist
.loop:
   tst (a6)+
   beq .lb13      ; si derniŠre ligne
   cmp lignes,d2    ; sur la premiŠre ligne, pas de saut
   beq.s .truc
   GOSUB cr
.truc:
	move.l edb,a0
   move.b (a6)+,d0
   move.l a6,-(sp)	; adresse ligne
   bsr _texte_effet	; pr‚pare l'effet de texte
   ext.w d0
   subq #1,d0       ; tabulation
   moveq #32,d1
   bra.s .lb10
.lb9: move.b d1,(a0)+  ; copie autant de blancs que voulu
.lb10: dbf d0,.lb9
.lb11: move.b (a6)+,(a0)+
   bne.s .lb11      ; transfert du reste
   subq.l #1,a6     ; revient sur le z‚ro
   subq.l #1,a0
   cmp.b -1(a0),d1  ; au cas ou ce soit un espace en dernier caractŠre
   bne.s .lb12
   subq.l #1,a0     ; alors on recule
.lb12: clr.b (a0)   ; fin de chaine virtuelle
	move.l edb,a0
   move colonnes,d0
   clr.b (a0,d0.w)     ; fin de chaine physique ( si ‚cran trop petit )
   move d2,a3
	if STE=1
		jsr write_str
	else
	   bsr.l write_str
	endif
   move a3,d2
   dbf d2,.loop
.lb13:
	clr vef_int
	GEM_VDI vst_eff		; effet normal
	GEM_VDI show_mouse
   movem.l regist,d4-d7
.bc1:
   bsr lgnaff        ; num‚ro de la ligne
   bsr update_slider	; vertical slider selon le bloc
   if STE=0
	   lea ([edb,pc],8),a0 ; buffer plus 8
	else
		move.l edb,a0
		addq.l #8,a0
	endif
   move.l a0,a2
   moveq #4,d0
   move.l #$20202020,d1
.lb14: move.l d1,(a0)+
   move.l d1,(a0)+
   move.l d1,(a0)+
   move.l d1,(a0)+
   dbf d0,.lb14      ; pr‚pare 80 blancs pour la ligne
   clr.b (a0)

   move d5,d3        ; calcule les coordonn‚es du curseur
   sub d6,d3         ; nøde ligne … l'‚cran
   lea edit_bas,a1
   muls 14(a1),d3    ; fois h, coordonn‚e du curseur en points
   move.l d3,8(a1)   ; avec 0 pour x dans le mot sup‚rieur
   move.l a1,fenetre

   move.l a5,a1
   tst (a1)+
   beq.s .bc3        ; ligne vide, pas de transfert
   move.b (a1)+,d0
   ext.w d0
   subq #1,d0
   add.w d0,a2       ; on saute la tabulation
.lb15: move.b (a1)+,(a2)+
   bne.s .lb15       ; on tranfert la ligne
   move.b d1,-(a2)
.bc3:
   if STE=0
   	lea ([edb,pc],8),a0
   else
   	move.l edb,a0
   	addq.l #8,a0
   endif
   movem.l d5-d6,regist
   moveq #-80,d6     ; nombre maxi de caractŠres … lire ( d4/d7 colonne )
   jsr edition
   movem.l regist,d5-d6

   bsr propre    ; traite les cas de RETURN ( nouvelle ligne )
                 ; BACKSPACE ( collage de deux lignes )
                 ; Control DEL ( vire une ligne )
                 ; et UNDO = Shift F2 ( ne fait rien )
                 ; renvoit un code
                 ; >0 si on doit traiter une touche encore
                 ; 0 si l'‚cran est correct ( .bc1 )
                 ; -1 si il faut redessiner ( .lb1 )
   tst d0
   beq .bc1
   bmi .lb1
   cmp #$5400,d0	; Shift F1 simule Help
   beq.s .tta1
   cmp #$6200,d0	; HELP afficher aide
   bne.s .tta
.tta1:
   bsr help_display
   move #2,-(sp)
   BIOS 2,4			; attendre touche
   bra .lb1			; tout reconstruire
.tta:
	cmp #$5C00,d0	; shift F9, aide mot sous le curseur
	bne.s .tta2
	bsr help_cursor
	bne .lb1			; si NE, une aide trouv‚e, tout reconstruire
	bra .bc1
.tta2:
   cmp #$3b00,d0 ; F1 : top of file
   bne.s .tt0
   clr d5
   bra .lb1
.tt0:
   cmp #$3c00,d0 ; F2 : screen up
   bne.s .tt01
.f2:
   move demi_ecran,d0
   asr #1,d0
   sub d0,d6
   move d6,d5
   bra .lb1
.tt01:
   cmp #$3d00,d0 ; F3 : bloc start
   bne.s .tt02
   move d5,debutb
;   move #-1,finb
	move topedit,d0
	sub d5,d0
	move d0,finb
;
   bra .bc1
.tt02:
	cmp #$5600,d0		; shift F3 aller au d‚but du bloc
	bne.s .tt02a
	move debutb,d0
	bpl.s .tt020
.tt021:
	bsr bell
	bra .bc1			; pas de bloc, rien … faire
.tt020:
	move d0,d5
	bra .lb1
.tt02a:
   cmp #$3e00,d0 ; F4 : bloc end
   bne.s .tt03
   move debutb,d0
   bmi.s .tt021		; pas de bloc marqu‚, on saute
   sub d5,d0
   bmi.s .tt02b	; fin aprŠs d‚but, ok on garde
   move d5,debutb	; sinon, d5 devient d‚but !
   bra.s .tt02c
.tt02b:
   neg d0
.tt02c:
   move d0,finb
   bra .bc1
.tt03:
	cmp #$5700,d0	; Shift F4: aller … la fin du bloc
	bne.s .tt03a
	move debutb,d0
	bmi.s .tt021			; pas de bloc...
	move finb,d5
	bmi .tt2a		; si n‚gatif, bloc jusqu'… la fin, prendre topedit
	add d0,d5		; sinon calcule fin de bloc
	bra .lb1	
.tt03a:
   cmp #$3f00,d0 ; F5 : bloc hide
   bne.s .tt1
   move.l #-1,debutb
   bra .bc1
.tt1:
	cmp #$2E03,d0		; Ctrl-C ou Shift Ctrl-C
	bne.s .tt1a
	bsr save_clipbrd
	bra .bc1
.tt1a:
	cmp #$2F16,d0		; Ctrl-V
	bne.s .tt1b
	bsr load_clipbrd	; renvoie D0=2F16 si rien … faire et d0=$5900 si bloc move
	bra .ttt4
.tt1b:
	cmp #$260c,d0	; Ctrl-L : goto line
	beq.s .tt1b_b
   cmp #$4000,d0  ; F6	: goto line
   bne.s .ttt1
.tt1b_b:
   bsr aller
   bra .lb1
.ttt1:
	cmp #$2106,d0	; Ctrl-F : find
	beq.s .ttt1_b
   cmp #$4100,d0 ; F7 : find
   bne.s .ttt2
.ttt1_b:
   bsr chercher
   bra .lb1
.ttt2:
	cmp #$2207,d0	; Ctrl-G : find next
	beq.s .ttt2_b
   cmp #$4200,d0 ; F8 : find next
   bne.s .ttt3
.ttt2_b:
   bsr chsuiv
   bra .lb1
.ttt3:
   cmp #$5800,d0 ; Shift F5 : bloc delete
   bne.s .ttt4
   bsr bloc
   beq .bc1
   bsr effbloc
   bra .lb1reset
.ttt4:
   cmp #$5900,d0 ; Shift F6 : bloc move
   bne.s .ttt5
   bsr bloc
   beq .bc1
   tst d0
   beq .bc1
   bsr mvbloc
   bra .lb1reset
.ttt5:
   cmp #$5a00,d0 ; Shift f7 : bloc copy
   bne.s .ttt6
   bsr bloc
   beq .bc1
   tst d0
   beq .bc1
   bsr cpbloc
   bra .lb1reset
.ttt6:
   cmp #$4300,d0 ; F9 : screen down
   bne.s .tt2
.f9:
   move lignes,d0
   add d0,d6
   asr #2,d0
   add d0,d6
   move d6,d5
   bra .lb1
.tt2:
   cmp #$4400,d0 ; F10 : end of file
   bne.s .tt3
.tt2a:
   move topedit,d5
   bra .lb1
.tt3:
   cmp #$011b,d0 ; ESC
   beq .fin

   cmp #$4838,d0       ; shift UP
   beq .f2

   cmp #$4800,d0       ; up
   bne.s .tt9
   tst d5
   beq .bc1            ; d‚j… au d‚but
   cmp d5,d6
   bne.s .lb24
   moveq #3,d0         ; ins‚rer en haut
   bsr copy_up
   subq #1,d6
.lb24: tst.b -(a5)     ; recule d'une ligne jusqu'au z‚ro de l'autre
   bne.s .lb24
   subq #1,d5
   bra .bc1
.tt9: cmp #$5032,d0    ; shift DOWN
   beq .f9

   cmp #$5000,d0       ; DOWN
	bne.s .tt10
   cmp topedit,d5
   beq .bc1            ; d‚j… au bout !
   move lignes,d0
   add d6,d0           ; num‚ro de la ligne du bas
   cmp d5,d0
   bne.s .lb25          ; pas en bas encore, on peut descendre
   bsr copy_down
   addq #1,d6
.lb25: addq #1,d5
   add.w (a5),a5
   bra .bc1
.tt10:
	move d0,d1
	and #$CFFF,d1
	cmp #$0F09,d1			; l'un des Shift TAB ?
   bne .lb1            	; autre touche ? bizarre...
   bsr _shift_tab
	beq .bc1					; si EQ, ‚cran … jour (rien … faire)
	bra .lb1					; sinon, tout redessiner
.fin:
   move d5,editb
   bsr .remove_ghost_line	; is cursor on last line a ghost line appears not counted in topedit
   lea in_data,a0
   move (a0)+,d0
   cmp topedit,d0			; topedit a chang‚?
   sne change_flag
   bne.s .fin1				; un changement, pas besoin de v‚rifier l'adresse
   move.l (a0),d0
	cmp.l bfptr,d0			; mˆme adresse de fin?
	sne change_flag		; change_flag = FF si buffer modifi‚ !   
.fin1:
   moveq #1,d4
   moveq #1,d5
   moveq #-1,d6	; pour juste reset slider
   bsr update_slider
   move.l #w_titre,wst_in+4
   GEM_AES wind_set_title  ; le titre normal
   clr vef_int
   GEM_VDI vst_eff			; remettre le style normal
   move.l #fenetre0,fenetre
   GOSUB cls
   lea bloc0,a0
   tst debutb
   bmi.s .fin2
   lea bloc1,a0
.fin2:
	if STE=1
		jsr write_str
	else
	   bsr.l write_str
	endif
   movem.l regist+52,a4-a6
   rts
.remove_ghost_line:
	moveq #0,d1				; line count
	move.l beuf(pc),a0
	moveq #0,d2
.rgl0:
	move (a0),d0
	beq.s .rgl1
	add d0,a0
	addq #1,d1
	move d0,d2
	bra.s .rgl0
.rgl1:
	cmp topedit,d1
	beq.s .rgl2				; this is correct !
	move d1,topedit		; update with good value
	cmp #4,d2				; else, last line with 4 bytes?
	bne.s .rgl2				; no...
	cmp.b #32,-(a0)			; and a space?
	bne.s .rgl2				; no don't touch!
	subq.l #3,a0
	clr (a0)					; mark the end
	move.l a0,bfptr
	subq #1,topedit
.rgl2:
	rts	
	


copy_up:
   moveq #0,d0    ; ligne 0 au d‚part
   moveq #1,d1    ; +1 vers le bas
   move lignes,d3 ; lignes-1 … d‚caler
   bsr _deplace
   rts

copy_down:
   moveq #1,d0    ; premiŠre ligne
   moveq #-1,d1   ; -1 vers le haut
   move lignes,d3
   bsr _deplace
   rts

copy_del:
   move d5,d0
   sub d6,d0
   move lignes,d3
   sub d0,d3      ; nombre de lignes
   addq #1,d0     ; source sous d5
   moveq #-1,d1   ; vers le haut
   bsr _deplace
   move lignes,d0 ; afficher la derniŠre ligne
   bsr _ecrire
   rts


copy_ret:
   move d5,d0
   sub d6,d0
   move lignes,d3
   sub d0,d3
   bgt.s .lb0     ; ok, pas sur la derniŠre ligne
   moveq #-1,d0   ; sinon, redessiner entiŠrement l'‚cran
   rts
.lb0:
   moveq #1,d1
   bsr _deplace
   move d5,d0
   sub d6,d0      ; transforme en offset pour la routine _ecrire
   subq #1,d0     ; afficher ligne pr‚c‚dente ( qui a ‚t‚ coup‚e )
   bsr _ecrire
   moveq #0,d0    ; pas d'‚cran … redessiner.
   rts

; BackSpace sur la 1ere colonne
; si 1ere ligne : ignorer
; si en recollant les 2 lignes on d‚passe 80, ignorer
; sinon, coller, ajuster le bloc et tout redessiner.


backspace:
  	tst d5
   beq .out		   ; si 1ere ligne, rien … faire
   move.l beuf(pc),a0	; d‚but du texte
   move d5,d0
   subq #1,d0		; va chercher la ligne -1
   bra.s .lb0
.lb1:
	add.w (a0),a0
.lb0:
	dbf d0,.lb1
	moveq #0,d0
	move.b 2(a0),d0	; tabulations+1
	add (a0),d0			; taille totale en ram
	subq #4,d0			; taille actuelle de la ligne, tabulations comprises
	move d0,d4			; sera la nouvelle position du curseur
	bsr new_cursor		; et adapte d4/d7 selon largeur fenˆtre
   if STE=0
   	lea ([edb,pc],8),a1
   else
   	move.l edb,a1
   	addq.l #8,a1
   endif	
   moveq #0,d1
   move.l a1,a2
.debut_ligne:
	move.b (a1)+,d2
	beq.s .ok
	cmp.b #32,d2
	beq.s .debut_ligne
	move.l a1,a2
.taille_ligne:
	addq #1,d1
	tst.b (a2)+
	bne.s .taille_ligne
	subq.l #1,a2
.recule:
	cmp.b #32,-1(a2)
	bne.s .ok
	clr.b -(a2)
	subq #1,d1
	bra.s .recule
.ok:
	subq.l #1,a1		; d‚but de ligne nouvelle et d1 taille
	btst #0,d1			; impair?
	beq.s .ok2			; oui, ok
	move.b #32,(a2)+	; sinon un espace de plus
	clr.b (a2)
	addq #1,d1			; et ajuste taille
.ok2:
	move d0,d2
	add d1,d2			; taille totale !
	cmp #80,d2
	bhi .out				; trop de caractŠres, on quitte
	move.l a5,a3		; conserve l'endoit ou ajouter
	move.l a1,a2		; conserve le d‚but des octets … ajouter
	exg.l a5,a0			; a5 ligne pr‚c‚dente et a0 courante
	add d1,(a5)			; nouvelle taille ligne pr‚c‚dente
	cmp (a0),d1			; plus ou moins d'octets ajout‚s ?
	beq.s .egal
	lea 0(a0,d1.w),a1	; destination
	add (a0),a0			; source
	bsr _copie			; d‚place les blocs
.egal:
	move.b (a2)+,(a3)+	; copie la ligne coll‚e
	bne.s .egal
	
  	bsr where_in_block
 	bgt.s .k0a				; GT rien … faire, au dela du bloc
  	beq.s .k0b				; EQ dans le bloc
.k0c:
  	subq #1,debutb			; MI, avant le bloc, ajuster d‚but
  	bra.s .k0a
.k0b:
	cmp debutb,d5			; 1ere ligne du bloc?
	beq.s .k0c				; oui, on englobe la pr‚c‚dente
  	subq #1,finb			; EQ, une ligne de moins dans le bloc, ajuster taille
  								; le bloc ne peut jamais disparaitre
.k0a:	
	subq #1,topedit
	subq #1,d5				; une ligne avant		
	cmp d5,d6				; sommes-nous sur la 1ere ligne?
	bgt.s .tout				; oui, tout reconstruire
	bsr copy_del			; sinon, d‚placer vers le haut
	moveq #0,d0				; tout trait‚
	rts
.tout:
	moveq #-1,d0			; tout refaire
	rts
.out:
	moveq #0,d7
	moveq #0,d4		; curseur au d‚but
	bsr bell			; cloche car erreur !
	moveq #0,d0
   rts

; d0 ligne de d‚part dans edit_bas
; d1 offset en lignes ( + ou -1 en g‚n‚ral )
; d3 nombre de lignes

_deplace:
   tst d3
   bgt.s .ok
   rts
.ok:
   move #3,copy_int
   lea edit_bas,a0
   lea copy_pts,a1
   muls 14(a0),d0
   muls 14(a0),d1
   muls 14(a0),d3    ; convertit les lignes en points
   add.l (a0)+,d0    ; X:Y+D0
   move.l d0,(a1)+
   swap d3
   move (a0),d3      ; L
   swap d3           ; L et h
   add.l d0,d3       ; X+L:Y+D0+D3
   sub.l #$10001,d3  ; ajuste
   move.l d3,(a1)+   ; coin inf‚rieur droit
   add.l d1,d0
   move.l d0,(a1)+   ; rectangle dest
   add.l d1,d3
   move.l d3,(a1)    ; coin inf‚rieur droit
   clr.l mf1
   clr.l mf2
   GEM_VDI hide_mouse
   GEM_VDI copy_tab
   GEM_VDI show_mouse
   rts

; en entr‚e d0, num‚ro de la ligne … r‚‚crire ( en offset par rapport … d6 )

_ecrire:
   move d0,d1
   add d6,d1            ; num‚ro absolu de ligne
   move.l beuf(pc),a1
   bra.s .lb1
.lb0:
   add.w (a1),a1        ; recherche l'adresse de la ligne
.lb1: dbf d1,.lb0
	move.l edb,a0
   move.l a0,a2
   move.l #$20202020,d1
   moveq #19,d2
.lb2:
   move.l d1,(a2)+
   dbf d2,.lb2
   clr.b (a2)       ; la fin
   tst (a1)+
   beq.s .vide
   move.b (a1)+,d2
   move.l a1,-(sp)
   bsr _texte_effet
   ext.w d2         ; tabulation
   lea -1(a0,d2.w),a2
.lb3:
   move.b (a1)+,(a2)+
   bne.s .lb3
   move.b d1,-(a2)
.vide:
   move colonnes,d2
   clr.b (a0,d2.w)     ; fin de chaine physique ( si ‚cran trop petit )
   move.l #edit_bas,a1
   move.l a1,fenetre
   muls 14(a1),d0     ; curseur ( avec 0 pour x )
   move.l d0,8(a1)
   move.l d4,a3
   jsr write_str
   move.l a3,d4
   rts

; en entr‚e [edb(pc)]+8 contient les octets avec 0
; a5 pointe sur l'ancienne ligne
; d5 ligne en cours
; d6 ligne du haut
; utilise a0,a1,a3,a4,d1,d2
; renvoit 0 dans d0 si la touche est trait‚e
; renvoit le code si elle ne l'est pas encore
; renvoie -1 si la page est … redessiner

propre:
	cmp #$5500,d0		 ; Shift F2 simule UNDO
	beq.s .special
   cmp #$6100,d0      ; UNDO, ne pas tenir compte des modifications
   bne.s .lb_0
.special:
   moveq #0,d0
   rts
.lb_0:
   cmp #$531f,d0      ; control DEL
   bne.s .lb_1
      cmp topedit,d5
      bne.s .k0
      clr (a5)
      move.l a5,bfptr      ; dans la fin du texte
      bra.s .special
   .k0:
   	bsr where_in_block
   	bgt.s .k0a				; GT rien … faire, au dela du bloc
   	beq.s .k0b				; EQ dans le bloc
   	subq #1,debutb			; MI, avant le bloc, ajuster d‚but
   	bra.s .k0a
   .k0b:
   	subq #1,finb			; EQ, une ligne de moins dans le bloc, ajuster taille
   	bpl.s .k0a				; si >=0 ok
   	move #-1,debutb		; sinon, bloc disparu !
   .k0a:
   	subq #1,topedit
      move.l a5,a0
      add (a5),a0          ; source
      move.l a5,a1         ; dest
      bsr _copie
      bsr copy_del
      bra.s .special
.lb_1:
	cmp.b #13,d0       ; l'un des ENTER
	bne .lb_2

		move.l edb,a0
	   lea 8(a0),a1
	   lea 2(a0),a3
	   move d7,d0
	   add d4,d0       ; taille
	   move.b (a1,d0.w),d3 ; c'est l… que ENTER coupe
	   clr.b (a1,d0.w)  ; on simule la fin de ligne
      bsr _formater

		bsr where_in_block
		bgt.s .k1a			; GT rien … faire, au dela du bloc
		beq.s .k1b			; EQ dans le bloc
	.k1c:
		addq #1,debutb		; MI avant le bloc, le d‚caler
		bra.s .k1a		
	.k1b:
		cmp debutb,d5		; sur la 1ere ligne?
		bne.s .k1d			; non
		cmp.l #$00040120,(a0)	; a-t-on cr‚‚ une ligne vide?
		beq.s .k1c			; oui, cela d‚cale le bloc
	.k1d:
		addq #1,finb		; dans le bloc: une ligne de plus
	.k1a:

      move.b d3,(a1)   ; remet l'octet
      move.l a3,a0     ; nouvelle ligne en a3
      lea 2(a0),a3     ; la tabulation
      bsr _formater
		if STE=0
	      move.b ([edb,pc],2),d4  ; ancienne tabulation
	   else
	   	move.l a0,d7
	   	move.l edb,a0
	   	move.b 2(a0),d4
	   	move.l d7,a0
	   endif
      subq.b #1,d4     ; moins l'offset
      add.b d4,2(a0)   ; d‚cale la ligne suivante
      ext.w d4
      bsr new_cursor
      move.l a3,d2
		if STE=0
	      sub.l (edb,pc),d2
	   else
	   	sub.l edb,d2
	   endif
      bsr _insertion
      add.w (a5),a5
      addq #1,d5
      addq #1,topedit
      bsr copy_ret
		rts
.lb_2:
   cmp #$0e08,d0      ; BACKSPACE (si on est l… c'est forc‚ment sur la 1ere colonne)
   bne.s .normal
 		bsr backspace		; renvoie 0 si rien … faire ou -1 pour redessiner
 		rts
.normal:              ; touches sans suppression ou ajout de lignes
	move.l edb,a0
   lea 8(a0),a1
   lea 2(a0),a3
   bsr _formater
   bsr _insertion
   rts

new_cursor:
   moveq #0,d7      ; nouvelle position du curseur
   move colonnes,d3
.k1:
   cmp d3,d4        ; hors de la fenetre?
   bmi.s .k2		  ; non, tout est bon
   sub d3,d4        ; sinon, avance d'une fenetre
   add d3,d7
   bra.s .k1
.k2:
	rts

; en entr‚e, a5 pointe sur l'ancienne ligne
; d2 contient la taille de la nouvelle ligne
; nouvelle ligne en edb(pc)

_insertion:
   move (a5),d1       ; taille de la ligne avant
   lea (a5,d1.w),a0   ; d‚but de la ligne suivante avant
   lea (a5,d2.w),a1   ; d‚but de la ligne suivante voulu
   sub d2,d1          ; diff‚rence ?
   beq.s .lb9         ; aucune, rien … d‚placer
   bsr _copie
.lb9:
	move.l edb,a0
   move.l a5,a1
   lsr #1,d2          ; en mots
   bra.s .lb11
.lb10: move (a0)+,(a1)+
.lb11: dbf d2,.lb10
   rts

; en entr‚e a1 pointe sur le texte
; a0 pointe sur le d‚but de ligne formatt‚
; a3 pointe sur a0+2
; en sortie a3 pointe sur la fin de la ligne
; d2.l contient la taille
; a1 pointe sur le z‚ro terminal
; a0 pointe toujours sur le d‚but de la ligne

_formater:
   moveq #0,d1
.lb0: move.b (a1)+,d2
   beq.s .vide
   addq #1,d1
   cmp.b #32,d2
   beq.s .lb0
   move.b d1,(a3)+    ; nombre +1 d'espaces avant ( tabulation )
   subq.l #1,a1
.lb1: move.b (a1)+,(a3)+
   bne.s .lb1         ; copie la ligne
   subq.l #1,a3       ; revient sur le z‚ro
.lb2: cmp.b #32,-(a3)
   beq.s .lb2         ; revient sur les espaces de fin de ligne
   addq.l #1,a3
   move.b #32,(a3)+   ; un espace au cas o— (pour adresse paire)
   move.l a3,d2
   bclr #0,d2         ; adresse paire
   move.l d2,a3
   sub.l a0,d2        ; taille de la ligne
   move d2,(a0)
   bra.s .lb8
.vide: move.l a0,a3
   moveq #4,d2
   move.l #$40120,(a3)+
.lb8: subq.l #1,a1    ; a1 pointe sur le z‚ro terminal
   rts

; a0 source, a1 dest copie de a0 jusqu'a bfptr ( mis … jour en cons‚quence )
; modifie a0,a1,d1

_copie:
	move.l bfptr,d1
	sub.l a0,d1      ; octets … copier
   ror.l #4,d1      ; paquets de 16
   cmp.l a0,a1
   bpl.s .lb4
   bra.s .lb1
.lb0:
   move.l (a0)+,(a1)+
   move.l (a0)+,(a1)+
   move.l (a0)+,(a1)+
   move.l (a0)+,(a1)+
.lb1: dbf d1,.lb0
   rol.l #3,d1      ; reste en mots
   and #7,d1
   bra.s .lb3
.lb2:
   move (a0)+,(a1)+
.lb3: dbf d1,.lb2
   clr (a1)         ; fin de texte
   move.l a1,bfptr
   rts
.lb4: sub.l a0,a1
   move.l bfptr,a0
   add.l a0,a1
   clr (a1)       ; fin de texte
   move.l a1,bfptr
   bra.s .lb6
.lb5:
   move.l -(a0),-(a1)
   move.l -(a0),-(a1)
   move.l -(a0),-(a1)
   move.l -(a0),-(a1)
.lb6: dbf d1,.lb5
   rol.l #3,d1
   and #7,d1
   bra.s .lb8
.lb7:
   move -(a0),-(a1)
.lb8: dbf d1,.lb7
   rts

	; d5 = ligne qui va ˆtre supprim‚e ou ins‚r‚e
	; compar‚e … la position du bloc
	; revoie MI si D5 avant le bloc
	; renvoie EQ si D5 dans le bloc
	; renvoie GT si D5 aprŠs le bloc ou si pas de bloc
	; utilise d0
		
where_in_block:
	move debutb,d0
	bmi.s .rien
	cmp d0,d5
	bmi.s .exit		; renvoie MI, d5 avant le bloc
	tst finb
	bpl.s .lb0
	move topedit,finb
	sub d0,finb
.lb0:
	add finb,d0		; derniŠre ligne du bloc
	cmp d5,d0
	bmi.s .rien		; si au dessus on saute
.dans:
	moveq #0,d0		; renvoie EQ si dans le bloc
	bra.s .exit
.rien:
	moveq #1,d0		; ici, on est aprŠs le bloc, pas d'influence
.exit:
	rts
	
	; traite les 3 Shift TAB possibles
	; renvoie EQ si op‚ration impossible (block ind‚fini, ou d‚calage impossible)
	; sinon renvoie NE
	
_shift_tab:
	move debutb,d2
	bmi .bug			; pas de bloc d‚fini
	move finb,d1
	bpl.s .lb0		; si>=0 ok
	move topedit,d1	; sinon jusqu'… la fin
	sub d2,d1
.lb0:
	move.l beuf(pc),a0
	bra.s .lb1
.lb2:
	add (a0),a0		; cherche l'adresse de la 1ere ligne du bloc
.lb1:
	dbf d2,.lb2
	cmp #$3F09,d0	; double SHIFT TAB : normaliser les tabulations
	bne.s .autre
.normal:
	moveq #0,d0
	move.b 2(a0),d0	; tabulations+1
	subq #1,d0			; tab
	divs #3,d0
	muls #3,d0			; align‚ sur 3
	addq #1,d0
	move.b d0,2(a0)	; range la nouvelle tabulation
	add (a0),a0			; ligne suivante
	dbf d1,.normal
	bra.s .retour_ok
.autre:
	move.l a0,a1
	move.l d1,d2		; sauve pour la seconde boucle
	cmp #$2F09,d0		; SHIFT gauche TAB, r‚duire tabulation
	bne.s .autre2
.check:
	cmp.b #1,2(a1)
	beq.s .bug			; une colonne d‚j… au bord, d‚calage impossible
	add (a1),a1
	dbf d2,.check
.shift_gauche:
	moveq #0,d0
	move.b 2(a0),d0
	subq #1,d0			; tab
	divs #3,d0
	move.l d0,d2
	swap d2
	tst d2				; reste nul?
	bne.s .lb3			; non, il suffit d'arrondir en dessous
	subq #1,d0			; oui, donc 1 bloc en dessous
.lb3:
	muls #3,d0
	addq #1,d0
	move.b d0,2(a0)
	add (a0),a0
	dbf d1,.shift_gauche
.retour_ok:
	move debutb,d5		; ira au d‚but du bloc
	move d5,d6			; affiche une ligne au dessus
	beq.s .ro1			; sauf si on est d‚j… en d‚but de fichier
	subq #1,d6
.ro1:
	moveq #0,d4
	moveq #0,d7			; en d‚but de ligne
	moveq #1,d0
	rts
.autre2:					; ici SHIFT droit TAB, augmenter tabulation
	moveq #0,d0
	move.b 2(a1),d0	; tab
	add (a1),d0			; size (il faut Size+Tab-4 < 78, donc Size+Tab < 82)
	cmp #82,d0
	bpl.s .bug			; trop grand, pas de d‚calage droite possible
	add (a1),a1
	dbf d2,.autre2
.shift_droit:
	moveq #0,d0
	move.b 2(a0),d0
	subq #1,d0			; tab
	divs #3,d0
	addq #1,d0
	muls #3,d0			; bloc suivant
	addq #1,d0
	move.b d0,2(a0)	; nouvelle tabulation
	add (a0),a0
	dbf d1,.shift_droit
	bra.s .retour_ok
.bug:
	bsr bell
	moveq #0,d0
	rts


res: dc.w 0

aller: lea .prompt(pc),a5
   moveq #5,d6      ; taille maxi
   bsr _dialogue
   moveq #0,d4		 ; remet le curseur au d‚but
   moveq #0,d7
   lea 2(a5),a5
   clr d5
.lb0:
   move.b (a5)+,d1
   beq.s .fin
   muls #10,d5
   sub.b #'0',d1
   ext.w d1
   add d1,d5
   bra.s .lb0
.fin: rts
	if LANG=0
.prompt: dc.b "Aller en : ",0
	else
.prompt: dc.b "   Go to : ",0
	endif

   even

chercher: lea .prompt(pc),a5
   moveq #20,d6
   bsr _dialogue
   move (a5)+,d0
   beq.s .fin
   clr d3
   bsr.s fouille
   moveq #0,d4
   moveq #0,d7
.fin: rts
	if LANG=0
.prompt: dc.b "Chercher : ",0
	else
.prompt: dc.b "  Search : ",0
	endif

 even

chsuiv: lea mot,a5
   move (a5)+,d0
   beq.s .fin
   move d5,d3
   addq #1,d3
   bsr.s fouille
   moveq #0,d4
   moveq #0,d7
.fin: rts

fouille: cmp topedit,d3
   bpl.s .fin
   move.l beuf(pc),a0
   move d3,d1
   bra.s .lb1
.lb0: add.w (a0),a0
.lb1: dbf d1,.lb0
   move.b (a5)+,d4
.loop: move (a0),d2
   beq.s .fin
   move.l a0,a1
   addq.l #2,a1
   move.l a1,a4
   addq.l #1,a1
   add.w d2,a0
   subq #2,d2
   sub d0,d2
   bmi.s .lb4
   bra.s .lb3
.lb2: cmp.b (a1)+,d4
   bne.s .lb3
   move d0,d1
   move.l a1,a2
   move.l a5,a3
   subq #1,d1
   clr d6
   bra.s .lb5
.lb6: cmp.b (a2)+,(a3)+
.lb5: dbne d1,.lb6
   beq.s .lb7
.lb3: dbf d2,.lb2
.lb4: addq #1,d3
   bra.s .loop
.lb7: moveq #82,d4
   move.b (a4),d1
   ext.w d1
   sub d1,d4
   sub.l a4,a1
   sub a1,d4
   move d3,d5
   rts
.fin: moveq #79,d4
	bsr.s bell
	rts
	
bell:
   move #7,-(sp)
   move #2,-(sp)
   BIOS 3,6
   rts

_dialogue:
	move.l #edit_haut,fenetre
	GOSUB cls
	clr vef_int
	GEM_VDI vst_eff				; effet normal pour la ligne du haut
	move.l a5,a0
	jsr write_str
   move.l #mot,a5
   clr.l (a5)
   lea 2(a5),a0
   move d5,-(sp)
   move.l #user_keys,end_keys
   jsr edition
   move.l #edit_list,end_keys
   move (sp)+,d5
   lea 2(a5),a0
.lb0:
   tst.b (a0)+
   bne.s .lb0
   sub.l a5,a0
   subq #3,a0
   move a0,(a5)
   move.l #edit_bas,fenetre
   rts

bloc: ; bsr propre    ; renvoit  a0 : debut de bloc
   move debutb,d0   ;          a1 : fin
   bpl.s .lb0       ;          d0 : 0 si le curseur dans le bloc
.lb: bsr bell
	moveq #0,d0	     ;         CCR : nul si bloc non valide
   rts              ;          d1 : taille
.lb0: cmp topedit,d0 ;         d3 : nbr de lignes
   bpl.s .lb
   move finb,d1
   bmi.s .lb1
   add d0,d1
   cmp topedit,d1
   bgt.s .lb
   bra.s .lb2
.lb1: move topedit,d1
.lb2: cmp topedit,d1
   bne.s .lb22
   subq #1,d1
.lb22:   move.l beuf(pc),a0
   move d0,d2
   bra.s .lb4
.lb3: add.w (a0),a0
.lb4: dbf d2,.lb3
   move d1,d2
   sub d0,d2
   move d2,d3
   addq #1,d3
   move.l a0,a1
.lb5: add.w (a1),a1
   dbf d2,.lb5
   cmp d5,d0
   bpl.s .lb6
   cmp.l d1,d5
   bpl.s .lb6
   moveq #0,d0
   bra.s .lb7
.lb6: moveq #1,d0
.lb7: move.l a1,d1
   sub.l a0,d1
   rts

effbloc: cmp.l a0,a5
   bmi.s .lb
   cmp.l a5,a1
   bpl.s .lba
   sub d3,d5
   bra.s .lb
.lba: move debutb,d5
.lb: sub d3,topedit
   move.l bfptr,d0
   sub.l a1,d0
   addq.l #2,d0
   lsr.l #1,d0
   move d0,d1
   and #7,d1
   lsr.l #3,d0
   bra.s .lb1
.lb0: move.l (a1)+,(a0)+
   move.l (a1)+,(a0)+
   move.l (a1)+,(a0)+
   move.l (a1)+,(a0)+
.lb1: dbf d0,.lb0
   bra.s .lb3
.lb2: move.w (a1)+,(a0)+
.lb3: dbf d1,.lb2
	ext.l d1
   move.l d1,debutb
   subq.l #2,a0
   move.l a0,bfptr
   rts

mvbloc: cmp.l a0,a5
   beq.s .fin
   bpl.s .lb
   exg.l a0,a5
   exg.l a5,a1
   bra.s .lb0
.lb: sub d3,d5
.lb0: move d5,debutb
   move.l a5,d0
   sub.l a0,d0
   move.l a5,d1
   sub.l a1,d1
   beq.s .fin
   move.l d0,d7
   lsr.l #1,d7
   bra.s .lb3
.lb1: add.l d1,a1
   cmp.l a5,a1
   bmi.s .lb2
   sub.l d0,a1
.lb2: move (a1),d3
   move d2,(a1)
   move d3,d2
   cmp.l a1,a0
   bne.s .lb4
   addq.l #2,a1
   cmp.l a5,a1
   bmi.s .lb3
   sub.l d0,a1
.lb3: move (a1),d2
   move.l a1,a0
.lb4: subq.l #1,d7
   bpl.s .lb1
.fin: rts

cpbloc: move.l bfptr,a2
   addq.l #2,a2
   move.l a2,a3
   add.l d1,a3
   add.l d1,bfptr
   add d3,topedit
   move.l a2,d0
   sub.l a5,d0
   lsr.l #1,d0
   move d0,d2
   and #$7,d2
   lsr.l #3,d0
   bra.s .lb1
.lb0: move.l -(a2),-(a3)
   move.l -(a2),-(a3)
   move.l -(a2),-(a3)
   move.l -(a2),-(a3)
.lb1: dbf d0,.lb0
   bra.s .lb3
.lb2: move -(a2),-(a3)
.lb3: dbf d2,.lb2
   cmp.l a5,a0
   bmi.s .lb4
   add.l d1,a0
   add d3,debutb
.lb4: lsr.l #1,d1
   move.l d1,d0
   and #$7,d0
   lsr.l #3,d1
   bra.s .lb6
.lb5: move.l (a0)+,(a5)+
   move.l (a0)+,(a5)+
   move.l (a0)+,(a5)+
   move.l (a0)+,(a5)+
.lb6: dbf d1,.lb5
   bra.s .lb8
.lb7: move (a0)+,(a5)+
.lb8: dbf d0,.lb7
   rts

; d5 num‚ro de ligne
; calcule aussi la taille restante en Ko
; utilise a0,a1,a2 et d0,d1,d2,d3
; restaure la structure fenetre

lgnaff:
	clr vef_int
	GEM_VDI vst_eff	; style normal
   lea eedd,a0
   lea 13(a0),a1
   move d5,d0
   moveq #4,d1
.lb0:
   ext.l d0
   divs #10,d0
   swap d0
   add.b #"0",d0
   move.b d0,-(a1)
   swap d0
   dbf d1,.lb0
   move.l bfsize,d0
   add.l beuf(pc),d0
   sub.l bfptr,d0
   divs #1024,d0
   cmp ksize,d0
   beq.s .fin
   move d0,ksize
   lea 26(a0),a1
   moveq #2,d1
.lb1:
   ext.l d0
	divs #10,d0
	swap d0
	add.b #"0",d0
	move.b d0,-(a1)
	swap d0
	dbf d1,.lb1
.fin:
   lea edit_haut,a1
   clr.l 8(a1)
   move.l fenetre,-(sp)
   move.l a1,fenetre
   move.l d4,-(sp)
   jsr write_str
   move.l (sp)+,d4
   move.l (sp)+,fenetre
   rts

help_display_prompt:
	movem.l d4-d7/a3/a6,-(sp)
	lea help_prompt,a6
	GOSUB cr
	move.l fenetre,a0
	moveq #0,d6
	move 4(a0),d6			; largeur fenetre
	divs 12(a0),d6			; /largeur caractŠre nombre de colonnes
	move d6,colonnes
	bra.s _help_comm
help_display:
	movem.l d4-d7/a3/a6,-(sp)
	GOSUB cls
	lea help_txt,a6
_help_comm:
.loop:
	move.l a6,a0			; one line
.lb0:
	tst.b (a6)+
	bne.s .lb0				; a6 sur la fin de chaine
	move colonnes(pc),d6
	lea 0(a0,d6.w),a3
	move.b (a3),d7			; sauvegarde un octet
	clr.b (a3)				; fin physique au cas o—
	jsr write_str
	move.b d7,(a3)			; remet l'octet
	tst.b (a6)				; fin des chaines?
	beq.s .exit
	GOSUB cr
	bra.s .loop
.exit:
	movem.l (sp)+,d4-d7/a3/a6
	rts

	; a1 = chaine … ‚tendre
	; a0 = zone o— ‚tendre
	; entr‚e si (a0) = 0 chaine normale
	; si (a0)=FF chaine avec taille devant

expand_path:
	movem.l d1/a0/a2-a4,-(sp)
	move.l a1,a3
	move.l a0,a1
	move.l a0,a4
	move.b (a0),d1
	beq.s .lb0			; chaine normale
	addq.l #1,a1		; saute l'octet taille
.lb0:
	move.b (a3)+,d0	; un caractŠre source
	cmp.b #'%',d0
	bne.s .lb1			; ce n'est pas un %
	cmp.b #'%',(a3)
	bne.s .lb2
	move.b d0,(a1)+	; un double %% = %
	addq.l #1,a3
	bra.s .lb0
.lb2:
	lea chemin,a0
	if STE=1
		jsr _copy_path
	else
		bsr.l _copy_path
	endif
	move.l a2,a1		; reprendre au dernier "\"
	bra.s .lb0
.lb1:
	move.b d0,(a1)+
	bne.s .lb0			; pas z‚ro final, on continue
	tst.b d1
	beq.s .exit
	move.l a1,d1
	sub.l a4,d1			; taille + z‚ro final + octet taille
	subq.l #2,d1
	move.b d1,(a4)		; stocke la taille
.exit:
	movem.l (sp)+,d1/a0/a2-a4
	rts

update_slider:
	movem.l d3-d5/d7/a3,-(sp)
	moveq #0,d3
	tst d6					; <0 si appel‚ en fin d'‚dition
	bmi .modif
	move topedit,d0
	move d6,d7
	add lignes,d7			; nø de ligne de fin
	cmp d0,d7
	bmi.s .lb0
	move d0,d7				; limite … topedit
.lb0:
	move debutb,d4
	bmi.s .rien				; pas de bloc!
	cmp d7,d4
	bgt.s .rien				; bloc au dela de la fenˆtre
	move d4,d5
	cmp d6,d4
	bpl.s .lb1
	move d6,d4				; le bloc commence avant la fenˆtre, on remonte
.lb1:
	move finb,d1
	bpl.s .lb2
	move d0,d5				; si finb<0 aller jusqu'… la fin topedit
	bra.s .lb3
.lb2:
	add d1,d5				; sinon, derniŠre ligne du bloc
.lb3:
	cmp d6,d5
	bmi.s .rien				; tout le bloc est avant la fenˆtre
	cmp d7,d5
	bmi.s .compare
	move d7,d5				; si le bloc d‚borde du bas de la fenˆtre, on limite
	bra.s .compare	
.rien:
	moveq #0,d4
	moveq #-1,d5
.compare:	
	sub d4,d5
	addq #1,d5					; nombre de lignes
	sub d6,d4					; ramŠne le num‚ro de ligne en relatif/d‚but page
	lea slider,a0
	cmp 2(a0),d5			; d‚j… la mˆme taille?
	seq d3					; conserve...
	bne.s .recalc
	cmp (a0),d4				; d‚j… la mˆme valeur de d‚part?
	beq.s .sortie				
.recalc:
	move d4,(a0)+				; nouvelles valeurs
	move d5,(a0)
	bne.s .normal				; si d5<>0, un vrai slider
	moveq #1,d4					; sinon pas de bloc apparent, slider en haut
	moveq #1,d5
	bra.s .modif
.normal:
	lea fenetre0,a1
	move 14(a1),d0				; h d'un caractŠre
	move 6(a1),d1				; H fenˆtre
	addq #1,d4
	muls d0,d4					; h*(x+1) (ligne de d‚part)
	addq.l #2,d4				; pour la ligne de s‚paration
	muls d0,d5					; h*n (taille du slider)
	move d1,d0
	sub d5,d0					; taille restante H-h*n
	muls #1000,d5
	divs d1,d5					; taille slider h*n*1000/H
	muls #1000,d4
	divs d0,d4					; position slider (h*(x+1)+2)*1000/(H-h*n)
.modif:
	lea ws_int+2,a3
	tst.b d3
	bne.s .same_size
	move #16,(a3)				; set size
	move d5,2(a3)
	GEM_AES wind_set
.same_size:
	move #9,(a3)+
	move d4,(a3)				; set pos
	GEM_AES wind_set
.sortie:
	movem.l (sp)+,d3-d5/d7/a3
	rts
	
   COPIE lmax,y302
lmax: move.l #topedit,-(a6)
y302: rts

   COPIE bsize,y303
bsize: move.l #finb,-(a6)
y303:  rts

   COPIE   bfinit,y304
bfinit: clr topedit
	moveq.l #-1,d0
   move.l d0,debutb
   move.l beuf,a0
   move.l a0,bfptr
   clr (a0)
   sf change_flag			; remise … z‚ro du flag changement
y304: rts

init_ptr:
	moveq #0,d7
	move.l d7,inc_ptr			; reset la chaine des fichiers inclus
	move.l d7,opt_count		; remet … z‚ro le compte des optimisations (en global-4)
	rts

   SAUT
compilb: 
	bsr.s init_ptr
   bra.s ccmmpp

   SAUT
eval: moveq #-1,d7
ccmmpp: move.l #1624,-(sp)	; reserve un nouveau bloc
   GEMDOS 72,6
   move.l d0,a1
   move.l a5,(a1)+			; sauve les pointeurs
   move.l a4,(a1)+
   move.l a4,retptr
   move.l #debutb,a0
   move (a0)+,d3				; debut bloc
   move d3,(a1)+				; les infos de bloc
   move (a0)+,d4				; fin de bloc
   move d4,(a1)+
   move (a0),(a1)+
   move.l #cmplptr,a0
   move.l (a0)+,(a1)+
   move (a0),(a1)+
   move.l #exebuf,a0			; et sauvegarde le buffer d'ex‚cution qui va ˆtre utilis‚
   moveq #99,d1
.loop0: move.l (a0)+,(a1)+
   move.l (a0)+,(a1)+
   move.l (a0)+,(a1)+
   move.l (a0)+,(a1)+
   dbf d1,.loop0
   move.l (a0),(a1)
   move.l d0,(a0)				; adresse du buffer sauv‚e
   move.l a6,pilptr
   clr fincomp
   tst d7
   beq.s .cmp
   move finb,ligne
   move.l (a6),a0
   addq.l #4,pilptr
   bra.s .boucle
.cmp: move topedit,d5
   beq .fin
   tst d3
   bpl.s .lb0
   clr d3
.lb0: cmp d5,d3
   bpl .fin
   move d3,debutb
   tst d4
   bpl.s .lb1
   move d5,d4
   sub d3,d4
   subq #1,d4
.lb1: move d4,finb
   clr ligne
   move.l beuf(pc),a0
   bra.s .lb3
.lb2: add.w (a0),a0
.lb3: dbf d3,.lb2
   addq.l #3,a0
.boucle: jsr compil
   tst erreur
   bne.s .bug2
   cmp.l pilptr,a6
   bne.s .bug1
   tst trc
   bne.s .lb4
   jsr execut
   bra.s .lb5
.lb4: jsr exetrc
.lb5: tst fincomp
   bne.s .fin
   move.l cmplptr,a0
   bra.s .boucle
.bug1: lea bugpil,a0
   jsr write_str
   move #1,erreur
.bug2: move debutb,d3
   add ligne,d3
   move d3,editb
.fin: clr fincomp
   move.l #exebuf,a1
   move.l 1600(a1),a0
   move.l a0,-(sp)
   move.l (a0)+,a5
   move.l (a0)+,a4
   move.l #debutb,a2
   move.l (a0)+,(a2)+
   move (a0)+,(a2)
   move.l #cmplptr,a2
   move.l (a0)+,(a2)+
   move (a0)+,(a2)
   moveq #99,d0
.loop1: move.l (a0)+,(a1)+
   move.l (a0)+,(a1)+
   move.l (a0)+,(a1)+
   move.l (a0)+,(a1)+
   dbf d0,.loop1
   move.l (a0),(a1)
   move.l pilptr,a6
   GEMDOS 73,6
.vider_inclusions:
	tst.l inc_ptr
	beq.s .exit				; chaine vide
	bsr.s depile_inc
	bra.s .vider_inclusions
.exit:
   rts

depile_inc:
	move.l inc_ptr,d0
	beq.s .fin
	move.l d0,a0
	pea (a0)				; pour mfree
	move.l (a0)+,inc_ptr	; nouveau pointeur
	move (a0),-(sp)		; handle
	move (a0),d0
	GEMDOS 62,4				; fclose
	GEMDOS 73,6				; mfree
.fin:
	rts


   SAUT
format: moveq #1,d3               ; interleave par d‚faut
   move.l (a6)+,d7                ; sect par piste 9 ou 10
   bpl.s .lb
   moveq #9,d7                    ; sinon 9 secteurs
   moveq #11,d3                   ; et 11 en interleave
.lb: move.l (a6)+,d6              ; pistes par face 80, 81 ou 82
   move.l (a6)+,d5                ; faces 1 ou 2
   move.l (a6),d4                 ; unit‚ 0:A, 1:B
   move.b d4,d0
   add.b #'A',d0
   move.b d0,avertd
   ACONTROL 52,1,1,1
   move #2,intin
   move.l #avert,addrin
   AES
   move intout,d0
   cmp #2,d0
   bne.s .lb0
   rts
.lb0: move.l #11576,-(sp)             ; reserve 11*80*2*512+512
   GEMDOS 72,6                        ; place d'une piste 2 faces 11 sect
   move.l d0,formbuf                  ; plus le boot 512 octets
   bpl.s .lb1
   bra.s .fin
.bug: move.l formbuf,-(sp)
   GEMDOS 73,6                        ; libŠre la place
.fin: move.l d0,(a6)
   rts
.lb1: clr -(sp)                       ; non ex‚cutable
   move.w #3,-(sp)                    ; type 80/9/2faces
   move.l #$0603,-(sp)                ; nøserie (3.60 cod‚)
   add.l #11064,d0                    ; a la fin du buffer
   move.l d0,-(sp)
   XBIOS 18,14                        ; cr‚e un Boot secteur
   tst.l d0
   bmi.s .bug
   move.l formbuf,a3
   move.b d5,26+11064(a3)             ; ajuste le boot : faces
   move.b d7,24+11064(a3)             ; sect par piste
   move.l d7,d0
   muls d6,d0
   muls d5,d0                         ; d0=sect*pist*faces
   move.b d0,19+11064(a3)             ; total des secteurs
   lsr.w #8,d0
   move.b d0,20+11064(a3)             ; cod‚ a l'envers...
   bra.s .lb3
.lb2: move.w #$e5e5,-(sp)                 ; remplissage
   move.l #$87654321,-(sp)                ; magic
   move d3,-(sp)                          ; interleave
   clr -(sp)                              ; face 0
   move.w d6,-(sp)                        ; nøpiste
   move.w d7,-(sp)                        ; sect/piste
   move.w d4,-(sp)                        ; unit‚
   clr.l -(sp)
   move.l a3,-(sp)                        ; buffer
   XBIOS 10,26                            ; formate
   tst.l d0
   bmi.s .bug
   cmp #2,d5
   bne.s .lb3                             ; si une face on saute
   move.w #$e5e5,-(sp)
   move.l #$87654321,-(sp)
   move #1,-(sp)
   move #1,-(sp)                          ; meme chose face 1
   move.w d6,-(sp)
   move.w d7,-(sp)
   move.w d4,-(sp)
   clr.l -(sp)
   move.l a3,-(sp)
   XBIOS 10,26
   tst.l d0
   bmi .bug
.lb3: dbf d6,.lb2                         ; on boucle sur le nombre de pistes
   move.l a3,a0
   moveq #0,d0                            ; on vide 11064 octets
   move #460,d1
.lb4: move.l d0,(a0)+                     ; 461 * 24 = 11064
   move.l d0,(a0)+
   move.l d0,(a0)+
   move.l d0,(a0)+
   move.l d0,(a0)+
   move.l d0,(a0)+
   dbf d1,.lb4
   move d7,-(sp)                          ; nbr de sect
   clr.l -(sp)                            ; face 0 piste 0
   move #1,-(sp)                          ; … partir du secteur 1
   move d4,-(sp)                          ; unit‚
   clr.l -(sp)
   move.l a3,-(sp)                        ; buffer vide
   XBIOS 9,20                             ; ‚crit 0 sur la FAT et DIR
   tst.l d0
   bmi .bug
   cmp #2,d5                              ; si il y a 2 faces meme chose
   bne.s .lb5
   move d7,-(sp)
   move #1,-(sp)                          ; face 1
   clr -(sp)
   move #1,-(sp)
   move d4,-(sp)
   clr.l -(sp)
   move.l a3,-(sp)
   XBIOS 9,20
   tst.l d0
   bmi .bug
.lb5: add.w #11064,a3                     ; adresse du BOOT en m‚moire
   move #1,-(sp)                          ; 1 secteur
   clr.l -(sp)                            ; piste 0 face 0
   move #1,-(sp)                          ; secteur 1
   move d4,-(sp)                          ; unit‚
   clr.l -(sp)
   move.l a3,-(sp)                        ; adresse BOOT
   XBIOS 9,20                             ; qu'on ‚crit
   bra .bug

   SAUT
word: lea ordres,a0
   move.l #pad+2,a1
   move.l (a6),d0
   move.l a1,(a6)
   tst d0
   bmi.s .lb4
   cmp forth,d0
   bpl.s .lb4
   moveq #0,d1
   bra.s .lb0
.lb1: move.b (a0)+,d1
   add.w d1,a0
.lb0: dbf d0,.lb1
   move.b (a0)+,d1
   bra.s .lb2
.lb3: move.b (a0)+,(a1)+
.lb2: dbf d1,.lb3
.lb4: clr.b (a1)
   rts

	; certaines instructions peuvent ˆtre optimis‚es si une constante les pr‚cŠde
	; (code $4002) par exemple  26 and
	; au lieu move.l #26,-(a6) // move.l (a6)+,d1 // and.l d1,(a6)
	; on fera andi.l #26,(a6)
	; (code $5002) pour + et - si l'argument est de+/-1 … 8 on utilisera en plus:
	; addq/subq.l #n,(a6)
	; (code $6002) pour =,<,>,<> remplace le passage par la pile par D1 directement
	; et utilisation de moveq si -128/+12

optimise:
	cmp #$4002,d2			; simple remplacement?
	bne.s .lb0
.normal:
   move -6(a4),-6(a2)	; remplace move.l par le code de l'instruction optimis‚e
.optimisation:
	addq #1,opt_count
   rts
.lb0:
	cmp #$5002,d2			; add/sub ?
	bne.s .lb1
	move.l -4(a2),d2		; la constante
	bsr.s .un_huit			; renvoit EQ si de -1/-8 ou de 1/8
	bne.s .normal			; utlise addi et subi
	cmp #32,d4				; instruction "-"?
	bne.s .lb2
	neg.l d2					; donc ajouter l'oppos‚
.lb2:
	tst.l d2
	bmi.s .sous
	ror.w #7,d2
	or #$5096,d2			; addq
.ascomm:
	subq.l #6,a2
	move d2,(a2)+
	bra.s .optimisation
.sous:
	neg.l d2
	ror.w #7,d2
	or #$5196,d2			; subq
	bra.s .ascomm
.lb1:
	cmp #$6002,d2			; <,>,=,<> ?
	bne.s .lb3
	bsr.s optimise_move
   move -4(a4),d2      ; taille … copier en mots -1
   addq.l #2,a4			; saute le premier mot
   bra.s .cc2				; et donc en copie encore un de moins
.cc1: move (a4)+,(a2)+
.cc2:
   dbf d2,.cc1
	bra.s .optimisation
.lb3:
	rts
.un_huit:
	beq.s .non				; z‚ro est refus‚
	cmp.l #-8,d2
	bmi.s .non				; en dessous de -8?
	cmp.l #9,d2				; au dessus de 8?
	bpl.s .non
	cmp d2,d2				; renvoie EQ si ok
	rts
.non:
	moveq #-1,d2			; renvoie NE si refus‚
	rts

	; optimise array, array$, table, warray

optimise_array:
	tst.b ass_const
	bne.s .opt
	move (a5)+,(a2)+		; pas d'optimisation, instruction move normale
	rts
.opt:
	addq.l #2,a5			; saute le move
	sf ass_const			; et annule le flag
	addq #1,opt_count
	bra.s optimise_move

	; optimise les of,<of,>of,<>of si il y a une constante

optimise_of:
	tst.b ass_const
	bne.s .opt
	move (a4)+,(a2)+		; pas d'optimisation, instruction move normale
	rts
.opt:
	addq #1,opt_count
	addq.l #2,a4			; saute le move
	; continue sur optimise move

	; remplace un move.l #nnn,-(a6)
	; par move.l #nnn,d1
	; ou bien par moveq.l #nnn,d1	si -128/+127

optimise_move:
	move.l -4(a2),d2		; valeur
	bpl.s .cc3
	neg.l d2
	cmp.l #128,d2			; cas particulier
	beq.s .cc2
.cc3:
	and.l #$FFFFFF80,d2
	bne.s .cc4				; c'est en dehors de -128/+127
.cc2:
	subq.l #6,a2
	move.b #$72,(a2)+
	move.b 4(a2),(a2)+	; fabrique moveq.l #nn,d1
	bra.s .cc5
.cc4:
	move #$223c,-6(a2)	; remplace move.l #xxx,-(a6) en move.l #xxx,d1
.cc5:
	rts

	; tente d'‚viter ces cas, par exemple:
	; routine qui finit par move.l d1,-(a6)
	; suivie d'une qui commence par move.l (a6)+,d1
optimise_chaine:
	cmp #$221e,(a4)		; est-ce (a6)+,d1 … la suivante?
	bne.s .lb0
	cmp #$2c81,-2(a2)		; d1,(a6) … la derniŠre
	bne.s .lb2
	move #$588e,-2(a2)	; remplace par drop
	bra.s .comm
.lb2:
	cmp #$2c80,-2(a2)		; d0,(a6) … la derniŠre
	bne.s .lb3
	move #$588e,-2(a2)	; remplace par drop
	move #$2200,(a2)+		; ajoute d0,d1
	bra.s .comm
.lb3:
	cmp #$2d00,-2(a2)		; d0,-(a6) … la derniŠre?
	bne.s .lb1
	move #$2200,-2(a2)	; remplace par d0,d1
	bra.s .comm
.lb1:
	cmp #$2d01,-2(a2)		; d1,-(a6) … la derniŠre instruction?
	bne.s .no_opt
	subq.l #2,a2			; vire move.l d1,-(a6)
.comm:
	addq.l #2,a4			; vire move.l (a6)+,d1 ou (a6)+,a2
	subq #1,d2				; un mot de moins … copier
	addq #1,opt_count+2	; statistiques!
	rts
.lb0:
	cmp #$245e,(a4)		; (a6)+,a2 sur la suivante?
	bne.s .no_opt
	cmp #$2d01,-2(a2)		; et d1,-(a6)?
	bne.s .no_opt
	move #$2441,-2(a2)	; remplace par move.l d1,a2
	bra.s .comm
.no_opt:
	rts

assemblons:
	if STE=0
	   move.l (adresse,pc,d4.w*4),a4     ;  adresse du mot
	else
		lea adresse,a4
		add d4,a4
		add d4,a4
		add d4,a4
		move.l 0(a4,d4.w),a4
	endif
   tst d4
   bne.s .lb00
   move .emp(pc),(a2)+     ; constante entiŠre
   move.l d5,(a2)+
   st ass_const				; flag pour constante empil‚e
   rts
.lb00: cmp #637,d4       ; constante r‚elle
   bne.s .lb0
   move #$2d3c,(a2)+
   move.l d1,(a2)+
   move #$2d3c,(a2)+
   move.l d0,(a2)+
.sortie:
   sf ass_const
	rts
.lb0: cmp #diko,d4
   bpl .us             ; si c'est un mot "user"
   move -2(a4),d2      ; code juste avant la routine
   cmp.b #2,d2           ; recopie du code
   bne.s .lb2
   cmp #2,d2				; sans optimisation? (code 0002)
   beq.s .no_opt			; c'est ‡a, copier normalement
   tst.b ass_const		; d‚j… une constante
   beq.s .no_opt			; ben non, copier normalement
	bsr optimise			; va optimiser !
   bra.s .sortie
.no_opt:
   move -4(a4),d2      ; taille … copier en mots -1
   bsr optimise_chaine	; tente d'optimiser l'enchainement (pour ‚viter la pile)
.lb1: move (a4)+,(a2)+
   dbf d2,.lb1
   bra.s .sortie
.lb2:
	tst d2
   beq .bug1           ; non assemblable
   bmi .fin            ; -1 pour ";"
	cmp.b #3,d2        ; cr‚ation de "jsr adresse"
   bne.s .lb3
.saut: move .type3(pc),(a2)+
   move.l a4,(a2)+
   bra .sortie
.lb3: cmp.b #12,d2       ; exit
   bne.s .lb4
   move #$4e75,(a2)+
   bra .sortie
.lb4: cmp.b #17,d2       ; vdi ou aes
   bne.s .lb5
   addq.l #2,a4          ; passe l'opcode de sub
   sub (a4)+,d4          ; soustrait le d‚calage
   move .type17(pc),(a2)+
   move d4,(a2)+
   bra.s .saut
.lb5: 
	cmp.b #36,d2		; and->
	bne.s .lb5a
	move.l #$221e6700,(a2)+		; move.l (a6)+,d1 / beq XXXX
.lb5b:
	move.l a2,-(a6)
	addq.l #2,a2
	bra .sortie
.lb5a:
	cmp.b #37,d2		; or->
	bne.s .lb5c
	move.l #$221e6600,(a2)+		; move.l (a6)+,d1 / bne XXXX
	bra.s .lb5b
.lb5c:
	cmp.b #38,d2		; ->.
	bne.s .lb5z
	move #$221e,(a2)+			; move.l (a6)+,d1
.lb5d:
	tst.l (a6)			; fin de liste
	beq.s .lb5e
	bsr.s .lb6			; r‚sout toutes les adresses
	bra.s .lb5d
.lb5e:
	addq.l #4,a6
	move.l #$670272FF,(a2)+	; beq.s+1 / moveq #-1,d1 
	move #$2d01,(a2)+			; move.l d1,-(a6)
	bra .sortie
.lb5z:
	cmp.b #6,d2        ; do
   bne.s .lb7
   lea .type6(pc),a4
	move.l (a4)+,(a2)+
	move.l (a4)+,(a2)+
	move.l a2,-(a6)
	move.w (a4)+,(a2)+
	move.l (a4)+,(a2)+
	move.l (a4)+,(a2)+
	move.l (a4)+,(a2)+
	move.l (a4)+,(a2)+
   move.l a2,-(a6)
   bra .sortie
.lb6:
	move.l (a6)+,a5
	move.l a2,d2
	sub.l a5,d2
	move.w d2,(a5)
	rts
.lb7: cmp.b #4,d2        ; loop
   bne.s .lb9
   lea .type4(pc),a4
   move.l (a4)+,(a2)+
   move.l (a4)+,(a2)+
   move (a4)+,(a2)+
   move.l (a6)+,d2
   sub.l a2,d2
   move d2,(a2)+
   addq.l #2,a4
   move.l (a4)+,(a2)+
   move.l (a4),(a2)+
   bsr.s .lb6
   bra .sortie
.lb9: cmp.b #13,d2      ; if
   beq.s .lb9b
   cmp.b #10,d2         ; while
   bne.s .lb10
.lb9b: lea.l .type13(pc),a4
   move.l (a4)+,(a2)+
   move (a4)+,(a2)+
   move.l a2,-(a6)
   addq.l #4,a2
   bra .sortie
.lb10: cmp.b #14,d2     ; else ou endof
   bne.s .lb11
   move .type14(pc),(a2)+
   move.l (a6),a4
   move.l a2,(a6)
   addq.l #4,a2
   move.l a2,(a4)
   bra .sortie
.lb11: cmp.b #15,d2     ; then
   bne.s .lb12
   move.l (a6)+,a4
   move.l a2,(a4)
   bra .sortie
.lb12: cmp.b #5,d2      ; +loop
   bne.s .lb14
   lea .type5(pc),a4
   move.l (a4)+,(a2)+
   move.l (a4)+,(a2)+
   move.l (a4)+,(a2)+
   move (a4)+,(a2)+
   move.l (a6),d2
   sub.l a2,d2
   move d2,(a2)+
   addq.l #2,a4
   move.l (a4)+,(a2)+
   move.l (a4)+,(a2)+
   move.l (a4)+,(a2)+
   move.l (a4)+,(a2)+
   move.l (a4)+,(a2)+
   move.l (a6)+,d2
   sub.l a2,d2
   move d2,(a2)+
   move 2(a4),(a2)+
   bsr .lb6
   bra .sortie
.lb14: cmp.b #16,d2     ; ifloop
   bne.s .lb16
   lea .type16(pc),a4
   move.l (a4)+,(a2)+
   move.l (a4)+,(a2)+
   move.l (a4)+,(a2)+
   move (a4)+,(a2)+
   move.l (a6)+,d2
   sub.l a2,d2
   move d2,(a2)+
   addq.l #2,a4
   move.l (a4)+,(a2)+
   move.l (a4)+,(a2)+
   move.l (a4)+,(a2)+
   bsr .lb6
   move.w (a4),(a2)+
   bra .sortie
.lb16: cmp.b #7,d2      ; begin
   bne.s .lb17
   move.l a2,-(a6)
   bra .sortie
.lb17: cmp.b #8,d2      ; again
   bne.s .lb18
   move .type14(pc),(a2)+
   move.l (a6)+,(a2)+
   bra .sortie
.lb18: cmp.b #9,d2      ; until
   bne.s .lb19
   lea .type13(pc),a4
   move.l (a4)+,(a2)+
   move (a4),(a2)+
   move.l (a6)+,(a2)+
   bra .sortie
.lb19: cmp.b #11,d2     ; repeat
   bne.s .lb20
   move .type14(pc),(a2)+
   move.l (a6)+,a4
   move.l (a6)+,(a2)+
   move.l a2,(a4)
   bra .sortie
.lb20: cmp.b #18,d2      ; quit
   bne.s .lb21
   lea .type18(pc),a4
   move.l (a4)+,(a2)+
   move.l (a4)+,(a2)+
   move.l (a4)+,(a2)+
   bra .sortie
.lb21: cmp.b #1,d2       ; un gemdos
   bne.s .lb23
   lea gblk-1476(pc),a4
   move #$4e41,d2
.lb22:
	if STE=0
		lea 0(a4,d4.w*4),a4
	else
		add d4,a4
		add d4,a4
		add d4,a4
		add d4,a4
	endif
   lea .tos(pc),a5
   move.l (a5)+,(a2)+
   move (a5)+,(a2)+
   move.b (a4)+,d0
   move.b (a4)+,d1
   bmi.s .tos1
   ext.w d1
.tos0: btst d1,d0
   bne.s .tos2
   move.l 2(a5),(a2)+
   bra.s .tos3
.tos2: move (a5),(a2)+
.tos3: dbf d1,.tos0
.tos1: addq.l #6,a5
   move (a5)+,(a2)+
   move.b (a4)+,d0
   ext.w d0
   move d0,(a2)+
   move d2,(a2)+
   addq.l #2,a5
   move (a5)+,(a2)+
   move.l (a5)+,(a2)+
   tst.b (a4)
   beq.s .tos4
   move (a5),(a2)+
.tos4: bra .sortie
.lb23: cmp.b #21,d2      ; un bios
   bne.s .lb24
   lea bblk-1588(pc),a4
   move #$4e4d,d2
   bra.s .lb22
.lb24: cmp.b #22,d2      ; un xbios
   bne.s .lb25
   lea xblk-1632(pc),a4
   move #$4e4e,d2
   bra.s .lb22
.lb25: cmp.b #19,d2      ; ."
   bne.s .lb26
   move #$6100,(a2)+		; bsr.b xx
   bsr .ch
   move.b d2,-(a5)		; complŠte l'offset du bsr
   lea .type19(pc),a5
   move.l (a5)+,(a2)+
   move.l (a5)+,(a2)+
   bra .sortie
.lb26: cmp.b #20,d2      ; "
   bne.s .lb27
	move.l #$61000000,(a2)+	; bsr.s xx et LEN
   bsr .ch
   move d2,-(a5)			; complete LEN
   addq #2,d2				; deux en plus
   move.b d2,-(a5)		; complŠte le bsr
   move.l .type20(pc),(a2)+	; addq.l #2,(sp), move.l (sp)+,-(a6)
	bra .sortie
.lb27: cmp.b #23,d2      ; case ou ->
   bne.s .lb28
   clr.l -(a6)
   bra .sortie
.lb28: cmp.b #25,d2      ; of
   bne.s .lb281
   lea .type25(pc),a4
.lb280:
	bsr optimise_of
	move.w (a4)+,(a2)+
   move.l (a4)+,(a2)+
   move.l a2,-(a6)
   move.l (a4)+,(a2)+
   move (a4)+,(a2)+
   bra .sortie
.lb281: cmp.b #33,d2      ; <>of
   bne.s .lb282
   lea .type33(pc),a4
   bra.s .lb280
.lb282: cmp.b #34,d2      ; >of
   bne.s .lb283
   lea .type34(pc),a4
   bra.s .lb280
.lb283: cmp.b #35,d2      ; <of
   bne.s .lb29
   lea .type35(pc),a4
   bra.s .lb280
.lb29: cmp.b #24,d2      ; endcase
   bne.s .lb31
.lb30: move.l (a6)+,d2
   beq .sortie
   move.l d2,a4
   move.l a2,(a4)
   bra.s .lb30
.lb31: cmp.b #26,d2      ; ndo
   bne.s .lb32
   lea .type26(pc),a4
   move.l (a4)+,(a2)+
   move.l a2,-(a6)		; adresse du saut si boucle vide
   move (a4)+,(a2)+
   move.l (a4)+,(a2)+
   move.l (a4),(a2)+
   move.l a2,-(a6)		; adresse retour de boucle
   bra .sortie
.lb32: cmp.b #27,d2      ; nloop
   bne.s .lb33
   lea .type27(pc),a4
   move.l (a4),(a2)+
   move.l (a6)+,d2
   sub.l a2,d2
   move d2,(a2)+
   addq.l #6,a4
   move.l (a4)+,(a2)+
   move (a4)+,(a2)+
   subq #8,d2
   move d2,(a2)+
   move 2(a4),(a2)+
	bsr .lb6
   bra .sortie
.lb33: cmp.b #28,d2      ; fast ou slow
   beq .sortie
   cmp.b #29,d2      ; exe+
   bne.s .lb34
   move #$0696,(a2)+  ; addi.l #....,(a6)
   clr (a2)+
   move courant,(a2)+
   bra.s .exec
.lb34: cmp.b #30,d2      ; exec
   bne.s .lb35
.exec: lea .type30(pc),a4
   moveq #6,d2
.exe0: move.l (a4)+,(a2)+
   dbf d2,.exe0
   move (a4),(a2)+
   bra .sortie
.lb35: cmp.b #32,d2      ; dolist
   bne.s .lb36
   lea .type32(pc),a4
   move.l (a4)+,(a2)+
   move.l (a4)+,(a2)+
   move.l (a4)+,(a2)+
   move.l (a4)+,(a2)+
   move.l a2,-(a6)
   move (a4)+,(a2)+
   move.l (a4)+,(a2)+
   move.l (a4)+,(a2)+
   move.l (a4)+,(a2)+
   move.l (a4)+,(a2)+
   move.l (a4)+,(a2)+
   move.l a2,-(a6)
   bra .sortie
.lb36: cmp.b #31,d2      ; lloop
   bne .bug
   lea .type31(pc),a4
   move.l (a4)+,(a2)+
   move.l (a4)+,(a2)+
   move.l (a4)+,(a2)+
   move.l (a4)+,(a2)+	; x
   move.w (a4)+,(a2)+	; x
   move.l (a6)+,d2
   sub.l a2,d2
   move d2,(a2)+
   addq.l #2,a4
   move.l (a4)+,(a2)+
   move.l (a4)+,(a2)+
   move.l (a4)+,(a2)+
   move (a4)+,(a2)+
   bsr .lb6
   bra .sortie
.bugloop2:
	move #-1,erreur
	rts
.fin: 
   lea loopnest,a1
   tst.l (a1)		; des boucles encore ouvertes?
   bne.s .bugloop2			; oui, erreur !
   tst.l 4(a1)
   bne.s .bugloop2
	tst.w 8(a1)
	bne .bugloop2
	move #$4e75,(a2)+
   move.l a2,topprg
   move.l #but,a2
   move.l (a2)+,d0
   move.l (a2),-4(a2)
   move.l d0,(a2)
   move.l topsav2,a2
   clr ass
   clr in_def
   bra .sortie
.ch: move.l a2,a5
.ch3: move.b (a0)+,d2
   beq.s .ch2
   cmp.b #34,d2
   beq.s .ch1
   move.b d2,(a2)+
   bra.s .ch3
.ch1: clr.b (a2)+
   move.l a2,d2
   addq.l #1,d2
   bclr #0,d2
   move.l d2,a2    ; sur une adresse paire
   sub.l a5,d2     ; taille de la chaine
   rts
.ch2: addq.l #4,sp
	lea cbug2,a0
	bra .bug_comm
.us:                    ; mot "user"
   move (a4)+,d2		; quel type ? ($7FFF si ind‚fini pour l'instant)
   cmp #$7FFF,d2
   beq .bug_indef
	cmp #142,d2        ; array
   bne.s .u3
   lea .t142(pc),a5
   bsr optimise_array
   move.l (a5)+,(a2)+
   move.l a4,(a2)+
   addq.l #4,a5
   move (a5),(a2)+
   rts
.u3:
	cmp #144,d2        ; array$
   bne.s .u6
   lea .t144(pc),a5
   bsr optimise_array
   move (a4)+,d2
   addq #4,d2
   bclr #0,d2
   move (a5)+,(a2)+
   move d2,(a2)+
   addq.l #2,a5
   move (a5),(a2)+
   move.l a4,(a2)+
   move 6(a5),(a2)+
   rts
.u6: cmp #145,d2        ; table
   bne.s .u5
   lea .t145(pc),a5
   bsr optimise_array
   move.l (a5)+,(a2)+
   move.l a4,(a2)+
   move.l 4(a5),(a2)+
   rts
.u5:
	cmp #706,d2        ; [war]
   bne.s .u8
   lea .t706(pc),a5
   bsr optimise_array
   move.l (a5)+,(a2)+
   subq.l #2,a4
   move.l a4,(a2)+
   move 4(a5),(a2)+
   rts
.u8:
	sf ass_const			; pour tous les autres, on annule le flag inutile
	cmp #530,d2				; thvariable
	bne.s .u0
	move .emp(pc),(a2)+
	move.l a4,(a2)+		; empile l'adresse de d‚but du tableau-2 (avec taille donn‚es)
	move #$4eb9,(a2)+
	move.l #thvar,(a2)+	; et cr‚e jsr thvar
	rts
.u0:
   cmp #437,d2          ; "&assembler" ou ":: ;"
   bne.s .u1
   move #$4eb9,(a2)+
   move.l a4,(a2)+
   rts
.u1: cmp #140,d2        ; variable
   bne.s .u2
   move .emp(pc),(a2)+
   move.l a4,(a2)+
   rts
.u2: cmp #141,d2        ; constant
   bne.s .u4
   move .emp1(pc),(a2)+
   move.l a4,(a2)+
   rts
.u4: cmp #143,d2        ; string
   bne.s .u7
   addq.l #2,a4
   move .emp(pc),(a2)+
   move.l a4,(a2)+
   rts
.u7: cmp #628,d2        ; [&]
   bne.s .bug2
   ext.l d4
   move .emp(pc),(a2)+
   move.l d4,(a2)+
   rts
.bug2:
.bug1: lea ordres,a0		; mot non assemblable
   move.l #mot,a1
   move.b #32,(a1)+		; un espace
.blb1: subq #1,d4
   bmi.s .blb2
   move.b (a0)+,d2
   ext.w d2
   ext.l d2
   add.l d2,a0
   bra.s .blb1
.blb2: move.b (a0)+,d1
   ext.w d1
   subq #1,d1
.blb3: move.b (a0)+,(a1)+
   dbf d1,.blb3
   clr.b (a1)
   lea mot,a0
   jsr write_str
.bug: lea bugass,a0
.bug_comm:
   jsr write_str
   move #1,erreur
   rts
.bug_indef:
	lea bugundef,a0
	bra.s .bug_comm

.emp: move.l #2,-(a6)
.type3: dc.w $4eb9
.type17: move #100,d1
.type6: movem.l (a6)+,d0-d1
	cmp.l d0,d1
	beq .type4
	movem.l d0-d1,-(a4)
   move.l #indptr,a1
   addq.l #4,(a1)
   move.l (a1),a2
   move.l a4,(a2)
.type4: addq.l #1,(a4)
   move.l (a4),d1
   cmp.l 4(a4),d1
   bmi .type13
   addq.l #8,a4
   subq.l #4,indptr
.type13: tst.l (a6)+
   bne.s .type5
.type14: dc.w $4ef9,0,0
.type5: move.l (a6)+,d1
   ble.s .ttt5
   add.l d1,(a4)
   move.l (a4),d1
   cmp.l 4(a4),d1
   bmi .type16
.tt5: addq.l #8,a4
   subq.l #4,indptr
   bra.s .type16
.ttt5: add.l d1,(a4)
   move.l (a4),d1
   cmp.l 4(a4),d1
   bpl .type16
   bra.s .tt5
.type16: 
	tst.l (a6)+
   beq.s .t16
   addq.l #1,(a4)
   move.l (a4),d1
   cmp.l 4(a4),d1
   bmi .type18
.t16: move.l (a4),-(a6)
   addq.l #8,a4
   subq.l #4,indptr.l
   bra.s .type18
   subq.l #4,a6
.type18: move.l uspile,a7
   dc.w $4ef9
   dc.l debut
.t142: move.l (a6)+,d1
   asl.l #2,d1
   add.l #1212,d1
   move.l d1,-(a6)
.t144: move.l (a6)+,d1
   muls #1212,d1
   add.l #1212,d1
   move.l d1,-(a6)
.t145: move.l (a6)+,d1
   asl.l #2,d1
   move.l #1212,a0
   move.l (a0,d1),-(a6)
.t706: move.l (a6)+,d1
   add.l d1,d1
   add.l #1212,d1
   move.l d1,-(a6)
.tos: move.l a7,topsave.l
   move.l (a6)+,-(a7)
   move.l (a6)+,d0
   move d0,-(a7)
   move #1212,-(a7)
   move.l topsave.l,a7
   move.l d0,-(a6)
.type19: move.l (sp)+,a0
   jsr write_str
.type20:
	addq.l #2,(sp)
	move.l (sp)+,-(a6)
.type25: move.l (a6)+,d1
   cmp.l (a6),d1
   beq.s .t25
   dc.w $4ef9,0,0
.t25: UP
.type33: move.l (a6)+,d1
   cmp.l (a6),d1
   bne.s .t33
   dc.w $4ef9,0,0
.t33: UP
.type34: move.l (a6)+,d1
   cmp.l (a6),d1
   bmi.s .t34
   dc.w $4ef9,0,0
.t34: UP
.type35: move.l (a6)+,d1
   cmp.l (a6),d1
   bgt.s .t35
   dc.w $4ef9,0,0
.t35: UP
.type26: 
   move.l (a6)+,d0
	beq .type27
	clr.l -(a4)
   subq.l #1,d0
   swap d0
   move.l d0,-(a4)
.type27: subq #1,(a4)
   bcc .type30
   subq #1,2(a4)
   bcc .type30
   addq.l #8,a4
.type30: moveq #2,d0
   move.l (a6)+,d1
   cmp dicco,d1
   bpl.s .t30
   moveq #0,d0
.t30: asl #2,d1
   move.l #adresse,a1
   move.l  0(a1,d1.w),a1
   add.w d0,a1
   jsr (a1)
.emp1: move.l $fffff.l,-(a6)
.type31:
	move.l indptr,a1
	addq.l #4,(a1)
	addq.l #1,(a4)
	move.l (a4),d0
	cmp.l 4(a4),d0
	bcs .typee1
   addq.l #8,a4
   subq.l #4,lstptr
   subq.l #4,indptr
.typee1: rts	
.type32:
	move.l lst,d1
	bne.s .t31a
	move.l (a6)+,d0
	bne.s .t31c
	addq.l #4,a6
.t31b:
	bra .type32
.t31a:
	clr.l lst
	move.l d1,d2
	sub.l a6,d2
	asr.l #2,d2
	beq.s .t31b
.t31c:
	jsr dlcomp	

   NON
fff1: move (a5)+,forth
   move.l (a5)+,a0
   clr.b (a0)
   move.l a0,sommet
   move.l (a5),topprg
   move.l (a4)+,a5
   rts

   COPIE bstart,y305
bstart: move.l #debutb,-(a6)
y305: rts

   SAUT
buf0: move.l beuf(pc),-(a6)
   rts

   SAUT
writeb: move debutb,d3
   bpl.s .lb0
   clr d3
.lb0: move topedit,d5
   cmp d5,d3
   bpl.s .fin
   move finb,d4
   move.l beuf(pc),a3
   bra.s .lb2
.lb1: add.w (a3),a3
.lb2: dbf d3,.lb1
.lb3: move #0,-(sp)
   BIOS 8,4
   tst.l d0
   bne.s .lb4
   ACONTROL 52,1,1,1
   move #2,intin
   move.l #avert1,addrin
   AES
   move intout,d0
   cmp #2,d0
   beq.s .lb3
.fin: rts
.lb4: move #13,-(sp)
   clr -(sp)
   BIOS 3,6
   move #10,-(sp)
   clr -(sp)
   BIOS 3,6
   tst (a3)+
   beq.s .fin
   move.b (a3)+,d5
   bra.s .lb42
.lb41: move #32,-(sp)
   clr -(sp)
   BIOS 3,6
.lb42: subq.b #1,d5
   bne.s .lb41
   clr d5
.lb5: move.b (a3)+,d5
   beq.s .lb6
   move d5,-(sp)
   clr -(sp)
   BIOS 3,6
   bra.s .lb5
.lb6: subq.l #1,a3
   dbf d4,.lb4
   rts

   SAUT
import:
	tst selmode
	beq.s .lb00
	move.l #chetxt,addrin
	move.l #fichtxt,addrin+4
	bsr selecteur
	bne.s .lb0
.fin:
	rts
.lb00:
	move.l (a6)+,a0			; directement depuis la pile
.lb0:
	clr -(sp)
	move.l a0,-(sp)
	GEMDOS 61,8
	move.l d0,d7
	bpl.s .ok
	tst selmode
	beq.s .fin					; erreur
	lea .extension(pc),a0
	bsr retente					; retente avec extension TXT
	move.l d0,d7
	bmi.s .fin
.ok:
	move.l bfptr,a3			; adresse derniŠre ligne
	move.l #setdat,d6			; critŠre d'arrˆt
	move.l d6,a0
	tst selmode
	beq.s .boucle
	move.l a3,-(a6)			; conserve pour statistiques
.boucle:
	move.l a3,a2				; place pour la taille de la ligne
	clr (a3)+					; … z‚ro la taile (en cas de fin)
	clr.b (a3)					; la tabulation
.tab:
	bsr .suivant
	addq.b #1,(a3)				; une tabulation
	cmp.b #32,d0
	beq.s .tab
	cmp.b #9,(a3)				; TAB ?
	bne.s .lb2
	addq.b #3,(a3)
	bra.s .tab
.lb2:
	addq.l #1,a3
.ligne:
	cmp.b #13,d0				; fin de ligne?
	beq.s .fin_l
	cmp.b #9,d0
	bne.s .lb1
	moveq #32,d0
	move.b d0,(a3)+
	move.b d0,(a3)+
.lb1:
	move.b d0,(a3)+
	bsr .suivant
	bra.s .ligne
.fin_l:
	bsr .suivant				; le #10
	move.l a3,d0
	btst #0,d0					; adresse impaire?
	beq.s .paire
	move.b #32,(a3)+			; complŠte avec un espace
.paire:
	move.l a3,bfptr			; nouveau pointeur
	addq #1,topedit			; une ligne de plus
	move.l a3,d0
	sub.l a2,d0					; taille de la ligne
	move d0,(a2)
	bra.s .boucle
.suivant:
	cmp.l d6,a0
	bpl.s .read
	move.b (a0)+,d0
	rts
.read:
	pea setdat
	move.l #8192,-(sp)		; 16 secteurs de 512 octets
	move d7,-(sp)
	GEMDOS 63,12
	move.l d0,d6				; nombre d'octets lus
   bmi.s .sortie				; une erreur
   beq.s .sortie				; plus d'octets
   lea setdat,a0
   add.l a0,d6
   bra.s .suivant
.sortie:
	move d7,-(sp)
	GEMDOS 62,8					; sp+8 au lieu de +4 pour oter bsr
	tst selmode
	bne load_stat				; meme fin que loadb, affiche les stats
	rts
.extension: dc.b "TXT",0

	SAUT
export:
	tst.b selmode
	beq.s .lb00
	move.l #chetxt,addrin
	move.l #fichtxt,addrin+4
	bsr selecteur
	bne.s .lb0
.fin:
	rts
.lb00:
	move.l (a6)+,a0
.lb0:
	move debutb,d6
   bpl.s .lb1
   clr d6
.lb1: move topedit,d5
   cmp d5,d6
   bpl.s .fin
   cmp #$00FF,selmode	; Shift Ctrl-C ?
   bne.s .create
   move #1,-(sp)
   move.l a0,-(sp)
   GEMDOS 61,8				; fopen SCRAP.TXT
   move.l d0,d7
   bmi.s .create			; si ouverture impossible, alors cr‚er
   move #2,-(sp)
   move d7,-(sp)
   clr.l -(sp)
   GEMDOS 66,10			; fseek vers la fin, ajoute les donn‚es
	bra.s .commun   
.create:
   clr -(sp)
   move.l a0,-(sp)
   GEMDOS 60,8				; fcreate
   move.l d0,d7
   bmi.s .fin
.commun:
   move finb,d4
   move.l beuf(pc),a3
   bra.s .lb3
.lb2: add.w (a3),a3
.lb3: dbf d6,.lb2
.boucle:
	lea setdat,a0
	moveq #98,d0
.boucle99:
   tst (a3)+
   bne.s .lb4
   bsr .write
   bra .close
.lb4:
   move.b (a3)+,d5
   ext.w d5
   subq #1,d5
   bra.s .lb42
.lb41: move.b #32,(a0)+
.lb42: dbf d5,.lb41
.lb5: move.b (a3)+,(a0)+
   bne.s .lb5
   subq.l #2,a0
   cmp.b #32,(a0)
   beq.s .lb6
   addq.l #1,a0
.lb6:
	move.b #13,(a0)+
	move.b #10,(a0)+
   subq.l #1,a3
   subq #1,d0
   bpl.s .lb7
   bsr .write
.lb7:
   dbf d4,.boucle99
   bsr .write
.close:
	move d7,-(sp)
	GEMDOS 62,4
   rts
.write:
	move.l #setdat,d0
	sub.l d0,a0
	cmp.l #0,a0
	beq.s .w1
	move.l d0,-(sp)
	move.l a0,-(sp)
	move d7,-(sp)
	GEMDOS 64,12
.w1: lea setdat,a0
	moveq #98,d0
	rts

   COPIE buf,y306
buf: move.l #bfptr,-(a6)
y306: rts

	SAUT
_trace_win:
	move.l (a6)+,d1
	move.l (a6)+,d0
	bsr.s trace_window
	rts

; d0 position verticale (en lignes textes) de la fenetre trace, si n‚gatif
; position … partir du bas
; d1 hauteur de la fenetre trace (en lignes textes)

trace_window:
	lea trace_win,a0			; la fenˆtre
	clr (a0)+					; X=0
	move.l work_out,d2      ; L-1,H-1
	addq #1,d2					; H
	move.l fenetre0+12,d3	; l,h (pour un caractŠre)
	muls d3,d0					; position Y
	bpl.s .lb1					; si positif, c'‚tait … partir du haut
	add d2,d0					; si n‚gatif Y'=H-Y
	bpl.s .lb1
	clr d0
.lb1:
	move d2,d4
	sub d3,d4
	sub d3,d4
	sub d3,d4					; H-3lignes
	cmp d4,d0
	bmi.s .lb2
	move d4,d0					; si trop bas, on remonte pour avoir 3 lignes
.lb2:
	move d0,(a0)+				; Y d‚finitif
	swap d2						; L-1
	addq #1,d2					; L
	move d2,(a0)+				; L
	swap d2
	move d3,d4					; hauteur caractŠre
	cmp #3,d1
	bpl.s .lb3
	moveq #3,d1					; 3 lignes au moins
.lb3:
	muls d1,d4					; hauteur fenˆtre
	add d4,d0					; fin fenˆtre
	cmp d0,d2					; compar‚ … H total
	bpl.s .lb4					; bon
	move d2,d4
	sub d0,d4					; hauteur maxi
.lb4:
	move d4,(a0)+ 	   		; H
	clr.l (a0)+					; x y curseur
	move.l d3,(a0)+			; l h caractŠre
	move.l #$10001,(a0)+		; lignes colonnes du d‚coupage (ici un seul bloc 1x1)
	clr d2
	swap d2						; L
	swap d3						; l d'un caractŠre
	divs d3,d2					; caractŠres pas ligne
	move d2,(a0)+				; rang‚s … la fin de fenetre
	rts

help_cursor:
	movem.l d0-d7/a0-a6,-(sp)
	move.l edb,a3
	cmp.l #$00040120,(a3)
	beq .non						; ligne vide on saute
	moveq #0,d0
	move.b 2(a3),d0			; tabulation
	subq.l #1,d0				; -1
	sub.l d0,d4					; position
	lea 3(a3,d4),a0			; caractŠre sous le curseur
	move.b (a0),d0				; z‚ro?
	beq .non
	cmp #32,d0					; espace?
	beq .non
	; ici assurer que NE est valid‚
	bra.s .loop
.cherche_debut:
	cmp.b #32,-(a0)
.loop:
	dbeq d4,.cherche_debut
	bne.s .lb0
	addq.l #1,a0			; remonte le dernier espace
.lb0:
	lea mot,a1
	moveq #0,d1				; taille
.lb1:
	move.b (a0)+,d0
	beq.s .lb2
	cmp.b #32,d0
	beq.s .lb2
	move.b d0,(a1)+
	addq.l #1,d1
	bra.s .lb1
.lb2:
	clr.b (a1)
	moveq #0,d4
	GOSUB find_word
	beq.s .non					; mot non trouv‚
   move.l pilptr,a6
   move.l retptr,a4
.page:
	move.l d4,-(a6)
	GOSUB cls					; efface ecran
	lea helpc(pc),a0
	GOSUB write_str
	GOSUB cr
	bsr helpw
	moveq #0,d4
 	bsr.s .key
 	cmp #'-',d0
 	bne.s .oui
.lien:
	bsr.s .key
	sub #'0',d0
	bmi.s .fin
	cmp #10,d0
	bpl.s .fin
	mulu #10,d4
	add.l d0,d4
	bra.s .lien
.fin:
	neg.l d4	
	bra.s .page
.oui:
	moveq #1,d0					; renvoie NE on a affich‚ un truc 
	bra.s .exit			
.non:
	moveq #0,d0					; renvoie EQ, rien … changer
.exit:
	movem.l (sp)+,d0-d7/a0-a6
	rts
.key:
	move.l #$20002,-(sp)
	trap #13
	addq.l #4,sp	
	and.l #$FF,d0
	rts

_find_guide:
	move.l #acc2,af_addr
	GEM_AES appl_find2			; cherche HyperView
	tst stguide
	bpl.s .ok
	move.l #acc1,af_addr			; change le critŠre de recherche
	GEM_AES appl_find2			; cherche la pr‚sence de ST-GUIDE
	tst stguide
.ok:
	rts		; envoie >0 si trouv‚ !

	NON
guide:
	bsr.s _find_guide
	bpl.s .ok						; st guide present
	tst global+2					; multitache?
	bpl.s helpw						; si >0, monotache, on utilise help … la place
	moveq #1,d4						; d4=01 essayer shel_write
	bra.s _helpcomm
.ok:
	st d4							; d4=FF, guide
	bra.s _helpcomm
	
	NON
helpw:
	sf d4							; d4=00, help !
_helpcomm:
	moveq #0,d7					; par d‚faut, pas d'aide
	move.l (a6)+,d1
	bpl.s .mot					; positif, code d'un mot
	neg.l d1
	cmp.l max_help_page,d1
	bgt.s .defaut
	move.l d1,d7				; si n‚gatif, code direct d'une page
	bra.s .lb3
.mot:
	cmp.l #diko,d1
	bpl.s .defaut				; d‚passe les mots FORTH, vide aussi
	cmp #532,d1
	beq .helphelp				; si 'help
	cmp #533,d1
	beq .helphelp				; si 'guide
	lea helpcode(pc),a0
	move.b 0(a0,d1.l),d7		; code du paragraphe !
.lb3:
	cmp.b #255,d7				; code -1 pour les non explicables
	bne.s .lb2
	moveq #0,d7
.lb2:
	lsl.l #2,d7					; *4 pour acc‚der … des longs
.defaut:
	moveq #28,d6
	add.l d6,d7					; offset du long !
	
	move.l hlpptr,a0
	move.b #'L',(a0)			; FORTH.HLP
	clr -(sp)
   pea chehlp
   GEMDOS 61,8					; fopen 'FORTH.HLP'
   move.l d0,d5				; handle
   bmi .bug						; erreur
   
	tst.b d4
	beq.s .norm1	

   subq.l #6,a6				; de la place
   
   move.l a6,-(sp)
   move.l #6,-(sp)			; 6 octets 601A + OFFSET DATA un long
   move d5,-(sp)
   GEMDOS 63,12					; fread	
   addq.l #2,a6
	add.l (a6)+,d7				; le bon offset 28 + DATA + id*4   
	
.norm1:   
   clr -(sp)				   ; depuis le debut
   move d5,-(sp)
   move.l d7,-(sp)
   GEMDOS 66,10				; fseek
   
   subq.l #4,a6				; de la place
   
   move.l a6,-(sp)
   move.l #4,-(sp)			; 4 octets un long
   move d5,-(sp)
   GEMDOS 63,12					; fread
   add.l (a6)+,d6				; offset+28 pour pointer sur la bonne chaŒne
   tst.l d0
   bmi .ferme

   clr -(sp)				   ; depuis le debut
   move d5,-(sp)
   move.l d6,-(sp)
   GEMDOS 66,10				; fseek sur la bonne chaŒne
   
   tst.b d4
   bne .st_guide

	clr vef_int					; effet … z‚ro	
.loop:
	clr -(a6)
	move.l a6,-(sp)
   move.l #1,-(sp)			; 1 octet
   move d5,-(sp)
   GEMDOS 63,12					; fread
   move.l a6,a0				; en cas de write
   move (a6)+,d1
   bne.s .lb0
   move d5,-(sp)
   jsr cr						; un zero = saut de ligne
   move (sp)+,d5
   bra.s .loop
.lb0:
   lsr #8,d1
   cmp #255,d1					; 255 = fin de paragraphe!
   beq.s .reset
	cmp #222,d1
	bne.s .lb1
	bchg #0,vef_int+1			; passe de 0 … 1 et inverement
	GEM_VDI vst_eff
	bra.s .loop
.lb1:
	move d5,-(sp)
	jsr write_str
	move (sp)+,d5				; r‚cupŠre le handle !
   bra.s .loop
.bug:
	lea helpbug1(pc),a0
	bsr forth_alert
	bra.s .exit
.reset:
	clr vef_int
	GEM_VDI vst_eff
	; remettre attribut normal
.ferme:
   move d5,-(sp)
   GEMDOS 62,4						; fclose!
.exit:
	rts	
.st_guide:
	move.l #256,d0
	if STE=1
		move.l d0,-(sp)
		GEMDOS 72,6					; malloc
	else
		move #$2B,-(sp)			; pref TT Ram et alloc global
		move.l d0,-(sp)
		GEMDOS 68,8					; mxalloc
	endif
	move.l d0,a3					; on va y construire le buffer AES + chaine
	move.l d0,-(a6)				; conserve pour lib‚rer le bloc
	move #$4711,(a3)+				; VA_START
	move appl_id,(a3)+
	clr (a3)+
	lea 10(a3),a0					; pointeur vers chaŒne
	move.l a0,(a3)+
	clr.l (a3)+
	clr (a3)+
	move.l hlpptr,a0
	move.b #'Y',(a0)			; FORTH.HYP	
	lea chehlp,a0
.chemin:
	move.b (a0)+,(a3)+
	bne.s .chemin
	move.b #32,-1(a3)			; plus un espace
.nompage:
	clr.b -(a6)
	move.l a6,-(sp)
   move.l #1,-(sp)			; 1 octet
   move d5,-(sp)
   GEMDOS 63,12					; fread
   move.b (a6)+,(a3)+
   bne.s .nompage
   bsr.s .ferme				; referme FORTH.HLP
   move.l (a6),a3				; le bloc
   tst.b d4
   bgt.s .multi				; d4=1, multitache et pas en ACC, appeler shel_write
	moveq #0,d0
	move stguide,d0
	move.l d0,-(a6)			; ID
	move.l #16,-(a6)			; taille bloc
	move.l a3,-(a6)			; adresse
	jsr appl_write				; envoie le VA_START
.desk:
	jsr desk						; mode desk
	move.l (a6)+,-(sp)
	GEMDOS 73,6					; libŠre le bloc message
	rts	
.multi:
	lea 16(a3),a1			; saute le buffer AES
	move.l a1,a0
.len:
	tst.b (a0)+
	bne.s .len
	move.l a0,d0
	sub.l a1,d0
	subq.l #1,d0
	move.b d0,-(a1)		; ajoute la taille de la chaŒne un octet avant.
	lea sw_addrin,a0		; here run HYP file viewer with Mint
	move.l #chestg,(a0)+	; addrin[0]= program name((in FORTH.INI)
	move.l a1,(a0)			; addrin[1]= command line(HYP + page name
	GEM_AES shel_write2
	bra.s .desk
.helphelp:
	bsr _find_guide
	spl d4
	lea .txt1(pc),a0
	lea .txt2(pc),a3		; NON par defaut
	tst.b d4	
	beq.s .hh0
	move.l af_addr,a3		; sinon, nom du lecteur
.hh0:
	move.l a3,-(sp)
	jsr write_str		; lecteur present
	move.l (sp)+,a0
	jsr write_str		; nom lecteur
	jsr cr
	lea .txt3(pc),a0
	jsr write_str		; aide sur...
	moveq #0,d0
	move #diko,d1
	lea helpcode(pc),a0
	bra.s .hh2
.hh1:
	tst.b (a0)+			; calcule le nombre de mots avec code<>0
	beq.s .hh2
	addq.l #1,d0
.hh2:
	dbf d1,.hh1
	move.l d0,-(a6)	; nombre de mots avec aide
	jsr dpt
	lea .txt4(pc),a0	; sur...
	jsr write_str
	move.l #diko,-(a6) ; le total des mots
	jsr dpt
	jsr cr
	rts

	if LANG=0
.txt1: dc.b " Lecteur HYP en m‚moire : ",0
.txt2: dc.b "NON",0
.txt3: dc.b " Aide pour ",0
.txt4: dc.b " mots sur ",0
	else
.txt1: dc.b " HYP reader in memory : ",0
.txt2: dc.b "NO",0
.txt3: dc.b " Help for ",0
.txt4: dc.b " words out of ",0
	endif
	even

	NON
newin:
	GOSUB fastclose
	GOSUB fastdel
	move.l (a6)+,d0
	move d0,screen_percent
	GOSUB fastcreate
	GOSUB fastopen
	rts
	

	
helpcode:
   dc.b -1,7,7,7,7 ; [empl],variable,constant,array,string
   dc.b 7,7,2,13,13 ; array$,table,thvariable,r>,r@
   dc.b 9,14,9,9,9 ; ?dup,depth,drop,dup,over
   dc.b 9,13,9,9,13 ; pick,r0,roll,rot,rp!
   dc.b 25,13,14,14,25 ; w/mod,rp@,s0,sp!,wmod
   dc.b 14,9,25,25,25 ; sp@,swap,*,w*,w/
   dc.b 25,25,25,25,25 ; +,+-,-,/,/mod
   dc.b 25,25,25,25,25 ; 0<,0=,0>,>,<
   dc.b 25,25,25,25,25 ; =,1+,1-,2+,2-
   dc.b 25,25,25,25,25 ; 2*,2/,abs,and,max
   dc.b 25,25,25,25,25 ; min,mod,negate,not,or
   dc.b 25,3,3,3,4 ; xor,loop,+loop,do,again
   dc.b 4,4,4,4,0 ; begin,until,while,repeat,exit
   dc.b 6,6,6,6,5 ; case,of,endof,endcase,if
   dc.b 5,5,0,3,3 ; else,then,appl_find,i,j
   dc.b 3,3,89,90,90 ; k,leave,,,:,;
   dc.b 89,28,28,28,28 ; allot,$!,$+,$=,$<
   dc.b 28,28,78,28,78 ; $>,asc,base,chr$,decimal
   dc.b 78,28,28,28,28 ; hex,instr,len,left$,mid$
   dc.b 28,28,28,28,88 ; mlen,pad,right$,str$,append
   dc.b 28,26,26,26,26 ; val,!,+!,-!,1+!
   dc.b 26,79,79,26,26 ; 1-!,trace,untrace,?,@
   dc.b 88,26,26,90,0 ; select+,c!,c@,find,cls
   dc.b 0,90,88,78,89 ; addrin!,forget,select-,bin,here
   dc.b 9,9,0,90,30 ; dupm,dropm,system,vlist,.
   dc.b 29,0,30,30,29 ; ?terminal,bl,cr,emit,expect
   dc.b 29,29,29,29,30 ; inkey,input,input$,key,space
   dc.b 30,30,0,30,0 ; spaces,type,quit,.","
   dc.b -1,-1,-1,-1,-1 ; [var],[cst],[arr],[str],[ar$]
   dc.b -1,-1,0,25,89 ; [tab],[qt],timer,<>,free
   dc.b 89,14,89,91,91 ; full,.s,allot0,:does>,;end
   dc.b 91,3,88,0,88 ; ::does>,ifloop,edit,eval,bsize
   dc.b 12,12,12,12,12 ; <#,#,hold,#s,#>
   dc.b 0,88,88,88,88 ; call,loadb,saveb,lmax,buf!
   dc.b 0,87,89,0,0 ; compilb,>comp,top,aes,vdi
   dc.b 0,0,0,0,0 ; control,intin,ptsin,intout,ptsout
   dc.b 0,0,26,26,0 ; addrin,addrout,w@,w!,handle
   dc.b 0,0,0,0,0 ; vctrl,actrl,16b$,vintin!,ptsin!
   dc.b 0,64,61,72,89 ; aintin!,gemdos,bios,xbios,w,
   dc.b 26,26,26,28,28 ; extbw,extbl,extwl,puts,gets
   dc.b 16,16,16,16,16 ; fcreate,fopen,fclose,fread,fwrite
   dc.b 17,16,17,17,17 ; fgetdta,fdelete,ffirst,fnext,dta
   dc.b 17,16,16,16,0 ; fsetdta,fseek,fseek>,fseek<,xv_opnwk
   dc.b 0,0,0,73,52 ; xv_updwk,global,vq_aes,vsync,joyst
   dc.b 52,52,52,52,52 ; mouse,jx0,jy0,fire0,jx1
   dc.b 52,52,52,52,52 ; jy1,fire1,mousex,mousey,mousek
   dc.b 90,70,70,0,0 ; adress,super,user,v_opnvwk,vst_load_fonts
   dc.b 0,0,18,19,0 ; vst_unload_fonts,vs_clip,v_pline,v_pmarker,v_gtext
   dc.b 0,0,0,0,0 ; v_fillarea,v_contourfill,v_recfl,vswr_mode,vs_color
   dc.b 18,18,18,18,18 ; vsl_type,vsl_udsty,vsl_width,vsl_color,vsl_ends
   dc.b 19,19,19,0,0 ; vsm_type,vsm_height,vsm_color,vst_height,vst_point
   dc.b 0,0,0,0,0 ; vst_rotation,vst_font,vst_color,vst_effects,vst_alignment
   dc.b 0,0,0,0,0 ; vsf_interior,vsf_style,vsf_color,vsf_perimeter,vsf_udpat
   dc.b 21,0,21,0,0 ; vsc_form,vex_timv,v_show_c,vq_color,vqt_extent
   dc.b 0,0,0,0,21 ; vqt_width,vqt_name,v_clsvwk,v_clrwk,v_hide_c
   dc.b 0,18,19,0,0 ; vq_key_s,vql_attributes,vqm_attributes,vqf_attributes,vqt_attributes
   dc.b 0,20,20,20,20 ; vqt_fontinfo,v_bar,v_arc,v_pieslice,v_circle
   dc.b 20,20,20,20,20 ; v_ellipse,v_ellarc,v_ellpie,v_rbox,v_rfbox
   dc.b 0,0,0,0,0 ; v_justified,vq_chcells,v_exit_cur,v_enter_cur,v_curup
   dc.b 0,0,0,0,0 ; v_curdown,v_curright,v_curleft,v_curhome,v_eeos
   dc.b 0,0,0,0,0 ; v_eeol,vs_curaddress,v_curtext,v_rvon,v_rvoff
   dc.b 0,0,0,0,0 ; vq_curaddress,vq_tabstatus,v_hardcopy,appl_init,graf_handle
   dc.b 0,0,22,24,24 ; evnt_keybd,rsrc_free,wind_get,wind_create,wind_open
   dc.b 24,23,24,0,24 ; wind_delete,wind_set,wind_find,wind_update,wind_calc
   dc.b 0,0,0,0,24 ; evnt_button,evnt_mouse,evnt_timer,form_error,wind_close
   dc.b 0,0,0,0,0 ; graf_rubberbox,graf_dragbox,graf_movebox,graf_growbox,graf_shrinkbox
   dc.b 21,0,0,0,0 ; graf_mkstate,evnt_dclick,evnt_mesag,evnt_multi,appl_read
   dc.b 0,0,0,0,0 ; appl_write,objc_draw,objc_find,objc_offset,objc_edit
   dc.b 0,0,0,0,0 ; objc_change,rsrc_load,rsrc_saddr,form_do,form_dial
   dc.b 0,0,0,0,0 ; form_center,form_alert,menu_icheck,menu_ienable,menu_tnormal
   dc.b 0,0,0,21,0 ; menu_register,graf_watchbox,graf_slidebox,graf_mouse,scrp_read
   dc.b 0,0,0,0,0 ; scrp_write,shel_get,shel_put,shel_find,rsrc_gaddr
   dc.b 0,0,0,0,0 ; menu_text,fsel_input,shel_read,shel_write,shel_envrn
   dc.b 74,0,90,90,70 ; format,menu_bar,exec,exe+,pterm0
   dc.b 70,70,70,67,67 ; pterm,ptermres,pexec,dsetdrv,dgetdrv
   dc.b 67,67,67,67,67 ; dsetpath,dgetpath,dfree,dcreate,ddelete
   dc.b 71,71,71,71,70 ; frename,fattrib,fduplic,fforce,malloc
   dc.b 70,70,69,69,69 ; mfree,mshrink,cauxin,cauxout,cprnout
   dc.b 69,69,69,69,69 ; crawio,cconws,cconrs,cconis,cprnos
   dc.b 69,69,62,62,62 ; cauxis,cauxos,bconstat,bcostat,bconin
   dc.b 62,62,62,62,62 ; bconout,rwabs,mediach,drvmap,getmpb
   dc.b 62,62,62,73,73 ; getbpb,kbshift,setexec,physbase,logbase
   dc.b 73,73,73,73,74 ; getrez,setscreen,setpalette,setcolor,floprd
   dc.b 74,74,75,75,75 ; flopwr,flopver,mfpint,jdisint,jenabint
   dc.b 75,76,77,77,77 ; xbtimer,kbdvbase,midiws,giaccess,dosound
   dc.b 75,75,75,75,76 ; offgibit,ongibit,setprt,rsconf,iorec
   dc.b 76,76,76,76,77 ; initmous,keytbl,bioskeys,kbrate,random
   dc.b 77,0,-1,0,0 ; supexec,MFP_ST,[ass],MFP_TT,count
   dc.b 89,0,0,0,0 ; even,delay,auto_end,soft_end,timer_stop
   dc.b 0,0,0,0,0 ; timerA,timerB,timerC,timerD,timer_calc
   dc.b 49,49,49,50,50 ; sc_load,sc_unload,sc_dma,sc_boot,sc_sendm
   dc.b 50,50,50,50,50 ; sc_getm,sc_exec,sc_xsendm,sc_xgetm,sc_xsendb
   dc.b 50,49,49,49,51 ; sc_xgetb,sc_adr,sc_check,sc_status,if!
   dc.b 51,51,51,51,51 ; if@,i!,i@,iw!,iw@
   dc.b 89,0,0,27,27 ; align,ver,screen_info,.b,.w
   dc.b 27,27,27,78,78 ; .l,)@,)!,uh.,ub.
   dc.b 40,40,40,41,41 ; modset,modload,modunload,modsname,modlname
   dc.b 41,41,41,0,0 ; modver,modfmt,modtype,modinfo,modpal
   dc.b 0,10,0,0,0 ; modexe,fillmfdb,fopensize,imagesize,dorim
   dc.b 0,0,0,0,40 ; dowim,doifx,dotrm,graphic_card,modmload
   dc.b 40,0,0,0,0 ; modmunload,(,),savebitmap,loadbitmap
   dc.b 0,68,68,68,68 ; rsrc_mono,datetostr,strtodate,timetostr,strtotime
   dc.b 68,68,68,68,11 ; tgetdate,tgettime,tsetdate,tsettime,setsubpage
   dc.b 11,2,2,2,2 ; getsubpage,thread,thnext,thkill,thpause
   dc.b 2,2,2,2,2 ; thwake,thrun,thid,thsync,thsyncmain
   dc.b 2,2,2,15,13 ; thnsync,thkillall,thstat,st@,>r
   dc.b -1,2,-1,-1,34 ; [thv],vthread,help,guide,vd_set
   dc.b 34,34,34,34,34 ; vd_info,vd_play,vd_create,vd_frame,vd_sign
   dc.b 35,35,35,35,35 ; gr_yx,gr_xyt,gr_rt,gr_window,gr_axes
   dc.b 35,35,35,36,36 ; gr_grid,gr_getpoint,gr_plot,gr3_window,gr3_xyz(t)
   dc.b 36,0,0,27,27 ; gr3_plot,vdi!,aes!,-(@,-(!
   dc.b 27,27,27,27,27 ; +(@,+(!,)-@,)-!,)+@
   dc.b 27,27,89,26,26 ; )+!,size,c,,w*!,w/!
   dc.b 26,26,89,25,25 ; 2*!,2/!,dcs,<seg>,>seg<
   dc.b 90,90,3,3,3 ; word$,::,ndo,nloop,list
   dc.b 3,3,89,89,90 ; dolist,lloop,remember,restore,&f
   dc.b -1,78,78,78,78 ; [f],b.,d.,o.,h.
   dc.b 81,83,81,81,82 ; struct,&pointer,&name,sizeof,chain
   dc.b 82,82,82,81,81 ; unchain,next,previous,screate,sdelete
   dc.b 82,30,82,83,83 ; empty,..,inchain,pchain,punchain
   dc.b 83,81,88,0,0 ; pinchain,s!,bstart,fast,slow
   dc.b 8,8,8,8,8 ; start,pushs,pushv,pushc,display
   dc.b 17,84,84,84,84 ; dir,&(,&,&),&setof
   dc.b 85,85,85,85,85 ; set+,set*,set-,card,set=
   dc.b 85,84,84,84,84 ; setin,elmt@,elmt+,elmt-,elmtin   
   dc.b 85,85,84,-1,37 ; initset,pads,&segment,[&],f+
   dc.b 37,37,37,37,37 ; f-,f*,f/,fdup,fdrop
   dc.b 30,37,-1,37,37 ; f.,fval,[fl],fswap,fover
   dc.b 30,37,37,37,37 ; f..,&float,f@,f!,f=
   dc.b 37,37,37,37,37 ; f>,sqr,fabs,pi,sin
	dc.b 37,37,37,37,37 ; cos,tan,atan,fneg,1/x
	dc.b 37,37,37,37,37 ; x^2,exp,log,ftoi,itof
	dc.b 37,37,37,37,37 ; sincos,x^y,int,frac,f*2^n
	dc.b 37,37,37,37,37 ; round,fsign,f>r,r>f,frot
	dc.b 37,37,37,37,37 ; fpick,asin,acos,cosh,sinh
	dc.b 37,37,37,37,37 ; tanh,atanh,asinh,acosh,f<>
	dc.b 37,37,37,66,66 ; f>=,f<=,f<,str>,flt>
	dc.b 66,66,66,66,66 ; set>,struc>,>int,>str,>flt
	dc.b 66,66,27,0,0 ; >set,>struc,cmove,vqt_devinfo,vm_filename
   dc.b 0,0,39,39,39 ; v_meta_extents,vm_pagesize,stallot,ttallot,play
   dc.b 6,6,6,7,81 ; <>of,>of,<of,&wvar,setable
   dc.b 7,-1,88,0,88 ; &warray,[war],buf,setdigits,buf0
   dc.b 8,86,86,86,86 ; getfmt,->,and->,->.,or->
   dc.b 11,0,0,0,15 ; pageclip,v_ftext,v_clear_disp_list,v_updwk,&stack
   dc.b 15,15,15,15,11 ; >st,st>,current,stack0,&page
   dc.b 11,11,0,0,0 ; defpage,setpage,absolute,relative,fastclose
   dc.b 11,0,0,0,0 ; page0,fastopen,desk,cache,menu
   dc.b 0,0,0,0,0 ; setmenu,gemindex,strindex,dialogue,lastobj
   dc.b 0,0,0,0,0 ; child<<,>>,BOX,IBOX,BOXCHAR
   dc.b 0,0,0,0,0 ; BUTTON,STRING,TITLE,TEXT,BOXTEXT
   dc.b 0,0,0,0,0 ; FTEXT,FBOXTEXT,IMAGE,USERDEF,get_xywh
   dc.b 0,0,0,0,0 ; set_redraw,redraw,work_out,get_xyxy,vst_arbpt
   dc.b 0,0,0,0,10 ; vqt_f_extent,vst_setsize,vst_skew,ICON,mfdbs
   dc.b 10,10,10,10,89 ; mfdbd,vr_trnfm,vrt_cpyfm,vro_cpyfm,top>
   dc.b 89,39,0,39,39 ; >top,setplay,path,loadbin,savebin
   dc.b 0,0,0,0,0 ; setreplay,replay,savevdipal,setvdipal,replay_end
   dc.b 0,0,0,0,11 ; &cookie,vm_coords,v_opnwk,v_clswk,page
   dc.b 88,88,0,0,0 ; import,export,v_alpha_text,v_bez,v_bez_fill
   dc.b 0,0,0,0,0 ; v_bez_off,v_bez_on,v_bez_qual,v_bit_image,v_fulshcache
   dc.b 0,0,0,0,0 ; v_fontinit,v_form_adv,v_ftext16,v_ftext_offset,v_ftext_offset16
   dc.b 0,0,0,0,0 ; v_getbitmap_info,v_getoutline,v_get_pixel,v_loadcache,v_output_window
   dc.b 0,0,0,0,21 ; v_pgcount,v_savecache,v_set_app_buff,v_write_meta,vex_butv
   dc.b 21,21,0,0,21 ; vex_curv,vex_motv,vq_extnd,vq_gdos,vq_mouse
   dc.b 0,0,0,0,0 ; vq_scan,vqt_advance32,vqt_advance,vqt_cachesize,vqt_f_extent16
   dc.b 0,0,0,0,0 ; vqt_fontheader,vqt_get_table,vqt_pairkern,vqt_trackkern,vst_arbpt32
   dc.b 0,0,0,0,0 ; vst_charmap,vst_error,vst_kern,vst_scratch,vst_setsize32
   dc.b 0,0,0,0,0 ; form_button,form_keybd,fsel_exinput,menu_attach,menu_istart
   dc.b 0,0,0,0,0 ; menu_popup,menu_settings,objc_add,objc_delete,objc_order
   dc.b 0,0,0,24,0 ; objc_sysvar,rsrc_obfix,rsrc_rcfix,wind_new,basepage
   dc.b 0,89,75,38,38 ; _app,reserve,nvmaccess,&wdial_create,wdial_open
   dc.b 38,38,38,38,0 ; wdial_close,wdial_formdo,wdial_change,wdial_evnt,vq_margin
   dc.b 0,0,0,0,0 ; vq_driver_info,vq_bit_image,vs_page_info,vs_crop,vq_image_type
   dc.b 12,79,31,33,33 ; #nul_char,trace_win,>include,>true,>false
   dc.b 32,32,0,33,33 ; >export,>exec,>prgflags,>ifflag,>endf
   dc.b 1,1,1,1,0 ; solve,gauss,maximum,minimum,_fpu
   dc.b 36,36,36,0,0		; gr3_axes,gr3_grid,gr3_view,appl_trecord,appl_getinfo
   dc.b 0,82,0,83,88 ; appl_search,islast,appl_tplay,pempty,writeb
   dc.b 0,0,85,85,66 ; ltype,pal2xbios,set!,-set,int>
   dc.b 25,25,36,36,36 ; >=,<=,gr_area,gr3_z(xy)l,gr3_z(xy)f
   dc.b 36,37,37,48,0		; gr3_rot,>rad,>deg, sndb, bstr
   dc.b 0,0,0,0,0				; getfile, getpath, >ask, rsc2for, getradio
   dc.b 0,0,0,0,0				; gem_list, assign_array, highw,loww,highb
   dc.b 0,0,68,68,68			; lowb,fasthdl,ddate,dofw,date+
   dc.b 29,0,0,0,53			; gem_input,>accname,unpackdate,packdate,>fom
   dc.b 0,0,0,0,0				; resize_list,language,>ifflag2,lambert,lambert1
	dc.b 66,66,0,79,0			; >line,line>,change.ext,watch,argc
	dc.b 0,27,89,0,0			; argv,sizef,"f,",sign,isqr
	dc.b 79,0,0,0,0			; illegal,irandom,irandomize,gr_pie,gr_hpie
	dc.b 11,0,0,0,27			; setmargin,tovdi,toaes,gr_bar,size?
	dc.b 0,0,0,0,0				; gr_barg,gr_sbar,gr_sbarg,gr_bar_hlabel,gr_bar_vlabel
	dc.b 0,0,0,0				; gr_bar_title,gr_pie_label,gr_hpie_label,newin
	even
max_help_page: dc.l 91

adresse:
 dc.l empile,vayab,const,array,string,charray,table,thvayab,ret2,raff,dup2
 dc.l depth,drop,dup,over,pick,rzer,roll,rot,rpinit,wdmod
 dc.l rpaff,s0,spinit,wmod,spaff,swap,mul,mulw,wdiv,plus
 dc.l plm,moins,div,divm,inf0,eg0,sup0,sup,inf,egal
 dc.l plus1,moins1,plus2,moins2,mul2,div2,abs,and,max,min
 dc.l mod,neg,not,or,xor,loop,looppls,do,again,begin
 dc.l until,while,repeat,exit,case,of,else,endcase,if,else
 dc.l then,appl_find,i,j,k,leave,virg,0,pvirg,allot
 dc.l chsto,chplus,chegal,chinf,chsup,asc,bbase,chr,decimal,hex
 dc.l instr,len,left,mid,mlen,ppad,right,str,append,val
 dc.l sto,stop,stom,stop1,stom1,trace,untrc,aff,rcl,selplus
 dc.l carsto,carrcl,0,cls,addrsto,forget,selmoins,bin,here,dupm
 dc.l dropm,fin,vlist,point,term,bl,cr,emit,expect,inkey
 dc.l input,inputc,key,spc,spcs,type,quit,disply,chain,var1
 dc.l cons1,arr1,str1,char1,tab1,qt1,timer,dif,free,full
 dc.l pilaf,allot0,does,0,doesa,ifloop,edit,eval,bsize
 dc.l stform,diese,hold,dieses,edform
 dc.l call,loadb,saveb,lmax,bfinit,compilb,0,top
 dc.l aess,vdii,ctrl,iin,pin,iout,pout,ain,aout,wrcl
 dc.l wsto,hdl,vctrl,actrl,seizeb,vint,ptinsto,aint,gmds,bioss
 dc.l xbioss,wvirg,ebw,ebl,ewl,puts,gets,fcr,fop,fcl
 dc.l frd,fwr,fgd,fdl,ffs,fnx,dta,fsd,fsk,fsk1
 dc.l fsk2,xv_opnwk,xv_updwk,_global,vq_aes,vsync,joyst,mouse,jx0,jy0
 dc.l fire0,jx1,jy1,fire1,mousx,mousy,mousk,hadr,super,user
 dc.l v_opnvwk,vst_load_fonts,vst_unload_fonts,vs_clip,v_pline,v_pmarker
 dc.l v_gtext,v_fillarea,v_contourfill,v_recfl,vswr_mode
 dc.l vs_color,vsl_type,vsl_udsty,vsl_width,vsl_color
 dc.l vsl_ends,vsm_type,vsm_height,vsm_color,vst_height
 dc.l vst_point,vst_rotation,vst_font,vst_color
 dc.l vst_effects,vst_alignment,vsf_interior,vsf_style
 dc.l vsf_color,vsf_perimeter,vsf_udpat,vsc_form,vex_timv
 dc.l v_show_c,vq_color,vqt_extent,vqt_width,vqt_name
 dc.l v_clsvwk,v_clrwk,v_hide_c,vq_key_s,vql_attributes
 dc.l vqm_attributes,vqf_attributes,vqt_attributes
 dc.l vqt_fontinfo,v_bar,v_arc,v_pieslice,v_circle
 dc.l v_ellipse,v_ellarc,v_ellpie,v_rbox,v_rfbox
 dc.l v_justified,vq_chcells,v_exit_cur,v_enter_cur
 dc.l v_curup,v_curdown,v_curright,v_curleft,v_curhome
 dc.l v_eeos,v_eeol,vs_curaddress,v_curtext,v_rvon
 dc.l v_rvoff,vq_curaddress,vq_tabstatus,v_hardcopy
 dc.l _appl_init,graf_handle,evnt_keybd
 dc.l rsrc_free,wind_get,_wind_create,_wind_open,wind_delete
 dc.l _wind_set,wind_find,_wind_update,_wind_calc
 dc.l evnt_button,evnt_mouse,evnt_timer,form_error
 dc.l _wind_close,graf_rubberbox,graf_dragbox,graf_movebox
 dc.l graf_growbox,graf_shrinkbox,graf_mkstate,evnt_dclick
 dc.l evnt_mesag,evnt_multi,appl_read,appl_write
 dc.l objc_draw,objc_find,objc_offset,objc_edit
 dc.l objc_change,rsrc_load,rsrc_saddr,form_do,form_dial
 dc.l form_center,form_alert,menu_icheck,menu_ienable
 dc.l menu_tnormal,menu_register,graf_watchbox,graf_slidebox
 dc.l graf_mouse,scrp_read,scrp_write,shel_get,shel_put
 dc.l shel_find,rsrc_gaddr,menu_text,fsel_input
 dc.l shel_read,shel_write,shel_envrn,format
 dc.l menu_bar,xcut,xplus
 dc.l fin,pterm,ptermres
 rept 25
   dc.l blockgds
 endr
 rept 11
   dc.l blockbs
 endr
 rept 28
   dc.l blockxbs
 endr
 dc.l st,ass1,tt,count,pair,sizeb,sizeb,sizew,sizel
 dc.l timera,timerb,timerc,timerd,timer_calc
 dc.l sc_load,sc_unload,sc_dma,sc_boot,sc_sendm,sc_getm
 dc.l sc_exec,sc_xsendm,sc_xgetm,sc_xsendb,sc_xgetb,sc_adr
 dc.l sc_check,sc_status,ifsto,ifrcl,isto,ircl,iwsto,iwrcl
 dc.l aligne,ver,screen_info
 dc.l sizeb,sizew,sizel,rcl_ind,sto_ind,uhpt,ubpt
 dc.l modset,modload,modunload,modsname,modlname,modver
 dc.l modfmt,modtype,modinfo,modpal,modexe,fillmfdb
 dc.l fopsize,imagesize,dorim,dowim,doifx,dotrm
 dc.l graphic_card,modmload,modmunload,0,0
 dc.l savebitmap,loadbitmap,rsrc_mono,datetostr,strtodate
 dc.l timetostr,strtotime,tgetdate,tgettime,tsetdate,tsettime
 dc.l setsubpage,getsubpage,thread,thnext,thkill,thpause
 dc.l thwake,thrun,thid,thsync,thsyncmain,thnsync
 dc.l thkillall,thstat,st3,ret1,thv1,vthread
 dc.l helpw,guide,vd_set,vd_info,vd_play,vd_create
 dc.l vd_frame,vd_sign
 dc.l gr_yx,gr_xyt,gr_rt,gr_window,gr_axes,gr_grid
 dc.l gr_getpoint,gr_plot2,gr3_window,gr3_xyzt,gr3_plot
 dc.l vdisto,aessto,pre1,pre2,pre3,pre4
 dc.l post1,post2,post3,post4,siz,cvirg,wmulsto,wdivsto,mulsto2
 dc.l divsto2,deces,segferme,segouvert,word,0,ndo,nloop,list,dolist
 dc.l lloop,remember,restore,fff,fff1,bpt,dpt,opt,hpt,struct,pointer
 dc.l name,sizeof,schain,unchain,next,previous,screate,sdel,empty
 dc.l view,inchain,pchain,punchain,pinchain,ssto,bstart,fast,slow
 dc.l start,pushs,pushv,pushc,display,dir,ouvert,et,ferme,setof
 dc.l setplus,setfois,setmoins,card,setegal,setin,elmtrcl,elmtplus
 dc.l elmtmoins,elmtin,initset,pads,segment,et1
 dc.l fplus,fmoins,ffois
 dc.l fdiv,fdup,fdrop,fpt,fval,empilfl,fswap,fover,fptpt,float
 dc.l frcl,fsto,fegal,fsup,sqr,fabs,pee,sin,cos,tan,atn,fneg,inv
 dc.l carre,expo,loga,flint,intfl,sincos,power,int,frac
 dc.l ffois2,round,fsign,fsurr,rsurf,frot,fpick
 dc.l asin,acos,cosh,sinh,tanh,atanh,asinh,acosh
 dc.l fdiff,fsupegal,finfegal,finf
 
 dc.l pstr,pflt,pset,pstruc
 dc.l rint,rstr,rflt,rset,rstruc,cmove,vqt_devinfo,vm_filename
 dc.l v_meta_extents,vm_pagesize
 dc.l stallot,ttallot,play,difof,supof,infof,wvar,setable
 dc.l warray,war,buf,setdigits,buf0,getfmt,fleche,andfl,andorpt,orfl
 dc.l pageclip,v_ftext,v_clear_disp_list,v_updwk,stack,st1,st2,current,stack0
 dc.l page,defp,setp,absolute,relative,fastcl,page0,fastop,desk,cache
 dc.l menu,setmenu,gemindex,strindex,dialogue,lastobj,child,parent
 rept 6
   dc.l objets
 endr
 rept 4
   dc.l boxtext
 endr
 dc.l image,userdef,get_xywh,set_redraw,_redraw,_work_out,get_xyxy,vst_arbpt
 dc.l vqt_f_extent,vst_setsize,vst_skew,icon,mfdbs,mfdbd,vr_trnfm,vrt_cpyfm,vro_cpyfm
 dc.l topsur,surtop,setplay,path,loadbin,savebin,setreplay,replay,savevdipal
 dc.l setvdipal,replay_end,cookie,vm_coords,v_opnwk,v_clswk,_page,import
 dc.l export,v_alpha_text,v_bez,v_bez_fill,v_bez_off,v_bez_on,v_bez_qual
 dc.l v_bit_image,v_fulshcache,v_fontinit,v_form_adv,v_ftext16,v_ftext_offset
 dc.l v_ftext_offset16,v_getbitmap_info,v_getoutline,v_get_pixel,v_loadcache
 dc.l v_output_window,v_pgcount,v_savecache,v_set_app_buff,v_write_meta
 dc.l vex_butv,vex_curv,vex_motv,vq_extnd,vq_gdos,_vq_mouse,vq_scan
 dc.l vqt_advance32,vqt_advance,vqt_cachesize,vqt_f_extent16,vqt_fontheader
 dc.l vqt_get_table,vqt_pairkern,vqt_trackkern,vst_arbpt32,vst_charmap
 dc.l vst_error,vst_kern,vst_scratch,vst_setsize32
 dc.l form_button,form_keybd,fsel_exinput,menu_attach,menu_istart,menu_popup
 dc.l menu_settings,objc_add,objc_delete,objc_order,objc_sysvar,rsrc_obfix
 dc.l rsrc_rcfix,wind_new,basepage,_app,reserve,nvmaccess,wdial_create,wdial_open
 dc.l wdial_close,wdial_formdo,wdial_change,wdial_evnt
 dc.l vq_margin,vq_driver_info,vq_bit_image,vs_page_info
 dc.l vs_crop,vq_image_type,nul_char,_trace_win,0,0,0,0,0,0,0	; >include … >ifflag
 dc.l 0	; >endf
 dc.l solve,gauss
 dc.l maximum,minimum
 dc.l _fpu,gr3_axes,gr3_grid,gr3_view
 dc.l appl_trecord,appl_getinfo,appl_search,islast,appl_tplay,pempty
 dc.l writeb,ltype,pal2xbios,setsto,compset,pint,supegal,infegal
 dc.l gr_area,gr3_zxyl,gr3_zxyf,gr3_rot,torad,todeg,sndbadr,bstr
 dc.l getfile,getpath,0,rsc2for,getradio,gemlist,assign_array ; 0 = >ask
 dc.l highw,loww,highb,lowb,fasthdl,ddate,dofw,datep,gem_input,0 ; 0=>accname
 dc.l unpackdate,packdate,0,resize_list,language,0	; 0=>fom,>ifflag2
 dc.l lambert,lambert1,rline,pline,changeext,watch,argc,argv,sizef
 dc.l fvirg,sign,isqr,illeg,irandom,irandomize,gr_pie,gr_hpie,setmargin
 dc.l tovdi,toaes,gr_bar,sizei,gr_barg,gr_sbar,gr_sbarg
 dc.l gr_bar_hlabel,gr_bar_vlabel,gr_bar_title,gr_pie_label,gr_hpie_label
 dc.l newin

	; … partir d'ici on a environ 10+461 LONGs pour 471 mots de plus.
	if STE=0
adrfin: dcb.l 10,0
	else
adrfin: dcb.l 9,0
	endif

diko equ (adrfin-adresse)/4

; flags dans le fichier INI:
; lettre Wnnn = nnn% de l'‚cran pour la fenetre, d‚faut full screen
; lettre M = Mouse On, sinon, souris effac‚e par d‚faut.
; lettre F = mode fast, depuis 0.2.2 mode slow par d‚faut
; lettre B = vecteurs bombes laiss‚s au systŠme, d‚tourn‚s par d‚faut
; lettre Annn = masque de bits sur les diff‚rentes alertes
;					bit0 = signaler si fichier FOR/TXT existe quand on ‚crit dessus
;				   bit1 = signaler si un bloc marqu‚ lorsqu'on sauve
; lettre Lnnn = langage n (utilis‚ pour le format de date)
; lettre S = pas standard (comme mon ".s" … l'envers)


read_flags:
	sf mouse_on
	cmp.b #'#',(a6)+
	bne .exit			; pas de #? pas de flags!
.encore:
	move.b (a6)+,d0
	cmp.b #33,d0
	bmi.s .fin			; fin de ligne?
	or.b #32,d0			; minuscule
	cmp.b #'w',d0
	bne.s .lb0
	bsr.s .get_number
	tst d1
	beq.s .encore			; refuser z‚ro
	move d1,screen_percent	; sinon, pourcentage valid‚
	bra.s .encore
.lb0:
	cmp.b #'m',d0
	bne.s .lb1
	st mouse_on
	bra.s .encore
.lb1:
	cmp.b #'f',d0
	bne.s .lb2
	move #1,isfast		; defaut slow mode, f=fast
	bra.s .encore
.lb2:
	cmp.b #'b',d0
	bne.s .lb3
	clr isbomb			; defaut d‚tourner bombes, si B, on laisse
	bra.s .encore
.lb3:
	cmp.b #'a',d0
	bne.s .lb4
	bsr.s .get_number
	move d1,alert_mask
	bra.s .encore
.lb4:
	cmp.b #'l',d0
	bne.s .lb5
	bsr.s .get_number
	move d1,langage	; cela peut recouvrir la valeur trouv‚e dans la ROM
	bra.s .encore
.lb5:
	cmp.b #'s',d0
	bne.s .lb6
	sf standard			; annule les routines standard
	bra.s .encore
.lb6:
	bra.s .encore
.fin:
	cmp.b #33,(a6)+	; avance jusqu'… la ligne suivante
	bmi.s .fin
.exit:
	subq.l #1,a6
	rts
.get_number:			; for parameters with a number, D1=value
	moveq #0,d1
.next_digit:
	move.b (a6)+,d0
	sub.b #'0',d0
	bmi.s .end_size
	cmp.b #9,d0
	bgt.s .end_size
	muls #10,d1
	add d0,d1
	bra.s .next_digit
.end_size:
	subq.l #1,a6
	rts

alloc_edit:
	tst d7
	bmi.s .defaut
	move.b (a6)+,d0
	cmp.b #'%',d0
	bne.s .defaut
	moveq #0,d6
.lb1:
	move.b (a6)+,d0
	beq.s .defaut
	cmp.b #"+",d0
	beq.s .suite
	cmp.b #"-",d0
	beq.s .suite
	cmp.b #13,d0
	beq.s .defaut
	cmp.b #10,d0
	beq.s .defaut
	muls #10,d6
	sub.b #'0',d0
	add.b d0,d6
	bra.s .lb1
.suite:
	moveq #0,d5
.lb2:
	move.b (a6)+,d1
	beq.s .defaut
	cmp.b #13,d1
	beq.s .fin
	cmp.b #10,d1
	beq.s .fin
	muls #10,d5
	sub.b #'0',d1
	ext.w d1
	ext.l d1
	add.l d1,d5
	bra.s .lb2
.fin:
	cmp.b #'+',d0
	beq.s .fin2
	neg.l d5
.fin2:
	rts
.defaut:
	moveq #-1,d7
	moveq #17,d6
	moveq #0,d5
	rts

alloc_dicco:
	tst d7
	bmi.s .defaut
.lb0:
	move.b (a6)+,d0
	beq.s .defaut		; pas normal
	cmp.b #'%',d0
	bne.s .lb0
	moveq #0,d6
.lb1:
	move.b (a6)+,d0
	beq.s .defaut
	cmp.b #"+",d0
	beq.s .suite
	cmp.b #"-",d0
	beq.s .suite
	cmp.b #13,d0
	beq.s .defaut
	cmp.b #10,d0
	beq.s .defaut
	muls #10,d6
	sub.b #'0',d0
	add.b d0,d6
	bra.s .lb1
.suite:
	moveq #0,d5
.lb2:
	move.b (a6)+,d1
	beq.s .defaut
	cmp.b #13,d1
	beq.s .fin
	cmp.b #10,d1
	beq.s .fin
	muls #10,d5
	sub.b #'0',d1
	ext.w d1
	ext.l d1
	add.l d1,d5
	bra.s .lb2
.fin:
	cmp.b #'+',d0
	beq.s .fin2
	neg.w d5
.fin2
	rts
.defaut:
	moveq #-1,d7
	moveq #75,d6
	moveq #0,d5
	rts

copie_chemins:
	lea chemin,a0
	lea chetxt,a1
	lea chehlp,a2
	lea chedef,a3
.lb0:
	move.b (a6)+,d0		; chemin FOR
	beq .defaut
	cmp.b #32,d0
	bmi.s .lb0
	subq.l #1,a6
.lb1:
	move.b (a6)+,d0
	beq .defaut
	cmp.b #13,d0
	beq.s .suite
	cmp.b #10,d0
	beq.s .suite
	move.b d0,(a0)+
	move.b d0,(a3)+		; DEF = FOR
	bra.s .lb1
.suite:
	clr.b (a0)			; marque la fin de FOR
	clr.b (a3)
	move.b #'F',-(a3)
	move.b #'E',-(a3)
	move.b #'D',-(a3)
.lb2:
	move.b (a6)+,d0	; chemin TXT
	beq .defaut
	cmp.b #32,d0
	bmi.s .lb2
	subq.l #1,a6
.lb3:
	move.b (a6)+,d0
	beq.s .fin
	cmp.b #13,d0
	beq.s .fin
	cmp.b #10,d0
	beq.s .fin
	move.b d0,(a1)+
	bra.s .lb3
.fin:
	clr.b (a1)		; marque la fin de TXT
.lb4:
	move.b (a6)+,d0	; chemin HELP
	beq.s .defaut
	cmp.b #32,d0
	bmi.s .lb4
	subq.l #1,a6
.lb5:
	move.b (a6)+,d0
	beq.s .fin2
	cmp.b #13,d0
	beq.s .fin2
	cmp.b #10,d0
	beq.s .fin2
	cmp.b #',',d0
	beq.s .lb8
	cmp.b #';',d0
	beq.s .lb8
	move.b d0,(a2)+
	bra.s .lb5
.fin2:
	moveq #0,d0
.lb8:
	lea .lb7(pc),a0
	cmp.b #'\',-1(a2)	; teste si le slash  est d‚j…
	bne.s .lb6
	addq.l #1,a0
.lb6:
	move.b (a0)+,(a2)+	; ajoute \FORTH.HLP au chemin
	bne.s .lb6
	subq.l #3,a2
	move.l a2,hlpptr		; pointeur pour changer Y ou L dans HYP et HLP
	tst.b d0
	beq.s .exit				; si d0=0, pas de chaine pour le programme STGUIDE/HYPVIEW
	lea chestg,a2
.lb9:
	move.b (a6)+,d0		
	beq.s .fin3
	cmp.b #13,d0
	beq.s .fin3
	cmp.b #10,d0
	beq.s .fin3
	move.b d0,(a2)+
	bra.s .lb9
.fin3:
	clr.b (a2)		; marque la fin	
.exit:
	rts
.defaut:
	lea chemin,a0
	lea chetxt,a1
	lea chedef,a3
	move.l #'\*.F',(a0)+
	move.w #'OR',(a0)+
	clr.b (a0)
	move.l #'\*.D',(a3)+
	move.w #'EF',(a3)+
	clr.b (a3)
	move.l #'\*.T',(a1)+
	move.w #'XT',(a1)+
	clr.b (a1)
	lea chehlp,a2
	lea .lb7+1(pc),a0
	moveq #0,d0
	bra.s .lb6
.lb7: dc.b "\FORTH.HLP",0	; modifiable en HYP

	even

initial:
   move.l  4(a7),a5
   move.l a5,bspage           ; basepage rang‚e
   move.l #-1,_app_flag 		; pas un accessoire
   move.l $18(a5),d0
   add.l $1c(a5),d0
   add.l #$1100,d0
   and.b #$FC,d0					; multiple de 4 !
   move.l d0,sp
   lea -128(sp),sp				; de la marge en cas de foutoir
   sub.l a5,d0
   move.l  d0,-(sp)
   move.l  a5,-(sp)
   clr -(sp)
   GEMDOS $4a,12              ; r‚duit l'espace
   GEM_AES appl_init
   GOSUB aes_info					; teste la version et ses possibilit‚s
; 	bsr detect_aes
   GEM_AES graf_hand
   move.l intout+2,fenetre0+12  ; l et h d'un caractŠre.
   move intout,d7
   move d7,i_handle
   move d7,g_handle
   XBIOS 4,2
	add d0,ow_int              ; getrez+2
	GEM_VDI open_work          ; station interne (avec vsf_color … z‚ro)
   move ow_cont+12,d6         ; garde le handle interne au FORTH
   move #1,ow_int+18				; remet vsf_color … 1 pour l'utilisateur
   GEM_VDI open_work          ; station pour l'utilisateur
   move ow_cont+12,handle
   move d6,i_handle
   GEM_VDI hide_mouse

   moveq #1,d0						; allow direct access
   moveq #1,d5						; allow AES calls
   jsr ScreenEncoding
   move.l d0,code_ecran
   move.l d1,gcard				; 0 SHIFTER, 1 VDI en liaison avec les modules M&E

	; jsr debug
	
   clr.b edbuf
   lea edsav,a0
   clr.w (a0)						; 0 + 0 si pas d'autoexec et 0 + FF si tester autoexec
   clr.w 512(a0)
   clr.w 1024(a0)
   clr.w 1536(a0)
	clr.w edoffset					; pointe sur le premier buffer
		
	lea chedef,a0
	lea info(pc),a1
.lb0:
	move.b (a1)+,(a0)+			; copie FORTH.INF
	bne.s .lb0
	GEM_AES shel_find2				; et le cherche !
   clr -(sp)
	tst intout
	beq.s .lb00						; pas trouv‚, tenter quand mˆme le nom seul
	pea chedef					; sinon, trouv‚ et on met le chemin complet
	bra.s .suite
.lb00:	
   pea info(pc)
.suite:   
   GEMDOS 61,8						; fopen 'FORTH.INF'
   lea pad+2,a6
   move d0,d7						; handle
   bmi.s .pas_inf
   move.l a6,-(sp)
   move.l #1024,-(sp)			; 1028 octets maxi!
   move d7,-(sp)
   GEMDOS 63,12					; fread
   tst.l d0
   bmi.s .pas_inf
   clr.b 0(a6,d0.l)				; ajoute un z‚ro
   move d7,-(sp)
   GEMDOS 62,4						; fclose!
   lea .auto(pc),a0
   lea edbuf,a1
.lb3:
	move.b (a0)+,(a1)+
	bne.s .lb3
	st edsav+1				; FF pour marquer ce premier appel
   bra.s .lb1
.auto: dc.b "9 >include ",34,"%AUTOEXEC.FOR",34,0
	even
.pas_inf:
	moveq #-1,d7
.lb1:
	bsr read_flags					; quelques r‚glages par d‚faut
	bsr alloc_edit					; renvoit dans D6 le pourcentage
										; dans d5 le + ou - kilo octets
.encore:

	; jsr debug
	
   move.l  #-1,-(sp)          ; taille maxi
   GEMDOS $48,6
   moveq #12,d1
   lsr.l d1,d0
;   ext.l d0
	divs #25,d0					; d6% du total
	muls d6,d0
	add.l d5,d0						; + d5 kilo
   cmp.l #520,d0
   bmi.s .premier
   move.l #520,d0               ; mais limit‚ … 520 ko de source
.premier:
	moveq #10,d1
   lsl.l d1,d0                ; retour en octets
   move.l  d0,bfsize          ; taille buffer
   move.l  d0,-(sp)
   GEMDOS $48,6               ; allocation
   move.l  d0,beuf
   bpl.s .ok1
   moveq #17,d6
   moveq #0,d5						; sinon, retour … 17% et rien de plus
   bra.s .encore
.ok1:
   move.l  d0,bfptr           ; adresse gard‚e
   move.l  d0,a0
   clr (a0)                   ; 0 sur la premiŠre ligne
	bsr alloc_dicco				; renvoit d6 et d5 (% et +/-)
.encore2:
   move.l  #-1,-(sp)          ; taille restante
   GEMDOS $48,6
   moveq #10,d1
   lsr.l d1,d0
	divs #100,d0					; d6% du total
	muls d6,d0
	add.l d5,d0						; + d5 kilo
   lsl.l d1,d0                ; retour en octets
   move.l  d0,d6              ; on garde la taille
   move.l  d0,-(sp)
   GEMDOS $48,6               ; alloue le bloc dicco
   move.l  d0,program         ; on garde l'adresse
   move.l d0,debut_prog
   bpl.s .ok2
   moveq #75,d6					; sinon, 75%
   moveq #0,d5						; plus rien
   bra.s .encore2
.ok2:
	move.l d6,size_prog
   move.l  d0,topprg          ; dicco vide, on pointe au d‚but
   add.l d0,d6                ; fin du dico
   subq.l #4,d6
   move.l  d6,topmem          ; pour la gestion de l'allocation dynamique
   move.l  d6,botmem
   move.l  #1028,-(sp)        ; bloc pour la gestion dynamique
   GEMDOS $48,6
   move.l  d0,a0
   move.l  d0,szone           ; gard‚ dans szone
   clr.l (a0)+                ; aucun libre ni occup‚
   clr.l (a0)+
   moveq #-1,d0               ; fin de bloc
   move.l  d0,(a0)
   bsr copie_chemins				; celui des *.FOR et *.TXT , *.DEF et HLP!
   move #1024,pad             ; taille de la chaine
   move #3,-(sp)
   move #15,-(sp)
   XBIOS 35,6           ; ralentit la r‚p‚tition du clavier
   lea ordres,a0        ; les mots du forth
   moveq #0,d1
   moveq #0,d2
.labell: move.b (a0)+,d2  ; taille du mot
   beq.s .label1          ; si 0, c'est fini
   addq #1,d1             ; sinon, un mot de plus
   add.l d2,a0            ; au suivant
   bra.s .labell
.label1: move d1,dicco    ; nombre de mots dans dicco
   move d1,forth          ; nombre de mots de base
   subq.l #1,a0           ; revient sur le z‚ro final
   move.l a0,sommet       ; c'est l… qu'on placera le mot suivant

	; jsr debug
	
   jsr read_cookies		; _MCH, _SND, _CPU, _APK

   clr def
   GEM_AES mouse_form
   clr.l remdata
   XBIOS 34,2				  ; kbdvbase
   move.l d0,a0
   lea 24(a0),a0
   move.l a0,joystick	  ; adresse ou mettre notre routine en cas de joyst
   move.l (a0),old_joyst  ; conserve l'ancien pointeur
   move.l -8(a0),old_mouse	; idem pour la souris (pour capter mousek=2)
   move.l  a7,uspile      ; garde la pile en cas de plantage
   clr.l -(sp)
   GEMDOS 32,6            ; superviseur
   move.l $4f2.w,a0       ; d‚but ROM
   move 2(a0),d4          ; version
	cmp #$0100,d4
	beq.s .lb2
	move.l 36(a0),kbshift	; pour TOS>1.00 on actualise la variable
.lb2:
	tst langage
	bpl.s .lb4					; d‚j… modifi‚ par FORTH.INI
	move 28(a0),d1				; os_conf
	lsr #1,d1					; enlŠve le bit du mode video
	cmp #127,d1					; tous langages?
	bne.s .lb5					; non, donc c'est le bon code
	move.l apk_value,d1		; si! aller voir dans APK
	lsr #8,d1
.lb5:
	move d1,langage
.lb4:
	
	; jsr debug

	tst isbomb
	beq.s .no_detour

   move.w #8,a0
   move.l #vectbuf,a1
   move.l (a0),(a1)+
   move.l #gloups2,(a0)+
   move.l (a0),(a1)+
   move.l #gloups3,(a0)+
   move.l (a0),(a1)+
   move.l #gloups4,(a0)+
   move.l (a0),(a1)
   move.l #gloups5,(a0)

.no_detour:

   jsr nova_init

	
   move.l d0,-(sp)
   GEMDOS 32,6           ; mode USER
	move #9,fixn          ; 9 chiffres pour l'affichage r‚el

   if STE=1
   	jsr test_fpu
   endif
	jsr test_mxalloc

	jsr version_init

	moveq #-4,d0			; FC !
	and.b d0,retptr+3	; multiple de 4
	and.b d0,pilbase+3
	lea pilptr,a6
	and.b d0,3(a6)		; multiple de 4
   move.l (a6),a6			; pile
   jsr get_xylh
   jsr fastcreate
   jsr fastopen         ; ouvre une fenetre sur tout l'‚cran ou % selon flag
   
   ; jsr debug
   
   jsr init_thread0

   jsr le_menu

   moveq #-3,d0			 ; 3 lignes … parir du bas
   moveq #3,d1				 ; 3 lignes en tout
   jsr trace_window		 ; pr‚pare la fenˆtre pour TRACE

   tst mint_flag
   beq.s .monotache
   GEM_AES menu_reg      ; nom de l'application dans le menu MINT
.monotache:
	bsr init_ptr			 ; les pointeurs d'inclusion ou de compilation
	jsr souris_visible
	pea dtabuf
	GEMDOS 26,6				 ; fixe ma DTA, libŠre la ligne de commande
	jsr init_argv
	move.l _argv+4,d0		 ; premier argument de commande
	beq.s .sortie			 ; pas de chaine, rien … charger
	move.l d0,a0
   move.l a0,a1
.lb7:
	tst.b (a1)+				 ; cherche fin de chaine
	bne.s .lb7
	move.l a1,d0
	sub.l a0,d0				 ; taille chaine+0
	subq #1,d0
	beq.s .sortie			 ; chaine nulle, on sort
   ext.w d0
   lea 0(a0,d0.w),a1		 ; pointe sur la fin
.cherche_debut:			 ; ici on va chercher dans le chemin le d‚but du fichier
	cmp.l a0,a1
	beq.s .cd1
	move.b -(a1),d0
	cmp.b #':',d0
	beq.s .cd2
	cmp.b #'\',d0
	bne.s .cherche_debut
.cd2:
	addq.l #1,a1	
.cd1:
	move.l a1,addrin+4	 ; nom de fichier valable (pour l'affichage des stats)
   bsr lll7              ; charge le fichier
.sortie: 

	; jsr debug
	
	tst.b edbuf				 ; si 0, pas de fichier FORTH.INF avec chemins par d‚faut
	bne.s .autoexec
.annule:
	jmp debut				; donc on commence normalement
.autoexec:
   moveq #3,d0
   move.l kbshift,a0
   and.b (a0),d0			; une touche Shift appuy‚e?
   bne.s .annule			; oui, donc ne pas essayer AUTOEXEC.FOR
	jmp ici					; sinon, on essaye d'inclure AUTOEXEC.FOR

fin_new_adr:

	; initialement fonctions de 369 … 396
	; maintenant de 372 … 396
	; les trois premiers (pterm0/pterm/ptermres) ont ‚t‚ lib‚r‚s.
	; 4 octets par fonction:
	; - masque des paramŠtres 1=LONG, 0=WORD
	; - nombre de paramŠtres-1 (pour DBF)
	; - num‚ro fonction
	; - flag renvoyer D0 ou non
	
gblk: dc.b 0,-1,0,0,0,0,76,0,1,1,49,0,%1110,3,75,1,0,0,14,1,0,-1,25,1,1,0,59,1
      dc.b 1,1,71,1,1,1,54,0,1,0,57,1,1,0,58,1,%110,2,86,1,1,2,67,1,0,0,69,1
      dc.b 0,1,70,1,1,0,72,1,1,0,73,1,%110,2,74,1,0,-1,3,1,0,0,4,0,0,0,5,1
      dc.b 0,0,6,1,1,0,9,0,1,0,10,1,0,-1,11,1,0,-1,17,1,0,-1,18,1,0,-1,19,1

bblk: dc.b 0,0,1,1,0,0,8,1,0,0,2,1,0,1,3,0,%10,4,4,1,0,0,9,1,0,-1,10,1
      dc.b 1,0,0,0,0,0,7,1,0,0,11,1,%10,1,5,0

xblk: dc.b 0,-1,2,1,0,-1,3,1,0,-1,4,1,%11,2,5,0,1,0,6,0,0,1,7,0,%11,6,8,1
      dc.b %11,6,9,1,%11,6,19,1,%10,1,13,0,0,0,26,0,0,0,27,0,%1000,3,31,0
      dc.b 0,-1,34,1,%10,1,12,0,0,1,28,1,1,0,32,1,0,0,29,0,0,0,30,0,0,0,33,1
      dc.b 0,5,15,0,0,0,14,1,%110,2,0,0,%111,2,16,0,0,-1,24,0,0,1,35,1
      dc.b 0,-1,17,1,1,0,38,1

 data
 even

; puissances de 10 de 10^-1 … 10^-256

negdata:  dc.l $3fb99999,$9999999a
          dc.l $3f847ae1,$47ae147a
          dc.l $3f1a36e2,$eb1c432c
          dc.l $3e45798e,$e2308c38
          dc.l $3c9cd2b2,$97d889b7
          dc.l $3949f623,$d5a8a729
          dc.l $32a50ffd,$44f4a72d
          dc.l $255bba08,$cf8c9771
          dc.l $0ac80628,$64ac6ef7

; puissances de 10 de 10^1 … 10^256

posdata: dc.l $40240000,0
         dc.l $40590000,0
         dc.l $40c38800,0
         dc.l $4197d784,0
         dc.l $4341c379,$37e08000
         dc.l $4693b8b5,$b5056e16
         dc.l $4d384f03,$e93ff9f3
         dc.l $5a827748,$f9301d2e
         dc.l $75154fdd,$7f73bf33

; nombres r‚els de 1 … 9

chdata:  dc.w $3ff0,$4000,$4008,$4010,$4014,$4018,$401c,$4020,$4022

; donn‚es pour le CORDIC

cordk:  dc.l $3fe36e9d,$b5086bcb
        dc.l $3ff351e8,$7200eec2
pi:     dc.w $4009,$21fb,$5444,$2d18
pisur2: dc.w $3ff9,$21fb,$5444,$2d18

 even
ordres:
 dc.b 6,"[empl]",8,"variable",8,"constant",5,"array",6,"string"
 dc.b 6,"array$",5,"table",10,"thvariable",2,"r>",2,"r@",4,"?dup"
 dc.b 5,"depth",4,"drop",3,"dup",4,"over",4,"pick",2,"r0"
 dc.b 4,"roll",3,"rot",3,"rp!",5,"w/mod",3,"rp@",2,"s0",3,"sp!"
 dc.b 4,"wmod",3,"sp@",4,"swap",1,"*",2,"w*",2,"w/",1,"+",2,"+-"
 dc.b 1,"-",1,"/",4,"/mod",2,"0<",2,"0=",2,"0>",1,">",1,"<",1,"="
 dc.b 2,"1+",2,"1-",2,"2+",2,"2-",2,"2*",2,"2/",3,"abs",3,"and"
 dc.b 3,"max",3,"min",3,"mod",6,"negate",3,"not",2,"or",3,"xor"
 dc.b 4,"loop",5,"+loop",2,"do",5,"again",5,"begin",5,"until"
 dc.b 5,"while",6,"repeat",4,"exit",4,"case",2,"of",5,"endof"
 dc.b 7,"endcase",2,"if",4,"else",4,"then",9,"appl_find",1,"i",1,"j"
 dc.b 1,"k",5,"leave",1,44,1,":",1,";",5,"allot",2,"$!",2,"$+"
 dc.b 2,"$=",2,"$<",2,"$>",3,"asc",4,"base",4,"chr$",7,"decimal"
 dc.b 3,"hex",5,"instr",3,"len",5,"left$",4,"mid$",4,"mlen"
 dc.b 3,"pad",6,"right$",4,"str$",6,"append",3,"val",1,"!"
 dc.b 2,"+!",2,"-!",3,"1+!",3,"1-!",5,"trace",7,"untrace",1,"?"
 dc.b 1,"@",7,"select+",2,"c!",2,"c@",4,"find",3,"cls",7,"addrin!"
 dc.b 6,"forget",7,"select-",3,"bin",4,"here",4,"dupm",5,"dropm"
 dc.b 6,"system",5,"vlist",1,".",9,"?terminal",2,"bl",2,"cr",4,"emit"
 dc.b 6,"expect",5,"inkey",5,"input",6,"input$",3,"key"
 dc.b 5,"space",6,"spaces",4,"type",4,"quit",2,46,34,1,34
 dc.b 5,"[var]",5,"[cst]",5,"[arr]",5,"[str]",5,"[ar$]"
 dc.b 5,"[tab]",4,"[qt]",5,"timer",2,"<>"
 dc.b 4,"free",4,"full",2,".s",6,"allot0",6,":does>",4,";end"
 dc.b 7,"::does>",6,"ifloop",4,"edit",4,"eval",5,"bsize"
 dc.b 2,"<#",1,"#",4,"hold",2,"#s",2,"#>",4,"call",5,"loadb"
 dc.b 5,"saveb",4,"lmax",4,"buf!",7,"compilb",5,">comp",3,"top"
 dc.b 3,"aes",3,"vdi",7,"control",5,"intin",5,"ptsin",6,"intout"
 dc.b 6,"ptsout",6,"addrin",7,"addrout",2,"w@",2,"w!",6,"handle"
 dc.b 5,"vctrl",5,"actrl",4,"16b$",7,"vintin!",6,"ptsin!"
 dc.b 7,"aintin!",6,"gemdos",4,"bios",5,"xbios",2,"w",44,5,"extbw"
 dc.b 5,"extbl",5,"extwl",4,"puts",4,"gets",7,"fcreate",5,"fopen"
 dc.b 6,"fclose",5,"fread",6,"fwrite",7,"fgetdta",7,"fdelete"
 dc.b 6,"ffirst",5,"fnext",3,"dta",7,"fsetdta",5,"fseek",6,"fseek>"
 dc.b 6,"fseek<",8,"xv_opnwk",8,"xv_updwk",6,"global",6,"vq_aes"
 dc.b 5,"vsync",5,"joyst",5,"mouse",3,"jx0",3,"jy0",5,"fire0"
 dc.b 3,"jx1",3,"jy1",5,"fire1",6,"mousex",6,"mousey",6,"mousek"
 dc.b 6,"adress",5,"super",4,"user"
 dc.b 8,"v_opnvwk",14,"vst_load_fonts"
 dc.b 16,"vst_unload_fonts",7,"vs_clip",7,"v_pline",9,"v_pmarker"
 dc.b 7,"v_gtext",10,"v_fillarea",13,"v_contourfill",7,"v_recfl",9,"vswr_mode"
 dc.b 8,"vs_color",8,"vsl_type",9,"vsl_udsty",9,"vsl_width",9,"vsl_color"
 dc.b 8,"vsl_ends",8,"vsm_type",10,"vsm_height",9,"vsm_color",10,"vst_height"
 dc.b 9,"vst_point",12,"vst_rotation",8,"vst_font",9,"vst_color"
 dc.b 11,"vst_effects",13,"vst_alignment",12,"vsf_interior",9,"vsf_style"
 dc.b 9,"vsf_color",13,"vsf_perimeter",9,"vsf_udpat",8,"vsc_form",8,"vex_timv"
 dc.b 8,"v_show_c",8,"vq_color",10,"vqt_extent",9,"vqt_width",8,"vqt_name"
 dc.b 8,"v_clsvwk",7,"v_clrwk",8,"v_hide_c",8,"vq_key_s",14,"vql_attributes"
 dc.b 14,"vqm_attributes",14,"vqf_attributes",14,"vqt_attributes"
 dc.b 12,"vqt_fontinfo",5,"v_bar",5,"v_arc",10,"v_pieslice",8,"v_circle"
 dc.b 9,"v_ellipse",8,"v_ellarc",8,"v_ellpie",6,"v_rbox",7,"v_rfbox"
 dc.b 11,"v_justified",10,"vq_chcells",10,"v_exit_cur",11,"v_enter_cur"
 dc.b 7,"v_curup",9,"v_curdown",10,"v_curright",9,"v_curleft",9,"v_curhome"
 dc.b 6,"v_eeos",6,"v_eeol",13,"vs_curaddress",9,"v_curtext",6,"v_rvon"
 dc.b 7,"v_rvoff",13,"vq_curaddress",12,"vq_tabstatus",10,"v_hardcopy"
 dc.b 9,"appl_init",11,"graf_handle",10,"evnt_keybd"
 dc.b 9,"rsrc_free",8,"wind_get",11,"wind_create",9,"wind_open",11,"wind_delete"
 dc.b 8,"wind_set",9,"wind_find",11,"wind_update",9,"wind_calc"
 dc.b 11,"evnt_button",10,"evnt_mouse",10,"evnt_timer",10,"form_error"
 dc.b 10,"wind_close",14,"graf_rubberbox",12,"graf_dragbox",12,"graf_movebox"
 dc.b 12,"graf_growbox",14,"graf_shrinkbox",12,"graf_mkstate",11,"evnt_dclick"
 dc.b 10,"evnt_mesag",10,"evnt_multi",9,"appl_read",10,"appl_write"
 dc.b 9,"objc_draw",9,"objc_find",11,"objc_offset",9,"objc_edit"
 dc.b 11,"objc_change",9,"rsrc_load",10,"rsrc_saddr",7,"form_do",9,"form_dial"
 dc.b 11,"form_center",10,"form_alert",11,"menu_icheck",12,"menu_ienable"
 dc.b 12,"menu_tnormal",13,"menu_register",13,"graf_watchbox",13,"graf_slidebox"
 dc.b 10,"graf_mouse",9,"scrp_read",10,"scrp_write",8,"shel_get",8,"shel_put"
 dc.b 9,"shel_find",10,"rsrc_gaddr",9,"menu_text",10,"fsel_input"
 dc.b 9,"shel_read",10,"shel_write",10,"shel_envrn",6,"format"
 dc.b 8,"menu_bar",4,"exec",4,"exe+",6,"pterm0",5,"pterm",8,"ptermres"
 dc.b 5,"pexec",7,"dsetdrv",7,"dgetdrv",8,"dsetpath",8,"dgetpath"
 dc.b 5,"dfree",7,"dcreate",7,"ddelete",7,"frename",7,"fattrib"
 dc.b 7,"fduplic",6,"fforce",6,"malloc",5,"mfree",7,"mshrink",6,"cauxin"
 dc.b 7,"cauxout",7,"cprnout",6,"crawio",6,"cconws",6,"cconrs"
 dc.b 6,"cconis",6,"cprnos",6,"cauxis",6,"cauxos",8,"bconstat"
 dc.b 7,"bcostat",6,"bconin",7,"bconout",5,"rwabs",7,"mediach"
 dc.b 6,"drvmap",6,"getmpb",6,"getbpb",7,"kbshift",7,"setexec"
 dc.b 8,"physbase",7,"logbase",6,"getrez",9,"setscreen",10,"setpalette"
 dc.b 8,"setcolor",6,"floprd",6,"flopwr",7,"flopver",6,"mfpint"
 dc.b 7,"jdisint",8,"jenabint",7,"xbtimer",8,"kbdvbase",6,"midiws"
 dc.b 8,"giaccess",7,"dosound",8,"offgibit",7,"ongibit",6,"setprt"
 dc.b 6,"rsconf",5,"iorec",8,"initmous",6,"keytbl",8,"bioskeys"
 dc.b 6,"kbrate",6,"random",7,"supexec",6,"MFP_ST",5,"[ass]"
 dc.b 6,"MFP_TT",5,"count",4,"even",5,"delay",8,"auto_end",8,"soft_end"
 dc.b 10,"timer_stop",6,"timerA",6,"timerB",6,"timerC",6,"timerD"
 dc.b 10,"timer_calc"
 dc.b 7,"sc_load",9,"sc_unload",6,"sc_dma",7,"sc_boot",8,"sc_sendm",7,"sc_getm"
 dc.b 7,"sc_exec",9,"sc_xsendm",8,"sc_xgetm",9,"sc_xsendb",8,"sc_xgetb",6,"sc_adr"
 dc.b 8,"sc_check",9,"sc_status",3,"if!",3,"if@",2,"i!",2,"i@",3,"iw!",3,"iw@"
 dc.b 5,"align",3,"ver",11,"screen_info"
 dc.b 2,".b",2,".w",2,".l",2,")@",2,")!",3,"uh.",3,"ub."
 dc.b 6,"modset",7,"modload",9,"modunload",8,"modsname",8,"modlname",6,"modver"
 dc.b 6,"modfmt",7,"modtype",7,"modinfo",6,"modpal",6,"modexe",8,"fillmfdb"
 dc.b 9,"fopensize",9,"imagesize",5,"dorim",5,"dowim",5,"doifx",5,"dotrm"
 dc.b 12,"graphic_card",8,"modmload",10,"modmunload",1,"(",1,")"
 dc.b 10,"savebitmap",10,"loadbitmap",9,"rsrc_mono",9,"datetostr",9,"strtodate"
 dc.b 9,"timetostr",9,"strtotime",8,"tgetdate",8,"tgettime",8,"tsetdate",8,"tsettime"
 dc.b 10,"setsubpage",10,"getsubpage",6,"thread",6,"thnext",6,"thkill",7,"thpause"
 dc.b 6,"thwake",5,"thrun",4,"thid",6,"thsync",10,"thsyncmain",7,"thnsync"
 dc.b 9,"thkillall",6,"thstat",3,"st@",2,">r",5,"[thv]",7,"vthread"
 dc.b 4,"help",5,"guide",6,"vd_set",7,"vd_info",7,"vd_play",9,"vd_create"
 dc.b 8,"vd_frame",7,"vd_sign"
 dc.b 7,"gr_y(x)",8,"gr_xy(t)",7,"gr_r(t)",9,"gr_window",7,"gr_axes",7,"gr_grid"
 dc.b 11,"gr_getpoint",7,"gr_plot",10,"gr3_window",10,"gr3_xyz(t)",8,"gr3_plot"
 dc.b 4,"vdi!",4,"aes!",3,"-(@",3,"-(!"
 dc.b 3,"+(@",3,"+(!",3,")-@",3,")-!",3,")+@",3,")+!",4,"size",2,"c"
 dc.b 44,3,"w*!",3,"w/!",3,"2*!",3,"2/!",3,"dcs",5,"<seg>",5,">seg<"
 dc.b 5,"word$",2,"::",3,"ndo",5,"nloop",4,"list",6,"dolist",5,"lloop"
 dc.b 8,"remember",7,"restore",2,"&f",3,"[f]",2,"b.",2,"d.",2,"o."
 dc.b 2,"h.",6,"struct",8,"&pointer",5,"&name",6,"sizeof"
 dc.b 5,"chain",7,"unchain",4,"next",8,"previous",7,"screate"
 dc.b 7,"sdelete",5,"empty",2,"..",7,"inchain",6,"pchain"
 dc.b 8,"punchain",8,"pinchain",2,"s!",6,"bstart",4,"fast",4,"slow"
 dc.b 5,"start",5,"pushs",5,"pushv",5,"pushc",7,"display",3,"dir"
 dc.b 2,"&(",1,"&",2,"&)",6,"&setof",4,"set+",4,"set*",4,"set-"
 dc.b 4,"card",4,"set=",5,"setin",5,"elmt@",5,"elmt+",5,"elmt-"
 dc.b 6,"elmtin",7,"initset",4,"pads",8,"&segment",3,"[&]"
 
 dc.b 2,"f+"
 dc.b 2,"f-",2,"f*",2,"f/",4,"fdup",5,"fdrop",2,"f.",4,"fval"
 dc.b 4,"[fl]",5,"fswap",5,"fover",3,"f..",6,"&float",2,"f@",2,"f!"
 dc.b 2,"f=",2,"f>",3,"sqr",4,"fabs",2,"pi",3,"sin"
 dc.b 3,"cos",3,"tan",4,"atan",4,"fneg",3,"1/x",3,"x^2",3,"exp",3,"log"
 dc.b 4,"ftoi",4,"itof",6,"sincos",3,"x^y",3,"int",4,"frac"
 dc.b 5,"f*2^n",5,"round",5,"fsign",3,"f>r",3,"r>f"
 dc.b 4,"frot",5,"fpick"
 dc.b 4,"asin",4,"acos",4,"cosh",4,"sinh",4,"tanh",5,"atanh",5,"asinh",5,"acosh"
 dc.b 3,"f<>",3,"f>=",3,"f<=",2,"f<"
 
 dc.b 4,"str>",4,"flt>",4,"set>",6,"struc>",4,">int"
 dc.b 4,">str",4,">flt",4,">set",6,">struc",5,"cmove",11,"vqt_devinfo",11,"vm_filename"
 dc.b 14,"v_meta_extents",11,"vm_pagesize"
 dc.b 7,"stallot",7,"ttallot",4,"play",4,"<>of",3,">of",3,"<of"
 dc.b 5,"&wvar",7,"setable",7,"&warray",5,"[war]",3,"buf",9,"setdigits"
 dc.b 4,"buf0",6,"getfmt",2,"->",5,"and->",3,"->.",4,"or->",8,"pageclip"
 dc.b 7,"v_ftext",17,"v_clear_disp_list",7,"v_updwk",6,"&stack",3,">st",3,"st>"
 dc.b 7,"current",6,"stack0",5,"&page",7,"defpage",7,"setpage",8,"absolute"
 dc.b 8,"relative",9,"fastclose",5,"page0",8,"fastopen",4,"desk",5,"cache"
 dc.b 4,"menu",7,"setmenu",8,"gemindex",8,"strindex",8,"dialogue",7,"lastobj"
 dc.b 7,"child<<",2,">>",3,"BOX",4,"IBOX",7,"BOXCHAR",6,"BUTTON"
 dc.b 6,"STRING",5,"TITLE",4,"TEXT",7,"BOXTEXT",5,"FTEXT",8,"FBOXTEXT"
 dc.b 5,"IMAGE",7,"USERDEF",8,"get_xywh",10,"set_redraw",6,"redraw",8,"work_out"
 dc.b 8,"get_xyxy",9,"vst_arbpt",12,"vqt_f_extent",11,"vst_setsize"
 dc.b 8,"vst_skew",4,"ICON"
 dc.b 5,"mfdbs",5,"mfdbd",8,"vr_trnfm",9,"vrt_cpyfm",9,"vro_cpyfm",4,"top>"
 dc.b 4,">top",7,"setplay",4,"path",7,"loadbin",7,"savebin",9,"setreplay"
 dc.b 6,"replay",10,"savevdipal",9,"setvdipal",10,"replay_end",7,"&cookie"
 dc.b 9,"vm_coords",7,"v_opnwk",7,"v_clswk",4,"page",6,"import",6,"export"
 dc.b 12,"v_alpha_text",5,"v_bez",10,"v_bez_fill",9,"v_bez_off",8,"v_bez_on"
 dc.b 10,"v_bez_qual",11,"v_bit_image",12,"v_fulshcache",10,"v_fontinit"
 dc.b 10,"v_form_adv",9,"v_ftext16",14,"v_ftext_offset",16,"v_ftext_offset16"
 dc.b 16,"v_getbitmap_info",12,"v_getoutline",11,"v_get_pixel",11,"v_loadcache"
 dc.b 15,"v_output_window",9,"v_pgcount",11,"v_savecache",14,"v_set_app_buff"
 dc.b 12,"v_write_meta",8,"vex_butv",8,"vex_curv",8,"vex_motv",8,"vq_extnd"
 dc.b 7,"vq_gdos",8,"vq_mouse",7,"vq_scan",13,"vqt_advance32",11,"vqt_advance"
 dc.b 13,"vqt_cachesize",14,"vqt_f_extent16",14,"vqt_fontheader",13,"vqt_get_table"
 dc.b 12,"vqt_pairkern",13,"vqt_trackkern",11,"vst_arbpt32",11,"vst_charmap"
 dc.b 9,"vst_error",8,"vst_kern",11,"vst_scratch",13,"vst_setsize32",11,"form_button"
 dc.b 10,"form_keybd",12,"fsel_exinput",11,"menu_attach",11,"menu_istart",10,"menu_popup"
 dc.b 13,"menu_settings",8,"objc_add",11,"objc_delete",10,"objc_order",11,"objc_sysvar"
 dc.b 10,"rsrc_obfix",10,"rsrc_rcfix",8,"wind_new",8,"basepage",4,"_app"
 dc.b 7,"reserve",9,"nvmaccess",13,"&wdial_create",10,"wdial_open",11,"wdial_close"
 dc.b 12,"wdial_formdo",12,"wdial_change",10,"wdial_evnt"
 dc.b 9,"vq_margin",14,"vq_driver_info",12,"vq_bit_image",12,"vs_page_info"
 dc.b 7,"vs_crop",13,"vq_image_type",9,"#nul_char",9,"trace_win",8,">include"	; ne pas d‚placer
 dc.b 5,">true",6,">false",7,">export",5,">exec",9,">prgflags",7,">ifflag"	; ces ordres ont une valeur absolue
 dc.b 5,">endf"
 dc.b 5,"solve",5,"gauss"
 dc.b 7,"maximum",7,"minimum"
 dc.b 4,"_fpu",8,"gr3_axes",8,"gr3_grid",8,"gr3_view"
 dc.b 12,"appl_trecord",12,"appl_getinfo",11,"appl_search",6,"islast"
 dc.b 10,"appl_tplay",6,"pempty",6,"writeb",5,"ltype",9,"pal2xbios",4,"set!"
 dc.b 4,"-set",4,"int>",2,">=",2,"<=",7,"gr_area",10,"gr3_z(xy)l",10,"gr3_z(xy)f"
 dc.b 7,"gr3_rot",4,">rad",4,">deg",4,"sndb",4,"bstr",7,"getfile",7,"getpath"
 dc.b 4,">ask",7,"rsc2for",8,"getradio",8,"gem_list",12,"assign_array"
 dc.b 5,"highw",4,"loww",5,"highb",4,"lowb",7,"fasthdl",5,"ddate",4,"dofw"
 dc.b 5,"date+",9,"gem_input",8,">accname",10,"unpackdate",8,"packdate"
 dc.b 4,">fom",11,"resize_list",8,"language",8,">ifflag2",7,"lambert",8,"lambert1"
 dc.b 5,">line",5,"line>",10,"change.ext",5,"watch",4,"ARGC",4,"ARGV",2,".f"
 dc.b 2,"f,",4,"sign",4,"isqr",7,"illegal",7,"irandom",10,"irandomize"
 dc.b 6,"gr_pie",7,"gr_hpie",9,"setmargin",5,"tovdi",5,"toaes",6,"gr_bar"
 dc.b 5,"size?",7,"gr_barg",7,"gr_sbar",8,"gr_sbarg",13,"gr_bar_hlabel"
 dc.b 13,"gr_bar_vlabel",12,"gr_bar_title",12,"gr_pie_label",13,"gr_hpie_label"
 dc.b 5,"newin",0

	even

 end