SPL,L,O,M 
!     NAME:   CR..
!     SOURCE: 92071-18016 
!     RELOC:  92071-16016 
!     PGMR:   G.A.A.
!     MOD:    M.L.K., E.D.B.
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  ALL RIGHTS     *
!  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
!  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
!  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
!  ***************************************************************
! 
      NAME CR..(7) "92071-1X016 REV.2041 800702"
! 
!     CR.. IS THE RTE FILE MANAGER ACTION ROUTINE 
!     TO CREATE EMPTY FILES.
!     IT ALSO CREATES TYPE ZERO FILES.
! 
!     THIS ROUTINE HANDLES THE FOLLOWING FORMS: 
! 
!     CR,NAMR 
! 
!     WHERE:
! 
!     NAMR  IS A NAME REFERENCE WHICH INCLUDES
!           SC    IS A SECURITY CODE
!           CR    IS A CARTRIDGE ID 
!           TY    IS A FILE TYPE
!           SZ    IS THE FILE SIZE  (NO. OF BLOCKS) 
!           RL    IS THE FILE RECORD LENGTH (ONLY IF TY=2)
! 
!     (OR)
! 
!     CR,NAMR,LU,RWOP,SPOP,EOFOP,  SUBFUN OP
! 
!     WHERE:
! 
!     NAMR  IS AS ABOVE EXCEPT TY=0 
!           LU    IS THE DEVICE  LOGICAL UNIT 
!           RWOP  IS  THE  READ  WRITE  OPTION
!                 (I.E. "READ", "WRITE", "BOTH")
!           SPOP  IS THE  SPACING  OPTION 
!                 (I.E. " BSPACE", "FSPACE", "BOTH")
!           EOF   IS THE END OF FILE OPTION 
!                 (I.E.  "EOF","LEADER","PAGE", 
!                  NUMERIC SUB FUNCTION)
!           SUBFUNOP IS THE READ/WRITE SUBFUNCTION
!                 (I.E. "BINARY","ASCII",NUMERIC
!                    SUBFUNCTION) 
! 
!  EXTERNAL SUBROUTINES 
      LET CLOSE     BE SUBROUTINE,EXTERNAL
      LET CREAT     BE SUBROUTINE,EXTERNAL
      LET OPEN.     BE SUBROUTINE,EXTERNAL
! 
!  EXTERNAL FUNCTIONS 
      LET NAM..     BE FUNCTION,EXTERNAL
      LET GTOPN     BE FUNCTION,EXTERNAL
! 
!  EXTERNAL VARIBLES
      LET O.BUF     BE INTEGER,EXTERNAL 
      LET N.OPL     BE INTEGER,EXTERNAL 
! 
!  INTERNAL CONSTANTS 
      LET  EOF      BE CONSTANT (42517K)         !"EO"
      LET  LE       BE CONSTANT (46105K)         !"LE"
      LET  PA       BE CONSTANT (50101K)         !"PA"
      LET  AS       BE CONSTANT (40523K)         !"AS"
      LET  BI       BE CONSTANT (41111K)         !"BI"
      LET  RE       BE CONSTANT (51105K)         !"RE"
      LET  WR       BE CONSTANT (53522K)         !"WR"
      LET  BO       BE CONSTANT (41117K)         !"BO"
      LET  BS       BE CONSTANT (41123K)         !"BS"
      LET  FS       BE CONSTANT (43123K)         !"FS"
! 
      LET A         BE CONSTANT (0) 
      LET B         BE CONSTANT (1) 
! 
CR..: SUBROUTINE(NO,LIS, ER) GLOBAL 
      TY_@N.OPL+2 
      LIS21_[LIS20_[LIS17_[LIS16_[LIS13_[LIS9_[  \
          LIS5_[LIS1_@LIS+1]+4]+4]+4]+3]+1]+3]+1 !
! 
      IF NAM..($LIS1) THEN GOTO ILNAM            !TEST FOR ILLEGAL NAME 
! 
!     CREATE DISC FILE (TYPES 1 TO 32767) 
! 
      IF $TY THEN[                               \CHECK FOR PROPER TYPE 
          CREAT(O.BUF,ER,$LIS1,$(@N.OPL+3),      \CREATE THE FILE 
               $(@N.OPL+2),N.OPL,$(@N.OPL+1));   \
          IF ER > 0 THEN ER_ 0;                  \IGNORE SIZE RETURN
          RETURN]                                !AND RETURN
! 
!     CREATE NON-DISC FILE (TYPE 0) 
! 
      LUC, EF, SP, RW, SC _ 0                    !CLEAR PARAMETERS
! 
      IF $LIS5 >20000K THEN GOTO ILLU            !IF LU IS ASCII, ILLEGAL 
      IF $LIS5 <1      THEN GOTO ILLU            !IF LU NEGATIVE, ILLEGAL 
! 
!     SET   R/W  CODE 
! 
      IFNOT $LIS9      THEN GOTO MISPM           !MISSING PARAMETER 
      IF    $LIS9 = RE THEN RW_100000K           !SET READ CODE 
      IF    $LIS9 = WR THEN RW_1                 !SET WRITE CODE
      IF    $LIS9 = BO THEN RW_100001K           !SET BOTH READ,WRITE CODES 
      IFNOT RW         THEN GOTO ILLPM           !BAD RW CODE 
! 
!     SET   SPACING CODE
! 
      IFNOT $LIS13     THEN GOTO  EOFCD          !IF NO SP CODE, WORK ON EOF
      IF    $LIS13= BS THEN SP_100000K           !SET BACKSPACE CODE
      IF    $LIS13= FS THEN SP_1                 !SET FORWARD SPACE CODE
      IF    $LIS13= BO THEN SP_100001K           !SET BOTH CODES
      IFNOT SP         THEN GOTO ILLPM           !BAD SP CODE 
! 
!     SET  EOF  CODE  (DEFAULT -FMGR DEFAULT) 
! 
EOFCD:IFNOT $LIS16     THEN [                    \USE DEFAULT EOF 
          OPEN.(O.BUF,$LIS5,N.OPL,1);            \GET DEFAULT LU
          CLOSE(O.BUF);                          \CLOSE LU
          EF _ $(@O.BUF+4);                      \GET EOF CODE
          GOTO SUBCD]                            !AND CONTINUE
      IF    $LIS17=EOF THEN EF_100K              !EOF (MAG TAPE)
      IF    $LIS17=PA  THEN EF_1100K             !PAGE EJECT
      IF    $LIS17=LE  THEN EF_1000K             !PUNCH LEADER
      IF    $LIS16<3   THEN EF_($LIS17 AND 37K)-<6
      IFNOT EF         THEN GOTO ILLPM           !BAD EOF CODE
! 
!     SET   SUB FUNCTION  (DEFAULT 00=ASCII)
! 
SUBCD:IFNOT $LIS20     THEN GOTO SETUP
      IF    $LIS20<3   THEN LUC_($LIS21 AND 37K)-<6 
      IF    $LIS21= BI THEN LUC_100K
      IF    $LIS21= AS THEN GOTO SETUP
      IFNOT LUC        THEN GOTO ILLPM           !BAD SUB CODE
! 
SETUP:LUC_ LUC+[T_($LIS5 AND 77K)]               !MERGE IN DEFAULT LU 
      EF_EF OR T                                 !MERGE IN DEFAULT LU 
! 
      OFLAG_ GTOPN                               !GET OPEN FLAG FOR SPLC
      CREAT(O.BUF,ER,$LIS1,LUC,                  \CREATE NON-DISC FILE  
            0,N.OPL,$(@N.OPL+1),0,T,0,OFLAG)
      RETURN
! 
!     ERROR RETURNS 
! 
ILLU: DO[ ER_ 20; RETURN]                        !ILLEGAL LU
MISPM:DO[ ER_ 55; RETURN]                        !MISSING PARAMETER 
ILLPM:DO[ ER_ 56; RETURN]                        !ILLEGAL PARAMETER 
ILNAM:DO[ ER_-15; RETURN]                        !ILLEGAL NAME
! 
      END 
      END 
! 
      END$
                