 |
» |
|
|
|
 |
Copyright (c) Digital Equipment Corporation 1984, 1985. All rights reserved
LIB_TPARSE: PROCEDURE OPTIONS (MAIN);
/* Tested on VMS V3.5, PL/I V2.0. Program LIB_TPARSE uses the Run Time
Library routine LIB$TPARSE. The main routine and action routine are
written in PL/I and the State Table is coded in Macro. For a complete
description of LIB$TPARSE, see Appendix A, in the V3.x Run Time Library
Reference Manual. The State Table has specified one action routine.
This action routine will be called if the state transition is true.
This example of LIB$TPARSE will parse the SHOW DEVICES command:
SHOW DEVICES [device-name[:]]
Command Qualifier Default
/ALLOCATED
/BRIEF /BRIEF
/FILES
/FULL /BRIEF
/MOUNTED
/[NO]SYSTEM
If the program is successful, the action routine will print out
the action argument, the name of the device input and the message
'Syntax OK'.
If there is an error, the message 'Syntax error' will be printed,
as well as the position in the string and the input string itself.
*/
DECLARE LIB$TPARSE EXTERNAL ENTRY (
ANY,
ANY,
ANY)
RETURNS (FIXED BINARY (31));
DECLARE STR$UPCASE EXTERNAL ENTRY (
CHARACTER(*),
CHARACTER(*))
RETURNS (FIXED BINARY (31));
DECLARE LIB$STOP EXTERNAL ENTRY (ANY VALUE);
%REPLACE TPA$K_COUNT0 BY 8; /* Set parameter block count */
%REPLACE TPA$M_BLANKS BY 1; /* Process blanks */
%REPLACE TPA$M_ABBREV BY 2; /* Allow abbreviations */
DECLARE V_STRING CHARACTER (80) VARYING;
DECLARE LC_STRING CHARACTER (80);
DECLARE 1 COMMAND_STRING UNION,
2 UC_STRING CHARACTER (80),
2 UC_ARRAY(80) CHARACTER (1);
/* This structure defines the parameter block for LIB$TPARSE. The action
routine will reference it also. */
DECLARE 1 TPARS GLOBALDEF,
2 PB_COUNT FIXED BIN (31) INITIAL (TPA$K_COUNT0),
2 PB_OPTIONS FIXED BIN (31) INITIAL (0),
2 PB_STRINGCNT FIXED BIN (31) INITIAL (0),
2 PB_STRINGPTR POINTER,
2 PB_TOKENCNT FIXED BIN (31) INITIAL (0),
2 PB_TOKENPTR POINTER,
2 PB_CHAR FIXED BIN (31) INITIAL (0),
2 PB_NUMBER FIXED BIN (31) INITIAL (0),
2 PB_PARAM FIXED BIN (31) INITIAL (0);
/* UFD_STATE and UFD_KEY are defined in the Macro routine */
DECLARE (UFD_STATE, UFD_KEY) FIXED BIN (31) GLOBALREF;
DECLARE RETURN_STATUS FIXED BIN (31);
DECLARE LENGTH BUILTIN;
DECLARE POSITION FIXED BIN (31);
DECLARE LIB$_SYNTAXERR FIXED BIN (31) INITIAL (1409668);
/* Get the command string from the user */
GET EDIT (V_STRING) (A(80))
OPTIONS (PROMPT('Enter the command:$'));
/* Convert lowercase to UPPERCASE */
LC_STRING = V_STRING;
RETURN_STATUS = STR$UPCASE (UC_STRING, LC_STRING);
IF (RETURN_STATUS ^= 1) THEN CALL LIB$STOP (RETURN_STATUS);
/* Set parameter block fields */
TPARS.PB_OPTIONS = TPA$M_BLANKS + TPA$M_ABBREV;
TPARS.PB_STRINGCNT = LENGTH (V_STRING);
TPARS.PB_STRINGPTR = ADDR (UC_ARRAY(1));
RETURN_STATUS = LIB$TPARSE (TPARS, UFD_STATE, UFD_KEY);
/* Check return status */
IF (RETURN_STATUS = LIB$_SYNTAXERR) THEN DO
POSITION = LENGTH(V_STRING) - TPARS.PB_STRINGCNT + 1;
PUT SKIP LIST ('Syntax error at position: ',POSITION);
PUT SKIP LIST ('The input string was:');
PUT SKIP LIST (UC_STRING);
END;
ELSE IF (RETURN_STATUS ^= 1) THEN
CALL LIB$STOP(RETURN_STATUS);
ELSE
PUT SKIP LIST ('Syntax OK');
END LIB_TPARSE;
ACTION: PROCEDURE RETURNS (FIXED BINARY (31));
/*
This is an action routine. The state transition that occurred to get
here is that a character was found were the device specification should
be. This routine will print the action parameter that was specified on
the transition and the device specification, then return.
*/
DECLARE 1 TPARS GLOBALREF,
2 PB_COUNT FIXED BIN (31),
2 PB_OPTIONS FIXED BIN (31),
2 PB_STRINGCNT FIXED BIN (31),
2 PB_STRINGPTR POINTER,
2 PB_TOKENCNT FIXED BIN (31),
2 PB_TOKENPTR POINTER,
2 PB_CHAR FIXED BIN (31),
2 PB_NUMBER FIXED BIN (31),
2 PB_PARAM FIXED BIN (31);
DECLARE STRING CHARACTER (PB_TOKENCNT) BASED (PB_TOKENPTR);
PUT SKIP LIST ('The action argument is: ',TPARS.PB_PARAM);
PUT SKIP LIST ('The device is: ',STRING);
RETURN (1);
END ACTION;
/* .TITLE PARSE
;+
; This macro routine will set up the state tables for
; the SHOW DEVICES command.
;-
;+
; Define parameter block. You may fill the count and options field
; here or in the high level language routine.
;-
; .PSECT TPARS,PIC,OVR,GBL,SHR,NOEXE,REL,WRT,LONG
;PARM: .LONG 0 ; LONGWORD COUNT
; .LONG 0 ; OPTIONS
; .BLKL 7 ; DEFINE REMAINING STORAGE
;
; Define control block offsets
;
$TPADEF GLOBAL
$LIBDEF GLOBAL
;
; Begin definition of the State Table. UFD_STATE and UFD_KEY are
; the names of the State and Key Tables.
;
$INIT_STATE UFD_STATE,UFD_KEY
;
; The $STATE Macro designates that we are entering a new state and a name
; for that state. The name is used for branching too. The $TRAN Macro
; specifies a keyword and, optionally, a state to branch too.
$STATE COMMAND
$TRAN 'SHOW',FUNC
;
; If the Token does not match any of the transition for that state
; an error indicating an syntax error will be returned.
;
$STATE FUNC
$TRAN TPA$_BLANK
$STATE
$TRAN 'DEVICES',DEV
;
; Command is SHOW DEVICES. Check for / or blank.
;
$STATE DEV
$TRAN TPA$_BLANK,DEVNAM
$TRAN '/',QUAL
$TRAN TPA$_EOS,TPA$_EXIT
;
; Blank found, check for device name
;
$STATE DEVNAM
$TRAN TPA$_SYMBOL, ALLDONE, ACTION, , ,1234
;
; Qualifiers found, check syntax
;
$STATE QUAL
$TRAN 'ALLOCATED',DEV
$TRAN 'BRIEF',DEV
$TRAN 'FILES',DEV
$TRAN 'FULL',DEV
$TRAN 'MOUNTED',DEV
$TRAN 'SYSTEM',DEV
$TRAN 'NOSYSTEM',DEV
$TRAN 'WINDOWS',DEV
$TRAN TPA$_BLANK,QUAL
$TRAN TPA$_EOS,TPA$_FAIL
;
; All done, return, Status OK.
;
$STATE ALLDONE
$TRAN TPA$_ANY, TPA$_EXIT
$TRAN TPA$_EOS, TPA$_EXIT
$END_STATE
.END */
|
|
|
buy online or call 1.800.AT.COMPAQ
|
|
