ASMB,R,L,C
      HED (FMP) CREAT: CREAT A FILE 
*     NAME:   CREAT 
*     SOURCE: 92071-18040 
*     RELOC:  92071-16040 
*     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.       *
*  ***************************************************************
* 
      NAM CREAT,7 92071-1X040 REV.2041 800707 
* 
      ENT CREAT,ECREA 
* 
      EXT CLOSE 
      EXT $OPEN, GTOPN, NAM.., $DBLX
      EXT CLD.R, .P1, .P2, .P3, .P4, .P6, .P6B, .P7, .P9, .R1 
      EXT .ENTR, $SETP
* 
      EXT F.DCB, F.TYP, F.SIZ, F.ST1, F.FLG 
      EXT F.BFP, F.ST2
      SUP 
      SKP 
* 
*     DESCRIPTION 
* 
*     CREAT IS THE FILE CREATION ROUTINE OF THE RTE-L/20
*           FILE MANAGEMENT PACKAGE (FMP).
* 
*     THE FORTRAN CALLING SEQUENCE IS:
* 
*     CALL CREAT(IDCB,IERR,NAME,ISIZE,ITYPE,ISECU,ICR,IDCBS,JSIZE)
*        O R
*     IERR = CREAT(IDCB,IERR,NAME,ISIZE,ITYPE,ISECU,ICR,IDCBS,JSIZE)
* 
*     WHERE:
* 
*     IDCB   IS A DATA CONTROL BLOCK (144-WORD ARRAY) 
*            TO BE USED TO CREATE THE FILE. IF
*            ISIZE<0 THEN THE CREATED FILE IS ALSO
*            OPENED TO THIS DATA CONTROL BLOCK. 
* 
*     IERR   WILL BE THE RETURN ERROR CODE (ALSO RETURNED IN A).
*            FOR DISC FILES, ACTUAL FILE SIZE CREATED WILL BE 
*            RETURNED AS A POSITIVE NUMBER. 
* 
*     NAME   IS THE NEW FILE'S NAME (3-WORD ARRAY). 
*            THE NAME MUST CONTAIN ONLY LEGAL ASCII 
*            CHARACTERS INCLUDING EMBEDDED BLANKS. COMMAS,
*            + SIGN, - SIGN ARE NOT ALLOWED.
*            IN ADDITION THE FIRST
*            CHARACTER MUST BE NON-NUMERIC AND NON-BLANK. 
* 
*     ISIZE  IS ADDITIONAL FILE CREATION PARAMETERS (ARRAY):
*            FOR DISC FILES (ITYPE>0), WORD 1 CONTAINS THE REQUESTED
*            FILE SIZE (IN BLOCKS). 
*            FOR USER-DEFINED FIXED RECORD FILES (ITYPE=2), WORD 2
*            CONTAINS THE REQUESTED RECORD LENGTH (IN WORDS). 
*            FOR NON-DISC FILES (ITYPE=0), WORD 1 CONTAINS THE
*            REQUESTED DEVICE LU AND FUNCTION WORD, WORD 2 CONTAINS 
*            THE EOF FUNCTION WORD, WORD 3 CONTAINS THE SPACING 
*            FUNCTION WORD, WORD 4 CONTAINS THE READ/WRITE FUNCTION WORD. 
* 
*     ITYPE  IS THE FILE'S TYPE.
* 
*     ISECU  IS THE FILE'S SECURITY CODE (OPTIONAL).
*            IF ISECU>0 THE FILE IS WRITE PROTECTED.
*            IF ISECU<0 THE FILE IS READ/WRITE PROTECTED. 
*            IF ISECU=0 OR IS NOT CODED THE FILE IS PUBLIC. 
* 
*     ICR    IS THE FILE'S CARTRIDGE REFERENCE (OPTIONAL).
*            IF ICR<0 THEN THE DISC AT LOGICAL UNIT (-ICR). 
*            IF ICR>0 THEN THE DISC WITH LABEL ICR. 
*            IF ICR=0 OR NOT CODED, THE FIRST AVAILABLE 
*                     DISC WITH ENOUGH ROOM IS USED.
* 
*     IDCBS  IS THE LENGTH OF THE PACKING BUFFER
*            AREA FOLLOWING DCB HEADER (OPTIONAL).
*            IF NOT CODED, A 128-WORD BUFFER IS ASSUMED.
*            THE BUFFER MUST EVENLY DIVIDE THE FILE SIZE, 
*            HENCE, ONLY PART OF THE SPECIFIED BUFFER MAY BE USED.
*            THE SIZE USED WILL BE: 
*            SIZE USED = FILE SIZE/N  WHERE 
*             N = (FILE SIZE/IBLK)+(IF REMAINDER THEN 1,ELSE 0) 
* 
*     JSIZE  WILL BE THE ACTUAL SIZE (IN SECTORS, 32-BIT) OF
*            THE FILE CREATED (OPTIONAL, USED FOR ECREA ONLY) 
* 
*     POSSIBLE ERRORS:
* 
*     >0   THE CREAT WAS SUCCESSFUL - SIZE IS RETURNED
*     -1   THE DISC IS DOWN 
*     -2   DUPLICATE NAME 
*     -4   FILE TOO LONG
*     -6   CARTRIDGE NOT FOUND
*     -10  NOT ENOUGH PARAMETERS IN THE CALL
*     -13  DISC LOCKED
*     -14  DIRECTORY FULL 
*     -15  ILLEGAL NAME 
*     -16  ILLEGAL TYPE OR SIZE 
      SKP 
* 
*     ENTRY 
* 
ECREA NOP           DOUBLE WORD ENTRY 
      CCA           SET DOUBLE WORD FLAG
      LDB ECREA     SET UP RETURN ADDRESS 
      JMP SETUP 
* 
CREAT NOP 
      CLA           SET FALSE FOR DBL FLAG
      LDB CREAT     GET RETURN ADDRESS
* 
SETUP STA DBLWD     STORE DOUBLE FLAG 
      STB DREAT     STORE RETURN ADDRESS
      LDA DZERO 
      STA ITYPE 
      STA ISECU 
      STA ICR 
      STA IDCBS 
      STA SCFLG 
      LDA DDSIZ 
      STA JSIZE 
      JMP DREAT+1 
* 
IDCB  NOP 
IERR  NOP 
NAME  NOP 
ISIZE NOP 
ITYPE DEF ZERO
ISECU DEF ZERO
ICR   DEF ZERO
IDCBS DEF ZERO
JSIZE DEF ZERO
      NOP           PLACE HOLDER FOR SPECIAL CALL 
SCFLG DEF ZERO      SCRATCH FILE CREATE FLAG
* 
DREAT NOP           ENTRY POINT 
      JSB .ENTR     TRANSFER THE PARAMETERS 
      DEF IDCB
* 
      LDA ITYPE     MAKE SURE THERE ARE 
      CPA DZERO     ENOUGH
      JMP ER10      NO - ERROR EXIT 
* 
      LDA IDCB      SET UP POINTERS INTO DCB
      LDB F.DCB 
      JSB $SETP 
      DEF .16 
      NOP 
      SKP 
* 
*     PROCESS REQUEST 
* 
      JSB CLOSE     CLOSE 
      DEF *+2        FILE 
      DEF IDCB,I      IF OPEN 
* 
      SZA           SKIP IF NO ERRORS 
      CPA N11        OR IF NOT OPEN 
      RSS 
      JMP EREX        OTHERWISE, TAKE ERROR EXIT
* 
      JSB GTOPN     GET CURRENT OPEN FLAG 
      DEF *+1 
* 
      CPA SCFLG,I   IF THE SCRATCH FLAG IS SET AND CORRECT, 
      JMP NAMOK      THEN SKIP NAME CHECK 
* 
      JSB NAM..     GO CHECK THE NAME 
      DEF *+2 
      DEF NAME,I
* 
      SZA           IF OK SKIP
      JMP EREX       ELSE EXIT ERROR
* 
      LDA ITYPE,I   GET REQUESTED FILE TYPE 
      SZA,RSS       IF TYPE ZERO, 
      JMP ER16       THEN TAKE ERROR EXIT 
      SKP 
* 
*     GET CREATION PARAMETERS (ISIZE) 
* 
NAMOK LDA ITYPE,I   GET FILE TYPE 
      SZA           IF NOT TYPE ZERO, 
      JMP CREA1      THEN CONTINUE
* 
      LDA DBLWD     GET DOUBLE-WORD FLAG
      SZA,RSS       IF SINGLE,
      JMP CREA2      THEN GET SINGLE WORD PARAMETERS
* 
      DLD ISIZE,I   GET 32-BIT PARAMETER
      ISZ ISIZE      AND BUMP TO NEXT PARAMETER 
      ISZ ISIZE 
      JSB $DBLX     IF OUT OF 16-BIT RANGE
      JMP EREX       THEN TAKE ERROR EXIT 
* 
      STB DLU       SAVE DEVICE LU
* 
      DLD ISIZE,I   GET 32-BIT PARAMETER
      ISZ ISIZE      AND BUMP TO NEXT PARAMETER 
      ISZ ISIZE 
      JSB $DBLX     IF OUT OF 16-BIT RANGE
      JMP EREX       THEN TAKE ERROR EXIT 
* 
      STB EOFC      SAVE EOF CODE 
      JMP CREA1 
* 
CREA2 LDB ISIZE,I   GET 16-BIT PARAMETER
      ISZ ISIZE      AND BUMP TO NEXT PARAMETER 
      STB DLU       SAVE DEVICE LU
* 
      LDB ISIZE,I   GET 16-BIT PARAMETER
      ISZ ISIZE      AND BUMP TO NEXT PARAMETER 
      STB EOFC      SAVE EOF CODE 
      SKP 
* 
*     GET MORE CREATION PARAMETERS (ISIZE)
* 
CREA1 LDA DBLWD     GET DOUBLE-WORD FLAG
      SZA,RSS       IF SINGLE,
      JMP CREA3      THEN GET SINGLE WORD PARAMETERS
* 
      DLD ISIZE,I   GET 32-BIT PARAMETER
      ISZ ISIZE      AND BUMP TO NEXT PARAMETER 
      ISZ ISIZE 
      JSB $DBLX     IF OUT OF 16-BIT RANGE
      JMP EREX       THEN TAKE ERROR EXIT 
* 
      STB FSIZE     SAVE FILE SIZE OR SPACING CODE
* 
      LDA ITYPE,I   GET FILE TYPE 
      SZA           IF NOT TYPE ZERO, 
      CPA .2         AND NOT TYPE 2,
      RSS 
      JMP CREA6       THEN DON'T CHECK RECORD LENGTH
* 
      DLD ISIZE,I   GET 32-BIT PARAMETER
      JSB $DBLX     IF OUT OF 16-BIT RANGE
      JMP EREX       THEN TAKE ERROR EXIT 
* 
      STB RECLN     SAVE RECORD LENGTH OR READ/WRITE CODE 
      JMP CREA6      AND CONTINUE 
* 
CREA3 LDB ISIZE,I   GET 16-BIT PARAMETER
      ISZ ISIZE      AND BUMP TO NEXT PARAMETER 
      STB FSIZE     SAVE FILE SIZE OR SPACING CODE
* 
      LDB ISIZE,I   GET 16-BIT PARAMETER
      STB RECLN      SAVE RECORD LENGTH OR READ/WRITE CODE
      SKP 
* 
*     MODIFY CREATION PARAMETERS
* 
CREA6 LDB ITYPE,I   GET FILE TYPE 
      SSB           IF NEGATIVE,
      JMP ER16       THEN TAKE ERROR EXIT 
* 
      SZB,RSS       IF FILE TYPE ZERO,
      JMP CREA4      THEN CONTINUE
* 
*     CHECK LEGALITY OF FILE SIZE 
* 
      LDA FSIZE     GET THE REQUESTED SIZE
      SZA,RSS       IF FILE SIZE ZERO,
      JMP ER16       THEN TAKE ERROR EXIT 
* 
      SSA           IF FILE SIZE NEGATIVE,
      JMP CRE60      THEN CONTINUE
* 
      RAL           CONVERT TO SECTORS
      SSA           IF SIGN BIT SET,
      JMP ER16       THEN TAKE ERROR EXIT 
* 
      STA FSIZE     SAVE FILE SIZE FOR D.RTR
* 
*     HANDLE RECORD LENGTH REQUEST
* 
CRE60 CPB .1        IF FILE TYPE ONE, 
      JMP CRE61      THEN DO TYPE 1 STUFF 
* 
      CPB .2        IF FILE TYPE TWO, 
      JMP CRE62      THEN DO TYPE 2 STUFF 
* 
      CLA           SET RECORD LENGTH TO ZERO 
      JMP CRE66 
* 
CRE61 LDA .128      SET RECORD LENGTH TO 128 WORDS
      JMP CRE66 
* 
CRE62 LDA RECLN     GET REQUESTED RECORD LENGTH 
      SZA           IF ZERO,
      SSA            OR NEGATIVE, 
      JMP ER4         THEN TAKE ERROR EXIT
* 
***** LDA FSIZE     GET FILE SIZE 
***** CLB            CLEAR FOR DIVIDE 
***** DIV RECLN       CALCULATE NUMBER OF RECORDS/128 
***** CLB           CLEAR FOR SHIFT 
***** ASL 7          CALCULATE NUMBER OF RECORDS (MORE OR LESS) 
***** SZB,RSS       IF MORE THAN
***** SSA            32640 RECORDS, 
***** JMP ER4         THEN TAKE ERROR EXIT
* 
CRE66 STA RECLN     SAVE RECORD LENGTH
      SKP 
* 
*     SET UP D.RTR REQUEST
* 
CREA4 CLA,INA       GET FUNCTION CODE 
      STA .P1        SAVE FOR D.RTR 
* 
      LDA ICR,I     GET CARTRIDGE IDENTIFIER
      STA .P2        SAVE FOR D.RTR 
* 
      LDA NAME,I    SAVE FOR D.RTR
      STA .P3 
      ISZ NAME
      DLD NAME,I
      DST .P4 
* 
      LDA ITYPE,I   GET REQUESTED FILE TYPE 
      STA .P6        SAVE FOR D.RTR 
* 
      DLD DLU       GET TWO PARAMETERS
      DST .P6B       SAVE FOR D.RTR 
      DLD FSIZE     GET TWO MORE PARAMETERS 
      DST .P7        SAVE FOR D.RTR 
* 
      LDA ISECU,I   GET SECURITY CODE 
      STA .P9        SAVE FOR D.RTR 
* 
      JSB CLD.R     GO CALL D.RTR 
* 
      LDA .R1       GET D.RTR COMPLETION
      SSA           IF ERROR, 
      JMP EREX       THEN TAKE ERROR EXIT 
      SKP 
* 
*     SET UP USER DATA CONTROL BLOCK
* 
      LDA IDCBS,I   GET REQUESTED PACKING BUFFER SIZE 
      LDB ISECU,I   GET REQUESTED SECURITY CODE 
      JSB $OPEN     SET UP DCB
      JMP EREX      DISC ERROR - EXIT 
* 
      LDA F.ST1,I   GET FIRST STATUS WORD 
      IOR .1         SET UPDATE-MODE BIT
      STA F.ST1,I     AND SAVE AGAIN
* 
      LDA F.TYP,I   GET FILE TYPE 
      ADA N3        IF SEQUENTIAL ACCESS FILE,
      SSA            THEN WRITE EOF 
      JMP EXIT       ELSE EXIT NORMALLY 
* 
      LDA F.ST2,I   GET SECOND STATUS WORD
      IOR .1        SET WRITTEN ON FLAG 
      STA F.ST2,I   SAVE STATUS WORD
* 
      CCA           SET EOF IN
      LDB F.BFP,I    FIRST WORD 
      STA B,I         OF BUFFER 
      SKP 
* 
*     EXIT
* 
EXIT  JSB GTOPN     SET OPEN FLAG 
      DEF *+1        INTO DCB 
      STA F.FLG,I 
* 
      LDB F.TYP,I   NO ERROR INTENDED 
      SZB,RSS       IF FILE TYPE ZERO,
      CLA,RSS        THEN RETURN ZERO 
      LDA F.SIZ,I    ELSE RETURN FILE SIZE
      JMP EREX
* 
ER4   LDA N4        ILLEGAL DOUBLE WORD PARAMETER 
      JMP EREX
* 
ER10  LDA N10       NOT ENOUGH PARAMETERS 
      JMP EREX
* 
ER16  LDA N16       ILLEGAL TYPE OR SIZE PARAMETER
* 
EREX  STA IERR,I    SET ERROR CODE
      ISZ DBLWD     IF THIS WAS NOT DOUBLE WORD CALL, 
      JMP DREAT,I    THEN RETURN (CREAT EXIT) 
* 
      CLA 
      LDB F.SIZ,I   GET ACTUAL FILE SIZE
      DST JSIZE,I    SAVE 32-BITS FOR USER
* 
      LDA IERR,I    GET ERROR CODE AGAIN
      JMP DREAT,I    AND RETURN (ECREA EXIT)
      SKP 
* 
*     STORAGE AREA
* 
ZERO  NOP           32-BIT ZERO 
      NOP 
* 
N16   DEC -16 
N10   DEC -10 
N11   DEC -11 
N4    DEC -4
N3    DEC -3
* 
.1    DEC 1 
.2    DEC 2 
.16   DEC 16
.128  DEC 128 
* 
DZERO DEF ZERO
DDSIZ DEF DUMSZ 
* 
DLU   NOP           - CREATION PARAMETER BUFFER 
EOFC  NOP           ! 
FSIZE NOP           ! 
RECLN NOP           - 
* 
DBLWD NOP           DOUBLE WORD FLAG
DUMSZ NOP           DUMMY RETURN SIZE FOR ECREA 
      NOP 
* 
A     EQU 0 
B     EQU 1 
* 
END   EQU * 
* 
      END 
                                                                                                                                                                  