home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / bp_6_93 / bonus / winer / ems.bas < prev    next >
BASIC Source File  |  1994-09-03  |  7KB  |  230 lines
  1. '*********** EMS.BAS - demonstrates the EMS memory services
  2.  
  3. 'Copyright (c) 1992 Ethan Winer
  4.  
  5. DEFINT A-Z
  6.  
  7. DECLARE FUNCTION Compare% (BYVAL Seg1, BYVAL Adr1, BYVAL Seg2, BYVAL Adr2, NumBytes)
  8. DECLARE FUNCTION EMSErrMessage$ (ErrNumber)
  9. DECLARE FUNCTION EMSError% ()
  10. DECLARE FUNCTION EMSFree& ()
  11. DECLARE FUNCTION EMSThere% ()
  12. DECLARE FUNCTION PeekWord% (BYVAL Segment, BYVAL Address)
  13.  
  14. DECLARE SUB EMSInt (EMSRegs AS ANY)
  15. DECLARE SUB EMSStore (Segment, Address, ElSize, NumEls, Handle)
  16. DECLARE SUB EMSRetrieve (Segment, Address, ElSize, NumEls, Handle)
  17. DECLARE SUB MemCopy (BYVAL FromSeg, BYVAL FromAdr, BYVAL ToSeg, BYVAL ToAdr, NumBytes)
  18.  
  19. TYPE EMSType                    'similar to DOS Registers
  20.   AX AS INTEGER
  21.   BX AS INTEGER
  22.   CX AS INTEGER
  23.   DX AS INTEGER
  24. END TYPE
  25.  
  26. DIM SHARED EMSRegs AS EMSType   'so all the subs can get at them
  27. DIM SHARED ErrCode
  28. DIM SHARED PageFrame
  29.  
  30.  
  31. CLS
  32. IF NOT EMSThere% THEN           'ensure that EMS is present
  33.   PRINT "No EMS is installed"
  34.   END
  35. END IF
  36.  
  37. PRINT "This computer has"; EMSFree&;
  38. PRINT "kilobytes of EMS available"
  39.  
  40. PRINT "Initializing array ";
  41. REDIM Array#(1 TO 20000)
  42. FOR X = 1 TO 20000
  43.   Array#(X) = X
  44.   IF X MOD 1000 = 0 THEN PRINT ".";
  45. NEXT
  46. PRINT
  47.  
  48. PRINT "Storing the array in EMS"
  49. CALL EMSStore(VARSEG(Array#(1)), VARPTR(Array#(1)), 8, 20000, Handle)
  50. IF EMSError% THEN
  51.   PRINT EMSErrMessage$(EMSError%)
  52.   END
  53. END IF
  54.  
  55. PRINT "Retrieving the array from EMS"
  56. REDIM Array#(1 TO 20000)
  57. CALL EMSRetrieve(VARSEG(Array#(1)), VARPTR(Array#(1)), 8, 20000, Handle)
  58. IF EMSError% THEN
  59.   PRINT EMSErrMessage$(EMSError%)
  60.   END
  61. END IF
  62.  
  63. PRINT "Testing the data ";
  64. FOR X = 1 TO 20000
  65.   IF Array#(X) <> X THEN PRINT "ERROR! ";
  66.   IF X MOD 1000 = 0 THEN PRINT ".";
  67. NEXT
  68.  
  69. FUNCTION EMSErrMessage$ (ErrNumber) STATIC
  70.  
  71.   SELECT CASE ErrNumber
  72.     CASE 128
  73.       EMSErrMessage$ = "Internal error"
  74.     CASE 129
  75.       EMSErrMessage$ = "Hardware malfunction"
  76.     CASE 131
  77.       EMSErrMessage$ = "Invalid handle"
  78.     CASE 133
  79.       EMSErrMessage$ = "No handles available"
  80.     CASE 135, 136
  81.       EMSErrMessage$ = "No pages available"
  82.     CASE ELSE
  83.       IF PageFrame THEN
  84.         EMSErrMessage$ = "Undefined error: " + STR$(ErrNumber)
  85.       ELSE
  86.         EMSErrMessage$ = "EMS not loaded"
  87.       END IF
  88.   END SELECT
  89.  
  90. END FUNCTION
  91.  
  92. FUNCTION EMSError% STATIC
  93.  
  94.   Temp& = ErrCode
  95.   IF Temp& < 0 THEN Temp& = Temp& + 65536
  96.   EMSError% = Temp& \ 256
  97.  
  98. END FUNCTION
  99.  
  100. FUNCTION EMSFree& STATIC
  101.  
  102.   EMSFree& = 0                  'assume failure
  103.   IF PageFrame = 0 THEN EXIT FUNCTION
  104.  
  105.   EMSRegs.AX = &H4200
  106.   CALL EMSInt(EMSRegs)
  107.   ErrCode = EMSRegs.AX          'save possible error from AH
  108.  
  109.   IF ErrCode = 0 THEN EMSFree& = EMSRegs.BX * 16
  110.  
  111. END FUNCTION
  112.  
  113. SUB EMSRetrieve (Segment, Address, ElSize, NumEls, Handle) STATIC
  114.  
  115.   IF PageFrame = 0 THEN EXIT SUB
  116.  
  117.   LocalSeg& = Segment           'work with copies we can change
  118.   LocalAdr& = Address
  119.  
  120.   BytesNeeded& = NumEls * CLNG(ElSize)
  121.   PagesNeeded = BytesNeeded& \ 16384
  122.   Remainder = BytesNeeded& MOD 16384
  123.   IF Remainder THEN PagesNeeded = PagesNeeded + 1
  124.  
  125.   NumBytes = 16384              'assume we're copying a complete page
  126.   ThisPage = 0                  'start copying to page 0
  127.  
  128.   FOR X = 1 TO PagesNeeded      'copy the data
  129.     IF X = PagesNeeded THEN     'watch out for the last page
  130.       IF Remainder THEN NumBytes = Remainder
  131.     END IF
  132.   
  133.     IF LocalAdr& > 32767 THEN   'watch out for segment boundaries
  134.       LocalAdr& = LocalAdr& - &H8000&
  135.       LocalSeg& = LocalSeg& + &H800
  136.       IF LocalSeg& > 32767 THEN LocalSeg& = LocalSeg& - 65536
  137.     END IF
  138.  
  139.     EMSRegs.AX = &H4400         'map physical page 0 to the
  140.     EMSRegs.BX = ThisPage       '  current logical page
  141.     EMSRegs.DX = Handle         '  for the given handle
  142.     CALL EMSInt(EMSRegs)        'then copy the data there
  143.     ErrCode = EMSRegs.AX        'save possible error from AH
  144.     IF ErrCode THEN EXIT SUB
  145.     CALL MemCopy(PageFrame, Zero, CINT(LocalSeg&), CINT(LocalAdr&), NumBytes)
  146.  
  147.     ThisPage = ThisPage + 1
  148.     LocalAdr& = LocalAdr& + NumBytes
  149.   NEXT
  150.  
  151.   EMSRegs.AX = &H4500           'release memory service
  152.   EMSRegs.DX = Handle
  153.   CALL EMSInt(EMSRegs)
  154.   ErrCode = EMSRegs.AX          'save possible error
  155.  
  156. END SUB
  157.  
  158. SUB EMSStore (Segment, Address, ElSize, NumEls, Handle) STATIC
  159.  
  160.   IF PageFrame = 0 THEN EXIT SUB
  161.  
  162.   LocalSeg& = Segment           'work with copies we can change
  163.   LocalAdr& = Address
  164.  
  165.   BytesNeeded& = NumEls * CLNG(ElSize)
  166.   PagesNeeded = BytesNeeded& \ 16384
  167.   Remainder = BytesNeeded& MOD 16384
  168.   IF Remainder THEN PagesNeeded = PagesNeeded + 1
  169.  
  170.   EMSRegs.AX = &H4300           'allocate memory service
  171.   EMSRegs.BX = PagesNeeded
  172.   CALL EMSInt(EMSRegs)
  173.  
  174.   ErrCode = EMSRegs.AX          'save possible error from AH
  175.   IF ErrCode THEN EXIT SUB
  176.   Handle = EMSRegs.DX           'save the handle returned
  177.  
  178.   NumBytes = 16384              'assume we're copying a complete page
  179.   ThisPage = 0                  'start copying to page 0
  180.  
  181.   FOR X = 1 TO PagesNeeded      'copy the data
  182.     IF X = PagesNeeded THEN     'watch out for the last page
  183.       IF Remainder THEN NumBytes = Remainder
  184.     END IF
  185.    
  186.     IF LocalAdr& > 32767 THEN   'watch out for segment boundaries
  187.       LocalAdr& = LocalAdr& - &H8000&
  188.       LocalSeg& = LocalSeg& + &H800
  189.       IF LocalSeg& > 32767 THEN LocalSeg& = LocalSeg& - 65536
  190.     END IF
  191.  
  192.     EMSRegs.AX = &H4400         'map physical page 0 to the
  193.     EMSRegs.BX = ThisPage       '  current logical page
  194.     EMSRegs.DX = Handle         '  for the given handle
  195.     CALL EMSInt(EMSRegs)        'then copy the data there
  196.     ErrCode = EMSRegs.AX        'save possible error from AH
  197.     IF ErrCode THEN EXIT SUB
  198.     CALL MemCopy(CINT(LocalSeg&), CINT(LocalAdr&), PageFrame, Zero, NumBytes)
  199.  
  200.     ThisPage = ThisPage + 1
  201.     LocalAdr& = LocalAdr& + NumBytes
  202.   NEXT
  203.  
  204. END SUB
  205.  
  206. FUNCTION EMSThere% STATIC
  207.  
  208.   EMSThere% = 0                 'assume the worst
  209.   DIM DevName AS STRING * 8
  210.   DevName = "EMMXXXX0"          'search for this below
  211.  
  212.   '---- Try to find the string "EMMXXXX0" at offset 10 in the EMS handler.
  213.   '     If it's not there then EMS cannot possibly be installed.
  214.   Int67Seg = PeekWord%(0, (&H67 * 4) + 2)
  215.   IF NOT Compare%(Int67Seg, 10, VARSEG(DevName$), VARPTR(DevName$), 8) THEN
  216.     EXIT FUNCTION
  217.   END IF
  218.  
  219.   EMSRegs.AX = &H4100           'get Page Frame Segment service
  220.   CALL EMSInt(EMSRegs)
  221.   ErrCode = EMSRegs.AX          'save possible error from AH
  222.  
  223.   IF ErrCode = 0 THEN
  224.     EMSThere% = -1
  225.     PageFrame = EMSRegs.BX
  226.   END IF
  227.  
  228. END FUNCTION
  229.  
  230.