
Les fonctions TCP/IP ou de compression ne sont pas dans votre magnifique code GFA. Elles se trouvent ailleurs (comme la vérité). Pour appeler ces fonctions, on utilise une particularité du GFA qui fait sa puissance : se la couler douce et faire intervenir du code C ou assembleur. Explication :
$C+ zlib_r%=C:zlib_deflate_init%(L:zlib_stream%,L:zlib_level%) $C-zlib_deflate_init% est la fonction qu'on appelle. C'est en fait une adresse, donc un entier LONG.
Bon, c'est bien joli, mais comment trouve-t-on l'adresse de cette fonction, hein ?
Réponse 1 : sûrement pas DTC, mais parfois dans un INLINE. Le plus souvent, le codeur GFA-68K stocke ses fonctions et bouts de programmes dans une zone mémoire du même programme GFA. Hop-ni-vu-ni-connu.
Réponse 2 : en fait, dans notre cas, la fonction est EXTERNE. Et l'on va demander au système où elle se trouve. Et comme d'habitude, ce sont dans la boîte à biscuits de mémé de Bagnières-de-Bigorre, heu... non pardon, c'est dans la boîte-à-cookies atari qu'on va la trouver.
Et comme votre serviteur vous sert bien, on vous redonne la fonction pour explorer la cookie-jar, même si vous l'avez eu la dernière fois.
FUNCTION test_cookie(cookie_name$,VAR cookie_valeur%)
LOCAL read_cook%,nom_cook%,cookie%
'
nom_cook%=CVL(cookie_name$)
cookie%=LPEEK(&H5A0)
cookie_valeur%=0
'
IF cookie%<>0
REPEAT
read_cook%=LPEEK(cookie%)
cookie_valeur%=LPEEK(ADD(cookie%,4))
ADD cookie%,8
UNTIL read_cook%=0 OR read_cook%=nom_cook%
IF read_cook%=nom_cook%
RETURN TRUE
ELSE
RETURN FALSE
ENDIF
ELSE
RETURN FALSE
ENDIF
ENDFUNC
En fait, on va obtenir la présence ou non du cookie, et une valeur de retour. Cette valeur de retour est en fait un pointeur (=adresse) sur une structure, qui comporte divers renseignements, dont les adresses/pointeurs vers les fonctions que vous voulez utiliser dans votre marveilleux code GFA bien propre sur lui.
presence_sting!=@test_cookie("STiK", sting_pointeur%) ! ben oui, STinG est le fils légitime de STiK
Voilà la structure de STinG
typedef struct tpl {
char *module; /* Specific string that can be searched for */
char *author; /* Any string */
char *version; /* Format `00.00' Version:Revision */
char * cdecl (*KRmalloc) (int32);
void cdecl (*KRfree) (char *);
int32 cdecl (*KRgetfree) (int16 x);
char * cdecl (*KRrealloc) (char *, int32);
char * cdecl (*get_err_text) (int16);
char * cdecl (*getvstr) (char *);
int16 cdecl (*carrier_detect) (void);
int16 cdecl (*TCP_open) (uint32, int16, int16, uint16);
int16 cdecl (*TCP_close) (int16, int16);
int16 cdecl (*TCP_send) (int16, char *, int16);
int16 cdecl (*TCP_wait_state) (int16, int16, int16);
int16 cdecl (*TCP_ack_wait) (int16, int16);
int16 cdecl (*UDP_open) (uint32, int16);
int16 cdecl (*UDP_close) (int16);
int16 cdecl (*UDP_send) (int16, char *, int16);
int16 cdecl (*CNkick) (int16);
int16 cdecl (*CNbyte_count) (int16);
int16 cdecl (*CNget_char) (int16);
NDB * cdecl (*CNget_NDB) (int16);
int16 cdecl (*CNget_block) (int16, char *, int16);
void cdecl (*housekeep) (void);
int16 cdecl (*resolve) (char *, char **, uint32 *, int16);
void cdecl (*ser_disable) (void);
void cdecl (*ser_enable) (void);
int16 cdecl (*set_flag) (int16);
void cdecl (*clear_flag) (int16);
CIB * cdecl (*CNgetinfo) (int16);
int16 cdecl (*on_port) (char *port);
void cdecl (*off_port) (char *port);
int16 cdecl (*setvstr) (char *vs, char *value);
int16 cdecl (*query_port) (char *port);
int16 cdecl (*g_resolve)(char *dn, char **rdn, uint32 *adr_list, int16 lsize);
int16 cdecl (*g_TCP_wait_state)(int16 cn, int16 state, int16 timeout);
} TPL;
Oh, rassurez-vous, ce n'est pas bien méchant, et on ne pas pas tout utiliser.
Dans votre code GFA, ça donnera ça :
FUNCTION stik_init
$F%
LOCAL stik_cookie_value%,stik_tpl%
'
IF @test_cookie("STiK",stik_cookie_value%)
IF stik_cookie_value%>0
IF MKL$(LONG{stik_cookie_value%})="STiK" AND MKL$(LONG{ADD(stik_cookie_value%,4)})="magi" AND BYTE{ADD(stik_cookie_value%,8)}=99 ! "STiKmagic"
'
stik_function_buffer%=@mxalloc_global(256,0) ! on créée aussi quelques zones mémoire en global, pour passer les chaines de texte via tcp_send
IF stik_function_buffer%<1
RETURN -6 ! can't malloc for sting
ENDIF
'
stik_get_dftab%=LONG{ADD(stik_cookie_value%,10)}
sitk_etm_exec%=LONG{ADD(stik_cookie_value%,14)}
stik_config%=LONG{ADD(stik_cookie_value%,18)}
stik_debug%=LONG{ADD(stik_cookie_value%,22)}
'
stik_tpl%=@stik_get_dftab("TRANSPORT_TCPIP")
IF stik_tpl%>0
'
tpl_module%=LONG{stik_tpl%}
tpl_author%=LONG{ADD(stik_tpl%,4)}
tpl_version%=LONG{ADD(stik_tpl%,8)}
kr_malloc%=LONG{ADD(stik_tpl%,12)}
kr_free%=LONG{ADD(stik_tpl%,16)}
kr_get_free%=LONG{ADD(stik_tpl%,20)}
kr_realloc%=LONG{ADD(stik_tpl%,24)}
tpl_get_error_text%=LONG{ADD(stik_tpl%,28)}
tpl_get_variable_string%=LONG{ADD(stik_tpl%,32)}
tpl_carrier_detect%=LONG{ADD(stik_tpl%,36)}
tcp_open%=LONG{ADD(stik_tpl%,40)}
tcp_close%=LONG{ADD(stik_tpl%,44)}
tcp_send%=LONG{ADD(stik_tpl%,48)}
tcp_wait_state%=LONG{ADD(stik_tpl%,52)}
tcp_ack_wait%=LONG{ADD(stik_tpl%,56)}
udp_open%=LONG{ADD(stik_tpl%,60)}
udp_close%=LONG{ADD(stik_tpl%,64)}
udp_send%=LONG{ADD(stik_tpl%,68)}
cn_kick%=LONG{ADD(stik_tpl%,72)}
cn_byte_count%=LONG{ADD(stik_tpl%,76)}
cn_get_char%=LONG{ADD(stik_tpl%,80)}
cn_get_ndb%=LONG{ADD(stik_tpl%,84)}
cn_get_block%=LONG{ADD(stik_tpl%,88)}
tpl_housekeep%=LONG{ADD(stik_tpl%,92)}
tpl_resolve%=LONG{ADD(stik_tpl%,96)}
ser_disable%=LONG{ADD(stik_tpl%,100)}
ser_enable%=LONG{ADD(stik_tpl%,104)}
tpl_set_flag%=LONG{ADD(stik_tpl%,108)}
tpl_clear_flag%=LONG{ADD(stik_tpl%,112)}
cn_get_info%=LONG{ADD(stik_tpl%,116)}
'
stik_client_ip%=LONG{stik_config%}
stik_provider%=LONG{ADD(stik_config%,4)}
stik_cn_time%=LONG{ADD(stik_config%,26)}
stik_cd_valid&=WORD{ADD(stik_config%,30)}
'
ELSE
RETURN -5 ! TCP layer not loaded
ENDIF
ELSE
RETURN -4 ! "STikmagic" not found
ENDIF
ELSE
RETURN -3 ! disabled?
ENDIF
ELSE
RETURN -2 ! cookie not found
ENDIF
RETURN 0 ! okay
ENDFUNC
Là, je vous laisse à l'étude de la librairie STiK pour GFA concoctée avec amour par Lonny Pursell (STiK DevKit 1.09, avec une doc STGUIDE remarquablement bien faite).Même principe, on va fouiller dans la cookie-jar pour trouver les bonnes adresses. Attention ici, car il existe une autre méthode, celle du linkage, qui permet un programme en C d'appeler directement les fonctions LDG. Pas de pot ici, on doit passer par le cookie, et donc d'installer le LDG.PRG dans le dossier AUTO. Une fois cette installation faite, on peut avoir cela :
PROCEDURE ldg_init
'
ldgm_cookie!=@test_cookie("LDGM",ldg_cookie_ptr%)
IF ldgm_cookie!=TRUE AND ldg_cookie_ptr%>0
'
ldg_version&=INT{ldg_cookie_ptr%}
ldg_path$=CHAR{ADD(ldg_cookie_ptr%,2)}
ldg_gc_time&=INT{ADD(ldg_cookie_ptr%,130)}
'
ldg_open%=LONG{ADD(ldg_cookie_ptr%,134)}
ldg_close%=LONG{ADD(ldg_cookie_ptr%,138)}
ldg_find%=LONG{ADD(ldg_cookie_ptr%,142)}
ldg_error%=ADD(ldg_cookie_ptr%,150)
'
ELSE
ldg_version&=0
ldg_path$=""
ldg_gc_time&=0
'
ldg_open%=0
ldg_close%=0
ldg_find%=0
ldg_error%=0
ENDIF
'
RETURN
Si le développeur de la librairie (par exemple la DEFLATE.LDG de votre humble serviteur) a fait son taf correctement, les fonctions de sa librairie sont documentées. Il suffit d'utiliser un outil du pack LDG, ou même le LDG.CPX pour savoir quelle fonction est présente et savoir quels paramètres lui passer.
Dans le cas du DEFLATE, voici les prototypages :
const char* CDECL get_version(); const char* CDECL get_info(); const char* CDECL get_error(int err); unsigned long CDECL get_compil_flags(); unsigned long CDECL get_sizeof_stream_struct(); int CDECL raw_deflate_init (z_stream *strm, int level); int CDECL raw_deflate (z_stream *strm, int flush); int CDECL raw_deflate_end (z_stream *strm); int CDECL raw_inflate_init (z_stream *strm); int CDECL raw_inflate (z_stream *strm, int flush); int CDECL raw_inflate_end (z_stream *strm); unsigned long CDECL update_crc32(uLong crc_value, const Bytef *buf, uInt len);Pour les trouver en GFA, cela donne :
FUNCTION zlib_open
$F%
'
zlib_get_version%=0
zlib_get_info%=0
zlib_get_error%=0
zlib_get_compil_flags%=0
zlib_get_sizeof_stream_struct%=0
'
zlib_deflate_init%=0
zlib_deflate%=0
zlib_deflate_end%=0
'
zlib_inflate_init%=0
zlib_inflate%=0
zlib_inflate_end%=0
'
zlib_crc%=0
'
ldg_mem_malloc_ptr%=0
ldg_mem_free_ptr%=0
'
IF shell_buf%>0 AND ldg_open%>0
zlib_error&=0
'
CHAR{shell_buf%}="deflate.ldg" ! on place notre chaine de texte dans une zone mémoire en global
'
zlib_ldg_ptr%=C:ldg_open%(L:shell_buf%,L:global%) !!! on charge
IF zlib_ldg_ptr%<1
zlib_error&=INT{ldg_error%}
'
RETURN FALSE
ENDIF
'
CHAR{shell_buf%}="get_version"
'
zlib_get_version%=C:ldg_find%(L:shell_buf%,L:zlib_ldg_ptr%) !! et on cherche
IF zlib_get_version%=0
RETURN FALSE
ENDIF
'
CHAR{shell_buf%}="get_info"
'
zlib_get_info%=C:ldg_find%(L:shell_buf%,L:zlib_ldg_ptr%)
IF zlib_get_info%=0
RETURN FALSE
ENDIF
'
CHAR{shell_buf%}="get_error"
'
zlib_get_error%=C:ldg_find%(L:shell_buf%,L:zlib_ldg_ptr%)
IF zlib_get_error%=0
RETURN FALSE
ENDIF
'
CHAR{shell_buf%}="get_compil_flags"
'
zlib_get_compil_flags%=C:ldg_find%(L:shell_buf%,L:zlib_ldg_ptr%)
IF zlib_get_compil_flags%=0
RETURN FALSE
ENDIF
'
CHAR{shell_buf%}="get_sizeof_stream_struct"
'
zlib_get_sizeof_stream_struct%=C:ldg_find%(L:shell_buf%,L:zlib_ldg_ptr%)
IF zlib_get_sizeof_stream_struct%=0
RETURN FALSE
ENDIF
'
CHAR{shell_buf%}="raw_deflate_init"
'
zlib_deflate_init%=C:ldg_find%(L:shell_buf%,L:zlib_ldg_ptr%)
IF zlib_deflate_init%=0
RETURN FALSE
ENDIF
'
CHAR{shell_buf%}="raw_deflate"
'
zlib_deflate%=C:ldg_find%(L:shell_buf%,L:zlib_ldg_ptr%)
IF zlib_deflate%=0
RETURN FALSE
ENDIF
'
CHAR{shell_buf%}="raw_deflate_end"
'
zlib_deflate_end%=C:ldg_find%(L:shell_buf%,L:zlib_ldg_ptr%)
IF zlib_deflate_end%=0
RETURN FALSE
ENDIF
'
CHAR{shell_buf%}="raw_inflate_init"
'
zlib_inflate_init%=C:ldg_find%(L:shell_buf%,L:zlib_ldg_ptr%)
IF zlib_inflate_init%=0
RETURN FALSE
ENDIF
'
CHAR{shell_buf%}="raw_inflate"
'
zlib_inflate%=C:ldg_find%(L:shell_buf%,L:zlib_ldg_ptr%)
IF zlib_inflate%=0
RETURN FALSE
ENDIF
'
CHAR{shell_buf%}="raw_inflate_end"
'
zlib_inflate_end%=C:ldg_find%(L:shell_buf%,L:zlib_ldg_ptr%)
IF zlib_inflate_end%=0
RETURN FALSE
ENDIF
'
CHAR{shell_buf%}="update_crc32"
'
zlib_crc%=C:ldg_find%(L:shell_buf%,L:zlib_ldg_ptr%)
IF zlib_crc%=0
RETURN FALSE
ENDIF
'
CHAR{shell_buf%}="mem.ldg"
'
ldg_mem_ptr%=C:ldg_open%(L:shell_buf%,L:global%)
IF ldg_mem_ptr%>0
'
CHAR{shell_buf%}="ldg_malloc"
'
ldg_mem_malloc_ptr%=C:ldg_find%(L:shell_buf%,L:ldg_mem_ptr%)
'
CHAR{shell_buf%}="ldg_free"
'
ldg_mem_free_ptr%=C:ldg_find%(L:shell_buf%,L:ldg_mem_ptr%)
'
ENDIF
'
RETURN TRUE
ENDIF
RETURN FALSE
ENDFUNC
Remarques :
En fait, le PKZIP est tout à fait gérable en GFA pur (et mon code GFA le gère en natif), mais sans compression. Un PKZIP est en fait une liste de structures,
avec à côté des fichiers compressés, ou pas. On dit "encapsuler", c'est-à-dire qu'on place une ou plusieurs choses (ici des fichiers, traités ou non par
compression et/ou cryptage) dans un contenant (qui sera lui-même un fichier).
Vu que le GFA est un peu faible niveau traitement, on externalise les fonctions qui demandent du calcul, comme la compression/décompression, dans une librairie codée en C, déjà écrite, comme la zlib.
Ici, la librairie va s'occuper de l'algorithme de compression nommé DEFLATE (dégrossir, compresser), et son contraire, INFLATE (grossir, décompresser).
La documentation officielle du PKZIP se trouve chez PKware.
Je vous renvoie aux sources de KK Commander, pour une gestion de .ZIP complète, et vers Crésus, pour une version allégée, qui crée un .ZIP de novo, puis ajoute les fichiers un par un, dans
l'optique d'archivage. D'ailleurs, j'ai eu assez de mojo pour en faire un programme exemple à part, merci de voir dans le dossier bonux.
A vous d'adapter le BIG_ZEE.GFA à vos besoins, si votre application de-la-mort-qui-tue a besoin de quelques fonctions d'archivage.
A noter que vous ne comprendez pas grand chose au code si vous n'avez pas lu d'abord la documentation de PKware. Une fois le APPNOTE.TXT lu de long en large et prêt à le réciter de mémoire (Shakespeare, c'est mieux mais on va pas en faire un programme), alors cela deviendra limpide. Quelques remarques cependant :
Heu, j'aillais dire "à la prochaine !", mais vu l'âge avancé du capitaine qui mérite bien sa retraite, on dira : "Tchuss".
Rajah Lone
écrit en 2009