home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / progjrn / pj_5_5.arc / DEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-08-07  |  7.5 KB  |  307 lines
  1. {   Code for "TSR's Using Expanded Memory With Turbo Pascal"
  2.                  by John J. Newlin
  3.     Page 28, Volume 5.5, Programmer's Journal
  4.  
  5. DEMO.PAS
  6. Copyright 1987 by John J. Newlin, 4060-228 Rosenda Court, San
  7. Diego, CA 92122
  8. }
  9. {$I demo.var}
  10. {$I-,K-,C-,V-,B-,F4}
  11. (*  Expanded memory demonstration program
  12.     Copyright 1987 by John J. Newlin
  13.     All rights reserved                   *)
  14.  
  15. function emm_version : str4;
  16. var x : integer;
  17.     u,l : str4;
  18.     r : regpack;
  19. begin
  20.   r.ah := $46;
  21.   intr($67,r);
  22.   x := r.al and $F0;
  23.   x := x shr 4;
  24.   str(x,u);
  25.   x := r.al and $0F;
  26.   str(x,l);
  27.   emm_version := u + '.' + l;
  28. end;
  29.  
  30. procedure emm_page_count(var total,allocated,free : integer);
  31. var r : regpack;
  32. begin
  33.   r.ah := $42;
  34.   intr($67,r);
  35.   total := r.dx;
  36.   free := r.bx;
  37.   allocated := total - free;
  38. end;
  39.  
  40. procedure save_cursor;
  41. var r : regpack;
  42. begin
  43.   r.ah := 3;
  44.   r.bh := 0;
  45.   intr($10,r);
  46.   cursor_size := r.cx;
  47.   cursor_posit := r.dx;
  48. end;
  49.  
  50. procedure restore_cursor;
  51. var r : regpack;
  52. begin
  53.   r.cx := cursor_size;
  54.   intr($10,r);
  55.   r.ah := 2;
  56.   r.dx := cursor_posit;
  57.   intr($10,r);
  58.   r.ah := $1A;
  59. end;
  60.  
  61. procedure map_memory(logical,physical : integer);
  62. var r : regpack;
  63. begin
  64.   r.ax := physical;
  65.   r.ah := $44;
  66.   r.bx := logical;
  67.   r.dx := emm_handle;
  68.   intr($67,r);
  69. end;
  70.  
  71. procedure printline(var str : str255);
  72. var i : integer;
  73.     r : regpack;
  74. begin
  75.   str := str + #13 + #10;
  76.   for i := 1 to ord(str[0]) do
  77.     begin
  78.       r.ah := 0;
  79.       r.dx := 0;
  80.       r.al := ord(str[i]);
  81.       intr($17,r);
  82.     end;
  83. end;
  84.  
  85. procedure print(var str : str255);
  86. var i : integer;
  87.     r : regpack;
  88. begin
  89.   for i := 1 to ord(str[0]) do
  90.   begin
  91.     r.ah := 0;
  92.     r.dx := 0;
  93.     r.al := ord(str[i]);
  94.     intr($17,r);
  95.   end;
  96. end;
  97.  
  98. function hex(n : integer) : str4;
  99. begin
  100.   hex := hex_char[hi(n) div 16] + hex_char[hi(n) mod 16] +
  101.          hex_char[lo(n) div 16] + hex_char[lo(n) mod 16];
  102. end;
  103.  
  104. procedure save_screen;
  105. begin
  106.   map_memory(3,5);
  107.   move(mem[buffer_loc:0],main_buffer^,4000);
  108.   map_memory(3,3);
  109. end;
  110.  
  111. procedure restore_screen;
  112. begin
  113.   map_memory(3,5);
  114.   move(main_buffer^,mem[buffer_loc:0],4000);
  115.   map_memory(3,3);
  116. end;
  117.  
  118. function number_of_emm_handles : integer;
  119. var r : regpack;
  120. begin
  121.   r.ah := $4B;
  122.   intr($67,r);
  123.   number_of_emm_handles := r.bx;
  124. end;
  125.  
  126. function pages_assigned_to_handle(handle : integer) : integer;
  127. var r : regpack;
  128. begin
  129.   r.ah := $4C;
  130.   r.dx := handle;
  131.   intr($67,r);
  132.   pages_assigned_to_handle := r.bx;
  133. end;
  134.  
  135. procedure main_proc;
  136. var r : regpack;
  137.     k : char;
  138.     total,used,free,handles,pages,x,y : integer;
  139. begin
  140.   x := 19;
  141.   y := 8;
  142.   emm_page_count(total,used,free);
  143.   handles := number_of_emm_handles;
  144.   pages := pages_assigned_to_handle(emm_handle);
  145.   clrscr;
  146.   gotoxy(x,y);
  147.   write('The Expanded Memory Manager version is ',emm_version);
  148.   gotoxy(x,wherey+2);
  149.   write('   Expanded memory frame segment     ',hex(emm_seg),'H');
  150.   gotoxy(x,wherey+1);
  151.   write('   Expanded memory pages in system   ',total:5);
  152.   gotoxy(x,wherey+1);
  153.   write('   Expanded memory pages available   ',free:5);
  154.   gotoxy(x,wherey+1);
  155.   write('   Expanded memory pages in use      ',used:5);
  156.   gotoxy(x,wherey+1);
  157.   write('   Expanded memory pages used by DEMO',pages:5);
  158.   gotoxy(x,wherey+1);
  159.   write('   Expanded memory handles in use    ',handles:5);
  160.   gotoxy(x,wherey+2);
  161.   write('Press any key to continue.... ');
  162.   read(kbd,k);
  163. end;
  164.  
  165. procedure handler;
  166. begin
  167. Inline(
  168.    $5D                   {                    pop bp}
  169.   /$5D                   {                    pop bp}
  170.   /$FA                   {                    cli}
  171.   /$2E                   {                    cs:}
  172.   /$8C/$1E/>SAVEDS       {                    mov word ptr [>saveds],ds}
  173.   /$2E                   {                    cs:}
  174.   /$8C/$06/>SAVEES       {                    mov word ptr [>savees],es}
  175.   /$2E                   {                    cs:}
  176.   /$8C/$16/>SAVESS       {                    mov word ptr [>savess],ss}
  177.   /$2E                   {                    cs:}
  178.   /$89/$26/>SAVESP       {                    mov word ptr [>savesp],sp}
  179.   /$2E                   {                    cs:}
  180.   /$8E/$1E/>DATASEG      {                    mov ds,word ptr [>dataseg]}
  181.   /$2E                   {                    cs:}
  182.   /$8E/$16/>STACKSEG     {                    mov ss,word ptr [>stackseg]}
  183.   /$2E                   {                    cs:}
  184.   /$8B/$26/>STACKPTR     {                    mov sp,word ptr [>stackptr]}
  185.   /$FA                   {                    sti}
  186. );
  187.   save_cursor;
  188.   save_screen;
  189.   main_proc;
  190.   restore_screen;
  191.   restore_cursor;
  192. Inline(
  193.    $FA                   {                    cli}
  194.   /$2E
  195.   /$8E/$1E/>SAVEDS       {                    mov ds,word ptr[>saveds]}
  196.   /$2E                   {                    cs:}
  197.   /$8E/$06/>SAVEES       {                    mov es,word ptr[>savees]}
  198.   /$2E                   {                    cs:}
  199.   /$8E/$16/>SAVESS       {                    mov ss,word ptr[>savess]}
  200.   /$2E                   {                    cs:}
  201.   /$8B/$26/>SAVESP       {                    mov sp,word ptr[>savesp]}
  202.   /$FB                   {                    sti}
  203.   /$CB                   {                    return far}
  204. );
  205. end;
  206.  
  207. {All functions and procedures above this point will be moved to
  208. EMS} 
  209.  
  210. procedure dummy;
  211. begin
  212. end;
  213.  
  214. var
  215.   lastx,lasty,lastvar,xcode : integer;
  216.  
  217. procedure initialize;
  218. var r : regpack;
  219. begin
  220.   r.ah := $0F;
  221.   intr($10,r);
  222.   color := r.al <> 7;
  223.   r.ah := $03;
  224.   intr($10,r);
  225.   if color then buffer_loc := $B800 else buffer_loc := $B000;
  226. end;
  227.  
  228. function emm_present : boolean;
  229. var
  230.   ems_str : array[1..8] of char;
  231. begin
  232.   ems_str := '        ';
  233.   move(mem[vector[$67].segment:10],ems_str,8);
  234.   emm_present := ems_str = 'EMMXXXX0';
  235. end;
  236.  
  237. function emm_segment : integer;
  238. var r : regpack;
  239. begin
  240.   r.ah := $41;
  241.   intr($67,r);
  242.   emm_segment := r.bx;
  243. end;
  244.  
  245.  
  246. function get_handle(var handle : integer) : boolean;
  247. var r : regpack;
  248. begin
  249.   r.ah := $43;
  250.   r.bx := 8;
  251.   intr($67,r);
  252.   if r.ah = 0 then
  253.     begin
  254.       handle := r.dx;
  255.       get_handle := true;
  256.     end
  257.   else
  258.     begin
  259.       r.ah := $42;
  260.       intr($67,r);
  261.       handle := r.bx;
  262.       get_handle := false;
  263.     end;
  264. end;
  265.  
  266. begin
  267.   initialize;
  268.   demo_main := ofs(handler);
  269.   if not emm_present then
  270.     begin
  271.       writeln('Expanded memory driver not present - aborting!',^g,^g);
  272.       halt;
  273.     end
  274.   else
  275.     begin
  276.       if not get_handle(emm_handle) then
  277.         begin
  278.           writeln;
  279.           writeln('Insufficient memory pages available - aborting!',^g,^g);
  280.           writeln('EM Manager reports ',emm_handle,' pages available.');
  281.           halt;
  282.         end;
  283.       if emm_version <> '3.2' then
  284.         begin
  285.           writeln('Not EMS version 3.2 - found instead ',emm_version,
  286.                    ' - aborting',^g,^g);
  287.           halt;
  288.         end;
  289.       emm_seg := emm_segment;
  290.       map_memory(0,0);
  291.       map_memory(1,1);
  292.       map_memory(2,2);
  293.       map_memory(3,3);
  294.       fillchar(mem[emm_seg:0],$FFFF,0);
  295.       lasty := ofs(dummy);
  296.       lastx := lasty shr 4;
  297.       dataseg := emm_seg + lastx + 2;
  298.       stackseg := emm_seg;
  299.       stackptr := $BFFF;
  300.       main_buffer := ptr(emm_seg,$C000);         {page 6}
  301.       aux_buffer  := ptr(emm_seg,$D000);         {page 6}
  302.       move(mem[cseg:0],mem[emm_seg:0],ofs(dummy));
  303.       move(mem[dseg:0],mem[dataseg:0],ofs(lastvar));
  304.     end;
  305. end.
  306.  
  307.