
1   ' ***********************************************************
2   ' This program illustrates how to call the SortMerge object								
      modules from BASIC.  The records to be sorted are read								
      from the SAM file Files.In, contained on the distribution 								 
3   ' diskette.  The sorted records are written to the SAM file 								
      Files.Out.								

4   ' Files.In contains a sequence of 65byte records 								
      terminated by line feeds.  All the records must be 								
      exactly 65bytes long (including the line feed), or the 								
      sort will not work.								

5   ' Two 6byte keys are used for the sort, both of type 								
      character.  The first is located 6 bytes from the 								
      beginning of the record, and the second 26 bytes from the 								 
6   ' beginning.	  Both are sorted in ascending order.							
								

10  '************************************************************
11  ' Declarations								

20  ' Function to extend an integer (2byte) to a quad (4byte 								
      integer).  The quad is stored as a singleprecision (4								
      byte) real number.								

21    DEF fnQuadFromInt(w) = CVS(MKI$(w) + MKI$(0))								
								

30  ' Array definitions.								

31    DIM rgwStatusBlock[2]
32    DIM rgwPrepSort[112]
33    DIM rgwKeyDesc[9]								
								

40  ' Constants								

41    qsWFCreate = fnQuadFromInt(1024)
42    sWFIncr = 512
43    sBufferIn = 1024
44    sBufferOut = 1024
45    sRecordMax = 65
46    sRecordMin = 32								
								

50  ' File Names								

51    wf1$ = [Sys]<$>Sort1.Temp
52    wf2$ = [Sys]<$>Sort2.Temp								
								

200 ' ***********************************************************
201 ' Initialize key descriptor		 (2 keys, 2 + 2*8 = 18 bytes)						

205 PRINT Initializing key descriptor
210 ' 2 keys are used.
211   rgwKeyDesc[0] = 2

220 ' The first key is of type character, is 6 bytes long, has 								
      an offset of 6 bytes from the beginning of the record, 								
      and is sorted in ascending order.								

221   rgwKeyDesc[1] = 6
222   rgwKeyDesc[2] = 6
223   rgwKeyDesc[3] = 2
224   rgwKeyDesc[4] = hFFFF								

230 ' The second  key is of type character, is 6 bytes long, 								
      has an offset of 26 bytes from the beginning of the 								
      record, and is sorted in ascending order.								

231   rgwKeyDesc[5] = 26
232   rgwKeyDesc[6] = 6
233   rgwKeyDesc[7] = 2
234   rgwKeyDesc[8] = hFFFF								
								

300 ' ***********************************************************
301 ' Open input and output files.								

305 PRINT Opening files
310   OPEN I, 1, Files.In								

320   OPEN O, 2, Files.Out								
								

400 ' ***********************************************************
401 ' Initialize SortMerge.								

405 PRINT Preparing for sort
410  erc = BasicPrepareKeySort(								
	 PTR(rgwPrepSort[0]), wf1$, , wf2$, , 							
	 qsWFCreate, sWFIncr, fnQuadFromInt(0), sRecordMax, 0,
	 PTR(rgwKeyDesc[0]), MAKEPOINTER(0,0), 							
	 PTR(rgwStatusBlock[0]))
411  IF erc <> 0 THEN GOTO 940								
								

500 ' ***********************************************************
501 ' Read records from Files.In and release them to SortMerge.								

510   PRINT Release Records								

520   IF EOF(1) THEN GOTO 600								

530   LINE INPUT 1, record$
531   IF LEN(record$) > sRecordMax THEN 								
          record$ = LEFT$(record$, sRecordMax)						
532   IF LEN(record$) < sRecordMin THEN								
          record$ = record$ + SPACE$(sRecordMin  LEN(record$))						
533   sRecord = LEN(record$)

540   erc = ReleaseRecord(								
          PTR(sRecord), PTR(record$), PTR(rgwStatusBlock[0])):								
      IF erc <> 0 THEN GOTO 940								

550   PRINT record$
551   GOTO 520								
								

600 ' ***********************************************************
601 ' Sort the records.								

610   PRINT Do Sort								

620   erc = DoSort(PTR(rgwStatusBlock[0])) : 								
      IF erc <> 0 THEN GOTO 940								
								

700 ' ***********************************************************
701 ' Get the sorted records back, displaying and writing them 								
      to Files.Out.								

710   PRINT Return Records								

720   record$ = SPACE$(sRecordMax)
721   erc = ReturnRecord(								
          PTR(sRecord), PTR(record$), PTR(rgwStatusBlock[0])):								
      IF erc <> 0 THEN GOTO 760
722   record$ = LEFT$(record$, sRecord)								

730   PRINT 2, record$		
740   PRINT record$								

750   GOTO 720								
								

760 ' Check to be sure that the error was no more records.
761   IF erc <> 3404 THEN GOTO 940								
								

800 ' ***********************************************************
801 ' Termination logic.								

810   erc = ConcludeSort(PTR(rgwStatusBlock[0])) : 								
      IF erc <> 0 THEN GOTO 940								

820   PRINT Sort Concluded Successfully
821   PRINT								

830   PRINT Press any key to exit
831   x$ = INPUT$(1)
832   SYSTEM								

840   END								
								

900 ' ***********************************************************
901 ' Error logic:  Display status and quit.								

910 ' Terminate with a status status code in erc								

920   PRINT Error
921   PRINT Status code = ; erc								

930 ' Note that TerminateSort can be called even if no sort is 								
      pending.
931   erc = TerminateSort(PTR(rgwStatusBlock[0]))
932   STOP								
								

940 ' Terminate with a status code in erc and a status block 								
      in rgwStatusBlock								

950 ' Make sure the status block is valid.
951   IF erc <> rgwStatusBlock[0] THEN GOTO 910								

960   PRINT Error
961   PRINT Status code = ; erc
962   IF rgwStatusBlock[1] <> 0 THEN								
          PRINT Detailed status code = ; rgwStatusBlock[1]								

970   erc = TerminateSort(PTR(rgwStatusBlock[0]))
971   STOP
