Trailing-Edge
-
PDP-10 Archives
-
bb-r775c-bm_tops20_ks_upd_3
-
sources/prlinnum.bli
There are 10 other files named prlinnum.bli in the archive. Click here to see a list.
%TITLE 'PRLINNUM - parse a line number'
MODULE PRLINNUM ( ! Parse a command
IDENT = '3-003' ! File: PRLINNUM.BLI Edit:GB3003
) =
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:
!
! Parse a line number and a number.
!
! ENVIRONMENT: Runs on TOPS-20 only
!
! AUTHOR: Chris Gill, CREATION DATE: March 15, 1983
!
! MODIFIED BY:
! 3-002 - Check for control-C being typed. CJG 5-Jan-1984
! 3-003 - Handle line numbers with fractional part of 0. GB 19-Jun-1984
!--
%SBTTL 'DECLARATIONS'
!
! TABLE OF CONTENTS
!
REQUIRE 'EDTSRC:TRAROUNAM';
REQUIRE 'EDTSRC:PARLITS';
FORWARD ROUTINE
EDT$$PA_LINE_NUM, ! Parse a line number
EDT$$PA_NUMBER; ! Parse a number
!
! INCLUDE FILES
!
REQUIRE 'EDTSRC:EDTREQ';
REQUIRE 'SYS:JSYS';
!
! EXTERNAL REFERENCES
!
! In the routines
!
!
! MACROS:
!
! NONE
!
!
! OWN STORAGE
!
! NONE
!
%SBTTL 'EDT$$PA_NUMBER - Parse a decimal number'
GLOBAL ROUTINE EDT$$PA_NUMBER = ! Parse a number
BEGIN
!+
! FUNCTIONAL DESCRIPTION
!
! This subroutine parses a number and returns its value.
!
! ROUTINE VALUE
!
! +N - Value of number
! -1 - Reparse required
! -2 - JSYS error or number not found
!-
EXTERNAL
CSB,
FD_VAL,
CC, ! Control-C flag
PA_NUMVAL : LN_BLOCK;
LOCAL
VAL : LN_BLOCK, ! Temp for line numbers
C_FLAG, ! COMND flags
C_DATA, ! COMND data or pointer
C_FDB; ! FDB used in parse
BEGIN
IF (NOT COMMAND (FD_VAL)) THEN RETURN (-2);
IF (.CC NEQ 0) THEN RETURN (-2);
IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (-1);
IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN RETURN (-2);
BUILDLINE (.C_DATA, VAL);
MOVELINE (VAL, PA_NUMVAL);
RETURN (.C_DATA);
END;
END;
%SBTTL 'EDT$$PA_LINE_NUM - Build a line number'
GLOBAL ROUTINE EDT$$PA_LINE_NUM (
OLD ) = ! Build a line number
BEGIN
!+
! FUNCTIONAL DESCRIPTION
!
! This routine builds a line number which is in the form nnn[.mmm].
! Spaces are not allowed in the number. PA_NUMVAL is set up with
! the line number.
!
! ROUTINE VALUE
!
! -1 - JSYS error or number not found
! 0 - Reparse required
! +1 - All OK
!-
EXTERNAL
CSB,
FD_DOT,
PA_ERRNO, ! Error number
PA_NUMVAL : LN_BLOCK, ! Numeric value
CC, ! Control-C flag
LNO0 : LNOVECTOR [14];
LOCAL
STS,
VAL : LN_BLOCK, ! Temp for line numbers
C_FLAG, ! COMND flags
C_DATA, ! COMND data or pointer
C_FDB; ! FDB used in parse
MESSAGES ((NUMVALILL));
BEGIN
!+
! If a value has already been parsed, then use it, else get a new one.
!-
IF (.OLD LSS 0) THEN
BEGIN
STS = EDT$$PA_NUMBER ();
IF (.STS LSS 0) THEN RETURN (.STS+1);
END
ELSE
BEGIN
BUILDLINE (.OLD, PA_NUMVAL);
END;
MULTLINE (LNO0 [5], PA_NUMVAL, PA_NUMVAL);
!+
! If the next character is a dot, then keep going, else done now.
!-
IF (NOT COMMAND (FD_DOT)) THEN RETURN (-1);
IF (.CC NEQ 0) THEN RETURN (-1);
IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN RETURN (1);
IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
MOVELINE (PA_NUMVAL, VAL);
!+
! Parse the next part of the line number (the fraction)
!-
STS = EDT$$PA_NUMBER ();
IF (.STS LSS 0) THEN RETURN (.STS+1);
IF (.STS GEQ 100000) THEN
BEGIN
PA_ERRNO = EDT$_NUMVALILL;
RETURN (-1);
END;
!+
! Shift the fraction to the right place and add the integer part
!-
IF (.PA_NUMVAL NEQ 0) THEN
UNTIL (.PA_NUMVAL GEQ 10000) DO
(PA_NUMVAL = .PA_NUMVAL * 10);
ADDLINE (VAL, PA_NUMVAL, PA_NUMVAL);
RETURN (1);
END;
END;
END
ELUDOM