home *** CD-ROM | disk | FTP | other *** search
- 'The following Microsoft BASIC 7.0 program should be linked with the above
- 'library. The BASIC program first initializes XLIB. Next, it creates a
- 'single precision array. A control block for SUMARRAY is then constructed
- 'and the call to SUMARRAY is executed. Finally, the condition code in the
- 'control block is inspected and results are printed.
-
- DEFINT A-Z
-
- 'Declare XLIB procedures
- DECLARE FUNCTION XLIBMEMREQ& ()
- DECLARE FUNCTION INITXLIB& ()
- DECLARE FUNCTION XLIBCONFIG% ()
-
- 'Declare procedures in the library linked with XLIB
- DECLARE FUNCTION LINADR& (SEG VARIABLE AS ANY)
- DECLARE SUB SUMARRAY (SEG VARIABLE AS ANY)
-
- 'Structure for the control block
- TYPE ARRAYDATA
- CONDCODE AS LONG 'Location to receive any error codes
- N AS LONG 'Number of elements to be summed
- ADDRESS AS LONG 'Linear address of the array
- SUM AS SINGLE 'Location for array sum
- END TYPE
-
- 'Check XLIBCONFIG to see if XLIB has already been initialized. If not then
- 'call XLIBMEMREQ to find amount of conventional memory needed by XLIB and
- 'release at least this amount with the BASIC SETMEM function. XLIBMEMREQ
- 'returns with sign bit of DX set if an error occurred. The error is then
- 'identified by AX. XLIB will not be terminated upon completion of this
- 'program in the Microsoft QBX environment; therefore, initialization is
- 'required only once within the environment.
- IF XLIBCONFIG = 0 THEN
- TEMP& = XLIBMEMREQ
- IF TEMP& >= 0& THEN
- IF TEMP& > 0 THEN TEMP& = SETMEM(-TEMP& - 16&)
- TEMP& = INITXLIB 'INITXLIB error code returned in TEMP&
- ELSE
- TEMP& = TEMP& AND &H7FFFFFFF 'Mask sign bit to leave error code only
- END IF
- IF TEMP& THEN
- PRINT "Library initialization error: "; HEX$(TEMP&)
- END
- END IF
- END IF
-
- DIM A(100) AS SINGLE
- DIM AD AS ARRAYDATA
-
- FOR I = 0 TO 100 'Assign numbers to array
- A(I) = I
- NEXT I
-
- AD.CONDCODE = 0& 'Clear the error code
- AD.N = 50& 'Sum first 50 elements
- AD.ADDRESS = LINADR(A(0)) 'Calculate and record linear address of A(0)
-
- CALL SUMARRAY(AD)
-
- IF AD.CONDCODE THEN
- PRINT "Error: "; HEX$(AD.CONDCODE)
- ELSE
- PRINT "Sum: "; AD.SUM 'Should equal 1225
- END IF
-
- END
-
-