Google
 

Trailing-Edge - PDP-10 Archives - DEC_CMS-20_V1.0_SRC - cms/sources/filtyp.bli
There are no other files named filtyp.bli in the archive.
MODULE filtyp ( !Determine RMS characteristics of a file
    		IDENT = '1',
    		%if 
    		    %bliss(bliss32)
    		%then
    		    language (bliss32),
    		    addressing_mode(external = long_relative,
    				    nonexternal = long_relative)
    		%else
    		    language(bliss36)
    		%fi
        		) =
BEGIN

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

!++
! FACILITY:
!   CMS  library processor
!
! ABSTRACT:
!   Determine the RMS file attributes so CMS can determine if they
!   are admittable to the library.
!
!
! ENVIRONMENT:
!   VAX/VMS ( Dummy for TOPS-20 and TOPS-10)
!
! AUTHOR: Susan Millar, CREATION DATE: Sep 1980
!
! MODIFIED BY:
!
!--
!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
	FILTYP ;			! Determine file attributes

!
! INCLUDE FILES:
!
%if %bliss(bliss32) %then
    library 'SYS$LIBRARY:STARLET' ;
    undeclare %quote $descriptor ;
%fi

%if %bliss(bliss36) %then

require 'jsys:';

%fi
    library 'XPORT:' ;
    require 'BLISSX:' ;
    require 'SCONFG:' ;

%if %bliss(bliss32) %then
    require 'HOSUSR:' ;
%fi
!
!
! MACROS:
!

!
! EQUATED SYMBOLS:
!

!
! OWN STORAGE:
!

!
! EXTERNAL REFERENCES:
!
global routine filtyp ( a_file_iob) =

!++
! FUNCTIONAL DESCRIPTION:
!
! Determine the RMS chararcters of a given file. The file must be
! as follows :
!	File organization : sequential only
!	Record format : Variable length or VFC
!			If the format is VFC, then the fixed size must
!			be zero or two.
!	Record Attributes: Carriage Return only
!
! FORMAL PARAMETERS:
!
! 	a_file_iob : address of an open file iob to be checked
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!	TRUE if the file all the above conditions are met,
!            ( 1 if sequential,
!              3 if sequenced)
!	FALSE otherwise.
!
! SIDE EFFECTS:
!
!	None
!--

    BEGIN
%if %bliss(bliss32) %then    
    local
    file_iob : ref $xpo_iob(),		! iob of file to be examined
    fsz,				! size of fixed portion of VFC record
    rat,				! record attribute
    org,				! file organization
    var,				! record format
    seq;
    

    file_iob = .a_file_iob ;	
    begin
    !
    ! use xport to get address of fab
    !
    bind
        fab = .file_iob[iob$a_rms_fab]:  block[,byte] ;
        

    !initialize all flags
    rat = false ;
    org = false ;
    var = false ;
    seq = false ;
    fsz = true ;		!this is set to true because the normal
    				!rfm is variable, not vfc
    


    rat =			! determine record attributes
	    (.fab[fab$v_cr] and
	    (not .fab[fab$v_prn]) and
	    (not .fab[fab$v_ftn]) )  ;

    org =			! determine file organization
    	    (.fab[fab$b_org] eql fab$c_seq) ;
    
    var =			! determine record format
    	    (.fab[fab$b_rfm] eql fab$c_var) ;

    seq =
            (.fab[fab$b_rfm] eql fab$c_vfc );
                
    if
        .seq
    then			!only accept a header of length 0 or 2
    	if 
    	    .fab[fab$b_fsz] eql 2 or
    	    .fab[fab$b_fsz] eql 0
    	then
    	    fsz = true 
    	else
    	    fsz = false ;


    	
    if
       (.rat and .org and .var and .fsz)
    then
       return 1;

    if
       (.rat and .org and .seq and .fsz)
    then
       return 3;

    false
    
    end 
%fi
%if %bliss(bliss36) %then
	true
%fi

    END;			! end of routine filtyp


END				! End of module
ELUDOM