
PROGRAM PascalSortExample(INPUT, OUTPUT);

****************************************************************

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

 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.

 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 beginning.  Both are sorted in 
 ascending order.

****************************************************************


{ CTOS and SAM Types and Constants }

CONST
	ercOk = 0;
	ercEof = 1;
	ercInternalError = 8;

	{ note: RETYPE to word bug in Pascal 8.0 }
	modeAppend = 28001 {RETYPE(WORD, 'ma')};
	modeModify = 28013 {RETYPE(WORD, 'mm')};
	modeRead   = 28018 {RETYPE(WORD, 'mr')};
	modeWrite  = 28023 {RETYPE(WORD, 'mw')};

	pageSize   = 512;

TYPE
	ErcType = WORD;
	FlagType = BOOLEAN;
	FhType = WORD;
	LfaType = INTEGER4;
	ModeType = WORD;
	POINTER = ADS OF WORD;
	PbType = ADS OF WORD;
	QUAD = INTEGER4;


{ SortMerge Types and Constants }

CONST
	ercNoMoreRecords = 3404;
	charType = 2;

TYPE
  StatusBlockType =
	PACKED RECORD
	erc : ErcType;
	ercDetail : ErcType;
	END;

TYPE
  PrepareSortBlockType = 
	RECORD
	lstrWorkFile1        [000] : LSTRING(91);
	lstrPwWorkFile1      [092] : LSTRING(12);
	lstrWorkFile2        [105] : LSTRING(91);
	lstrPwWorkFile2      [197] : LSTRING(12);
	qsSortWorkfileCreate [210] : QUAD;
	sWorkFileIncrement   [214] : WORD;
	qsSortWorkArea       [216] : QUAD;
	sRecordMax           [220] : WORD;
	fStableSort          [222] : WORD;
	END;

TYPE
  KeyComponentType =
	PACKED RECORD
	rbKey : WORD;
	cbKey : WORD;
	typ : WORD;
	fAscending : WORD;
	END;

TYPE
  KeyDescriptorType =
	PACKED RECORD
	cKeyComponents : WORD;
	keyComponentDescriptor1 : KeyComponentType;
	keyComponentDescriptor2 : KeyComponentType;
	END;

{ CTOS and SAM Procedures }

PROCEDURE CheckErc(erc : ErcType) ; EXTERN;

PROCEDURE Exit ; EXTERN;

PROCEDURE FatalError(erc : ErcType) ; EXTERN;

FUNCTION OpenByteStream(
	pBs : POINTER; pbFile : POINTER; cbFile : WORD;
	pbPW : POINTER; cbPW : WORD; mode : modeType; 
	pBuffer : POINTER; cbBuffer : WORD) : ErcType ; EXTERN;

FUNCTION ReadBsRecord(
	pBs : POINTER; pBufferRet : POINTER; sBuffer : WORD;
	psDataRet : POINTER) : ErcType ; EXTERN;

FUNCTION CloseByteStream(pBs : POINTER) : ErcType ; EXTERN;

FUNCTION WriteBsRecord(
	pBs : POINTER; pb : POINTER; cb : WORD;
	pcbRet : POINTER) : ErcType ; EXTERN;


{ SortMerge Procedures }

FUNCTION ConcludeSort (
	pStatusBlockRet : POINTER) : ErcType ; EXTERN;

FUNCTION DoSort (pStatusBlockRet : POINTER) : ErcType ; EXTERN;

FUNCTION PrepareKeySort (
	pPrepareSortBlock : POINTER; pKeyDescriptor : POINTER; 
	pSortWorkArea : POINTER;
	pStatusBlockRet : POINTER) : ErcType ; EXTERN;

FUNCTION PrepareSort (
	pPrepareSortBlock : POINTER; psKey : POINTER; 
	pSortWorkArea : POINTER;
	pStatusBlockRet : POINTER) : ErcType ; EXTERN;

FUNCTION ReleaseRecord (
	psRecord : POINTER; pRecord : POINTER;
	pStatusBlockRet : POINTER) : ErcType ; EXTERN;

FUNCTION ReleaseRecordAndKey (
	psRecord : POINTER; pRecord : POINTER;
	psKey : POINTER; pKey : POINTER;
	pStatusBlockRet : POINTER) : ErcType ; EXTERN;

FUNCTION ReturnRecord (
	psRecordRet : POINTER; pRecordRet : POINTER;
	pStatusBlockRet : POINTER) : ErcType ; EXTERN;

FUNCTION ReturnRecordAndKey (
	psRecordRet : POINTER; pRecordRet : POINTER;
	psKeyRet : POINTER; pKeyRet : POINTER;
	pStatusBlockRet : POINTER) : ErcType ; EXTERN;

FUNCTION TerminateSort (
	pStatusBlockRet : POINTER) : ErcType ; EXTERN;


{ Global Variables }

VAR [PUBLIC]
	bsIn : ARRAY [0..129] OF BYTE;
	bsOut : ARRAY [0..129] OF BYTE;
	rgbBufferIn : ARRAY [0..1023] OF BYTE;
	rgbBufferOut : ARRAY [0..1023] OF BYTE;
	rgbWorkArea : ARRAY [0..8191] OF BYTE;
	prepareSortBlock : PrepareSortBlockType;
	keyDescriptor : KeyDescriptorType;
	statusBlock : StatusBlockType;
	lstrRecord : LSTRING(66);
	sRecord : WORD;
	lstrInFileName : LSTRING(10);
	lstrOutFileName : LSTRING(10);
	lstrPw : LSTRING(10);

VAR
	i : INTEGER;
	j : INTEGER;
	cbJunk : WORD;
	erc : WORD;
	ercJunk : WORD;
	wRet : WORD;


{ Procedure to check status blocks, returning for ercOk }

PROCEDURE CheckStatus(
	erc : ErcType; CONST statusBlock : StatusBlockType);

BEGIN
	IF erc <> statusBlock.erc THEN FatalError(ercInternalError);
	IF erc = ercOk THEN RETURN;

	WRITELN;
	WRITELN('Sort Error');
	WRITELN('    Status code ', erc);
	IF statusBlock.ercDetail <> ercOk THEN
		BEGIN
		WRITELN('   Detail status code ', statusBlock.ercDetail);
		END;

	ercJunk := TerminateSort(ADS statusBlock);
	Exit;
END;


{ Main Program }

BEGIN

{ Open input file }
lstrInFileName := 'Files.In';
lstrPw := NULL;
CheckErc(OpenByteStream(
	ADS bsIn, 
	ADS(lstrInFileName[1]), lstrInFileName.LEN, 
	ADS(lstrPw[1]), lstrPw.LEN, 
	modeRead, ADS rgbBufferIn, SIZEOF(rgbBufferIn)));

{ Open output file }
lstrOutFileName := 'Files.Out';
lstrPw := NULL;
CheckErc(OpenByteStream(
	ADS bsOut, 
	ADS(lstrOutFileName[1]), lstrOutFileName.LEN, 
	ADS(lstrPw[1]), lstrPw.LEN, 
	modeWrite, ADS rgbBufferOut, SIZEOF(rgbBufferOut)));

{ Initialize prepareSortBlock }
prepareSortBlock.lstrWorkFile1 := '[Sys]<$>WorkFile1.Tmp';
prepareSortBlock.lstrPwWorkFile1 := NULL;
prepareSortBlock.lstrWorkFile2 := '[Sys]<$>WorkFile2.Tmp';
prepareSortBlock.lstrPwWorkFile2 := NULL;
prepareSortBlock.qsSortWorkFileCreate := 1024; 
prepareSortBlock.sWorkFileIncrement := 512;
prepareSortBlock.qsSortWorkArea := SIZEOF(rgbWorkArea);
prepareSortBlock.sRecordMax := 65;
prepareSortBlock.fStableSort := 0;

{ Initialize key descriptor }
{ 2 keys are used.          }
{ 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. }
keyDescriptor.cKeyComponents := 2;
keyDescriptor.keyComponentDescriptor1.rbKey := 6;
keyDescriptor.keyComponentDescriptor1.cbKey := 6;
keyDescriptor.keyComponentDescriptor1.typ := charType;
keyDescriptor.keyComponentDescriptor1.fAscending := 0FF;
{ 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. }
keyDescriptor.keyComponentDescriptor2.rbKey := 26;
keyDescriptor.keyComponentDescriptor2.cbKey := 6;
keyDescriptor.keyComponentDescriptor2.typ := charType;
keyDescriptor.keyComponentDescriptor2.fAscending := 0FF;

{ Initialize Sort }
CheckStatus(
	PrepareKeySort(
		ADS prepareSortBlock, ADS keyDescriptor,
		ADS rgbWorkArea, ADS statusBlock), 
	statusBlock);

{ Release records }
WRITELN;
WRITELN('Release Records');
erc := ercOk;
sRecord := 65;
WHILE erc = ercOk DO
	BEGIN
	erc := ReadBsRecord(
		ADS bsIn, ADS lstrRecord[1], sRecord, ADS wRet);
	IF erc = ercOk THEN 
		BEGIN
		lstrRecord.LEN := sRecord1; { strip off the line feed }
		WRITELN(lstrRecord);
		CheckStatus(
			ReleaseRecord(
				ADS sRecord, ADS lstrRecord[1], ADS statusBlock), 
			statusBlock);
		END;
	END;
IF erc <> ercEOF THEN FatalError(erc);

{ Do Sort }
WRITELN('Do Sort');
CheckStatus(DoSort(ADS statusBlock), statusBlock);

{ Retrieve records }
WRITELN('Return Records');
erc := ercOk;
WHILE erc = ercOk DO
	BEGIN
	erc := ReturnRecord(
		ADS sRecord, ADS lstrRecord[1], ADS statusBlock);			
	IF erc = ercOk THEN
		BEGIN
		IF sRecord <> 65 THEN FatalError(ercInternalError);
		CheckErc(WriteBsRecord(
			ADS bsOut, ADS lstrRecord[1], sRecord, ADS cbJunk));
		lstrRecord.LEN := sRecord1; { strip off line feed }
		WRITELN(lstrRecord);
		END;
	END;
IF erc <> ercNoMoreRecords THEN CheckStatus(erc, statusBlock);

{ Close files and end sort }
CheckStatus(ConcludeSort(ADS statusBlock), statusBlock);
CheckErc(CloseByteStream(ADS bsIn));
CheckErc(CloseByteStream(ADS bsOut));
WRITELN('Sort concluded successfully');
Exit;
END.