ASMB,R,L,C HED (FMP) OPEN: OPEN A FILE * NAME: OPEN * SOURCE: 92071-18047 * RELOC: 92071-16047 * 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 OPEN,7 92071-1X047 REV.2041 800808 * ENT OPEN * EXT CLOSE, $OPEN, GTOPN EXT CLD.R, .P1, .P2, .P3, .P4, .P6, .R1 EXT .ENTR, LURQ, IFTTY, $SETP * EXT F.DCB, F.TYP, F.FLG, F.DLU, F.ST1 SUP SKP * * DESCRIPTION * * OPEN ATTEMPTS TO OPEN A FILE. (BLAH, BLAH, BLAH) * * THE FORTRAN CALLING SEQUENCE IS: * * CALL OPEN(IDCB,IERR,NAME,IOPTN,ISECU,ICR,IDCBS) * * WHERE: * * IDCB IS A DATA CONTROL BLOCK (144-WORD ARRAY) * TO BE USED FOR ACCESS TO THE FILE * DURING THIS OPEN. * * IERR WILL BE THE ERROR RETURN CODE (ALSO RETURNED IN A). * * NAME IS THE 6-CHARACTER NAME (3-WORD ARRAY). * * IOPTN IS THE OPEN OPTION WORD (OPTIONAL). * * OPTIONS ARE: * BIT MEANING IF SET * 0 NON-EXCLUSIVE OPEN * 1 UPDATE OPEN (DISC FILES ONLY) * 2 FORCE TO TYPE 1 OPEN (DISC FILES ONLY) * 3 USE SUB FUNCTION IN BITS 6-11 (NON-DISC FILES ONLY) * 4 PREVENT CREATION OF FILE EXTENTS (DISC FILES ONLY) * 6-11 ACCESS SUBFUNCTION (NON-DISC FILES ONLY) * * ISECU IS THE EXPECTED SECURITY CODE (OPTIONAL). * * ICR IS THE SPECIFIED CARTRIDGE REFERENCE. * IF ICR >0 THEN USE DISC LABELED ICR * IF ICR <0 THEN USE DISC AT LOGICAL UNIT (-ICR) * * IDCBS IS THE LENGTH OF THE PACKING BUFFER * AREA FOLLOWING HEADER (OPTIONAL). * IF NOT CODED, 128-WORD BUFFER IS ASSUMED. * THE BUFFER MUST EVENLY DIVIDE THE FILE SIZE, * HENCE, ONLY PART OF THE SPECIFIED BUFFER MAY BE USED. * SIZE USED IS: * SIZE USED = FILE SIZE/N WHERE * N = (FILE SIZE/IDCBS)+(IF REMAINDER THEN 1,ELSE 0) * * POSSIBLE ERRORS: * * -1 DISC ERROR * -6 FILE NOT FOUND * -7 WRONG SECURITY CODE * -8 FILE IS CURRENTLY OPEN (IF EXCLUSIVE REQUEST) OR * IS CURRENTLY OPEN TO 7 OTHER PROGRAMS * -9 ATTEMPT TO OPEN TYPE 0 AS TYPE 1 * -10 NOT ENOUGH PARAMETERS * -13 DISC LOCKED * -36 LOCK ERROR SKP * * ENTRY * OPEN NOP LDA DZERO PRESET ENTRY PARMS STA NAME STA IOPTN STA ISECU STA ICR STA IDCBS LDA OPEN STA DPEN JMP DPEN+1 * IDCB NOP IERR NOP NAME DEF ZERO IOPTN DEF ZERO ISECU DEF ZERO ICR DEF ZERO IDCBS DEF ZERO * DPEN NOP ENTRY POINT JSB .ENTR TRANSFER PARAMETERS DEF IDCB TO LOCAL AREA * LDB NAME DID WE GET CPB DZERO ENOUGH PARAMETERS? 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 FILE DEF *+2 IF ALREADY DEF IDCB,I OPEN * SZA SKIP IF NO ERRORS CPA N11 OR IF NOT OPEN RSS JMP EREX ELSE TAKE ERROR EXIT * * SET UP D.RTR OPEN REQUEST * LDA .9 SET FUNCTION FIELD (OPEN REQUEST) STA .P1 SAVE FOR D.RTR * LDA ICR,I FETCH -LU/+CRN/0 STA .P2 SAVE FOR D.RTR * LDA NAME,I SET FILE NAME LDB IOPTN,I GET OPTION WORD ERB ISOLATE EXCLUSIVE-OPEN FLAG CME COMPLEMENT RAL,ERA MERGE WITH FIRST NAME WORD STA .P3 AND SAVE FOR D.RTR * ISZ NAME BUMP TO SECOND NAME WORD DLD NAME,I GET REST OF NAME SZA,RSS IF NULL, LDA BLANK THEN FILL WITH BLANKS SZB,RSS IF NULL, LDB BLANK THEN FILL WITH BLANKS DST .P4 SAVE FOR D.RTR * LDA ISECU,I GET SECURITY CODE STA .P6 SAVE FOR D.RTR * JSB CLD.R CALL D.RTR * LDA .R1 GET ERROR WORD SSA IF ERROR JMP EREX EXIT SKP * * SET UP USER DATA CONTROL BLOCK * JSB GTOPN GET OPEN FLAG DEF *+1 STA F.FLG,I AND SAVE IN DCB * LDA IDCBS,I GET REQUESTED PACKING BUFFER SIZE LDB ISECU,I GET REQUESTED SECURITY CODE JSB $OPEN SET UP REST OF DCB JMP EREX1 IF ERROR, THEN TAKE ERROR EXIT * LDA F.ST1,I GET FIRST STATUS WORD LDB IOPTN,I GET OPEN OPTION WORD RBR,ERB MOVE UPDATE MODE (BIT 1) INTO E-REG SSA,RSS IF WRITE-PROTECTED ACCESS, CLE THEN CLEAR UPDATE-MODE BIT RAR,ELA MOVE E-REG INTO STATUS WORD * RBR,RBR SLB IF PREVENT-EXTENT-CREATES (BIT 4) SET, IOR B10 THEN SET FLAG IN STATUS WORD STA F.ST1,I SAVE STATUS WORD * ELB MOVE BIT 2 TO SIGN, BIT 3 TO E-REG LDA F.TYP,I GET FILE TYPE SSB,RSS IF NO TYPE 1 OVERRIDE (BIT 2), JMP OPEN1 THEN CONTINUE * SZA,RSS IF TYPE ZERO FILE, JMP ER9 THEN TAKE ERROR EXIT * CLA,INA FORCE TO TYPE 1 STA F.TYP,I AND SAVE AGAIN * OPEN1 SZA IF NOT TYPE ZERO, JMP EXIT THEN EXIT SKP * * SET UP TYPE 0 FILE ACCESS (E CONTAINS BIT 3 FROM OPTION WORD) * LDA F.DLU,I GET DEVICE LU AND B77 ISOLATE IT STA LU SAVE FOR POSSIBLE LOCK REQUEST * LDA IOPTN,I GET OPTION WORD AGAIN AND B477K ISOLATE SUBFUNCTION FIELD ADA LU MERGE WITH OND LU SEZ IF NEW SUBFUNCTION REQUESTED, STA F.DLU,I THEN SET IT IN THE DCB * LDA IOPTN,I GET OPTION WORD AGAIN SLA,RSS IF NOT EXCLUSIVE OPEN (BIT 0) JMP EXIT THEN DON'T LOCK, EXIT * JSB IFTTY TEST IF LU IS DEF *+2 INTERACTIVE DEF LU * SZA IF INTERACTIVE JMP EXIT THEN DON'T LOCK! * JSB LURQ REQUEST LU LOCK DEF *+4 DEF OPTN OPTION WORD DEF LU LU WORD DEF .1 ONE LU JMP ER18 ERROR; REPORT BAD REQUEST * SZA NO RN? JMP ER36 RIGHT, ERROR * LDA F.ST1,I GET STATUS WORD IOR B2 SET LOCK BIT STA F.ST1,I SAVE AGAIN SKP * * EXIT * EXIT LDA F.TYP,I GET FILE TYPE FOR RETURN IN ERROR CODE * EREX STA IERR,I SAVE ERROR CODE JMP DPEN,I AND RETURN * ER9 LDA N9 CANNOT OVERRIDE TYPE 0 FILE ACCESS JMP EREX1 * ER10 LDA N10 NOT ENOUGH PARAMETERS JMP EREX * ER18 LDA N18 ILLEGAL LU JMP EREX1 * ER36 LDA N36 DEVICE LOCK ERROR * EREX1 STA IERR,I SAVE ERROR CODE * JSB CLOSE MAKE SURE THAT FILE IS CLOSED DEF *+2 DEF IDCB,I * LDA IERR,I GET ERROR CODE JMP DPEN,I AND RETURN SKP * * STORAGE AREA * ZERO NOP * N36 DEC -36 N18 DEC -18 N11 DEC -11 N10 DEC -10 N9 DEC -9 * .1 OCT 1 .9 DEC 9 .16 DEC 16 * B2 OCT 2 B10 OCT 10 B77 OCT 77 B477K OCT 47700 * OPTN OCT 140001 BLANK ASC 1, * DZERO DEF ZERO * LU NOP LOGICAL UNIT NUMBER * A EQU 0 B EQU 1 * END EQU * * END