Utilisation de Turbo Pascal 7.0

La mémoire XMS est gérée par le pilote HIMEM.SYS, chargé automatiquement par Windows (et très souvent par DOS). Ce pilote permet d'accéder à toute la mémoire RAM disponible sur l'ordinateur (contrairement à Turbo Pascal, programme 16 bits, qui est limité à 640 Ko).

Toutes les fonctions XMS passent par l'interruption 2Fh (interruption qui regroupe plusieurs extensions, comme le pilote de CD-ROM MSCDEX) et la fonction 43h. Oui, il faut faire de l'assembleur.

Si une erreur se produit (AX = 0), BL contient le code d'erreur ; sinon AX est différent de 0. Je ne vais pas détailler toutes les fonctions, car, premièrement, je ne les connais pas, et, deuxièmement, j'ai une unité qui fait ça très bien. J'ai menti (j'avoue) : l'unité n'est pas entièrement de moi, je me suis beaucoup basé sur une autre unité (dont la source n'était pas indiquée), ce qui veut dire que je ne suis pas un expert en mémoire XMS. L'unité s'appelle « XMS.PAS » (elle est dans le pack de toutes mes unités).

Le pilote pour la mémoire XMS n'est pas toujours disponible (il arrive que HIMEM.SYS ne soit pas chargé). Il est donc obligatoire (sous peine de plantage ou d'erreurs inexpliquées) d'appeler : « VerifiePresenceXms » au démarrage de votre programme. Celui-ci affichera un message d'erreur standard si le pilote n'est pas présent. Dans la version 0.4 de l'unité, ça donne :

Le driver XMS n'est pas installé !

[ Sous DOS ]
-> Vérifiez que vous avez bien la ligne 'DEVICE=C:\WINDOWS\HIMEM.SYS' dans le fichier Config.sys

[ Sous Windows 95/98 ]
-> 'Cliquez avec le bouton droit sur le programme, choisissez 'Propriétés'. Dans l'onglet 'Mémoire'', sous ''Mémoire XMS'', choisissez 'Auto'.

Pour allouer de la mémoire, utilisez la fonction « AlloueMemXms » (j'ai essayé de donner des noms parlants !). La taille du « bloc » demandé est donnée en kilooctets. Malgré l'appellation « kilo », 1 kilooctet = 1024 octets. Pour convertir les octets en kilooctets, il faut diviser par 1024 et arrondir par défaut (car écrire hors du bloc XMS provoque une erreur !). Pour cela, tapez : « Taille := Taille div 1024 +1; » ou plus rapidement « Taille := Taille shr 10 +1; ». « shr d » est un décalage binaire de d bits vers la droite (R = Right = Droite en anglais). Donc shr n = div (2^n) et 2^10 = 1024 !

Il faut taper {$G+} au début de votre programme pour pouvoir utiliser cette instruction (elle utilise alors les instructions du 80286 - dire qu'on en est au 686 !).

Chaque « bloc » de mémoire alloué est désigné par un « handle », c'est un nombre de type Word (valeur entre 0 et 65535), mais sa valeur ne peut pas être 0 (on verra plus tard).

Fonction AlloueMemXms ! « Function AlloueMemXms (Taille: word) : word; ».

C'est tout simple : « RendMemXms ». Il faut juste donner comme paramètre le handle renvoyé par AlloueMemXms : « Procedure RendMemXms (Handle: word); ».

Exemple :

uses Xms;
var MaMem: Word; Taille: LongInt;
begin
  { Vérifie la présence du driver XMS }
  VerifiePresenceXms;

  Taille := 81530; { 81 530 octets } 
  MaMem := AlloueMemXms (Taille shr 10 +1);
  Writeln ("Ma mémoire est allouée");
  RendMemXms (MaMem);
end.

Voilà, on a de la mémoire disponible, voyons comment y accéder maintenant. La solution la plus pratique est de « verrouiller » un bloc mémoire pour qu'il soit accessible via un pointeur : « Function VerrouilleBlocXms (Handle : word) : pointer; ». Le problème est que ça ne fonctionne pas toujours… Je n'ai donc jamais utilisé cette méthode. Peut-être que je m'y prends mal, à vous de tester. Personnellement, je crée un tampon de 64 Ko (taille maximale avec Turbo Pascal, car c'est un programme 16 bits : 2^16 = 65536 octets !) avec GetMem :

{ Réglage de la mémoire requise : 4 Ko de pile (éventuellement 8 Ko), }
{ et 65 Ko de mémoire allouables dynamiquement, c'est-à-dire avec GetMem. }
{ Remarque : XMS n'entre pas du tout en compte } 
{$M 4096,0,65536}
uses StopProg;
type
  TamponMax = Array[0..$FFFE] of Byte; { Accessible octet/octet }
  PtrTampon = ^TamponMax;
var
  Tampon: PtrTampon;
  txt: String;

begin
  { Assez de mémoire libre ? }
  if MemAvail<$FFFF then begin
    Str ($FFFF-MemAvail,txt);
    StopProgramInfo ('allocation du tampon de transfert','Mémoire libre insuffisante','manque '+txt+'octets');
  end;

  GetMem (Tampon,$FFFF); { $FFFF = 65535 octets }
  Tampon^[0] := 0; { On accède au tampon avec ^[i] où i est l'index de l'octet à modifier }
  fillchar (Tampon^,65535,23); { Remplit le tampon avec la valeur Byte 23 }
  FreeMem (Tampon,$FFFF);
end.

Maintenant que nous avons de la mémoire XMS et un tampon de transfert, voyons comment passer de l'un à l'autre. Le cœur de l'accès à la mémoire XMS est « CopieXms », c'est une variable de l'unité XMS du type « StructCopieXms ». Voyons ce type :

Après avoir initialisé la structure CopieXms, il faut appeler la procédure « CopieMemXms » avec comme paramètre CopieXms (ou un autre StructCopieXms de votre choix) : « Procedure CopieMemXms (var StructCopie: StructCopieXms); ».

Il faut vérifier après chaque appel de fonction ou procédure qu'aucune erreur ne s'est produite. Pour cela, pas de procédure standard, je vous ai laissé programmer la vôtre. Cela vous permettra de choisir d'afficher les erreurs en mode texte ou en mode graphique, et d'afficher ce que vous voulez.

Je vous offre quand même ma procédure standard que j'intègre dans tous mes programmes (fonctionne en mode texte couleur uniquement ; nécessite les unités EcranTxt, Clavier et Convert) :

procedure TestErreurXms (Quand: String);
begin
  { Aucune erreur, rien à signaler }
  if ErreurXms=0 then exit;

  {=== En cas d'erreur : efface l'écran, affiche l'erreur, puis stoppe le programme ===} 
  EffaceEcranTxt;
  EcriTcr ('Erreur lors de '+Quand+' (n°'+Hex8z(ErreurXms)+') :',12);
  Ecrit ('=> '); EcriTcr (TxtErreurXms+' !',15);
  SauteLigne;
  EcriTcr ('[ Info pour le débogage ]',15+3*16);
  with CopieXms do begin
    Ecrit ('Taille = '); EcriTncr (Taille,10);
    Ecrit ('SrcHdl = '); EcriTncr (SrcHdl,10);
    Ecrit ('SrcOfs = '); EcriTnc (SrcOfs,10);
    Ecrit (' ('); EcriTc (Hex16z(SrcOfs shr 16)+':'+Hex16z(SrcOfs and $FFFF),10); EcriTr (')');
    Ecrit ('DstOfs = '); EcriTnc (DstOfs,10);
    Ecrit (' ('); EcriTc (Hex16z(DstOfs shr 16)+':'+Hex16z(DstOfs and $FFFF),10); EcriTr (')');
    Ecrit ('Mémoire XMS libre = '); EcriTnc (MemXmsLibre,10); EcriTr (' Ko');
  end;
  SauteLigne;

  { Attend la pression d'une touche }
  Ecrit ('Pressez une touche pour finir :'); LitTouche; EffaceLigneTxt;

  { Libère la mémoire XMS allouée }
  RendMemXms (TamponTexte);

  { Stoppe le programme }
  Halt (8);
end;

Cette procédure doit être appelée après chaque appel à une fonction de l'unité XMS avec comme paramètre un texte expliquant l'opération que l'on voulait exécuter (qui sera précédé de « Erreur lors de « ). Exemple : pour allouer de la mémoire, on tapera « TestErreurXms ('l''allocation d''un tampon mémoire'); ».

Autre point : restituer la mémoire allouée en cas d'erreur. La solution la plus simple est de créer une procédure (nommée « LibereMemAllouee » par exemple) qui sera exécutée en cas d'erreur avant d'arrêter l'exécution du programme (appel de « Halt »). Si vous utilisez mon unité StopProg, vous pouvez mettre cette procédure en appel far (par la directive « far; » écrite juste avant begin ou var), puis la rentrer dans la variable « ProcAppeleeStop » (procédure appelée lorsque le programme stoppe son exécution :-). Exemple :

{ uses StopProg; }

procedure LibereMemAllouee; { Aucun paramètre }
far; { Adressage long}
var ...
begin
  { Libère la mémoire allouée dynamiquement }
  Dispose (Tampon);

  { Libère la mémoire XMS }
  RendMemXms (MonHandle);
end;

begin
  { … }
  { En cas d'erreur : libère la mémoire allouée } 
  ProcAppeleeStop := LibereMemAllouee;
  { … }
  { Libère la mémoire allouée en fin de programme } 
  LibereMemAllouee;
end.

Merci à Claude LELOUP pour ses corrections.