From:	CSBVAX::MRGATE!RELAY-INFO-VAX@CRVAX.SRI.COM@SMTP 18-OCT-1988 03:11
To:	ARISIA::EVERHART
Subj:	Fast TAIL


Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Mon, 17 OCT 88 22:12:03 PDT
Received: from ucbvax.Berkeley.EDU by KL.SRI.COM with TCP; Mon, 17 Oct 88 21:57:08 PDT
Received: by ucbvax.Berkeley.EDU (5.59/1.31)
	id AA20521; Mon, 17 Oct 88 21:15:05 PDT
Received: from USENET by ucbvax.Berkeley.EDU with netnews
	for info-vax@kl.sri.com (info-vax@kl.sri.com)
	(contact usenet@ucbvax.Berkeley.EDU if you have questions)
Date: 15 Oct 88 22:11:09 GMT
From: mcvax!enea!sommar@uunet.uu.net  (Erland Sommarskog)
Organization: ENEA DATA AB, Sweden
Subject: Fast TAIL
Message-Id: <3999@enea.se>
Sender: info-vax-request@kl.sri.com
To: info-vax@kl.sri.com

This is it. A TAIL utility that maps the file to a global
section. 9 seconds (VAX 11/750) to get to the end of STARLET.PAS 
as compared to 2 minutes for a TAIL uses standard I/O, like the 
one that was posted a while ago here. And, yes, it works on open 
log files. 

The author of this necessity is Thomas Nilsson. He has a  
read-only access to comp.os.vms/INFO-VAX so I'm posting
this for him. Please direct all question, comments, thanks
etc to him, not me. His address is MTK_TNN@kiera.ericsson.se.
Whether this address works universally, I don't know. If you
have troubles to reach him you could try the path:
   ...uunet!enea!kiera.ericsson.se
If nothing else works, mail me, and I will forward.

Below follows the archive file and Thomas' own comments. Some
warnings first, though. The archive contains a MAKEFILE.COM,
check what it does before you run it. You may prefer to build
TAIL by hand. If you run it, give a complete device and 
directory specification when it asks where to put TAIL.
I tried SYS$DISK:<>, that was not good.
  Also note that the CLD file is a template, the IMAGE line is
missing. Either the MAKEFILE add it for you, or you have to
do it yourself.
  
IMPORTANT NOTE: The VMS_SHARE file says there are two parts.
I have concatenated the parts to one, so don't look for another
article. This is all there is.

Erland Sommarskog            
ENEA Data, Stockholm         
sommar@enea.UUCP             
----------------------------------------------------------------------
From: Thomas Nilsson ERA/KI/BT/KRTC Sweden <MTK_TNN@kiera.ericsson.se>

Hi,


this is a FAST TAIL that maps the file(s) into memory before the 
tailing. 

@makefile

There might be a few creatures involved called "bugs", in the system-wide
make part. Please check it up before you use it. The local make works OK.

A small help is added to HELP.

I timed this TAIL and found it to be 15-20 times faster than the usual
RMS-based ones (I.e. readln/writeln based or similar).


All question regarding this TAIL should be mailed to:

mtk_tnn@kiera.ericsson.se

$!.............................................................................
$! VAX/VMS archive file created by VMS_SHARE V06.00 26-May-1988.
$!
$! VMS_SHARE was written by James Gray (Gray:OSBUSouth@Xerox.COM) from
$! VMS_SHAR by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au).
$!
$! To unpack, simply save, concatinate all parts into one file and
$! execute (@) that file.
$!
$! This archive was created by user MTK_TNN
$! on  6-APR-1866 20:07:23.75.
$!
$! ATTENTION: To keep each article below 31 blocks (15872 bytes), this
$!            program has been transmitted in 2 parts.  You should
$!            concatenate ALL parts to ONE file and execute (@) that file.
$!
$! It contains the following 5 files:
$!        MAKEFILE.COM
$!        TAIL.HLP
$!        TAIL.PAS
$!        TAIL_MSG.MSG
$!        TAIL_TEMPLATE.CLD
$!
$!==============================================================================
$ SET SYMBOL/SCOPE=( NOLOCAL, NOGLOBAL )
$ VERSION = F$GETSYI( "VERSION" )
$ IF VERSION .GES "V4.4" THEN GOTO VERSION_OK
$ WRITE SYS$OUTPUT "You are running VMS ''VERSION'; ", -
    "VMS_SHARE V06.00 26-May-1988 requires VMS V4.4 or higher."
$ EXIT 44 
$VERSION_OK:
$ GOTO START
$
$UNPACK_FILE:
$ WRITE SYS$OUTPUT "Creating ''FILE_IS'"
$ DEFINE/USER_MODE SYS$OUTPUT NL:
$ EDIT/TPU/COMMAND=SYS$INPUT/NODISPLAY/OUTPUT='FILE_IS'/NOSECTION -
    VMS_SHARE_DUMMY.DUMMY
b_part := CREATE_BUFFER( "{Part}", GET_INFO( COMMAND_LINE, "file_name" ) )
; s_file_spec := GET_INFO( COMMAND_LINE, "output_file" ); SET( OUTPUT_FILE
, b_part, s_file_spec ); b_errors := CREATE_BUFFER( "{Errors}" ); i_errors 
:= 0; pat_beg_1 := ANCHOR & "-+-+-+ Beginning"; pat_beg_2 := LINE_BEGIN 
& "+-+-+-+ Beginning"; pat_end := ANCHOR & "+-+-+-+-+ End"; POSITION
( BEGINNING_OF( b_part ) ); i_append_line := 0; LOOP EXITIF MARK( NONE 
) = END_OF( b_part ); s_x := ERASE_CHARACTER( 1 ); IF s_x = "+" THEN r_skip 
:= SEARCH( pat_beg_1, FORWARD, EXACT ); IF r_skip <> 0 THEN s_x := ""
; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ERASE_LINE; ENDIF; ENDIF
; IF s_x = "-" THEN r_skip := SEARCH( pat_end, FORWARD, EXACT ); IF r_skip <
> 0 THEN s_x := ""; MOVE_HORIZONTAL( -CURRENT_OFFSET ); m_skip := MARK( NONE )
; r_skip := SEARCH( pat_beg_2, FORWARD, EXACT ); IF r_skip <> 0 THEN POSITION
( END_OF( r_skip ) ); MOVE_HORIZONTAL( -CURRENT_OFFSET ); MOVE_VERTICAL( 1 )
; MOVE_HORIZONTAL( -1 ); ELSE POSITION( END_OF( b_part ) ); ENDIF; ERASE
( CREATE_RANGE( m_skip, MARK( NONE ), NONE ) ); ENDIF; ENDIF
; IF s_x = "V" THEN s_x := ""; IF i_append_line <> 0 THEN APPEND_LINE
; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF; i_append_line := 1; MOVE_VERTICAL
( 1 ); ENDIF; IF s_x = "X" THEN s_x := ""; IF i_append_line <
> 0 THEN APPEND_LINE; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF
; i_append_line := 0; MOVE_VERTICAL( 1 ); ENDIF; IF s_x <> "" THEN i_errors 
:= i_errors + 1; s_text := CURRENT_LINE; POSITION( b_errors ); COPY_TEXT
( "The following line could not be unpacked properly:" ); SPLIT_LINE
; COPY_TEXT( s_x ); COPY_TEXT( s_text ); POSITION( b_part ); MOVE_VERTICAL( 1 
); ENDIF; ENDLOOP; POSITION( BEGINNING_OF( b_part ) ); LOOP r_x := SEARCH( "`"
, FORWARD, EXACT ); EXITIF r_x = 0; POSITION( r_x ); ERASE_CHARACTER( 1 )
; IF CURRENT_CHARACTER = "`" THEN MOVE_HORIZONTAL( 1 ); ELSE COPY_TEXT( ASCII
( INT( ERASE_CHARACTER( 3 ) ) ) ); ENDIF; ENDLOOP; IF i_errors = 0 THEN SET
( NO_WRITE, b_errors, ON ); ELSE POSITION( BEGINNING_OF( b_errors ) )
; COPY_TEXT( FAO( "The following !UL errors were detected while unpacking !AS"
, i_errors, s_file_spec ) ); SPLIT_LINE; SET( OUTPUT_FILE, b_errors
, "SYS$COMMAND" ); ENDIF; EXIT; 
$ DELETE VMS_SHARE_DUMMY.DUMMY;*
$ CHECKSUM 'FILE_IS
$ WRITE SYS$OUTPUT " CHECKSUM ", -
  F$ELEMENT( CHECKSUM_IS .EQ. CHECKSUM$CHECKSUM, ",", "failed!,passed." )
$ RETURN
$
$START:
$ FILE_IS = "MAKEFILE.COM"
$ CHECKSUM_IS = 1264399222
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X$  on error then goto clean
X$  !
X$  ! Ask a few questions to start with
X$  ! 
X$  say = "write sys$output"
X$  inquire syswide "Do you want to generate TAIL system-wide (Y/N) "
X$  if syswide then goto sys_wide
X$ one_more:
X$     say "Where do you want to put the"
X$     inquire bin_dir "executable file "
X$     if F$LOCATE(":",bin_dir) .NE. F$LENGTH(bin_dir) then -
X         goto create_files
X$     say " "
X$     say "You must include a disk specification!"
X$     say " "
X$     goto one_more
X$ sys_wide:
X$  bin_dir = "SYS$SYSTEM:"
X$ create_files:
X$  !
X$  ! Generate all files you need
X$  !
X$  say " Creating message file..."
X$  message tail_msg
X$  say " Compiling tail..."
X$  pascal/nolist tail
X$  say " Linking tail..."
X$  link/notrace tail,tail_msg
X$  say " Moving TAIL to "+"''bin_dir'"+"..."
X$  set protection=(g:e,w:e,s:re,o:rewd) tail.exe
X$  exe_file = "''bin_dir'"+"TAIL.EXE"
X$  if syswide then on error goto no_priv
X$  copy tail.exe 'exe_file
X$  !
X$  ! Create a correct CLD file
X$  !                  
X$  say " Creating CLD file..."
X$  copy tail_template.cld tail.cld
X$  open/append cld tail.cld
X$  write cld "     IMAGE "+ exe_file       
X$  close cld
X$  if syswide then goto load_syswide
X$     dir = F$ENVIRONMENT("DEFAULT")
X$     set command tail
X$     say " Creating help library..."
X$     library/help/creat tail tail
X$     hlplib = "''dir'"+"TAIL"
X$     define/nolog HLP$LIBRARY 'hlplib
X$     goto clean
X$  !
X$  ! Load the stuff systemwide...
X$  !
X$  say " Replacing DCLTABLES..."
X$  set command/replace/table=sys$library:dcltables -
X              /output=sys$library:dcltables tail
X$  install = "$install/command"
X$  install
Xreplace sys$library:dcltables
Xexit                         
X$  say " Inserting help..."
X$  library/help/insert SYS$LIBRARY:HELPLIB TAIL
X$ clean:                            
X$  on error then continue
X$  say " Cleaning..."
X$  delete/noconfirm/nolog tail.obj;*
X$  delete/noconfirm/nolog tail_msg.obj;*
X$  purge/nolog 'exe_file
X$  delete/nolog/noconfirm tail.exe;*
X$  purge/nolog tail.cld
X$  purge/nolog tail.hlb
X$  exit
X$ no_priv:
X$  say " No privilegie for attempted operation"
X$  goto clean:
X                                    
$ GOSUB UNPACK_FILE
$ FILE_IS = "TAIL.HLP"
$ CHECKSUM_IS = 1686048874
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X
X1 TAIL
X  TAIL
X
X  TAIL is a program that displays the last N lines of a file.
X  The format of the TAIL command is:
X
X      $ TAIL[/LINES=N][/OUTPUT=output-spec][LOG] file-spec
X
X  A related command is MORE. Type HELP MORE for information
X
X2 file-spec
X  file-spec
X
X  Wildcards and multiple file specifications are recognised and valid.
X
X2 /LINES
X  /LINES=n
X
X  The optional qualifier specifies the number of lines to be displayed.
X  The default is 20.
X
X2 /OUTPUT
X  /OUTPUT=output-spec
X
X  The qualifier specifies the output file.
X  The default is SYS$OUTPUT.
X
X2 /LOG
X  /LOG
X
X  The qualifier logs the behaviour of TAIL.
$ GOSUB UNPACK_FILE
$ FILE_IS = "TAIL.PAS"
$ CHECKSUM_IS = 1917391668
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X[inherit ('SYS$LIBRARY:STARLET')]
X
X
Xprogram fast_tail(output);
X
X(* A fast version of tail
X   
X
X   Written by Thomas Nilsson
X              ERA/KI/BT/KRTC
X              Ericsson Radio Systems AB
X              Sweden
X              870506         
X
X   Thanks to Anders Johansson, DIGITAL (DEC) Sweden
X   who solved the "File currently locked problem" *)
X
Xconst
X   CLI$_ABSENT = 229872;
X   CLI$_PRESENT = 261401;
X   CLI$_NEGATED = 229880;
X   CLI$_DEFAULTED = 261409;
X   CLI$_COMMA = 261433;
X
X   (* Memory used after the mapping is done *)
X
X   pool_size = 50;
X
X   %include 'SYS$LIBRARY:PASSTATUS.PAS'
X
Xtype
X      line_pointer   =      ^lines;
X      lines   =
X
X         (* Record used in circulate list *)
X
X         record
X            line      :      ^mem_line;
X            next_line :      line_pointer;
X         end;
X
X      mem_line      =
X
X         (* Record used in memory *)
X
X         record
X            length  :    [word]  0..65535;
X            body    :    packed array[1..255] of char;
X         end;
X
X      word_integer   =     [word]   0..65535;
X      byte_integer   =     [byte]   0..255;
X
X      FType          =     File of varying [255] of char;
X      file_mem_adr   =     array [0..1] of unsigned;
X
X
Xvar
X      no_of_lines     :      integer;
X      block_size      :      integer;
X      context         :      unsigned;
X      file_name       :      [volatile] varying [132] of char;
X      start_of_list,end_of_list
X                      :      line_pointer;
X      input           :      FType;
X      file_alloc_size :      unsigned;
X      XAB             :      [unsafe] ^XAB$TYPE;
X      log             :      boolean;
X      return          :      integer;
X      channel         :      unsigned;
X      in_file_mem,
X      out_file_mem    :      file_mem_adr;
X      lines_loaded    :      integer;
X      count           :      integer;
X      file_found      :      boolean;
X      multiple_files  :      boolean;
X      ebk             :      unsigned;
X      ffb             :      word_integer;
X
X
X
X[external] function CLI$GET_VALUE (
X         entity_desc    :  packed array[a..b : integer] of char;
X         var retdesc    :  packed array[c..d : integer] of char;
X         var retlength  :  word_integer := %immed 0) : integer; extern;
X
X
X[external] function CLI$PRESENT (
X         entity_desc    :  packed array[a..b : integer] of 
X                              char) : integer; extern;
X
X
X[external] function LIB$FIND_FILE (
X         file_spec         :  packed array[a..b : integer] of char;
X         var result_spec   :  packed array[c..d : integer] of char;
X         var context       :  unsigned;
X         default_spec      :  packed array[e..f : integer] of char := 
X                              %immed 0;
X         related_spec      :  packed array[g..h : integer] of char :=
X                              %immed 0;
X         var stv_addr      :  unsigned := %immed 0;
X         user_flags        :  unsigned := %immed 0) : integer; extern;
X
X
X[external] function  LIB$FIND_FILE_END (
X         context           :  unsigned) : integer; extern;
X
X                    
X[external] function LIB$FREE_VM_PAGE (
X         num_pages: integer;
X         base_adr: unsigned) : integer; extern;
X
X
X[external] function LIB$GET_VM_PAGE (
X         num_pages: integer;
X         var base_adr: unsigned) : integer; extern;
X
X
X[external] function LIB$SIGNAL (
X         %immed condition_value :      unsigned;
X         %immed number         :       integer:= %immed 0;
X          FAO_arg        :  [list,unsafe] integer:= %immed 0): integer;
X                                  extern;
X
X
X[external] function LIB$STOP (
X         %immed condition_value1  :  integer) : integer; extern;
X
X
X(* The following declarations are used by LIB$SIGNAL *)
X
Xprocedure tail_numoutrng; extern;
Xprocedure tail_filnotfou; extern;
Xprocedure tail_openout; extern;
Xprocedure tail_openin; extern;
Xprocedure tail_lintolong; extern;
Xprocedure tail_nullfile; extern;
Xprocedure tail_wrgfilform; extern;
Xprocedure tail_tailed; extern;
Xprocedure tail_tottailed; extern;
X
X
Xprocedure initiate;
X
X(* Initiate the stuff *)
X
X
X   procedure check_input;
X      
X   (* Check if the /LINES,/LOG or /OUTPUT qualifier are present
X      and if multiple files and/or wildcards are specified *)
X
X
X   var
X      string,output_file,      
X      cmd_line       :      varying [132] of char;
X 
X
X      procedure command_line_error;
X
X      (* Exit the program if a wrong number is entered *)
X
X      begin
X         lib$signal(iaddress(TAIL_NUMOUTRNG));
X      end;
X
X
X   begin
X
X      (* Get the number of lines to tail *)
X
X      return:=cli$get_value (
X               entity_desc:='lines',
X               retdesc:=string.body,
X               retlength:=string.length);
X      readv(string,no_of_lines);       
X      if no_of_lines <= 0 then command_line_error;
X      log:= (CLI$PRESENT(entity_desc:='log') = CLI$_PRESENT);
X
X      (* Reopen the output with a wider linewidth
X         and maybe a different file name *)
X
X      close(output);
X      return:=cli$get_value (
X            entity_desc:='output',
X            retdesc:=output_file.body,
X            retlength:=output_file.length);
X      open(output,file_name:=output_file,record_length:=255,
X            error:=continue);           
X      if status(output) <> PAS$K_SUCCESS then
X         lib$signal(iaddress(TAIL_OPENOUT),
X                    2,
X                    %immed output_file.length,
X                    output_file.body);
X      rewrite(output);
X
X      (* Check if multiple files and wildcards are specified *)
X
X      multiple_files:=false;
X      return:=cli$get_value (
X            entity_desc:='$line',
X            retdesc:=cmd_line.body,
X            retlength:=cmd_line.length);
X      if (index(cmd_line,'*') <> 0) or
X         (index(cmd_line,'%') <> 0) or
X         (index(cmd_line,',') <> 0) or
X         (index(cmd_line,'...') <> 0) then
X         multiple_files:=true;
X
X   end;                                      
X                                           
X
X   procedure init_list;
X
X   (* Creates a circular linked list with the size "no_of_lines" *) 
X
X   var
X      i               :      integer;
X      new_line,prev_line
X                      :      line_pointer;
X   
X
X   begin
X      new(start_of_list);
X      prev_line:=start_of_list;
X      new_line:=start_of_list;
X      for i:=1 to no_of_lines-1 do
X      begin
X         new(new_line);
X         prev_line^.next_line:=new_line;
X         prev_line:=new_line;
X      end;
X
X      (* Start_of_list point to the first line                  
X         and end_of_list to the block AFTER the last block.
X         The end_of_list is later initiated to nil *)
X
X      new_line^.next_line:=start_of_list;
X   end;
X
X
Xbegin
X   count:=0;
X   file_found:=false;
X   check_input;
X   init_list;
Xend;
X
X
Xprocedure load_file;
X
X(* Load file into memory.
X
X   This is the procedure as described in:
X
X                   VAX/VMS Run time library,
X                   Memory Allocation Procedures,
X                   page 8-20,
X                   release April 1986 *)
X
Xbegin
X
X   (* Create a memory pool *)
X
X   return:=lib$get_vm_page (
X               num_pages:=pool_size,
X               base_adr:=in_file_mem[0]);
X   if not odd(return) then lib$stop(return);
X   return:=lib$free_vm_page (
X               num_pages:=pool_size,
X               base_adr:=in_file_mem[0]);
X   if not odd(return) then lib$stop(return);
X
X   (* Map the file, inadr is in P0 space *)
X
X   return:=$crmpsc (
X               inadr:=1000,
X               retadr:=out_file_mem,
X               flags:=SEC$M_EXPREG,
X               chan:=int(channel));
X   if not odd(return) then lib$stop(return);
Xend;
X
X
Xprocedure unload_file;
X
X(* Free the memory used to hold the file, and the channel,
X   if we don't do this we run out of quotas
X
X   The following lines releases the pages in a
X   proper way *)
X
Xbegin
X
X   (* Unmap the file and deassign the channel *)
X
X   return:=$deltva(inadr:=out_file_mem);
X   if not odd(return) then lib$stop(return);
X   return:=$dassgn(chan:=%immed int(channel));
X   if not odd(return) then lib$stop(return);
Xend;
X
X
Xfunction get_records: boolean;
X
X(* Read line pointers from memory into the circulate list *)
X
Xvar
X   buffer      :      [volatile] varying [255] of char;
X   pointer     :      line_pointer;
X   mem_pnt     :      [unsafe] ^mem_line;
X   mem_pos_calc
X               :      unsigned;
X   last_byte   :      unsigned;
X
X
X   procedure line_to_long;
X
X   (* A line with length > 255 found *)
X
X   begin
X      lib$signal(iaddress(TAIL_LINTOLONG),
X                 2,
X                 %immed file_name.length,
X                 file_name.body);
X
X      (* Signal line to long *)
X
X      get_records:=false;
X   end;
X
X
Xbegin
X
X   (* Do the loading from memory *)
X
X   get_records:=true;
X
X   (* Calculate where the last byte in the file 
X      is mapped by using the FAB data extracted above *)
X
X   last_byte:=((int(ebk)-1)*block_size + int(ffb)) + out_file_mem[0];
X
X   pointer:=start_of_list;
X   end_of_list:=nil;
X   mem_pos_calc:=out_file_mem[0];
X   mem_pnt:=mem_pos_calc;
X   lines_loaded:=0;
X   while (mem_pos_calc < last_byte) and (mem_pnt^.length < 256) do
X      with pointer^ do
X      begin
X
X         (* Save ONLY the memoryposition where the record starts *)
X
X         line:=mem_pnt;
X         if (start_of_list = end_of_list) then
X               start_of_list:=next_line;
X         end_of_list:=next_line;
X
X         (* Calculate the start of next record *)
X
X         mem_pos_calc:=mem_pos_calc+2+((mem_pnt^.length+1) div 2)*2;
X         mem_pnt:=mem_pos_calc;
X         pointer:=next_line;
X         lines_loaded:=lines_loaded+1;
X   end;
X   if (mem_pos_calc < last_byte) and (mem_pnt^.length > 255) then
X
X         (* No end of file found *)
X
X         line_to_long;
X
Xend;
X
X
Xprocedure output_data;
X
X(* Write the data to the output_file (prob. the screen) *) 
X          
Xvar
X   pointer         :      line_pointer;
X   buffer          :      varying [255] of char;
X
Xbegin
X   if multiple_files then
X   begin
X
X      (* If multple files, write the filename at the 
X         beginning of each new file *)
X
X      writeln;
X      writeln(file_name);
X      writeln;
X   end;
X
X   pointer:=start_of_list;
X   repeat                                               
X      with pointer^ do
X      begin
X
X         (* Load the memoryrecord into a buffer *)
X
X         buffer.length:=line^.length;
X         buffer.body:=substr(line^.body,1,buffer.length);
X         writeln(buffer);     
X         pointer:=next_line;
X      end;
X   until  (pointer = end_of_list) or (end_of_list = nil);
Xend;
X
X
Xprocedure statistic;
X
X(* Gives you some information about each tailing *)
X
X   function min(x,y : integer): integer;
X
X   (* Returns the minimum value of x and y *)
X
X   begin
X      if x < y then
X         min:=x
X      else
X         min:=y;
X   end;
X
Xbegin
X
X   (* Show number of lines actualy tailed from file *)
X
X   lines_loaded:=min(no_of_lines,lines_loaded);
X   lib$signal(iaddress(TAIL_TAILED),
X              3,
X              %immed lines_loaded,
X              %immed file_name.length,
X              file_name.body);
Xend;                                           
X
X
Xprocedure total_statistic;
X
X(* Gives you some information about the total tailing *)
X
Xbegin
X
X   (* Show number of files succesfully tailed *)
X
X   lib$signal(iaddress(TAIL_TOTTAILED),
X              1,
X              %immed count);
Xend;
X
X
Xprocedure process_files;
X
X(* Get the file names and process each file *)
X
Xvar                                  
X   buffer                 :       packed array [1..132] of char;
X   wild_file_name         :       varying [132] of char;
X   cli_return             :       integer;
X
X
X   procedure get_block_size;
X
X   (* Get the blocksize of the device used *)
X
X   type
X      item_type = [byte(16)] record
X                  buffer_length   :  [pos(0)] word_integer;
X                  item_code       :  [pos(16)] word_integer;
X                  buffer_add      :  [pos(32),unsafe] ^unsigned;
X                  ret_len_add     :  [pos(64)] ^unsigned;
X                  terminator      :  integer;
X               end;
X
X   var
X      item_block  :     item_type;
X      buffer      :     [volatile] integer;
X      ret_len     :     [volatile] unsigned;
X      dev_name    :     packed array [1..132] of char;
X
X   begin
X      with item_block do
X      begin
X
X         (* Build a GETDVI block *)
X
X         item_code:= DVI$_DEVBUFSIZ;
X         buffer_length:= 4;
X         buffer_add:= address(buffer);
X         ret_len_add:= address(ret_len);
X         terminator:=0;
X      end;
X
X      (* Extract the device name *)
X
X      dev_name:=substr(file_name,1,index(file_name,':'));
X
X      return:=$getdviw( devnam:=dev_name,
X                             itmlst:= item_block);
X      if not odd(return) then lib$stop(return);
X      block_size:=buffer;
X   end;
X
X                                              
X   procedure open_file;
X
X   var
X      empty      :      boolean;
X
X   (* Open the file *)
X
X      function spec_open (                   
X                  var FAB   :   FAB$TYPE;
X                  var RAB   :   RAB$TYPE;
X                  var F     :   FType): integer;
X
X      (* Open the file "input" and gets the allocation size,
X         eof information and a channel *)
X                    
X      begin
X         FAB.FAB$V_SHRGET:=true; 
X         FAB.FAB$V_SHRPUT:=true; 
X         FAB.FAB$V_UPI:=true;  
X         FAB.FAB$V_UFO:=true;  
X         return := $open(FAB);
X         spec_open:=return;
X    
X
X         if return = RMS$_NORMAL then
X         begin
X
X            (* If the file is correct open extract
X               data from the FAB *)
X
X            channel:=FAB.FAB$L_STV;
X            XAB:=FAB.FAB$L_XAB;
X
X            (* Get last virtual (End of file) BlocK = ebk
X               and First Free Byte = ffb *)
X
X            ebk:=XAB^.XAB$L_EBK;
X            ffb:=XAB^.XAB$W_FFB;
X
X            (* Get the allocated file size *)
X
X            file_alloc_size:=FAB.FAB$L_ALQ;
X
X            (* Check if the file is empty *)
X
X            empty:=false;
X            if file_alloc_size = 0 then
X            begin
X               lib$signal(iaddress(TAIL_NULLFILE),
X                          2,
X                          %immed file_name.length,
X                          file_name.body);
X
X               (* Mark the file as empty *)
X   
X               empty:=true;
X            end;
X         end;
X      end;
X                                              
X             
X   begin
X      get_block_size;
X      open(input,file_name:=file_name,history:=readonly,
X            user_action:= spec_open,error:=continue);
X      return:=status(input);
X      if return <> PAS$K_SUCCESS then
X      begin
X         if return in [ PAS$K_ACCMETINC,
X                        PAS$K_RECLENINC,
X                        PAS$K_RECTYPINC,
X                        PAS$K_ORGSPEINC ] then
X         begin
X
X            (* These errors are returned from pascal status
X               if the file format is incorrect *)
X                                           
X            lib$signal(iaddress(TAIL_WRGFILFORM),
X                       2,
X                       %immed file_name.length,
X                       file_name.body);
X
X            (* With this error PASCAL has assigned a channel
X               that we have to release, if not, we run out of
X               open file quota *)
X
X            return:=$dassgn(chan:=%immed int(channel));
X            if not odd(return) then lib$stop(return);
X
X         end
X         else
X         
X            (* This error might happen *)
X
X            lib$signal(iaddress(TAIL_OPENIN),
X                       2,
X                       %immed file_name.length,
X                       file_name.body);
X      end
X      else
X      begin 
X
X         (* Close the file in pascal sense *)
X
X         close(input);
X
X         if not empty then
X         begin
X
X            (* Do the tailing *)
X
X            load_file;
X            if get_records then
X            begin
X               count:=count+1;
X               output_data;
X               if log then statistic;
X            end;
X            unload_file;
X         end;
X      end;
X   end;
X
X
Xbegin
X   repeat
X      cli_return:=cli$get_value (
X            entity_desc:='input',
X            retdesc:=wild_file_name.body,
X            retlength:=wild_file_name.length);
X      while lib$find_file(file_spec:=wild_file_name,
X                            result_spec:=buffer,
X                            context:=context,
X                            user_flags:=2) <> RMS$_NMF do
X      begin
X
X         (* Process each file one by one *)
X
X         file_found:=true;
X         file_name.length:=index(buffer,' ')-1;
X         file_name.body:=buffer;
X         open_file;
X      end;
X
X
X   until cli_return <> CLI$_COMMA; 
X
X   (* End the search *)
X
X   lib$find_file_end(context:=context);
X
X   if not file_found then
X   begin
X
X      (* No file has mached the filespecification *)
X
X      lib$signal(iaddress(TAIL_FILNOTFOU),
X                 2,
X                 %immed wild_file_name.length,
X                 wild_file_name.body);
X   end;             
Xend;
X
X
Xbegin
X   initiate;
X   process_files;
X   if log and multiple_files then total_statistic;
Xend.
$ GOSUB UNPACK_FILE
$ FILE_IS = "TAIL_MSG.MSG"
$ CHECKSUM_IS = 1300066868
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X.FACILITY TAIL, 1
X
X.SEVERITY SUCCESS
X     TAILED <!UL lines tailed from !AD>/FAO_COUNT=3
X     TOTTAILED <a total of !UL files tailed>/FAO_COUNT=1
X.SEVERITY INFORMATION
X     NULLFILE    "file !AD contains no records"/FAO_COUNT=2
X.SEVERITY ERROR
X     WRGFILFORM  "file !AD has wrong format"/FAO_COUNT=2
X     LINTOLONG   "file !AD contains line longer than 255 byte"/FAO_COUNT=2
X     OPENIN      "error opening !AD as input"/FAO_COUNT=2
X.SEVERITY FATAL
X     NUMOUTRNG   "number of lines is out of range"
X     FILNOTFOU   "file !AD not found"/FAO_COUNT=2
X     OPENOUT     "error opening !AD as output"/FAO_COUNT=2
X.END
$ GOSUB UNPACK_FILE
$ FILE_IS = "TAIL_TEMPLATE.CLD"
$ CHECKSUM_IS = 274941906
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
XDEFINE VERB tail
X     parameter p1,value(required,type=$file,list,noconcatenate),label=input,
X               prompt="Tailing file"
X               ! This is the file to process
X
X     qualifier lines,nonnegatable,default,value(TYPE=$number,default=20)
X               ! The number of lines you want to see
X     qualifier output,nonnegatable,default,value(TYPE=$file,
X                  default=SYS$OUTPUT)
X               ! Where the output will go
X     qualifier log
X               ! Gives you some informal messages
$ GOSUB UNPACK_FILE
$ EXIT

