home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Basic / Samples / PBWIZ19 / PBWIZ19.ZIP / XMSDEMO.BAS < prev   
Encoding:
BASIC Source File  |  1994-03-01  |  5.2 KB  |  146 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |         PBWIZ  Copyright (c) 1991-1993  Thomas G. Hanlin III         |
  4. '   |                      3544 E. Southern Ave. #104                      |
  5. '   |                            Mesa, AZ 85204                            |
  6. '   |                                                                      |
  7. '   |                      PowerBASIC Wizard's Library                     |
  8. '   |                                                                      |
  9. '   +----------------------------------------------------------------------+
  10.  
  11. '  This provides a brief demo of the XMS routines.  It allocates enough
  12. '  memory to hold a long integer array of dimensions 300 x 70 and loads
  13. '  it sequentially with long integers.  Why?  Because someone requested
  14. '  it, that's why!  Actually, they wanted 3003 x 70, which is nigh on to
  15. '  a megabyte, and considerably more than PowerBASIC can handle on its own.
  16. '  With these routines, 3003 x 70 is a snap, but I'm using a fraction of
  17. '  the size to keep things reasonably quick.  The technique used here can
  18. '  be used to simulate an array of any size, however.
  19.  
  20.    $DIM ARRAY
  21.  
  22.    DECLARE SUB XMSclose (BYVAL INTEGER)
  23.    DECLARE FUNCTION XMSexists% ()
  24.    DECLARE FUNCTION XMSlfree& ()
  25.    DECLARE SUB XMSopen (BYVAL LONG, INTEGER, INTEGER)
  26.    DECLARE SUB XMSread (BYVAL INTEGER, BYVAL LONG, BYVAL LONG, BYVAL INTEGER, BYVAL INTEGER)
  27.    DECLARE SUB XMSwrite (BYVAL INTEGER, BYVAL LONG, BYVAL LONG, BYVAL INTEGER, BYVAL INTEGER)
  28.  
  29.    $LINK "pbwiz.pbl"
  30.  
  31.    DEFINT A-Z
  32.  
  33.  
  34.  
  35.    ' -- Set up variables.  We'll be simulating a 300x70 element array of
  36.    ' -- long integers in XMS.  This would ordinarily look something like:
  37.    ' -- DIM BigArray&(300,70) with OPTION BASE 1 on.
  38.  
  39.    Size1& = 300&                       ' elements in first dimension
  40.    Size2& = 70&                        ' elements in second dimension
  41.    BytesPerElement& = 4                ' bytes per element
  42.  
  43.    ArrayBytes& = Size1& * Size2& * BytesPerElement&  ' bytes needed for array
  44.    ArrayKB& = (ArrayBytes& + 1023&) \ 1024&          ' Kbytes needed for array
  45.  
  46.  
  47.  
  48.    '-- Make sure XMS is installed and that there's enough of it.
  49.  
  50.    IF NOT XMSexists THEN
  51.       PRINT "This demo requires XMS memory to run."
  52.       END
  53.    END IF
  54.  
  55.    IF ArrayKB& > XMSlfree& THEN
  56.       PRINT "This demo requires more XMS memory than is available."
  57.       END
  58.    END IF
  59.  
  60.  
  61.  
  62.    '-- Open an area of XMS memory (like DIM for arrays).
  63.    '-- If it succeeds, it will return a value in ArrayName
  64.    '-- which we'll use to access the opened memory area.
  65.  
  66.    XMSopen ArrayKB&, ArrayName, ErrCode
  67.    IF ErrCode THEN
  68.       PRINT "Error allocating XMS.  Unable to proceed."
  69.       END
  70.    END IF
  71.  
  72.    CLS
  73.    PRINT "XMS allocated for 300x70 long integer array.  Bytes ="; ArrayBytes&
  74.  
  75.  
  76.  
  77.    '-- Since we want the numbers we display to be right-justified, and
  78.    '-- PRINT USING would be overkill (also slow), we'll use RSET to do
  79.    '-- the work for us.  First, we need to define the string "fields".
  80.    '-- We'll make them just large enough for the largest number we'll
  81.    '-- display in each print position.
  82.  
  83.    First$ = SPACE$(LEN(STR$(Size1&)))
  84.    Second$ = SPACE$(LEN(STR$(Size2&)))
  85.    Third$ = SPACE$(LEN(STR$(Size1& * Size2&)))
  86.  
  87.  
  88.  
  89.    '-- Let's fill 'er up with sequential numbers starting from 1.
  90.    LOCATE 4, 1
  91.    PRINT "Filling XMS 'array' with sequential values..."
  92.    Counter& = 1&
  93.    ' get pointer to value to set
  94.    DSeg = VARSEG(Counter&)
  95.    DOfs = VARPTR(Counter&)
  96.    FOR FirstElement = 1 TO Size1&
  97.       RSET First$ = STR$(FirstElement)
  98.       FOR SecondElement = 1 TO Size2&
  99.          RSET Second$ = STR$(SecondElement)
  100.          RSET Third$ = STR$(Counter&)
  101.          LOCATE 5, 1
  102.          PRINT "Array&("; First$; ", "; Second$; ") = "; Third$;
  103.          ' calculate position within XMS memory
  104.          Posn& = (CLNG(FirstElement - 1) * Size2& + CLNG(SecondElement - 1)) * BytesPerElement&
  105.          ' set it
  106.          XMSwrite ArrayName, Posn&, BytesPerElement&, DSeg, DOfs
  107.          ' update the counter
  108.          INCR Counter&
  109.       NEXT
  110.    NEXT
  111.  
  112.  
  113.  
  114.    '-- Let's read it back, by way of verification
  115.    LOCATE 7, 1
  116.    PRINT "Reading back from XMS 'array'..."
  117.    ' get pointer to value to read
  118.    DSeg = VARSEG(Counter&)
  119.    DOfs = VARPTR(Counter&)
  120.    FOR FirstElement = 1 TO Size1&
  121.       RSET First$ = STR$(FirstElement)
  122.       FOR SecondElement = 1 TO Size2&
  123.          RSET Second$ = STR$(SecondElement)
  124.          ' calculate position within XMS memory
  125.          Posn& = (CLNG(FirstElement - 1) * Size2& + CLNG(SecondElement - 1)) * BytesPerElement&
  126.          ' read it
  127.          XMSread ArrayName, Posn&, BytesPerElement&, DSeg, DOfs
  128.          LOCATE 8, 1
  129.          RSET Third$ = STR$(Counter&)
  130.          PRINT "Array&("; First$; ", "; Second$; ") = "; Third$;
  131.       NEXT
  132.    NEXT
  133.  
  134.  
  135.  
  136.    '-- We're all done, so let's return the XMS memory to the system.
  137.    '-- This is IMPORTANT, because otherwise the XMS would remain
  138.    '-- unavailable until the computer is rebooted.
  139.  
  140.    XMSclose ArrayName
  141.  
  142.  
  143.  
  144.    LOCATE 10, 1
  145.    PRINT "Done"
  146.