%TITLE 'PARSE_TIMES'
MODULE PARSE_TIMES (IDENT='V1.1-2') =
BEGIN
!++
! FACILITY: 	    WCP
!
! ABSTRACT: 	    Routine for parsing day/time lists.
!
! MODULE DESCRIPTION:
!
!   This module contains routines that parse things.  All of these routines
!   use LIB$TPARSE to do the major parsing work.  All of the routines also
!   use extended TPARSE argument blocks for storing things to keep things
!   modular.  When a token needs to be saved, an action routine is named
!   in the transition and the user argument is a constant which indicates
!   to the action routine which argument in the extended argument block
!   should be modified.  Some of the argument blocks and numbering schemes
!   are set up so as to allow direct offsetting from the argument pointer
!   in the action routine (so be careful when modifying).
!
! AUTHOR:   	    M. Madison
!                   COPYRIGHT © 1993, 1994  MADGOAT SOFTWARE.  ALL RIGHTS RESERVED.
!
! CREATION DATE:    01-MAY-1989
!
! MODIFICATION HISTORY:
!
!   01-MAY-1989	    V1.0    	Madison	    Initial coding.
!   16-NOV-1989	    V1.1-1  	Madison	    Update for WATCHER V2.
!   10-JUL-1990	    V1.1-2  	Madison	    Fix stupid DOW bug.
!--

    LIBRARY 'SYS$LIBRARY:STARLET';
    LIBRARY 'SYS$LIBRARY:TPAMAC';
    LIBRARY 'WATCHER';

    FORWARD ROUTINE
    	PARSE_TIMES,
    	PT_STORE;

%IF %BLISS(BLISS32E) %THEN
    MACRO
    	LIB$TPARSE = LIB$TABLE_PARSE%;
%fi

    EXTERNAL ROUTINE
    	LIB$ANALYZE_SDESC   : BLISS ADDRESSING_MODE (GENERAL),
    	LIB$TPARSE  	    : BLISS ADDRESSING_MODE (GENERAL);

    MACRO
    	TPA_A_P1    	=   TPA$C_LENGTH0+00,0,32,0%,
    	TPA_A_P2    	=   TPA$C_LENGTH0+04,0,32,0%,
    	TPA_A_P3    	=   TPA$C_LENGTH0+08,0,32,0%,
    	TPA_A_P4    	=   TPA$C_LENGTH0+12,0,32,0%,
    	TPA_A_P5    	=   TPA$C_LENGTH0+16,0,32,0%,
    	TPA_A_P6    	=   TPA$C_LENGTH0+20,0,32,0%,
    	TPA_A_P7    	=   TPA$C_LENGTH0+24,0,32,0%;

    LITERAL
    	PT_K_SECONDARY	= -1,
    	PT_K_PRIMARY	= 0;

%SBTTL 'State table for PARSE_TIMES'

    $INIT_STATE (PT_STATE, PT_KEY);

    $STATE (DAYNAME,
    	('SECONDARY',, PT_STORE,,, PT_K_SECONDARY),
    	('PRIMARY',, PT_STORE,,, PT_K_PRIMARY),
    	('MONDAY',, PT_STORE,,, 1),
    	('TUESDAY',, PT_STORE,,, 2),
    	('WEDNESDAY',, PT_STORE,,, 3),
    	('THURSDAY',, PT_STORE,,, 4),
    	('FRIDAY',, PT_STORE,,, 5),
    	('SATURDAY',, PT_STORE,,, 6),
    	('SUNDAY',, PT_STORE,,, 7));

    $STATE (,
    	(':',),
    	(TPA$_EOS, TPA$_EXIT, PT_STORE,,, 99));

    $STATE (OPNPAR,
    	('(',),
    	(TPA$_LAMBDA,));

    $STATE (NUM1,
    	(TPA$_DECIMAL,, PT_STORE,,, 88));

    $STATE (HYPCOM,
    	(')', TPA$_EXIT, PT_STORE,,, 89),
    	('-',),
    	(',', NUM1, PT_STORE,,, 89),
    	(TPA$_EOS, TPA$_EXIT, PT_STORE,,, 89));

    $STATE (NUM2,
    	(TPA$_DECIMAL, EXPCOM, PT_STORE,,, 90));

    $STATE (EXPCOM,
    	(',', NUM1),
    	(')', TPA$_EXIT),
    	(TPA$_EOS, TPA$_EXIT));


%SBTTL 'PARSE_TIMES'
GLOBAL ROUTINE PARSE_TIMES (STR_A, PRIM_A, BITS_A) =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
!   This routine parses WCFG time lists of the form
!   	    day : (hour-range[,...])
!   and OR's the resultant activated bits into a 7-longword bitvector
!   (one longword per day, only bits 0-23 used per longword).
!
! RETURNS:  	cond_value, longword (unsigned), write only, by value
!
! PROTOTYPE:
!
!   PARSE_TIMES str, prim, bits
!
! IMPLICIT INPUTS:  None.
!
! IMPLICIT OUTPUTS: None.
!
! COMPLETION CODES:
!
!   SS$_NORMAL:	    	normal successful completion.
!
! SIDE EFFECTS:
!
!   None.
!--

    BIND
    	STR 	= .STR_A    : BLOCK [DSC$K_S_BLN,BYTE];

    LITERAL
    	TPA_C_LENGTH	= TPA$C_LENGTH0 + 16,
    	TPA_K_COUNT 	= TPA$K_COUNT0 + 4;

    LOCAL
    	TPABLK	: BLOCK [TPA_C_LENGTH,BYTE],
    	LEN 	: WORD,
    	DOW 	: ALIAS,
    	NUM1	: ALIAS;

    LIB$ANALYZE_SDESC (STR, LEN, TPABLK [TPA$L_STRINGPTR]);
    TPABLK [TPA$L_COUNT] = TPA_K_COUNT;
    TPABLK [TPA$L_OPTIONS] = 0;
    TPABLK [TPA$V_ABBRFM] = 1;
    TPABLK [TPA$L_STRINGCNT] = .LEN;
    TPABLK [TPA_A_P1] = DOW;
    TPABLK [TPA_A_P2] = NUM1;
    TPABLK [TPA_A_P3] = .PRIM_A;
    TPABLK [TPA_A_P4] = .BITS_A;

    LIB$TPARSE (TPABLK, PT_STATE, PT_KEY)

END; ! PARSE_TIMES

%SBTTL 'PT_STORE'
%IF %BLISS(BLISS32E) %THEN
ROUTINE PT_STORE (ARGLST : REF VECTOR [,LONG]) =
BEGIN

    BIND
    	OPTIONS	= ARGLST[1],
    	STRLEN	= ARGLST[2],
    	STRPTR	= ARGLST[3],
    	TOKLEN	= ARGLST[4],
    	TOKPTR	= ARGLST[5],
    	CHAR	= ARGLST[6] 	: BYTE,
    	NUMBER	= ARGLST[7],
    	PARAM	= ARGLST[8],
    	DOW_A	= ARGLST[9],
    	NUM1_A	= ARGLST[10],
    	PRIM_A	= ARGLST[11],
    	BITS_A	= ARGLST[12];
%ELSE
ROUTINE PT_STORE (OPTIONS, STRLEN, STRPTR, TOKLEN, TOKPTR, CHAR : BYTE,
    	    NUMBER, PARAM, DOW_A, NUM1_A, PRIM_A, BITS_A) =
BEGIN
%FI
!++
! FUNCTIONAL DESCRIPTION:
!
!   Stores values for PARSE_TIMES.
!
! RETURNS:  	cond_value, longword (unsigned), write only, by value
!
! PROTOTYPE:
!
!   PT_STORE  opt, strl, strp, tokl, tokp, chr, num, par, dow, num1, prim, bits
!
! IMPLICIT INPUTS:  None.
!
! IMPLICIT OUTPUTS: None.
!
! COMPLETION CODES:
!
!   SS$_NORMAL:	    	normal successful completion.
!
! SIDE EFFECTS:
!
!   None.
!--
    BIND
    	DOW 	= .DOW_A,
    	NUM1	= .NUM1_A,
    	PRIM	= .PRIM_A   : BITVECTOR [6],
    	BITS	= .BITS_A   : BLOCK [7,LONG];

    IF .PARAM LSS 8 THEN
    	DOW = .PARAM
    ELSE
    SELECTONE .PARAM OF
    SET
    	[99] :
    	    IF .DOW LSS 1 THEN
    	    BEGIN
    	    	INCR I FROM 0 TO 6 DO
    	    	    IF .PRIM [.I] EQL (.DOW EQL PT_K_PRIMARY) THEN
    	    	    	BITS [.I,0,24,0] = %X'FFFFFF';
    	    END
    	    ELSE
    	    	BITS [.DOW,0,24,0] = %X'FFFFFF';

    	[88] : NUM1 = MAX (MIN (.NUMBER, 23), 0);

    	[89] :
    	    IF .DOW LSS 1 THEN
    	    BEGIN
    	    	INCR I FROM 0 TO 6 DO
    	    	    IF .PRIM [.I] EQL (.DOW EQL PT_K_PRIMARY) THEN
    	    	    	BITS [.I,.NUM1,1,0] = 1;
    	    END
    	    ELSE
    	    	BITS [.DOW,.NUM1,1,0] = 1;

    	[90] :
    	    IF .DOW LSS 1 THEN
    	    BEGIN
    	    	INCR I FROM 0 TO 6 DO
    	    	    IF .PRIM [.I] EQL (.DOW EQL PT_K_PRIMARY) THEN
    	    	    	INCR J FROM .NUM1 TO MAX (MIN (.NUMBER, 23), 0) DO
    	    	    	    BITS [.I,.J,1,0] = 1;
    	    END
    	    ELSE
    	    	INCR J FROM .NUM1 TO MAX (MIN (.NUMBER, 23), 0) DO
    	    	    BITS [.DOW-1,.J,1,0] = 1;
    TES;

    SS$_NORMAL

END; ! PT_STORE

END
ELUDOM