Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

MODULE CREATE	(
		IDENT = '1',
		%IF
		    %BLISS(BLISS32)
		%THEN
		    LANGUAGE(BLISS32),
		    ADDRESSING_MODE(EXTERNAL=LONG_RELATIVE,
				    NONEXTERNAL=LONG_RELATIVE)
		%ELSE
		    LANGUAGE(BLISS36)
		%FI
		) =
BEGIN

!
!			COPYRIGHT (C) 1982 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
! ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER
! COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE
! AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!

!++
! FACILITY:	CMS Library processor
!
! ABSTRACT:
!
!	INSERT, REMOVE, and CREATE processor.  CREATE CLASS places
!	a new entry in the class table.  CREATE ELEMENT places a new
!	element in the library.  INSERT and REMOVE are used to
!	manipulate and modify the entries made by CREATE CLASS.
!
! ENVIRONMENT:	DS-20, VAX/VMS
!
! AUTHOR: D. Knight , CREATION DATE: 20-Dec-79
!
!--

!
! TABLE OF CONTENTS
!

FORWARD ROUTINE
	CREATE,				!CREATE
	INSERT,				!INSERT/REMOVE processor
	CLS_INP : NOVALUE,		!close input file
	CLS_OUT : NOVALUE,		!Close output file
	OPNINP,				!open input class file
	OPNOUT : NOVALUE,		!open new output class file
	RFILGEN,			!retrieve file generation information
	SETUP : NOVALUE;		!common setup

!
! INCLUDE FILES:
!
%if %bliss(bliss32) %then
    library 'sys$library:starlet';
%else
    require 'jsys:';
%fi

LIBRARY 'XPORT:';

REQUIRE 'SCONFG:';

REQUIRE 'BLISSX:';

REQUIRE 'COMUSR:';

REQUIRE 'HOSUSR:';

REQUIRE 'LOGUSR:';

REQUIRE 'SHRUSR:';

!
! MACROS:
!

MACRO
	STG(L,M) = OUTSTG(CH$PTR(UPLIT(L)),%CHARCOUNT(L),M) %;

!
! EQUATED SYMBOLS:
!

LITERAL
	DELETE=TRUE,			!Argument to TERMINATE to allow file deletion
	NODELETE=FALSE,			!Disallow file deletion in TERMINATE
	FAILURE=-1,			!Return values for
	NORMAL=0,			!   OPNINP
	NOSUCHFILE=+1;			!   processor

!
! OWN STORAGE:
!

OWN
	FIRST_FIL,			!First file read
	GEN_BUF : VECTOR[CH$ALLOCATION(GEN_SIZE)],
	GEN_LEN,
	GEN_PTR,
	$IO_BLOCK(INP),
	INP_OPN,
	$IO_BLOCK(OUT),
	OUT_OPN,
	PLUS_OP,
	QUAL : REF QUALIFIER_BLOCK,
	SUB_CMD,
	USR_REM : REF DESC_BLOCK;

!Command qualifiers
OWN
	IFABS,				! /IFABSENT
	IFPRES,				! /IFPRESENT
	SUPERS;				! /SUPERSEDE
!CRC accumulators and flags
OWN
	EXISTING_CRC,			!CRC already in file
	FOUND_CRC,			!Set is CRC is found
	OLD_CRC ;			!Re-calculated CRC from input file

!
! EXTERNAL REFERENCES:
!

external literal

	s_biggen,			!generation number too large
	s_classro,			!Class is read only
	s_clsexists,			!Class already exists
	s_creclass,			!Class created
	s_elemexist,			!Element already exists in class
 	s_enotincls,
	s_insclass,			!Class inserted
	s_invcksum,			!class file has an inv cksum(CRC)
	s_noclassf,			!Class does not exist
	s_noelem,			!No such element name in library
	s_nocksum,			!No checksum (CRC)
	s_nogen,			!Element has no generation
	s_subcomerr,			!Subcommand not yet implemented
	s_remclass;			!removed from class

external
	f_perf_crc,			! If on,calculate CRC in OUTSTG
	calc_crc,			! CRC calculated by OUTSTG
	ignore_control;			! Tell OUTSTG to ignore the control line

EXTERNAL ROUTINE
	ASCHEX,				!Convert ASCII to hex
	BADLIB,
	BADXPO,
	BEGTRN,				!Mark start of transaction
	BUG,
	BUGXPO,
	CANTRN,				!Cancel transaction
	CMPGEN,
	COMAND,
	CRCTABLE,			!Set up ploynomial table
	CRCCALC,			!Calculate the CRC of a string
	CRELM,				! CREATE ELEMENT
	DELVRS,				! delete files(FILOPS)
	DIRDES,				! check for direct descendant (SHWEXA)
	DONLIB,				!Unlock library
	ENDTRN,				!Mark end of transaction
	ERS,
	exits,				!exit silently
	GETATR,
	GETELM,
	GET_LXM,
	HEXASZ,				!Hex to ASCII
	LOGTRN,				! write log entry
	OUTINI,
	OUTSTG,
	SAFLIB,				!Lock library
	SETATR,
	sysmsg,
 	trnlog,				! translate a logical name
	TRNFIL;				!Set protection, etc.

GLOBAL ROUTINE CREATE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	CREATE an class entry, either CLASS or ELEMENT, and place
!	it in the master class file ATF.
!
! FORMAL PARAMETERS:
!
!	NONE.
!
! IMPLICIT INPUTS:
!
!	The arguments are passed from the command line typed by the user
!	and parsed by COMAND.
!
! IMPLICIT OUTPUTS:
!
!	An entry is made in the class file in the library.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	Normal system return values.
!
! SIDE EFFECTS:
!
!	The obsolete class file is deleted.
!
!--

    BEGIN

    LOCAL
	CMD,
	OPN_VAL,
	PAR : REF PARAMETER_BLOCK,
	STATUS;

    !Parse the command
    IF
	NOT COMAND(CMD,SUB_CMD,QUAL,PAR,USR_REM)
    THEN
	RETURN K_SILENT_ERROR;

    !CREATE ELEMENT command
    IF
	.SUB_CMD EQL K_ELEMENT_SUB
    THEN
	RETURN CRELM(.QUAL,.PAR,.USR_REM)
    ELSE
    IF
	.SUB_CMD NEQ K_CLASS_SUB
    THEN
	BEGIN
	ERS(s_subcomerr,LIT('Subcommand not yet implemented'));
	RETURN K_SILENT_ERROR
	END;

    !Do initial setup
    SETUP();

    !Lock the library
    IF
	NOT SAFLIB(K_UPDATE_LIB)
    THEN
	RETURN K_SILENT_SEVERE ;

    !Open the old class file, if any
    OPN_VAL=OPNINP();

    !Mark start of transaction
    BEGTRN();

    !Open the new class file
    OPNOUT();
 
    !Initialize CRC variables
    old_crc = 0;
    existing_crc = 0;
    found_crc = false;
    calc_crc = 0;
    f_perf_crc = true;
    ignore_control = true;

    ! Set up polynomial table
    crctable();
    !Locate the position where the class is to be placed
    IF
	.OPN_VAL EQL NORMAL
    THEN
	BEGIN

	REPEAT
	    BEGIN

	    LOCAL
		CL_NM_LEN;

	    CL_NM_LEN=0;

	    !If end of file, the location must be right for insertion
	    STATUS =$STEP_GET(IOB=INP_IOB,failure=0);
		
	    IF .STATUS NEQ STEP$_EOF AND
		CH$EQL(4,CH$PTR(UPLIT('*/C:')),4, .INP_IOB[IOB$A_STRING])
	    THEN
		BEGIN
		LOCAL
		    LEN,
		    PTR;
		LEN = .INP_IOB[IOB$H_STRING] - 4;
	  	PTR = CH$PLUS(.INP_IOB[IOB$A_STRING], 4);
		EXISTING_CRC = ASCHEX(PTR, LEN);
		found_crc = true;
		! This must be the place to insert the new line
		OUTSTG(.PAR[PAR_TEXT_PTR],.PAR[PAR_TEXT_LEN],FALSE);
		!Put out the command comment also
		STG(' ',FALSE);
		OUTSTG(.USR_REM[DESC_PTR],.USR_REM[DESC_LEN],TRUE);
		EXITLOOP ;
		END;
		
	    IF .STATUS EQL STEP$_EOF
	    THEN
		BEGIN
		!Place the entry in the file
		OUTSTG(.PAR[PAR_TEXT_PTR],.PAR[PAR_TEXT_LEN],FALSE);
		!Put out the command comment also
		STG(' ',FALSE);
		OUTSTG(.USR_REM[DESC_PTR],.USR_REM[DESC_LEN],TRUE);
		EXITLOOP
		END;

	    ! Calculate the CRC of this line
	    OLD_CRC = .OLD_CRC + 
			CRCCALC(.INP_IOB[IOB$H_STRING], .INP_IOB[IOB$A_STRING]);

	    !Get the length of the name only in the class file
	    INCR I FROM 0 TO .INP_IOB[IOB$H_STRING]-1 DO
		BEGIN

		IF
		    CH$RCHAR(CH$PLUS(.INP_IOB[IOB$A_STRING],.I)) EQL %C' '
		THEN
		    EXITLOOP;

		CL_NM_LEN=.CL_NM_LEN+1
		END;

	    !See if we have found the position for an insertion
	    IF
		CH$RCHAR(.INP_IOB[IOB$A_STRING]) NEQ %C' ' AND
		CH$LSS(.PAR[PAR_TEXT_LEN],.PAR[PAR_TEXT_PTR],
		    .CL_NM_LEN,.INP_IOB[IOB$A_STRING])
	    THEN
		BEGIN
		!Build the entry and place it in the file
		OUTSTG(.PAR[PAR_TEXT_PTR],.PAR[PAR_TEXT_LEN],FALSE);

		!Put out the command comment also
		STG(' ',FALSE);
		OUTSTG(.USR_REM[DESC_PTR],.USR_REM[DESC_LEN],TRUE);

		!Output the original entry also
		OUTSTG(.INP_IOB[IOB$A_STRING],.INP_IOB[IOB$H_STRING],TRUE);

		EXITLOOP

		END;

	    !The class might already exist.
	    IF
		CH$EQL(.PAR[PAR_TEXT_LEN],.PAR[PAR_TEXT_PTR],
		    .CL_NM_LEN,.INP_IOB[IOB$A_STRING])
	    THEN
		BEGIN
		ERS(s_clsexists,CAT(('Class '),PAR[PAR_TEXT],
				(' already exists')));

		!Close and delete incomplete new file
		CLS_INP(NODELETE);
		CLS_OUT(DELETE);
		CANTRN();

		!Unlock the library
		DONLIB();

		RETURN K_SILENT_ERROR
		END;

	    !This isn't the right place, output the record and try again
	    OUTSTG(.INP_IOB[IOB$A_STRING],.INP_IOB[IOB$H_STRING],TRUE)

	    END

	END
    ELSE
	BEGIN
	!Nothing in file, start it
	OUTSTG(.PAR[PAR_TEXT_PTR],.PAR[PAR_TEXT_LEN],FALSE);

	!Put out the command comment also
	STG(' ',FALSE);
	OUTSTG(.USR_REM[DESC_PTR],.USR_REM[DESC_LEN],TRUE)
	END;

    !Write out the remainder of the file, if any
    IF
	.OPN_VAL EQL NORMAL
    THEN
	BEGIN
	UNTIL
	    $STEP_GET(IOB=INP_IOB,failure=0) EQL STEP$_EOF
	DO
	    BEGIN
	    IF CH$EQL(4,CH$PTR(UPLIT('*/C:')),4, .INP_IOB[IOB$A_STRING])
	    THEN
		BEGIN
		LOCAL
		    LEN,
		    PTR;
		LEN = .INP_IOB[IOB$H_STRING] - 4;
	  	PTR = CH$PLUS(.INP_IOB[IOB$A_STRING], 4);
		EXISTING_CRC = ASCHEX(PTR, LEN);
	   	found_crc = true;
		EXITLOOP ;
		END ;
	    
	    ! Calculate the CRC of this line
	    OLD_CRC = .OLD_CRC + 
			CRCCALC(.INP_IOB[IOB$H_STRING], .INP_IOB[IOB$A_STRING]);
	    OUTSTG(.INP_IOB[IOB$A_STRING],.INP_IOB[IOB$H_STRING],TRUE)
	    END;
	END;

    !Close the new class file
    CLS_OUT(NODELETE);

    ! write log record
    IF
	NOT LOGTRN(K_NORMAL_LOG,0,K_NULL)
    THEN
	BUG(CAT('Unable to write log record.  Error occurred in routine ',
		'CREATE')) ;

    !Mark the transaction end
    ENDTRN();

    !Now close and delete the old class file
    CLS_INP(DELETE);

    !Unlock the library
    DONLIB();

    !Tell the user all is OK
    sysmsg(s_creclass,CAT(('Class '),PAR[PAR_TEXT],(' created')),0);

    exits(s_creclass)

    END;				!End of CREATE

GLOBAL ROUTINE INSERT =

!++
! FUNCTIONAL DESCRIPTION:
!
!	INSERT/REMOVE dispatcher.  Transfer to the correct sub-processor.
!
! FORMAL PARAMETERS:
!
!	NONE.
!
! IMPLICIT INPUTS:
!
!	The arguments are passed through the command line and parsed
!	by COMAND.
!
! IMPLICIT OUTPUTS:
!
!	The class file is updated.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	The normal system values are returned.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	cls_nm_lgt,
	CMD,
	ELEM : DESC_BLOCK,		!Element name.
	GEN_QUAL : REF QUALIFIER_BLOCK,
	PAR : REF PARAMETER_BLOCK,
	PAR1 : REF PARAMETER_BLOCK,	!To class name parameter block.
	RESULT,				!Status from GETELM.
	ret_val,
	sup_elm,			!element superseded flag
	TREE : REF NODE_BLOCK,		!To generation reference node block
					!if INSERT, otherwise K_NULL.
	GET_STATUS,			!Status code from $XPO_GET of old
					!class file.
	STATUS;				!Status code from $XPO_GET of old
					!class file.

    !Common setup
    SETUP();

    !Parse the command
    IF
	NOT COMAND(CMD,SUB_CMD,QUAL,PAR,USR_REM)
    THEN
	RETURN K_SILENT_ERROR;

    !Lock the library
    IF
	NOT SAFLIB(K_UPDATE_LIB)
    THEN
	RETURN K_SILENT_SEVERE;

    !Pick up generation reference, if any
    GEN_LEN=0;
    IF
	.PAR[PAR_A_QUAL] NEQ K_NULL
    THEN
	BEGIN
	GEN_QUAL=.PAR[PAR_A_QUAL];
	IF
	    .GEN_QUAL[QUA_CODE] NEQ K_GEN_QUAL
	THEN
	    BUG(LIT('Unrecognized parameter qualifier (INSERT)'));
	GEN_PTR=CH$PTR(GEN_BUF);

	IF
	    .GEN_QUAL[QUA_A_TREE] EQL K_NULL
	THEN
	    !No plus operator exists
	    BEGIN
	    PLUS_OP=FALSE;
	    GEN_LEN=.GEN_QUAL[QUA_VALUE_LEN];
	    if
		.gen_len gtr gen_size
	    then
		begin
		donlib();
		ers(s_biggen,lit('Generation string is too long'));
		return k_silent_error
		end;
	    CH$MOVE(.GEN_LEN,.GEN_QUAL[QUA_VALUE_PTR],.GEN_PTR)
	    END
	ELSE
	    !Plus operator was seen
	    BEGIN
	    PLUS_OP=TRUE;
	    TREE=.GEN_QUAL[QUA_A_TREE];
	    GEN_LEN=.TREE[NOD_DESC_1_LEN];
	    if
		.gen_len gtr gen_size
	    then
		begin
		donlib();
		ers(s_biggen,lit('Generation string is too long'));
		return k_silent_error
		end;
	    CH$MOVE(.GEN_LEN,.TREE[NOD_DESC_1_PTR],.GEN_PTR)
	    END;

	!Check for user specified generation or class
	IF
	    .GEN_LEN NEQ 0
	THEN
	    BEGIN
	    IF
		CH$RCHAR(.GEN_PTR) GEQ %C'A'
	    THEN
		!This must be an class, try to find its value
		BEGIN

		!Make sure class exists
		IF
		    NOT SETATR(.GEN_LEN,.GEN_PTR)
		THEN
		    BEGIN
		    DONLIB();
		    ERS(s_noclassf,CAT(('Class '),(.GEN_LEN,.GEN_PTR),
					(' does not exist')));
		    RETURN K_SILENT_ERROR
		    END;

		IF
		    NOT GETATR(.PAR[PAR_TEXT_LEN],.PAR[PAR_TEXT_PTR],GEN_LEN,.GEN_PTR)
		THEN
		    BEGIN
		    DONLIB();
		    ERS(s_enotincls,CAT(('Element '),PAR[PAR_TEXT],
			(' does not exist in class '),(.GEN_LEN,.GEN_PTR)));
		    RETURN K_SILENT_ERROR
		    END

		END

	    END

	END;

    !Initialize qualifiers
    IFABS=FALSE;
    IFPRES=FALSE;
    SUPERS=FALSE;

    !Check qualifier list
    WHILE
	.QUAL NEQ K_NULL
    DO
	BEGIN

	!Process each individual qualifier
	SELECTONE .QUAL[QUA_CODE] OF
	    SET

	    [K_IF_ABSENT_QUAL]:
		IFABS=TRUE;

	    [K_IF_PRESENT_QUAL]:
		IFPRES=TRUE;

	    [K_SUPERSEDE_QUAL]:
		SUPERS=TRUE;

	    [K_NOSUPERSEDE_QUAL]:
		SUPERS=FALSE;
	    TES;

	QUAL=.QUAL[QUA_A_NEXT]

	END;

    !Point to the class name parameter
    PAR1=.PAR[PAR_A_NEXT];

    !Get the element name
    $STR_DESC_INIT(DESCRIPTOR = ELEM, STRING = PAR[PAR_TEXT]);

    !Open the old class file, error if no file exists
    IF
	OPNINP() EQL NOSUCHFILE
    THEN
	BEGIN
	ERS(s_noclassf,CAT(('Class '),PAR1[PAR_TEXT],(' does not exist')));
	DONLIB();
	RETURN K_SILENT_ERROR
	END;

    !Get the needed element information for INSERT
    IF
	.CMD EQL K_INSERT_COM
    THEN
	BEGIN
	!Retrieve the desired generation value
	FIRST_FIL=TRUE;
	RESULT=GETELM(.ELEM[DESC_PTR],.ELEM[DESC_LEN],RFILGEN);
	!Check return value for error
	IF
	    .RESULT EQL G_NO_ELM
	THEN
	    BEGIN
 	    local
 		d_log_nam : $str_desc(),
 		d_log_trn : $str_desc(),
 		log_trn_buf : vector[ch$allocation(log_nam_value_size)];
 	    $str_desc_init(descriptor = d_log_nam,
 			   string=(len_comma_ptr(lib)));
 	    $str_desc_init(descriptor = d_log_trn,
 			   string=(log_nam_value_size,ch$ptr(log_trn_buf)));
 	    trnlog(d_log_nam,d_log_trn);
	    ERS(s_noelem,CAT(('Element '),elem,
		(' does not exist in the CMS library '),d_log_trn));
	    END;

	IF
	    .RESULT EQL G_ERMSG
	THEN
	    BEGIN
	    CLS_INP(NODELETE);
	    DONLIB();
	    RETURN K_SILENT_ERROR
	    END;

	IF
	    .RESULT NEQ G_OK
	THEN
	    BUG(LIT('Error in element processing (INSERT)'))

	END;

    !Mark beginning of transaction
    BEGTRN();

    !Open the new class file
    OPNOUT();
 
    !Set up the CRC variales
    calc_crc =  0;
    existing_crc = 0;
    old_crc = 0;
    ignore_control = true;
    f_perf_crc = true;
    found_crc = false;
    !set up polynomial table
    crctable();

    !Find the desired class table, copying old file to new
    !file as the process advances
    REPEAT
	BEGIN

	STATUS = $STEP_GET(IOB=INP_IOB,failure=0);
        IF
	    .status eql step$_eof or
	    CH$EQL(4,CH$PTR(UPLIT('*/C:')),4, .INP_IOB[IOB$A_STRING])
	THEN
	    BEGIN
	    ERS(s_noclassf,CAT(('Class '),PAR1[PAR_TEXT],(' does not exist')));

	    !Delete incomplete new file
	    CLS_INP(NODELETE);
	    CLS_OUT(DELETE);
	    !Cancel the transaction
	    CANTRN();

	    DONLIB();
	    RETURN K_SILENT_ERROR
	    END;

      ! Calculate the CRC of this line
	    OLD_CRC = .OLD_CRC + 
			CRCCALC(.INP_IOB[IOB$H_STRING], .INP_IOB[IOB$A_STRING]);

	OUTSTG(.INP_IOB[IOB$A_STRING],.INP_IOB[IOB$H_STRING],TRUE);

	!Get length of class name only
	CLS_NM_LGT=0;
	UNTIL
	    CH$RCHAR(CH$PLUS(.INP_IOB[IOB$A_STRING],.CLS_NM_LGT)) EQL %C' ' OR
	    .CLS_NM_LGT EQL .INP_IOB[IOB$H_STRING]
	DO
	    CLS_NM_LGT=.CLS_NM_LGT+1;

	IF
	    CH$RCHAR(.INP_IOB[IOB$A_STRING]) NEQ %C' ' AND
	    CH$EQL(.PAR1[PAR_TEXT_LEN],.PAR1[PAR_TEXT_PTR],.CLS_NM_LGT,.INP_IOB[IOB$A_STRING])
	THEN
	    !We have located the correct table
	    EXITLOOP

	END;

    !Make sure the class we want is not read-only
%if VaxVms %then
    if
	.inp_iob[iob$h_string]-.cls_nm_lgt-1 gtr 11 and
	ch$eql(11,ch$ptr(uplit('/READ_ONLY ')),
		11,ch$plus(.inp_iob[iob$a_string],.cls_nm_lgt+1))
    then
	begin
	ers(s_classro,cat(('Class '),par1[par_text],(' is READ_ONLY')));
%fi
%if Tops20 %then
    if
	.inp_iob[iob$h_string]-.cls_nm_lgt-1 gtr 11 and
	ch$eql(11,ch$ptr(uplit('/READ-ONLY ')),
		11,ch$plus(.inp_iob[iob$a_string],.cls_nm_lgt+1))
    then
	begin
	ers(s_classro,cat(('Class '),par1[par_text],(' is READ-ONLY')));
%fi
	!delete incomplete new file
	cls_inp(nodelete);
	cls_out(delete);
	!cancel the transaction
	cantrn();
	donlib();
	return k_silent_error
	end;

    !Find the position where the new entry can be placed
    REPEAT
	BEGIN

	LOCAL
	    S_LEN,			!Length of element name in file.
	    S_PTR;			!Pointer to element name in file.

	GET_STATUS = $STEP_GET(IOB=INP_IOB,failure=0);
        IF .GET_STATUS NEQ step$_eof AND
	    CH$EQL(4,CH$PTR(UPLIT('*/C:')),4, .INP_IOB[IOB$A_STRING])
	THEN
	    BEGIN
	    LOCAL
	        LEN,
	        PTR;
	    LEN = .INP_IOB[IOB$H_STRING] - 4;
	    PTR = CH$PLUS(.INP_IOB[IOB$A_STRING], 4);
	    EXISTING_CRC = ASCHEX(PTR, LEN);
	    found_crc = true;
	    ! Fake an end of file
	    get_status = step$_eof;
	    END;

	!See if there are no entries in the requested class.
	IF
	    (IF
		.GET_STATUS EQL STEP$_EOF
	    THEN
		TRUE
	    ELSE
	        CH$RCHAR(.INP_IOB[IOB$A_STRING]) NEQ %C' '
	    )
	THEN
	    BEGIN
	    IF
		.CMD EQL K_INSERT_COM
	    THEN
		EXITLOOP
	    ELSE
		BEGIN
		IF
		    NOT .IFPRES
		THEN
		    BEGIN
		    ERS(s_enotincls,CAT('Element ',ELEM,
			' does not exist in class ',PAR1[PAR_TEXT]));

		    !Delete incomplete new file
		    CLS_INP(NODELETE);
		    CLS_OUT(DELETE);
		    !Cancel the transaction
		    CANTRN();
		    DONLIB();
		    RETURN K_SILENT_ERROR
		    END
		ELSE
		    !The user said that failure is allowed
		    BEGIN
		    CLS_INP(NODELETE);
		    CLS_OUT(DELETE);
		    !Cancel the transaction
		    CANTRN();
		    DONLIB();
		    RETURN K_SUCCESS
		    END;
		END
	    END;

	!Find the length of the element name
	S_LEN=0;
	S_PTR=CH$PLUS(.INP_IOB[IOB$A_STRING],1);
	UNTIL CH$RCHAR_A(S_PTR) EQL %C' ' DO S_LEN=.S_LEN+1;

	!See if the position is correct for an insertion
	IF
	    CH$LSS(LEN_COMMA_PTR(ELEM),.S_LEN,CH$PLUS(.INP_IOB[IOB$A_STRING],1))
	THEN
	    !The position is correct
	    BEGIN
	    IF
		.CMD EQL K_INSERT_COM
	    THEN
		EXITLOOP
	    ELSE
		BEGIN
		IF
		    NOT .IFPRES
		THEN
		    BEGIN
		    ERS(s_enotincls,CAT('Element ',ELEM,' does not exist ',
				'in class ',PAR1[PAR_TEXT]));

		    !Delete incomplete new file
		    CLS_INP(NODELETE);
		    CLS_OUT(DELETE);
		    !Cancel the transaction
		    CANTRN();

		    DONLIB();
		    RETURN K_SILENT_ERROR
		    END
		ELSE
		    !The user said that failure is allowed
		    BEGIN
		    CLS_INP(NODELETE);
		    CLS_OUT(DELETE);
		    !Cancel the transaction
		    CANTRN();
		    DONLIB();
		    RETURN K_SUCCESS
		    END
		END
	    END;

	!assume entry won't be superseded
	sup_elm=false;

	!See if there is an entry that matches exactly
	IF
	    CH$EQL(LEN_COMMA_PTR(ELEM),.S_LEN,CH$PLUS(.INP_IOB[IOB$A_STRING],1))
	THEN
	    !Entry already exists
	    BEGIN

	    IF
		.CMD EQL K_INSERT_COM
	    THEN
		BEGIN
		IF
		    .IFABS
		THEN
		    BEGIN
		    CLS_INP(NODELETE);
		    CLS_OUT(DELETE);
		    !Cancel the transaction
		    CANTRN();
		    DONLIB();
		    RETURN K_SUCCESS
		    END;

		IF
		    NOT .SUPERS
		THEN
		    BEGIN
		    ERS(s_elemexist,CAT('Element ',ELEM,' already exists ',
					'in class ',PAR1[PAR_TEXT]));

		    !Delete incomplete new file
		    CLS_INP(NODELETE);
		    CLS_OUT(DELETE);
		    !Cancel the transaction
		    CANTRN();

		    DONLIB();
		    RETURN K_SILENT_ERROR
		    END
		ELSE
		    !Supersede the old entry
		    BEGIN
		    ! Calculate the CRC of this line
	    	    OLD_CRC = .OLD_CRC + 
			CRCCALC(.INP_IOB[IOB$H_STRING], .INP_IOB[IOB$A_STRING]);
		    GET_STATUS=$step_get(IOB=INP_IOB,failure=0);
		    !entry is being superseded
		    sup_elm=true;
		    EXITLOOP
		    END
		END
	    ELSE
		!Skip this entry
		BEGIN
		! Calculate the CRC of this line
	    	OLD_CRC = .OLD_CRC + 
			CRCCALC(.INP_IOB[IOB$H_STRING], .INP_IOB[IOB$A_STRING]);
		GET_STATUS=$STEP_GET(IOB=INP_IOB,failure=0);
		EXITLOOP
		END
	    END;

      ! Calculate the CRC of this line
	    OLD_CRC = .OLD_CRC + 
			CRCCALC(.INP_IOB[IOB$H_STRING], .INP_IOB[IOB$A_STRING]);
	!Write out the line and continue
	OUTSTG(.INP_IOB[IOB$A_STRING],.INP_IOB[IOB$H_STRING],TRUE)

	END;

    IF
	.CMD EQL K_INSERT_COM
    THEN
	!Format and place the new class in the table
	BEGIN

	!don't allow supersede if there isn't anything to supersede
	if
	    not .sup_elm and
	    .supers
	then
	    begin
	    ers(s_enotincls,cat('Element ',elem,' does not exist in class ',
				par1[par_text]));
	    !Delete incomplete new file
	    CLS_INP(NODELETE);
	    CLS_OUT(DELETE);
	    !Cancel the transaction
	    CANTRN();
	    DONLIB();
	    RETURN K_SILENT_ERROR
	    end;

	STG(' ',FALSE);
	!Output element name
	OUTSTG(.ELEM[DESC_PTR],.ELEM[DESC_LEN],FALSE);
	STG(' ',FALSE);
	!Output generation obtained by RFILGEN
	OUTSTG(.GEN_PTR,.GEN_LEN,TRUE)
	END;

    IF
	.GET_STATUS NEQ STEP$_EOF
    THEN
	BEGIN
	IF CH$EQL(4,CH$PTR(UPLIT('*/C:')),4, .INP_IOB[IOB$A_STRING])
        THEN
	    BEGIN
	    LOCAL
	        LEN,
	        PTR;
	    LEN = .INP_IOB[IOB$H_STRING] - 4;
	    PTR = CH$PLUS(.INP_IOB[IOB$A_STRING], 4);
	    EXISTING_CRC = ASCHEX(PTR, LEN);
	    found_crc = true;
	    end
	else
	    begin
      	    ! Calculate the CRC of this line
	    OLD_CRC = .OLD_CRC + 
	        CRCCALC(.INP_IOB[IOB$H_STRING], .INP_IOB[IOB$A_STRING]);
	    OUTSTG(.INP_IOB[IOB$A_STRING],.INP_IOB[IOB$H_STRING],TRUE);
	    end;
	END;

    !Copy the table and the rest of the old class file to the
    !new file
    UNTIL
	$step_get(IOB=INP_IOB,failure=0) EQL STEP$_EOF
    DO
	BEGIN
	IF CH$EQL(4,CH$PTR(UPLIT('*/C:')),4, .INP_IOB[IOB$A_STRING])
	    THEN
	    	BEGIN
	    	LOCAL
	            LEN,
	            PTR;
	        LEN = .INP_IOB[IOB$H_STRING] - 4;
	    	PTR = CH$PLUS(.INP_IOB[IOB$A_STRING], 4);
	    	EXISTING_CRC = ASCHEX(PTR, LEN);
	    	found_crc = true;
		EXITLOOP;
	        END;

      ! Calculate the CRC of this line
	OLD_CRC = .OLD_CRC + 
	    CRCCALC(.INP_IOB[IOB$H_STRING], .INP_IOB[IOB$A_STRING]);

	OUTSTG(.INP_IOB[IOB$A_STRING],.INP_IOB[IOB$H_STRING],TRUE);
	END;
    !Close the files
    CLS_OUT(NODELETE);

    ! log transaction
    IF
	.CMD EQL K_INSERT_COM
    THEN
	BEGIN	! log INSERT command

	IF
	    NOT LOGTRN(K_NORMAL_LOG,.GEN_LEN,.GEN_PTR)
	THEN
	    BUG(CAT('Unable to write log record (INSERT)'));

	END 	! log INSERT command
    ELSE
	BEGIN	! log remove command

	IF
	    NOT LOGTRN(K_NORMAL_LOG,0,K_NULL)
	THEN
	    BUG(CAT('Unable to write log record (INSERT)'));

	END ;	! log remove command


    !Mark the end of the transaction
    ENDTRN();

    CLS_INP(DELETE);

    IF
	.CMD EQL K_INSERT_COM
    THEN
	begin
	ret_val=s_insclass;
	sysmsg(s_insclass,CAT('Element ',ELEM,', Generation ',(.GEN_LEN,.GEN_PTR),
	    ' inserted in class ',PAR1[PAR_TEXT]),0)
	end
    ELSE
	begin
	ret_val=s_remclass;
	sysmsg(s_remclass,
	    CAT('Element ',ELEM,' removed from class ',PAR1[PAR_TEXT]),0);
	end;

    DONLIB();

    exits(.ret_val)

    END;				!End of INSERT

ROUTINE CLS_INP (DEL_FLG) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Close and optionally delete the specified file
!
! FORMAL PARAMETERS:
!
!	NONE.
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	D_FIL_SPC: DESC_BLOCK ;

    IF
	.INP_OPN
    THEN
	BEGIN
	IF
	    .DEL_FLG EQL DELETE
	THEN
	    BEGIN
	    ! Check checksums
	    IF NOT .FOUND_CRC
	    THEN
		SYSMSG(s_nocksum,CAT(%STRING(LIB,ATF),' has no checksum'),0)
	    ELSE
	        IF .EXISTING_CRC NEQ .OLD_CRC 
	        THEN
		    SYSMSG(s_invcksum,CAT('Class file has an invalid  ',
				'checksum'),0);

	    $STEP_CLOSE(IOB=INP_IOB) ;
	    $STR_DESC_INIT(DESCRIPTOR=D_FIL_SPC,STRING=(%STRING(LIB,ATF))) ;
	    DELVRS(FILVRS,.D_FIL_SPC[DESC_LEN],.D_FIL_SPC[DESC_PTR]) ;
	    END
	ELSE
	    $STEP_CLOSE(IOB=INP_IOB)
	END

    END;				!End of CLS_INP

ROUTINE CLS_OUT (DEL_FLG) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Close and optionally delete the specified file
!
! FORMAL PARAMETERS:
!
!	NONE.
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    IF
	.OUT_OPN
    THEN
	BEGIN
	IF
	    .DEL_FLG EQL DELETE
	THEN
	    BEGIN
	    $STEP_CLOSE(IOB=OUT_IOB,OPTIONS=REMEMBER);
	    $STEP_DELETE(IOB=OUT_IOB)
	    END
	ELSE
	    BEGIN
	    LOCAL 
	     	LEN,
		NUM_BUF: VECTOR[CH$ALLOCATION(MAX_NUM_SIZE+5)],
		PTR;
	     ! Build control line
            PTR = CH$MOVE(4,CH$PTR(UPLIT('*/C:')),CH$PTR(NUM_BUF)) ;
	    LEN = HEXASZ(.CALC_CRC, .PTR, 8) ;
	    PTR = CH$PLUS(.PTR, .LEN);
	    CH$WCHAR(%C' ', .PTR);
	    LEN = .LEN + 5 ;
	    $STEP_PUT(IOB = OUT_IOB, STRING=(.LEN,CH$PTR(NUM_BUF)),
		     FAILURE = 0); 
	    $STEP_CLOSE(IOB=OUT_IOB)
	    END
	END

    END;				!End of CLS_OUT

ROUTINE OPNINP =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Open input file
!
! FORMAL PARAMETERS:
!
!	NONE.
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	 0 - normal
!	+1 - no such file
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	OPN_FLG;

    OPN_FLG=$STEP_OPEN(IOB=INP_IOB,FILE_SPEC=(%STRING(LIB,ATF)),OPTIONS=INPUT,FAILURE=0);

    IF
	.OPN_FLG EQL STEP$_NORMAL
    THEN
	BEGIN
	INP_OPN=TRUE;
	RETURN NORMAL
	END;

    IF
	.OPN_FLG EQL STEP$_NO_FILE
    THEN
	RETURN NOSUCHFILE;

    BUGXPO(.OPN_FLG,CAT(('Cannot open '),(%STRING(LIB,ATF))))

    END;				!End of OPNINP

ROUTINE OPNOUT : NOVALUE =

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

    BEGIN

    LOCAL
	OPN_FLG;

    OPN_FLG=$STEP_OPEN(IOB=OUT_IOB,FILE_SPEC=(%STRING(LIB,ATF)),OPTIONS=OUTPUT,FAILURE=0);

    IF
	not .OPN_FLG
    THEN
	BUGXPO(.OPN_FLG,CAT(('Output file failure on'),(%STRING(LIB,ATF))));

    !Set protection, etc.
    TRNFIL(OUT_IOB);

    OUT_OPN=TRUE

    END;				!End of OPNOUT

ROUTINE RFILGEN (FIL_NAM_LEN,FIL_NAM_STR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Retrieve the desired generation from the specified element.
!
! FORMAL PARAMETERS:
!
!	FIL_NAM_LEN - length of file name to be read
!	FIL_NAM_STR - pointer to file name
!
! IMPLICIT INPUTS:
!
!	FIRST_FIL means that this is the first file of the element.
!
!	GEN_LEN and GEN_PTR indicate an explicit generation to be
!	searched for, provided GEN_LEN is non-zero.  PLUS_OP means that
!	the latest in that line is to be found.
!
!	The header record from the specified file is scanned.
!
! IMPLICIT OUTPUTS:
!
!	FIRST_FIL is set to FALSE if it is TRUE.
!
!	The generation to be used is stored in GEN_BUF, and GEN_LEN and
!	GEN_PTR are set accordingly.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	FIL : VECTOR[CH$ALLOCATION(EXTENDED_FILE_SPEC)],
	FIL_PTR,
	FIL_SIZ,
	STS,
	$io_BLOCK_DECL(WRK);

    !Make this routine a no-op for all except the first call
    IF
	NOT .FIRST_FIL
    THEN
	RETURN G_OK;

    FIRST_FIL=FALSE;

    !Initialize IOB
    $IO_BLOCK_INIT(WRK);

    !Make the composite file name
    FIL_PTR=CH$PTR(FIL);
    FIL_PTR=CH$MOVE(%CHARCOUNT(LIB),CH$PTR(UPLIT(LIB)),.FIL_PTR);
    FIL_PTR=CH$MOVE(.FIL_NAM_LEN,.FIL_NAM_STR,.FIL_PTR);
    FIL_SIZ=CH$DIFF(.FIL_PTR,CH$PTR(FIL));

    !Open the file in the library to retrieve the generation list
    STS=$STEP_OPEN(IOB=WRK_IOB,FILE_SPEC=(.FIL_SIZ,CH$PTR(FIL)),OPTIONS=INPUT,FAILURE=0);
    IF
	NOT .STS
    THEN
	BADXPO(.STS,CAT(('Cannot open file '),(.FIL_SIZ,CH$PTR(FIL))));

    !Do the necessary checking in the generation list
    !Find a header record on the main line of descent
    REPEAT
	BEGIN

	LOCAL
	    GENERATION,
	    S_L_PTR,
	    TG_BUF : VECTOR[CH$ALLOCATION(GEN_SIZE)],
	    TG_LGT;

	!Get a header record
	IF
	    $STEP_GET(IOB=WRK_IOB,failure=0) EQL STEP$_EOF
	THEN
	    BADLIB(LIT('Illegal Library file format '));

	S_L_PTR=.WRK_IOB[IOB$A_STRING];

	!Look for a required header record
	IF
	    CH$RCHAR_A(S_L_PTR) NEQ %C'+'
	THEN
	    !No generations in file yet, this isn't allowed
	    BADLIB(LIT('Illegal Library file format '))
	ELSE
	    !Pick up generation data
	    BEGIN

	    GENERATION=CH$PTR(TG_BUF);
	    TG_LGT=GET_LXM(S_L_PTR,%C' ',.WRK_IOB[IOB$H_STRING]-1,GENERATION);

	    if
		.tg_lgt gtr gen_size
	    then
		badlib(cat('Generation value too long in library file ',
				(.fil_siz,ch$ptr(fil))));

	    !Blank terminate the generation
	    CH$WCHAR_A(%C' ',GENERATION);

	    IF
		.TG_LGT LEQ 0
	    THEN
		BADLIB(LIT('Illegal header record'));

	    IF
		.GEN_LEN NEQ 0
	    THEN
		!User specified which generation
		!See if it matches a legal generation
		BEGIN
		!Did the user ask for the latest generation of a series?
		IF
		    .PLUS_OP AND
		    dirdes(.GEN_LEN,.GEN_PTR,.TG_LGT,CH$PTR(TG_BUF))
		THEN
		    !yes, pick up the first one that matches
		    BEGIN
		    CH$MOVE(.TG_LGT,CH$PTR(TG_BUF),CH$PTR(GEN_BUF));
		    GEN_LEN=.TG_LGT;
		    GEN_PTR=CH$PTR(GEN_BUF);
		    EXITLOOP
		    END
		ELSE
		!Did he ask for a specific generation?
		IF
		    CH$EQL(.GEN_LEN,.GEN_PTR,.TG_LGT,CH$PTR(TG_BUF))
		THEN
		    EXITLOOP
		END

	    END;

	!See if this entry is on the main line
	! and the user did not specify which generation
	IF
	    .GEN_LEN EQL 0
	THEN
	    BEGIN

	    LOCAL
		CHAR,
		PTR;

	    PTR=CH$PTR(TG_BUF);

	    !Skip all leading numerics
	    REPEAT
		BEGIN

		CHAR=CH$RCHAR_A(PTR);

		IF
		    .CHAR LSS %C'0' OR
		    .CHAR GTR %C'9'
		THEN
		    EXITLOOP

		END;

	    !If the character in CHAR is a blank we are on the main line.
	    IF
		.CHAR EQL %C' '
	    THEN
		BEGIN
		CH$MOVE(.TG_LGT,CH$PTR(TG_BUF),CH$PTR(GEN_BUF));
		GEN_LEN=.TG_LGT;
		GEN_PTR=CH$PTR(GEN_BUF);
		EXITLOOP
		END

	    END;

	!See if there are no more header records
	IF
	    CH$EQL(2,CH$PTR(UPLIT('1 ')),.TG_LGT+1,CH$PTR(TG_BUF))
	THEN
	    BEGIN
	    IF
		.GEN_LEN NEQ 0
	    THEN
		!No such generation
		BEGIN
		ERS(s_nogen,CAT('Generation ',(.GEN_LEN,.GEN_PTR),
				 ' does not exist'));
		$STEP_CLOSE(IOB=WRK_IOB);
		RETURN G_ERMSG
		END;

	    BUG(LIT('Failure in RFILGEN'))
	    END

	END;

    !Now close the file
    $STEP_CLOSE(IOB=WRK_IOB);

    G_OK

    END;				!End of RFILGEN

ROUTINE SETUP : NOVALUE =

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

    BEGIN

    !Keep track of what is open or not
    INP_OPN=FALSE;
    OUT_OPN=FALSE;

    !Initialize the output routines
    OUTINI(OUT_IOB);

    END;				!End of SETUP

END				!End of Module CREATE
ELUDOM