ASMB,R,L,C
      HED (FMP) $OPEN: SET UP FILE DCB
*     NAME:   $OPEN 
*     SOURCE: 92071-18066 
*     RELOC:  92071-16066 
*     PGMR:   G.A.A.
*     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 $OPEN,7 92071-1X066 REV.2041 800618 
* 
      ENT $OPEN 
* 
      EXT RWND$, .R2, .R5 
      EXT EXEC
* 
      EXT F.DCB, F.LU,  F.TYP, F.SIZ, F.SC2 
      EXT F.ST1, F.S/T, F.RCN, F.EXN  
      SUP 
      SKP 
* 
*     DESCRIPTION 
* 
*     $OPEN IS CALLED BY OPEN AND CREAT TO SET UP THE DCB.
*           IT TRANSFERS THE INFORMATION FROM D.RTR'S AUXILLARY 
*           BUFFER TO THE DCB.  IT ALSO INITIALIZES THE REST
*           OF THE DCB VIA RWND$. 
* 
*     CALLING SEQUENCE: 
* 
*     <A = REQUESTED PACKING BUFFER SIZE> 
*     <B = REQUESTED SECURITY CODE> 
*     JSB $OPEN 
*     <ERROR RETURN: A = ERROR CODE>
*     <NORMAL RETURN: A,B,E = GARBAGE>
* 
*     POSSIBLE ERRORS:
* 
*     -7   BAD FILE SECURITY CODE 
*     -102 ILLEGAL D.RTR SEQUENCE (NO STRING RETURNED)
* 
*     NOTE: THIS ROUTINE ASSUMES THAT THE DCB INFORMATION 
*           HAS BE EXPANDED AND PLACED INTO EXTERNAL LOCATIONS
* 
      SKP 
* 
*     ENTRY 
* 
$OPEN NOP           ENTRY 
      STA IDCBS     SAVE REQUESTED PACKING BUFFER SIZE
      STB ISECU     SAVE REQUESTED FILE SECURITY CODE 
* 
*     PROCESS REQUEST 
* 
      DLD .R2       GET LU AND ENTRY
      DST F.LU,I     SAVE IN DCB
* 
      JSB EXEC      GET STRING FROM D.RTR 
      DEF *+5 
      DEF NAB14     STRING PASSAGE REQUEST
      DEF .1         FROM SON 
      DEF F.TYP,I 
      DEF .6
      JMP ER102     ERROR EXIT
* 
      LDA F.SC2,I   GET STARTING SECTOR 
      AND B377       ISOLATE SECTOR 
      STA F.SC2,I     AND SAVE AGAIN
* 
      LDA F.ST1,I   GET FILE SECURITY CODE
      SZA,RSS       IF ZERO,
      JMP SCOK       THEN OK
* 
      CPA ISECU     IF MATCHES REQUESTED SECURITY CODE, 
      JMP SCOK       THEN OK
* 
      SSA           IF NEGATIVE SECURITY CODE,
      JMP ER7        THEN NOT OK
* 
      CMA,INA       MAKE SECURITY CODE NEGATIVE 
      CPA ISECU     IF MATCHES REQUESTED SECURITY CODE, 
* 
SCOK  CCE,RSS       SET SECOD-MATCH FLAG
      CLE           CLEAR SECOD-MATCH FLAG
      CLA 
      ERA           MOVE SECOD-MATCH FLAG INTO FIRST STATUS WORD
      STA F.ST1,I    AND SAVE 
* 
      LDA .R5       GET SECTORS / TRACK 
      ALF,ALF        ALIGN, 
      AND B377        ISOLATE,
      STA F.S/T,I      AND SAVE 
* 
      LDB IDCBS     GET REQUESTED BUFFER SIZE (IN WORDS)
      ASR 7          CONVERT TO BLOCKS
      SZB,RSS       IF ZERO,
      INB            THEN USE ONE BLOCK BUFFER
      BLS           CONVERT TO SECTORS
* 
NXBUF STB IDCBS     SAVE IT 
      LDB F.SIZ,I   GET THE FILE SIZE 
      ASR 16         EXTEND SIGN
      DIV IDCBS       DIVIDE BY BUFFER SIZE 
      SZB,RSS       IF NO REMAINDER 
      JMP BFOK      THEN THE SIZE IS OK 
* 
      LDB N2        ELSE TRY ONE SMALLER
      ADB IDCBS     THAN THE CURRENT
      JMP NXBUF     ONE 
* 
BFOK  LDA IDCBS     GET ACTUAL PACKING BUFFER SIZE (IN SECTORS) 
      ASL 6          CONVERT TO WORDS 
      IOR F.ST1,I     MERGE WITH FIRST STATUS WORD
      STA F.ST1,I      AND SAVE 
* 
      CLA           OPEN EXTENT ZERO
      LDB F.DCB,I 
      JSB RWND$     SET REST OF DCB 
      JMP EREX      TAKE ERROR EXIT 
* 
      CLA,INA       SET THE RECORD NUMBER 
      STA F.RCN,I    TO ONE.
      SKP 
* 
*     EXIT
* 
EXIT  CLA           NO ERROR INTENDED 
      ISZ $OPEN     STEP TO GOOD ADDRESS
      JMP EREX
* 
ER7   LDA N7        BAD FILE SECURITY CODE
      JMP EREX
* 
ER102 LDA N102      ILLEGAL D.RTR SEQUENCE (NO STRING RETURNED) 
* 
EREX  JMP $OPEN,I   RETURN
      SKP 
* 
*     STORAGE AREA
* 
N2    DEC -2
N7    DEC -7
N102  DEC -102
* 
.1    DEC 1 
.6    DEC 6 
* 
B377  OCT 377 
* 
NAB14 OCT 100016
* 
IDCBS NOP           PACKING BUFFER SIZE 
ISECU NOP           REQUESTED SECURITY CODE 
* 
A     EQU 0 
B     EQU 1 
* 
END   EQU * 
* 
      END 
                                                                                                                                    