Google
 

Trailing-Edge - PDP-10 Archives - BB-H138F-BM_1988 - 7-sources/fffopn.b36
There are 3 other files named fffopn.b36 in the archive. Click here to see a list.
%TITLE 'FFFOPN -- $OPEN service routines for non-RMS file types'
!<BLF/REQUIRE 'BLI:BLF.REQ'>
MODULE fffopn (IDENT = 'Open'
		) =
BEGIN
!
!	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1985, 1986.
!	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.
!
!
!
!
!    ********** TABLE OF CONTENTS **********
!
!
!
!    ROUTINE                    FUNCTION
!    -------                    --------
!
!    F$Open
!
!+
!  Need a require file similar to RMSREQ.R36
!  which contains library of all FGNLIB
!  routines.
!-

REQUIRE 'fffreq';

REQUIRE 'rmsosd';				! [Lusk] For JSYSes

COMPILETIME
    Load_with_RMS = ((%Variant AND 1) NEQ 0);

EXTERNAL ROUTINE
    uaddr,
    uapointer,
    tgupointer,
    uclass,
    raddr,
    openisam;

FORWARD ROUTINE
!
!   $OPEN processor
!
    f$open,
!
!   $OPEN routines for foreign file types
!
    opensix,
    openebc,
    openfbin;

!
! Global Data
!

%IF Load_with_RMS                                                         !m572
%THEN

EXTERNAL				! Use same locations as RMS

%ELSE

GLOBAL					! Create our own copy

%FI
    fab : REF $fab_decl,
    rab : REF $rab_decl,
    fst : REF $rms_fst,
    rst : REF $rms_rst,
    kdb : REF $rms_kdb,
    cbd : REF $rms_bucket_descriptor,
    adb : REF $rms_adb [8],
    fpt : REF $rms_fpt,
    rmssec,					! RMS's section
    blksec;					! User's xAB section

GLOBAL                                                              !m572
    uab : BLOCK [15],				! $UTLINT argument block
    stksec,					! Section of stack locals
    fffsec;					! Our section
%SBTTL 'F$OPEN -- $OPEN dispatcher'

GLOBAL ROUTINE f$open (usrfab : REF $fab_decl) =
    BEGIN

    BUILTIN
	machop;

    REGISTER
	sec_ac;

    LOCAL
	rsec_addr;

    !+
    !   This gets the section we were called from.
    !   It relies on the fact that the Return addr
    !   follows the args on the stack.
    !   We can't use the RMS entry vector,
    !   it may point to the RMS stub!
    !-

!    BIND ReturnAddress = UsrFab + %UPVAL;	! Reach around stack
    $xmovei (sec_ac, usrfab);
    stksec = .sec_ac AND fff$m_section;		! Set stack's section
    rsec_addr = .sec_ac + 1;			! Point at return PC
    BEGIN

    BIND
	returnaddress = .rsec_addr;

    rmssec = .returnaddress AND fff$m_section;	! Get section of RMS
    END;
    !
    !	This gets our section number.
    !
    $xmovei (sec_ac, %O'20');			! Will get our section number
    fffsec = .sec_ac AND fff$m_section;		! Get our section number

    !+
    !   Save the Fab address away
    !-

    fab = .usrfab;				! Address must be global

    !+
    !   Now get the section the Fab is in
    !-

    blksec = .usrfab AND fff$m_section;		! Save Section Fab came from
    fst = raddr (.fab [fab$a_ifi]);		! Fst has already been created

    !+
    !    Dispatch to the proper "OPEN" routine for this file class
    !-

    (CASE (fst [fst$h_file_class] = uclass (.fab)) FROM typ$k_fff_class_min TO
	typ$k_fff_class_max OF
	SET
	[typ$k_sixbit] : opensix ();		! COBOL SIXBIT
	[typ$k_ebcdic] : openebc ();		! COBOL EBCDIC
	[typ$k_fortran_binary] : openfbin ();	! FORTRAN BINARY
	[typ$k_isam] : openisam ();
	TES);
    RETURN true;
    END;
%SBTTL 'Opensix'

GLOBAL ROUTINE opensix =
    BEGIN

%IF %SWITCHES(TOPS20)
%THEN

    STACKLOCAL
	!
	!   These must be explicitly on the stack in order
	!   to pass their address to the monitor correctly.
	!
	file_bytes,				! Size of file in FDB bytes
	file_words;				! Size of file in words

    LOCAL
	bytes_per_word,				! For calculation
	file_bytsiz : monword;			! Byte size from FDB

    !

    !	Get the size of the file in bytes
    !
    gtfdb (.fst [fst$h_jfn], xwd (1, $fbsiz), .stksec OR file_bytes);
    gtfdb (.fst [fst$h_jfn], xwd (1, $fbbyv), .stksec OR file_bytsiz);

    IF .file_bytsiz [fb_bsz] EQL rms$k_six_size	! Real 6-bit bytes? (Unlikely!)
    THEN
	fst [fst$g_sof] = .file_bytes		! Yes - use real count
    ELSE
	BEGIN					! No - use approximation
	bytes_per_word = %BPVAL/.file_bytsiz [fb_bsz];
	file_words = (.file_bytes + .bytes_per_word - 1)/.bytes_per_word;
	fst [fst$g_sof] = .file_words*rms$k_six_bpw;
	END;

%ELSE	! TOPS-10

    fst[fst$g_sof] = .fst[fst$g_sof_words] * rms$k_six_bpw;

%FI
    fst [fst$h_bsz] = 6;
    RETURN true;
    END;
%SBTTL 'OpenEbc - $OPEN for EBCDIC files'

GLOBAL ROUTINE openebc =
    BEGIN

%IF %SWITCHES(TOPS20)
%THEN

    STACKLOCAL
	!
	!   These must be explicitly on the stack in order
	!   to pass their address to the monitor correctly.
	!
	file_bytes,				! Size of file in FDB bytes
	file_words;				! Size of file in words

    LOCAL
	bytes_per_word,				! For calculation
	file_bytsiz : monword;			! Byte size from FDB

    !

    !	Get the size of the file in bytes
    !
    gtfdb (.fst [fst$h_jfn], xwd (1, $fbsiz), .stksec OR file_bytes);
    gtfdb (.fst [fst$h_jfn], xwd (1, $fbbyv), .stksec OR file_bytsiz);

    IF .file_bytsiz [fb_bsz] EQL rms$k_ebc_size	! Real 9-bit bytes? (Unlikely!)
    THEN
	fst [fst$g_sof] = .file_bytes		! Yes - use real count
    ELSE
	BEGIN					! No - use approximation
	bytes_per_word = %BPVAL/.file_bytsiz [fb_bsz];
	file_words = (.file_bytes + .bytes_per_word - 1)/.bytes_per_word;
	fst [fst$g_sof] = .file_words*rms$k_ebc_bpw;
	END;

%ELSE	! TOPS-10

    fst[fst$g_sof] = .fst[fst$g_sof_words] * rms$k_ebc_bpw;

%FI

    RETURN true;
    END;
GLOBAL ROUTINE openfbin =
    BEGIN

    STACKLOCAL
	!
	!   These must be explicitly on the stack in order
	!   to pass their address to the monitor correctly.
	!
	file_bytes,				! Size of file in FDB bytes
	file_words;				! Size of file in words

    fst [fst$h_bsz] = 36;
    !
    !	Get the size of the file in bytes
    !
%IF %SWITCHES(TOPS20)
%THEN

    gtfdb (.fst [fst$h_jfn], xwd (1, $fbsiz), .stksec OR file_bytes);
    fst [fst$g_sof] = .file_bytes;		! Use real count

%ELSE	! TOPS-10

    fst[fst$g_sof] = .fst[fst$g_sof_words];

%FI

    RETURN true;
    END;

END

ELUDOM