Trailing-Edge
-
PDP-10 Archives
-
bb-h138e-bm_tops20_v6_1_distr
-
6-1-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) 1983, 1985 BY
! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
! 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 WHICH 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