Category : BASIC Source Code
Archive   : QBXM10.ZIP
Filename : XMDEMO1.BAS

DEFINT A-Z

'$INCLUDE: 'QBXM.BI'

'=========================================================================
'
' XMDEMO1.BAS a simple demo of a few of the QBXM routines. Note that
' these programs can be run in the QB environment as is. If compiled
' to an EXE, the BASIC run time library must be used (No /O on the
' command line) because of the CHAIN statement at the end of the code
' to XMDEMO2. To use as a stand alone program, change the commented
' out code at the end of the file, so that the extra memory parameters
' are written out to disk, and XMDEMO2 is RUN instead of CHAINed to.
'
'=========================================================================

COMMON SHARED paramBuffer AS STRING * 530

DIM rec1 AS STRING * 20
REDIM test1(1 TO 32000) 'REDIM forces array to be $DYNAMIC

'=========================================================================
'
' The GetXM routine is called first. It returns a flag indicating the
' type of memory installed, expanded or extended. It's just there of
' course if you're interested. The type of memory has no effect on any
' of the routines. The SELECT CASE statement illustrates the values
' returned. The major and minor version numbers of the driver in use
' are also returned. Care must be taken if an EMS driver earlier than
' version 4.0 is in use. If that is the case, the named handle routines
' should not be called. EMS 3.0 and 3.2 did not support named handles.
'
'=========================================================================

CLS
CALL GetXM(major, minor, flag)

SELECT CASE flag
CASE 0
PRINT "No extra memory is installed."
END
CASE 1
PRINT "Expanded memory is in use, version:";
CASE 2
PRINT "Extended memory is in use, version:";
CASE ELSE
PRINT "An error was returned. Code: ";
PRINT RIGHT$("0000" + HEX$(flag), 4)
END
END SELECT

PRINT USING "##.##"; major + minor / 10

'=========================================================================
'
' Now, find out how much memory is installed and how much is free.
'
' GetPagesXM returns:
'
' 'total' as the number of 16k pages installed for EMS,
' or the number of 16k pages free at the moment for XMS.
'
' 'pages' as the count of free pages for EMS, all this could be allocated
' to 1 handle in an EMS system,
' with XMS this indicates the largest block that can be allocated
' to one handle. The 'total' and 'pages' should be equal most of
' the time. A multitasker with another program running may cause
' memory to become fragmented.
'
'=========================================================================


CALL GetPagesXM(total, pages)

SELECT CASE flag
CASE 1
PRINT USING "Expanded memory total: ###,###,###"; CLNG(total) * 16384&
PRINT "Expanded";
CASE 2
PRINT USING "Extended memory total: ###,###,###"; CLNG(total) * 16384&
PRINT "Extended";
END SELECT

PRINT USING " memory free: ###,###,###"; CLNG(pages) * 16384&

'=========================================================================
'
' An example of the 'Bulk' memory handling routines.
'
' First, fill an array of 32000 integers and store it in eXtraMem:
' 32,000 integers require 64,000 bytes. 64,000 / 16384 page size
' means that we need 4 pages (65,536 bytes)
'
'=========================================================================

pages = 4
CALL OpenXM(pages, handle, errCode)
PRINT
PRINT "OpenXM call: ";
PRINT "Requested:"; pages; "pages,";
PRINT " Handle assigned: "; handle;
PRINT " ErrCode: "; RIGHT$("0000" + HEX$(errCode), 4)

IF errCode THEN GOSUB CloseExtraMem

'=========================================================================
'
' Just out of curiousity, see if PageCountXM returns 4....
'
'=========================================================================

x = PageCountXM(handle)

IF x <> pages THEN
PRINT "GetPagesXM error, returned: "; x
GOSUB CloseExtraMem
END IF

PRINT
PRINT USING "Conventional memory free with array: ###,###"; FRE(-1)
PRINT "Filling array, ";

FOR i = 1 TO 32000
test1(i) = i
NEXT

PRINT "storing array in extra memory, ";

'=========================================================================
'
' To move x number of bytes from conventional memory to extra memory,
' you need to specify the starting address in conventional memory as
' a segment offset pair. VARSEG and VARPTR do the trick. (I embed the
' function right in the call because BASIC may move things around in
' memory, and I'm BASICly a chicken.) Next you need the extra memory
' handle that you want to store the data in, then the number of bytes
' to move. Because the bytes to move value is really an unsigned integer
' it can range from 0-65535. BASIC won't take 64,000 in a signed integer,
' so for ease of use I specified a hex value. Equates to -1536, if your
' interested. When an unknown number of bytes must be moved you can use
' a loop instead. See the doc file for an example. Finally, you have
' to say where in the extra memory handle you want to store the data.
' This value is a long integer and is treated as an offset into the extra
' memory handle, the first byte is at offset 0, so that's where this array
' is going.
'
'=========================================================================

CALL Conv2XM(VARSEG(test1(1)), VARPTR(test1(1)), handle, &HFA00, 0, errCode)

IF errCode THEN
PRINT : PRINT "Error: "; RIGHT$("0000" + HEX$(errCode), 4)
GOSUB CloseExtraMem
END IF

'=========================================================================
'
' Don't need the array any more, so free up the memory for other uses.
'
'=========================================================================

PRINT "erasing array."
ERASE test1
PRINT USING "Conventional memory free without array: ###,###"; FRE(-1)

'=========================================================================
'
' Have the array in eXtraMemory in handle number "handle" so we'll name
' it so XMDEMO2 can use it. You could pass the handle to the next
' program in the chain via a variable, or write it to disk, but why use
' up limited memory (with COMMON SHARED) or take time to write a file
' if you don't have to.
'
'=========================================================================

CALL PutNameXM("ARRAY", handle, errCode)

IF errCode THEN
PRINT "Error on PutNameXM: "; RIGHT$("0000" + HEX$(errCode), 4)
GOSUB CloseExtraMem
END IF

'=========================================================================
'
' Now let's try the record orientated routines. We will generate 1,000
' records that look like "Record: 1", "Record: 2", "Record: 3" etc.
' Then each record is put to the extra memory 'file'. XMDEMO2 will use
' the same code to generate a 'record' then get the corresponding record
' from the extra memory 'file' and compare the results. Pages should
' equal, for 1,000 20 byte records: (2)
'
'=========================================================================


pages = 20000 \ 16384 + 1

'=========================================================================
'
' OpenRecXM needs the number of 16k pages, then the length of each
' record associated with the 'file'. It will return a handle to use
' with this allocation of memory.
'
'=========================================================================

CALL OpenRecXM(pages, 20, handle, errCode)

PRINT
PRINT "OpenRecXM call: ";
PRINT "Requested:"; pages; "pages,";
PRINT " Handle assigned: "; handle;
PRINT " ErrCode: "; RIGHT$("0000" + HEX$(errCode), 4)
IF errCode THEN GOSUB CloseExtraMem

FOR i& = 1 TO 1000
rec1 = "Record:" + STR$(i&)


'=========================================================================
'
' PutRecXM needs the 'file' handle, the record number as a long
' integer, and the segment:offset address of the data to put in
' the file. Same route to determine the address of the record to
' put into extra memory as in Conv2XM, VARSEG and VARPTR.
' Note that the record length doesn't have to be referred to any
' more because it was specified when the memory was allocated.
'
'=========================================================================

CALL PutRecXM(handle, i&, VARSEG(rec1), VARPTR(rec1), errCode)

IF errCode THEN
PRINT "Put Record Error: "; RIGHT$("0000" + HEX$(errCode), 4)
GOSUB CloseExtraMem
END IF
NEXT

'=========================================================================
'
' Have all 1000 records in eXtraMem in handle number "handle" so name
' it for XMDEMO2's use:
'
'=========================================================================

CALL PutNameXM("RECORDS", handle, errCode)


'=========================================================================
'
' Now for the screen handling routines. This is pretty boring, but
' what the routine does is generate 102 screens and stores each screen
' in extra memory. First thing is to save the current screen with the
' information that has been printed so far.
'
'=========================================================================

screens = 100 'Request 100, results in 102
CALL OpenScreenXM(screens, errCode)

IF errCode THEN
PRINT "Open Screen Error: "; RIGHT$("0000" + HEX$(errCode), 4)
GOSUB CloseExtraMem
END IF

screens = ScreenCountXM% 'This gives us the total available.
CALL SaveScreenXM(screens, errCode)

'=========================================================================
'
' The above saves the current output screen in the last screen available.
' so that when when it's restored, the prompt below won't be on it.
' Note also that the current cursor position is saved. As the test
' screens are drawn, the cursor location will be changed, this allows
' the cursor to be restored to it's proper location later.
'
'=========================================================================

holdRow = CSRLIN
holdCol = POS(0)
PRINT "press a key to start generating screens."
DO: LOOP WHILE INKEY$ = ""

FOR scrNum = 1 TO screens - 1
a$ = LTRIM$(RTRIM$(STR$(scrNum)))
a$ = RIGHT$("****" + a$, 4)
FOR row = 1 TO 25
FOR col = 1 TO 79 STEP 4
LOCATE row, col
PRINT a$;
NEXT
NEXT

CALL SaveScreenXM(scrNum, errCode)

IF errCode THEN
CLS
PRINT "Save Screen Error: "; RIGHT$("0000" + HEX$(errCode), 4)
GOSUB CloseExtraMem
END IF
NEXT

CALL RestScreenXM(screens, errCode) 'Redisplay the status screen
LOCATE holdRow, holdCol 'restore the cursor

'=========================================================================
'
' OK, that should be enough for now. Fill out the parameter buffer for
' everything we've put in memory, and save it for XMDEMO2's use.
'
' Adjust the commented code below to change from a CHAIN to a RUN
' start up for XMDEMO2.
'
'=========================================================================

CALL SaveParamXM(VARSEG(paramBuffer), VARPTR(paramBuffer), errCode)

CHAIN "XMDEMO2" 'Comment out for a RUN command.

' OPEN "XMPARAM.DAT" FOR BINARY AS #1
' PUT #1, 1, paramBuffer
' CLOSE
' RUN "XMDEMO2"

END

CloseExtraMem:

CALL CloseAllXM
END