Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/t20src/diustr.b36
There are 4 other files named diustr.b36 in the archive. Click here to see a list.
%TITLE 'General-purpose string-handling functions'
MODULE diustr(
              IDENT='253',
              LANGUAGE(BLISS36),
              ENTRY(moveaz, fsubaz)
              ) =
BEGIN

!	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1985.
!	ALL RIGHTS RESERVED.
!
!	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 THAT IS NOT SUPPLIED BY DIGITAL.
!
!  FACILITY:   DIU-20 (Data Interchange Utility for TOPS-20)
!
!  ABSTRACT:   ASCIZ string manipulation
!
! ENVIRONMENT: TOPS-20 V6.1         
!              BLISS-36 V4
!
! AUTHOR:      Andrew Nourse                              CREATED: --no date--
!
! HISTORY:     
!
!  253  Rename file to DIUSTR.R36.
!       Gregory A. Scott 1-Jul-86
!
!     V01-001 RDF0001           Rick Fricchione                12-Nov-1984
!             Rewrite for DIU use.  Fix BLISS V4 bugs caused by strange
!             return mechanisms.  Extract from DAP areas and make part of DIU.
!
!*****************************************************************************
!**                    F O R W A R D   R O U T I N E S 
!*****************************************************************************
FORWARD ROUTINE
        MOVEAZ,
        FSUBAZ;
!*****************************************************************************
!**                               M O V E A Z 
!*****************************************************************************
GLOBAL ROUTINE MOVEAZ(sptr,dptr)=
BEGIN
!++
! FUNCTIONAL DESCRIPTION
!
!             Copy an ASCIZ string
!
! FORMAL PARAMETERS:
!
!         sptr : address of source byte pointer (returned untouched)
!         dptr : address of destination byte pointer (returned updated)
!
! COMPLETION CODES:
!
!         Returns length of string
!
! SIDE EFFECTS:
!
!         Dest byte pointer updated
!
!--

LOCAL sp,
       c;	!Character we just read

sp = ..sptr;
! Make a copy of source pointer

INCR len FROM 0 BY 1 DO
     BEGIN
	IF (C=CH$RCHAR_A(sp)) EQL 0 
           THEN BEGIN
		  CH$WCHAR(0,..dptr); 
                  RETURN .len;
                END;
		!Make ASCIZ string of dest, but don't bump DPTR past null byte

  	   CH$WCHAR_A(.C,.dptr);
     END

END;	!MOVEAZ
!*****************************************************************************
!**                           F S U B A Z 
!*****************************************************************************
GLOBAL ROUTINE fsubaz(target,pattern)=
BEGIN
LOCAL
      f,                                ! First pattern character
      tpattern;                         ! Current pattern pointer

tpattern   = .pattern;
f = CH$RCHAR_A(tpattern);

DO    BEGIN
      SELECT CH$RCHAR(.target) OF
      SET
      [.f]: BEGIN
            LOCAL ttpattern,            ! Current Pattern pointer
                  ttarget,              ! Current Target pointer
                  p;                    ! Current Pattern character 

            ttpattern = .tpattern;
            ttarget   = .target;
            CH$RCHAR_A(ttarget);

            WHILE (p=CH$RCHAR_A(ttpattern)) EQL CH$RCHAR_A(ttarget) 
               DO (IF .p EQL 0 THEN EXITLOOP);

            IF .p EQL 0 THEN RETURN .target; 
            ! End of Pattern -- MATCH

            ttpattern = .tpattern;
            ! Reset to start of pattern

            END;                        

      [0]: RETURN 0;                    ! No match

      TES;

      CH$RCHAR_A(target);
      ! Not yet

      END WHILE 1
END;

END
ELUDOM