ASMB,R,L,C
      HED (FMP) CRETS: CREATE A TEMPORARY FILE
*     NAME:   CRETS 
*     SOURCE: 92071-18041 
*     RELOC:  92071-16041 
*     PGMR:   M.L.K.
*     MOD:    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 CRETS,7 92071-1X041 REV.2041 800619 
* 
      ENT CRETS 
* 
      EXT ECREA, PURGE, CLOSE 
      EXT GTOPN 
      EXT .ENTR 
      SUP 
      SKP 
* 
*     DESCRIPTION 
* 
*     CRETS IS THE SCRATCH FILE CREATION MODULE OF THE REAL TIME
*           FILE MANAGEMENT PACKAGE.
* 
*     THE FORTRAN CALLING SEQUENCE IS:
* 
*     CALL CRETS(IDCB,IERR,NUM,NAME,ISIZE,ITYPE,ISECU,ICR,IDCBS,JSIZE)
*        O R
*     IERR = CRETS(IDCB,IERR,NUM,NAME,ISIZE,ITYPE,ISECU,ICR,IDCBS,JSIZE)
* 
*     WHERE:
* 
*     IDCB   IS A SCRATCH DATA CONTROL BLOCK (144-WORD ARRAY) 
*            WHICH CRETS WILL USE.
*            IF ISIZE<0 THEN THE CREATED FILE IS ALSO 
*            OPENED TO THIS DATA CONTROL BLOCK. 
* 
*     IERR   WILL BE TH ERROR RETURN CODE.
*            ALSO RETURNED IN A-REG.
* 
*     NUM    IS THE SCRATCH FILE NUMBER TO BE ASSIGNED TO THE CREATED 
*            FILE.
* 
*     NAME   WILL BE THE 6-CHARACTER FILE NAME WHICH CRETS
*            HAS CREATED (3-WORD ARRAY).
* 
*     ISIZE  CONTAINS THE FILE SIZE (WORD 1) AND RECORD LENGTH
*            (WORD 2).  FILE SIZE IS IN BLOCKS, RECORD LENGTH IS
*            IN WORDS AND ONLY USED FOR TYPE 2 FILES. 
*            THE DEFAULT FILE SIZE IS 24 BLOCKS.
* 
*     ITYPE  IS THE FILE TYPE--MUST BE >0.  THE DEFAULT IS TYPE 3.
* 
*     ISECU  (OPTIONAL); IS THE FILE'S SECURITY CODE. 
*            IF ISECU>0 THE FILE IS WRITE PROTECTED.
*            IF ISECU<0 THE FILE IS OPEN PROTECTED. 
*            IF ISECU=0 OR IS NOT CODED THE FILE IS PUBLIC. 
* 
*     ICR    (OPTIONAL); IS THE CARTRIDGE TO USE: 
*             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  (OPTIONAL); IS THE LENGTH OF THE PACKING BUFFER
*            AREA FOLLOWING THE DCB HEADER (DEFAULT 128-WORDS.) 
*            THE BUFFER MUST BE AN EVEN 
*            DIVISOR OF THE FILE SIZE SO ONLY PART OF 
*            THE SPECIFIED SIZE MAY BE USED.  THE USED SIZE IS: 
*            USED SIZE=FILE SIZE/N  WHERE 
*            N=(FILE SIZE/IBLK)+(IF REMAINDER THEN 1,ELSE 0)
* 
*     JSIZE  WILL BE THE SIZE (32-BIT) OF THE FILE CREATED IF 
*            SUCCESSFUL (OPTIONAL). 
* 
*     POSSIBLE ERRORS:
* 
*     >0   CRETS WAS SUCCESSFUL - THE FILE SIZE IS RETURNED 
*     -1   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 
*     -38  ILLEGAL FILE NUMBER
      SKP 
* 
*     ENTRY 
* 
CRETS NOP           ENTRY POINT 
      LDA DZERO     GET DUMMY 0 FOR DEFAULT 
      STA NAME
      STA ISECU 
      STA ICR 
      STA IDCBS 
      LDA DFLTS     GET DEFAULT SIZE
      STA ISIZE        (=24 BLOCKS) 
      LDA DFLTT     GET DEFAULT TYPE
      STA ITYPE        (=3) 
      LDA DDMSZ     GET POINTER TO DUMMY SIZE 
      STA JSIZE     STORE AT PARAMETER ADDRESS
      LDA CRETS     GET RETURN ADDRESS
      STA DRETS      SAVE 
      JMP DRETS+1   GO SET UP PARAMETERS
* 
IDCB  NOP 
IERR  NOP 
NUM   NOP 
NAME  DEF ZERO
ISIZE DEF DSIZE 
ITYPE DEF DTYPE 
ISECU DEF ZERO
ICR   DEF ZERO
IDCBS DEF ZERO
JSIZE DEF DUMSZ 
* 
DRETS NOP 
      JSB .ENTR 
      DEF IDCB
* 
      LDA NAME      TEST FOR ENOUGH 
      CPA DZERO       PARAMETERS
      JMP ER10      NOT ENOUGH!  ERROR
      SKP 
* 
*     PROCESS REQUEST 
* 
      JSB CLOSE     CLOSE FILE
      DEF *+2        IF ALREADY 
      DEF IDCB,I      OPEN
* 
      LDA NUM,I     TEST SCRATCH FILE NUMBER
      SSA           IF NEGATIVE,
      JMP ER38       THEN TAKE ERROR 38 EXIT
* 
      ADA N100      TEST FOR TOO LARGE
      SSA,RSS       IF TOO LARGE, 
      JMP ER38       THEN TAKE ERROR 38 EXIT
* 
      LDA NAME      GET POINTER TO USER'S NAME BUFFER 
      INA           INCREMENT TO SECOND WORD
      STA NAME2     AND SAVE
      INA           INCREMENT TO THIRD WORD 
      STA NAME3     AND SAVE
* 
      JSB GTOPN     GET CURRENT OPEN FLAG 
      DEF *+1 
      STA OPFLG     SAVE IT FOR LATER 
* 
      AND B377      ISOLATE THE ID NUMBER 
      JSB CHAR      CONVERT TO ASCII
      STB NAME2,I   STORE TEMPORARILY IN LOW BITS 
      JSB CHAR      CONVERT THE NEXT CHAR OF ID # 
      STB NAME,I    STORE IN LOW BITS 
      JSB CHAR      CONVERT 100'S DIGIT 
      BLF,BLF       SHIFT TO HIGH BYTE
      ADB NAME,I    ADD 10'S DIGIT
      STB NAME,I    AND STORE IN USER'S BUFFER
* 
      LDB NAME2,I   GET 1'S DIGIT 
      LDA OPFLG      AND RESTORE OPEN FLAG
      AND B3400     ISOLATE THE CPU#
      LSL 8         SHIFT BYTES INTO POSITION IN B
      ADB B60       ADD 60B TO CONVERT TO ASCII 
      STB NAME2,I   STORE IN USER'S BUFFER
* 
      LDA NUM,I     GET FILE NUMBER 
      JSB CHAR      CONVERT 1'S TO ASCII
      STB NAME3,I   STORE IN USER'S BUFFER
      JSB CHAR      CONVERT UPPER CHARACTER 
      BLF,BLF       SHIFT UP
      ADB NAME3,I   ADD LOWER CHARACTER 
      STB NAME3,I   AND STORE IN USER'S BUFFER
      SKP 
* 
*     CALL ECREA
* 
CREAT JSB ECREA     CALL DOUBLE WORD CREATE 
      DEF *+12
      DEF IDCB,I
      DEF IERR,I
      DEF NAME,I
      DEF ISIZE,I 
      DEF ITYPE,I 
      DEF ISECU,I 
      DEF ICR,I 
      DEF IDCBS,I 
      DEF JSIZE,I 
      DEF ZERO
      DEF OPFLG 
* 
      SSA,RSS       IF NO ERRORS, 
      JMP EXIT       THEN EXIT
* 
      CPA N2        IF NOT FILE ALREADY EXISTS ERROR, 
      RSS 
      JMP EREX       THEN TAKE ERROR EXIT 
* 
      JSB PURGE     PURGE THE SCRATCH FILE
      DEF *+6 
      DEF IDCB,I
      DEF IERR,I
      DEF NAME,I
      DEF ISECU,I 
      DEF ICR,I 
* 
      SZA,RSS       IF NO ERRORS, 
      JMP CREAT      THEN TRY CREATING FILE AGAIN 
* 
      JMP EREX      TAKE ERROR EXIT 
      SKP 
* 
*     EXIT
* 
EXIT  CLA           NO ERROR INTENDED 
      JMP EREX
* 
ER10  LDA N10       NOT ENOUGH PARAMETER
      JMP EREX
* 
ER38  LDA N38       ILLEGAL FILE NUMBER 
* 
EREX  STA IERR,I    SAVE ERROR CODE 
      JMP DRETS,I    AND RETURN 
      SKP 
* 
*     CHARACTER CONVERSION SUBROUTINE 
* 
*     CALLING SEQUENCE
* 
*     <A = NUMBER TO CONVERT> 
*     JSB CHAR
*     <RETURN: A = A / 10; B = DECIMAL CHARACTER> 
* 
CHAR  NOP 
      CLB           CLEAR UPPER BITS
      DIV .10       CONVERT TO DECIMAL CHARACTER
      ADB B60       CONVERT TO ASCII
      JMP CHAR,I    RETURN
      SKP 
* 
*     STORAGE AREA
* 
ZERO  NOP 
      NOP 
* 
.10   DEC 10
* 
B60   OCT 60
B377  OCT 377 
B3400 OCT 3400
* 
N2    DEC -2
N10   DEC -10 
N38   DEC -38 
N100  DEC -100
N101  DEC -101
* 
DSIZE NOP           DEFAULT SIZE (2-WORD
      DEC 24          = 24 BLOCKS 
DTYPE DEC 3         DEFAULT TYPE
* 
DZERO DEF ZERO
DFLTS DEF DSIZE 
DFLTT DEF DTYPE 
DDMSZ DEF DUMSZ 
* 
NAME2 NOP           POINTER TO WORD 2 OF NAME 
NAME3 NOP           POINTER TO WORD 3 OF NAME 
OPFLG NOP           PROGRAM'S OPEN FLAG 
DUMSZ BSS 2         DUMMY RETURN SIZE 
* 
END   EQU * 
* 
      END 
                          