LEX 'FORMALEX' ID #71 MSG 0 POLL 0 ENTRY CENTER CHAR #F ENTRY CESURE CHAR #F ENTRY FORMAT CHAR #F ENTRY REDUCE CHAR #F ENTRY SPACE CHAR #F * Syntaxe: KEY 'CENTER$' CENTER$(A$,N) TOKEN 34 KEY 'CESURE' CESURE(A$,N) TOKEN 35 KEY 'FORMAT$' FORMAT$(A$,N) TOKEN 36 KEY 'REDUCE$' REDUCE$(A$) TOKEN 37 KEY 'SPACE$' SPACE$(N) TOKEN 38 ENDTXT REVPOP EQU #0BD31 REV$ EQU #1B38E EXPR EQU #0F23C HDFLT EQU #1B31B FNRTN4 EQU #0F238 AVMEMS EQU #2F594 MEMERR EQU #0944D MFERR EQU #09393 IDIVA EQU #0EC6E D=AVMS EQU #1A460 RNDAHX EQU #136CB STKCHR EQU #18504 ARGERR EQU #0BF19 POP1S EQU #0BD38 CSLC5 EQU #1B435 flag EQU 0 boucle EQU 1 caract EQU 2 ADHEAD EQU #181B7 CSRC5 EQU #1B41B ************************************************** * reduire * But: enlever tous les espaces superflus d'une * chaÑne de caractÉres. ************************************************** reduire SETHEX HEX pour POP1S GOSBVL POP1S CD0EX C=pointeur programme GOSBVL CSLC5 C=.......D0...... CD1EX C=.......D0 D1 C=C+A A C=.......D0 (D1+long) R1=C R1=...[D0][D1+A] D0=C D0=^dÅbut de la chaÑne D1=C D1= idem D=0 A D[A]=Nb d'emplacements * (espaces de la chaÑne * rÅduite) ST=1 flag Il faut enlever les * blancs suivant ST=0 boucle aucun passage dans la * boucle ST=0 caract CaractÉre non blanc non * rencontrÅ LCASC ' ' C=' ' B=C B B[B]=32 (espace) EnlÉve A=A-1 A Longueur en quartets GOC Fin Saut si longueur nulle ST=1 boucle au moins un passage dans * la boucle A=A-1 A quartets... D0=D0- 2 caractÉre suivant C=DAT0 B Il est recopiÅ dans C ?C#B B est-ce un espace ? GOYES noblan non ?ST=1 flag Si non, est-ce le premier * d'une sÅrie ? GOYES EnlÉve non, alors on le nÅglige D=D+1 A oui: un emplacement * supplÅmentaire ST=1 flag C'est le premier d'une * sÅrie GONC ajoute B.E.T. noblan ST=0 flag Premier d'une sÅrie: * aucun sens, puisque non * blanc ST=1 caract Au moins un caractÉre non * blanc dans la chaÑne ajoute D1=D1- 2 On range le caractÉre * C[B] ds la chaÑne rÅduite. DAT1=C B GONC EnlÉve B.E.T. Fin ?ST=0 flag GOYES nonnul ?ST=0 boucle GOYES nonnul ?ST=0 caract GOYES nonnul D1=D1+ 2 Si le dernier caractÉre * Åtait un blanc, on * l'enlÉve, D=D-1 A ainsi que du nombre * d'emplacements nonnul RTN ************************************************** * SPACE$ * ************************************************** NIBHEX 811 SPACE GOSBVL RNDAHX GOC positif A=0 A positif D1=D1+ 16 CD1EX D1=C R1=C GOSBVL D=AVMS GOSUB stkblc GOC ret2 stkblc LCASC ' ' On charge " " dans C(B) GONC test Reste-t-il des caractÉres * È empiler ? (B.E.T.) bsp GOSBVL STKCHR Oui: on empile un blanc * devant la chaÑne * alphanumÅrique. test A=A-1 A A(A) sert de compteur. GONC bsp Boucle si A>=0 RTN ************************************************** * REDUCE$ * ************************************************** NIBHEX 411 REDUCE GOSUB reduire ************************************************** * retour * But: assurer le retour È l'environnement Basic, * et prendre en charge la restauration des * pointeurs. ************************************************** retour C=R1 C=....D0... GOSBVL CSRC5 C=.......D0 CD0EX D0=pgm counter ret2 ST=0 0 ADHEAD ne rend pas la main GOSBVL D=AVMS GOVLNG ADHEAD argerr GOVLNG ARGERR ************************************************** * CENTER$ * ************************************************** NIBHEX 8422 CENTER GOSUB Argnum Pop, teste et convertit en * HEXA le paramÉtre * numÅrique. GOSBVL REVPOP "Pop", test et renverse * la chaÑne alphanumÅrique. * En sortie de routine, D1 * pointe aprÉs l'en-tÁte de * la chaÑne. CD1EX Chargement dans C(A) de * la valeur de D1. D1=C Restitution. C=C+A A C(A) = maintenant * l'adresse de fin de chaÑne * (utilisÅ plus loin par la * routine ADHEAD). R1=C Sauvegarde dans R1 pour * Átre utilisÅ dans ADHEAD. GOSBVL D=AVMS D(A) = AVMEMS (AVailable * MEMory Start). L'opÅration * est faite maintenant car * la routine utilise C(A). C=R0 On charge dans C(A) la * valeur du paramÉtre * numÅrique. C=C+C A C(A) = paramÉtre * numÅrique en quartets. GOC argerr En cas de dÅpassement, * l'argument Åtait supÅrieur * È la longueur maxi. d'une * chaÑne: ERREUR. ?A=0 A La longueur de la chaÑne * est-elle nulle ?? GOYES FIN Si oui: FIN. ?C<=A A La longueur de la chaÑne * >= È la longueur demandÅe? GOYES FIN Si oui: on renvoie * simplement la chaÑne. C=C-A A Calcul du nombre de * blancs: C(A) = 4 fois le * nombre de blancs. A=0 M ) Division de C(A) A=C A ) par 4 ASRB ) et restitution dans A(A) ASRB ) en octets. GOSUB stkblc FIN ST=1 0 Obligatoire pour un bon * retour de ADHEAD. GOSBVL ADHEAD Mise en place de * l'en-tÁte de la nouvelle * chaÑne. GOSBVL REV$ On renverse È nouveau * avant le GOVLNG EXPR retour È BASIC. ************************************************** * Argnum * But: renvoyer le paramÉtre qui est sur la pile, * dÃement vÅrifiÅ et testÅ (>0). * Le nombre est renvoyÅ dans A(A) et R0(A) en hexa * En sortie, on a Carry=0 ************************************************** Argnum GOSBVL RNDAHX A(A)=nombre hexa GONC argerr Argument Error si <0 ?A=0 A ParamÉtre nul GOYES argerr ... alors Arg. Error D1=D1+ 16 POPer le paramÉtre R0=A et le mettre dans R0 RTN memerr GOVLNG MEMERR ************************************************** * FORMAT$ * ************************************************** NIBHEX 8422 FORMAT GOSUB Argnum A[A],R0[A]=nombre hexa GOSUB reduire C=R1 C=......(^dÅbut de la * chaÑne) A=R0 A=paramÉtre C=C-A A GOC memerr C=C-A A C=^fin de la chaÑne * formattÅe GOC memerr R2=C R2=^fin de la chaÑne * formattÅe A=C A Pour transfert ensuite * dans D0 D0=C } D0=D0+ 16 }+16 pour l'en-tÁte GOC memerr } CD0EX } D0=(5) AVMEMS AD0EX ?C<=A A a-t-on depassÅ AVMEMS ? GOYES memerr non: pas d'erreur C=R1 C=^dÅbut de la chaÑne A=0 W } A=C A } A=00....000 ^dÅbut CD1EX C=^fin de la chaÑne * rÅduite D1=C D1= idem A=A-C A A=longueur rÅduite ASRB ... en octets C=R0 C=longueur formattÅe ?A>C A erreur si long(rÅduite) > * long(formattÅe) GOYES strovf ?A=C A Retour si chaÑne dÅjÈ * formattÅe... GOYES retouR A=A+1 A long(chaÑne rÅduite) ?D=0 A Peut-on mettre des blancs? GOYES retouR non: la chaÑne rÅduite * est renvoyÅe A=A-C A A=-A A C=D A R3=C R3= nb total * d'emplacements GOSBVL IDIVA A/C P= 0 P=15 aprÉs IDIVA * A: Quotient B:C: Reste * Il faut mettre C fois * A+1 blancs * et (le reste) fois A * blancs R0=C R0 <- C B=A A B=B+1 A GOSUB rajout A=R0 A=longueur de la chaÑne * formattÅe C=R3 C=nb total d'emplacements C=C-A A C=(le reste) B=B-1 A (un espace en moins par * boucle) GOSUB rajout C=R2 D1=C pointeur de pile-math retouR GOTO retour ************************************************** * strovf * But: renvoyer l'erreur "DÅpassement de chaÑne" * (pour les heureux possesseurs de FRALEX). * Pour les autres, il n'y a plus rien È faire... ************************************************** strovf LC(2) 37 String Overflow GOVLNG MFERR * rajout * But: rajouter C(A) espaces È la chaÑne ************************************************** rajout D=C A D=compteur. LCASC ' ' C=' ' GOTO bool bb A=DAT1 B Recopier le dernier * caractÉre de la chaÑne * rÅduite D1=D1+ 2 DAT0=A B dans la chaÑne formattÅe D0=D0+ 2 ?C#A B est-ce un espace ? GOYES bb non: on continue A=B A Boucle interne sur A. * Elle est exÅcutÅe A fois GONC b2 recopie DAT0=C B Un espace de plus dans la * chaÑne formattÅe D0=D0+ 2 b2 A=A-1 A GONC recopie On continue tant que A>=0 D=D-1 A Un emplacement de moins bool ?D#0 A Est-ce le dernier * emplacement ? GOYES bb Non, on continue RTN Oui: retour È l'envoyeur ************************************************** * CESURE * ************************************************** NIBHEX 8422 CESURE GOSUB Argnum Retourne un nombre HEXA * dans A(A) et R0(A) B=A A Sauvegarde de la cÅsure * dans B(A). GOSBVL POP1S VÅrifie que l'on est bien * en prÅsence d'une chaÑne * et retourne sa longueur * dans A(A). C=A A Division de A(A) par 2. A=0 M " A=C A " ASRB " CD1EX C(A) ^ DÅbut de la * chaÑne. D1=C " C=C+A A " C=C+A A " D=C A On sauvegarde l'adresse de * dÅbut de chaÑne dans D(A) ?A