home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / CPROG / XLIB20.ZIP / EXAMPLE3.BAS < prev    next >
BASIC Source File  |  1993-08-19  |  2KB  |  68 lines
  1. 'The following Microsoft BASIC 7.0 program should be linked with the above
  2. 'library.  The BASIC program first initializes XLIB.  Next, it creates a
  3. 'single precision array.  A control block for SUMARRAY is then constructed
  4. 'and the call to SUMARRAY is executed.  Finally, the condition code in the
  5. 'control block is inspected and results are printed.
  6.  
  7. DEFINT A-Z
  8.  
  9. 'Declare XLIB procedures
  10. DECLARE FUNCTION XLIBMEMREQ& ()
  11. DECLARE FUNCTION INITXLIB& ()
  12. DECLARE FUNCTION XLIBCONFIG% ()
  13.  
  14. 'Declare procedures in the library linked with XLIB
  15. DECLARE FUNCTION LINADR& (SEG VARIABLE AS ANY)
  16. DECLARE SUB SUMARRAY (SEG VARIABLE AS ANY)
  17.  
  18. 'Structure for the control block
  19. TYPE ARRAYDATA
  20.   CONDCODE AS LONG      'Location to receive any error codes
  21.   N AS LONG             'Number of elements to be summed
  22.   ADDRESS AS LONG       'Linear address of the array
  23.   SUM AS SINGLE         'Location for array sum
  24. END TYPE
  25.  
  26. 'Check XLIBCONFIG to see if XLIB has already been initialized.  If not then
  27. 'call XLIBMEMREQ to find amount of conventional memory needed by XLIB and
  28. 'release at least this amount with the BASIC SETMEM function.  XLIBMEMREQ
  29. 'returns with sign bit of DX set if an error occurred.  The error is then
  30. 'identified by AX.  XLIB will not be terminated upon completion of this
  31. 'program in the Microsoft QBX environment; therefore, initialization is
  32. 'required only once within the environment.
  33. IF XLIBCONFIG = 0 THEN
  34.   TEMP& = XLIBMEMREQ
  35.   IF TEMP& >= 0& THEN
  36.     IF TEMP& > 0 THEN TEMP& = SETMEM(-TEMP& - 16&)
  37.     TEMP& = INITXLIB                 'INITXLIB error code returned in TEMP&
  38.   ELSE
  39.     TEMP& = TEMP& AND &H7FFFFFFF     'Mask sign bit to leave error code only
  40.   END IF
  41.   IF TEMP& THEN
  42.     PRINT "Library initialization error:  "; HEX$(TEMP&)
  43.     END
  44.   END IF
  45. END IF
  46.  
  47. DIM A(100) AS SINGLE
  48. DIM AD AS ARRAYDATA
  49.  
  50. FOR I = 0 TO 100            'Assign numbers to array
  51.   A(I) = I
  52. NEXT I
  53.  
  54. AD.CONDCODE = 0&            'Clear the error code
  55. AD.N = 50&                  'Sum first 50 elements
  56. AD.ADDRESS = LINADR(A(0))   'Calculate and record linear address of A(0)
  57.  
  58. CALL SUMARRAY(AD)
  59.  
  60. IF AD.CONDCODE THEN
  61.   PRINT "Error: "; HEX$(AD.CONDCODE)
  62. ELSE
  63.   PRINT "Sum: "; AD.SUM     'Should equal 1225
  64. END IF
  65.  
  66. END
  67.  
  68.