ASMB,R,L,C
      HED COMPILER LIBRARY CREATE ROUTINE 
      NAM CRE.C,7 92060-16102  780921 REV. 1901 $CLIB 
* 
* 
*************************************************************** 
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  ALL RIGHTS     * 
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE-  * 
* REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * 
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.   * 
*************************************************************** 
* 
* 
* 
*   SOURCE PART NUMBER :       92060-18070
* 
* 
*  CREATE FILE SUBROUTINE 
* 
*  THIS ROUTINE WILL CREATE A FILE AS REQUIRED BY THE OPEN ROUTINE. 
*   CRE.C WILL TAKE THE 'NAMR' DATA AND PUT IT IN A BUFFER WHICH IS 
*   A SKELETON FOR A DIRECTORY ENTRY AND WRITE OUT TO A DISC TRACK
*   THEN CALL D.RTR WHICH READS THE DISC TRACK AND CREATES A FILE 
*   DIRECTORY. THE DISC TRACK IS THEN RETURNED. 
* 
* 
* 
*  CALLING SEQUENCE:
* 
* 
*       A = CREATED FILE TYPE(4 FOR SOURCE, 5 FOR BINARY) 
*         JSB CRE.C 
*         ERROR RETURN
*         NO ERROR RETURN 
* 
* 
*         A <= INDICATES ERROR NUMBER 
* 
*  ENTRY POINT: 
* 
      ENT CRE.C 
* 
*  EXTERNALS: 
* 
      EXT EXEC      SYSTEM EXECUTIVE
      EXT GEX.C     CREATE/OPEN ROUTINE 
      EXT NAM..     CHECK NAME ROUTINE
* 
      EXT C.NAM     DEFAULT FILE NAME 
      EXT C.NA3     FILE NAME - LAST 2 CHARACTERS 
      EXT C.SC      DEFAULT FILE SECURITY CODE
      EXT C.CR      DEFAULT FILE CARTRIDGE OR LU NUMBER 
      EXT C.FTY     DEFAULT FILE TYPE 
      EXT C.FSZ     DEFAULT FILE SIZE 
      EXT C.TYP     'NAMR' TYPE 
* 
* 
* 
A     EQU 0 
B     EQU 1 
* 
CRE.C NOP 
      LDB C.FTY,I   HAS USER REQUESTED
      SZB,RSS         A FILE TYPE?
      STA B         YES, USE IT!
      STB BUF+3     NO, USE DEFAULT!!
      JSB NAM..     IS NAME 
      DEF *+2         OK? 
      DEF C.NAM,I 
      SZA 
      JMP ERROR     NO! 
      DLD C.NAM,I   SET 
      DST BUF         UP NAME 
      LDA C.NA3,I       IN BUFFER 
      STA BUF+2           PRIOR TO WRITING OUT ON DISC TRACK
      LDB C.FSZ,I 
      SZB,RSS       IS SIZE ZERO? 
      LDB .24       YES, USE DEFAULT OF 1 TRACK WORTH 
      BLS           DOUBLE TO 
      SSB             GET 64
      CCB               64 WORD SECTORS, SET TO -1 IF ALL OF DISC 
      STB BUF+6 
      CLA 
      SSB 
      CMA 
      STA BUF+5       SESSION USES DBL WRD
      LDA C.SC,I    SET SECURITY CODE 
      STA BUF+8 
* 
      CLA,INA 
      LDB C.CR,I
      JSB GEX.C     CREATE FILE 
      DEF BUF 
ERROR JMP CRE.C,I   ERROR RETURN
      ISZ CRE.C 
      JMP CRE.C,I   GOOD RETURN 
* 
* 
*  CONSTANTS AND BUFFERS
* 
.24   DEC 24
BUF   NOP           NAME
      NOP             IS
      NOP               HERE
      NOP           PRGRAM TYPE 
      NOP 
      NOP 
      NOP 
      NOP 
      NOP           PRGRAM SECURITY CODE
      NOP 
      END 
                                                                          