Trailing-Edge
-
PDP-10 Archives
-
DEC_CMS-20_V1.0_SRC
-
cms/sources/pattrn.bli
There are no other files named pattrn.bli in the archive.
MODULE PATTRN (
IDENT = '1',
%IF
%BLISS(BLISS32)
%THEN
LANGUAGE(BLISS32),
ADDRESSING_MODE(EXTERNAL=LONG_RELATIVE,
NONEXTERNAL=LONG_RELATIVE)
%ELSE
LANGUAGE(BLISS36)
%FI
) =
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: CMS Library Processor
!
! ABSTRACT:
!
! Parse the source audit pattern for RESERVE or REPLACE
!
! ENVIRONMENT: VAX/VMS, DS-20
!
! AUTHOR: D. Knight , CREATION DATE: 13-Jul-79
!
!--
!
! TABLE OF CONTENTS
!
FORWARD ROUTINE
PAT_SETUP : NOVALUE;
!
! INCLUDE FILES:
!
LIBRARY 'XPORT:';
%if %bliss(bliss32) %then
LIBRARY 'sys$library:starlet';
%else
REQUIRE 'jsys:';
%fi
REQUIRE 'SCONFG:';
REQUIRE 'BLISSX:';
REQUIRE 'COMUSR:';
REQUIRE 'HOSUSR:';
!
! MACROS:
!
!
! EQUATED SYMBOLS:
!
!
! OWN STORAGE:
!
!Generation control
GLOBAL
GEN_BUF : VECTOR[CH$ALLOCATION(GEN_SIZE)],
GEN_LGT,
MAX_G_LGT; !Maximum possible generation length
!Source audit control
GLOBAL
PAT_FIL, !Left margin fill count
PAT_GEN, !True if generation is needed in audit mark
PAT_LS: VECTOR[CH$ALLOCATION(PAT_TX_SIZE)], !Left part of pattern
PAT_LLS, !Length of left part
PATPOS, !Position in line, 0 = left margin
PAT_RS: VECTOR[CH$ALLOCATION(PAT_TX_SIZE)], !Right part of pattern
PAT_LRS; !Length of right part
!Source history control
GLOBAL
CHR_LS: VECTOR[CH$ALLOCATION(PAT_TX_SIZE)], !Left part of pattern
CHR_LLS, !Length of left part
CHR_RS : VECTOR[CH$ALLOCATION(PAT_TX_SIZE)], !Right part of pattern
CHR_LRS ; !Length of right part
!
! EXTERNAL REFERENCES:
!
EXTERNAL
CHRLEN, ! length of chronology string
CHRPTR, ! pointer to chronology string
NOTLEN, ! length of note string
NOTPTR, ! pointer to note string
POSLEN, ! length of position string
POSPTR, ! pointer to position string
PATLGT, ! length of qualifiers string
PATPTR ; ! pointer to qualifiers string
EXTERNAL ROUTINE
BADLIB,
bug,
PARQUA; ! parse parameter qualifiers(MODIFY)
GLOBAL ROUTINE PAT_SETUP : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! Set up the source audit patterns if any
!
! FORMAL PARAMETERS:
!
! NONE.
!
! IMPLICIT INPUTS:
!
! NONE.
!
! IMPLICIT OUTPUTS:
!
! NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
! parse qualifier string in individual qualifiers
PARQUA(.PATLGT,.PATPTR) ;
if
.max_g_lgt gtr gen_size
then
bug(lit('Generation string too long in PAT_SETUP'));
!Set up for no starting pattern
PAT_LLS=0;
PAT_LRS=0;
PAT_FIL=0;
PATPOS=0;
PAT_GEN=FALSE;
!See if a pattern exists
IF
(.POSLEN NEQ 0) AND (.NOTLEN NEQ 0)
THEN
!It does, parse and store the decomposed pattern
BEGIN
LOCAL
CHAR,
CNTR,
LEFT_P,
PTR,
PTR_LR;
LEFT_P=TRUE;
PTR_LR=CH$PTR(PAT_LS);
PTR=.POSPTR;
CNTR=.POSLEN;
!Pick up the column count
UNTIL
.CNTR EQL 0
DO
BEGIN
CHAR=CH$RCHAR_A(PTR);
CNTR=.CNTR-1;
IF
.CHAR LSS %C'0' OR
.CHAR GTR %C'9'
THEN
BADLIB(LIT('Illegal character in position string'));
PATPOS=.PATPOS*10+(.CHAR-%C'0')
END;
! set up for parsing note string
PTR = .NOTPTR ;
CNTR = .NOTLEN ;
!Parse the pattern proper
!Parse notes string into left and right halves ( breaking at
!occurence of '#G'). Assume the string has at most one such occurrence
!since it is checked at LOAD and MODIFY time.
UNTIL
.CNTR eql 0
DO
BEGIN
CHAR = CH$RCHAR_A(PTR) ;
IF
.CHAR NEQ %C'#' !Just write character
THEN
BEGIN
CH$WCHAR_A(.CHAR, PTR_LR ) ;
IF
.LEFT_P
THEN
PAT_LLS = .PAT_LLS + 1
ELSE
PAT_LRS = .PAT_LRS + 1 ;
END
ELSE !Could be the end of left half
BEGIN
LOCAL
NXT_CHR ;
NXT_CHR = CH$RCHAR_A (PTR) ;
CNTR = .CNTR - 1 ;
IF
.NXT_CHR EQL %C'#' !Found '##' in string
THEN
BEGIN
CH$WCHAR_A (.NXT_CHR, PTR_LR) ;
IF
.LEFT_P
THEN
PAT_LLS = .PAT_LLS + 1
ELSE
PAT_LRS = .PAT_LRS + 1 ;
END
ELSE
BEGIN !Must have found the 'G'
LEFT_P = FALSE;
PAT_GEN = TRUE ;
PTR_LR = CH$PTR(PAT_RS) ;
END ;
END ;
CNTR = .CNTR - 1 ;
END ;
END;
!Check for left fill needed
IF
.PATPOS EQL 0
THEN
!Compute left fill count
BEGIN
PAT_FIL=(.MAX_G_LGT+.PAT_LLS+.PAT_LRS+1)/8;
IF
((.MAX_G_LGT+.PAT_LLS+.PAT_LRS+1) MOD 8) NEQ 0
THEN
PAT_FIL=.PAT_FIL+1;
PAT_FIL=.PAT_FIL*8
END ;
!Initialize chronology variables
CHR_LLS = 0 ;
CHR_LRS = 0 ;
IF
.CHRLEN NEQ 0
THEN
BEGIN
LOCAL
CHR,
COUNT,
LFT_P,
P_PTR,
P_PTR_LR ;
LFT_P = TRUE ;
P_PTR_LR = CH$PTR(CHR_LS) ;
P_PTR = .CHRPTR ;
COUNT = .CHRLEN ;
!Parse chronology string into left and right halves ( breaking at
!occurence of '#H'. Assume the string has only one such occurrence
!since it is checked at LOAD and MODIFY time.
UNTIL
.COUNT eql 0
DO
BEGIN
CHR = CH$RCHAR_A(P_PTR) ;
IF
.CHR NEQ %C'#' !Just write character
THEN
BEGIN
CH$WCHAR_A(.CHR, P_PTR_LR ) ;
IF
.LFT_P
THEN
CHR_LLS = .CHR_LLS + 1
ELSE
CHR_LRS = .CHR_LRS + 1 ;
END
ELSE !Could be the end of left half
BEGIN
LOCAL
NXT_CHR ;
NXT_CHR = CH$RCHAR_A (P_PTR) ;
COUNT = .COUNT - 1 ;
IF
.NXT_CHR EQL %C'#' !Found '##' in string
THEN
BEGIN
CH$WCHAR_A (.NXT_CHR, P_PTR_LR) ;
IF
.LFT_P
THEN
CHR_LLS = .CHR_LLS + 1
ELSE
CHR_LRS = .CHR_LRS + 1 ;
END
ELSE
BEGIN !Must have found the 'G'
LFT_P = FALSE;
P_PTR_LR = CH$PTR(CHR_RS) ;
END ;
END ;
COUNT = .COUNT - 1 ;
END ;
END ;
END; !End of PAT_SETUP
END !End of Module PATTRN
ELUDOM