Google
 

Trailing-Edge - PDP-10 Archives - integ_tools_tops20_v7_30-apr-86_dumper - tools/recog3/hlpcolect.b32
There are 2 other files named hlpcolect.b32 in the archive. Click here to see a list.
MODULE LIB$COLLECT (
		IDENT = 'V00A03'
		 ) =
BEGIN

!
!			  COPYRIGHT (C) 1982 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
! ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER
! COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE
! AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!
!++
! FACILITY:	Recognition Package
!
! ABSTRACT:
!
!	The Collector.
!	This module consists of a set of utility routines
!	that are useful when writing routines to perform
!	recognition.  They allow a program to "collect"
!	up strings.  These routines determine that part of
!	all those strings that are common to them all and
!	will return them on command.
!
! ENVIRONMENT:
!
! AUTHOR: Stanley Rabinowitz,	CREATION DATE: 1980
!
! MODIFIED BY: Stanley Rabinowitz
!
! V00A01	1980		Stan	Initial version
!
! V00A02	1-Jan-1982	Stan	Broke out of DECset
!
! V00A03	9-May-1982	Stan	Made modular by adding handle
!					and virtual memory allocation.
!--
!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE

	LIB$COLLECT_INITIALIZE,		! Initialize package
	LIB$COLLECT_ABORT,		! Abort collection process
	LIB$COLLECT_STORE,		! Send it a new string
	LIB$COLLECT_OUTPUT;		! Get back common part

!
! INCLUDE FILES:
!

REQUIRE 'HLP.R32';

!
! MACROS:
!

!
! EQUATED SYMBOLS:
!

!
! OWN STORAGE:
!

!
! EXTERNAL REFERENCES:
!

EXTERNAL LITERAL

	LIB$_INVARG;
GLOBAL ROUTINE LIB$COLLECT_INITIALIZE(P_HANDLE) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Initializes the collector to make it ready to begin
!	another collection process.
!
! FORMAL PARAMETERS:
!
!	P_HANDLE	Address of a longword supplied by the user
!			to be used when referring to this package
!			in later calls.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	SS$_NORMAL	Routine completed successfully
!
!	LIB$_INVARG	No handle was specified or an
!			address of 0 was specified as the handle.
!
! SIDE EFFECTS:
!
!	NONE
!
!--
BIND	HANDLE	= .P_HANDLE;

BUILTIN

	ACTUALCOUNT;

!+
!	It is an error if no handle was specified.
!-

IF ACTUALCOUNT() LSSU 1
OR HANDLE EQL 0
  THEN	RETURN	LIB$_INVARG;

!+
!	Set the handle to 0.
!-

HANDLE=0;

RETURN	SS$_NORMAL

END;
GLOBAL ROUTINE LIB$COLLECT_STORE(P_HANDLE,SIZE,P_BUF) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Collects names passed to it, keeping track of which characters
!	are in common.
!
! FORMAL PARAMETERS:
!
!	P_HANDLE	Address of handle.
!
!	SIZE		Number of characters in new name to be collected.
!			May be 0.
!
!	P_BUF		Address of buffer where name begins.
!
! IMPLICIT INPUTS:
!
!	HANDLE		Address of
!			a dynamic descriptor for the part of
!			the string that matches.
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	FALSE 	if length of recognized string has gone to 0
!		and there is more than one name collected so far
!		or any kind of error has occurred that might
!		stop this routine from working properly,
!		such as insufficient virtual memory.
!
!	TRUE	otherwise.
!
! SIDE EFFECTS:
!
!	NONE
!
!--
LOCAL

	STATUS;		! status value

BIND

	HANDLE	= .P_HANDLE,
	BUF	= .P_BUF	 : VECTOR[,BYTE];

EXTERNAL ROUTINE

	LIB$SCOPY_R_DX,
	LIB$GET_VM;

!+
! If this is the first time through, allocate a dynamic descriptor
! and two words..
!-

IF .HANDLE EQL 0
  THEN	BEGIN
	STATUS=LIB$GET_VM(%REF(12),HANDLE);
	IF NOT .STATUS THEN RETURN .STATUS;

	!+
	! Set first two longwords allocated to be a dynamic descriptor.
	! -

		BEGIN
		BIND D = .HANDLE : BLOCK[,BYTE];
		D[DSC$W_LENGTH]=0;
		D[DSC$B_CLASS]=DSC$K_CLASS_D;
		D[DSC$B_DTYPE]=DSC$K_DTYPE_T;
		D[DSC$A_POINTER]=0;

		!+
		! Copy the user's string to our newly
		! acquired memory.
		!-

		STATUS=LIB$SCOPY_R_DX(SIZE,BUF,D);
		IF NOT .STATUS THEN RETURN .STATUS;

		END;

	!+
	! Set third longword allocated to be two words:
	! The count of the number of entries the user has made
	! followed by the current size of the common characters.
	! Initialize this to 1 and .SIZE respectively..
	!-

		BEGIN
		BIND V = .HANDLE : VECTOR[,WORD];
		V[4]=1;
		V[5]=.SIZE
		END;

	RETURN SS$_NORMAL

	END;

!+
! We have found one more name to be collected.
! Count it well.
!-

BEGIN
BIND	NEW_COUNT	= .HANDLE+8	: WORD;
NEW_COUNT=.NEW_COUNT+1
END;

!+
! Calculate the number of additional characters
! in this new name over and above the number of
! characters that the user had typed.
!-

	BEGIN

	BIND	D	  = .HANDLE		: BLOCK[,BYTE],
		NEW_SIZE  = .HANDLE+10		: WORD,
		NEW_CHARS = .D[DSC$A_POINTER]	: VECTOR[,BYTE];

	!+
	! Find out how many characters match those that
	! have previously been collected.
	!-

	IF .NEW_SIZE NEQ 0
	  THEN	INCR I FROM 0 TO .NEW_SIZE-1 DO
			IF .NEW_CHARS[.I] NEQ .BUF[.I]
			  THEN	BEGIN
				NEW_SIZE=.I;
				EXITLOOP
				END;
	RETURN (.NEW_SIZE NEQ 0)

	END

END;
GLOBAL ROUTINE LIB$COLLECT_OUTPUT(P_HANDLE,P_RTN,RTN_PARAM) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Sends the "recognized" characters collected by the collector
!	to a user-specified routine.
!
! FORMAL PARAMETERS:
!
!	P_HANDLE	Address of handle.
!
!	P_RTN		Address of user's routine to call.
!
!	RTN_PARAM	Longword Parameter to be passed to user's routine.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	TRUE	if complete recognition has occurred.
!	FALSE	if partial recognition has been performed.
!
! SIDE EFFECTS:
!
!	NONE
!
!--
LOCAL

	R_STATUS,
	UNIQUE_DESC	: VECTOR[2];

BIND ROUTINE

	RTN	= .P_RTN;

BIND

	HANDLE	= .P_HANDLE;

EXTERNAL ROUTINE

	LIB$SFREE1_DD,
	LIB$FREE_VM;

!+
! If no chars were sent to us at all then just exit.
!-

IF .HANDLE EQL 0
  THEN	RETURN FALSE;

	BEGIN

	BIND	D		= .HANDLE	: BLOCK[,BYTE],
		NEW_COUNT	= .HANDLE+8	: WORD,
		NEW_SIZE	= .HANDLE+10	: WORD;

!	IF .NEW_COUNT EQL 0 THEN RETURN FALSE;

	UNIQUE_DESC[0]=.NEW_SIZE;
	UNIQUE_DESC[1]=.D[DSC$A_POINTER];

	!+
	! Call the user's action routine, sending it
	! a descriptor for the recognized characters
	! and his context parameter.
	! What do we do if his routine fails?
	!-

	RTN(UNIQUE_DESC,.RTN_PARAM);

	R_STATUS = .NEW_COUNT EQL 1;

	!+
	! Now go deallocate the virtual memory.
	!-

	LIB$SFREE1_DD(D);
	LIB$FREE_VM(%REF(12),HANDLE);
	HANDLE=0;

	RETURN .R_STATUS

	END

END;
GLOBAL ROUTINE LIB$COLLECT_ABORT(P_HANDLE) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Aborts the collection process; frees up virtual memory.
!
! FORMAL PARAMETERS:
!
!	P_HANDLE	Address of handle.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	SS$_NORMAL	if okay
!	error status	if not
!
! SIDE EFFECTS:
!
!	NONE
!
!--
LOCAL

	STATUS;

BIND

	HANDLE	= .P_HANDLE;

EXTERNAL ROUTINE

	LIB$SFREE1_DD,
	LIB$FREE_VM;

!+
! If no handle specified, assume everything is okay
! and that the virtual memory had previously been cleaned up.
! (((Maybe we should give an error instead?)))
! Also should give an error if no argument specified.
!-

IF .HANDLE EQL 0
  THEN	RETURN SS$_NORMAL;

STATUS=LIB$SFREE1_DD(.HANDLE);
IF NOT .STATUS THEN RETURN .STATUS;
STATUS=LIB$FREE_VM(%REF(12),HANDLE);
IF NOT .STATUS THEN RETURN .STATUS;
HANDLE=0;

RETURN SS$_NORMAL

END;
END
ELUDOM