ASMB
      NAM DBCRT,7 92069-16169 REV.1912 790315 
* 
* 
******************************************************************
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. 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. 
******************************************************************* 
* 
* 
*     SOURCE:    92069-18169
*     RELOC:     92069-16169
* 
* 
* CALLING SEQUENCE: 
*    CALL DBCRT(IROOT,IDCB,IMODE,ISTAT) 
* 
*        WHERE: 
* 
*        IROOT
*        IS THE ADDRESS OF THE ROOT FILE
* 
*        IDCB 
*        IS A FMP FILE CONTROL BLOCK
* 
*        IMODE
*        IS THE PURGE MODE INDICATOR
*             0 IMPLIES "NO PURGE" OF DATA SET FILES
*             1 IMPLIES "PURGE" THE DATA SET FILES
* 
*        ISTAT
*        IS AN ARRAY OF AT LEAST FOUR WORDS IN WHICH A STATUS CODE, ZERO
*        IF SUCCESSFUL, IS RETURNED IN THE FIRST ELEMENT.  IF UNSUCCESS-
*        FUL, THE NAME OF THE DATA SET ON WHICH THE ERROR IS ENCOUNTERED
*        IS RETURNED IN THE SECOND THROUGH FOURTH ELEMENTS. 
* 
      ENT DBCRT 
* 
      EXT PURGE,.ENTR,.MVW,ECREA,ECLOS,EWRIT
      EXT SIZE
      EXT .DMP,.DDI,.DIN,.DDS,.DIS
* 
* 
* 
      SKP 
* 
* 
* 
* 
* 
* 
IROOT BSS 1         ADDRESS OF ROOT FILE
IDCB  BSS 1         FMP FILE CONTROL BLOCK
IMODE BSS 1         PURGE MODE FLAG 
*                                   0 IMPLIES "NO PURGE"
*                                   1 IMPLIES "PURGE" 
ISTAT BSS 1         STATUS ARRAY
* 
DBCRT NOP 
      JSB .ENTR     GET PARMETERS 
       DEF IROOT
* 
      LDA IROOT,I   SAVE THE SECURITY CODE
      ADA DBSCD 
      STA ISC 
* 
      ADA DBSCT     SAVE SET TABLE COUNT
      LDB A,I 
      CMB,INB 
      STB SCNT
* 
      INA           SAVE SET TABLE POINTER
      LDB A,I 
      ADB IROOT,I 
      STB DSET
* 
      ADA .2        SAVE FREE RECORD TABLE POINTER. 
      LDB A,I 
      ADB IROOT,I 
      STB FRTPT 
* 
* 
*                   INITIALIZE INFORMATION NEEDED FOR FMP CALLS 
* 
* 
DBC10 LDB DSET      GET CARTRIDGE NUMBER
      ADB DSCRN 
      STB ICR 
* 
      INB           GET RECORD LENGTH 
      LDA B,I       RECORD LENGTH = 
      AND B377        MEDIA LENGTH +
      INB              DATA LENGTH
      ADA B,I 
* 
      STA RLGT2     SAVE RECORD LENGTH AS A DOUBLE WORD 
      STA ISIZ4     SAVE THE RECORD SIZE FOR ECREA
* 
      ADB DSCAP     GET SIZE OF FILE IN SECTORS.
      DLD B,I 
      DST FLGTH     SAVE NUMBER OF RECORDS IN FILE
* 
      JSB SIZE
      DEF *+4 
      DEF FLGTH 
      DEF RLGT2 
      DEF ISTAT,I 
* 
      SOC           CHECK FOR OVERFLOW
      JMP ERR30 
* 
      JSB .DIN
      SOC           CHECK FOR OVERFLOW
      JMP ERR30 
* 
      SLB           CHECK FOR EVEN BLOCK COUNT
      JSB .DIN
* 
      SOC           CHECK FOR OVERFLOW
      JMP ERR30 
* 
      DST ISIZE     SAVE THE BLOCK SIZE 
* 
* 
* 
* 
* 
*                   ZERO BUFFER 
* 
* 
* 
      LDB RLGT2     SET CNT TO # WORDS IN RECORD
      CMB,INB 
      STB CNT 
* 
      LDB ABUFF      GET ADDRESS TO BUFFER
      CLA 
DBC20 STA B,I       ZERO BUFFER 
      INB 
      ISZ CNT 
      JMP DBC20 
* 
* 
*                   SET FLAG TO INDICATE DATA SET TYPE
* 
* 
      CLB 
      LDA DSET      GET THE DATA SET TYPE 
      ADA DSINF 
      LDA A,I 
      ALF           SIGN BIT SET AFTER ROTATE 
      SSA             IF DATA SET A DETAIL. 
      CCB           IF DETAIL SET FLAG = -1 
      STB FLAG
* 
* 
* 
* 
*                   DELETE FILE WHEN NECESSARY
* 
* 
* 
      LDA IMODE,I 
      SZA,RSS 
      JMP DBC30 
* 
      JSB PURGE 
      DEF *+6 
      DEF IDCB,I
      DEF ISTAT,I 
      DEF DSET,I
ISC   ABS *-* 
ICR   ABS *-* 
* 
      CPA M6
      JMP DBC30 
      SSA 
      JMP ERRX
* 
* 
*                   CREATE THE FILE 
* 
* 
DBC30 JSB ECREA 
      DEF *+8 
      DEF IDCB,I
      DEF ISTAT,I 
      DEF DSET,I
      DEF ISIZE 
      DEF .2
      DEF ISC,I 
      DEF ICR,I 
* 
      SSA 
      JMP ERRX
* 
      CLA 
      CLB,INB 
      DST NUM 
* 
* 
*         REINITIALIZE THE FREE SPACE POINTERS FOR THIS DATA SET. 
* 
* 
      DLD FLGTH     FIRST DOUBLEWORD =
      DST FRTPT,I     # OF FREE RECORDS = 
      ISZ FRTPT         CAPACITY OF DATA SET. 
      ISZ FRTPT 
* 
      CLB           SECOND DOUBLEWORD = 
      LDA FLAG        ZERO IF A MASTER SET
      SSA               ELSE ONE. 
      INB 
      CLA 
      DST FRTPT,I 
      ISZ FRTPT 
      ISZ FRTPT 
      SKP 
* 
* 
* 
* 
* 
*                   INITIALIZE THE DATA SET RECORDS TO ZERO 
*                   CHAIN THE FREE SPACE POINTERS IN THE DETAIL 
*                   DATA SETS 
* 
* 
* 
* 
DBC40 LDA FLAG
      SSA,RSS       IF MASTER DON'T MODIFY MEDIA
      JMP DBC50 
* 
      DLD NUM         OTHERWISE POINT TO NEXT RECORD
      JSB .DIN
      DST ABUF2 
* 
DBC50 JSB WRITE 
      SSA 
      JMP ERRX
* 
      JSB .DIS      DOUBLE INCREMENT RECORD COUNT 
      DEF NUM 
      NOP 
* 
      JSB .DDS      DOUBLE DECREMENT AND SKIP 
      DEF FLGTH 
      JMP DBC40 
* 
      CLA           PUT A ZERO IN THE MEDIA RECORD OF LAST CHAIN
      CLB 
      DST ABUF2 
* 
      JSB .DDS
      DEF NUM 
      NOP 
* 
      JSB WRITE 
      SSA 
      JMP ERRX
* 
      JSB ECLOS     CLOSE THE DATA FILE 
      DEF *+3 
      DEF IDCB,I
      DEF ISTAT,I 
* 
      SSA 
      JMP ERRX
* 
      LDA DSET      GET NEXT DATA SET TABLE ENTRY 
      ADA DSLNG 
      STA DSET
* 
      ISZ SCNT      ARE THERE MORE DATA SETS? 
      JMP DBC10       YES, GO PROCESS THEM
      CLA             NO, EXIT WITH NO ERROR
      STA ISTAT,I 
EXIT  JMP DBCRT,I 
* 
* 
* 
ERR30 LDA .N30      SET ERROR CODE TO -30 
      STA ISTAT,I 
* 
ERRX  LDA DSET      ERROR, PUT DATA SET NAME
      LDB ISTAT       IN STATUS ARRAY.
      INB 
      JSB .MVW
      DEF .3
      DEC 0 
      JMP EXIT      RETURN
* 
* 
.N30  DEC -30 
      SKP 
* 
* 
* 
*                   WRITE FILE ROUTINE
* 
* 
* 
* 
WRITE NOP 
      JSB EWRIT 
      DEF *+6 
      DEF IDCB,I
      DEF ISTAT,I 
      DEF BUFF
      DEF .0
      DEF NUM 
      JMP WRITE,I 
      SKP 
* 
* 
* 
* 
*                   DATA DECLARATION
* 
* 
* 
* 
* 
* 
A     EQU 0 
B     EQU 1 
* 
* 
DBSCD DEC 3         OFFSET INTO ROOT FILE FOR DATA BASE SECURITY CODE 
DBSCT DEC 6         + 3 = ROOT FILE OFFSET FOR DB SET COUNT 
* 
* 
DSCRN EQU DBSCD     DATA SET OFFSET FOR DATA SET CARTRIDGE
DSINF DEC 4         DATA SET OFFSET FOR TYPE AND MEDIA
DSCAP EQU DBSCD     + 5 = DATA SET OFFSET FOR CAPACITY
DSLNG DEC 17        LENGTH OF SET TABLE ENTRY 
* 
* 
B377  OCT 377       MASK FOR RIGHT BYTE 
.128D DEC 0         DOUBLE WORD 128 
      DEC 128 
.0    EQU .128D 
M6    DEC -6
.2    DEC 2 
.3    EQU DBSCD 
* 
* 
* 
* 
SCNT  BSS 1         NEGETIVE SET COUNT
DSET  BSS 1         ADDRESS OF CURRENT SET
FRTPT BSS 1         ADDRESS OF FREE RECORD TABLE
CNT   BSS 1 
FLAG  BSS 1         FLAG TO INDICATE SET TYPE 
NUM   BSS 2         HOLDS CURRENT RECORD NUMBER.
FLGTH BSS 2         FILE CAPACITY 
RLGTH DEC 0,0       DOUBLE WORD RECORD LENGTH 
RLGT2 EQU RLGTH+1 
ISIZE DEC 0,0,0,0 
ISIZ4 EQU ISIZE+3 
* 
ABUFF DEF BUFF
BUFF  BSS 2048
ABUF2 EQU BUFF+1
* 
      BSS 0 
      END 
                                                                                                    