; ModŠle, de module FORTH
; Guillaume Tello
; guillaume.tello@orange.fr
; july 2024

; version 1.01 
;		correction bug taille cl‚ avec CFGsetkey
;		CFGsetkey n'utilise plus pad (qui peut donc ˆtre une valeur d'entr‚e)
;		CFGdelkey non plus

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

		section	text

debut:	
	dc.b "READ_FOM"	; identifiant module g‚n‚ral FORTH
	dc.b ".CFG"			; objets support‚s
	dc.w 6				; type nbr de redef diff‚rentes de modexe
	dc.b "CONFIG  "	; nom court
	dc.w 101				; version 1.00
	dc.b "Config File Manager ½2024 GT  ",0 ; long name (30 caractŠres + z‚ro)
	dc.b 4+2+1			; 4 si pas de retour D0 auto, 2 si mots red‚finis, 1 si do_param pr‚sent
	bra CFGset
	bra CFGfree
	bra modexe
	bra do_param		; si bit #0
	
	; ici type<>0 (et donc bit #1 mis aussi!), la structure serait:

	dc.b "CFGset",0		; extrasize flag CFGset, ne renvoie rien
	dc.b "CFGfree",0		; sans paramŠtre
	dc.b "CFGload",0		; " path\file" CFGload
	dc.b "CFGsave",0		; " path\file" CFGsave
	dc.b "CFGgetkey",0	; " cl‚" CFGgetkey
	dc.b "CFGsetkey",0	; " cl‚" " val" CFGsetkey
	dc.b "CFGdelkey",0	; " cl‚" CFGdelkey
	dc.b "CFGcreate",0	; CFGcreate: block vide de extrasize octets
	even					; assure la parit‚	
	
	
	
	
	; en 4(SP)on trouve SNDB
	; sur A6 la pile FORTH
	; fonction modinfo
	
	; extra_size flag CFGset
	; pour ignorer un paramŠtre, mettre -1
		
CFGset:
	moveq #-1,d0
	move.l (a6)+,d1
	lea flag(pc),a0
	cmp.l d1,d0
	beq.s .lb0
	move.l d1,(a0)		; le flag
.lb0:
	move.l (a6)+,d1
	cmp.l d1,d0
	beq.s .lb1
	move.l d1,4(a0)	; extra size
.lb1:
	rts

	; sauvegarde les valeurs du FORTH
	
do_param:
	bsr save_forth_values
	moveq #96,d0			; pad
	bsr exec_forth
	lea pad(pc),a0
	move.l (a6)+,(a0)		; conserve PAD pour renvoyer les valeurs de cl‚s
	moveq #0,d0				; tout va bien !
	rts

save_forth_values:
	lea debut(pc),a0		; r‚cupŠre les donn‚es envoy‚es par MODLOAD
	lea adresse(pc),a1
	move.l -(a0),(a1)+	; adresse
	rts

	; d0=code du mot FORTH … ‚x‚cuter
	
exec_forth:
	lea adresse(pc),a0
	move.l (a0),a0			; base des adresses
	lsl.w #2,d0
	move.l 0(a0,d0.w),a0	; adresse du mot
	jsr (a0)					; execute
	rts

; pile 4(SP):sndb

modexe:	
	cmp.l #'XFOM',d1
	bne.s .nul				; ici choisir que faire si appel direct … modexe
	add.l d0,d0
	lea fn_list(pc),a0
	move -2(a0,d0.l),d0	; le bon offset !
	lea base(pc),a0
	add d0,a0					; adresse de la fonction
	jmp (a0)
.nul:
	moveq #0,d0
	rts

	; fonction modpal
CFGfree:
	lea block(pc),a0
	move.l (a0),d0
	beq.s _fin_bug		; si adresse nulle, pas de bloc allou‚ !
	move.l d0,-(sp)
	clr.l (a0)			; et efface le bloc
	GEMDOS 73,6			; mfree, renvoie 0 si Ok, code GEMDOS sinon
	tst.l d0
	bmi.s _fin_bug
	bra.s _fin_ok

base:

	; " path\file" CFGload, renvoie 0 si erreur
CFGload:
	move.l (a6)+,a1		; adresse du nom de fichier
	move.l extra(pc),d0	; taille supp
	neg.l d0
	move.l d0,-(a6)		; taille a r‚server avant le fichier
	moveq #-1,d0
	move.l d0,-(a6)		; tout charger
	move.l a1,-(a6)		; nom du fichier
	clr.l -(a6)				; adr=0 laisser FORTH r‚server le block
	move #773,d0			; loadbin
	bsr exec_forth
	move.l (a6)+,d0		; code d'erreur ? ou taille lue ?
	bmi.s _fin_bug			; si <0 erreur
	move.l (a6)+,a1		; adresse du bloc	
	lea extra(pc),a0
	move.l (a0)+,d1		; taille avant le fichier
	move.l a1,(a0)			; sauve block
	add.l d1,a1				; d‚but r‚el du fichier
	lea start_cfg(pc),a0
	move.l a1,(a0)+		; dans start_cfg
	add.l d0,a1				; fin du fichier (pointe sur l'octet APRES le fichier
	move.l a1,(a0)			; dans end_cfg
	bra _fin_ok

	; " path\file" CFGsave, renvoie 0 si erreur
	
CFGsave:
	move.l (a6)+,a1		; nom du fichier
	lea start_cfg(pc),a0
	move.l (a0)+,d0		; adresse d‚but
	move.l (a0)+,d1		; adresse fin
	sub.l d0,d1				; taille !
	move.l d1,-(a6)		; taille
	move.l a1,-(a6)		; nom
	move.l d0,-(a6)		; adresse d‚part
	move #774,d0			; savebin
	bsr exec_forth
	move.l (a6)+,d0		
	bmi.s _fin_bug
	; continue sur _fin_ok
_fin_ok:
	moveq #1,d0
	move.l d0,-(a6)
	rts
	
_fin_bug:
	moveq #0,d0
	move.l d0,-(a6)
	rts

CFGgetkey:
	move.l (a6)+,a3			; chaine … rechercher
	lea start_cfg(pc),a0
	move.l (a0)+,a2		; zone de recherche
	move.l (a0)+,d7		; critŠre de fin !
	move.l flag(pc),d6	; pour les options
.start_line:				; ici on cherche le premier caractŠre non vide d'une ligne
	cmp.l a2,d7
	beq.s _fin_bug			; on a atteint la fin, pas trouv‚
	move.b (a2)+,d0
	cmp.b #32,d0
	bls.s .start_line		; espace ou en dessous, on saute
	cmp.b #';',d0			; un commentaire?
	beq.s .skip_comment
	cmp.b #'\',d0			; idem?
	bne.s .ok0				; c'est bon, on a notre d‚but de mot !
.skip_comment:				; ici ligne commentaire, passer … la suivante
	cmp.l a2,d7
	beq.s _fin_bug			; fin de fichier
	move.b (a2)+,d0
	cmp.b #13,d0			; CR ?
	beq.s .start_line		; fin de ligne atteinte, on repart chercher un mot
	cmp.b #10,d0			; LF ?
	bne.s .skip_comment	; non, on cherche encore
	bra.s .start_line		; fin de ligne
.ok0:
	subq.l #1,a2			; revient sur le d‚but du mot
	lea start_key(pc),a0
	move.l a2,(a0)			; garde le d‚but !
	move.l a3,a0			; notre cl‚
.verif_key:
	cmp.l a2,d7
	beq.s _fin_bug			; fin de fichier
	move.b (a2)+,d2		; le fichier
	move.b (a0)+,d0		; la cl‚
	beq.s .fin_key			; si z‚ro, cl‚ finie
	cmp.b #32,d2
	bls.s .skip_comment	; mot fini et pas la cl‚, on saute
	cmp.b #'=',d2
	beq.s .skip_comment	; idem
	btst #0,d6				; case sensitive ?
	bne.s .comp				; oui, conserver d2 et d0 tels quels
	bsr .minuscules	
.comp:
	cmp.b d2,d0
	beq.s .verif_key		; ‡a reste ‚gal, on continue
	bra.s .skip_comment	; diff‚rence... on saute la ligne !
.fin_key:
	cmp.b #32,d2
	beq.s .yeah				; cl‚ finie et espace, tout va
	cmp.b #9,d2
	beq.s .yeah				; idem avec tabulation
	cmp.b #'=',d2
	bne.s .skip_comment	; cl‚ finie mais pas dans le fichier, donc passe la ligne
	bra.s .cherche_valeur
.yeah:
	cmp.l a2,d7
	beq _fin_bug			; fin de fichier
	move.b (a2)+,d0
	cmp.b #'=',d0
	beq.s .cherche_valeur	; '=' trouv‚ ! on cherche la valeur
	cmp.b #32,d0
	beq.s .yeah				; ce n'est pas la fin de ligne, on cherche encore
	cmp.b #9,d0
	beq.s .yeah				; idem avec tabulation
	bra .start_line		; cl‚ sans "=", on cherche ailleurs
.cherche_valeur:
	btst #1,d6
	bne.s .debut_val		; ignorer pad (appel de CFGsetkey)
	move.l pad(pc),a0		; pour y stocker la r‚ponse !
	move.l a0,-(a6)		; retour !
.debut_val:
	cmp.l a2,d7
	beq.s .fin				; fin de fichier, chaine vide
	move.b (a2)+,d0
	cmp.b #9,d0
	beq.s .debut_val		; tant que c'est une tabulation on saute
	cmp.b #32,d0
	beq.s .debut_val		; idem avec un espace
	bcs.s .fin				; fin de ligne atteinte, chaine vide	
	subq.l #1,a2			; revient sur le premier octet correct
.copie_val:
	cmp.l a2,d7
	beq.s .recule			; fin de fichier, on va revenir sur d'‚ventuels espaces
	move.b (a2)+,d0
	cmp.b #32,d0
	bcs.s .recule2			; fin de ligne
	btst #1,d6
	bne.s .copie_val		; ignorer pad
	move.b d0,(a0)+		; ajoute … pad
	bra.s .copie_val
.recule2:
	subq.l #1,a2			; revient d‚j… sur le caractŠre<32 (CR, LF...)
.recule:
	btst #1,d6
	bne.s .fin				; ignorer pad
	cmp.b #32,-(a0)
	beq.s .recule
	addq.l #1,a0
.fin:
	btst #1,d6
	bne.s .fin2				; ignorer pad
	clr.b (a0)				; fin de valeur dans pad
.fin2:
	lea end_key(pc),a0
	subq.l #1,a2			; revient sur le dernier caractŠre
	move.l a2,(a0)			; fin de cl‚ !
	bra _fin_ok		
.minuscules:
	cmp.b #'A',d0
	bcs.s .m0
	cmp.b #'Z',d0
	bhi.s .m0
	or.b #$20,d0			; c'est une majuscule, on passe en minus
.m0:
	cmp.b #'A',d2
	bcs.s .m1
	cmp.b #'Z',d2
	bhi.s .m1
	or.b #$20,d2
.m1:
	rts
	
	; " key"  " val"  CFGsetkey 		
CFGsetkey:
	lea val(pc),a0
	move.l (a6)+,(a0)+	; sauve valeur
	move.l (a6),(a0)		; sauve cl‚
	bsr .calc_size		; taille des deux chaines D4/D5
	bsr getkey_nopad
	move.l d5,d3			; val
	add.l d4,d3				; + cl‚
	addq.l #1,d3			; + =, taille … ajouter
	tst.l (a6)+
	bne.s .oui
								; ici, la cl‚ n'existe pas, on l'ajoute
	addq.l #2,d3			; nouvelle cl‚, donc CR+LF en plus
	bsr.s .verif_add		; voit si D3 octets entrent encore, renvoie a0=nouveau d‚part
	lea start_cfg(pc),a1
	move.l (a1),a2			; ancien start
	move.l a0,(a1)+		; nouveau start
	move.l (a1),d0			; fin
	sub.l a2,d0				; taille … d‚placer
	bra.s .sk0
.sk1:
	move.b (a2)+,(a0)+
.sk0
	dbf d0,.sk1
	move.b #13,(a0)+		; un saut de ligne, nouvelle ligne!
	move.b #10,(a0)+
	bra.s .comm				; copie cl‚ et fin renvoie ok
.oui:							; la cl‚ existe, remplacer
	move.l end_key(pc),d0
	sub.l start_key(pc),d0	; ‚cart end-start
	addq.l #1,d0				; +1 = taille actuelle
	sub.l d0,d3
	beq.s .meme_taille
	bmi.s .reduire_taille
	bsr.s .verif_add			; peut-on ajouter D3 octets?
	lea start_cfg(pc),a2
	move.l (a2),a1				; source
	move.l a0,(a2)				; nouveau start_cfg
	move.l start_key(pc),d0
	sub.l a1,d0					; taille … d‚caler
	bra.s .at0
.at1:
	move.b (a1)+,(a0)+
.at0:
	dbf d0,.at1				
	bra.s .comm					; A0 pointe pile sur la nouvelle cl‚
.meme_taille:
	move.l start_key(pc),a0	; pas de bloc a d‚placer
.comm:
	bsr.s .copy_key			; on copie !
	bra _fin_ok	
.reduire_taille:				; ici cl‚ plus petite que l'ancienne
	neg.l d3						; d‚calage
	move.l start_key(pc),a2	; source
	move.l a2,d0
	sub.l start_cfg(pc),d0	; nombre d'octets a bouger
	lea 0(a2,d3.l),a1			; destination
	move.l a1,a0				; future position de la nouvelle cl‚
	bra.s .rt0
.rt1:
	move.b -(a2),-(a1)		; remonte le bloc
.rt0:
	dbf d0,.rt1
	lea start_cfg(pc),a2
	move.l a1,(a2)				; nouveau d‚but de bloc
	bra.s .comm
	
.verif_add:					; peut-on ajouter D3 octets au buffer?
	move.l start_cfg(pc),a0
	sub.l d3,a0				; nouvelle adresse de d‚part
	cmp.l block(pc),a0
	bcc.s .va0
	addq.l #4,sp			; vire l'adresse d'appel
	bra _fin_bug			; renvoie 0 : pas assez de place
.va0: rts

.calc_size:					; calcule les tailles des chaines cl‚ et valeur
	move.l val(pc),a0		; la valeur
	moveq #-1,d5
.cs0:
	addq.l #1,d5
	tst.b (a0)+
	bne.s .cs0				; D5=taille chaine "valeur"
	move.l val+4(pc),a0	; la cl‚
	moveq #-1,d4
.cs1:
	addq.l #1,d4
	tst.b (a0)+
	bne.s .cs1				; D4=taille chaine "cl‚"
	rts
.copy_key:					; copy en (a0)
	lea val+4(pc),a1
	move.l (a1),a2			; chaine cl‚
	move d4,d0				; taille
	bra.s .ck0
.ck1:
	move.b (a2)+,(a0)+	; copie cl‚
.ck0:
	dbf d0,.ck1
	move.b #'=',(a0)+		; ajoute =
	move d5,d0				; taille valeur
	move.l -(a1),a2		; chaine valeur
	bra.s .ck3
.ck2:
	move.b (a2)+,(a0)+	; copi‚e
.ck3:
	dbf d0,.ck2
	rts

getkey_nopad:
	lea flag+3(pc),a0
	bset #1,(a0)			; ne pas remplir pad
	bsr CFGgetkey			; la cl‚ existe?
	lea flag+3(pc),a0
	bclr #1,(a0)			; reautoriser pad
	rts

CFGdelkey:
	bsr.s getkey_nopad
	tst.l (a6)+				; cl‚ trouv‚e?
	beq _fin_bug				; non, donc rien … effacer renvoie 0
	move.l end_key(pc),a0	; destination
	addq.l #1,a0				; fin+1 pour le premier octet … garder
	move.l start_key(pc),a1	; source
	move.l a1,a2
.lb5:								; ici on cherche … reculer sur CR LF
	cmp.l start_cfg(pc),a2	; debut atteint, on quitte
	beq.s .annule
	move.b -(a2),d0			; un octet
	cmp.b #32,d0
	beq.s .lb5
	cmp.b #9,d0
	beq.s .lb5					; espace ou tab, on recule encore
	cmp.b #10,d0
	beq.s .lb3					; LF on a trouv‚
	cmp.b #13,d0
	bne.s .annule				; autre chose on annule
.lb3:
	cmp.l start_cfg(pc),a2	; ici on a trouv‚ le d‚but de ligne et
	beq.s .lb2
	move.b -(a2),d0
	cmp.b #13,d0				; on recule tant qu'il y a des CR
	beq.s .lb3
	cmp.b #10,d0				; et des LF
	beq.s .lb3
	addq.l #1,a2
.lb2:
	move.l a2,a1				; nouveau debut
.annule:	
	move.l a1,d0
	sub.l start_cfg(pc),d0	; taille … remonter
	bra.s .lb0
.lb1:
	move.b -(a1),-(a0)
.lb0:
	dbf d0,.lb1
	lea start_cfg(pc),a1
	move.l a0,(a1)			; nouveau start
	bra _fin_ok				; cl‚ effac‚e, renvoie 1

CFGcreate:
	move.l extra(pc),d0
	beq _fin_bug				; pas de bloc nul !
	move.l d0,-(sp)
	GEMDOS 72,6
	tst.l d0
	bmi _fin_bug				; allocation rat‚e
	lea block(pc),a0
	move.l d0,(a0)			; sauve le block
	lea start_cfg(pc),a0
	add.l extra(pc),d0	; d‚but et fin du block au meme endroit
	move.l d0,(a0)+
	move.l d0,(a0)+
	bra _fin_ok
	
	data
	
fn_list: dc.w CFGload-base,CFGsave-base,CFGgetkey-base,CFGsetkey-base,CFGdelkey-base
			dc.w CFGcreate-base

flag: dc.l 0				; bit0=1 si respecter Maj/Min dans les cl‚s, sinon ignorer
								; bit1=1 ignorer pad dans getkey, =0 remplir pad
extra: dc.l 1024			; taille de 1Ko par d‚faut
block: dc.l 0				; pas d'adresse d‚finie encore
	
	bss
	
adresse: ds.l 1
start_key: ds.l 1		; lors d'une recherche, adr d‚but...
end_key: ds.l 1		; et fin de cl‚
start_cfg: ds.l 1		; d‚but du CFG dans le bloc
end_cfg: ds.l 1		; fin du CFG
pad: ds.l 1
val: ds.l 2				; valeur et cl‚

	end