Google
 

Trailing-Edge - PDP-10 Archives - BB-H138F-BM_1988 - 7-sources/prgettok.bli
There are 10 other files named prgettok.bli in the archive. Click here to see a list.
 %TITLE 'PRGETTOK - scan a token'
MODULE PRGETTOK (				! Scan a token
		IDENT = '2-002'			! File: PRGETTOK.BLI Edit: CJG2002
		) =
BEGIN
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1988.  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:	EDT -- The DEC Standard Editor
!
! ABSTRACT:
!
!	Find the length and pointer to the current atom in the command buffer
!
! ENVIRONMENT:  TOPS-20 only
!
! AUTHOR: Bob Kushlis, CREATION DATE: December 12, 1978
!
! MODIFIED BY:
!
! 1-001	- Original.  DJS 25-Feb-1981.  This module was created by
!	extracting routine EDT$$PA_SCANTOK  from module PARSER.
! 1-002	- Regularize headers.  JBS 12-Mar-1981
! 1-003	- Suppress quoted strings if requested.  JBS 26-Aug-1981
! 1-004 - Change index on line numbers for 15 instead of 10 digits.  SMB 18-Jan-1982
! 1-005 - Accept quoted keys. STS 07-Apr-1982
! 1-006 - Delete reference to pa_val. STS 09-Apr-1982
!
! 2-001 - Rewrite for TOPS-20 version. CJG 4-Mar-83
! 2-002 - Look for ^_ in strings and convert to null. CJG 8-Nov-1983
!--

%SBTTL 'Declarations'
!
! TABLE OF CONTENTS:
!

REQUIRE 'EDTSRC:TRAROUNAM';

FORWARD ROUTINE
    EDT$$PA_SCANTOK : NOVALUE;

!
! INCLUDE FILES:
!

REQUIRE 'EDTSRC:EDTREQ';

REQUIRE 'SYS:JSYS';

!
! MACROS:
!
!	NONE
!
! EQUATED SYMBOLS:
!
!	NONE
!
! OWN STORAGE:
!
!	NONE
!
! EXTERNAL REFERENCES:
!
!	In the routine
!<BLF/PAGE>
%SBTTL 'EDT$$PA_SCANTOK  - scan the next token'

GLOBAL ROUTINE EDT$$PA_SCANTOK ( 		! Scan the next token
			QST,			! Flag for quoted string
			CAP ) : NOVALUE =	! Capitalise the string


!++
! FUNCTIONAL DESCRIPTION:
!
! This routine uses the atom currently in the atom buffer to find the
! length of the atom. From this we can find the starting pointer to the
! atom in the command buffer. This is only required for string atoms.
!
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	CSB
!
! IMPLICIT OUTPUTS:
!
!	PA_CURTOK
!	PA_CURTOKLEN
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN

    EXTERNAL ROUTINE
	EDT$$CNV_UPC : NOVALUE;		! Convert to upper case

    EXTERNAL
	PA_CURTOK,			! start of the current token
	PA_CURTOKLEN,			! length of current token
	CSB : VECTOR [10];		! Command state block (with pointers)

    LOCAL
	CHAR,
	PTR;				! A temp pointer

    PTR = .CSB [$CMABP];
    PA_CURTOKLEN = 0;

    WHILE 1 DO
	BEGIN
	CHAR = CH$RCHAR (.PTR);
	IF (.CHAR NEQ 0) THEN
	    BEGIN
	    PA_CURTOKLEN = .PA_CURTOKLEN + 1;
	    IF (.CHAR EQL %O'37') THEN CHAR = 0;
	    CH$WCHAR_A (.CHAR, PTR);
	    END
	ELSE
	    EXITLOOP;
	END;

    PA_CURTOK = CH$PLUS (.CSB [$CMPTR], -(.PA_CURTOKLEN + .QST));
    CH$MOVE (.PA_CURTOKLEN, .CSB [$CMABP], .PA_CURTOK);		! Replace the string
    IF .CAP THEN EDT$$CNV_UPC (.PA_CURTOK, .PA_CURTOKLEN);
    END;

END
ELUDOM