Trailing-Edge
-
PDP-10 Archives
-
BB-X117B-SB_1986
-
10,7/nml/filt10.b36
There is 1 other file named filt10.b36 in the archive. Click here to see a list.
! DSKC:FILT10.B36[10,5665,SOURCE,TOPS10] 21-Sep-83 21:44:22, Edit by GROSSMAN
!
! Fix detection of errors while parsing file specs.
! Edit=26
!
! FILT10 - Network Management File Utility, Tops-10 Specific Routines
!
! COPYRIGHT (C) 1981 BY
! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS 01754
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A SINGLE
! COMPUTER SYSTEM AND MAY BE COPIED ONLY 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
! EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO THESE LICENSE
! TERMS. TITLE TO AND OWNERSHIP OF THE SOFTWARE SHALL AT ALL TIMES
! REMAIN IN DEC.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
!
!++
! 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
!
!--
%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 [3];
!
! Allocate the buffer ring control block.
!
BUFFER_HEADER = NMU$MEMORY_GET (3);
if .BUFFER_HEADER eql 0 then return $false;
!
! Size, and number of buffers required
!
ARGLST [0] = $IOBIN; ! 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] = NMU$FILE_BUILD_BUFFERS (.T1<18,18,0>,
.T1<0,18,0>);
if .BUFFER_HEADER [$BFADR] eql 0 then
begin
NMU$MEMORY_RELEASE (.BUFFER_HEADER, 3);
return $false
end;
selectone .FILE [FD_ACCESS] of
set
[FILE_ACCESS_READ_ONLY,
FILE_ACCESS_RANDOM] : FILE [FD_BUFFER_HEADERS] = .BUFFER_HEADER;
[FILE_ACCESS_WRITE_ONLY] : FILE [FD_BUFFER_HEADERS] = .BUFFER_HEADER ^ 18
tes;
$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 [3];
BUFFER_HEADER =
(selectone .FILE [FD_ACCESS] of
set
[FILE_ACCESS_READ_ONLY] : .FILE [FD_BUFFER_HEADERS] and %o'777777';
[FILE_ACCESS_WRITE_ONLY]: .FILE [FD_BUFFER_HEADERS] ^ -18;
tes);
NMU$FILE_KILL_BUFFERS (.BUFFER_HEADER[$BFADR]);
NMU$MEMORY_RELEASE (.BUFFER_HEADER, 3);
end; ! End of DEALLOC_BUFFER
%global_routine ('NMU$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
NMU$FILE_KILL_BUFFERS (.BUFFER_RING); ! Kill off the buffers
return 0
end;
BF$VBR + BUFFER_RING [$BFHDR]
end; ! End of NMU$FILE_BUILD_BUFFERS
%global_routine ('NMU$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 NMU$FILE_KILL_BUFFERS
%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
!
! This macro computes the width of a bit mask
!
macro
WID (MASK) = %nbitsu(MASK) - (%nbitsu((MASK) and - (MASK)) - 1) %,
POS (MASK) = (%nbitsu((MASK) and - (MASK)) - 1) %,
PW (MASK) = POS(MASK),WID(MASK),0 %,
WRD = 0,36,0 %,
LEFT_HALF = 18,18,0 %,
RIGHT_HALF = 0,18,0 %;
field
FILOP_BLOCK_FIELDS =
set
FILOP_CHANNEL = [$FOFNC, PW(FO$CHN)],
FILOP_FUNCTION = [$FOFNC, PW(FO$FNC)],
FILOP_FLAGS = [$FOFNC, WRD],
FILOP_OPEN_FLAGS = [$FOIOS, WRD],
FILOP_DEVICE = [$FODEV, WRD],
FILOP_OUTPUT_BUFFER_HEADER = [$FOBRH, LEFT_HALF],
FILOP_INPUT_BUFFER_HEADER = [$FOBRH, RIGHT_HALF],
FILOP_BUFFER_HEADERS = [$FOBRH, WRD],
FILOP_OUTPUT_BUFFER_NUMBER = [$FONBF, LEFT_HALF],
FILOP_INPUT_BUFFER_NUMBER = [$FONBF, RIGHT_HALF],
FILOP_RENAME_POINTER = [$FOLEB, LEFT_HALF],
FILOP_LOOKUP_POINTER = [$FOLEB, RIGHT_HALF],
FILOP_ENTER_POINTER = [$FOLEB, RIGHT_HALF],
FILOP_PATH_LENGTH = [$FOPAT, LEFT_HALF],
FILOP_PATH_POINTER = [$FOPAT, RIGHT_HALF]
tes;
field
LOOKUP_BLOCK_FIELDS =
set
LOOKUP_NAME = [0, WRD],
LOOKUP_EXT = [1, LEFT_HALF],
LOOKUP_PATH = [3, RIGHT_HALF]
tes;
field
PATH_BLOCK_FIELDS =
set
PATH_PROJECT = [$PTPPN, LEFT_HALF],
PATH_PROGRAMMER = [$PTPPN, RIGHT_HALF],
PATH_SFD = [$PTSFD, 0, 0, 0]
tes;
local
FILOP_BLOCK : block [$FOPAT+1] field (FILOP_BLOCK_FIELDS),
LOOKUP_BLOCK : block [4] field (LOOKUP_BLOCK_FIELDS),
PATH_BLOCK : block [$PTMAX] field (PATH_BLOCK_FIELDS),
BUFFER_HEADER : ref vector,
TEMP;
!
! First we set up the FILOP, LOOKUP, and PATH blocks with the constant data
!
begin
map
FILOP_BLOCK : vector [$FOPAT+1],
LOOKUP_BLOCK : vector [4],
PATH_BLOCK : vector [$PTMAX];
incr INDEX from 0 to $FOPAT do FILOP_BLOCK [.INDEX] = 0;
incr INDEX from 0 to 3 do LOOKUP_BLOCK [.INDEX] = 0;
incr INDEX from 0 to $PTMAX-1 do PATH_BLOCK [.INDEX] = 0
end;
! Tell monitor to assign channels, and use privs
FILOP_BLOCK [FILOP_FLAGS] = FO$PRV + FO$ASC;
FILOP_BLOCK [FILOP_OPEN_FLAGS] = $IOBIN + 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;
LOOKUP_BLOCK [LOOKUP_PATH] = PATH_BLOCK;
BUFFER_HEADER =
(selectone .FILE [FD_ACCESS] of
set
[FILE_ACCESS_READ_ONLY] : .FILE [FD_BUFFER_HEADERS] and %o '777777';
[FILE_ACCESS_WRITE_ONLY]: .FILE [FD_BUFFER_HEADERS] ^ -18
tes);
!
! Now its time to parse the filespec...
!
!=========================================================================
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];
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 = .FN [FN_NAME_POINTER];
LEN = .FN [FN_LENGTH];
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] : 7;
[otherwise] : 0;
tes);
case .PTABLE [.STATE, .NEWSTATE] from 0 to END$P of
set
[0] :
begin
$RESPONSE (.FILE [FD_RESPONSE], NICE$_FOE,0,
'Illegal file specification. File = ''%#A''',
.FN [FN_LENGTH], .FN [FN_NAME_POINTER]);
return $FALSE
end;
[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
!======================================================================
FILOP_BLOCK [FILOP_BUFFER_HEADERS] = .FILE [FD_BUFFER_HEADERS];
begin
local
GENERATION; ! Generation number for new files
builtin
UUO;
register
T1;
GENERATION = 0;
selectone .FILE [FD_ACCESS] of
set
[FILE_ACCESS_READ_ONLY]:
begin
FILOP_BLOCK [FILOP_FUNCTION] = $FORED;
T1 = ($FOPAT+1) ^ 18 + FILOP_BLOCK;
if not UUO (1, FILOP$(T1)) then
begin
if .T1 eql ERFNF_ then
$RESPONSE (.FILE [FD_RESPONSE], NICE$_FOE, 0,
'File %#A not found.', .FN [FN_LENGTH],
.FN [FN_NAME_POINTER])
else
$RESPONSE (.FILE [FD_RESPONSE], NICE$_FOE, 0,
'Cannot lookup file %#A. LOOKUP error = %O',
.FN [FN_LENGTH], .FN [FN_NAME_POINTER], .T1);
return $FALSE;
end;
end;
[FILE_ACCESS_WRITE_ONLY]:
while $true do
begin
external routine
NMU$SCHED_PAUSE : novalue ;
local
EXTENSION;
FILOP_BLOCK [FILOP_FUNCTION] = $FOCRE;
T1 = ($FOPAT+1) ^ 18 + FILOP_BLOCK;
if UUO (1, FILOP$(T1)) then exitloop;
if .T1 neq ERAEF_ then
begin
$RESPONSE (.FILE [FD_RESPONSE], NICE$_FOE, 0,
'Cannot create file %#A. ENTER error = %O',
.FN [FN_LENGTH], .FN [FN_NAME_POINTER], .T1);
return $FALSE;
end;
NMU$SCHED_PAUSE (); ! We may be here for a while ...
EXTENSION = .LOOKUP_BLOCK [LOOKUP_EXT];
EXTENSION = (.EXTENSION and %O '770000')
+ (.GENERATION/10) ^ 6
+ .GENERATION mod 10
+ %sixbit ' 00';
LOOKUP_BLOCK [LOOKUP_EXT] = .EXTENSION;
GENERATION = .GENERATION + 1;
if .GENERATION gtr 100 then
begin
$RESPONSE (.FILE [FD_RESPONSE], NICE$_FOE, 0,
'Too many generations of file %#A.',
.FN [FN_LENGTH], .FN [FN_NAME_POINTER]);
return $FALSE
end;
end;
tes;
end;
FILE [FD_CHANNEL] = .FILOP_BLOCK [FILOP_CHANNEL];
BUFFER_HEADER [$BFPTR] = FLD(
selectone .FILE [FD_FORMAT] of
set
[FILE_FORMAT_18_FOR_16] : 18;
[FILE_FORMAT_BYTE_STREAM] : 8;
[OTHERWISE] : 36;
tes,
%o'007700000000');
$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
builtin
UUO;
register
T1;
local
ARGLST : vector [2];
ARGLST [0] = .FILE [FD_CHANNEL] ^ 18 + $FOCLS;
ARGLST [1] = 0;
T1 = 2 ^ 18 + ARGLST;
if not UUO (1, FILOP$(T1)) then return $false;
ARGLST [0] = .FILE [FD_CHANNEL] ^ 18 + $FOREL;
T1 = 1 ^ 18 + ARGLST;
if not UUO (1, FILOP$(T1)) then return $false;
$true
end; ! End of CLOSE_FILE
%routine ('READ_FILE', FILE : ref FILE_DATA_BLOCK, DATA) =
!++
!
! Functional description:
!
! This routine will do a buffered mode read from a file. Call it
! once for each byte desired.
!
! Formal parameters:
!
! .FILE Address of file descriptor block
! .DATA Address of where to store data
!
! Routine value:
!
! $true Everythings fine, byte is in DATA.
! $false I/O error occurred while reading. GETSTS
! data is in DATA.
! $eof End of file was encountered.
!
!--
begin
bind
BUFFER_HEADER = .FILE [FD_BUFFER_HEADERS] and %o'777777' : vector;
BUFFER_HEADER [$BFCTR] = .BUFFER_HEADER [$BFCTR] - 1;
if .BUFFER_HEADER [$BFCTR] lss 0 then
begin
local
FILOP_ARGS;
builtin
UUO;
register
T1;
FILOP_ARGS = .FILE [FD_CHANNEL] ^ 18 + $FOINP;
T1 = 1 ^ 18;
T1 = .T1 + FILOP_ARGS;
if not UUO (1, FILOP$(T1)) then
begin
! T1 = .T1 and IO$EOF; \ Commented out
! if .T1 neq 0 then $eof; > because of a
! return $false; / nasty BLISS problem
.DATA = .T1;
return $eof;
end;
BUFFER_HEADER [$BFCTR] = .BUFFER_HEADER [$BFCTR] - 1;
end;
.DATA = ch$rchar_a (BUFFER_HEADER [$BFPTR]);
$true
end; ! End of READ_FILE
%routine ('WRITE_FILE', FILE : ref FILE_DATA_BLOCK, DATA) =
!++
!
! Functional description:
!
! This routine will do a buffered mode write to a file. Call it
! once for each byte you wish to write.
!
! Formal parameters:
!
! .FILE Address of file descriptor block
! .DATA Data to be written to the file
!
! Routine value:
!
! $true Everythings fine, data has been put in buffer
! Not $true Value of routine is GETSTS for the channel
!
!--
begin
bind
BUFFER_HEADER = .FILE [FD_BUFFER_HEADERS] ^ -18 : vector;
BUFFER_HEADER [$BFCTR] = .BUFFER_HEADER [$BFCTR] - 1;
if .BUFFER_HEADER [$BFCTR] lss 0 then
begin
local
FILOP_ARGS;
builtin
UUO;
register
T1;
FILOP_ARGS = .FILE [FD_CHANNEL] ^ 18 + $FOOUT;
T1 = 1 ^ 18;
T1 = .T1 + FILOP_ARGS;
if not UUO (1, FILOP$(T1)) then return .T1;
BUFFER_HEADER [$BFCTR] = .BUFFER_HEADER [$BFCTR] - 1;
end;
ch$wchar_a (.DATA, BUFFER_HEADER [$BFPTR]);
$true
end; ! End of WRITE_FILE