Google
 

Trailing-Edge - PDP-10 Archives - TOPS-20_V6.1_DECnetSrc_7-23-85 - mcb/utilities/lbrsys.b36
There is 1 other file named lbrsys.b36 in the archive. Click here to see a list.
MODULE LBRSYS (					!System dependant functions
		IDENT = '001040',
		LANGUAGE (BLISS36)
		) =
BEGIN
!
!
!
!                    COPYRIGHT (c) 1980, 1981, 1982
!                    DIGITAL EQUIPMENT CORPORATION
!                        Maynard, Massachusetts
!
!     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: LBR20 - Librarian Utility
!
! ABSTRACT:
!
!
! This module contains routines to do system dependant functions.
! This includes I/O, command processing, and information access.
!
!
! ENVIRONMENT: TOPS20
!
! AUTHOR: ALAN D. PECKHAM, CREATION DATE: 19-MAY-80
!
! MODIFIED BY:
!
!	Alan D. Peckham, : VERSION 01
! 01	- Restructure file positioning to refer to block/offset.
!	  Add "get file position" function (FILPOS).
! 02	- Add COMPRESS function to command parser.
! 03    - Add FAST switch.
! 04    - Add support for RG (replace global) switch.
!--

!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
    ALLOCATE_FILBLK,				!Allocate a file block.
    ASSOCIATE,					!Associate filename with control block.
    CLOSE : NOVALUE,				!Close a file.
    CMD,					!Get a user command.
    FILDT,					!Return the file creation date in ASCII.
    FILNM,					!Convert a file name to ASCII.
    FILPOS,					!Get the current file position.
    GETFIL,					!Get data from a file opened for input.
    GETTIM : NOVALUE,				!Get the current time.
    INIT_PARSE : NOVALUE,			!Initialize for command parse.
    OPEN,					!Open a file.
    POSFIL : NOVALUE,				!Set the current position within the file.
    PUTFIL : NOVALUE,				!Put a string to a file opened for output.
    RELEASE_FILBLK : NOVALUE;			!Release a file block.

!
! INCLUDE FILES
!

LIBRARY 'LBRCOM';				!LBR common definitions.

REQUIRE 'BLI:MONSYM.R36';			!Define the TOPS20 monitor symbols.

BUILTIN
    JSYS;					!Define the JSYS machine specific function.

!
! MACROS:
!

MACRO
    REGISTERS [ACN] =
	REGISTER %NAME('AC',ACN) = ACN %,
    DUMP_FLAG =
	MY_FLAGS [0] %,
    BASE_FLAG =
	MY_FLAGS [1] %,
    CMD_FUNCTION (function, link, cmd_data, default, help, mask) =
	VECTOR [%IF %NULL (mask) %THEN 4 %ELSE 5 %FI]
	INITIAL ( FLD (function, CM_FNC)
	    %IF NOT %NULL (link)
		%THEN +FLD (link,CM_LST)
		%FI
	    %IF NOT %NULL (help)
		%THEN +CM_HPP+CM_SDH
		%FI
	    %IF NOT %NULL (mask)
		%THEN +CM_BRK
		%FI
	    %IF NOT %NULL (default)
		%THEN +CM_DPP
		%FI,
	    %IF NOT %NULL (cmd_data)
		%THEN cmd_data
		%ELSE 0
		%FI,
	    %IF %NULL (help)
		%THEN 0
		%ELSE CH$ASCIZ (help)
		%FI,
	    %IF %NULL (default)
		%THEN 0
		%ELSE default
		%FI
	    %IF NOT %NULL (mask)
		%THEN ,mask
		%FI
	    ) %,
    CMD_DATA_STRING (STRING) =
	CH$ASCIZ(STRING) %,
    CMD_DATA_KEYS (TABLE) =
	UPLIT( KEY_COUNT(%REMOVE(TABLE)), KEY_STR_SET(%REMOVE(TABLE)) ) %,
    KEY_COUNT (ARGS) =
	(%LENGTH)^18+%LENGTH %,
    KEY_STR_SET [PAIR] =
	KEY( %REMOVE(PAIR) ) %,
    KEY (TEXT) [VALUE] =
	UPLIT(%ASCIZ %STRING(TEXT))^18+VALUE %,
    CMD_DATA_MASK (chars) =
	UPLIT (0 + MASK_WORD (0, 31, %REMOVE (chars)) XOR -1,
	    0 + MASK_WORD (32, 63, %REMOVE (chars)) XOR -1,
	    0 + MASK_WORD (64, 95, %REMOVE (chars)) XOR -1,
	    0 + MASK_WORD (96, 127, %REMOVE (chars)) XOR -1) %,
    MASK_WORD (low_char, high_char) [char] =
	%IF ((%C char GEQ low_char) AND (%C char LEQ high_char))
	    %THEN 1^(35 + low_char - %C char)
	    %ELSE 0
	    %FI %,
    CMD_COMMA (LINK) =
	CMD_FUNCTION($CMCMA,LINK) %,
    CMD_CONFIRM (LINK) =
	CMD_FUNCTION($CMCFM,LINK) %,
    CMD_DIRECTORY (LINK, HELP) =
	CMD_FUNCTION($CMDIR,LINK,,,HELP) %,
    CMD_FILE (LINK, DEFAULT, HELP) =
	CMD_FUNCTION($CMFIL,LINK,,DEFAULT,HELP) %,
    CMD_FIELD (LINK) =
	CMD_FUNCTION($CMFLD,LINK) %,
    CMD_INITIALIZE =
	CMD_FUNCTION($CMINI) %,
    CMD_INPUT_FILE (LINK, STRING, DEFAULT, HELP) =
	CMD_FUNCTION($CMIFI,LINK,STRING,DEFAULT,HELP) %,
    CMD_KEYWORDS (LINK, TABLE, DEFAULT, HELP) =
	CMD_FUNCTION($CMKEY,LINK,CMD_DATA_KEYS(TABLE),DEFAULT,HELP) %,
    CMD_NOISE (LINK, STRING, DEFAULT, HELP) =
	CMD_FUNCTION($CMNOI,LINK,CMD_DATA_STRING(STRING),DEFAULT,HELP) %,
    CMD_NUMBER (LINK, RADIX, DEFAULT, HELP) =
	CMD_FUNCTION($CMNUM,LINK,RADIX,DEFAULT,HELP) %,
    CMD_QUOTED_STR (LINK, DEFAULT, HELP) =
	CMD_FUNCTION($CMQST, LINK,, DEFAULT, HELP) %,
    CMD_RAD50 (LINK, DEFAULT, HELP) =
	CMD_FUNCTION ($CMFLD,LINK,,DEFAULT,HELP,
	    CMD_DATA_MASK ((%EXPLODE ('ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789$.')))) %,
    CMD_STRING (LINK, STRING, DEFAULT, HELP) =
	CMD_FUNCTION($CMTOK,LINK,CMD_DATA_STRING(STRING),DEFAULT,HELP) %,
    CMD_SWITCHES (LINK, TABLE, DEFAULT, HELP) =
	CMD_FUNCTION($CMSWI,LINK,CMD_DATA_KEYS(TABLE),DEFAULT,HELP) %,
    CMD_TOKEN (LINK, STRING, DEFAULT, HELP) =
	CMD_FUNCTION($CMTOK,LINK,CMD_DATA_STRING(STRING),DEFAULT,HELP) %;

MACRO
    BIT_NUMBER (p1, p2, p3, p4) =
	p2 %;

!
! EQUATED SYMBOLS:
!

MACRO
    F_JFN =
	0, 0, 18, 0 %;

LITERAL
    F_LENGTH = 1;

LITERAL
    CMD_ATOM_MAX = 40,				!Maximum atom length.
    CMD_INPUT_MAX = 133,			!Maximum command length.
    JFN_NAME_MAX = 40,				!Maximum file name length.
    SWT_CMD = %O'770000',
    SWT_MIN = 0,
    SWT_FLAG_OFF = 0,
    SWT_FLAG_ON = 1,
    SWT_LIST = 2,
    SWT_CREATE = 3,
    SWT_DE = 4,
    SWT_DG = 5,
    SWT_COMPRESS = 6,
    SWT_MAX = 6,
    SWT_VAL = %O'007777';

BIND
    FLAG_OFF = FLD (SWT_FLAG_OFF, SWT_CMD),
    FLAG_ON = FLD (SWT_FLAG_ON, SWT_CMD),
    S_LIST = FLD (SWT_LIST, SWT_CMD),
    S_COMPRESS = FLD (SWT_COMPRESS, SWT_CMD),
    S_CREATE = FLD (SWT_CREATE, SWT_CMD),
    S_DE = FLD (SWT_DE, SWT_CMD),
    S_DG = FLD (SWT_DG, SWT_CMD);

!
! OWN STORAGE:
!

OWN
    CMD_ATOM : CH$SEQUENCE (CMD_ATOM_MAX),
    CMD_INPUT : CH$SEQUENCE (CMD_INPUT_MAX + %CHARCOUNT (PROMPT, '>')) INITIAL (%STRING (PROMPT, '>')),
    CMD_JFN : VECTOR [14] INITIAL ( REP 14 OF (0)),
    CMD_STATE_BLK : VECTOR [10] INITIAL (CM_RAI, $PRIIN^18 + $PRIOU,
	    CH$PTR(CMD_INPUT,0),CH$PTR(CMD_INPUT,%CHARCOUNT (PROMPT, '>')),
	    CH$PTR(CMD_INPUT, %CHARCOUNT (PROMPT, '>')),CMD_INPUT_MAX-%CHARCOUNT (PROMPT, '>'),0,
	    CH$PTR(CMD_ATOM,0),CMD_ATOM_MAX,
	    CMD_JFN),
    DEF_LIB_FILE : CH$SEQUENCE (JFN_NAME_MAX) INITIAL ( REP CH$ALLOCATION (JFN_NAME_MAX) OF (0)),
    DEF_LST_NAME : CH$SEQUENCE (JFN_NAME_MAX) INITIAL ( REP CH$ALLOCATION (JFN_NAME_MAX) OF (0)),
    FILBLK : BLOCKVECTOR [LBR_MAX_FILES, F_LENGTH] INITIAL (REP LBR_MAX_FILES*F_LENGTH OF (0)),
    FUNCTION,					!Current function
    MY_FLAGS : BITVECTOR [16],
    RSCAN_FLAG;

!
! Command parser tables
!

FORWARD
    CO2 : VECTOR [4],
    CO3 : VECTOR [4],
    CO4 : VECTOR [4],
    CO5 : VECTOR [4],
    CO6 : VECTOR [4],
    CO7 : VECTOR [4],
    CR2 : VECTOR [4],
    CR3 : VECTOR [4],
    CR4 : VECTOR [4],
    CR5 : VECTOR [4],
    CR6 : VECTOR [4],
    DE2 : VECTOR [5],
    DG2 : VECTOR [5],
    EOL : VECTOR [4],
    FI2 : VECTOR [4],
    FI3 : VECTOR [4],
    FI4 : VECTOR [4],
    FN1 : VECTOR [4],
    FN2 : VECTOR [4],
    FN3 : VECTOR [4],
    FN4 : VECTOR [4],
    LI2 : VECTOR [4];

OWN
    FN1 : CMD_INITIALIZE,
    FN2 : CMD_FILE (FN3, CH$PTR (DEF_LIB_FILE), 'library file'),
    FN3 : CMD_SWITCHES (EOL, (
	    ('EXIT', M_EXIT + FLAG_ON), 	!
	    ('HELP', M_HELP + FLAG_ON),		!
	    ('VERSION', M_VERSION + FLAG_ON)	!
	    )),
    FN4 : CMD_SWITCHES (FI2, (
	    ('COMPRESS:', S_COMPRESS),		!
	    ('CREATE:', S_CREATE),		!
	    ('DELETE:', S_DE),			!
	    ('DG:', S_DG),			!
	    ('EPT', M_NOEPT + FLAG_OFF),	!
	    ('EXIT', M_EXIT + FLAG_ON), 	!
            ('FAST', M_FAST + FLAG_ON),         !
	    ('FULL', M_LIST_HEADERS + FLAG_ON),	!
	    ('HELP', M_HELP + FLAG_ON),		!
	    ('INSERT', M_REPLACE + FLAG_OFF),	!
	    ('LE', M_LIST_ENTRIES + FLAG_ON),	!
	    ('LISTING:', S_LIST), 		!
	    ('NOEPT', M_NOEPT + FLAG_ON),	!
            ('NORG', M_RG + FLAG_OFF),          !
	    ('NOSS', M_SS + FLAG_OFF),		!
	    ('REPLACE', M_REPLACE + FLAG_ON),	!
            ('RG', M_RG + FLAG_ON),             !
	    ('SS', M_SS + FLAG_ON),		!
	    ('VERSION', M_VERSION + FLAG_ON),	!
	    ('WIDE', M_WIDE + FLAG_ON)		!
	    )),
    FI2 : CMD_FILE (EOL,, 'object file'),
    FI3 : CMD_SWITCHES (FI4, (
	    ('EPT', BIT_NUMBER (F_NOEPT) + FLAG_OFF),	!
	    ('INSERT', BIT_NUMBER (F_REPLACE) + FLAG_OFF), !
	    ('NOEPT', BIT_NUMBER (F_NOEPT) + FLAG_ON),	!
            ('NORG', BIT_NUMBER (F_RG) + FLAG_OFF),     !
	    ('NOSS', BIT_NUMBER (F_SS) + FLAG_OFF),	!
	    ('REPLACE', BIT_NUMBER (F_REPLACE) + FLAG_ON), !
            ('RG', BIT_NUMBER (F_RG) + FLAG_ON),        !
	    ('SS', BIT_NUMBER (F_SS) + FLAG_ON)		!
	    )),
    FI4 : CMD_COMMA (EOL),
    LI2 : CMD_FILE (, CH$ASCIZ ('TTY:'), 'listing file'),
    CO2 : CMD_NUMBER (, 10,, 'size of file in blocks'),
    CO3 : CMD_TOKEN (CO7, ':', CH$ASCIZ (':')),
    CO4 : CMD_NUMBER (, 10,, 'maximum entry points'),
    CO5 : CMD_TOKEN (CO7, ':', CH$ASCIZ (':')),
    CO6 : CMD_NUMBER (, 10,, 'maximum modules'),
    CO7 : CMD_FILE (EOL,, 'library file'),
    CR2 : CMD_NUMBER (, 10, CH$ASCIZ ('100'), 'size of file in blocks'),
    CR3 : CMD_TOKEN (FN4, ':', CH$ASCIZ (':')),
    CR4 : CMD_NUMBER (, 10, CH$ASCIZ ('512'), 'maximum entry points'),
    CR5 : CMD_TOKEN (FN4, ':', CH$ASCIZ (':')),
    CR6 : CMD_NUMBER (, 10, CH$ASCIZ ('256'), 'maximum modules'),
    DE2 : CMD_RAD50 (,, 'module name'),
    DG2 : CMD_RAD50 (,, 'entry point'),
    EOL : CMD_CONFIRM ();

!
! EXTERNAL REFERENCES:
!

EXTERNAL ROUTINE
    $CAT5;					!Convert ASCII to RAD50.

EXTERNAL
    FLAGS : BITVECTOR [M_MAX_BITS],
    GBLNAM : BLOCKVECTOR [LBR_MAX_GLOBAL_DELETES, 2],
    GBLNUM,
    LIBBLK,					!Dump file block.
    LSTBLK,					!Listing file block.
    MODNAM : BLOCKVECTOR [LBR_MAX_MODULE_DELETES, 2],
    MODNUM,
    NUMEPT,
    NUMMNT,
    OBJBLK : VECTOR [LBR_MAX_OBJ],
    OBJFLG : BLOCKVECTOR [LBR_MAX_OBJ, F_MAX],
    OBJNUM,
    SIZFIL,
    TTYBLK;					!Terminal block.
ROUTINE ALLOCATE_FILBLK (FILPTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    IF ..FILPTR EQL 0
    THEN
	BEGIN

	INCR INDEX FROM 0 TO LBR_MAX_FILES - 1 DO

	    IF .FILBLK [.INDEX, F_JFN] EQL 0
	    THEN
		BEGIN
		.FILPTR = FILBLK [.INDEX, F_JFN];
		RETURN TRUE
		END;

	FALSE
	END
    ELSE
	TRUE;				!OF ALLOCATE_FILBLK
GLOBAL ROUTINE ASSOCIATE (FILPTR, FILE_NAME_PTR, EXT_PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    OWN
	JFN_BLOCK : VECTOR [9],
	JFN_DIRECTORY : CH$SEQUENCE (40);

    JFN_BLOCK [$GJGEN] = GJ_OLD + $GJDEF;
    JFN_BLOCK [$GJSRC] = $NULIO^18 + $NULIO;
    JFN_BLOCK [$GJDEV] = 0;
    JFN_BLOCK [$GJDIR] = 0;
    JFN_BLOCK [$GJNAM] = 0;
    JFN_BLOCK [$GJEXT] = .EXT_PTR;
    JFN_BLOCK [$GJPRO] = 0;
    JFN_BLOCK [$GJACT] = 0;
    JFN_BLOCK [$GJJFN] = 0;

    IF NOT ALLOCATE_FILBLK (.FILPTR) THEN RETURN FALSE;

    BEGIN
    REGISTERS (1, 2, 3);
    AC2 = .FILE_NAME_PTR;
    AC1 = JFN_BLOCK;
    AC3 = JSYS (1, GTJFN, AC1, AC2);

    IF .AC3 NEQ 1 THEN RETURN FALSE;

    BLOCK [..FILPTR, F_JFN] = .AC1<0, 18>;
    END;
    TRUE
    END;					!OF ASSOCIATE
GLOBAL ROUTINE CLOSE (FILPTR) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    IF ..FILPTR NEQ 0
    THEN
	BEGIN
	BEGIN
	REGISTERS (1);
	AC1 = .BLOCK [..FILPTR, F_JFN];

	IF JSYS (1, CLOSF, AC1) NEQ 1
	THEN
	    BEGIN
	    AC1 = .BLOCK [..FILPTR, F_JFN];
	    JSYS (1, RLJFN, AC1);
	    END;

	END;
	BLOCK [..FILPTR, F_JFN] = 0;
	.FILPTR = 0;
	END;					!OF CLOSE
GLOBAL ROUTINE CMD =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    LOCAL
	COMND_FLAGS,				!Returned flags from the COMND JSYS.
	COMND_USED,
	COMND_DATA;

    BIND
	LIB_FILE_TYPE = CH$ASCIZ ('OLB'),
	LST_FILE_TYPE = CH$ASCIZ ('LST'),
	OBJ_FILE_TYPE = CH$ASCIZ ('OBJ');

    !+
    ! Check for a command in the rescan buffer.
    !-

    RSCAN_FLAG =
    BEGIN

    LOCAL
	CMD_LEN;

    IF
	BEGIN
	REGISTERS (1);
	AC1 = $RSINI;
	CMD_LEN = (IF JSYS (1, RSCAN, AC1) THEN .AC1 ELSE 0)
	END
	NEQ 0
    THEN
	BEGIN

	LOCAL
	    TEMP;

	BIND
	    CMD_PTR = CH$PTR (CMD_INPUT, %CHARCOUNT (PROMPT, '>'));

	!+
	! Get a copy of the rescan line to see if it has valid
	! information in it.
	!-

	BEGIN
	REGISTERS (1, 2, 3);
	AC3 = .CMD_LEN;
	AC2 = CMD_PTR;
	AC1 = $CTTRM;
	JSYS (0, SIN, AC1, AC2, AC3);
	TEMP = .AC2;
	END;

	!+
	! Now change lower case to upper case for comparisons
	! and chop off cr/lf if present.
	!-

	BEGIN

	LOCAL
	    CHR,
	    CNT,
	    PTR;

	PTR = CMD_PTR;
	CMD_LEN = 0;

	WHILE (CHR = CH$RCHAR (.PTR)) GEQ %C' ' DO
	    BEGIN

	    IF (.CHR GEQ %C'a') AND (.CHR LEQ %C'z') THEN CH$WCHAR (.CHR - %C'a' + %C'A', .PTR);

	    PTR = CH$PLUS (.PTR, 1);
	    CMD_LEN = .CMD_LEN + 1;
	    END;

	END;

	!+
	! If not RUN or START then must have good stuff.
	!-

	IF NOT CH$FAIL (TEMP = CH$FIND_CH (39, CMD_PTR, %C' ')) AND
	   NOT CH$FAIL (TEMP = CH$FIND_NOT_CH (4, .TEMP, %C' ')) AND
	   NOT CH$EQL (4, CH$ASCII ('RUN '), 4, CMD_PTR, %C' ') AND
	   NOT CH$EQL (6, CH$ASCII ('START '), 6, CMD_PTR, %C' ')
	THEN
	    BEGIN

	    !+
	    ! Append a /EX to the end so as to avoid re-prompt
	    !-

	    CH$MOVE (6, CH$ASCIZ ('/EX', %CHAR (13, 10)), CH$PLUS (CMD_PTR, .CMD_LEN));

	    !+
	    ! Now re-insert the line back into the rescan buffer and
	    ! redirect input to it instead of primary input.
	    !-

	    CMD_STATE_BLK [$CMIOJ] = $CTTRM^18 + $NULIO;
	    BEGIN
	    REGISTERS (1, 2, 3);
	    AC1 = .TEMP;
	    JSYS (1, RSCAN, AC1);
	    AC1 = $RSINI;
	    JSYS (1, RSCAN, AC1)
	    END
	    END
	ELSE
	    FALSE

	END
    ELSE
	FALSE

    END;

    !+
    ! Now parse the command line.
    !-

    FUNCTION = FN1;

    DO
	BEGIN

	SELECTA .FUNCTION<0, 18> OF
	    SET

	    [FN2, CO7] :
		BEGIN
		CMD_JFN [$GJGEN] = $GJDEF;
		CMD_JFN [$GJNAM] = 0;
		CMD_JFN [$GJEXT] = LIB_FILE_TYPE;
		END;

	    [LI2] :
		BEGIN
		CMD_JFN [$GJGEN] = GJ_FOU + $GJDEF;
		CMD_JFN [$GJNAM] = CH$PTR (DEF_LST_NAME);
		CMD_JFN [$GJEXT] = LST_FILE_TYPE;
		END;

	    [FN4, FI2] :
		BEGIN
		CMD_JFN [$GJGEN] = GJ_OLD + $GJDEF;
		CMD_JFN [$GJNAM] = 0;
		CMD_JFN [$GJEXT] = OBJ_FILE_TYPE;
		END;
	    TES;

	BEGIN
	REGISTERS (1, 2, 3);
	AC1 = CMD_STATE_BLK;
	AC2 = .FUNCTION;
	JSYS (0, COMND, AC1, AC2, AC3);
	COMND_FLAGS = .AC1;
	COMND_DATA = .AC2;
	COMND_USED = .AC3<0, 18>;
	END;

	SELECTONE 1 OF
	    SET

	    [.POINTR (COMND_FLAGS, CM_NOP)] :

		IF .POINTR (.FUNCTION, CM_FNC) EQL $CMFIL
		THEN
		    BEGIN

		    LOCAL
			BLK_PTR;

		    INCRA BLK_PTR FROM CMD_JFN [0] TO CMD_JFN [14] DO
			.BLK_PTR = 0;

		    CMD_JFN [$GJGEN] = GJ_OFG;
		    END
		ELSE
		    BEGIN
		    REGISTERS (1, 2, 3);
		    AC3 = 0;
		    AC2 = $FHSLF^18 + %O'777777';
		    AC1 = $PRIOU;
		    JSYS (2, ERSTR, AC1, AC2, AC3);
		    FUNCTION = FN1;
		    END;

	    [.POINTR (COMND_FLAGS, CM_RPT)] :
		INIT_PARSE ();

	    [OTHERWISE] :

		SELECTONEA .COMND_USED OF
		    SET

		    [CO2] :
			BEGIN
			SIZFIL = .COMND_DATA <0, 16>;
			FUNCTION = CO3;
			END;

		    [CO3] :
			FUNCTION = CO4;

		    [CO4] :
			BEGIN
			NUMEPT = .COMND_DATA <0, 16>;
			FUNCTION = CO5;
			END;

		    [CO5] :
			FUNCTION = CO6;

		    [CO6] :
			BEGIN
			NUMMNT = .COMND_DATA <0, 16>;
			FUNCTION = CO7;
			END;

		    [CO7] :
			0;

		    [CR2] :
			BEGIN
			SIZFIL = .COMND_DATA <0, 16>;
			FUNCTION = CR3;
			END;

		    [CR3] :
			FUNCTION = CR4;

		    [CR4] :
			BEGIN
			NUMEPT = .COMND_DATA <0, 16>;
			FUNCTION = CR5;
			END;

		    [CR5] :
			FUNCTION = CR6;

		    [CR6] :
			BEGIN
			NUMMNT = .COMND_DATA <0, 16>;
			FUNCTION = FN4;
			END;

		    [DE2] :
			BEGIN

			LOCAL
			    PTR;

			FUNCTION = FN4;
			PTR = CH$PTR (CMD_ATOM);
			MODNAM [.MODNUM, 0, 0, 16, 0] = $CAT5 (PTR, 1);
			MODNAM [.MODNUM, 1, 0, 16, 0] = $CAT5 (PTR, 1);

			IF CH$RCHAR (.PTR) EQL 0
			THEN
			    MODNUM = .MODNUM + 1
			ELSE
			    BEGIN
			    REGISTERS (1);
			    AC1 = CH$ASCIZ ('? improper module name', %CHAR (13, 10));
			    JSYS (0, PSOUT, AC1);
			    FUNCTION = FN1;
			    END;

			END;

		    [DG2] :
			BEGIN

			LOCAL
			    PTR;

			FUNCTION = FN4;
			PTR = CH$PTR (CMD_ATOM);
			GBLNAM [.GBLNUM, 0, 0, 16, 0] = $CAT5 (PTR, 1);
			GBLNAM [.GBLNUM, 1, 0, 16, 0] = $CAT5 (PTR, 1);

			IF CH$RCHAR (.PTR) EQL 0
			THEN
			    GBLNUM = .GBLNUM + 1
			ELSE
			    BEGIN
			    REGISTERS (1);
			    AC1 = CH$ASCIZ ('? improper entry point name', %CHAR (13, 10));
			    JSYS (0, PSOUT, AC1);
			    FUNCTION = FN1;
			    END;

			END;

		    [EOL] :
			FUNCTION = 0;

		    [FI2] :
			BEGIN
			OBJNUM = .OBJNUM + 1;
			CLOSE (OBJBLK [.OBJNUM - 1]);

			IF NOT ALLOCATE_FILBLK (OBJBLK [.OBJNUM - 1]) THEN RETURN FALSE;

			BLOCK [.OBJBLK [.OBJNUM - 1], F_JFN] = .COMND_DATA;
			OBJFLG [.OBJNUM - 1, F_SS] = .FLAGS [M_SS];
			OBJFLG [.OBJNUM - 1, F_REPLACE] = .FLAGS [M_REPLACE];
			OBJFLG [.OBJNUM - 1, F_NOEPT] = .FLAGS [M_NOEPT];
			FUNCTION = FI3;
			END;

		    [FI3] :
			BEGIN

			BIND
			    SWITCH_CMD = .POINTR ((.COMND_DATA), SWT_CMD),
			    SWITCH_VAL = .POINTR ((.COMND_DATA), SWT_VAL);

			CASE SWITCH_CMD FROM SWT_MIN TO SWT_MAX OF
			    SET

			    [SWT_FLAG_OFF] :
				OBJFLG [.OBJNUM - 1, 0, .SWITCH_VAL, 1, 0] = 0;

			    [SWT_FLAG_ON] :
				OBJFLG [.OBJNUM - 1, 0, .SWITCH_VAL, 1, 0] = 1;

			    [INRANGE] :
				0;

			    TES;

			END;

		    [FI4] :
			FUNCTION = FI2;

		    [FN1] :
			INIT_PARSE ();

		    [FN2] :
			BEGIN
			CLOSE (LIBBLK);

			IF NOT ALLOCATE_FILBLK (LIBBLK) THEN RETURN FALSE;

			BLOCK [.LIBBLK, F_JFN] = .COMND_DATA;
			BEGIN
			REGISTERS (1, 2, 3, 4);
			AC3 = FLD ($JSAOF, JS_TYP);
			AC2 = .BLOCK [.LIBBLK, F_JFN];
			AC1 = CH$PTR (CMD_ATOM);
			JSYS (0, JFNS, AC1, AC2, AC3, AC4);
			AC3 = 0;
			AC2 = .BLOCK [.LIBBLK, F_JFN];
			AC1 = CH$PTR (DEF_LIB_FILE);
			JSYS (0, JFNS, AC1, AC2, AC3, AC4);
			CH$WCHAR (0, .AC1);
			END;
			DUMP_FLAG = 1;

			IF .DEF_LST_NAME EQL 0
			THEN
			    BEGIN
			    REGISTERS (1, 2, 3, 4);
			    AC3 = FLD ($JSAOF, JS_NAM);
			    AC2 = .BLOCK [.LIBBLK, F_JFN];
			    AC1 = CH$PTR (DEF_LST_NAME);
			    JSYS (0, JFNS, AC1, AC2, AC3, AC4);
			    END;

			FUNCTION = FN4;
			END;

		    [FN3, FN4] :
			BEGIN

			BIND
			    SWITCH_CMD = .POINTR ((.COMND_DATA), SWT_CMD),
			    SWITCH_VAL = .POINTR ((.COMND_DATA), SWT_VAL);

			FUNCTION = .COMND_USED;

			CASE SWITCH_CMD FROM SWT_MIN TO SWT_MAX OF
			    SET

			    [SWT_FLAG_OFF] :
				FLAGS [SWITCH_VAL] = 0;

			    [SWT_FLAG_ON] :
				FLAGS [SWITCH_VAL] = 1;

			    [SWT_LIST] :
				BEGIN
				FLAGS [M_LIST] = 1;

				FUNCTION = (IF .POINTR (COMND_FLAGS, CM_SWT) THEN LI2 ELSE FN4);

				END;

			    [SWT_COMPRESS] :
				BEGIN
				FLAGS [M_COMPRESS] = 1;
				NUMEPT = -1;
				NUMMNT = -1;
				SIZFIL = -1;
				FUNCTION = (IF .POINTR (COMND_FLAGS, CM_SWT) THEN CO2 ELSE CO7);
				END;

			    [SWT_CREATE] :
				BEGIN
				FLAGS [M_CREATE] = 1;
				NUMEPT = 512;
				NUMMNT = 256;
				SIZFIL = 100;
				FUNCTION = (IF .POINTR (COMND_FLAGS, CM_SWT) THEN CR2 ELSE FN4);
				END;

			    [SWT_DE] :

				IF NOT .POINTR (COMND_FLAGS, CM_SWT)
				THEN
				    FUNCTION = FN4
				ELSE

				    IF .MODNUM LSS LBR_MAX_MODULE_DELETES
				    THEN
					FUNCTION = DE2
				    ELSE
					BEGIN
					REGISTERS (1);
					AC1 = CH$ASCIZ ('? too many modules', %CHAR (13, 10));
					JSYS (0, PSOUT, AC1);
					FUNCTION = FN1;
					END;

			    [SWT_DG] :

				IF NOT .POINTR (COMND_FLAGS, CM_SWT)
				THEN
				    FUNCTION = FN4
				ELSE

				    IF .GBLNUM LSS LBR_MAX_GLOBAL_DELETES
				    THEN
					FUNCTION = DG2
				    ELSE
					BEGIN
					REGISTERS (1);
					AC1 = CH$ASCIZ ('? too many global symbols', %CHAR (13, 10));
					JSYS (0, PSOUT, AC1);
					FUNCTION = FN1;
					END;

			    TES;

			END;

		    [LI2] :
			BEGIN
			CLOSE (LSTBLK);

			IF NOT ALLOCATE_FILBLK (LSTBLK) THEN RETURN FALSE;

			BLOCK [.LSTBLK, F_JFN] = .COMND_DATA;
			FUNCTION = FN4;
			END;

		    TES;

	    TES;

	END
    WHILE .FUNCTION NEQ 0;

    IF .LSTBLK NEQ 0
    THEN
	BEGIN
	REGISTERS (1, 2, 3);
	AC1 = .BLOCK [.LSTBLK, F_JFN];
	JSYS (0, DVCHR, AC1, AC2, AC3);
	SELECTONE .POINTR (AC2, DV_TYP) OF
	SET
	[$DVTTY, $DVPTY] : 0;
	[OTHERWISE] : FLAGS [M_WIDE] = 1;
	TES;
	END;

    .DUMP_FLAG
    END;					!OF CMD
GLOBAL ROUTINE FILDT (BUF_PTR_ADR, PAT_PTR_ADR, PRM_LST_ADR_ADR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN
    REGISTERS (1, 2, 3, 4);

    LOCAL
	BUF_PTR_INI,
	FILPTR,
	PRM_LIST : REF VECTOR;

    PRM_LIST = ..PRM_LST_ADR_ADR;
    FILPTR = .PRM_LIST [0];
    .PRM_LST_ADR_ADR = PRM_LIST [1];
    AC1 = (BUF_PTR_INI = ..BUF_PTR_ADR);
    AC2 = .BLOCK [..FILPTR, F_JFN];
    AC3 = FLD ($JSAOF, JS_CDR);
    AC4 = 0;
    JSYS (0, JFNS, AC1, AC2, AC3, AC4);
    .BUF_PTR_ADR = .AC1;
    CH$DIFF (..BUF_PTR_ADR, .BUF_PTR_INI)
    END;					!End of FILDT
GLOBAL ROUTINE FILNM (BUF_PTR_ADR, PAT_PTR_ADR, PRM_LST_ADR_ADR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN
    REGISTERS (1, 2, 3, 4);

    LOCAL
	BUF_PTR_INI,
	FILPTR,
	PRM_LIST : REF VECTOR;

    PRM_LIST = ..PRM_LST_ADR_ADR;
    FILPTR = .PRM_LIST [0];
    .PRM_LST_ADR_ADR = PRM_LIST [1];
    AC1 = (BUF_PTR_INI = ..BUF_PTR_ADR);
    AC2 = .BLOCK [..FILPTR, F_JFN];
    AC3 = FLD ($JSAOF, JS_DEV) + FLD ($JSAOF, JS_DIR) + FLD ($JSAOF, JS_NAM) + FLD ($JSAOF, JS_TYP) + FLD (
	$JSAOF, JS_GEN) + JS_PAF;
    AC4 = 0;
    JSYS (0, JFNS, AC1, AC2, AC3, AC4);
    .BUF_PTR_ADR = .AC1;
    CH$DIFF (..BUF_PTR_ADR, .BUF_PTR_INI)
    END;					!End of FILNM
GLOBAL ROUTINE FILPOS (FILPTR, FBLOCK_ADR, OFFSET_ADR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    LITERAL
	BLOCK_SIZE = 512;

    LOCAL
	POSITION;

    BEGIN
    REGISTERS (1, 2);
    AC1 = .BLOCK [..FILPTR, F_JFN];

    IF JSYS (1, RFPTR, AC1, AC2) NEQ 1 THEN RETURN FALSE;

    POSITION = .AC2;
    END;
    .FBLOCK_ADR = .POSITION^1/BLOCK_SIZE + 1;
    .OFFSET_ADR = .POSITION^1 MOD BLOCK_SIZE;
    TRUE
    END;					!OF FILPOS
ROUTINE INIT_PARSE : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN
    OBJNUM = 0;
    MODNUM = 0;
    GBLNUM = 0;
    DEF_LST_NAME = 0;
    FLAGS = 0;
    MY_FLAGS = 0;
    FUNCTION = (SELECTONE .RSCAN_FLAG OF
	SET
	[0] : FN2;
	[1] : (RSCAN_FLAG = 2; FN2);
	[2] : (FLAGS [M_EXIT] = 1; 0);
	TES);
    END;					!End of INIT_PARSE
GLOBAL ROUTINE GETFIL (FILPTR, BUFFER_PTR, LENGTH) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN
    REGISTERS (1, 2, 3, 4);
    AC1 = .BLOCK [..FILPTR, F_JFN];		!Pick up the JFN
    AC2 = .BUFFER_PTR;
    AC3 = -.LENGTH;
    JSYS (0, SIN, AC1, AC2, AC3, AC4);		!read in a 18 bit byte
    .LENGTH + .AC3				!and trim to 16 bits.
    END;					!OF GETFIL
GLOBAL ROUTINE GETTIM (TIME_BLOCK) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
!	.TIME_BLOCK				!Address of 8 word block
!						!to receive date and time.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN

    MAP
	TIME_BLOCK : REF VECTOR [8];

    REGISTERS (1, 2, 3, 4);
    AC4 = IC_ADS;
    AC2 = -1;
    JSYS (0, ODCNV, AC1, AC2, AC3, AC4);
    TIME_BLOCK [0] = .AC2<18, 16> - 1900;
    TIME_BLOCK [1] = .AC2<0, 16> + 1;
    TIME_BLOCK [2] = .AC3<18, 16> + 1;
    TIME_BLOCK [3] = (.AC4<0, 18>/(60*60)) MOD 24;
    TIME_BLOCK [4] = (.AC4<0, 18>/60) MOD 60;
    TIME_BLOCK [5] = (.AC4<0, 18>) MOD 60;
    TIME_BLOCK [6] = 0;
    TIME_BLOCK [7] = 0;
    END;					!End of GETTIM
GLOBAL ROUTINE OPEN (FILPTR, ACCESS, MODE) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    BIND
	ACCESS_TYPE = UPLIT (OF_RD, OF_WR, OF_RD + OF_WR, OF_RD + OF_WR, OF_RD + OF_WR) : VECTOR [5],
	MODE_TYPE = UPLIT (FLD (7, OF_BSZ), FLD (18, OF_BSZ)) : VECTOR [2];

    LOCAL
	FLAG_WORD;

    FLAG_WORD = .ACCESS_TYPE [.ACCESS] + .MODE_TYPE [.MODE];

    IF ..FILPTR EQL 0
    THEN
	BEGIN

	IF NOT ALLOCATE_FILBLK (.FILPTR) THEN RETURN FALSE;

	IF .POINTR (FLAG_WORD, OF_WR)
	THEN
	    BLOCK [..FILPTR, F_JFN] = $PRIOU
	ELSE
	    BLOCK [..FILPTR, F_JFN] = $PRIIN;

	END;

    BEGIN
    REGISTERS (1, 2);
    AC1 = .BLOCK [..FILPTR, F_JFN];		!Set the JFN
    AC2 = .FLAG_WORD;				!Set access and block if not available.

    IF .AC1 NEQ $PRIIN AND .AC1 NEQ $PRIOU AND JSYS (1, OPENF, AC1, AC2) NEQ 1 THEN RETURN FALSE;

    END;
						!and try to open it.
    TRUE
    END;					!OF OPEN
GLOBAL ROUTINE POSFIL (FILPTR, FBLOCK, OFFSET) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    LITERAL
	BLOCK_SIZE = 512;

    LOCAL
	POSITION;

    POSITION = ((.FBLOCK - 1)*BLOCK_SIZE + .OFFSET)^-1;
    BEGIN
    REGISTERS (1, 2);
    AC2 = .POSITION;
    AC1 = .BLOCK [..FILPTR, F_JFN];
    JSYS (1, SFPTR, AC1, AC2);
    END;
    END;					!OF POSFIL
GLOBAL ROUTINE PUTFIL (FILPTR, TEXT_PTR, LENGTH) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!	TEXT_PTR				!POINTER TO TEXT STRING TO PRINT
!	LENGTH					!LENGTH OF TEXT
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN
    REGISTERS (1, 2, 3);

    IF .LENGTH NEQ 0
    THEN
	BEGIN
	AC1 = .BLOCK [..FILPTR, F_JFN];		!Set the JFN
	AC2 = .TEXT_PTR;			!a pointer to the string
	AC3 = -.LENGTH;				!the length of the string
	JSYS (0, SOUT, AC1, AC2, AC3);		!and send it on its way.
	END;

    END;					!OF PUTFIL
ROUTINE RELEASE_FILBLK (FILPTR) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    IF ..FILPTR NEQ 0
    THEN
	BEGIN

	IF .BLOCK [..FILPTR, F_JFN] NEQ 0
	THEN
	    CLOSE (.FILPTR);

	.FILPTR = 0;
	END;				!OF RELEASE_FILBLK

END

ELUDOM