Google
 

Trailing-Edge - PDP-10 Archives - cuspbinsrc_1of2_bb-x128c-sb - 10,7/dil/dilsrc/nxtfil.bli
There are 21 other files named nxtfil.bli in the archive. Click here to see a list.
MODULE NXTFIL(                          ! Get next file from list of files
              IDENT='3'
              %BLISS36(,
                  ENTRY(DAP$NEXTFILE)
                      )
              ) =
BEGIN
!  COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 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.


!++
! FACILITY:  DAP
!
! ABSTRACT:  Routines to transfer records or blocks of file data.
!
!
! ENVIRONMENT:  RMS, BLISSNET, XPORT, Transportable code.
!
! AUTHOR:	Andrew Nourse, CREATION DATE:  14-Sep-82
!
! Edit (%O'1', '12-Apr-84', 'Sandy Clemens')
! %( Add the TOPS-10 DAP sources for DIL V2.  Use the standard DIL
!    edit history format.
! )%
!
! Edit (%O'5', '5-Oct-84', 'Sandy Clemens')
!  %( Add new format of COPYRIGHT notice.  FILES:  ALL )%
!
! 03    - Start TOPS-10 support [Doug Rayner]
! 02    - Filespec components (except node) should not be sticky
! 01	- Write code to handle multiple local input filespecs
!--
!
! INCLUDE FILES:
!

!LIBRARY 'BLI:XPORT';
 LIBRARY 'RMS';
 LIBRARY 'BLISSNET';
 LIBRARY 'CONDIT';
 LIBRARY 'DAP';

!
! Table of Contents
!

FORWARD ROUTINE
DAP$NEXTFILE;

!
! Externals
!
EXTERNAL ROUTINE DAP$MERGE,
                 DAP$CLOSE,
                 R$NULL,
                 DAP$OPENFILE;

GLOBAL ROUTINE DAP$NEXTFILE(FAB: REF $FAB_DECL, ERR)=
BEGIN
BIND NAM=.FAB[FAB$A_NAM]: $NAM_DECL;
BIND DIB=.FAB[FAB$A_DIB]: $DIB;
LOCAL BEGPTR;
IF NAM EQL 0 THEN RETURN 0;             ! Cannot do without name block

BEGPTR=CH$PLUS(.FAB[FAB$A_FNA],.NAM[NAM$H_WCC_NEXT]); ! Point to spec delimiter
SELECT CH$RCHAR_A(BEGPTR) OF
SET
[%C',', %C'+']:
     BEGIN
     LOCAL FUNCTION;
     LOCAL NEWFAB;

     FUNCTION=.DIB[DIB$B_OPERATION];
     NEWFAB=.DIB[DIB$A_NEW_FAB];

     NAM[NAM$H_WCC_NEXT]=.NAM[NAM$H_WCC_NEXT]+1;
     CH$WCHAR(0,CH$PTR(NAM[NAM$T_DEV]));        ![2] Should not be sticky
     CH$WCHAR(0,CH$PTR(NAM[NAM$T_DIR]));        ![2] Should not be sticky
     CH$WCHAR(0,CH$PTR(NAM[NAM$T_NAM]));        ![2] Should not be sticky
     CH$WCHAR(0,CH$PTR(NAM[NAM$T_EXT]));        ![2] Should not be sticky
     CH$WCHAR(0,CH$PTR(NAM[NAM$T_VER]));        ![2] Should not be sticky

     DAP$MERGE(FAB[$],MERGE$M_EXPANDED+MERGE$M_POINT,.ERR);
     DAP$CLOSE(FAB[$],DAP$K_ACCOMP_PURGE,R$NULL); ![2] Close old access if any
     DAP$OPENFILE(FAB[$],.FUNCTION,.NEWFAB,.ERR);
     (.FAB[FAB$H_STS] EQL RMS$_SUC)
     END;
[OTHERWISE]: 0;
TES
END;
END ELUDOM