Google
 

Trailing-Edge - PDP-10 Archives - bb-bt99r-bb - newt10.b36
There are 9 other files named newt10.b36 in the archive. Click here to see a list.
!	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1985, 1989.
!	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.
!++
! Facility: LSG DECnet Network Management
!
! Abstract: This file contains the Tops-10 specific routines for the
!	    Network Management file system.
!
! Environment: TOPS10 user mode, BLISS-36
!
! Author: Stuart S. Grossman, Creation Date: 9-Dec-81
!
!--
%global_routine('MX$FILE_STRUCTURE',file_id) =
    BEGIN
    LOCAL
        file: REF file_data_block,
        spcblk: REF BLOCK[] FIELD (spec_block_fields);

    IF NOT nmu$table_fetch (file_table, .file_id, file)
    THEN
        RETURN 0;

    spcblk = file[fd_spec_block];
    RETURN .spcblk[spec_device]
    END;

%global_routine('GETLOK', name, channel) =
    BEGIN
    STACKLOCAL
        appblk: VECTOR[6] INITIAL(%O'010001'^18 + 3);

    REGISTER t;
    BUILTIN UUO;

    appblk[1] = .channel;
    appblk[2] = .name;
    t = $enqaa^18 + appblk;
    IF uuo(1,enq$(t))
    THEN
        RETURN $true                    !Success... got the lock
    ELSE
        BEGIN
        $error(FACILITY=$enq,
               SEVERITY=STS$K_WARNING,
               CODE=.t);

        RETURN .t ^ 18;                  !Failure... enq failed.  Tell why
        END

    END;

%global_routine('FRELOK',name,channel) =
    BEGIN
    STACKLOCAL
        appblk: VECTOR[6] INITIAL(%O'010001'^18 + 3);

    REGISTER t;
    LOCAL
        val;

    BUILTIN UUO;

    val = $false;
    appblk[1] = .channel;
    appblk[2] = .name;
    t = $deqda^18;
    IF uuo(1,deq$(t))
    THEN
        val = $true
    ELSE
        $error(FACILITY=$enq,
               SEVERITY=STS$K_WARNING,
               CODE=.t);

    RETURN .val;

    END;
%routine ('ALLOC_BUFFER', FILE : ref FILE_DATA_BLOCK) =

!++
! Functional description:
!
!	This routine will allocate and build buffer rings for doing disk I/O.
!	This is necessary because just letting Tops-10 create it's own buffers
!	will mess up NML's memory management.
!
! Formal parameters:
!
!	FILE		Address of a FILE_DATA_BLOCK.
!
! Routine value:
!
!	$true		If all buffers could be allocated
!	$false		If not all buffers could be allocated
!
! Side effects:
!
!	A pointer to an input or output buffer control block will be put
!	into FD_BUFFER_HEADERS.
!--

BEGIN

    BUILTIN
	uuo;

    REGISTER
	t1;

    LOCAL
	arglst : VECTOR [2],
	buffer_header : REF VECTOR [buffer_data_block_allocation];

!
! Allocate the buffer ring control block.
!
    buffer_header = nmu$memory_get (buffer_data_block_allocation);

    IF .buffer_header EQL 0 THEN RETURN $false;
!
! Size, and number of buffers required
!
    arglst [0] = $ioasc;		! Probably this mode
    arglst [1] = %SIXBIT 'DSK';		! Figger out for DSK:

    t1 = arglst;
    UUO (1,devsiz (t1));		! Get the number and size of buffers
!
! Now its time to set up the buffer ring.
!
    buffer_header [$bfadr] = mx$file_build_buffers (1, .t1<0,18,0>);
    IF .buffer_header [$bfadr] EQL 0 THEN
    BEGIN
	nmu$memory_release (.buffer_header, buffer_data_block_allocation);
	RETURN $false
    END;

    file [fd_current_buffer] = .buffer_header;

    $true
END; ! End of ALLOC_BUFFER
%routine ('DEALLOC_BUFFER', FILE : ref FILE_DATA_BLOCK) : novalue =

!++
!
! Functional description:
!
!	This routine will deallocate the buffer ring for a file.
!
! Formal parameters:
!
!	.FILE		Address of a File Descriptor Block
!
! Routine value:
!
!	NONE
!
!--
BEGIN

    LOCAL
	buffer_header : REF VECTOR [buffer_data_block_allocation];

    buffer_header = .file [fd_current_buffer];

    mx$file_kill_buffers (.buffer_header[$bfadr]);

    nmu$memory_release (.buffer_header, buffer_data_block_allocation)
END; ! End of DEALLOC_BUFFER
%global_routine ('MX$FILE_BUILD_BUFFERS', NUMBER_BUFFERS, BUFFER_SIZE) =

!++
!
! Functional description:
!
!	Set up a buffer ring for doing Tops-10 style buffered I/O.
!
! Formal parameters:
!
!	.NUMBER_BUFFERS		Number of buffers desired
!	.BUFFER_SIZE		Size of one buffer
!
! Routine value:
!
!	neq 0			Buffer ring address + virgin buffer bit
!	eql 0			Not enough memory for all the buffers
!
!--

BEGIN

    LOCAL
	buffer_ring : REF VECTOR,
	got_memory_flag;

    BIND
	buffer_temp = (.buffer_size - 2) ^ 18;

    buffer_ring = 0;			! Indicate no buffer ring yet
    got_memory_flag = $true;		! Flag for allocation failure cleanup
!
! Now its time to set up the buffer ring.
!

    DECR junk FROM .number_buffers TO 1 DO
    BEGIN
	LOCAL
	    buffer : REF VECTOR;

	buffer = nmu$memory_get(.buffer_size);	! Get one buffer
	IF .buffer EQL 0 THEN
	BEGIN
	    got_memory_flag = $false;
	    EXITLOOP;
	END;
!
! Now its time to set up the header for one buffer.
!
	buffer [$bfsts] = 0;			! Reset the status word
	buffer [$bfcnt] = 0;			! And the count word

	IF .buffer_ring EQL 0 THEN
	BEGIN
!
! Special code for the first time through. It makes a ring of one item which
! points to itself.
!
	    buffer [$bfhdr] = buffer_temp + buffer [$bfhdr];
	    buffer_ring = .buffer;
	END
	ELSE
	BEGIN
!
! Here if not the first time through.  Insert the new buffer into the
! buffer ring.
!
	    buffer [$bfhdr] = .buffer_ring [$bfhdr];
	    buffer_ring [$bfhdr] = buffer_temp + buffer [$bfhdr];
	END;
    END; ! Of DECR loop

    IF NOT .got_memory_flag THEN
    BEGIN
	mx$file_kill_buffers (.buffer_ring);	! Kill off the buffers
	RETURN 0
    END;

    bf$vbr + buffer_ring [$bfhdr]

END; ! End of MX$FILE_BUILD_BUFFERS
%global_routine ('MX$FILE_KILL_BUFFERS', BUFFER_RING : ref block) : novalue =

!++
!
! Functional description:
!
!	This routine will take apart and deallocate a Tops-10 I/O buffer ring.
!	It will also deallocate the header.
!
! Formal parameters:
!
!	.BUFFER_RING		Address of $BFHDR word of a buffer in a buffer
!				ring.  Ie: the contents of $BFADR of a buffer
!				ring control block.
!
! Routine value:
!
!	NONE
!
!--

BEGIN
    LOCAL
	current_buffer : REF BLOCK,
	temp,
	first_buffer;

    current_buffer = first_buffer = (.buffer_ring AND %O'777777') - $bfhdr;

    DO
    BEGIN

	temp = (.current_buffer [$bfhdr, 0, 36, 0] AND %O'777777') - $bfhdr;

	nmu$memory_release (.current_buffer, .current_buffer [$bfhdr, 18, 17,0] + 2);
	current_buffer = .temp;

    END
    UNTIL .current_buffer EQL .first_buffer;

END; ! End of MX$FILE_KILL_BUFFERS
%routine('FILPAR', spec, filop_block_, lookup_block_, path_block_) =
    begin

%( The following is the file parser action table. The entries are action
routines to be called whenever going from one parser state to another. The
table is accessed using the old state and the new state. The table is
arranged such that the vertical numbers are the old state, and the horizontal
numbers are the new state.

\	1	2	3	4	5	6	7
 \----------------------------------------------------------
0!     dev     fil     fil                             fil
1!             fil     fil                             fil
2!                     ext                             ext
3!                             proj
4!                                     prog    prog
5!                                     sfd     sfd
6!                                                     end

)%

	SWITCHES LIST (NOOBJECT);

	STRUCTURE
	    parse_matrix [old, new ; row, col] =
	    [row+1 * col]
	    (parse_matrix + old*col + new - 1)<0,36,0>;

	LITERAL
	    dev$p = 1,			! We just saw a device
	    fil$p = 2,			! We just saw a file name
	    ext$p = 3,			! We just saw an extension
	    proj$p = 4,			! We just saw a project number
	    prog$p = 5,			! We just saw a programmer number
	    sfd$p = 6,			! We just saw a SFD
	    end$p = 7;			! We just saw end of file spec string

	BIND
	    ptable = UPLIT(
		dev$p,	fil$p,	fil$p,	0,	0,	0,	fil$p,
		0,	fil$p,	fil$p,	0,	0,	0,	fil$p,
		0,	0,	ext$p,	0,	0,	0,	ext$p,
		0,	0,	0,	proj$p,	0,	0,	0,
		0,	0,	0,	0,	prog$p,	prog$p,	0,
		0,	0,	0,	0,	sfd$p,	sfd$p,	0,
		0,	0,	0,	0,	0,	0,	end$p)
		     : parse_matrix [6,7];
    BIND
	filop_block = .filop_block_:
                        BLOCK [$fofsp+1] FIELD (filop_block_fields),
	lookup_block = .lookup_block_:
                        BLOCK [4] FIELD (lookup_block_fields),
	path_block = .path_block_:
                        BLOCK [$ptmax] FIELD (path_block_fields);
    OWN
        ptr,
        len;

    LOCAL
        state,
        newstate,
        token,
        sfd_count;

    BIND
        sfd = path_block [path_sfd] : VECTOR [5];

	ROUTINE getc =
	BEGIN
	    len = .len - 1;
	    IF .len LSS 0 THEN RETURN 0;
	    CH$RCHAR_A(ptr)
	END;

	ROUTINE getoct (token) =
	BEGIN
	    LOCAL
		temp;

	    .token = 0;

	    INCR index FROM 1 TO .len DO
	    BEGIN
		temp = getc ();
		IF .temp LSS %C'0' OR .temp GTR %C'7' THEN EXITLOOP;
		IF .index LEQ 6 THEN .token = ..token * 8 + .temp - %C'0';
	    END;

	    .temp
	END; !End of routine GETOCT

	ROUTINE getsix (token) =
	BEGIN
	    LOCAL
		temp,
		ptr;

	    .token = 0;
	    ptr = CH$PTR(.token,,6);

	    WHILE $true DO
	    BEGIN
		temp = getc ();
		IF .temp GEQ %C'a'
		   AND .temp LEQ %C'z' THEN temp = .temp - %C'a'+%C'A';

		IF NOT (.temp GEQ %C'A' AND .temp LEQ %C'Z')
		   AND NOT (.temp GEQ %C'0' AND .temp LEQ %C'9') THEN EXITLOOP;

		temp = .temp - %C' ';
		IF (..token AND %O'77') EQL 0 THEN CH$WCHAR_A(.temp, ptr);
	    END;

	    .temp
	END; !End of routine GETSIX

    state = 0;
    sfd_count = 0;
    ptr = .spec;
    len = CH$LEN(.ptr);

    WHILE .state NEQ 7 DO
        BEGIN
        newstate = (IF .state EQL 3 OR .state EQL 4 THEN getoct (token)
            					    ELSE getsix (token));

        newstate =
            (SELECTONE .newstate OF
		SET
		    [%C':']		:	1;
		    [%C'.']		:	2;
		    [%C'[']		:	3;
		    [%C',']		:	IF .state LEQ 3 THEN 4 ELSE 5;
		    [%C']']		:	6;
		    [0,%O'15',%O'12']	:	7;
		    [OTHERWISE]		:	0;
		TES);

        CASE .ptable [.state, .newstate] FROM 0 TO end$p OF
	    SET

	    [0]		:       RETURN $false;
	    [dev$p]	:	filop_block [filop_device] = .token;
	    [fil$p]	:	lookup_block [lookup_name] = .token;
	    [ext$p]	:	lookup_block [lookup_ext] = .token ^ -18;
	    [proj$p]	:	path_block [path_project] = .token;
	    [prog$p]	:	path_block [path_programmer] = .token;
	    [sfd$p]	:	(sfd[.sfd_count] = .token;sfd_count = .sfd_count + 1);
	    [end$p]	:	;
	    TES;

        state = .newstate;

	END; !End of while .STATE neq 7
	$true
    END; !End of routine PARSE
%routine ('OPEN_FILE', FILE : ref FILE_DATA_BLOCK, FN : ref FILE_NAME_BLOCK) =

!++
! Functional description:
!
!	This routine will do LOOKUPs or ENTERs as appropriate, in order to
!	set up the file for I/O. It will also set up the byte counts, byte
!	sizes, and other stuff in the file and buffer data bases.
!
! Formal parameters:
!
!	FILE		ref pointer to a FILE_DATA_BLOCK
!	FN		ref pointer to a FILE_NAME_BLOCK
!
! Implicit inputs:
!
!	NONE.
!
! Routine value:
!
!	$TRUE		if file is successfully opened
!	$FALSE		otherwise
!
! Side effects:
!
!	A file is now opened, and an I/O channel is now allocated.
!
!--

BEGIN

    LOCAL
	temp: VECTOR[2];

    BIND
	filop_block = file[fd_filop_block]:
                        BLOCK [$fofsp+1] FIELD (filop_block_fields),
	lookup_block = file[fd_lookup_block]:
                        BLOCK [4] FIELD (lookup_block_fields),
	path_block = file[fd_path_block]:
                        BLOCK [$ptmax] FIELD (path_block_fields),
        spec_block = file[fd_spec_block]:
                        BLOCK [8] FIELD (spec_block_fields);

    file[fd_error] = 0;

!
! First we set up the FILOP, LOOKUP, and PATH blocks with the constant data
!

	! Tell monitor to assign channels, and use privs
    filop_block [filop_flags] = fo$prv + fo$asc;
    filop_block [filop_open_flags] = $ioasc + uu$lbf;
    filop_block [filop_device] = %SIXBIT'DSK   ';
    filop_block [filop_output_buffer_number] = 0;
    filop_block [filop_input_buffer_number] = 0;
    filop_block [filop_lookup_pointer] = lookup_block;
    filop_block [filop_spec_length] = 8;
    filop_block [filop_spec_block] = spec_block;
    lookup_block [lookup_path] = path_block;


!
! Now its time to parse the filespec...
!

    IF NOT filpar(.fn[fn_pointer],filop_block,lookup_block,path_block)
    THEN
        BEGIN
        file[fd_error] = STS$VALUE(
                            COD=uf$cnp,
                            FAC=$ERR,
                            SEV=STS$K_WARNING);
	RETURN $false;
        END;

    CASE .file [fd_access]
	FROM file_access_read_only TO file_access_append_only OF
	    SET

	    [file_access_read_only]:
		BEGIN
                file [fd_filop_function] = $foinp;
                filop_block [filop_function] = $fored;
                filop_block [filop_input_buffer_header] =
                    .file [fd_current_buffer];
		END;

	    [file_access_write_only]:
		BEGIN
                file [fd_filop_function] = $foout;
                filop_block [filop_function] = $fowrt;
                filop_block [filop_output_buffer_header] =
                    .file [fd_current_buffer];
		END;

	    [file_access_append_only]:
		BEGIN
                BIND
                    buffer = .file [fd_current_buffer]: buffer_data_block;

                buffer [bd_valid] = $true;
                file [fd_filop_function] = $foout;
                filop_block [filop_function] = $foapp;
                filop_block [filop_output_buffer_header] =
                    .file [fd_current_buffer];

		END;
	    TES;

    BEGIN

    BUILTIN
        UUO;

    REGISTER
        t1;

	set_in_your_behalf(filop_block,lookup_block);
        t1 = ($fofsp+1) ^ 18 OR filop_block;
        IF NOT UUO (1, filop$(t1))
        THEN
            BEGIN
            SELECTONE .t1 OF
                SET
                [erfbm_]:   file [fd_error] = uf$lok;           !File is locked
                [OTHERWISE]:file [fd_error] = STS$VALUE(
                                                FAC=$fop,
                                                COD=.t1,
                                                SEV=STS$K_WARNING);
                TES;

            file[fd_channel] = .filop_block[filop_channel];
            temp = .file[fd_channel]^18 OR $forel;
            t1 = 1^18 + temp;
            UUO(1,filop$(t1));

            RETURN $false;
            END;

        temp = %SIXBIT'TXT   ';
        IF (.lookup_block[lookup_name] EQL %SIXBIT'MAIL  ') AND
           (.lookup_block[lookup_ext] EQL .temp<18,18,0>)
        THEN
            IF (temp = getlok(CH$PTR(
                                 UPLIT(%ASCIZ'Mail append interlock')),
                              .filop_block[filop_channel]))
            THEN
		BEGIN
                  file[fd_lock_channel] = .filop_block[filop_channel];
		  file[fd_light_new_mail_bit] = 1;
		END
            ELSE
                BEGIN
                IF .temp EQL (enqru_ ^ 18)
                THEN
                    file[fd_error] = uf$lok         !File is locked
                ELSE
                    file[fd_error] = STS$VALUE(     !Some other nasty error
                                        COD=.temp<left_half>,
                                        FAC=$ENQ,
                                        SEV=STS$K_WARNING);

                frelok(CH$PTR(UPLIT(%ASCIZ'Mail append interlock')),
                       .filop_block[filop_channel]);

                temp [0] = .file[fd_channel] ^ 18 OR $focls;
                temp [1] = cl$rst;
                t1 = 2^18+temp;
                UUO(1,filop$(t1));

                temp = .file[fd_channel]^18 OR $forel;
                t1 = 1^18 + temp;
                UUO(1,filop$(t1));

                RETURN $false;
                END;
    END;

    !Here is all is well... finish up
    IF .lookup_block [lookup_length] LSS 0
    THEN
	BEGIN
        file [fd_block_count] = ((- .lookup_block[lookup_length]) - 1)/128 + 1;
	file [fd_length] = - .lookup_block[lookup_length];
	END
    ELSE
        file [fd_block_count] = .lookup_block [lookup_length];

    file [fd_channel] = .filop_block [filop_channel];
    $true
END; ! End of OPEN_FILE
%routine ('CLOSE_FILE', FILE : ref FILE_DATA_BLOCK) =

!++
!
! Function description:
!
!	This routine will do a Tops-10 file close, and channel release.
!
! Formal parameters:
!
!	.FILE		Address of file descriptor block
!
! Routine value:
!
!	$true		File was closed successfully
!	$false		Couldn't close file
!
!--

BEGIN
    BIND
	filop_block = file[fd_filop_block]:
                        VECTOR [$fofsp+1],
	lookup_block = file[fd_lookup_block]:
                        BLOCK [4] FIELD (lookup_block_fields),
	path_block = file[fd_path_block]:
                        BLOCK [$ptmax] FIELD (path_block_fields),
        spec_block = file[fd_spec_block]:
                        VECTOR [8];

    BUILTIN
	UUO;

    REGISTER
	t1;

    LOCAL
        value,
	i,
	rename_block: VECTOR [$rbmax+1];


    value = $true;

    IF .file[fd_lock_channel] NEQ 0
    THEN
	value = .value AND (IF frelok(CH$PTR(UPLIT(
                                        %ASCIZ'Mail append interlock')),
         	                  .file[fd_channel])
                            THEN
                                $true
                            ELSE
                                BEGIN
                                file[fd_error]=STS$VALUE(
                                                COD=uf$cfl,
                                                FAC=$ERR,
                                                SEV=STS$K_WARNING);
                                $false
                                END
                            );

IF NOT .file [fd_light_new_mail_bit] THEN
BEGIN
    filop_block [0] = .file[fd_channel] ^ 18 OR $focls;

    IF  .file [fd_abort]
    THEN filop_block [1] = cl$rst
    ELSE filop_block [1] = 0;

    t1 = 2 ^ 18 OR filop_block;
END
ELSE
BEGIN
	INCR i FROM 1 TO $fofsp DO filop_block[.i] = 0;
	filop_block [0] = .file[fd_channel] ^ 18 OR $fornm OR fo$uoc;
	filop_block [$foleb]<left_half> = rename_block;
	INCR i FROM 0 TO $rbmax DO rename_block [.i] = 0;
	rename_block [$rbcnt] = $rbmax;
	rename_block [$rbnam] = .spec_block[$foffn];
	rename_block [$rbext] = .spec_block[$fofex];
	rename_block [$rbffb] = 1;
	rename_block [$rbtyp] = rb$dec OR ($rbdas ^ 12) OR ($rboms ^ 6);
	t1 = ($foleb + 1) ^ 18 OR filop_block;
END;

    IF NOT (value = (.value AND UUO (1, filop$(t1))))
    THEN
        file[fd_error] = STS$VALUE(
                            COD=.t1,
                            FAC=$FOP,
                            SEV=STS$K_WARNING);

    filop_block[0] = .file[fd_channel]^18 OR $forel;
    t1 = 1^18 OR filop_block;
    UUO(1,filop$(t1));
    RETURN .value;

END; ! End of CLOSE_FILE
%routine ('MAP_PAGE', FILE : ref FILE_DATA_BLOCK) =

!++
!
! Functional description:
!
!	This routine will do a buffered mode read from a file.  Call it
!	once to fill (or empty) the buffer.  The FILOP function is read
!	from the FD_FILOP_FUNCTION field of the file descriptor block.
!
! Formal parameters:
!
!	.FILE			Address of file descriptor block
!
! Routine value:
!
!	$true			Everythings fine, byte is in DATA.
!	$false			I/O error occurred while reading.  GETSTS
!				data is in DATA.
!
!--

BEGIN
    BIND
	buffer = (file [fd_current_buffer]): REF buffer_data_block;

    LOCAL
	filop_args;

    BUILTIN
	UUO;

    REGISTER
	t1;

    filop_args = .file [fd_channel] ^ 18 + .file [fd_filop_function];

    t1 = 1 ^ 18;
    t1 = .t1 + filop_args;
    IF NOT UUO (1, filop$(t1)) THEN
    BEGIN
	file [fd_error] = STS$VALUE(
                            COD=.t1,
                            FAC=$FOP,
                            SEV=STS$K_WARNING);
    	RETURN $false;
    END;

    file [fd_current_block] = .file [fd_current_block] + 1;

    IF .file [fd_current_block] GEQ .file [fd_block_count] THEN
    buffer [bd_end_of_file] = $true;

    buffer [bd_pointer] = CH$PTR((.buffer [bd_address] AND %O'777777') + 2);
    buffer [bd_valid] = $true
END; ! End of MAP_PAGE

! CMS REPLACEMENT HISTORY


!*1 WADDINGTON 27-Nov-1984 15:25:13 "MX's File System Tops-10 Specific Routines"