Google
 

Trailing-Edge - PDP-10 Archives - BB-JF18A-BM - sources/rms/lodcmd.b36
There are 3 other files named lodcmd.b36 in the archive. Click here to see a list.
!
!	COPYRIGHT (C) DIGITAL EQUIPMENT  1986.
!	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 THAT IS NOT SUPPLIED BY DIGITAL.
!
%TITLE 'L O D C M D  -- RMSLOD command script processor'
!<BLF/REQUIRE 'BLI:BLF.REQ'>
MODULE lodcmd =
BEGIN

LIBRARY 'bli:xport';

LIBRARY 'rmsint';				! Get the RMS symbols

LIBRARY 'stsdef';				! Get status code definitions

LIBRARY 'comand';				! Use the COMAND package

LIBRARY 'bli:tops20';			! Get monitor symbols and JSYSes

LIBRARY 'bli:fao';

!+
!   COMMAND_STATUS block
!
!   The command status block (CMDSTS) is the data structure
!   used to transfer command parsing status to and from action
!   routines.
!
!	COMMAND_STATUS fields
!
!	STATUS -	Status of the parse action.  This field
!			is used to flag that a "backup" or "display"
!			action has been requested, for instance.
!	NEXT ROUTINE -	Next routine to be called.  Option used
!			when a choice of keywords determines a
!			branch in the script tree, as choice of
!			file organization would do.
!	CONTEXT -	Extra word for internal routine use.  This
!			could pass FAB$K_SEQ (_REL, _IDX) as a
!			value to be set in the ORG field of a FAB.
!
!   The address of the command status block is passed to action
!   routines in the CONTEXT field of the $COMAND_FLDDB and
!   $COMAND_OPTION macros.
!
!   The block is declared as a $CMDSTS_BLOCK attribute.  A command
!   status "literal" may be created with the $COMMAND_STATUS macro, which
!   returns the address of an appropriately initialized UPLIT.
!
!   EDIT HISTORY
!
!   20-Sep-85  asp  Add Ron Lusk's final pieces for first working version.
!-

FIELD
    cmdsts$r_fields =
	SET
	cmdsts$g_status = [0, 0, 36, 0],	! Status of operation
	cmdsts$a_next_routine = [1, 0, 36, 0],	! Next routine to call
	cmdsts$g_context = [2, 0, 36, 0]	! Locally used value
	TES;

MACRO
    $cmdsts_block =
 BLOCK [3] FIELD (cmdsts$r_fields) %;

KEYWORDMACRO
    $command_status (
	    status = 0,
	    next = 0,
	    context = 0 ) =
 UPLIT (status, next, context)
%;

!+
!   Generally useful macros
!-

MACRO
    !
    !   CH$SEQUENCE -- allocates a buffer
    !
    ch$sequence (n) =
 VECTOR [CH$ALLOCATION (n)] %,
    !
    !   XWD -- performs MACRO XWD pseudo-op
    !
    $xwd (lh, rh) =
 ((lh)^18 OR ((rh) AND %O'777777')) %,
    !
    !   $STPTR -- returns pointer to literal ASCIZ string
    !
    $stptr [] =
 CH$PTR (UPLIT (%ASCIZ %STRING (%REMAINING))) %,
    !
    !   $$STRTBL_ENT -- internal macro for $STRTBL
    !
    $$strtbl_ent [strings] =
    $stptr (%REMOVE (strings)) %,
    !
    !   $STRTBL -- returns address of a vector of
    !   character pointers to literal strings
    !
    $strtbl [] =
 UPLIT (	!
	$$strtbl_ent (%REMAINING)) : VECTOR %,
    !
    !   $CRLF -- puts a CRLF into a string
    !
    $crlf =
 %CHAR($chcrt,$chlfd) %;

LITERAL
    !
    !   Assorted constants
    !
    max_bucket_size = 7,			! Maximum of 7 pages
    minimum_records_per_bucket = 6,		! Fit at least 6 recs/bkt
    buffer_length = 80,				! Command/atom buffer length
    bigbuf_length = 500,			! For DISPLAY, error buffers
    !
    !   Format word for JFNS output
    !
    jfns$k_format = fld ($jsssd, js_dev) OR 	! Device
	fld ($jsssd, js_dir) OR 		! Directory
	fld ($jsaof, js_nam) OR 		! Filename
	fld ($jsaof, js_typ) OR 		! Filetype
	fld ($jsaof, js_gen) OR 		! Generation
	js_paf,					! Punctuate all the above
    !
    !   Operation values
    !
    lod$k_load = 1,				! Load a file
    lod$k_reorg = 2,				! Reorganize a file
    lod$k_unload = 3,				! Unload a file
    !
    !   Fields to display (bits in DISP_FLAGS)
    !
    dsp$k_operation = 0,			! Operation has been chosen
    dsp$k_injfn = 1,				! We have an input JFN
    dsp$k_unload_key = 2,			! Key to unload upon
    dsp$k_outjfn = 3,				! Output file
    dsp$k_org = 4,				! Output organization
    dsp$k_rfm = 5,				! Record format
    dsp$k_bsz = 6,				! Output bytesize
    dsp$k_mrs = 7,				! Maximum record size
    dsp$k_blk = 8,				! BLK record attribute
    dsp$k_key = 9,				! Keys are defined
    dsp$k_class = 10,				! File class
    dsp$k_inrfm = 11,				! Input format
    dsp$k_inmrs = 12,				! Input record size
    dsp$k_inbls = 13,				! Input blocking factor
    !
    !   Status codes
    !
    lod$k_fac = 4,				! "Facility" for RMSLOD
    true = 1,
    false = 0,
    ss$_jsys_error_return = sts$value (CODE = 1, 	!
	    severity = error, fac_no = lod$k_fac),
    ss$_jsys_error_quit = sts$value (CODE = 1, 	!
	    severity = severe, fac_no = lod$k_fac),
    ss$_reparse = sts$value (CODE = 2, 		!
	    severity = info, fac_no = lod$k_fac),
    ss$_rms_error = sts$value (CODE = 3, 	!
	    severity = error, fac_no = lod$k_fac),
    ss$_exit = sts$value (CODE = 4, 		!
	    severity = info, fac_no = lod$k_fac),
    ss$_backup = sts$value (CODE = 5, 		!
	    severity = info, fac_no = lod$k_fac),
    ss$_success = sts$value (CODE = 6, 		!
	    severity = success, fac_no = lod$k_fac),
    ss$_display = sts$value (CODE = 7, 		!
	    severity = info, fac_no = lod$k_fac),
    ss$_out_of_range = sts$value (CODE = 8, 	!
	    severity = warning, fac_no = lod$k_fac),
    ss$_record_too_large = sts$value (CODE = 9, 	!
	    severity = severe, fac_no = lod$k_fac),
    ss$_input_not_indexed = sts$value (CODE = 11, 	!
	    severity = error, fac_no = lod$k_fac);

!+
!   Table of contents
!-

FORWARD ROUTINE
    display : NOVALUE,				! Display status
    dspkey : NOVALUE,
    setup_stateblock : NOVALUE,			! Initialize stateblock
    top_handler,			! Top condition handler for LODCMD
    lodcmd,					! Entry into LODCMD
    set_backup : NOVALUE,			! Set status to perform backup
    set_display : NOVALUE,		! Set status to perform display
    operation,				! Get RMSLOD operation to perform
    l_ifile,					! Get input file to load
    l_ofile,					! Get RMS file to be loaded
    organization,			! Get organization of new RMS file
    format,					! Get record format
    bytesize,					! Get file bytesize
    recordsize,					! Get record length in bytes
    primary_key,				! Get primary key data
    key_6,					! Key def's for 6-bit-bytes
    key_7,					! Key def's for 7-bit bytes
    key_9,					! Key def's for 9-bit bytes
    key_36,				! Key def's for other bytesizes
    key_prompt : NOVALUE,			! Set KEY_n prompt
    position,					! Key position in record
    size,					! Key size
    setdup,					! Are duplicates allowed?
    setchg,					! Are changes allowed?
    setdfl,					! Set data fill limit
    setifl,					! Set index fill limit
    nxtkey,					! Get alternate key data
    spanned_records,				! Get BLK record attribute
    file_language,				! Get language of foreign file
    isam_bsz,                                   ! Get bytesize of ISAM file
    ebc_rsz,					! Get RSZ for fixed EBC file
    blocking_factor,			! Get blocking factor, EBC file
    confirm,					! Get confirmation of order
    r_ifile,					! Get file to be reorganized
    r_ofile,					! Get new index file
    u_ifile,					! Get file to be unloaded
    u_ofile,					! Get file to unload into
    u_getkey;					! Key to unload file by

EXTERNAL ROUTINE
    getmem,
    fremem;

EXTERNAL LITERAL
    ss$unw;					! Status of UNWIND from CHF

OWN
    !
    !   Flag word for display of file definition fields
    !
    disp_flags : BITVECTOR [36],		! Fields to display
    !
    !   Buffers and variables for $FAO output and DISPLAY
    !
    control,					! Pointer to control string
    fprm : VECTOR [10],				! Parameter list for FAO
    dspbuf : ch$sequence [bigbuf_length],	! Immense buffer for DISPLAY
    dspdsc : $str_descriptor (class = fixed, 	! Buffer descriptor for
	    string = (bigbuf_length, CH$PTR (dspbuf))),	! DISPLAY routines
    errbuf : ch$sequence [bigbuf_length],	! Error message buffer
    errdsc : $str_descriptor (class = fixed, 	! Buffer descriptor for
	    string = (bigbuf_length, CH$PTR (errbuf))),	! error messages
    rtybuf : ch$sequence [buffer_length],	! Prompt buffer
    rtydsc : $str_descriptor (class = fixed, 	! Buffer descriptor for
	    string = (buffer_length, CH$PTR (rtybuf))),	! prompts
    hlpbuf : ch$sequence [buffer_length],	! Help buffer
    hlpdsc : $str_descriptor (class = fixed, 	! Buffer descriptor for
	    string = (buffer_length, CH$PTR (hlpbuf))),	! help messages
    !
    !   Assorted variables
    !
    op_choice,					! Desired operation
    databucket_size,				! Size of primary data bucket
    !
    !   COMND state block and buffers
    !
    stateblock : VECTOR [$cmgjb + 1],		! COMND stateblock
    command_buffer : ch$sequence [buffer_length],
    atom_buffer : ch$sequence [buffer_length],
    !
    !   JFN blocks and default filespec buffers
    !
    injfn : VECTOR [$gjatr + 1],		! Input JFN block
    outjfn : VECTOR [$gjatr + 1],		! Output JFN block
    outdev : ch$sequence [30],			! Default device
    outdir : ch$sequence [200],			! Default directory
    outnam : ch$sequence [40],			! Default filename
    outtyp : ch$sequence [40],			! Default file extension
    !
    !   RMS argument blocks
    !
    outfab : REF $fab_decl,
    summary : $xabsum (),			! Summary for unload key
    infab : REF $fab_decl,
    intyp : REF $typ_decl;
ROUTINE display : NOVALUE =
    BEGIN

    IF .disp_flags EQL 0			! Nothing set?
    THEN
	BEGIN
	psout ($stptr ('%You have not answered any questions yet', $crlf));
	RETURN;
	END;

    IF .disp_flags [dsp$k_operation]		!
    THEN
	BEGIN

	BIND
	    ops = $strtbl ('Load', 'Reorganize', 'Unload');

	control = $fao_ctl ('!2(/)!28<Operation:!> !AZ!/!%^@');
	fprm [0] = .ops [.op_choice - 1];
	$faol (ctrstr = .control, outbuf = dspdsc, prmlst = fprm);
	psout (CH$PTR (dspbuf));
	END;

    IF .disp_flags [dsp$k_injfn]		! Input file chosen?
    THEN
	BEGIN
	control = $fao_ctl ('!/!28<Input file:!> !J!/!%^@');
	fprm [0] = .infab [fab$h_jfn];

	IF NOT $faol (ctrstr = .control, outbuf = dspdsc, prmlst = fprm)
						!
	THEN
	    SIGNAL (ss$_jsys_error_quit);

	psout (CH$PTR (dspbuf));
	END;

    IF .disp_flags [dsp$k_unload_key]		! Key for unloading specified?
    THEN
	BEGIN
	control = $fao_ctl ('!28<    Key for unloading file:!> !UL!/!%^@');
	fprm [0] = .infab [fab$g_ctx];
	$faol (ctrstr = .control, outbuf = dspdsc, prmlst = fprm);	!
	psout (CH$PTR (dspbuf));
	END;

    IF .disp_flags [dsp$k_outjfn]		! Output file chosen?
    THEN
	BEGIN
	control = $fao_ctl ('!/!28<Output file:!> !J!/!%^@');
	fprm [0] = .outfab [fab$h_jfn];
	$faol (ctrstr = .control, outbuf = dspdsc, prmlst = fprm);	!
	psout (CH$PTR (dspbuf));
	END;

    IF .disp_flags [dsp$k_org]			!
    THEN
	BEGIN

	BIND
	    orgs = $strtbl ('Sequential', 'Relative', 'Indexed');

	control = $fao_ctl ('!28<    Organization:!> !AZ!/!%^@');
	fprm [0] = .orgs [.outfab [fab$v_org] - 1];
	$faol (ctrstr = .control, outbuf = dspdsc, prmlst = fprm);	!
	psout (CH$PTR (dspbuf));
	END;

    IF .disp_flags [dsp$k_rfm]			!
    THEN
	BEGIN

	BIND
	    rfms = $strtbl (			!
		    'Variable', 		!
		    'Stream', 			!
		    'Line-Sequenced ASCII', 	!
		    'Fixed');

	control = $fao_ctl ('!28<    Record format:!> !AZ!/!%^@');
	fprm [0] = .rfms [.outfab [fab$v_rfm]];
	$faol (ctrstr = .control, outbuf = dspdsc, prmlst = fprm);	!
	psout (CH$PTR (dspbuf));
	END;

    IF .disp_flags [dsp$k_bsz]			! Bytesize given?
    THEN
	BEGIN
	control = $fao_ctl ('!28<    File bytesize:!> !UL!/!%^@');
	fprm [0] = .outfab [fab$v_bsz];
	$faol (ctrstr = .control, outbuf = dspdsc, prmlst = fprm);	!
	psout (CH$PTR (dspbuf));
	END;

    IF .disp_flags [dsp$k_mrs]			! Record size given?
    THEN
	BEGIN

	IF .outfab [fab$h_mrs] EQL 0		! No maximum?
	THEN
	    BEGIN
	    control = $fao_ctl ('!28<    Maximum record size:!> ', 	!
		'No maximum specified!/!%^@');
	    END
	ELSE
	    BEGIN
	    control = $fao_ctl ('!28<    Maximum record size:!> !UL!/!%^@');
	    END;

	fprm [0] = .outfab [fab$h_mrs];
	$faol (ctrstr = .control, outbuf = dspdsc, prmlst = fprm);	!
	psout (CH$PTR (dspbuf));
	END;

    IF .disp_flags [dsp$k_blk]			!
    THEN
	BEGIN

	BIND
	    ratblks = $strtbl ('No', 'Yes');

	control = $fao_ctl ('!28<    Record blocking:!> !AZ!/!%^@');
	fprm [0] = .ratblks [.outfab [fab$v_blk]];
	$faol (ctrstr = .control, outbuf = dspdsc, prmlst = fprm);	!
	psout (CH$PTR (dspbuf));
	END;

    IF .outfab [fab$a_xab] NEQ 0		! XAB to display?
    THEN
	dspkey (.outfab [fab$a_xab]);		! Display it

    psout ($stptr ($crlf));
    END;					! End DISPLAY
ROUTINE dspkey (key_xab : REF $xabkey_decl) : NOVALUE =
    BEGIN

    BIND
	dtypes = $strtbl (			!
		'ASCII', 			!
		'EBCDIC', 			!
		'SIXBIT', 			!
		'Packed decimal', 		!
		'One-word integer', 		!
		'Floating point', 		!
		'Double floating point', 	!
		'G-floating point', 		!
		'Two-word integer', 		!
		'Eight-bit ASCII', 		!
		'Unsigned integer'),		!
	noyes = $strtbl ('No', 'Yes');		!

    IF .key_xab [xab$v_cod] EQL xab$k_key	! Display key XABs only
    THEN
	BEGIN
	control = $fao_ctl ('!/!28<    Key !UL:!> !AZ!/', 	!
	    '!28<        Position:!> !AZ !UL!/', 	!
	    '!28<        Size:!> !UL !AZ!%S!/', 	!
	    '!28<        Duplicates allowed:!> !AZ!/', 	!
	    '!28<        Changes allowed:!> !AZ!/', 	!
	    '!28<        Data fill:!> !3UL%!/', 	!
	    '!28<        Index fill:!> !3UL%!/!%^@');
	fprm [0] = .key_xab [xab$b_ref];	! Key of reference
	fprm [1] = .dtypes [.key_xab [xab$v_dtp]];	! Datatype

	SELECTONE .key_xab [xab$v_dtp] OF
	    SET

	    [xab$k_stg, xab$k_ebc, xab$k_six, xab$k_pac, xab$k_as8] :
		BEGIN
		fprm [2] = $stptr ('Byte');
		fprm [3] = .key_xab [xab$h_pos0];
		fprm [4] = .key_xab [xab$h_siz0];
		fprm [5] = $stptr ('byte');
		END;

	    [xab$k_in4, xab$k_uin, xab$k_fl1] :
		BEGIN
		fprm [2] = $stptr ('Word');
		fprm [3] = .key_xab [xab$h_pos0];
		fprm [4] = 1;
		fprm [5] = $stptr ('word');
		END;

	    [xab$k_in8, xab$k_fl2, xab$k_gfl] :
		BEGIN
		fprm [2] = $stptr ('Word');
		fprm [3] = .key_xab [xab$h_pos0];
		fprm [4] = 2;
		fprm [5] = $stptr ('word');
		END;
	    TES;

	!
	!   Display the CHANGE and DUPLICATES attributes
	!
	fprm [6] = .noyes [.key_xab [xab$v_dup]];
	fprm [7] = .noyes [.key_xab [xab$v_chg]];
	!
	!   Calculate the data fill percentage.  This
	!   is dependent upon whether this is the primary
	!   key (in which case we use the value in
	!   DATABUCKET_SIZE) or a secondary key (which
	!   uses the default bucket size of the file).
	!

	IF .key_xab [xab$b_ref] EQL 0
	THEN
	    fprm [8] = .key_xab [xab$h_dfl]*100/(.databucket_size*%O'1000' - 3)
	ELSE
	    fprm [8] = .key_xab [xab$h_dfl]*100/(.outfab [fab$v_bks]*%O'1000' -
	    3);

	!
	!   Get the index fill percentage
	!
	fprm [9] = .key_xab [xab$h_ifl]*100/(.outfab [fab$v_bks]*%O'1000' - 3);
	$faol (ctrstr = .control, prmlst = fprm, outbuf = dspdsc);
	psout (CH$PTR (dspbuf));
	END;

    IF .key_xab [xab$a_nxt] NEQ 0		! Next XAB
    THEN
	dspkey (.key_xab [xab$a_nxt]);

    END;					! End DSPKEY
ROUTINE setup_stateblock : NOVALUE =
    BEGIN
    stateblock [$cmflg] = 0;			! Default to no flags
    stateblock [$cmioj] = $xwd ($priin, $priou);	! TTY: I/O
    !
    !   Set up pointer to prompt buffer.  The calling routine
    !   will set this to a string literal pointer if the
    !   prompt buffer is not used.
    !
    stateblock [$cmrty] = CH$PTR (rtybuf);
    !
    !   Set up buffer pointers and lengths
    !
    stateblock [$cmptr] = stateblock [$cmbfp] = CH$PTR (command_buffer);
    stateblock [$cmcnt] = stateblock [$cmabc] = buffer_length;
    stateblock [$cminc] = 0;
    stateblock [$cmabp] = CH$PTR (atom_buffer);
    stateblock [$cmgjb] = 0;			! No default GTJFN block
    END;					! End SETUP_STATEBLOCK
ROUTINE top_handler (sig : REF VECTOR, mech : REF VECTOR, enbl : REF VECTOR) =
    BEGIN

    LOCAL
	hndbuf : ch$sequence [bigbuf_length],	! Large message buffer
	hnddsc : $str_descriptor (class = fixed);

    BIND
	cond = sig [1] : $condition_value,	! Value passed by SIGNAL
	return_value = mech [1];		! Value to be returned

    !
    !   Initialize our buffer descriptor
    !
    $str_desc_init (class = fixed, descriptor = hnddsc, 	!
	string = (bigbuf_length, CH$PTR (hndbuf)));

    !+
    !   Take appropriate action for the condition we received.
    !-

    SELECTONE .cond OF
	SET

	[ss$_exit] :
	    BEGIN
	    ! Close files
	    psout ($stptr ($crlf, '[Exiting]'));
	    haltf ();

	    INCR i FROM 1 TO 3 DO
		BEGIN
		esout ($stptr ('Cannot continue RMSLOD'));
		haltf ();
		END;

	    psout ($stptr ($crlf, '[Continuing]'));
	    RETURN true;
	    END;

	[ss$_backup] :
	    BEGIN
	    psout ($stptr ('% You cannot backup any further', $crlf));
	    return_value = false;
	    RETURN true;
	    END;

	[ss$unw] :
	    BEGIN
	    ! Probably shouldn't get here
	    ! Close files?
	    psout ($stptr ($crlf, '[Exiting (from UNWIND)]'));
	    haltf ();

	    INCR i FROM 1 TO 3 DO
		BEGIN
		esout ($stptr ('Cannot continue RMSLOD'));
		haltf ();
		END;

	    psout ($stptr ($crlf, '[Continuing]'));
	    RETURN true;
	    END;

	[ss$_display] :
	    BEGIN
	    display ();
	    RETURN true;			! Keep on going
	    END;

	[ss$_jsys_error_return, ss$_jsys_error_quit] :
	    BEGIN

	    !+
	    !   The format of the signal vector is
	    !
	    !       |---------------------------|
	    !   0   |   n = length of vector	|
	    !       |---------------------------|
	    !   1   |   Condition value		|
	    !       |---------------------------|
	    !   2   |   Error code 1		|
	    !       |---------------------------|
	    !   3   |   Error code 2		|
	    !       |---------------------------|
	    !       /   ....                   	/
	    !       |---------------------------|
	    !   n-1 |   Error code n-2		|
	    !       |---------------------------|
	    !
	    !   This block of code will determine the number
	    !   of error messages passed in the signal vector.
	    !   If no error message is passed, it defaults to
	    !   printing the message for the last error
	    !   encountered.  Otherwise, it prints the message
	    !   for each error code passed.  If any error code
	    !   is -1, the message for the last error is used.
	    !
	    !   The first message is output with an ESOUT,
	    !   and so is preceded with a "?".  Any subsequent
	    !   messages are output on a new line, preceded
	    !   by a "-<TAB>" sequence.
	    !
	    !   After the messages are output, the program is
	    !   halted if the severity field of the condition
	    !   value is SEVERE, otherwise the handler continues
	    !   the interrupted routine.
	    !-

	    LOCAL
		number_of_messages;

	    number_of_messages = .sig [0] - 1;	! Number of messages

	    IF .number_of_messages EQL 0	! Implicit last error
	    THEN
		BEGIN
		control = $fao_ctl ('!E!/!%^@');
		fprm [0] = 0;			! Last error
		$faol (ctrstr = .control, prmlst = fprm, outbuf = hnddsc);
		esout (CH$PTR (hndbuf));
		END
	    ELSE
		BEGIN				! Give explicit error message
		!
		!   Put out the primary error message
		!
		control = $fao_ctl ('!E!/!%^@');
		fprm [0] = .sig [2];		! Given error
		$faol (ctrstr = .control, prmlst = fprm, outbuf = hnddsc);
		esout (CH$PTR (hndbuf));

		!+
		!   If there are secondary messages, put
		!   them out, too.
		!-

		INCR i FROM 3 TO .sig [0] DO 	! Output others
		    BEGIN
		    !
		    !   Put out the secondary error message
		    !
		    control = $fao_ctl ('-!E!/!%^@');
		    fprm [0] = .sig [.i];	! Message
		    $faol (ctrstr = .control, prmlst = fprm, outbuf = hnddsc);
		    psout (CH$PTR (hndbuf));
		    END;

		END;

	    !+
	    !   If this was a severe error, then we don't
	    !   return to the user.  Just halt.
	    !-

	    IF .cond [sts$v_severity] EQL sts$k_severe	! Severe error?
	    THEN

		WHILE 1 DO
		    BEGIN
		    haltf ();
		    psout ($stptr ('?Cannot continue', $crlf));
		    END;

	    RETURN true;
	    END;

	[ss$_rms_error] :
	    BEGIN

	    !+
	    !   This code assumes that the third element of
	    !   the signal vector (SIG [2]) contains the
	    !   address of the RMS argument block which was
	    !   used in the call which received the error.
	    !-

	    BIND
		errblk = .sig [2] : $fab_decl;

	    control = $fao_ctl ('RMS error - STS: !OW   STV: !OW!%^@');
	    fprm [0] = .errblk [fab$h_sts];
	    fprm [1] = .errblk [fab$h_stv];
	    $faol (ctrstr = .control, prmlst = fprm, outbuf = hnddsc);
	    esout (CH$PTR (hndbuf));

	    WHILE 1 DO
		BEGIN
		haltf ();
		psout ($stptr ('?Cannot continue', $crlf));
		END;

	    RETURN false;
	    END;

	[ss$_record_too_large] :
	    BEGIN
	    psout ($stptr ($crlf, '%Record size too large'));
	    RETURN true;
	    END;

	[ss$_input_not_indexed] :
	    BEGIN
	    psout ($stptr ($crlf, '%Input file must be RMS indexed file'));
	    RETURN true;
	    END;

	[ss$_out_of_range] :
	    BEGIN

	    BIND
		lo_range = sig [2],		! Low end of range
		hi_range = sig [3];		! High end of range

	    control = $fao_ctl ('!/%Value must be between !UL and !UL!/!%^@');
	    fprm [0] = .lo_range;
	    fprm [1] = .hi_range;
	    $faol (ctrstr = .control, prmlst = fprm, outbuf = hnddsc);
	    psout (CH$PTR (hndbuf));
	    RETURN true;
	    END;

	[OTHERWISE] :
	    BEGIN
	    esout ($stptr ('Unknown condition code encountered', $crlf));
	    RETURN false;			! Resignal to default CHF
	    END;
	TES;

    END;					! End TOP_HANDLER
GLOBAL ROUTINE lodcmd (p_infab, p_outfab) =
    BEGIN

    ENABLE
	top_handler;

    MAP
	disp_flags;

    disp_flags = 0;				! Zero display flags
    infab = .p_infab;
    intyp = .infab [fab$a_typ];
    outfab = .p_outfab;
    operation ();
    RETURN .op_choice;
    END;					! End DRIVER
ROUTINE set_backup (a, b, status : REF $cmdsts_block) : NOVALUE =
    BEGIN
    status [cmdsts$g_status] = ss$_backup;
    END;					! End SET_BACKUP
ROUTINE set_display (a, b, status : REF $cmdsts_block) : NOVALUE =
    BEGIN
    status [cmdsts$g_status] = ss$_display;
    END;					! End SET_DISPLAY
ROUTINE set_exit (a, b, status : REF $cmdsts_block) : NOVALUE =
    BEGIN
    status [cmdsts$g_status] = ss$_exit;
    END;					! End SET_EXIT
%SBTTL 'OPERATION - get RMSLOD operation'
ROUTINE operation =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	op_question_handler,		! Condition handler for this routine
	op_initialize : NOVALUE,		! Called by .CMINI function
	op_take_action : NOVALUE;		! Called by parser

    OWN
	op_status : $cmdsts_block,		! Status from this parse
	!
	!   Keyword table
	!
	op_kwords : $comand_key (		!
		$comand_option (		!
		    opt = 'Load', 		!
		    action = op_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			next = l_ifile, 	!
			context = lod$k_load), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'Reorganize', 	!
		    action = op_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			next = r_ifile, 	!
			context = lod$k_reorg), 	!
		    next = 1),
		$comand_option (		!
		    opt = 'Unload', 		!
		    action = op_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			next = u_ifile, 	!
			context = lod$k_unload), 	!
		    next = 1)),
	!
	!   Parsing states and transitions
	!
	op_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = op_initialize, 	!
			context = op_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMKEY
			function = $cmkey, 	!
			data = op_kwords, 	! Load, Reorg, or Unload
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = op_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = op_status, 	! Status variable
				next = 1, more = 	!
				$comand_flddb (	! CRLF for default
				    function = $cmcfm, 	!
				    flags = cm_sdh, 	! Suppress help
				    help = 'Return for default', 	!
				    action = op_take_action, 	!
				    context = $command_status (	!
					status = ss$_success, 	!
					next = l_ifile, 	!
					context = lod$k_load), 	!
				    next = -1))))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE op_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_success;
	info [cmdsts$a_next_routine] = l_ifile;
	info [cmdsts$g_context] = lod$k_load;
	control = $fao_ctl (
	    'That is not an operation RMSLOD can perform.  Please choose one!/',
	' of the following operations:!/', 	!
	    '!_!11<LOAD!> -- make an RMS indexed file from another file!/',

	    '!_!11<REORGANIZE!> -- copy an RMS indexed file, making it more efficient!/'
	,

	    '!_!11<UNLOAD!> -- make an RMS sequential file from an RMS indexed file!/!%^@'
	);
	$faol (ctrstr = .control, prmlst = 0, outbuf = errdsc);
	cmderp = CH$PTR (errbuf);
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE op_take_action (a, b, returned_context : REF $cmdsts_block) :
	NOVALUE =
	BEGIN
	op_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];
	op_status [cmdsts$a_next_routine] = .returned_context [
	    cmdsts$a_next_routine];
	op_status [cmdsts$g_context] = .returned_context [cmdsts$g_context];
	cmderp = $stptr ('Your answer was not followed by a carriage return');
	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE op_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl : REF
	VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$unw] :
		BEGIN
		disp_flags [dsp$k_operation] = 0;
		RETURN false;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    ENABLE
	op_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN
	setup_stateblock ();			! Initialize the state block
	cmderr = 0;				! Handle errors for us
	cmdrpt = 2;			! Reparse from state after .CMINI
	stateblock [$cmrty] = $stptr ('Operation [Load]: ');	! Set prompt
	comand (0, stateblock, op_states);	! Get the command

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .op_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN

	    BIND ROUTINE
		routine_to_call = .op_status [cmdsts$a_next_routine];

	    op_choice = .op_status [cmdsts$g_context];	! Set operation code
	    disp_flags [dsp$k_operation] = 1;

	    !+
	    !   Call the next routine below us.  If the
	    !   return is successful, then we can exit the
	    !   loop and work our way back to the top of
	    !   the stack of calls.  If the return is not
	    !   successful, it is a request for backing up,
	    !   and we stay in the loop.
	    !-

	    IF routine_to_call () EQL ss$_success	! All OK?
	    THEN
		EXITLOOP;			! The only way out

	    END
	ELSE
	    BEGIN
	    disp_flags [dsp$k_operation] = 0;
	    op_choice = 0;			! No operation (for DISPLAY)
	    SIGNAL (.op_status [cmdsts$g_status]);	! Parse not "success"
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					!End OPERATION
%SBTTL 'Load script routines'
ROUTINE l_ifile =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	li_question_handler,		! Condition handler for this routine
	li_initialize : NOVALUE,		! Called by .CMINI function
	li_take_action : NOVALUE;		! Called by parser

    OWN
	li_status : $cmdsts_block,		! Status from this parse
	!
	!   Parsing states and transitions
	!
	li_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = li_initialize, 	!
			context = li_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMIFI
			function = $cmifi, 	!
			flags = cm_sdh, 	!
			help = 'input file',
			context = $command_status (	!
			    status = ss$_success, 	!
			    next = 0, 		! No branching here
			    context = 0), 	!
			action = li_take_action,
						! Do something w/ the JFN
			next = 1, 		!
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = li_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = li_status, 	! Status variable
				next = 1)))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE li_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_jsys_error_return;	! Just in case
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = 0;
	RETURN;
	END;					! End li_INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE li_take_action (jfn, b, returned_context : REF $cmdsts_block) :
	NOVALUE =
	BEGIN

	IF .infab [fab$h_jfn] NEQ 0		! Do we already have a JFN?
	THEN
	    BEGIN
	    rljfn (.infab [fab$h_jfn]);		! Release it
	    infab [fab$h_jfn] = 0;		! Zero it
	    END;

	li_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];
	infab [fab$h_jfn] = .jfn;
	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE li_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl : REF
	VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$_backup] :
		BEGIN
		return_value = ss$_backup;
		SETUNWIND ();
		RETURN true;
		END;

	    [ss$unw] :
		BEGIN

		IF .infab [fab$h_jfn] NEQ 0	! Release JFN if needed
		THEN
		    BEGIN
		    rljfn (.infab [fab$h_jfn]);	! Release it
		    infab [fab$h_jfn] = 0;	! Zero it
		    END;

		disp_flags [dsp$k_injfn] = 0;
		RETURN false;
		END;

	    [ss$_reparse] :
		BEGIN

		IF .infab [fab$h_jfn] NEQ 0	! Release JFN if needed
		THEN
		    BEGIN
		    rljfn (.infab [fab$h_jfn]);	! Release it
		    infab [fab$h_jfn] = 0;	! Zero it
		    END;

		disp_flags [dsp$k_injfn] = 0;
		RETURN true;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    ENABLE
	li_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN

	LOCAL
	    comnd_error,			! Status returned by COMAND
	    start_state;			! State to start/restart parse

	setup_stateblock ();			! Initialize the state block
	stateblock [$cmgjb] = injfn;		! Point to GTJFN block
	cmdrpt = 2;				! Reparse after .CMINI
	cmderr = true;				! Handle our own errors
	start_state = 0;			! Start here normally
	stateblock [$cmrty] = $stptr ('Input file: ');	! Set prompt

	WHILE 1 DO
	    BEGIN

	    MAP
		stateblock : monblock [];

	    comnd_error = comand (.start_state, stateblock, li_states);
						! Get the command

	    SELECTONE 1 OF
		SET

		[.stateblock [$cmflg, cm_nop]] :
		    BEGIN
		    start_state = 0;
		    SIGNAL (ss$_jsys_error_return, .comnd_error);
		    END;

		[.stateblock [$cmflg, cm_rpt]] :
		    BEGIN
		    start_state = 2;		! Set reparse state

		    IF .infab [fab$h_jfn] NEQ 0	! Release JFN if we have one
		    THEN
			BEGIN
			rljfn (.infab [fab$h_jfn]);	! Release it
			infab [fab$h_jfn] = 0;	! Zero it
			END;

		    END;

		[OTHERWISE] :
		    BEGIN
		    start_state = 0;
		    EXITLOOP;
		    END;
		TES;

	    END;

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .li_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN

	    !+
	    !   We have a JFN.  If this is an RMS record file, we
	    !   can get the output file info.  If it is COBOL,
	    !   FORTRAN, or RMS-STREAM/RMS-LSA, then we need the
	    !   user's additional info to read it.
	    !-

	    LOCAL
		file_class : monword;

	    IF NOT gtfdb (.infab [fab$h_jfn], 	! JFN
		    $xwd (1, $fbctl), 		! One word at .FBCTL
		    file_class)			! Put it here
	    THEN
		SIGNAL (ss$_jsys_error_quit, -1);	! Msg and halt

	    IF .file_class [fb_fcf] EQL $fbrms	! RMS record file?
	    THEN
		BEGIN				! RMS record file
		disp_flags [dsp$k_injfn] = 1;

		!+
		!   $OPEN the file to get the bytesize, etc.
		!-

		IF NOT $open (fab = .infab)
		THEN
		    SIGNAL (ss$_rms_error, .infab)
		ELSE
		    BEGIN
		    infab [fab$v_drj] = 1;	! Keep the JFN

		    IF NOT $close (fab = .infab)	! Close it now
		    THEN
			SIGNAL (ss$_rms_error, .infab);

		    infab [fab$v_drj] = 0;	! Toss JFN next time
		    END;

		IF l_ofile () EQL ss$_success	! Next routine OK?
		THEN
		    EXITLOOP;			! Exit and return

		disp_flags [dsp$k_injfn] = 0;
		END
	    ELSE
		BEGIN			! Foreign (non-RMS) or STM/LSA file
		disp_flags [dsp$k_injfn] = 1;

		IF file_language () EQL ss$_success	! Next routine OK?
		THEN
		    EXITLOOP;			! Exit and return

		disp_flags [dsp$k_injfn] = 0;
		END;

	    END
	ELSE
	    BEGIN
	    disp_flags [dsp$k_injfn] = 0;
	    SIGNAL (.li_status [cmdsts$g_status]);	! Parse not "success"
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End L_IFILE
ROUTINE l_ofile =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	lo_question_handler,		! Condition handler for this routine
	lo_initialize : NOVALUE,		! Called by .CMINI function
	lo_take_action : NOVALUE;		! Called by parser

    OWN
	lo_status : $cmdsts_block,		! Status from this parse
	!
	!   Parsing states and transitions
	!
	lo_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = lo_initialize, 	!
			context = lo_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMOFI
			function = $cmofi, 	!
			flags = cm_sdh, 	!
			help = 'RMS file to be created',
			context = $command_status (	!
			    status = ss$_success, 	!
			    next = 0, 		! No branching here
			    context = 0), 	!
			action = lo_take_action,
						! Do something w/ the JFN
			next = 1, 		!
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = lo_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = lo_status, 	! Status variable
				next = 1)))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE lo_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_jsys_error_return;	! Just in case
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = 0;
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE lo_take_action (jfn, b, returned_context : REF $cmdsts_block) :
	NOVALUE =
	BEGIN

	IF .outfab [fab$h_jfn] NEQ 0		! Do we already have a JFN?
	THEN
	    BEGIN
	    rljfn (.outfab [fab$h_jfn]);	! Release it
	    outfab [fab$h_jfn] = 0;		! Zero it
	    END;

	lo_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];
	outfab [fab$h_jfn] = .jfn;
	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE lo_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl : REF
	VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$_backup] :
		BEGIN
		return_value = ss$_backup;
		SETUNWIND ();
		RETURN true;
		END;

	    [ss$unw] :
		BEGIN
		disp_flags [dsp$k_outjfn] = 0;

		IF .outfab [fab$h_jfn] NEQ 0	! Release JFN if needed
		THEN
		    BEGIN
		    rljfn (.outfab [fab$h_jfn]);	! Release it
		    outfab [fab$h_jfn] = 0;	! Zero it
		    END;

		RETURN false;
		END;

	    [ss$_reparse] :
		BEGIN

		IF .outfab [fab$h_jfn] NEQ 0	! Release JFN if needed
		THEN
		    BEGIN
		    rljfn (.outfab [fab$h_jfn]);	! Release it
		    outfab [fab$h_jfn] = 0;	! Zero it
		    END;

		RETURN true;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    ENABLE
	lo_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN

	LOCAL
	    comnd_error,			! Status returned by COMAND
	    start_state;			! State to start/restart parse

	setup_stateblock ();			! Initialize the state block
	stateblock [$cmgjb] = outjfn;		! Point to GTJFN block
	cmdrpt = 2;				! Reparse after .CMINI
	cmderr = true;				! Handle our own errors
	start_state = 0;			! Start here normally
	stateblock [$cmrty] = $stptr ('Output file: ');	! Set prompt

	WHILE 1 DO
	    BEGIN

	    MAP
		stateblock : monblock [];

	    comnd_error = comand (.start_state, stateblock, lo_states);
						! Get the command

	    SELECTONE 1 OF
		SET

		[.stateblock [$cmflg, cm_nop]] :
		    BEGIN
		    start_state = 0;
		    SIGNAL (ss$_jsys_error_return, .comnd_error);
		    END;

		[.stateblock [$cmflg, cm_rpt]] :
		    BEGIN
		    start_state = 2;		! Set reparse state

		    IF .outfab [fab$h_jfn] NEQ 0	! Release JFN
		    THEN
			BEGIN
			rljfn (.outfab [fab$h_jfn]);	! Release it
			outfab [fab$h_jfn] = 0;	! Zero it
			END;

		    END;

		[OTHERWISE] :
		    BEGIN
		    start_state = 0;
		    EXITLOOP;
		    END;
		TES;

	    END;

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .lo_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN
	    disp_flags [dsp$k_outjfn] = 1;

	    IF organization () EQL ss$_success	! All OK?
	    THEN
		EXITLOOP;			! Leave and return success

	    disp_flags [dsp$k_outjfn] = 0;
	    END
	ELSE
	    BEGIN
	    disp_flags [dsp$k_outjfn] = 0;
	    SIGNAL (.lo_status [cmdsts$g_status]);	! Parse not "success"
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End L_OFILE
ROUTINE organization =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	org_question_handler,		! Condition handler for this routine
	org_initialize : NOVALUE,		! Called by .CMINI function
	org_take_action : NOVALUE;		! Called by parser

    OWN
	org_status : $cmdsts_block,		! Status from this parse
	!
	!   Keyword table
	!
	org_kwords : $comand_key (		!
		$comand_option (		!
		    opt = 'Indexed', 		!
		    action = org_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			next = 0, 		!
			context = fab$k_idx), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'Relative', 		!
		    action = org_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			next = 0, 		!
			context = fab$k_rel), 	!
		    next = 1),
		$comand_option (		!
		    opt = 'Sequential', 	!
		    action = org_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			next = 0, 		!
			context = fab$k_seq), 	!
		    next = 1)),
	!
	!   Parsing states and transitions
	!
	org_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = org_initialize, 	!
			context = org_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMKEY
			function = $cmkey, 	!
			data = org_kwords, 	! Load, Reorg, or Unload
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = org_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = org_status, 	! Status variable
				next = 1, more = 	!
				$comand_flddb (	! CRLF for default
				    function = $cmcfm, 	!
				    flags = cm_sdh, 	! Suppress help
				    help = 'Return for default', 	!
				    action = org_take_action, 	!
				    context = $command_status (	!
					status = ss$_success, 	!
					next = 0, 	!
					context = fab$k_idx), 	!
				    next = -1))))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE org_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_success;
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = fab$k_idx;
	cmderp = $stptr (
	    'That is not a valid RMS file organization.  Please enter one',
	    $crlf, 				!
	    ' of the following organizations:', $crlf, 	!
	    '	Indexed		Relative	Sequential', $crlf);
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE org_take_action (a, b, returned_context : REF $cmdsts_block) :
	NOVALUE =
	BEGIN
	org_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];
	org_status [cmdsts$a_next_routine] = .returned_context [
	    cmdsts$a_next_routine];
	org_status [cmdsts$g_context] = .returned_context [cmdsts$g_context];
	cmderp = $stptr ('Your answer was not followed by a carriage return');
	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE org_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl :
	REF VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$_backup] :
		BEGIN
		return_value = ss$_backup;
		SETUNWIND ();
		RETURN true;
		END;

	    [ss$unw] :
		BEGIN
		disp_flags [dsp$k_org] = 0;
		RETURN false;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    ENABLE
	org_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN
	setup_stateblock ();			! Initialize the state block
	cmderr = 0;				! Handle errors for us
	cmdrpt = 2;			! Reparse from state after .CMINI
	stateblock [$cmrty] = $stptr ('File organization [Indexed]: ');
						! Set prompt
	comand (0, stateblock, org_states);	! Get the command

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .org_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN
	    disp_flags [dsp$k_org] = 1;
	    outfab [fab$v_org] = .org_status [cmdsts$g_context];
						! Set organization

	    !+
	    !   Call the next routine below us.  If the
	    !   return is successful, then we can exit the
	    !   loop and work our way back to the top of
	    !   the stack of calls.  If the return is not
	    !   successful, it is a request for backing up,
	    !   and we stay in the loop.
	    !-

	    IF format () EQL ss$_success	! All OK?
	    THEN
		EXITLOOP;			! The only way out

	    disp_flags [dsp$k_org] = 0;
	    END
	ELSE
	    BEGIN
	    disp_flags [dsp$k_org] = 0;
	    outfab [fab$v_org] = 0;	! No organization (for DISPLAY)
	    SIGNAL (.org_status [cmdsts$g_status]);	! Parse not "success"
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					!End ORGANIZATION
ROUTINE format =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	fmt_question_handler,		! Condition handler for this routine
	fmt_initialize : NOVALUE,		! Called by .CMINI function
	fmt_take_action : NOVALUE;		! Called by parser

    OWN
	fmt_status : $cmdsts_block,		! Status from this parse
	!
	!   Keyword table
	!
	fmt_kwords : $comand_key (		!
		$comand_option (		!
		    opt = 'Fixed', 		!
		    action = fmt_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			next = 0, 		!
			context = fab$k_fix), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'Variable', 		!
		    action = fmt_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			next = 0, 		!
			context = fab$k_var), 	!
		    next = 1)),
	!
	!   Parsing states and transitions
	!
	fmt_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = fmt_initialize, 	!
			context = fmt_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMKEY
			function = $cmkey, 	!
			data = fmt_kwords, 	! Fixed or Variable
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = fmt_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = fmt_status, 	! Status variable
				next = 1, more = 	!
				$comand_flddb (	! CRLF for default
				    function = $cmcfm, 	!
				    flags = cm_sdh, 	! Suppress help
				    help = 'Return for default', 	!
				    action = fmt_take_action, 	!
				    context = $command_status (	!
					status = ss$_success, 	!
					next = 0, 	!
					context = -1), 	!
				    next = -1))))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE fmt_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_success;
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = .infab [fab$v_rfm];
	cmderp = $stptr (
	    'That is not a valid RMS record format.  Please enter either',
	    $crlf, 				!
	    ' Fixed or Variable', $crlf);
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE fmt_take_action (a, b, returned_context : REF $cmdsts_block) :
	NOVALUE =
	BEGIN
	fmt_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];
	if .returned_context [cmdsts$g_context] EQL -1	! Use data?
	then
	    fmt_status [cmdsts$g_context] = .infab [fab$v_rfm]
	else
	    fmt_status [cmdsts$g_context] = !
		.returned_context [cmdsts$g_context];
	cmderp = $stptr ('Your answer was not followed by a carriage return');
	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE fmt_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl :
	REF VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$_backup] :
		BEGIN
		return_value = ss$_backup;
		SETUNWIND ();
		RETURN true;
		END;

	    [ss$unw] :
		BEGIN
		disp_flags [dsp$k_rfm] = 0;
		RETURN false;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    ENABLE
	fmt_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN
	setup_stateblock ();			! Initialize the state block
	cmderr = 0;				! Handle errors for us
	cmdrpt = 2;			! Reparse from state after .CMINI
	!
	!   Set up the help message
	!
	control = $fao_ctl ('record format, default is !AZ-length!%^@');
	if .infab [fab$v_rfm] neq fab$k_fix	! Set default type
	then
	    fprm [0] = $stptr ('Variable')
	else
	    fprm [0] = $stptr ('Fixed');
	$faol (ctrstr = .control, prmlst = fprm, outbuf = hlpdsc);
	!
	!   Reuse some of the help data in the prompt.
	!
	control = $fao_ctl ('Record format [!AZ]: !%^@');
	$faol (ctrstr = .control, prmlst = fprm, outbuf = rtydsc);
	stateblock [$cmrty] = CH$PTR (rtybuf);	! Set prompt
	comand (0, stateblock, fmt_states);	! Get the command

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .fmt_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN
	    disp_flags [dsp$k_rfm] = 1;
	    outfab [fab$v_rfm] = .fmt_status [cmdsts$g_context];
						! Set organization

	    !+
	    !   Call the next routine below us.  If the
	    !   return is successful, then we can exit the
	    !   loop and work our way back to the top of
	    !   the stack of calls.  If the return is not
	    !   successful, it is a request for backing up,
	    !   and we stay in the loop.
	    !-

	    IF bytesize () EQL ss$_success	! All OK?
	    THEN
		EXITLOOP;			! The only way out

	    disp_flags [dsp$k_rfm] = 0;
	    END
	ELSE
	    BEGIN
	    disp_flags [dsp$k_rfm] = 0;
	    outfab [fab$v_rfm] = 0;		! No format
	    SIGNAL (.fmt_status [cmdsts$g_status]);	! Parse not "success"
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End FORMAT
ROUTINE bytesize =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	bsz_question_handler,		! Condition handler for this routine
	bsz_initialize : NOVALUE,		! Called by .CMINI function
	bsz_take_action : NOVALUE;		! Called by parser

    OWN
	bsz_status : $cmdsts_block,		! Status from this parse
	!
	!   Parsing states and transitions
	!
	bsz_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = bsz_initialize, 	!
			context = bsz_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMNUM
			function = $cmnum, 	!
			flags = cm_sdh, 	!
			help = 'bytesize from 1 to 36', 	!
			data = 10, 		! Key number in decimal
			context = $command_status (	!
			    status = ss$_success, 	!
			    next = 0, 		! No branching here
			    context = -1), 	! Special instructions
			action = bsz_take_action,
						! Do something w/ the JFN
			next = 1, 		!
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = bsz_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = bsz_status, 	! Status variable
				next = 1, 	!
				more = 		!
				$comand_flddb (	! Default to 0
				    function = $cmcfm, 	!
				    action = bsz_take_action, 	!
				    flags = cm_sdh, 	!
				    help = 'Return for default',
				    context = $command_status (	!
					status = ss$_success, 	!
					next = 0, 	!
					context = 0), 	!
				    next = -1))))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE bsz_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_success;	! Just in case
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = 0;
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE bsz_take_action (bits_per_byte, b, returned_context : REF
	$cmdsts_block) : NOVALUE =
	BEGIN
	bsz_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];

	IF .returned_context [cmdsts$g_context] EQL -1	! Use data?
	THEN
	    outfab [fab$v_bsz] = .bits_per_byte
	ELSE
	    outfab [fab$v_bsz] = .infab [fab$v_bsz];

	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE bsz_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl :
	REF VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$_backup] :
		BEGIN
		return_value = ss$_backup;
		SETUNWIND ();
		RETURN true;
		END;

	    [ss$unw] :
		BEGIN
		disp_flags [dsp$k_bsz] = 0;
		outfab [fab$v_bsz] = 0;
		RETURN false;
		END;

	    [ss$_reparse] :
		BEGIN
		RETURN true;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    ENABLE
	bsz_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN

	LOCAL
	    comnd_error,			! Status returned by COMAND
	    start_state;			! State to start/restart parse

	setup_stateblock ();			! Initialize the state block
	cmderp = 0;				! No special error message
	cmdrpt = 2;				! Reparse after .CMINI
	!
	!   Set up the help message
	!
	control = $fao_ctl ('number of bits per byte, default is !UL!%^@');
	fprm [0] = .infab [fab$v_bsz];
	$faol (ctrstr = .control, prmlst = fprm, outbuf = hlpdsc);
	!
	!   Reuse some of the help data in the prompt.
	!
	control = $fao_ctl ('Bytesize [!UL]: !%^@');
	$faol (ctrstr = .control, prmlst = fprm, outbuf = rtydsc);
	stateblock [$cmrty] = CH$PTR (rtybuf);
	comand (0, stateblock, bsz_states);	! Get the command

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .bsz_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN

	    !+
	    !   Make sure the value returned is within range
	    !-

	    IF .outfab [fab$v_bsz] LSS 1 OR .outfab [fab$v_bsz] GTR 36	!
	    THEN
		BEGIN
		SIGNAL (ss$_out_of_range, 1, 36);
		END
	    ELSE
		BEGIN

		!+
		!   Call the next routine below us.  If the
		!   return is successful, then we can exit the
		!   loop and work our way back to the top of
		!   the stack of calls.  If the return is not
		!   successful, it is a request for backing up,
		!   and we stay in the loop.
		!-

		disp_flags [dsp$k_bsz] = 1;

		IF recordsize () EQL ss$_success	! All OK?
		THEN
		    EXITLOOP;			! The only way out

		END

	    END
	ELSE
	    BEGIN
	    disp_flags [dsp$k_bsz] = 0;
	    outfab [fab$v_bsz] = 0;		! Zero it
	    SIGNAL (.bsz_status [cmdsts$g_status]);	! Parse not "success"
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End BYTESIZE
ROUTINE recordsize =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	mrs_question_handler,		! Condition handler for this routine
	mrs_initialize : NOVALUE,		! Called by .CMINI function
	mrs_take_action : NOVALUE;		! Called by parser

    OWN
	mrs_status : $cmdsts_block,		! Status from this parse
	!
	!   Parsing states and transitions
	!
	mrs_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = mrs_initialize, 	!
			context = mrs_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMNUM
			function = $cmnum, 	!
			flags = cm_sdh, 	!
			help = 'record length in bytes', 	!
			data = 10, 		! Key number in decimal
			context = $command_status (	!
			    status = ss$_success, 	!
			    next = 0, 		! No branching here
			    context = -1), 	! Special instructions
			action = mrs_take_action,
						! Do something w/ the JFN
			next = 1, 		!
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = mrs_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = mrs_status, 	! Status variable
				next = 1)))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE mrs_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_success;	! Just in case
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = 0;
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE mrs_take_action (recsiz, b, returned_context : REF $cmdsts_block) :
	NOVALUE =
	BEGIN
	mrs_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];
	outfab [fab$h_mrs] = .recsiz;
	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE mrs_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl :
	REF VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$_backup] :
		BEGIN
		return_value = ss$_backup;
		SETUNWIND ();
		RETURN true;
		END;

	    [ss$unw] :
		BEGIN
		disp_flags [dsp$k_mrs] = 0;
		outfab [fab$h_mrs] = 0;
		outfab [fab$v_bks] = 0;
		RETURN false;
		END;

	    [ss$_reparse] :
		BEGIN
		RETURN true;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    ENABLE
	mrs_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN

	LOCAL
	    comnd_error,			! Status returned by COMAND
	    start_state;			! State to start/restart parse

	setup_stateblock ();			! Initialize the state block
	cmderp = 0;				! No special error message
	cmdrpt = 2;				! Reparse after .CMINI

	IF .outfab [fab$v_rfm] EQL fab$k_fix	! Fixed format?
	THEN
	    stateblock [$cmrty] = $stptr ('Record length: ')
	ELSE
	    BEGIN

	    SELECTONE .outfab [fab$v_org] OF
		SET

		[fab$k_idx] :
		    stateblock [$cmrty] = $stptr (
			'Expected maximum record length: ');

		[fab$k_rel] :
		    stateblock [$cmrty] = $stptr ('Maximum record length: ');

		[fab$k_seq] :
		    stateblock [$cmrty] = $stptr ('Maximum record length or 0: '
		    );
		TES;

	    END;				! Set prompt

	comand (0, stateblock, mrs_states);	! Get the command

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .mrs_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN
	    !
	    !   Default bucketsize for the file is 1
	    !
	    outfab [fab$v_bks] = 1;

	    !+
	    !   For indexed files, calculate the primary
	    !   data bucket-size based on the length
	    !   of the data records.  The buckets must be large
	    !   enough to contain MINIMUM_RECORDS_PER_BUCKET
	    !   records, or 7 pages long, whichever is less.
	    !-

	    IF .outfab [fab$v_org] EQL fab$k_idx	! IDX only
	    THEN
		BEGIN

		LOCAL
		    bytes_per_word,
		    words_per_record,
		    records_per_bucket;

		!
		!   Figure number of user's bytes in a word
		!
		bytes_per_word = %BPVAL/.outfab [fab$v_bsz];
		!
		!   Now number of words in this record
		!
		words_per_record = 		!
		(.outfab [fab$h_mrs] + .bytes_per_word - 1)/.bytes_per_word;
						!
		!   Add in the length of the record header: fix=2, var=3.
		!

		IF .outfab [fab$v_rfm] EQL fab$k_fix	! Fixed headers?
		THEN
		    words_per_record = .words_per_record + 2
		ELSE
		    words_per_record = .words_per_record + 3;

		!
		!   Find a bucket big enough to hold several records.
		!
		databucket_size = (minimum_records_per_bucket*	!
		.words_per_record + 3)/%O'1000' + 1;

		IF .databucket_size GTR 7	! Not enough room
		THEN
		    SIGNAL (ss$_record_too_large)
		ELSE
		    BEGIN

		    !+
		    !   Call the next routine below us.  If the
		    !   return is successful, then we can exit the
		    !   loop and work our way back to the top of
		    !   the stack of calls.  If the return is not
		    !   successful, it is a request for backing up,
		    !   and we stay in the loop.
		    !-

		    disp_flags [dsp$k_mrs] = 1;

		    IF primary_key () EQL ss$_success	!
		    THEN
			EXITLOOP;

		    disp_flags [dsp$k_mrs] = 0;
		    END;

		END
	    ELSE
		BEGIN

		!+
		!   Call the next routine below us.  If the
		!   return is successful, then we can exit the
		!   loop and work our way back to the top of
		!   the stack of calls.  If the return is not
		!   successful, it is a request for backing up,
		!   and we stay in the loop.
		!-

		disp_flags [dsp$k_mrs] = 1;

		IF spanned_records () EQL ss$_success	!
		THEN
		    EXITLOOP;

		disp_flags [dsp$k_mrs] = 0;
		END;

	    END
	ELSE
	    BEGIN
	    disp_flags [dsp$k_mrs] = 0;
	    outfab [fab$h_mrs] = 0;		! Zero it
	    SIGNAL (.mrs_status [cmdsts$g_status]);	! Parse not "success"
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End RECORDSIZE
ROUTINE file_language =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	fl_question_handler,		! Condition handler for this routine
	fl_initialize : NOVALUE,		! Called by .CMINI function
	fl_take_action : NOVALUE;		! Called by parser

    OWN
	fl_status : $cmdsts_block,		! Status from this parse
	!
	!   Keyword table
	!
	fl_kwords : $comand_key (		!
		$comand_option (		!
		    opt = 'ASCII', 		!
		    action = fl_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			next = l_ofile, 	!
			context = 0), 		!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'Fixed-EBCDIC', 	!
		    action = fl_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			next = ebc_rsz, 	!
			context = typ$k_ebcdic), 	!
		    next = 1),
		$comand_option (		!
		    opt = 'FORTRAN-Binary', 	!
		    action = fl_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			next = l_ofile, 	!
			context = typ$k_fortran_binary), 	!
		    next = 1),
		$comand_option (		!
		    opt = 'LIBOL-ISAM', 	!
		    action = fl_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			next = isam_bsz, 	!
			context = typ$k_isam), 	!
		    next = 1),
		$comand_option (		!
		    opt = 'SIXBIT', 		!
		    action = fl_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			next = l_ofile, 	!
			context = typ$k_sixbit), 	!
		    next = 1),
		$comand_option (		!
		    opt = 'Variable-EBCDIC', 	!
		    action = fl_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			next = blocking_factor, 	!
			context = typ$k_ebcdic), 	!
		    next = 1)),
	!
	!   Parsing states and transitions
	!
	fl_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = fl_initialize, 	!
			context = fl_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMKEY
			function = $cmkey, 	!
			data = fl_kwords, 	! Load, Reorg, or Unload
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = fl_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = fl_status, 	! Status variable
				next = 1, more = 	!
				$comand_flddb (	! CRLF for default
				    function = $cmcfm, 	!
				    flags = cm_sdh, 	! Suppress help
				    help = 'Return for default', 	!
				    action = fl_take_action, 	!
				    context = $command_status (	!
					status = ss$_success, 	!
					next = l_ofile, 	!
					context = 0),           ! ASCII
				    next = -1))))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE fl_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_success;
	info [cmdsts$a_next_routine] = l_ofile;
	info [cmdsts$g_context] = 0;		! Default to ASCII
	control = $fao_ctl (
	    'RMS does not know about that file type.  Please choose one!/',
						!
	    ' of the following file types:!/', 	!
	    '!_!16<ASCII!> -- normal TOPS-20 text files!/',
	    '!_!16<Fixed EBCDIC!> -- COBOL''s "RECORDING MODE IS F"!/',
	    '!_!16<FORTRAN Binary!> -- written WITH "MODE = ''BINARY''"!/',
	    '!_!16<LIBOL ISAM!> -- COBOL''s old-style ISAM!/',
	    '!_!16<SIXBIT!> -- COBOL''s "RECORDING MODE IS SIXBIT"!/',
	    '!_!16<Variable EBCDIC!> -- COBOL''s "RECORDING MODE IS V"!/!%^@');
	$faol (ctrstr = .control, prmlst = 0, outbuf = errdsc);
	cmderp = CH$PTR (errbuf);
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE fl_take_action (a, b, returned_context : REF $cmdsts_block) :
	NOVALUE =
	BEGIN
	fl_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];
	fl_status [cmdsts$a_next_routine] = .returned_context [
	    cmdsts$a_next_routine];
	fl_status [cmdsts$g_context] = .returned_context [cmdsts$g_context];
	cmderp = $stptr ('Your answer was not followed by a carriage return');
	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE fl_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl : REF
	VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$unw] :
		BEGIN
		disp_flags [dsp$k_class] = 0;
		intyp [typ$h_class] = 0;
		RETURN false;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    ENABLE
	fl_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN
	setup_stateblock ();			! Initialize the state block
	cmderr = 0;				! Handle errors for us
	cmdrpt = 2;			! Reparse from state after .CMINI
	stateblock [$cmrty] = $stptr ('File type [ASCII]: ');	! Set prompt
	comand (0, stateblock, fl_states);	! Get the command

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .fl_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN

	    BIND ROUTINE
		routine_to_call = .fl_status [cmdsts$a_next_routine];

	    !
	    !	Set the file class
	    !
	    intyp [typ$h_class] = .fl_status [cmdsts$g_context];
	    disp_flags [dsp$k_class] = 1;

	    !+
	    !	Do any individual processing
	    !-

	    SELECTONE .fl_status [cmdsts$g_context] OF
		SET

		[typ$k_sixbit] : 		! COBOL SIXBIT
		    BEGIN
		    infab [fab$v_bsz] = 6;
		    END;

		[typ$k_ebcdic] : 		! COBOL EBCDIC
		    BEGIN
		    !
		    !	Default to variable format.  If the format
		    !	is really fixed, EBC_RSZ will be called,
		    !	and the format will be set to FIX there.
		    !	Likewise, blocking will be set later
		    !
		    infab [fab$v_rfm] = fab$k_var;
		    infab [fab$v_bsz] = 9;
		    infab [fab$v_bls] = 0;
		    END;

		[typ$k_isam] : 			! LIBOL ISAM
		    BEGIN

		    !+
                    ! Have already gotten byte size.  Bogosity to
                    ! fake out ASCII label below. 
		    !-
                    infab [fab$v_bsz] = 0;
		    END;

		[typ$k_fortran_binary] : 	! FORTRAN BINARY
		    BEGIN
		    infab [fab$v_bsz] = 36;
		    END;

		[0] : 				! ASCII
		    BEGIN
		    infab [fab$v_bsz] = 7;
		    END;
		TES;

	    !+
	    !   Call the next routine below us.  If the
	    !   return is successful, then we can exit the
	    !   loop and work our way back to the top of
	    !   the stack of calls.  If the return is not
	    !   successful, it is a request for backing up,
	    !   and we stay in the loop.
	    !-

	    IF routine_to_call () EQL ss$_success	! All OK?
	    THEN
		EXITLOOP;			! The only way out

	    END
	ELSE
	    BEGIN
	    disp_flags [dsp$k_class] = 0;
	    SIGNAL (.fl_status [cmdsts$g_status]);	! Parse not "success"
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End FILE_LANGUAGE
ROUTINE isam_bsz =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	isbsz_question_handler,		! Condition handler for this routine
	isbsz_initialize : NOVALUE,		! Called by .CMINI function
	isbsz_take_action : NOVALUE;		! Called by parser

    OWN
	isbsz_status : $cmdsts_block,		! Status from this parse
	!
	!   Parsing states and transitions
	!
	isbsz_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = isbsz_initialize, 	!
			context = isbsz_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMNUM
			function = $cmnum, 	!
			flags = cm_sdh, 	!
			help = 'bytesize from 1 to 36', 	!
			data = 10, 		! Key number in decimal
			context = $command_status (	!
			    status = ss$_success, 	!
			    next = 0, 		! No branching here
			    context = -1), 	! Special instructions
			action = isbsz_take_action,
						! Do something w/ the JFN
			next = 1, 		!
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = isbsz_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = isbsz_status,	! Status variable
				next = 1, 	!
				more = 		!
				$comand_flddb (	! Default to 0
				    function = $cmcfm, 	!
				    action = isbsz_take_action, 	!
				    flags = cm_sdh, 	!
				    help = 'Return for default',
				    context = $command_status (	!
					status = ss$_success, 	!
					next = 0, 	!
					context = 0), 	!
				    next = -1))))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE isbsz_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_success;	! Just in case
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = 0;
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE isbsz_take_action (bits_per_byte, b, returned_context : REF
	$cmdsts_block) : NOVALUE =
	BEGIN
	isbsz_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];
        infab [fab$v_bsz] = .bits_per_byte;
	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE isbsz_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl :
	REF VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$_backup] :
		BEGIN
		return_value = ss$_backup;
		SETUNWIND ();
		RETURN true;
		END;

	    [ss$unw] :
		BEGIN
		disp_flags [dsp$k_bsz] = 0;
		infab [fab$v_bsz] = 0;
		RETURN false;
		END;

	    [ss$_reparse] :
		BEGIN
		RETURN true;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    ENABLE
	isbsz_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN

	LOCAL
	    comnd_error,			! Status returned by COMAND
	    start_state;			! State to start/restart parse

	setup_stateblock ();			! Initialize the state block
	cmderp = 0;				! No special error message
	cmdrpt = 2;				! Reparse after .CMINI
	!
	!   Set up the help message
	!
	control = $fao_ctl ('number of bits per byte !%^@');
        fprm[0] = 0;
	$faol (ctrstr = .control, prmlst = fprm , outbuf = hlpdsc);
	!
	!   Reuse some of the help data in the prompt.
	!
	control = $fao_ctl ('Bytesize : !%^@');
        fprm[0] = 0;
	$faol (ctrstr = .control, prmlst = fprm , outbuf = rtydsc);
	stateblock [$cmrty] = CH$PTR (rtybuf);
	comand (0, stateblock, isbsz_states);	! Get the command

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .isbsz_status [cmdsts$g_status] EQL ss$_success ! Everything OK?
	THEN
	    BEGIN

	    !+
	    !   Make sure the value returned is within range
	    !-

	    IF .infab [fab$v_bsz] LSS 1 OR .infab [fab$v_bsz] GTR 36	!
	    THEN
		BEGIN
		SIGNAL (ss$_out_of_range, 1, 36);
		END
	    ELSE
		BEGIN

		!+
		!   Call the next routine below us.  If the
		!   return is successful, then we can exit the
		!   loop and work our way back to the top of
		!   the stack of calls.  If the return is not
		!   successful, it is a request for backing up,
		!   and we stay in the loop.
		!-

!!asp		disp_flags [dsp$k_bsz] = 1;

		IF l_ofile () EQL ss$_success	! All OK?
		THEN
		    EXITLOOP;			! The only way out

		END

	    END
	ELSE
	    BEGIN
!!asp	    disp_flags [dsp$k_bsz] = 0;
	    infab [fab$v_bsz] = 0;		! Zero it
	    SIGNAL (.isbsz_status [cmdsts$g_status]);	! Parse not "success"
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End ISAM_BSZ
ROUTINE ebc_rsz =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	er_question_handler,		! Condition handler for this routine
	er_initialize : NOVALUE,		! Called by .CMINI function
	er_take_action : NOVALUE;		! Called by parser

    OWN
	er_status : $cmdsts_block,		! Status from this parse
	!
	!   Parsing states and transitions
	!
	er_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = er_initialize, 	!
			context = er_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMNUM
			function = $cmnum, 	!
			flags = cm_sdh, 	!
			help = 'record length in bytes', 	!
			data = 10, 		! Key number in decimal
			context = $command_status (	!
			    status = ss$_success, 	!
			    next = 0, 		! No branching here
			    context = -1), 	! Special instructions
			action = er_take_action,
						! Do something w/ the JFN
			next = 1, 		!
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = er_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = er_status, 	! Status variable
				next = 1)))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE er_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_success;	! Just in case
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = 0;
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE er_take_action (recsiz, b, returned_context : REF $cmdsts_block) :
	NOVALUE =
	BEGIN
	er_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];
	infab [fab$h_mrs] = .recsiz;
	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE er_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl : REF
	VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$_backup] :
		BEGIN
		return_value = ss$_backup;
		SETUNWIND ();
		RETURN true;
		END;

	    [ss$unw] :
		BEGIN
		infab [fab$h_mrs] = 0;
		RETURN false;
		END;

	    [ss$_reparse] :
		BEGIN
		RETURN true;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    ENABLE
	er_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN

	LOCAL
	    comnd_error,			! Status returned by COMAND
	    start_state;			! State to start/restart parse

	!
	!   If we got here, then the file format must be fixed.
	!
	infab [fab$v_rfm] = fab$k_fix;		! Fixed record format
	setup_stateblock ();			! Initialize the state block
	cmderp = 0;				! No special error message
	cmdrpt = 2;				! Reparse after .CMINI
	stateblock [$cmrty] = $stptr ('Record length: ');
	comand (0, stateblock, er_states);	! Get the command

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .er_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN

	    !+
	    !   Call the next routine below us.  If the
	    !   return is successful, then we can exit the
	    !   loop and work our way back to the top of
	    !   the stack of calls.  If the return is not
	    !   successful, it is a request for backing up,
	    !   and we stay in the loop.
	    !-

	    IF blocking_factor () EQL ss$_success	!
	    THEN
		EXITLOOP;

	    END
	ELSE
	    BEGIN
	    infab [fab$v_rfm] = fab$k_var;	! Reset record format
	    infab [fab$h_mrs] = 0;		! Zero it
	    SIGNAL (.er_status [cmdsts$g_status]);	! Parse not "success"
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End EBC_RSZ
ROUTINE blocking_factor =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	bf_question_handler,		! Condition handler for this routine
	bf_initialize : NOVALUE,		! Called by .CMINI function
	bf_take_action : NOVALUE;		! Called by parser

    OWN
	bf_status : $cmdsts_block,		! Status from this parse
	!
	!   Parsing states and transitions
	!
	bf_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = bf_initialize, 	!
			context = bf_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMNUM
			function = $cmnum, 	!
			flags = cm_sdh, 	!
			help = 'number of records in block (0 = unblocked)',
						!
			data = 10, 		! Key number in decimal
			context = $command_status (	!
			    status = ss$_success, 	!
			    next = 0, 		! No branching here
			    context = -1), 	! Special instructions
			action = bf_take_action,
						! Do something w/ the JFN
			next = 1, 		!
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = bf_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = bf_status, 	! Status variable
				next = 1)))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE bf_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_success;	! Just in case
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = 0;
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE bf_take_action (blkfac, b, returned_context : REF $cmdsts_block) :
	NOVALUE =
	BEGIN
	bf_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];
	infab [fab$v_bls] = .blkfac;
	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE bf_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl : REF
	VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$_backup] :
		BEGIN
		return_value = ss$_backup;
		SETUNWIND ();
		RETURN true;
		END;

	    [ss$unw] :
		BEGIN
		infab [fab$v_bls] = 0;
		RETURN false;
		END;

	    [ss$_reparse] :
		BEGIN
		RETURN true;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    ENABLE
	bf_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN

	LOCAL
	    comnd_error,			! Status returned by COMAND
	    start_state;			! State to start/restart parse

	setup_stateblock ();			! Initialize the state block
	cmderp = 0;				! No special error message
	cmdrpt = 2;				! Reparse after .CMINI
	stateblock [$cmrty] = $stptr ('Blocking factor: ');
	comand (0, stateblock, bf_states);	! Get the command

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .bf_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN

	    !+
	    !   Call the next routine below us.  If the
	    !   return is successful, then we can exit the
	    !   loop and work our way back to the top of
	    !   the stack of calls.  If the return is not
	    !   successful, it is a request for backing up,
	    !   and we stay in the loop.
	    !-

	    IF l_ofile () EQL ss$_success	!
	    THEN
		EXITLOOP;

	    END
	ELSE
	    BEGIN
	    infab [fab$v_bls] = 0;		! Zero it
	    SIGNAL (.bf_status [cmdsts$g_status]);	! Parse not "success"
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End BLOCKING_FACTOR
ROUTINE primary_key =
    BEGIN

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE pkey_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl :
	REF VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$_backup] :
		BEGIN
		return_value = ss$_backup;
		SETUNWIND ();
		RETURN true;
		END;

	    [ss$unw] :
		BEGIN

		BIND
		    newkey = .enbl [1] : REF $xabkey_decl,
		    newarea = .enbl [2] : REF $xaball_decl;

		!
		!   Zero the pointer in the FAB
		!
		outfab [fab$a_xab] = 0;
		!
		!   Free the allocated Key XAB, if necessary
		!

		IF .newkey NEQ 0		!
		THEN
		    BEGIN
		    fremem (.newkey, xab$k_keylen);
		    newkey = 0;
		    END;

		!
		!   Free the allocated Area XAB, if necessary
		!

		IF .newarea NEQ 0		!
		THEN
		    BEGIN
		    fremem (.newarea, xab$k_alllen);
		    newarea = 0;
		    END;

		RETURN false;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    LOCAL
	newarea : REF $xaball_decl VOLATILE,
	newkey : REF $xabkey_decl VOLATILE;

    ENABLE
	pkey_question_handler (newkey, newarea);	! Enable our handler

    newkey = getmem (xab$k_keylen);
    $xabkey_init (xab = .newkey, 		!
	kref = 0, 				!
	dfl = (.databucket_size*%O'1000' - 3), 	!
	ifl = (%O'1000' - 3));

    IF .databucket_size GTR 1			! Do UDRs need separate area?
    THEN
	BEGIN
	newarea = getmem (xab$k_alllen);
	$xaball_init (xab = .newarea, aid = 1, bkz = .databucket_size);
	newkey [xab$b_dan] = 1;
	outfab [fab$a_xab] = .newarea;
	newarea [xab$a_nxt] = .newkey;
	END
    ELSE
	BEGIN
	newarea = 0;
	newkey [xab$b_dan] = 0;
	outfab [fab$a_xab] = .newkey;
	END;

    SELECTONE .outfab [fab$v_bsz] OF
	SET

	[6] :
	    BEGIN
	    newkey [xab$v_dtp] = xab$k_six;
	    RETURN key_6 (.newkey);
	    END;

	[7] :
	    BEGIN
	    newkey [xab$v_dtp] = xab$k_stg;
	    RETURN key_7 (.newkey);
	    END;

	[9] :
	    BEGIN
	    newkey [xab$v_dtp] = xab$k_ebc;
	    RETURN key_9 (.newkey);
	    END;

	[OTHERWISE] :
	    BEGIN
	    newkey [xab$v_dtp] = xab$k_in4;
	    RETURN key_36 (.newkey);
	    END;
	TES;

    END;					! End PRIMARY_KEY
ROUTINE key_6 (key_xab : REF $xabkey_decl) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	k6_question_handler,		! Condition handler for this routine
	k6_initialize : NOVALUE,		! Called by .CMINI function
	k6_take_action : NOVALUE;		! Called by parser

    OWN
	k6_status : $cmdsts_block,		! Status from this parse
	!
	!   Keyword table
	!
	k6_kwords : $comand_key (		!
		$comand_option (		!
		    opt = 'Double-Floating', 	!
		    action = k6_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_fl2), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'Floating', 		!
		    action = k6_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_fl1), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'G-Floating', 	!
		    action = k6_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_gfl), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'One-Word-Integer', 	!
		    action = k6_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_in4), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'SIXBIT', 		!
		    action = k6_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_six), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'Two-word-integer', 	!
		    action = k6_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_in8), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'Unsigned-Integer', 	!
		    action = k6_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_uin), 	!
		    next = 1)			!
	    ),
	!
	!   Parsing states and transitions
	!
	k6_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = k6_initialize, 	!
			context = k6_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMKEY
			function = $cmkey, 	!
			data = k6_kwords, 	! Key datatype
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = k6_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = k6_status, 	! Status variable
				next = 1, more = 	!
				$comand_flddb (	! CRLF for default
				    function = $cmcfm, 	!
				    flags = cm_sdh, 	! Suppress help
				    help = 'Return for default', 	!
				    action = k6_take_action, 	!
				    context = $command_status (	!
					status = ss$_success, 	!
					context = xab$k_six), 	!
				    next = -1))))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE k6_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_success;
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = xab$k_six;
	cmderp = $stptr ('Invalid key datatype - use "?" for help');
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE k6_take_action (a, b, returned_context : REF $cmdsts_block) :
	NOVALUE =
	BEGIN
	k6_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];
	k6_status [cmdsts$g_context] = .returned_context [cmdsts$g_context];
	cmderp = $stptr ('Your answer was not followed by a carriage return');
	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE k6_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl : REF
	VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$unw] :
		BEGIN
		RETURN false;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    ENABLE
	k6_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN
	setup_stateblock ();			! Initialize the state block
	cmderr = 0;				! Handle errors for us
	cmdrpt = 2;			! Reparse from state after .CMINI
	!
	!   Set up the prompt to look impressive
	!
	key_prompt (.key_xab [xab$b_ref], $stptr ('SIXBIT'));
	stateblock [$cmrty] = CH$PTR (rtybuf);	! Set prompt
	comand (0, stateblock, k6_states);	! Get the command

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .k6_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN
	    key_xab [xab$v_dtp] = .k6_status [cmdsts$g_context];
						! Set datatype

	    !+
	    !   Call the next routine below us.  If the
	    !   return is successful, then we can exit the
	    !   loop and work our way back to the top of
	    !   the stack of calls.  If the return is not
	    !   successful, it is a request for backing up,
	    !   and we stay in the loop.
	    !-

	    IF position (.key_xab) EQL ss$_success	! All OK?
	    THEN
		EXITLOOP;			! The only way out

	    END
	ELSE
	    BEGIN
	    SIGNAL (.k6_status [cmdsts$g_status]);	! Parse not "success"
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End KEY_6
ROUTINE key_7 (key_xab : REF $xabkey_decl) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	k7_question_handler,		! Condition handler for this routine
	k7_initialize : NOVALUE,		! Called by .CMINI function
	k7_take_action : NOVALUE;		! Called by parser

    OWN
	k7_status : $cmdsts_block,		! Status from this parse
	!
	!   Keyword table
	!
	k7_kwords : $comand_key (		!
		$comand_option (		!
		    opt = 'ASCII', 		!
		    action = k7_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_stg), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'Double-Floating', 	!
		    action = k7_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_fl2), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'Floating', 		!
		    action = k7_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_fl1), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'G-Floating', 	!
		    action = k7_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_gfl), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'One-Word-Integer', 	!
		    action = k7_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_in4), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'Two-word-integer', 	!
		    action = k7_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_in8), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'Unsigned-Integer', 	!
		    action = k7_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_uin), 	!
		    next = 1)			!
	    ),
	!
	!   Parsing states and transitions
	!
	k7_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = k7_initialize, 	!
			context = k7_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMKEY
			function = $cmkey, 	!
			data = k7_kwords, 	! Key datatype
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = k7_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = k7_status, 	! Status variable
				next = 1, more = 	!
				$comand_flddb (	! CRLF for default
				    function = $cmcfm, 	!
				    flags = cm_sdh, 	! Suppress help
				    help = 'Return for default', 	!
				    action = k7_take_action, 	!
				    context = $command_status (	!
					status = ss$_success, 	!
					context = xab$k_stg), 	!
				    next = -1))))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE k7_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_success;
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = xab$k_stg;
	cmderp = $stptr ('Invalid key datatype - use "?" for help');
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE k7_take_action (a, b, returned_context : REF $cmdsts_block) :
	NOVALUE =
	BEGIN
	k7_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];
	k7_status [cmdsts$g_context] = .returned_context [cmdsts$g_context];
	cmderp = $stptr ('Your answer was not followed by a carriage return');
	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE k7_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl : REF
	VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$unw] :
		BEGIN
		RETURN false;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    ENABLE
	k7_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN
	setup_stateblock ();			! Initialize the state block
	cmderr = 0;				! Handle errors for us
	cmdrpt = 2;			! Reparse from state after .CMINI
	!
	!   Set up the prompt to look impressive
	!
	key_prompt (.key_xab [xab$b_ref], $stptr ('ASCII'));
	stateblock [$cmrty] = CH$PTR (rtybuf);	! Set prompt
	comand (0, stateblock, k7_states);	! Get the command

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .k7_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN
	    key_xab [xab$v_dtp] = .k7_status [cmdsts$g_context];
						! Set datatype

	    !+
	    !   Call the next routine below us.  If the
	    !   return is successful, then we can exit the
	    !   loop and work our way back to the top of
	    !   the stack of calls.  If the return is not
	    !   successful, it is a request for backing up,
	    !   and we stay in the loop.
	    !-

	    IF position (.key_xab) EQL ss$_success	! All OK?
	    THEN
		EXITLOOP;			! The only way out

	    END
	ELSE
	    BEGIN
	    SIGNAL (.k7_status [cmdsts$g_status]);	! Parse not "success"
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End KEY_7
ROUTINE key_9 (key_xab : REF $xabkey_decl) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	k9_question_handler,		! Condition handler for this routine
	k9_initialize : NOVALUE,		! Called by .CMINI function
	k9_take_action : NOVALUE;		! Called by parser

    OWN
	k9_status : $cmdsts_block,		! Status from this parse
	!
	!   Keyword table
	!
	k9_kwords : $comand_key (		!
		$comand_option (		!
		    opt = 'Double-Floating', 	!
		    action = k9_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_fl2), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'EBCDIC', 		!
		    action = k9_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_ebc), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'Floating', 		!
		    action = k9_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_fl1), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'G-Floating', 	!
		    action = k9_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_gfl), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'One-Word-Integer', 	!
		    action = k9_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_in4), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'Packed-decimal', 	!
		    action = k9_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_pac), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'Two-word-integer', 	!
		    action = k9_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_in8), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'Unsigned-Integer', 	!
		    action = k9_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_uin), 	!
		    next = 1)			!
	    ),
	!
	!   Parsing states and transitions
	!
	k9_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = k9_initialize, 	!
			context = k9_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMKEY
			function = $cmkey, 	!
			data = k9_kwords, 	! Key datatype
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = k9_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = k9_status, 	! Status variable
				next = 1, more = 	!
				$comand_flddb (	! CRLF for default
				    function = $cmcfm, 	!
				    flags = cm_sdh, 	! Suppress help
				    help = 'Return for default', 	!
				    action = k9_take_action, 	!
				    context = $command_status (	!
					status = ss$_success, 	!
					context = xab$k_ebc), 	!
				    next = -1))))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE k9_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_success;
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = xab$k_ebc;
	cmderp = $stptr ('Invalid key datatype - use "?" for help');
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE k9_take_action (a, b, returned_context : REF $cmdsts_block) :
	NOVALUE =
	BEGIN
	k9_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];
	k9_status [cmdsts$g_context] = .returned_context [cmdsts$g_context];
	cmderp = $stptr ('Your answer was not followed by a carriage return');
	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE k9_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl : REF
	VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$unw] :
		BEGIN
		RETURN false;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    ENABLE
	k9_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN
	setup_stateblock ();			! Initialize the state block
	cmderr = 0;				! Handle errors for us
	cmdrpt = 2;			! Reparse from state after .CMINI
	!
	!   Set up the prompt to look impressive
	!
	key_prompt (.key_xab [xab$b_ref], $stptr ('EBCDIC'));
	stateblock [$cmrty] = CH$PTR (rtybuf);	! Set prompt
	comand (0, stateblock, k9_states);	! Get the command

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .k9_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN
	    key_xab [xab$v_dtp] = .k9_status [cmdsts$g_context];
						! Set datatype

	    !+
	    !   Call the next routine below us.  If the
	    !   return is successful, then we can exit the
	    !   loop and work our way back to the top of
	    !   the stack of calls.  If the return is not
	    !   successful, it is a request for backing up,
	    !   and we stay in the loop.
	    !-

	    IF position (.key_xab) EQL ss$_success	! All OK?
	    THEN
		EXITLOOP;			! The only way out

	    END
	ELSE
	    BEGIN
	    SIGNAL (.k9_status [cmdsts$g_status]);	! Parse not "success"
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End KEY_6
ROUTINE key_36 (key_xab : REF $xabkey_decl) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	k36_question_handler,		! Condition handler for this routine
	k36_initialize : NOVALUE,		! Called by .CMINI function
	k36_take_action : NOVALUE;		! Called by parser

    OWN
	k36_status : $cmdsts_block,		! Status from this parse
	!
	!   Keyword table
	!
	k36_kwords : $comand_key (		!
		$comand_option (		!
		    opt = 'Double-Floating', 	!
		    action = k36_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_fl2), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'Floating', 		!
		    action = k36_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_fl1), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'G-Floating', 	!
		    action = k36_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_gfl), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'One-Word-Integer', 	!
		    action = k36_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_in4), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'Two-word-integer', 	!
		    action = k36_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_in8), 	!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'Unsigned-Integer', 	!
		    action = k36_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			context = xab$k_uin), 	!
		    next = 1)			!
	    ),
	!
	!   Parsing states and transitions
	!
	k36_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = k36_initialize, 	!
			context = k36_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMKEY
			function = $cmkey, 	!
			data = k36_kwords, 	! Key datatype
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = k36_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = k36_status, 	! Status variable
				next = 1, more = 	!
				$comand_flddb (	! CRLF for default
				    function = $cmcfm, 	!
				    flags = cm_sdh, 	! Suppress help
				    help = 'Return for default', 	!
				    action = k36_take_action, 	!
				    context = $command_status (	!
					status = ss$_success, 	!
					context = xab$k_in4), 	!
				    next = -1))))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE k36_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_success;
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = xab$k_in4;
	cmderp = $stptr ('Invalid key datatype - use "?" for help');
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE k36_take_action (a, b, returned_context : REF $cmdsts_block) :
	NOVALUE =
	BEGIN
	k36_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];
	k36_status [cmdsts$g_context] = .returned_context [cmdsts$g_context];
	cmderp = $stptr ('Your answer was not followed by a carriage return');
	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE k36_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl :
	REF VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$unw] :
		BEGIN
		RETURN false;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    ENABLE
	k36_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN
	setup_stateblock ();			! Initialize the state block
	cmderr = 0;				! Handle errors for us
	cmdrpt = 2;			! Reparse from state after .CMINI
	!
	!   Set up the prompt to look impressive
	!
	key_prompt (.key_xab [xab$b_ref], $stptr ('One-word integer'));
	stateblock [$cmrty] = CH$PTR (rtybuf);	! Set prompt
	comand (0, stateblock, k36_states);	! Get the command

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .k36_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN
	    key_xab [xab$v_dtp] = .k36_status [cmdsts$g_context];
						! Set datatype

	    !+
	    !   Call the next routine below us.  If the
	    !   return is successful, then we can exit the
	    !   loop and work our way back to the top of
	    !   the stack of calls.  If the return is not
	    !   successful, it is a request for backing up,
	    !   and we stay in the loop.
	    !-

	    IF position (.key_xab) EQL ss$_success	! All OK?
	    THEN
		EXITLOOP;			! The only way out

	    END
	ELSE
	    BEGIN
	    SIGNAL (.k36_status [cmdsts$g_status]);	! Parse not "success"
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End KEY_36
ROUTINE key_prompt (key_of_ref, default_dtype) : NOVALUE =
    BEGIN

    IF .key_of_ref EQL 0			! Primary key
    THEN
	control = $fao_ctl ('Datatype of primary key [!AZ]: !%^@')
    ELSE
	BEGIN

	LOCAL
	    suffix_code;

	control = $fao_ctl (			!
	    'Datatype of !+!UL!AZ alternate key [!3(-)!AZ]: !%^@');
	fprm [1] = .key_of_ref;

	IF (.key_of_ref MOD 100) GTR 20		! Allow for 10th-19th
	THEN
	    suffix_code = .key_of_ref MOD 10
	ELSE
	    suffix_code = .key_of_ref;

	SELECTONE .suffix_code OF
	    SET

	    [1] :
		fprm [2] = $stptr ('st');

	    [2] :
		fprm [2] = $stptr ('nd');

	    [3] :
		fprm [2] = $stptr ('rd');

	    [OTHERWISE] :
		fprm [2] = $stptr ('th');
	    TES;

	END;

    fprm [0] = .default_dtype;
    $faol (ctrstr = .control, prmlst = fprm, outbuf = rtydsc);
    END;					! End KEY_PROMPT
ROUTINE position (key_xab : REF $xabkey_decl) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	pos_question_handler,		! Condition handler for this routine
	pos_initialize : NOVALUE,		! Called by .CMINI function
	pos_take_action : NOVALUE;		! Called by parser

    OWN
	pos_status : $cmdsts_block,		! Status from this parse
	!
	!   Parsing states and transitions
	!
	pos_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = pos_initialize, 	!
			context = pos_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMNUM
			function = $cmnum, 	!
			flags = cm_sdh, 	!
			help = CH$PTR (hlpbuf), 	!
			data = 10, 		! Key number in decimal
			context = $command_status (	!
			    status = ss$_success, 	!
			    next = 0, 		! No branching here
			    context = -1), 	! Special instructions
			action = pos_take_action,
						! Do something w/ the JFN
			next = 1, 		!
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = pos_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = pos_status, 	! Status variable
				next = 1)))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE pos_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_success;	! Just in case
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = 0;
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE pos_take_action (keypos, b, returned_context : REF $cmdsts_block) :
	NOVALUE =
	BEGIN
	pos_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];
	pos_status [cmdsts$g_context] = .keypos;
	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE pos_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl :
	REF VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$_backup] :
		BEGIN
		return_value = ss$_backup;
		SETUNWIND ();
		RETURN true;
		END;

	    [ss$unw] :
		BEGIN
		RETURN false;
		END;

	    [ss$_reparse] :
		BEGIN
		RETURN true;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    LOCAL
	high_key_position;

    ENABLE
	pos_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN

	LOCAL
	    comnd_error,			! Status returned by COMAND
	    start_state;			! State to start/restart parse

	setup_stateblock ();			! Initialize the state block
	cmderp = 0;				! No special error message
	cmdrpt = 2;				! Reparse after .CMINI
	!
	!   Set up the help message
	!
	control = $fao_ctl ('!AZposition of key (in !AZ), between 0 and !UL!%^@'
	);

	SELECTONE .key_xab [xab$v_dtp] OF
	    SET

	    [xab$k_stg, xab$k_six, xab$k_ebc, xab$k_as8, xab$k_pac] :
		BEGIN
		!
		!   Byte mode keys, all have a "starting" position
		!
		fprm [0] = $stptr ('starting ');
		fprm [1] = $stptr ('bytes');
		high_key_position = fprm [2] = .outfab [fab$h_mrs] - 1;
		END;

	    [xab$k_in4, xab$k_in8, xab$k_uin, xab$k_fl1, xab$k_fl2, xab$k_gfl] :
		BEGIN

		LOCAL
		    bytes_per_word,
		    words_per_record;

		!
		!   Word mode keys
		!

		SELECTONE .key_xab [xab$v_dtp] OF
		    SET

		    [xab$k_in4, xab$k_uin, xab$k_fl1] :
			! One-word keys do not "start"
			fprm [0] = $stptr ('');

		    [OTHERWISE] :
			! Two-word keys do "start"
			fprm [0] = $stptr ('starting ');
		    TES;

		fprm [1] = $stptr ('words');	! These are all word mode
		!
		!   Figure number of user's bytes in a word
		!
		bytes_per_word = %BPVAL/.outfab [fab$v_bsz];
		!
		!   Now number of words in this record
		!
		words_per_record = 		!
		(.outfab [fab$h_mrs] + .bytes_per_word - 1)/.bytes_per_word;
						!
		!   Set up the maximum key position
		!
		high_key_position = fprm [2] = .words_per_record - (	!
		SELECTONE .key_xab [xab$v_dtp] OF
		    SET
		    [xab$k_in4, xab$k_uin, xab$k_fl1] : 1;	! 1-word keys
		    [OTHERWISE] : 2;		! 2-word keys
		    TES);
		END;
	    TES;

	$faol (ctrstr = .control, prmlst = fprm, outbuf = hlpdsc);
	!
	!   Reuse some of the information from the
	!   last $FAOL call in the prompt.
	!
	control = $fao_ctl ('!+Position of key in !AZ (0-!UL): !%^@');
	$faol (ctrstr = .control, prmlst = fprm, outbuf = rtydsc);
	stateblock [$cmrty] = CH$PTR (rtybuf);
	comand (0, stateblock, pos_states);	! Get the command

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .pos_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN

	    IF .pos_status [cmdsts$g_context] LSS 0 OR 	!
		.pos_status [cmdsts$g_context] GTR .high_key_position	!
	    THEN
		BEGIN
		SIGNAL (ss$_out_of_range, 0, .high_key_position);
		END
	    ELSE
		BEGIN
		key_xab [xab$h_pos0] = .pos_status [cmdsts$g_context];

		!+
		!   Call the next routine below us.  If the
		!   return is successful, then we can exit the
		!   loop and work our way back to the top of
		!   the stack of calls.  If the return is not
		!   successful, it is a request for backing up,
		!   and we stay in the loop.
		!-

		SELECTONE .key_xab [xab$v_dtp] OF
		    SET

		    [xab$k_stg, xab$k_six, xab$k_ebc, xab$k_as8, xab$k_pac] :

			IF size (.key_xab) EQL ss$_success	!
			THEN
			    EXITLOOP;

		    [OTHERWISE] :

			IF setdup (.key_xab) EQL ss$_success	!
			THEN
			    EXITLOOP;

		    TES;

		END;

	    END
	ELSE
	    BEGIN
	    SIGNAL (.pos_status [cmdsts$g_status]);	! Parse not "success"
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End POSITION
ROUTINE size (key_xab : REF $xabkey_decl) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	siz_question_handler,		! Condition handler for this routine
	siz_initialize : NOVALUE,		! Called by .CMINI function
	siz_take_action : NOVALUE;		! Called by parser

    OWN
	siz_status : $cmdsts_block,		! Status from this parse
	!
	!   Parsing states and transitions
	!
	siz_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = siz_initialize, 	!
			context = siz_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMNUM
			function = $cmnum, 	!
			flags = cm_sdh, 	!
			help = CH$PTR (hlpbuf), 	!
			data = 10, 		! Key number in decimal
			context = $command_status (	!
			    status = ss$_success, 	!
			    next = 0, 		! No branching here
			    context = -1), 	! Special instructions
			action = siz_take_action,
						! Do something w/ the JFN
			next = 1, 		!
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = siz_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = siz_status, 	! Status variable
				next = 1)))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE siz_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_success;	! Just in case
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = 0;
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE siz_take_action (keysiz, b, returned_context : REF $cmdsts_block) :
	NOVALUE =
	BEGIN
	siz_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];
	siz_status [cmdsts$g_context] = .keysiz;
	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE siz_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl :
	REF VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$_backup] :
		BEGIN
		return_value = ss$_backup;
		SETUNWIND ();
		RETURN true;
		END;

	    [ss$unw] :
		BEGIN
		RETURN false;
		END;

	    [ss$_reparse] :
		BEGIN
		RETURN true;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    LOCAL
	max_key_size,
	high_key_position;

    ENABLE
	siz_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN

	LOCAL
	    comnd_error,			! Status returned by COMAND
	    start_state;			! State to start/restart parse

	setup_stateblock ();			! Initialize the state block
	cmderp = 0;				! No special error message
	cmdrpt = 2;				! Reparse after .CMINI
	!
	!   Set up the help message
	!
	control = $fao_ctl ('size of key (in bytes), between 1 and !UL!%^@');
	max_key_size = .outfab [fab$h_mrs] - .key_xab [xab$h_pos0];
	fprm [0] = max_key_size = MIN (.max_key_size, 255);	! Max key length
	$faol (ctrstr = .control, prmlst = fprm, outbuf = hlpdsc);
	!
	!   Reuse some of the help data in the prompt.
	!
	control = $fao_ctl ('Key size (1-!UL): !%^@');
	$faol (ctrstr = .control, prmlst = fprm, outbuf = rtydsc);
	comand (0, stateblock, siz_states);	! Get the command

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .siz_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN

	    IF .siz_status [cmdsts$g_context] LSS 1 OR 	!
		.siz_status [cmdsts$g_context] GTR .max_key_size	!
	    THEN
		BEGIN
		SIGNAL (ss$_out_of_range, 1, .max_key_size);
		END
	    ELSE
		BEGIN
		key_xab [xab$h_siz0] = .siz_status [cmdsts$g_context];

		!+
		!   Call the next routine below us.  If the
		!   return is successful, then we can exit the
		!   loop and work our way back to the top of
		!   the stack of calls.  If the return is not
		!   successful, it is a request for backing up,
		!   and we stay in the loop.
		!-

		IF setdup (.key_xab) EQL ss$_success	!
		THEN
		    EXITLOOP;

		END;

	    END
	ELSE
	    BEGIN
	    SIGNAL (.siz_status [cmdsts$g_status]);	! Parse not "success"
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End SIZE
ROUTINE setdup (key_xab : REF $xabkey_decl) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	dup_question_handler,		! Condition handler for this routine
	dup_initialize : NOVALUE,		! Called by .CMINI function
	dup_take_action : NOVALUE;		! Called by parser

    OWN
	dup_status : $cmdsts_block,		! Status from this parse
	!
	!   Keyword table
	!
	dup_kwords : $comand_key (		!
		$comand_option (		!
		    opt = 'No', 		!
		    action = dup_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			next = 0, 		!
			context = 0), 		!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'Yes', 		!
		    action = dup_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			next = 0, 		!
			context = 1), 		!
		    next = 1)),
	!
	!   Parsing states and transitions
	!
	dup_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = dup_initialize, 	!
			context = dup_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMKEY
			function = $cmkey, 	!
			data = dup_kwords, 	! Fixed or Variable
			flags = cm_sdh, 	! Suppress normal help
			help = 'Yes or No', 	!
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = dup_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = dup_status, 	! Status variable
				next = 1, more = 	!
				$comand_flddb (	! CRLF for default
				    function = $cmcfm, 	!
				    flags = cm_sdh, 	! Suppress help
				    help = 'Return for default', 	!
				    action = dup_take_action, 	!
				    context = $command_status (	!
					status = ss$_success, 	!
					next = 0, 	!
					context = 0), 	!
				    next = -1))))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE dup_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_success;
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = 0;
	cmderp = $stptr ('Please answer "Yes" or "No"', $crlf);
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE dup_take_action (a, b, returned_context : REF $cmdsts_block) :
	NOVALUE =
	BEGIN
	dup_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];
	dup_status [cmdsts$g_context] = .returned_context [cmdsts$g_context];
	cmderp = $stptr ('Your answer was not followed by a carriage return');
	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE dup_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl :
	REF VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$_backup] :
		BEGIN
		return_value = ss$_backup;
		SETUNWIND ();
		RETURN true;
		END;

	    [ss$unw] :
		BEGIN
		RETURN false;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    ENABLE
	dup_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN
	setup_stateblock ();			! Initialize the state block
	cmderr = 0;				! Handle errors for us
	cmdrpt = 2;			! Reparse from state after .CMINI
	stateblock [$cmrty] = $stptr ('Allow duplicate keys [No]: ');
						! Set prompt
	comand (0, stateblock, dup_states);	! Get the command

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .dup_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN
	    key_xab [xab$v_dup] = .dup_status [cmdsts$g_context];

	    !+
	    !   Call the next routine below us.  If the
	    !   return is successful, then we can exit the
	    !   loop and work our way back to the top of
	    !   the stack of calls.  If the return is not
	    !   successful, it is a request for backing up,
	    !   and we stay in the loop.
	    !-

	    IF .key_xab [xab$b_ref] EQL 0	! No changes on primary
	    THEN
		BEGIN

		IF setdfl (.key_xab) EQL ss$_success	!
		THEN
		    EXITLOOP;

		END
	    ELSE
		BEGIN

		IF setchg (.key_xab) EQL ss$_success	!
		THEN
		    EXITLOOP;

		END;

	    key_xab [xab$v_dup] = 0;		! No duplicate records
	    END
	ELSE
	    BEGIN
	    key_xab [xab$v_dup] = 0;		! No duplicate records
	    SIGNAL (.dup_status [cmdsts$g_status]);	! Parse not "success"
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End SETDUP
ROUTINE setchg (key_xab : REF $xabkey_decl) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	chg_question_handler,		! Condition handler for this routine
	chg_initialize : NOVALUE,		! Called by .CMINI function
	chg_take_action : NOVALUE;		! Called by parser

    OWN
	chg_status : $cmdsts_block,		! Status from this parse
	!
	!   Keyword table
	!
	chg_kwords : $comand_key (		!
		$comand_option (		!
		    opt = 'No', 		!
		    action = chg_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			next = 0, 		!
			context = 0), 		!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'Yes', 		!
		    action = chg_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			next = 0, 		!
			context = 1), 		!
		    next = 1)),
	!
	!   Parsing states and transitions
	!
	chg_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = chg_initialize, 	!
			context = chg_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMKEY
			function = $cmkey, 	!
			data = chg_kwords, 	! Fixed or Variable
			flags = cm_sdh, 	! Suppress normal help
			help = 'Yes or No', 	!
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = chg_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = chg_status, 	! Status variable
				next = 1, more = 	!
				$comand_flddb (	! CRLF for default
				    function = $cmcfm, 	!
				    flags = cm_sdh, 	! Suppress help
				    help = 'Return for default', 	!
				    action = chg_take_action, 	!
				    context = $command_status (	!
					status = ss$_success, 	!
					next = 0, 	!
					context = 0), 	!
				    next = -1))))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE chg_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_success;
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = 0;
	cmderp = $stptr ('Please answer "Yes" or "No"', $crlf);
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE chg_take_action (a, b, returned_context : REF $cmdsts_block) :
	NOVALUE =
	BEGIN
	chg_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];
	chg_status [cmdsts$g_context] = .returned_context [cmdsts$g_context];
	cmderp = $stptr ('Your answer was not followed by a carriage return');
	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE chg_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl :
	REF VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$_backup] :
		BEGIN
		return_value = ss$_backup;
		SETUNWIND ();
		RETURN true;
		END;

	    [ss$unw] :
		BEGIN
		RETURN false;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    ENABLE
	chg_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN
	setup_stateblock ();			! Initialize the state block
	cmderr = 0;				! Handle errors for us
	cmdrpt = 2;			! Reparse from state after .CMINI
	stateblock [$cmrty] = $stptr ('Allow key change on UPDATE [No]: ');
						! Set prompt
	comand (0, stateblock, chg_states);	! Get the command

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .chg_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN
	    key_xab [xab$v_chg] = .chg_status [cmdsts$g_context];

	    !+
	    !   Call the next routine below us.  If the
	    !   return is successful, then we can exit the
	    !   loop and work our way back to the top of
	    !   the stack of calls.  If the return is not
	    !   successful, it is a request for backing up,
	    !   and we stay in the loop.
	    !-

	    IF setdfl (.key_xab) EQL ss$_success	! All OK?
	    THEN
		EXITLOOP;			! The only way out

	    key_xab [xab$v_chg] = 0;		! No changes
	    END
	ELSE
	    BEGIN
	    key_xab [xab$v_chg] = 0;		! No changes
	    SIGNAL (.chg_status [cmdsts$g_status]);	! Parse not "success"
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End SETCHG
ROUTINE setdfl (key_xab : REF $xabkey_decl) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	dfl_question_handler,		! Condition handler for this routine
	dfl_initialize : NOVALUE,		! Called by .CMINI function
	dfl_take_action : NOVALUE;		! Called by parser

    OWN
	dfl_status : $cmdsts_block,		! Status from this parse
	!
	!   Parsing states and transitions
	!
	dfl_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = dfl_initialize, 	!
			context = dfl_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMNUM
			function = $cmnum, 	!
			flags = cm_sdh, 	!
			help = 'number from 50 to 100', 	!
			data = 10, 		! Key number in decimal
			context = $command_status (	!
			    status = ss$_success, 	!
			    next = 0, 		! No branching here
			    context = -1), 	! Special instructions
			action = dfl_take_action,
						! Do something w/ the JFN
			next = 1, 		!
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = dfl_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = dfl_status, 	! Status variable
				next = 1, 	!
				more = 		!
				$comand_flddb (	! Default to 0
				    function = $cmcfm, 	!
				    action = dfl_take_action, 	!
				    flags = cm_sdh, 	!
				    help = 'Return for default',
				    context = $command_status (	!
					status = ss$_success, 	!
					next = 0, 	!
					context = 100), 	!
				    next = -1))))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE dfl_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_success;	! Just in case
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = 0;
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE dfl_take_action (datafill, b, returned_context : REF $cmdsts_block)
	: NOVALUE =
	BEGIN
	dfl_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];

	IF .returned_context [cmdsts$g_context] EQL -1	! Use data?
	THEN
	    dfl_status [cmdsts$g_context] = .datafill
	ELSE
	    dfl_status [cmdsts$g_context] = 100;

	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE dfl_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl :
	REF VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$_backup] :
		BEGIN
		return_value = ss$_backup;
		SETUNWIND ();
		RETURN true;
		END;

	    [ss$unw] :
		BEGIN
		RETURN false;
		END;

	    [ss$_reparse] :
		BEGIN
		RETURN true;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    ENABLE
	dfl_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN

	LOCAL
	    comnd_error,			! Status returned by COMAND
	    start_state;			! State to start/restart parse

	setup_stateblock ();			! Initialize the state block
	cmderp = 0;				! No special error message
	cmdrpt = 2;				! Reparse after .CMINI
	stateblock [$cmrty] = $stptr ('Data fill limit [100%]: ');
						! Set prompt
	comand (0, stateblock, dfl_states);	! Get the command

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .dfl_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN

	    !+
	    !   Make sure the value returned is within range
	    !-

	    IF .dfl_status [cmdsts$g_context] LSS 50 OR 	!
		.dfl_status [cmdsts$g_context] GTR 100	!
	    THEN
		BEGIN
		SIGNAL (ss$_out_of_range, 50, 100);
		END
	    ELSE
		BEGIN

		LOCAL
		    words_per_bucket;

		IF .key_xab [xab$b_ref] EQL 0	! Primary key?
		THEN
		    words_per_bucket = .databucket_size*%O'1000'
		ELSE
		    words_per_bucket = .outfab [fab$v_bks]*%O'1000';

		key_xab [xab$h_dfl] = 		!
		(.words_per_bucket*.dfl_status [cmdsts$g_context])/100;

		!+
		!   Call the next routine below us.  If the
		!   return is successful, then we can exit the
		!   loop and work our way back to the top of
		!   the stack of calls.  If the return is not
		!   successful, it is a request for backing up,
		!   and we stay in the loop.
		!-

		IF setifl (.key_xab) EQL ss$_success	! All OK?
		THEN
		    EXITLOOP;			! The only way out

		key_xab [xab$h_dfl] = 0;
		END

	    END
	ELSE
	    BEGIN
	    key_xab [xab$h_dfl] = 0;
	    SIGNAL (.dfl_status [cmdsts$g_status]);	! Parse not "success"
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End SETDFL
ROUTINE setifl (key_xab : REF $xabkey_decl) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	ifl_question_handler,		! Condition handler for this routine
	ifl_initialize : NOVALUE,		! Called by .CMINI function
	ifl_take_action : NOVALUE;		! Called by parser

    OWN
	ifl_status : $cmdsts_block,		! Status from this parse
	!
	!   Parsing states and transitions
	!
	ifl_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = ifl_initialize, 	!
			context = ifl_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMNUM
			function = $cmnum, 	!
			flags = cm_sdh, 	!
			help = 'number from 50 to 100', 	!
			data = 10, 		! Key number in decimal
			context = $command_status (	!
			    status = ss$_success, 	!
			    next = 0, 		! No branching here
			    context = -1), 	! Special instructions
			action = ifl_take_action,
						! Do something w/ the JFN
			next = 1, 		!
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = ifl_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = ifl_status, 	! Status variable
				next = 1, 	!
				more = 		!
				$comand_flddb (	! Default to 0
				    function = $cmcfm, 	!
				    action = ifl_take_action, 	!
				    flags = cm_sdh, 	!
				    help = 'Return for default',
				    context = $command_status (	!
					status = ss$_success, 	!
					next = 0, 	!
					context = 100), 	!
				    next = -1))))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE ifl_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_success;	! Just in case
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = 0;
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE ifl_take_action (indexfill, b, returned_context : REF $cmdsts_block)
	: NOVALUE =
	BEGIN
	ifl_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];

	IF .returned_context [cmdsts$g_context] EQL -1	! Use data?
	THEN
	    ifl_status [cmdsts$g_context] = .indexfill
	ELSE
	    ifl_status [cmdsts$g_context] = 100;

	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE ifl_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl :
	REF VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$_backup] :
		BEGIN
		return_value = ss$_backup;
		SETUNWIND ();
		RETURN true;
		END;

	    [ss$unw] :
		BEGIN
		RETURN false;
		END;

	    [ss$_reparse] :
		BEGIN
		RETURN true;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    ENABLE
	ifl_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN

	LOCAL
	    comnd_error,			! Status returned by COMAND
	    start_state;			! State to start/restart parse

	setup_stateblock ();			! Initialize the state block
	cmderp = 0;				! No special error message
	cmdrpt = 2;				! Reparse after .CMINI
	stateblock [$cmrty] = $stptr ('Index fill limit [100%]: ');
						! Set prompt
	comand (0, stateblock, ifl_states);	! Get the command

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .ifl_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN

	    !+
	    !   Make sure the value returned is within range
	    !-

	    IF .ifl_status [cmdsts$g_context] LSS 50 OR 	!
		.ifl_status [cmdsts$g_context] GTR 100	!
	    THEN
		BEGIN
		SIGNAL (ss$_out_of_range, 50, 100);
		END
	    ELSE
		BEGIN

		LOCAL
		    words_per_bucket;

		words_per_bucket = .outfab [fab$v_bks]*%O'1000';
		key_xab [xab$h_ifl] = 		!
		(.words_per_bucket*.ifl_status [cmdsts$g_context])/100;

		!+
		!   Call the next routine below us.  If the
		!   return is successful, then we can exit the
		!   loop and work our way back to the top of
		!   the stack of calls.  If the return is not
		!   successful, it is a request for backing up,
		!   and we stay in the loop.
		!-

		IF nxtkey (.key_xab) EQL ss$_success	! All OK?
		THEN
		    EXITLOOP;			! The only way out

		key_xab [xab$h_ifl] = 0;
		END

	    END
	ELSE
	    BEGIN
	    key_xab [xab$h_ifl] = 0;
	    SIGNAL (.ifl_status [cmdsts$g_status]);	! Parse not "success"
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End SETIFL
ROUTINE nxtkey (key_xab : REF $xabkey_decl) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	nxtk_question_handler,		! Condition handler for this routine
	nxtk_initialize : NOVALUE,		! Called by .CMINI function
	nxtk_take_action : NOVALUE;		! Called by parser

    OWN
	nxtk_status : $cmdsts_block,		! Status from this parse
	!
	!   Keyword table
	!
	nxtk_kwords : $comand_key (		!
		$comand_option (		!
		    opt = 'No', 		!
		    action = nxtk_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			next = 0, 		!
			context = 0), 		!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'Yes', 		!
		    action = nxtk_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			next = 0, 		!
			context = 1), 		!
		    next = 1)),
	!
	!   Parsing states and transitions
	!
	nxtk_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = nxtk_initialize, 	!
			context = nxtk_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMKEY
			function = $cmkey, 	!
			data = nxtk_kwords, 	! Fixed or Variable
			flags = cm_sdh, 	! Suppress normal help
			help = 'Yes or No', 	!
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = nxtk_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = nxtk_status, 	! Status variable
				next = 1, more = 	!
				$comand_flddb (	! CRLF for default
				    function = $cmcfm, 	!
				    flags = cm_sdh, 	! Suppress help
				    help = 'Return for default', 	!
				    action = nxtk_take_action, 	!
				    context = $command_status (	!
					status = ss$_success, 	!
					next = 0, 	!
					context = 0), 	!
				    next = -1))))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE nxtk_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_success;
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = 0;
	cmderp = $stptr ('Please answer "Yes" or "No"', $crlf);
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE nxtk_take_action (a, b, returned_context : REF $cmdsts_block) :
	NOVALUE =
	BEGIN
	nxtk_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];
	nxtk_status [cmdsts$a_next_routine] = .returned_context [
	    cmdsts$a_next_routine];
	nxtk_status [cmdsts$g_context] = .returned_context [cmdsts$g_context];
	cmderp = $stptr ('Your answer was not followed by a carriage return');
	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE nxtk_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl :
	REF VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1],
	    key_xab = .enbl [1] : REF $xabkey_decl,
	    newkey = .enbl [2] : REF $xabkey_decl;

	SELECTONE .cond OF
	    SET

	    [ss$_backup] :
		BEGIN
		return_value = ss$_backup;
		SETUNWIND ();
		RETURN true;
		END;

	    [ss$unw] :
		BEGIN
		key_xab [xab$a_nxt] = 0;

		IF .newkey NEQ 0		!
		THEN
		    BEGIN
		    fremem (.newkey, xab$k_keylen);
		    newkey = 0;
		    END;

		RETURN false;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    LOCAL
	xab_pointer : REF $xabkey_decl VOLATILE,	! For handler to get at
	newkey : REF $xabkey_decl VOLATILE;

    ENABLE
	nxtk_question_handler (xab_pointer, newkey);	! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN
	xab_pointer = .key_xab;			! Pointer for handler
	setup_stateblock ();			! Initialize the state block
	cmderr = 0;				! Handle errors for us
	cmdrpt = 2;			! Reparse from state after .CMINI
	stateblock [$cmrty] = $stptr ('Do you want do define another key [No]: '
	);					! Set prompt
	comand (0, stateblock, nxtk_states);	! Get the command

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .nxtk_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN

	    !+
	    !   Call the next routine below us.  If the
	    !   return is successful, then we can exit the
	    !   loop and work our way back to the top of
	    !   the stack of calls.  If the return is not
	    !   successful, it is a request for backing up,
	    !   and we stay in the loop.
	    !-

	    IF .nxtk_status [cmdsts$g_context]	! Yes?
	    THEN
		BEGIN
		newkey = key_xab [xab$a_nxt] = getmem (xab$k_keylen);
		$xabkey_init (xab = .newkey, 	!
		    kref = (.key_xab [xab$b_ref] + 1), dfl = 509, ifl = 509);

		IF (SELECTONE .outfab [fab$v_bsz] OF
			SET
			[6] :
			    BEGIN
			    newkey [xab$v_dtp] = xab$k_six;
			    key_6 (.newkey)
			    END;
			[7] :
			    BEGIN
			    newkey [xab$v_dtp] = xab$k_stg;
			    key_7 (.newkey)
			    END;
			[9] :
			    BEGIN
			    newkey [xab$v_dtp] = xab$k_ebc;
			    key_9 (.newkey)
			    END;
			[OTHERWISE] :
			    BEGIN
			    newkey [xab$v_dtp] = xab$k_in4;
			    key_36 (.newkey)
			    END;
			TES) EQL ss$_success	!
		THEN
		    EXITLOOP;

		key_xab [xab$a_nxt] = 0;

		IF .newkey NEQ 0		!
		THEN
		    BEGIN
		    fremem (.newkey, xab$k_keylen);
		    newkey = 0;
		    END;

		END
	    ELSE
		BEGIN

		IF confirm () EQL ss$_success	! All OK?
		THEN
		    EXITLOOP;			! The only way out

		key_xab [xab$a_nxt] = 0;

		IF .newkey NEQ 0		!
		THEN
		    BEGIN
		    fremem (.newkey, xab$k_keylen);
		    newkey = 0;
		    END;

		END;

	    END
	ELSE
	    BEGIN
	    SIGNAL (.nxtk_status [cmdsts$g_status]);	! Parse not "success"
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End NXTKEY
ROUTINE spanned_records =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	spn_question_handler,		! Condition handler for this routine
	spn_initialize : NOVALUE,		! Called by .CMINI function
	spn_take_action : NOVALUE;		! Called by parser

    OWN
	spn_status : $cmdsts_block,		! Status from this parse
	!
	!   Keyword table
	!
	spn_kwords : $comand_key (		!
		$comand_option (		!
		    opt = 'No', 		!
		    action = spn_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			next = 0, 		!
			context = 0), 		!
		    next = 1), 			!
		$comand_option (		!
		    opt = 'Yes', 		!
		    action = spn_take_action, 	!
		    context = $command_status (	!
			status = ss$_success, 	!
			next = 0, 		!
			context = 1), 		!
		    next = 1)),
	!
	!   Parsing states and transitions
	!
	spn_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = spn_initialize, 	!
			context = spn_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMKEY
			function = $cmkey, 	!
			data = spn_kwords, 	! Fixed or Variable
			flags = cm_sdh, 	! Suppress normal help
			help = 'Yes or No', 	!
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = spn_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = spn_status, 	! Status variable
				next = 1, more = 	!
				$comand_flddb (	! CRLF for default
				    function = $cmcfm, 	!
				    flags = cm_sdh, 	! Suppress help
				    help = 'Return for default', 	!
				    action = spn_take_action, 	!
				    context = $command_status (	!
					status = ss$_success, 	!
					next = 0, 	!
					context = 0), 	!
				    next = -1))))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE spn_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_success;
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = 0;
	cmderp = $stptr ('Please answer "Yes" or "No"', $crlf);
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE spn_take_action (a, b, returned_context : REF $cmdsts_block) :
	NOVALUE =
	BEGIN
	spn_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];
	spn_status [cmdsts$a_next_routine] = .returned_context [
	    cmdsts$a_next_routine];
	spn_status [cmdsts$g_context] = .returned_context [cmdsts$g_context];
	cmderp = $stptr ('Your answer was not followed by a carriage return');
	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE spn_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl :
	REF VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$_backup] :
		BEGIN
		return_value = ss$_backup;
		SETUNWIND ();
		RETURN true;
		END;

	    [ss$unw] :
		BEGIN
		disp_flags [dsp$k_blk] = 0;
		RETURN false;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    ENABLE
	spn_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN
	setup_stateblock ();			! Initialize the state block
	cmderr = 0;				! Handle errors for us
	cmdrpt = 2;			! Reparse from state after .CMINI
	stateblock [$cmrty] = $stptr ('Blocked records [No]: ');
						! Set prompt
	comand (0, stateblock, spn_states);	! Get the command

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .spn_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN
	    disp_flags [dsp$k_blk] = 1;
	    outfab [fab$v_blk] = .spn_status [cmdsts$g_context];
						! Set BLK bit

	    !+
	    !   Call the next routine below us.  If the
	    !   return is successful, then we can exit the
	    !   loop and work our way back to the top of
	    !   the stack of calls.  If the return is not
	    !   successful, it is a request for backing up,
	    !   and we stay in the loop.
	    !-

	    IF confirm () EQL ss$_success	! All OK?
	    THEN
		EXITLOOP;			! The only way out

	    disp_flags [dsp$k_blk] = 0;
	    END
	ELSE
	    BEGIN
	    disp_flags [dsp$k_blk] = 0;
	    outfab [fab$v_blk] = 0;		! Spanned records
	    SIGNAL (.spn_status [cmdsts$g_status]);	! Parse not "success"
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End SPANNED_RECORDS
ROUTINE confirm =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	cfm_question_handler,		! Condition handler for this routine
	cfm_initialize : NOVALUE,		! Called by .CMINI function
	cfm_take_action : NOVALUE;		! Called by parser

    OWN
	cfm_status : $cmdsts_block,		! Status from this parse
	!
	!   Parsing states and transitions
	!
	cfm_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = cfm_initialize, 	!
			context = cfm_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			flags = cm_sdh, 	! Suppress normal help
			help = 'RETURN to confirm operation', 	!
			next = -1, 		!
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = cfm_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to redisplay current status',
				action = set_display, 	!
				context = cfm_status, 	! Status variable
				next = 1)))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE cfm_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_success;
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = 0;
	cmderp = $stptr ('Please confirm selected operation', $crlf);
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE cfm_take_action (a, b, returned_context : REF $cmdsts_block) :
	NOVALUE =
	BEGIN
	cfm_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];
	cfm_status [cmdsts$a_next_routine] = .returned_context [
	    cmdsts$a_next_routine];
	cfm_status [cmdsts$g_context] = .returned_context [cmdsts$g_context];
	cmderp = $stptr ('Your answer was not followed by a carriage return');
	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE cfm_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl :
	REF VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$_backup] :
		BEGIN
		return_value = ss$_backup;
		SETUNWIND ();
		RETURN true;
		END;

	    [ss$unw] :
		BEGIN
		RETURN false;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    ENABLE
	cfm_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    SIGNAL (ss$_display);

    WHILE 1 DO
	BEGIN
	setup_stateblock ();			! Initialize the state block
	cmderr = 0;				! Handle errors for us
	cmdrpt = 2;			! Reparse from state after .CMINI
	stateblock [$cmrty] = $stptr ('[Confirm with RETURN] ');
						! Set prompt
	comand (0, stateblock, cfm_states);	! Get the command

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .cfm_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN
	    EXITLOOP;				! The only way out
	    END
	ELSE
	    BEGIN
	    SIGNAL (.cfm_status [cmdsts$g_status]);	! Parse not "success"
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End CONFIRM
%SBTTL 'Reorganization script routines'
ROUTINE r_ifile =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	ri_question_handler,		! Condition handler for this routine
	ri_initialize : NOVALUE,		! Called by .CMINI function
	ri_take_action : NOVALUE;		! Called by parser

    OWN
	ri_status : $cmdsts_block,		! Status from this parse
	!
	!   Parsing states and transitions
	!
	ri_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = ri_initialize, 	!
			context = ri_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMIFI
			function = $cmifi, 	!
			flags = cm_sdh, 	!
			help = 'RMS indexed file to reorganize',
			context = $command_status (	!
			    status = ss$_success, 	!
			    next = 0, 		! No branching here
			    context = 0), 	!
			action = ri_take_action,
						! Do something w/ the JFN
			next = 1, 		!
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = ri_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = ri_status, 	! Status variable
				next = 1)))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE ri_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_jsys_error_return;	! Just in case
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = 0;
	RETURN;
	END;					! End RI_INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE ri_take_action (jfn, b, returned_context : REF $cmdsts_block) :
	NOVALUE =
	BEGIN

	IF .infab [fab$h_jfn] NEQ 0		! Do we already have a JFN?
	THEN
	    BEGIN
	    rljfn (.infab [fab$h_jfn]);		! Release it
	    infab [fab$h_jfn] = 0;		! Zero it
	    END;

	ri_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];
	infab [fab$h_jfn] = .jfn;
	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE ri_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl : REF
	VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$_backup] :
		BEGIN
		return_value = ss$_backup;
		SETUNWIND ();
		RETURN true;
		END;

	    [ss$unw] :
		BEGIN
		disp_flags [dsp$k_injfn] = 0;

		IF .infab [fab$h_jfn] NEQ 0	! Release JFN if needed
		THEN
		    BEGIN
		    rljfn (.infab [fab$h_jfn]);	! Release it
		    infab [fab$h_jfn] = 0;	! Zero it
		    END;

		RETURN false;
		END;

	    [ss$_reparse] :
		BEGIN

		IF .infab [fab$h_jfn] NEQ 0	! Release JFN if needed
		THEN
		    BEGIN
		    rljfn (.infab [fab$h_jfn]);	! Release it
		    infab [fab$h_jfn] = 0;	! Zero it
		    END;

		RETURN true;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    ENABLE
	ri_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN

	LOCAL
	    comnd_error,			! Status returned by COMAND
	    start_state;			! State to start/restart parse

	setup_stateblock ();			! Initialize the state block
	stateblock [$cmgjb] = injfn;		! Point to GTJFN block
	cmdrpt = 2;				! Reparse after .CMINI
	cmderr = true;				! Handle our own errors
	start_state = 0;			! Start here normally
	stateblock [$cmrty] = $stptr ('File to reorganize: ');	! Set prompt

	WHILE 1 DO
	    BEGIN

	    MAP
		stateblock : monblock [];

	    comnd_error = comand (.start_state, stateblock, ri_states);
						! Get the command

	    SELECTONE 1 OF
		SET

		[.stateblock [$cmflg, cm_nop]] :
		    BEGIN
		    start_state = 0;
		    SIGNAL (ss$_jsys_error_return, .comnd_error);
		    END;

		[.stateblock [$cmflg, cm_rpt]] :
		    BEGIN
		    start_state = 2;		! Set reparse state

		    IF .infab [fab$h_jfn] NEQ 0	! Release JFN if we have one
		    THEN
			BEGIN
			rljfn (.infab [fab$h_jfn]);	! Release it
			infab [fab$h_jfn] = 0;	! Zero it
			END;

		    END;

		[OTHERWISE] :
		    BEGIN
		    start_state = 0;
		    EXITLOOP;
		    END;
		TES;

	    END;

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .ri_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN

	    !+
	    !   Check to make sure that the file we
	    !   have been given is an RMS indexed file.
	    !-

	    IF NOT $open (fab = .infab)		! Check out the file
	    THEN
		BEGIN
		SIGNAL (ss$_rms_error, .infab);
		END
	    ELSE
		BEGIN

		!+
		!   Check to make sure the file is indexed
		!-

		IF .infab [fab$v_org] NEQ fab$k_idx	!
		THEN
		    BEGIN
		    SIGNAL (ss$_input_not_indexed);
		    infab [fab$v_drj] = 0;	! Get rid of the JFN

		    IF NOT $close (fab = .infab)	!
		    THEN
			SIGNAL (ss$_rms_error, .infab);

		    END
		ELSE
		    BEGIN

		    !+
		    !   Close the input file, but
		    !   keep a hold of the JFN.
		    !-

		    disp_flags [dsp$k_injfn] = 1;
		    infab [fab$v_drj] = 1;	! Do not release JFN

		    IF NOT $close (fab = .infab)	!
		    THEN
			SIGNAL (ss$_rms_error, .infab);

		    !+
		    !   Parse out the filename into its
		    !   component parts, and put them into
		    !   the default fields of the output
		    !   filename.
		    !-

		    IF NOT jfns (		!
			    CH$PTR (outdev), 	! Default device name
			    .infab [fab$h_jfn], 	! Input JFN
			    fld ($jsaof, js_dev))	!
		    THEN
			SIGNAL (ss$_jsys_error_return);

		    !
		    !   Now the directory
		    !

		    IF NOT jfns (		!
			    CH$PTR (outdir), 	! Default directory name
			    .infab [fab$h_jfn], 	! Input JFN
			    fld ($jsaof, js_dir))	!
		    THEN
			SIGNAL (ss$_jsys_error_return);

		    !
		    !   The filename
		    !

		    IF NOT jfns (		!
			    CH$PTR (outnam), 	! Default filename
			    .infab [fab$h_jfn], 	! Input JFN
			    fld ($jsaof, js_nam))	!
		    THEN
			SIGNAL (ss$_jsys_error_return);

		    !
		    !   The file extension
		    !

		    IF NOT jfns (		!
			    CH$PTR (outtyp), 	! Default filetype
			    .infab [fab$h_jfn], 	! Input JFN
			    fld ($jsaof, js_typ))	!
		    THEN
			SIGNAL (ss$_jsys_error_return);

		    !+
		    !   Call the next routine below us.  If the
		    !   return is successful, then we can exit the
		    !   loop and work our way back to the top of
		    !   the stack of calls.  If the return is not
		    !   successful, it is a request for backing up,
		    !   and we stay in the loop.
		    !-

		    IF r_ofile () EQL ss$_success	! All OK?
		    THEN
			EXITLOOP;		! The only way out

		    disp_flags [dsp$k_injfn] = 0;
		    END;

		END;

	    END
	ELSE
	    BEGIN
	    SIGNAL (.ri_status [cmdsts$g_status]);	! Parse not "success"
	    disp_flags [dsp$k_injfn] = 0;
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End R_IFILE
ROUTINE r_ofile =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	ro_question_handler,		! Condition handler for this routine
	ro_initialize : NOVALUE,		! Called by .CMINI function
	ro_take_action : NOVALUE;		! Called by parser

    OWN
	ro_status : $cmdsts_block,		! Status from this parse
	!
	!   Parsing states and transitions
	!
	ro_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = ro_initialize, 	!
			context = ro_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMFIL
			function = $cmfil, 	!
			flags = cm_sdh, 	!
			help = 'new indexed file',
			context = $command_status (	!
			    status = ss$_success, 	!
			    next = 0, 		! No branching here
			    context = 0), 	!
			action = ro_take_action,
						! Do something w/ the JFN
			next = 1, 		!
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = ro_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = ro_status, 	! Status variable
				next = 1)))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE ro_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_jsys_error_return;	! Just in case
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = 0;
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE ro_take_action (jfn, b, returned_context : REF $cmdsts_block) :
	NOVALUE =
	BEGIN

	IF .outfab [fab$h_jfn] NEQ 0		! Do we already have a JFN?
	THEN
	    BEGIN
	    rljfn (.outfab [fab$h_jfn]);	! Release it
	    outfab [fab$h_jfn] = 0;		! Zero it
	    END;

	ro_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];
	outfab [fab$h_jfn] = .jfn;
	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE ro_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl : REF
	VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$_backup] :
		BEGIN
		return_value = ss$_backup;
		SETUNWIND ();
		RETURN true;
		END;

	    [ss$unw] :
		BEGIN
		disp_flags [dsp$k_outjfn] = 0;

		IF .outfab [fab$h_jfn] NEQ 0	! Release JFN if needed
		THEN
		    BEGIN
		    rljfn (.outfab [fab$h_jfn]);	! Release it
		    outfab [fab$h_jfn] = 0;	! Zero it
		    END;

		RETURN false;
		END;

	    [ss$_reparse] :
		BEGIN

		IF .outfab [fab$h_jfn] NEQ 0	! Release JFN if needed
		THEN
		    BEGIN
		    rljfn (.outfab [fab$h_jfn]);	! Release it
		    outfab [fab$h_jfn] = 0;	! Zero it
		    END;

		RETURN true;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    ENABLE
	ro_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN

	LOCAL
	    comnd_error,			! Status returned by COMAND
	    start_state;			! State to start/restart parse

	setup_stateblock ();			! Initialize the state block
	stateblock [$cmgjb] = outjfn;		! Point to GTJFN block
	outjfn [$gjdev] = CH$PTR (outdev);
	outjfn [$gjdir] = CH$PTR (outdir);
	outjfn [$gjnam] = CH$PTR (outnam);
	outjfn [$gjext] = CH$PTR (outtyp);
	!
	!   Set up for new file with next higher
	!   generation number.
	!
	outjfn [$gjgen] = gj_fou + gj_msg + gj_xtn;
	cmdrpt = 2;				! Reparse after .CMINI
	cmderr = true;				! Handle our own errors
	start_state = 0;			! Start here normally
	stateblock [$cmrty] = $stptr ('New index file: ');	! Set prompt

	WHILE 1 DO
	    BEGIN

	    MAP
		stateblock : monblock [];

	    comnd_error = comand (.start_state, stateblock, ro_states);
						! Get the command

	    SELECTONE 1 OF
		SET

		[.stateblock [$cmflg, cm_nop]] :
		    BEGIN
		    start_state = 0;
		    SIGNAL (ss$_jsys_error_return, .comnd_error);
		    END;

		[.stateblock [$cmflg, cm_rpt]] :
		    BEGIN
		    start_state = 2;		! Set reparse state

		    IF .outfab [fab$h_jfn] NEQ 0	! Release JFN
		    THEN
			BEGIN
			rljfn (.outfab [fab$h_jfn]);	! Release it
			outfab [fab$h_jfn] = 0;	! Zero it
			END;

		    END;

		[OTHERWISE] :
		    BEGIN
		    start_state = 0;
		    EXITLOOP;
		    END;
		TES;

	    END;

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .ro_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN
	    disp_flags [dsp$k_outjfn] = 1;

	    IF confirm () EQL ss$_success	!
	    THEN
		EXITLOOP;			! Leave and return success

	    disp_flags [dsp$k_outjfn] = 0;
	    END
	ELSE
	    BEGIN
	    SIGNAL (.ro_status [cmdsts$g_status]);	! Parse not "success"
	    disp_flags [dsp$k_outjfn] = 0;
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End R_OFILE
%SBTTL 'Unload script routines'
ROUTINE u_ifile =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	ui_question_handler,		! Condition handler for this routine
	ui_initialize : NOVALUE,		! Called by .CMINI function
	ui_take_action : NOVALUE;		! Called by parser

    OWN
	ui_status : $cmdsts_block,		! Status from this parse
	!
	!   Parsing states and transitions
	!
	ui_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = ui_initialize, 	!
			context = ui_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMIFI
			function = $cmifi, 	!
			flags = cm_sdh, 	!
			help = 'RMS indexed file to unload',
			context = $command_status (	!
			    status = ss$_success, 	!
			    next = 0, 		! No branching here
			    context = 0), 	!
			action = ui_take_action,
						! Do something w/ the JFN
			next = 1, 		!
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = ui_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = ui_status, 	! Status variable
				next = 1)))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE ui_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_jsys_error_return;	! Just in case
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = 0;
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE ui_take_action (jfn, b, returned_context : REF $cmdsts_block) :
	NOVALUE =
	BEGIN

	IF .infab [fab$h_jfn] NEQ 0		! Do we already have a JFN?
	THEN
	    BEGIN
	    rljfn (.infab [fab$h_jfn]);		! Release it
	    infab [fab$h_jfn] = 0;		! Zero it
	    END;

	ui_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];
	infab [fab$h_jfn] = .jfn;
	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE ui_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl : REF
	VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$_backup] :
		BEGIN
		return_value = ss$_backup;
		SETUNWIND ();
		RETURN true;
		END;

	    [ss$unw] :
		BEGIN
		disp_flags [dsp$k_injfn] = 0;

		IF .infab [fab$h_jfn] NEQ 0	! Release JFN if needed
		THEN
		    BEGIN
		    rljfn (.infab [fab$h_jfn]);	! Release it
		    infab [fab$h_jfn] = 0;	! Zero it
		    END;

		RETURN false;
		END;

	    [ss$_reparse] :
		BEGIN

		IF .infab [fab$h_jfn] NEQ 0	! Release JFN if needed
		THEN
		    BEGIN
		    rljfn (.infab [fab$h_jfn]);	! Release it
		    infab [fab$h_jfn] = 0;	! Zero it
		    END;

		RETURN true;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    ENABLE
	ui_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN

	LOCAL
	    comnd_error,			! Status returned by COMAND
	    start_state;			! State to start/restart parse

	setup_stateblock ();			! Initialize the state block
	stateblock [$cmgjb] = injfn;		! Point to GTJFN block
	cmdrpt = 2;				! Reparse after .CMINI
	cmderr = true;				! Handle our own errors
	start_state = 0;			! Start here normally
	stateblock [$cmrty] = $stptr ('File to unload: ');	! Set prompt

	WHILE 1 DO
	    BEGIN

	    MAP
		stateblock : monblock [];

	    comnd_error = comand (.start_state, stateblock, ui_states);
						! Get the command

	    SELECTONE 1 OF
		SET

		[.stateblock [$cmflg, cm_nop]] :
		    BEGIN
		    start_state = 0;
		    SIGNAL (ss$_jsys_error_return, .comnd_error);
		    END;

		[.stateblock [$cmflg, cm_rpt]] :
		    BEGIN
		    start_state = 2;		! Set reparse state

		    IF .infab [fab$h_jfn] NEQ 0	! Release JFN if we have one
		    THEN
			BEGIN
			rljfn (.infab [fab$h_jfn]);	! Release it
			infab [fab$h_jfn] = 0;	! Zero it
			END;

		    END;

		[OTHERWISE] :
		    BEGIN
		    start_state = 0;
		    EXITLOOP;
		    END;
		TES;

	    END;

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .ui_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN

	    !+
	    !   Check to make sure that the file we
	    !   have been given is an RMS indexed file.
	    !-

	    infab [fab$a_xab] = summary;	! Add summary XAB

	    IF NOT $open (fab = .infab)		! Check out the file
	    THEN
		BEGIN
		SIGNAL (ss$_rms_error, .infab);
		END
	    ELSE
		BEGIN

		!+
		!   Check to make sure the file is indexed
		!-

		IF .infab [fab$v_org] NEQ fab$k_idx	!
		THEN
		    BEGIN
		    SIGNAL (ss$_input_not_indexed);
		    infab [fab$v_drj] = 0;	! Get rid of the JFN

		    IF NOT $close (fab = .infab)	!
		    THEN
			SIGNAL (ss$_rms_error, .infab);

		    END
		ELSE
		    BEGIN

		    !+
		    !   Close the input file, but
		    !   keep a hold of the JFN.
		    !-

		    disp_flags [dsp$k_injfn] = 1;
		    infab [fab$v_drj] = 1;	! Do not release JFN

		    IF NOT $close (fab = .infab)	!
		    THEN
			SIGNAL (ss$_rms_error, .infab);

		    !+
		    !   Call the next routine below us.  If the
		    !   return is successful, then we can exit the
		    !   loop and work our way back to the top of
		    !   the stack of calls.  If the return is not
		    !   successful, it is a request for backing up,
		    !   and we stay in the loop.
		    !-

		    IF u_ofile () EQL ss$_success	! All OK?
		    THEN
			EXITLOOP;		! The only way out

		    disp_flags [dsp$k_injfn] = 0;
		    END;

		END;

	    END
	ELSE
	    BEGIN
	    SIGNAL (.ui_status [cmdsts$g_status]);	! Parse not "success"
	    disp_flags [dsp$k_injfn] = 0;
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End U_IFILE
ROUTINE u_ofile =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	uo_question_handler,		! Condition handler for this routine
	uo_initialize : NOVALUE,		! Called by .CMINI function
	uo_take_action : NOVALUE;		! Called by parser

    OWN
	uo_status : $cmdsts_block,		! Status from this parse
	!
	!   Parsing states and transitions
	!
	uo_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = uo_initialize, 	!
			context = uo_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMOFI
			function = $cmofi, 	!
			flags = cm_sdh, 	!
			help = 'new sequential file',
			context = $command_status (	!
			    status = ss$_success, 	!
			    next = 0, 		! No branching here
			    context = 0), 	!
			action = uo_take_action,
						! Do something w/ the JFN
			next = 1, 		!
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = uo_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = uo_status, 	! Status variable
				next = 1)))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE uo_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_jsys_error_return;	! Just in case
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = 0;
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE uo_take_action (jfn, b, returned_context : REF $cmdsts_block) :
	NOVALUE =
	BEGIN

	IF .outfab [fab$h_jfn] NEQ 0		! Do we already have a JFN?
	THEN
	    BEGIN
	    rljfn (.outfab [fab$h_jfn]);	! Release it
	    outfab [fab$h_jfn] = 0;		! Zero it
	    END;

	uo_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];
	outfab [fab$h_jfn] = .jfn;
	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE uo_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl : REF
	VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$_backup] :
		BEGIN
		return_value = ss$_backup;
		SETUNWIND ();
		RETURN true;
		END;

	    [ss$unw] :
		BEGIN

		IF .outfab [fab$h_jfn] NEQ 0	! Release JFN if needed
		THEN
		    BEGIN
		    rljfn (.outfab [fab$h_jfn]);	! Release it
		    outfab [fab$h_jfn] = 0;	! Zero it
		    END;

		disp_flags [dsp$k_outjfn] = 0;
		RETURN false;
		END;

	    [ss$_reparse] :
		BEGIN

		IF .outfab [fab$h_jfn] NEQ 0	! Release JFN if needed
		THEN
		    BEGIN
		    rljfn (.outfab [fab$h_jfn]);	! Release it
		    outfab [fab$h_jfn] = 0;	! Zero it
		    END;

		RETURN true;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    ENABLE
	uo_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN

	LOCAL
	    comnd_error,			! Status returned by COMAND
	    start_state;			! State to start/restart parse

	setup_stateblock ();			! Initialize the state block
	stateblock [$cmgjb] = outjfn;		! Point to GTJFN block
	cmderp = 0;				! No special error message
	cmdrpt = 2;				! Reparse after .CMINI
	cmderr = true;				! Handle our own errors
	start_state = 0;			! Start here normally
	stateblock [$cmrty] = $stptr ('Sequential output file: ');
						! Set prompt

	WHILE 1 DO
	    BEGIN

	    MAP
		stateblock : monblock [];

	    comnd_error = comand (.start_state, stateblock, uo_states);
						! Get the command

	    SELECTONE 1 OF
		SET

		[.stateblock [$cmflg, cm_nop]] :
		    BEGIN
		    start_state = 0;
		    SIGNAL (ss$_jsys_error_return, .comnd_error);
		    END;

		[.stateblock [$cmflg, cm_rpt]] :
		    BEGIN
		    start_state = 2;		! Set reparse state

		    IF .outfab [fab$h_jfn] NEQ 0	! Release JFN
		    THEN
			BEGIN
			rljfn (.outfab [fab$h_jfn]);	! Release it
			outfab [fab$h_jfn] = 0;	! Zero it
			END;

		    END;

		[OTHERWISE] :
		    BEGIN
		    start_state = 0;
		    EXITLOOP;
		    END;
		TES;

	    END;

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .uo_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN

	    !+
	    !   Call the next routine below us.  If the
	    !   return is successful, then we can exit the
	    !   loop and work our way back to the top of
	    !   the stack of calls.  If the return is not
	    !   successful, it is a request for backing up,
	    !   and we stay in the loop.
	    !-

	    IF .summary [xab$b_nok] GTR 1	! More than one key?
	    THEN
		BEGIN
		disp_flags [dsp$k_outjfn] = 1;

		IF u_getkey () EQL ss$_success	! All OK?
		THEN
		    EXITLOOP;			! The only way out

		disp_flags [dsp$k_outjfn] = 0;
		END
	    ELSE
		BEGIN
		disp_flags [dsp$k_outjfn] = 1;
		infab [fab$g_ctx] = 0;		! Default to 0

		IF confirm () EQL ss$_success	!
		THEN
		    EXITLOOP;			! OK

		END;

	    END
	ELSE
	    BEGIN
	    SIGNAL (.uo_status [cmdsts$g_status]);	! Parse not "success"
	    disp_flags [dsp$k_outjfn] = 0;
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End U_OFILE
ROUTINE u_getkey =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    FORWARD ROUTINE
	ug_question_handler,		! Condition handler for this routine
	ug_initialize : NOVALUE,		! Called by .CMINI function
	ug_take_action : NOVALUE;		! Called by parser

    OWN
	ug_status : $cmdsts_block,		! Status from this parse
	!
	!   Parsing states and transitions
	!
	ug_states : $comand_states (		!
		$comand_state (			! 0
		    $comand_flddb (		! .CMINI
			function = $cmini, 	!
			action = ug_initialize, 	!
			context = ug_status, 	!
			next = 2)), 		!
		$comand_state (			! 1
		    $comand_flddb (		! .CMCFM
			function = $cmcfm, 	!
			next = -1)),
		$comand_state (			! 2
		    $comand_flddb (		! .CMNUM
			function = $cmnum, 	!
			flags = cm_sdh, 	!
			help = CH$PTR (hlpbuf), 	!
			data = 10, 		! Key number in decimal
			context = $command_status (	!
			    status = ss$_success, 	!
			    next = 0, 		! No branching here
			    context = -1), 	! Special instructions
			action = ug_take_action,
						! Do something w/ the JFN
			next = 1, 		!
			more = 			!
			$comand_flddb (		! Get the "<" with .CMTOK
			    function = $cmtok, 	!
			    data = '<', 	!
			    flags = cm_sdh, 	! Suppress help
			    help = '"<" to go back to previous question',
			    action = set_backup, 	! Signal a backup
			    context = ug_status,
						! Address of status variable
			    next = 1, 		!
			    more = 		!
			    $comand_flddb (	! Get a "*" with .CMTOK
				function = $cmtok, 	!
				data = '*', 	!
				flags = cm_sdh, 	! Suppress help
				help = '"*" to display current status',
				action = set_display, 	!
				context = ug_status, 	! Status variable
				next = 1, 	!
				more = 		!
				$comand_flddb (	! Default to 0
				    function = $cmcfm, 	!
				    action = ug_take_action, 	!
				    flags = cm_sdh, 	!
				    help = 'Return for default (key = 0)',
				    context = $command_status (	!
					status = ss$_success, 	!
					next = 0, 	!
					context = 0), 	!
				    next = -1))))));

    !+
    !   INITIALIZE is called by COMAND after the .CMINI function
    !   is called.  It sets up the default status and "next routine"
    !   if necessary.
    !-

    ROUTINE ug_initialize (a, b, info : REF $cmdsts_block) : NOVALUE =
	BEGIN
	info [cmdsts$g_status] = ss$_success;	! Just in case
	info [cmdsts$a_next_routine] = 0;
	info [cmdsts$g_context] = 0;
	RETURN;
	END;					! End INITIALIZE

    !+
    !   TAKE_ACTION is called when COMAND parses a field or keyword.
    !   It sets up the status block with the information from the
    !   context/command-status block of the FLDDB or keyword-entry.
    !-

    ROUTINE ug_take_action (key_number, b, returned_context : REF $cmdsts_block)
	: NOVALUE =
	BEGIN
	ug_status [cmdsts$g_status] = .returned_context [cmdsts$g_status];

	IF .returned_context [cmdsts$g_context] EQL -1	! Use data?
	THEN
	    infab [fab$g_ctx] = .key_number
	ELSE
	    infab [fab$g_ctx] = 0;

	RETURN;
	END;					! End TAKE_ACTION

    !+
    !   QUESTION_HANDLER is the condition handler for this particular
    !   routine.  It handles backing up and unwinding.
    !-

    ROUTINE ug_question_handler (sig : REF VECTOR, mech : REF VECTOR, enbl : REF
	VECTOR) =
	BEGIN

	BIND
	    cond = sig [1],
	    return_value = mech [1];

	SELECTONE .cond OF
	    SET

	    [ss$_backup] :
		BEGIN
		return_value = ss$_backup;
		SETUNWIND ();
		RETURN true;
		END;

	    [ss$unw] :
		BEGIN
		disp_flags [dsp$k_unload_key] = 0;
		infab [fab$g_ctx] = 0;
		RETURN false;
		END;

	    [ss$_reparse] :
		BEGIN
		RETURN true;
		END;

	    [OTHERWISE] : 			! Resignal anything else
		RETURN false;
	    TES;

	END;					! End QUESTION_HANDLER

    ENABLE
	ug_question_handler;			! Enable our handler

    !+
    !   Loop until the user gives us a valid response.  The only
    !   two ways out of this loop are the EXITLOOP when a call
    !   successful and to signal an UNWIND one way or another.
    !-

    WHILE 1 DO
	BEGIN

	LOCAL
	    comnd_error,			! Status returned by COMAND
	    start_state;			! State to start/restart parse

	!
	!   Set up the help message
	!
	control = $fao_ctl ('key number from 0 to !UL!%^@');
	fprm [0] = .summary [xab$b_nok] - 1;
	$faol (ctrstr = .control, prmlst = fprm, outbuf = hlpdsc);
	setup_stateblock ();			! Initialize the state block
	cmderp = 0;				! No special error message
	cmdrpt = 2;				! Reparse after .CMINI
	stateblock [$cmrty] = $stptr ('Key for unloading [0]: ');
						! Set prompt
	comand (0, stateblock, ug_states);	! Get the command

	!+
	!   If the status returned is SUCCESS, then
	!   we call the next routine down; otherwise, we
	!   SIGNAL with the status we received.
	!-

	IF .ug_status [cmdsts$g_status] EQL ss$_success	! Everything OK?
	THEN
	    BEGIN

	    !+
	    !   Make sure the value returned is within range
	    !-

	    IF .infab [fab$g_ctx] LSS 0 OR 	!
		.infab [fab$g_ctx] GTR (.summary [xab$b_nok] - 1)	!
	    THEN
		BEGIN
		SIGNAL (ss$_out_of_range, 0, (.summary [xab$b_nok] - 1));
		END
	    ELSE

	    !+
	    !   Call the next routine below us.  If the
	    !   return is successful, then we can exit the
	    !   loop and work our way back to the top of
	    !   the stack of calls.  If the return is not
	    !   successful, it is a request for backing up,
	    !   and we stay in the loop.
	    !-

		disp_flags [dsp$k_unload_key] = 1;

	    IF confirm () EQL ss$_success	!
	    THEN
		EXITLOOP;			! The only way out

	    disp_flags [dsp$k_unload_key] = 0;
	    END
	ELSE
	    BEGIN
	    SIGNAL (.ug_status [cmdsts$g_status]);	! Parse not "success"
	    disp_flags [dsp$k_unload_key] = 0;
	    END;

	END;

    RETURN ss$_success;				! Return OK
    END;					! End U_GETKEY
END

ELUDOM