home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 26 / CD_ASCQ_26_1295.iso / voxrom / textes / repwin08 / annexes / squirrel / mem2 / memory.pas next >
Pascal/Delphi Source File  |  1995-10-01  |  35KB  |  1,194 lines
  1. Unit memory;
  2.  
  3.  
  4. INTERFACE
  5.  
  6. {================== EMS ====================================================}
  7.  
  8. Var   Ems_Ver  : word;
  9.       Ems_Seg  : word;
  10.  
  11. Function Ems_Err (n : byte) : string;
  12. Function Ems_Map (handle, logik : word; Physik : byte) : byte;
  13. Function Ems_SaveMap (handle : word) : byte;
  14. Function Ems_RestoreMap (handle : word) : byte;
  15. Function Ems_Alloc (var handle : word; nbpages : word) : byte;
  16. Function Ems_UnAlloc (handle : word) : byte;
  17. Function Ems_GetTotalPages : word;
  18. Function Ems_GetFreePages : word;
  19. Function Ems_GetNbPages (handle : word) : word;
  20. Function Ems_GetNbHandles : word;
  21. Function Ems_GetHandles (var handles) : byte;
  22. Function Ems_State : byte;
  23. Function IsEms : boolean;
  24.  
  25. {================== XMS/HMA/UMB ============================================}
  26.  
  27. Var   Xms_Ver       : word;
  28.       Xms_Rev       : word;      { Révision interne }
  29.       Xms_Proc      : procedure;
  30.       Xms_Errflag   : byte;
  31.  
  32. Type  ExMM = record    { si un handle = 0 alors mémoire conventionelle }
  33.         size       : longint;   { Taille à déplacer }
  34.         src_handle : word;      { Handle Source }
  35.         src_offset : longint;   { Offset de début du bloc source }
  36.         cib_handle : word;      { Handle Cible }
  37.         cib_offset : longint;   { Offset de début du bloc cible }
  38.       end;
  39.  
  40. Function isXms : boolean;
  41. Function Xms_Err (n : byte) : string;
  42. Function Xms_ok : boolean;
  43.  
  44. Function Xms_GetHMA : boolean;
  45. Function Xms_ReleaseHMA : boolean;
  46. Function Xms_A20unlock : boolean;
  47. Function Xms_A20lock : boolean;
  48. Function Xms_A20localunlock : boolean;
  49. Function Xms_A20locallock : boolean;
  50. Function Xms_A20unlocked : boolean;
  51.  
  52. Function Xms_MaxAvail : word;
  53. Function Xms_MemAvail : word;
  54. Function Xms_Alloc (var handle : word; nbko : word) : boolean;
  55. Function Xms_UnAlloc (handle : word) : boolean;
  56. Function Xms_move (var e : ExMM) : boolean;
  57. Function Xms_Lock (handle : word) : boolean;
  58. Function Xms_UnLock (handle : word) : boolean;
  59. Function Xms_NbLocked (handle : word) : byte; { Nombre de verrouillages }
  60. Function Xms_GetEMBsize (handle : word) : word; { Taille en ko }
  61. Function Xms_SetEMBsize (handle, NewSizeInko : word) : boolean;
  62.  
  63. Function Xms_UMBAlloc (size : word) : word;   { Retourne l'adresse }
  64. Function Xms_UMBMaxAvail : word;   { taille du + gd bloc }
  65. Function Xms_UMBunAlloc (segm : word) : boolean;
  66.  
  67. {================== Mémoire DOS/MCBs =======================================}
  68.  
  69. Type  mcb      = record
  70.         id     : char;                        { M = à suivre, Z = dernier }
  71.         pspseg : word;                      { Adresse du psp père du bloc }
  72.         size   : word;                          { Taille du block mémoire }
  73.         unused : array[1..3] of byte;                      { Pas touche ! }
  74.         name   : array[1..8] of char;               { DOS 4.x + seulement }
  75.       end;
  76.  
  77.       ddhptr   = ^ddh;
  78.       ddh      = record
  79.         next          : ddhptr;
  80.         attr          : word;     { attributs }
  81.         strategiePROC : word;
  82.         interruptPROC : word;
  83.         name          : array[1..8] of char;
  84.       end;
  85.  
  86.       psp      = record
  87.         int20h    : word;
  88.         endseg    : word;
  89.         reserved1 : byte;
  90.         int21h    : word;
  91.         int22h    : word;
  92.         int23h    : word;
  93.         int24h    : word;
  94.         reserved2 : array[1..22] of byte;
  95.         envBlock  : word;    { adresse de segment de l'environnement }
  96.         reserved3 : array[1..46] of byte;
  97.         fcb1      : array[1..16] of byte;
  98.         fcb2      : array[1..20] of byte;
  99.         command   : string[127];
  100.       end;
  101.  
  102. Function xm_FreeMem (var P: Pointer) : byte;
  103. Function xm_GetMem  (var P: Pointer; Size: longint) : byte;
  104. Function xm_SetMem  (var P: Pointer; Size: longint) : byte;
  105. Function xm_MaxAvail : longint;
  106. Function xm_GetSize (P: Pointer) : longint;
  107. Function xm_useUMB (use : boolean) : boolean;
  108. Function xm_isUMB : boolean;
  109. Function xm_SetStrategy (strategy : word) : boolean;
  110. Function xm_GetStrategy : byte;
  111. Function GetDIB : pointer;
  112.  
  113.  
  114. {==================== Fonctions systèmes ===================================}
  115.  
  116. Const Seg0000 : word = 0;
  117. Const xm_ok          = 0;
  118.       xm_mcb_failure = 7;
  119.       xm_no_more_mem = 8;
  120.       xm_not_mcb     = 9;
  121.  
  122. Procedure SetIntVec (IntNo: word; Vector: Pointer);
  123. Procedure GetIntVec (IntNo: word; var Vector: Pointer);
  124. Procedure SetInDos;
  125. Function  GetInDos   : byte;
  126. Procedure SetPsp  (s : word);
  127. Function  GetPsp     : word;
  128. Function  ExePath    : string;
  129. Procedure Move     (Var Source, Dest;   Count: Word);
  130. Procedure Xchg     (Var Source, Dest;   Count: Word);
  131. Procedure FillChar (Var X; Count: Word; value: byte);
  132. Procedure FillWord (Var X; Count: Word; value: word);
  133. Procedure FillLong (Var X; Count: Word; value: longint);
  134. Function  DosVersion : word;
  135. Function  PHexa (n : pointer) : string;
  136. Function  Hexa (n : word) : string;
  137.  
  138. IMPLEMENTATION
  139.  
  140. {██████████████████████████████████████████████████████████████████████
  141.  ╔════════════════════════════════════════════════════════════════════╗
  142.  ║ Fonctions systèmes utilisées plus loin (pour certaines)            ║
  143.  ╚════════════════════════════════════════════════════════════════════╝
  144.  ██████████████████████████████████████████████████████████████████████}
  145.  
  146.  
  147. {╔═════════════╤═══════════════════════════════════════════════════════════╗
  148.  ║ Unit memory │ Renvoie la valeur hexa d'un pointeur                      ║
  149.  ║─────────────┴───────────────────────────────────────────────────────────╢
  150.  ║ La chaine de sortie est au format SSSS:OOOO                             ║
  151.  ╚═════════════════════════════════════════════════════════════════════════╝}
  152. const hex : array[0..15] of char = '0123456789ABCDEF';
  153.  
  154. Function  PHexa (n : pointer) : string;
  155. var i  : byte;
  156.     s  : string[9];
  157. begin
  158.   s[0] := #8;
  159.   for i := 1 to 8 do begin
  160.     s[9-i] := hex[longint(n) AND 15];
  161.     longint(n) := longint(n) shr 4;
  162.   end;
  163.   insert (':', s, 5);
  164.   Phexa := s;
  165. end;
  166.  
  167. {╔═════════════╤═══════════════════════════════════════════════════════════╗
  168.  ║ Unit memory │ Renvoie la correspondance hexa d'un nombre                ║
  169.  ║─────────────┴───────────────────────────────────────────────────────────╢
  170.  ║ La chaine de la sortie est ajusté au nombre de chiffres du nombre.      ║
  171.  ╚═════════════════════════════════════════════════════════════════════════╝}
  172. Function  Hexa (n : word) : string;
  173. var i  : byte;
  174.     s  : string[8];
  175. begin
  176.   s := '';
  177.   for i := 1 to 4 do begin
  178.     s := hex[n AND 15] + s;
  179.     n := n shr 4;
  180.   end;
  181.   hexa := s;
  182. end;
  183.  
  184. {╔═════════════╤═══════════════════════════════════════════════════════════╗
  185.  ║ Unit memory │ Renvoie la version du Système d'exploitation              ║
  186.  ║─────────────┴───────────────────────────────────────────────────────────╢
  187.  ║ Au format binaire, l'octet fort contient la version majeure et le       ║
  188.  ║ faible la version mineure                                               ║
  189.  ╚═════════════════════════════════════════════════════════════════════════╝}
  190. Function DosVersion : word;
  191. assembler; asm
  192.   mov  ah, 30h
  193.   int  21h
  194.   xchg al, ah
  195. end;
  196.  
  197. {╔═════════════╤═══════════════════════════════════════════════════════════╗
  198.  ║ Unit memory │ Echange deux parties de mémoires                          ║
  199.  ║─────────────┴───────────────────────────────────────────────────────────╢
  200.  ║ A la difference de Move, Xchg intervertit les données sources et cible. ║
  201.  ╚═════════════════════════════════════════════════════════════════════════╝}
  202. Procedure Xchg     (Var Source, Dest;    Count : Word);
  203. assembler; asm     { Pas de 32 bits ici, gain de temps insignifiant }
  204.   push ds
  205.   mov  cx, count
  206.   les  di, Dest
  207.   lds  si, Source
  208.  
  209.   shr  cx, 1
  210.   @:mov  ax, es:[di]   { cible  --> buffer }
  211.     movsw              { source --> cible  }
  212.     mov  ds:[si-2], ax { cible  --> source }
  213.   loop @
  214.   jnc  @fin
  215.  
  216.   mov  al, es:[di]
  217.   movsb
  218.   mov  ds:[si-1], al
  219.  
  220.   @fin:
  221.   pop  ds
  222. end;
  223.  
  224. {╔═════════════╤═══════════════════════════════════════════════════════════╗
  225.  ║ Unit memory │ Copie une partie de mémoire sur une autre                 ║
  226.  ║─────────────┴───────────────────────────────────────────────────────────╢
  227.  ║ Move est identique à system.move, mais bien plus rapide, car en 32bits. ║
  228.  ╚═════════════════════════════════════════════════════════════════════════╝}
  229. Procedure Move     (Var Source, Dest;    Count : Word);
  230. assembler; asm
  231.   push ds
  232.   cmp  test8086, 1
  233.   mov  cx, count
  234.   les  di, Dest
  235.   lds  si, Source
  236.   ja   @32
  237.  
  238.   @16:          { 8086 & 286 }
  239.   shr  cx, 1
  240.   rep  movsw
  241.   rcl  cx, 1
  242.   rep  movsb
  243.   jmp  @fin
  244.  
  245.   @32:          { 386 & 486  }
  246.   mov  bx, cx
  247.   shr  cx, 2
  248. { rep  movsd } db $F3,$66,$A5
  249.   mov  cx, bx
  250.   and  cx, 3
  251.   rep  movsb
  252.  
  253.   @fin:
  254.   pop  ds
  255. end;
  256.  
  257. {╔═════════════╤═══════════════════════════════════════════════════════════╗
  258.  ║ Unit memory │ Remplit une zone mémoire de n octets identiques           ║
  259.  ║─────────────┴───────────────────────────────────────────────────────────╢
  260.  ║ FillChar fonctionne comme system.fillchar, mais est optimisée en 32bits ║
  261.  ╚═════════════════════════════════════════════════════════════════════════╝}
  262. Procedure FillChar (Var X; Count : Word; value : byte);
  263. assembler; asm
  264.   les  di, X
  265.   mov  cx, count
  266.   mov  al, value
  267.   cmp  test8086, 1
  268.   ja   @32
  269.  
  270.   @16:
  271.   mov  ah, al
  272.   shr  cx, 1
  273.   rep  stosw
  274.   rcl  cx, 1
  275.   rep  stosb
  276.   jmp  @fin
  277.  
  278.   @32:
  279.   mov  ah, al
  280.   push ax
  281.   push ax
  282. { pop  eax   } db $66,$58
  283.   mov  bx, cx
  284.   and  cx, 3
  285.   rep  stosb
  286.   mov  cx, bx
  287.   shr  cx, 2
  288. { rep  stosd } db $F3,$66,$AB
  289.  
  290.   @fin:
  291. end;
  292.  
  293. {╔═════════════╤═══════════════════════════════════════════════════════════╗
  294.  ║ Unit memory │ Remplit une zone mémoire de n words identiques            ║
  295.  ║─────────────┴───────────────────────────────────────────────────────────╢
  296.  ║ Comme FillChar, mais l'unité de base est ici le word.                   ║
  297.  ╚═════════════════════════════════════════════════════════════════════════╝}
  298. Procedure FillWord (Var X; Count : Word; value : word);
  299. assembler; asm
  300.   les  di, X
  301.   mov  cx, count
  302.   mov  ax, value
  303.   cmp  test8086, 1
  304.   ja   @32
  305.  
  306.   @16:
  307.   rep  stosw
  308.   jmp  @fin
  309.  
  310.   @32:
  311.   push ax
  312.   push ax
  313. { pop  eax   } db $66,$58
  314.   shr  cx, 1
  315. { rep  stosd } db $F3,$66,$AB
  316.   rcl  cx, 1
  317.   rep  stosw
  318.  
  319.   @fin:
  320. end;
  321.  
  322. {╔═════════════╤═══════════════════════════════════════════════════════════╗
  323.  ║ Unit memory │ Remplit une zone mémoire avec n dwords identiques         ║
  324.  ║─────────────┴───────────────────────────────────────────────────────────╢
  325.  ║ Comme FillChar et FillWord, FillLong remplit, mais avec des longint.    ║
  326.  ╚═════════════════════════════════════════════════════════════════════════╝}
  327. Procedure FillLong (Var X; Count : Word; value : longint);
  328. assembler; asm
  329.   les  di, X
  330.   mov  cx, count
  331.   mov  ax, word ptr value
  332.   mov  dx, word ptr value +2
  333.   cmp  test8086, 1
  334.   ja   @32
  335.  
  336.   @16: mov  es:[di+0], ax
  337.        mov  es:[di+2], dx
  338.        add  di, 4
  339.        loop @16
  340.   jmp  @fin
  341.  
  342.   @32:
  343.   push dx
  344.   push ax
  345. { pop  eax   } db $66,$58
  346. { rep  stosd } db $F3,$66,$AB
  347.  
  348.   @fin:
  349. end;
  350.  
  351.  
  352. {╔═════════════╤═══════════════════════════════════════════════════════════╗
  353.  ║ Unit memory │ Renvoie le répertoire où est le programme .exe tournant   ║
  354.  ║─────────────┴───────────────────────────────────────────────────────────╢
  355.  ║ La fonction ne fait la recherche qu'une fois, lors de son 1° appel      ║
  356.  ╚═════════════════════════════════════════════════════════════════════════╝}
  357. Function ExePath : string;
  358. Const Path : string = '';
  359. Var   i : byte;
  360. Begin
  361.   IF Path = '' then begin
  362.     Path := paramstr(0);
  363.     for i := ord(Path[0]) downto 1 do
  364.     if Path[i] = '\' then begin
  365.       Path := copy(Path, 1, i-1);
  366.       if path[0] = #2 then path := path + '\';
  367.       break;
  368.     end;
  369.   end;
  370.   ExePath := Path;
  371. end;
  372.  
  373. {╔═════════════╤═══════════════════════════════════════════════════════════╗
  374.  ║ Unit memory │ Charge l'adresse du flag indos                            ║
  375.  ║─────────────┴───────────────────────────────────────────────────────────╢
  376.  ║ Vous pouvez ensuite accéder à Indos via Getindos                        ║
  377.  ╚═════════════════════════════════════════════════════════════════════════╝}
  378. Var indos : ^byte;
  379.  
  380. Procedure SetInDos;
  381. assembler; asm
  382.   mov  ah, 34h
  383.   int  21h
  384.   mov  indos.0.word, bx
  385.   mov  indos.2.word, es
  386. end;
  387.  
  388. {╔═════════════╤═══════════════════════════════════════════════════════════╗
  389.  ║ Unit memory │ Lit le flag indos                                         ║
  390.  ║─────────────┴───────────────────────────────────────────────────────────╢
  391.  ║ Si indos contient la valeur >0, alors Le dos est actif                  ║
  392.  ╚═════════════════════════════════════════════════════════════════════════╝}
  393. Function  GetInDos : byte;
  394. assembler; asm
  395.   les  bx, indos
  396.   mov  al, es:[bx]
  397. end;
  398.  
  399. {╔═════════════╤═══════════════════════════════════════════════════════════╗
  400.  ║ Unit memory │ Fixe un vecteur d'interruption                            ║
  401.  ║─────────────┴───────────────────────────────────────────────────────────╢
  402.  ║ Fonctionne comme dos.setintvec                                          ║
  403.  ╚═════════════════════════════════════════════════════════════════════════╝}
  404. Procedure SetIntVec (IntNo : word; Vector: Pointer);
  405. assembler; asm
  406.   pushf
  407.   push ds
  408.  
  409.   mov  es, Seg0000
  410.   mov  di, IntNo
  411.   shl  di, 2
  412.                  { N'utilise pas le dos, donc 10 * + rapide }
  413.   cli
  414.   lds  si, vector
  415.   mov  es:[di+2], ds
  416.   mov  es:[di+0], si
  417.  
  418.   pop  ds
  419.   popf
  420. end;
  421.  
  422. {╔═════════════╤═══════════════════════════════════════════════════════════╗
  423.  ║ Unit memory │ Prend connaissance d'un vecteur d'interruption            ║
  424.  ║─────────────┴───────────────────────────────────────────────────────────╢
  425.  ║ Fonctionne comme dos.getintvec                                          ║
  426.  ╚═════════════════════════════════════════════════════════════════════════╝}
  427. Procedure GetIntVec (IntNo : word; var Vector: Pointer);
  428. assembler; asm
  429.   push ds
  430.  
  431.   les  di, vector
  432.   mov  ds, Seg0000
  433.   mov  si, IntNo
  434.   shl  si, 2
  435.  
  436.   movsw
  437.   movsw
  438.  
  439.   pop  ds
  440. end;
  441.  
  442. {╔═════════════╤═══════════════════════════════════════════════════════════╗
  443.  ║ Unit memory │ Fixe le psp actif                                         ║
  444.  ║─────────────┴───────────────────────────────────────────────────────────╢
  445.  ║ s est le segment (word) indiquant le début du programme (cseg)          ║
  446.  ╚═════════════════════════════════════════════════════════════════════════╝}
  447. Procedure SetPsp   (s : word);
  448. assembler; asm
  449.   mov  ah, 50h
  450.   mov  bx, s
  451.   int  21h
  452. end;
  453.  
  454. {╔═════════════╤═══════════════════════════════════════════════════════════╗
  455.  ║ Unit memory │ Lit le segment de psp actif                               ║
  456.  ╚═════════════════════════════════════════════════════════════════════════╝}
  457. Function  GetPsp   : word;
  458. assembler; asm
  459.   mov  ah, 51h
  460.   int  21h
  461.   mov  ax, bx
  462. end;
  463.  
  464.  
  465. {██████████████████████████████████████████████████████████████████████
  466.  ╔════════════════════════════════════════════════════════════════════╗
  467.  ║ Fonctions d'accès à la mémoire DOS dont UMBs                       ║
  468.  ╚════════════════════════════════════════════════════════════════════╝
  469.  ██████████████████████████████████████████████████████████████████████}
  470.  
  471.  
  472. {╔═════════════╤═══════════════════════════════════════════════════════════╗
  473.  ║ Unit memory │ Get dos information Bloc                                  ║
  474.  ╚═════════════════════════════════════════════════════════════════════════╝}
  475. Function GetDIB : pointer;
  476. assembler; asm
  477.   mov  ah, 52h
  478.   int  21h
  479.   mov  dx, es
  480.   mov  ax, bx
  481. end;
  482.  
  483. {╔═════════════╤═══════════════════════════════════════════════════════════╗
  484.  ║ Unit memory │ Détermine si les UMBs sont inclus dans la gestion mémoire ║
  485.  ║─────────────┴───────────────────────────────────────────────────────────╢
  486.  ║ use = true alors les UMBs sont gérés                                    ║
  487.  ╚═════════════════════════════════════════════════════════════════════════╝}
  488. Function  xm_useUMB (use : boolean) : boolean;
  489. assembler; asm
  490.   mov  ax, 5803h
  491.   mov  bx, word ptr use
  492.   int  21h
  493.   mov  ax, -1
  494.   adc  ax, 0
  495. end;
  496.  
  497. {╔═════════════╤═══════════════════════════════════════════════════════════╗
  498.  ║ Unit memory │ Renvoie TRUE si les UMBs sont inclus dans la mémoire      ║
  499.  ╚═════════════════════════════════════════════════════════════════════════╝}
  500. Function  xm_isUMB : boolean;
  501. assembler; asm
  502.   mov  ax, 5802h
  503.   int  21h
  504.   and  ax, not 1
  505.   xor  ax, 1
  506. end;
  507.  
  508. {╔═════════════╤═══════════════════════════════════════════════════════════╗
  509.  ║ Unit memory │ Choisis la stratégie d'allocation mémoire                 ║
  510.  ║─────────────┴───────────────────────────────────────────────────────────╢
  511.  ║ 1 = Premier bloc convenable                                             ║
  512.  ║ 2 = Meilleur bloc convenable                                            ║
  513.  ║ 3 = Dernier bloc convenable                                             ║
  514.  ║ Avec le DOS 5 : Bit 7 (+128) donne la priorité aux UMBs                 ║
  515.  ╚═════════════════════════════════════════════════════════════════════════╝}
  516. Function  xm_SetStrategy (strategy : word) : boolean;
  517. assembler; asm
  518.   mov  ax, 5801h
  519.   mov  bx, strategy
  520.   int  21h
  521.   mov  ax, -1
  522.   adc  ax, 0    { ajoute la carry }
  523. end;
  524.  
  525. {╔═════════════╤═══════════════════════════════════════════════════════════╗
  526.  ║ Unit memory │ Obtient la stratégie actuelle                             ║
  527.  ╚═════════════════════════════════════════════════════════════════════════╝}
  528. Function  xm_GetStrategy : byte;
  529. assembler; asm
  530.   mov  ax, 5800h
  531.   int  21h      { renvoie la stratégie dans ax }
  532. end;
  533.  
  534. {╔═════════════╤═══════════════════════════════════════════════════════════╗
  535.  ║ Unit memory │ Renvoie la taille occupée par une zone mémoire externe    ║
  536.  ║─────────────┴───────────────────────────────────────────────────────────╢
  537.  ║ La taille est en octets.                                                ║
  538.  ╚═════════════════════════════════════════════════════════════════════════╝}
  539. Function  xm_GetSize (P: Pointer) : longint;
  540. assembler; asm
  541.   les  bx, p                { obtenir l'adresse du block mémoire }
  542.   mov  bx, es
  543.  
  544.   cmp  bx, 0                { NIL ? }
  545.   jne  @ok
  546.   mov  ax, 0                { oui, }
  547.   mov  dx, 0                { Renvoyer 0 }
  548.   jmp @fin
  549.  
  550.   @ok:
  551.   dec  bx                   { mcb = block mémoire - 1 }
  552.   mov  es, bx
  553.   mov  ax, es:mcb.size      { Renvoyer la taille }
  554.   mov  bx, 16               { multipliée par 16 }
  555.   mul  bx                   { dans dx:ax }
  556.  
  557.   @fin:
  558. end;
  559.  
  560. {╔═════════════╤═══════════════════════════════════════════════════════════╗
  561.  ║ Unit memory │ Renvoie la taille de la mémoire externe disponible        ║
  562.  ║─────────────┴───────────────────────────────────────────────────────────╢
  563.  ║ Le nombre renvoyé est en octets et indique la taille DU PLUS GRAND      ║
  564.  ║ BLOC disponible                                                         ║
  565.  ╚═════════════════════════════════════════════════════════════════════════╝}
  566. Function  xm_MaxAvail : longint;
  567. assembler; asm
  568.   mov  ah, 48h              { Allouer }
  569.   mov  bx, $FFFF            { toute la mémoire }
  570.   int  21h                  { Impossible, d'où erreur }
  571.   mov  ax, 16               { Renvoie le nb de para libres ds bx }
  572.   mul  bx                   { Qu'il suffit de * par 16 }
  573. end;
  574.  
  575. {╔═════════════╤═══════════════════════════════════════════════════════════╗
  576.  ║ Unit memory │ Change la taille d'une zone mémoire externe               ║
  577.  ║─────────────┴───────────────────────────────────────────────────────────╢
  578.  ║ Utilise les mcbs. La taille à fournir est en octets et est arrondie au  ║
  579.  ║ 16 octets supérieurs (paragraphe).                                      ║
  580.  ║ Le maximum adressable est fonction de la taille maximum disponible      ║
  581.  ╚═════════════════════════════════════════════════════════════════════════╝}
  582. Function  xm_SetMem (var P: Pointer; Size: longint) : byte;
  583. assembler; asm
  584.   mov  ah, 4Ah              { Modifier une taille }
  585.  
  586.   les  bx, p                { Pointer sur la zone à modifier }
  587.  
  588.   mov  bx, size.word.0      { poids faible }
  589.   shr  bx, 4                { diviser par 16 }
  590.   mov  dx, size.word.2      { poids fort }
  591.  
  592.   and  dl, 1111b            { ne garder que le nibble extra low }
  593.   shl  dl, 4                { le déplacer sur le nibble high }
  594.   or   bh, dl               { qu'on additione au poids faible }
  595.  
  596.   test size.byte, 15        { Vérifier si size mod 16 = 0 }
  597.   jz   @resize              { oui, on économise 16 octets }
  598.   inc  bx                   { non, on pêche par excès }
  599.   @resize:
  600.   int  21h                  { Maintenant, au dos de jouer ! }
  601.  
  602.   jc   @fin                 { erreur, al = 7, 8 ou 9 }
  603.   mov  al, xm_ok            { aucune erreur }
  604.   @fin:
  605. end;
  606.  
  607. {╔═════════════╤═══════════════════════════════════════════════════════════╗
  608.  ║ Unit memory │ Alloue un bloc mémoire externe                            ║
  609.  ║─────────────┴───────────────────────────────────────────────────────────╢
  610.  ║ Utilise les mcbs. La taille à fournir est en octets et est arrondie au  ║
  611.  ║ 16 octets supérieurs (paragraphe).                                      ║
  612.  ║ Le maximum adressable est fonction de la taille maximum disponible      ║
  613.  ╚═════════════════════════════════════════════════════════════════════════╝}
  614. Function  xm_GetMem (var P: Pointer; Size: longint) : byte;
  615. assembler; asm
  616.   mov  ah, 48h              { Créer un block }
  617.  
  618.   mov  bx, size.word.0      { poids faible }
  619.   shr  bx, 4                { diviser par 16 }
  620.   mov  dx, size.word.2      { poids fort }
  621.  
  622.   and  dl, 1111b            { ne garder que le nibble extra low }
  623.   shl  dl, 4                { le déplacer sur le nibble high }
  624.   or   bh, dl               { qu'on additione au poids faible }
  625.  
  626.   test size.byte, 15        { Vérifier si size mod 16 = 0 }
  627.   jz   @alloc               { oui, on économise 16 octets }
  628.   inc  bx                   { non, on pêche par excès }
  629.   @alloc:
  630.   int  21h                  { Maintenant, au dos de jouer ! }
  631.  
  632.   jc   @fin                 { erreur, al = 7, 8 ou 9 }
  633.   les  di, p                { Pointeur sur la zone crée }
  634.   mov  es:di.word.0, 0      { offset toujours = à 0 }
  635.   mov  es:di.word.2, ax     { segment }
  636.   mov  al, xm_ok            { aucune erreur }
  637.   @fin:
  638. end;
  639.  
  640. {╔═════════════╤═══════════════════════════════════════════════════════════╗
  641.  ║ Unit memory │ Désaloue une zone mémoire externe dos                     ║
  642.  ║─────────────┴───────────────────────────────────────────────────────────╢
  643.  ║ P identifie un MCB qui contient les informations nécessaires (taille,   ║
  644.  ║ voisins...) au déchargement du bloc.                                    ║
  645.  ╚═════════════════════════════════════════════════════════════════════════╝}
  646. Function  xm_FreeMem (var P: Pointer) : byte;
  647. assembler; asm
  648.   mov  ah, 49h              { Retirer un block de la mémoire }
  649.  
  650.   les  bx, p                { Pointer sur le pointeur }
  651.   les  bx, es:[bx]          { qui pointe sur la zone à retirer }
  652.  
  653.   int  21h                  { Maintenant, au dos de jouer ! }
  654.  
  655.   xor  ax, ax               { Reseter le pointeur }
  656.   les  bx, p
  657.   mov  es:bx.2, ax
  658.   mov  es:bx.0, ax          { = NIL }
  659.  
  660.   jc   @fin                 { erreur, al = 7, ou 9 }
  661.   mov  al, xm_ok            { aucune erreur }
  662.   @fin:
  663. end;
  664.  
  665.  
  666.  
  667. {██████████████████████████████████████████████████████████████████████
  668.  ╔════════════════════════════════════════════════════════════════════╗
  669.  ║ Fonctions proposées par HIMEM.SYS :                                ║
  670.  ║ HMA, UMB et XMS                                                    ║
  671.  ╚════════════════════════════════════════════════════════════════════╝
  672.  ██████████████████████████████████████████████████████████████████████}
  673.  
  674. Function  Xms_ok : boolean;
  675. assembler; asm
  676.   mov  al, Xms_errflag
  677.   mov  Xms_Errflag, 0
  678. end;
  679.  
  680. Procedure NoXmsDriver; far;
  681. Assembler; asm
  682.   mov  ax, 3            { Mode texte 80x25       }
  683.   int  10h              { Réafficher le mode 3   }
  684.   mov  ah, 9            { Fonction DOS 9h :      }
  685.   push cs               { Afficher une chaine    }
  686.   pop  ds               { Chaine dans le segment }
  687.   mov  dx, offset @err  { de code, offset @info  }
  688.   int  21h              { Afficher l'erreur      }
  689.   mov  ax, 4C80h        { Code de retour 128     }
  690.   int  21h              { Terminer le programme  }
  691.   @err:DB 'Erreur : Driver XMS non initialisé.',13,10,'$'
  692. END;
  693.  
  694. Function isXms : boolean;
  695. assembler; asm
  696.   mov  ax, 4300h
  697.   int  2fh            { Vérifit la présence d'un EMM }
  698.   cmp  al, 80h
  699.   jne  @noXMS
  700.   mov  ax, 4310h
  701.   int  2fh            { Obtient l'adresse d'appel }
  702.   mov  word ptr [Xms_Proc+0], bx
  703.   mov  word ptr [Xms_Proc+2], es
  704.   mov  ah, 0
  705.   call Xms_Proc       { Puis le numéro de version }
  706.   mov  Xms_Ver, ax
  707.   mov  Xms_Rev, bx
  708.   { dans cl : état HMA (1=libre, 0=occupée) }
  709.   cmp  ah, 3
  710.   jb   @BadVer        { Version < 3 non ok }
  711.   mov  al, true       { Renvoie true }
  712.   mov  Xms_ErrFlag, 0
  713.   ret
  714.  
  715.   @noXMS:
  716.   mov  Xms_Ver, 0
  717.   mov  Xms_Rev, 0
  718.   @Badver:
  719.   mov  word ptr [Xms_Proc+0], offset NoXmsDriver
  720.   mov  word ptr [Xms_Proc+2], seg NoXmsDriver
  721.   mov  al, false
  722.   mov  Xms_ErrFlag, 1
  723. end;
  724.  
  725. Function Xms_GetHMA : boolean;
  726. assembler; asm
  727.   mov  ah, 1
  728.   mov  dx, 0FFFFh
  729.   call Xms_proc
  730.   cmp  al, 1
  731.   je   @fin
  732.   mov  Xms_Errflag, bl
  733.   @fin:
  734. end;
  735.  
  736. Function Xms_ReleaseHMA : boolean;
  737. assembler; asm
  738.   mov  ah, 2
  739.   call Xms_proc
  740.   cmp  al, 1
  741.   je   @fin
  742.   mov  Xms_Errflag, bl
  743.   @fin:
  744. end;
  745.  
  746. Function Xms_A20unlock : boolean;
  747. assembler; asm
  748.   mov  ah, 3
  749.   call Xms_proc
  750.   cmp  al, 1
  751.   je   @fin
  752.   mov  Xms_Errflag, bl
  753.   @fin:
  754. end;
  755.  
  756. Function Xms_A20lock : boolean;
  757. assembler; asm
  758.   mov  ah, 4
  759.   call Xms_proc
  760.   cmp  al, 1
  761.   je   @fin
  762.   mov  Xms_Errflag, bl
  763.   @fin:
  764. end;
  765.  
  766. Function Xms_A20localunlock : boolean;
  767. assembler; asm
  768.   mov  ah, 5
  769.   call Xms_proc
  770.   cmp  al, 1
  771.   je   @fin
  772.   mov  Xms_Errflag, bl
  773.   @fin:
  774. end;
  775.  
  776. Function Xms_A20locallock : boolean;
  777. assembler; asm
  778.   mov  ah, 6
  779.   call Xms_proc
  780.   cmp  al, 1
  781.   je   @fin
  782.   mov  Xms_Errflag, bl
  783.   @fin:
  784. end;
  785.  
  786. Function Xms_A20unlocked : boolean;         { 1 = unlock, 0 = lock }
  787. assembler; asm
  788.   mov  ah, 7
  789.   call Xms_proc
  790. end;
  791.  
  792. Function Xms_MaxAvail : word;  { l'unité est le Ko }
  793. assembler; asm
  794.   mov  ah, 8
  795.   call Xms_proc
  796.   { renvoie dans ax le block, dans dx la mém }
  797. end;
  798.  
  799. Function Xms_MemAvail : word;  { l'unité est le Ko }
  800. assembler; asm
  801.   mov  ah, 8
  802.   call Xms_proc
  803.   mov  ax, dx
  804. end;
  805.  
  806. Function Xms_Alloc (var handle : word; nbko : word) : boolean;
  807. assembler; asm
  808.   mov  ah, 9
  809.   mov  dx, nbko
  810.   call xms_proc
  811.   cmp  al, 1
  812.   je   @fin
  813.   mov  Xms_Errflag, bl
  814.   @fin:
  815.   les  di, handle
  816.   mov  es:[di], dx
  817. end;
  818.  
  819. Function Xms_UnAlloc (handle : word) : boolean;
  820. assembler; asm
  821.   mov  ah, 10
  822.   mov  dx, handle
  823.   call xms_proc
  824.   cmp  al, 1
  825.   je   @fin
  826.   mov  Xms_Errflag, bl
  827.   @fin:
  828. end;
  829.  
  830. Function Xms_Move (var e : ExMM) : boolean;
  831. assembler; asm
  832.   push ds           { sauver le segment de données car il est utilisé ! }
  833.   mov  ah, 11
  834.   lds  si, e
  835.   call xms_proc
  836.   cmp  al, 1
  837.   je   @fin
  838.   mov  Xms_Errflag, bl
  839.   @fin:
  840.   pop  ds
  841. end;
  842.  
  843. Function Xms_Lock (handle : word) : boolean;
  844. assembler; asm
  845.   mov  ah, 12
  846.   mov  dx, handle
  847.   call Xms_proc
  848.   cmp  al, 1
  849.   je   @fin
  850.   mov  Xms_Errflag, bl
  851.   @fin:
  852.   { retourne l'adresse linéaire 32bits de l'emb en mémoire dans
  853.     dx:bx }
  854. end;
  855.  
  856. Function Xms_UnLock (handle : word) : boolean;
  857. assembler; asm
  858.   mov  ah, 13
  859.   mov  dx, handle
  860.   call Xms_proc
  861.   cmp  al, 1
  862.   je   @fin
  863.   mov  Xms_Errflag, bl
  864.   @fin:
  865. end;
  866.  
  867. Function Xms_NbLocked (handle : word) : byte; { Nombre de verrouillages }
  868. assembler; asm
  869.   mov  ah, 14
  870.   mov  dx, handle
  871.   call Xms_proc
  872.   cmp  al, 1
  873.   je   @fin
  874.   mov  Xms_Errflag, bl
  875.   jmp  @ret
  876.   @fin:
  877.   mov  al, bh
  878.   @ret:
  879. end;
  880.  
  881. Function Xms_GetEMBsize (handle : word) : word; { Taille en ko }
  882. assembler; asm
  883.   mov  ah, 14
  884.   mov  dx, handle
  885.   call Xms_proc
  886.   cmp  al, 1
  887.   je   @fin
  888.   mov  Xms_Errflag, bl
  889.   mov  ax, 0
  890.   jmp  @ret
  891.   @fin:
  892.   mov  ax, dx
  893.   @ret:
  894. end;
  895.  
  896. Function Xms_SetEMBsize (handle, NewSizeInko : word) : boolean;
  897. assembler; asm
  898.   mov  ah, 15
  899.   mov  bx, NewSizeinKo
  900.   mov  dx, handle
  901.   call Xms_proc
  902.   cmp  al, 1
  903.   je   @fin
  904.   mov  Xms_Errflag, bl
  905.   @fin:
  906. end;
  907.  
  908. Function Xms_UMBAlloc (size : word) : word;   { Retourne l'adresse }
  909. assembler; asm       { size en paragraphes }
  910.   mov  ah, 10h
  911.   mov  dx, size
  912.   call Xms_proc
  913.   cmp  al, 1
  914.   je   @fin
  915.   mov  Xms_Errflag, bl
  916.   mov  ax, 0
  917.   jmp  @ret
  918.   @fin:
  919.   mov  ax, bx
  920.   @ret:
  921. end;
  922.  
  923. Function Xms_UMBMaxAvail : word;   { taille du + gd bloc }
  924. assembler; asm
  925.   mov  ah, 10h
  926.   mov  dx, 0FFFFh
  927.   call Xms_proc
  928.   mov  ax, dx
  929. end;
  930.  
  931. Function Xms_UMBunAlloc (segm : word) : boolean;
  932. assembler; asm
  933.   mov  ah, 11h
  934.   mov  dx, segm
  935.   call Xms_proc
  936.   cmp  al, 1
  937.   je   @fin
  938.   mov  Xms_Errflag, bl
  939.   mov  ax, 0
  940.   @fin:
  941. end;
  942.  
  943. Function Xms_Err (n : byte) : string;
  944. CONST errs : array[1..29] of pchar = (
  945.     #$00'Opération réussie',
  946.     #$01'gestionnaire XMS non installé',
  947.     #$80'Fonction spécifiée non connue',
  948.     #$81'Conflit avec un RamDisque',
  949.     #$82'Erreur sur l''addresse de ligne A20',
  950.     #$8E'Erreur génerale du driver XMS',
  951.     #$8F'Erreur système, impossible à éliminer',
  952.     #$90'HMA non trouvée',
  953.     #$91'HMA déjà occupée',
  954.     #$92'Seuil d''allocation trop bas',
  955.     #$93'HMA non allouée',
  956.     #$94'La ligne A20 est encore en fonction',
  957.     #$A0'Plus de mémoire étendue disponible',
  958.     #$A1'Tous les Handles XMS sont occupés',
  959.     #$A2'Accès à une zone [Handle] indéfinie',
  960.     #$A3'Erreur de l''handle source',
  961.     #$A4'Erreur de l''offset source',
  962.     #$A5'Erreur de l''handle cible',
  963.     #$A6'Erreur de l''offset cible',
  964.     #$A7'Déplacement - longueur incorrecte',
  965.     #$A8'Déplacement - Superposition interdite',
  966.     #$A9'Erreur de parité',
  967.     #$AA'UMB non verrouillé',
  968.     #$AB'UMB encore vérouillé',
  969.     #$AC'UMB - Débordement de verrouillage',
  970.     #$AD'UMB non verrouillable',
  971.     #$B0'UMB plus petit disponible',
  972.     #$B1'Plus d''UMB Disponible',
  973.     #$B2'Adresse de segment d''UMB incorrecte' );
  974. VAR i, j : word;
  975.     st   : string;
  976. BEGIN
  977.   st := 'Erreur inconnue';
  978.   for i := 1 to 29 do
  979.     if ord(errs[i][0]) = n then begin
  980.       for j := 1 to 255 do
  981.         if errs[i][j] = #0 then break;
  982.       move (errs[i][0], st, j);
  983.       st[0] := chr(j-1);
  984.       break;
  985.     end;
  986.   Xms_Err := st;
  987. END;
  988.  
  989.  
  990.  
  991. {██████████████████████████████████████████████████████████████████████
  992.  ╔════════════════════════════════════════════════════════════════════╗
  993.  ║ Fonctions de gestion de l'EMS                                      ║
  994.  ║ Contient l'ensemble des services proposés par l'EMM 3.0            ║
  995.  ╚════════════════════════════════════════════════════════════════════╝
  996.  ██████████████████████████████████████████████████████████████████████}
  997.  
  998. Function Ems_State : byte;
  999. assembler; asm
  1000.   mov  ah, 40h
  1001.   int  67h
  1002.   mov  al, ah
  1003. end;
  1004.  
  1005. Function Ems_Err (n : byte) : string;
  1006. CONST errs : array[1..17] of pchar = (
  1007.     #$00'Opération réussie',
  1008.     #$80'Erreur Interne, EMM détruit',
  1009.     #$81'Electronique EMS défaillante',
  1010.     #$82'EMM occupé',
  1011.     #$83'Handle incorrect',
  1012.     #$84'Fonction non reconnue',
  1013.     #$85'Plus d''handle disponibles',
  1014.     #$86'Erreur de concordance de pages',
  1015.     #$87'Dépassement de pages',
  1016.     #$88'Mémoire insufisante',
  1017.     #$89'Impossible d''allouer 0 page',
  1018.     #$8A'Numéro de page logique non valable',
  1019.     #$8B'Numéro de page physique non valable',
  1020.     #$8C'Cellule d''allocation saturée',
  1021.     #$8D'Handle déjà sauvegardé',
  1022.     #$8E'Handle non sauvegardé',
  1023.     #$8F'Sous-fonction non reconnue' );
  1024. VAR i, j : word;
  1025.     st   : string;
  1026. BEGIN
  1027.   st := 'Erreur inconnue';
  1028.   for i := 1 to 28 do
  1029.     if ord(errs[i][0]) = n then begin
  1030.       for j := 1 to 255 do
  1031.         if errs[i][j] = #0 then break;
  1032.       move (errs[i][0], st, j);
  1033.       st[0] := chr(j-1);
  1034.       break;
  1035.     end;
  1036.   Ems_Err := st;
  1037. END;
  1038.  
  1039. Function Ems_Map (handle, logik : word; Physik : byte) : byte;
  1040. assembler; asm
  1041.   mov  dx, handle
  1042.   mov  bx, Logik
  1043.   mov  al, physik
  1044.   mov  ah, 44h
  1045.   int  67h
  1046.   mov  al, ah
  1047. end;
  1048.  
  1049. Function Ems_SaveMap (handle : word) : byte;
  1050. assembler; asm
  1051.   mov  ah, 47h
  1052.   mov  dx, handle
  1053.   int  67h
  1054.   mov  al, ah
  1055. END;
  1056.  
  1057. Function Ems_RestoreMap (handle : word) : byte;
  1058. assembler; asm
  1059.   mov  ah, 48h
  1060.   mov  dx, handle
  1061.   int  67h
  1062.   mov  al, ah
  1063. end;
  1064.  
  1065. Function Ems_Alloc (var handle : word; nbpages : word) : byte;
  1066. assembler; asm
  1067.   mov  ah, 43h
  1068.   mov  bx, nbpages
  1069.   int  67h
  1070.   les  di, handle
  1071.   mov  es:[di], dx
  1072.   mov  al, ah
  1073. end;
  1074.  
  1075. Function Ems_GetHandles (var handles) : byte;
  1076. assembler; asm
  1077.   mov  ah, 4Dh
  1078.   les  di, handles
  1079.   int  67h
  1080.   mov  al, ah
  1081. end;
  1082.  
  1083. Function Ems_UnAlloc (handle : word) : byte;
  1084. assembler; asm
  1085.   mov  ah, 45h
  1086.   mov  dx, handle
  1087.   int  67h
  1088.   mov  al, ah
  1089. end;
  1090.  
  1091. Function Ems_GetNbHandles : word;
  1092. assembler; asm
  1093.   mov  ah, 4Bh
  1094.   int  67h
  1095.   cmp  ah, 0
  1096.   jne  @fin
  1097.   mov  ax, bx
  1098.  
  1099.   @fin:
  1100.   mov  ax, 0    { 0 indique une erreur }
  1101. end;
  1102.  
  1103. Function Ems_GetNbPages (handle : word) : word;
  1104. assembler; asm
  1105.   mov  ah, 4Ch
  1106.   mov  dx, handle
  1107.   int  67h
  1108.   cmp  ah, 0
  1109.   jne  @fin
  1110.   mov  ax, bx
  1111.  
  1112.   @fin:
  1113.   mov  ax, 0    { 0 indique une erreur }
  1114. end;
  1115.  
  1116. Function Ems_GetTotalPages : word;
  1117. assembler; asm
  1118.   mov  ah, 42h
  1119.   int  67h
  1120.   cmp  ah, 0
  1121.   jne  @fin
  1122.   mov  ax, dx
  1123.   ret
  1124.   @fin:
  1125.   mov  ax, 0    { 0 indique une erreur }
  1126. end;
  1127.  
  1128. Function Ems_GetFreePages : word;
  1129. assembler; asm
  1130.   mov  ah, 42h
  1131.   int  67h
  1132.   cmp  ah, 0
  1133.   jne  @fin
  1134.   mov  ax, bx
  1135.   ret
  1136.   @fin:
  1137.   mov  ax, 0    { 0 indique une erreur }
  1138. end;
  1139.  
  1140. Function IsEms : boolean;
  1141.  
  1142.   Function Ems_GetSeg : boolean;
  1143.   assembler; asm
  1144.     mov  ah, 41h
  1145.     int  67h
  1146.     cmp  ah, 0
  1147.     jne  @fin
  1148.     mov  ems_seg, bx
  1149.     mov  al, true
  1150.     jmp  @ret
  1151.  
  1152.     @fin:
  1153.     mov  Ems_Seg, 0A000h   { un segment innofensif }
  1154.     mov  al, false
  1155.  
  1156.     @ret:
  1157.   end;
  1158.  
  1159.   Function Ems_Version : boolean;
  1160.   assembler; asm
  1161.     mov  ah, 46h
  1162.     int  67h
  1163.     cmp  ah, 0
  1164.     jne  @fin
  1165.     mov  bx, ax
  1166.     and  bx, 15
  1167.     shr  al, 4
  1168.     mov  cl, 10
  1169.     mul  cl
  1170.     add  ax, bx
  1171.     mov  Ems_Ver, ax
  1172.     mov  al, true
  1173.     jmp  @ret
  1174.  
  1175.   @fin:
  1176.     mov  al, false
  1177.     mov  Ems_Ver, 0
  1178.  
  1179.   @ret:
  1180.   end;
  1181.  
  1182. Type  EmmName = array[1..8] of char;
  1183. Var   emm : ^emmname;
  1184. BEGIN
  1185.   GetIntVec ($67, pointer(emm));
  1186.   word(emm) := 10;
  1187.   IsEms := false;
  1188.   {$B-}
  1189.   if emm^ = 'EMMXXXX0' then
  1190.     IsEms := Ems_GetSeg and Ems_Version and (Ems_Ver >= 30);
  1191.   {$B+}
  1192. END;
  1193.  
  1194. end.