ASMB,R,L,C HED OPEN * NAME: OPEN * SOURCE: 92067-18127 * RELOC: 92067-16125 * PGMR: G.A.A.,N.J.S. * * *************************************************************** * * (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. * * *************************************************************** * NAM OPEN,7 92067-16125 REV.2001 791018 ENT OPEN EXT EXEC, CLOSE, RMPAR, $OPEN EXT .ENTR, IFTTY, LURQ EXT D.R, OVRD., SESSN, $SMID, ISMVE SUP * * * OPEN IS THE FILE OPEN ROUTINE OF THE REAL TIME * FILE MANAGEMENT PACKAGE * * * THE FORTRAN CALLING SEQUENCE IS: * * CALL OPEN(IDCB,IERR,NAME,IOP,IS,ILU,IBLK) * * W H E R E: * * IDCB IS A 144-WORD DATA CONTROL BLOCK (ARRAY) * TO BE USED WITH ALL ACCESS TO THE FILE * UNDER THIS OPEN. * * IERR IS THE RETURN ERROR CODE (ALSO RETURNED IN A) * * NAME IS THE 6-CHARACTER (3 WORD) NAME ARRAY. * * IOP (OPTIONAL); IS THE OPEN OPTION FLAG WORD * OPTIONS ARE: * BIT MEANING IF SET * 0 NON-EXCLUSIVE OPEN * 1 UPDATE OPEN * 2 FORCE TO TYPE 1 OPEN * 3 USE SUB FUNCTION IN BITS 6-11 * IF TYPE 0. * * IS (OPTIONAL); IS THE EXPECTED SECURITY CODE. * * ILU (OPTIONAL); IS THE DISC SPECIFIED. * IF ILU >0 THEN USE DISC LABELED ILU * IF ILU <0 THEN USE DISC AT LOGICAL UNIT (-ILU) * * IBLK (OPTIONAL); SPECIFIES A DCB BUFFER AREA OF * IBLK WORDS. (NORMALLY 128 IS USED.) MUST BE * A MULTIPLE OF 128. 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)+(1 IF REMAINDER, ELSE 0) * * OPEN ERRORS ARE AS FOLLOWS: * * FROM D.RTR * -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 * -13 DISC LOCKED * -32 CARTRIDGE NOT FOUND * * FROM $OPEN * -9 ATTEMPT TO OPEN TYPE 0 AS TYPE 1 * * FROM OPEN * -10 NOT ENOUGH PARAMETERS * -18 LOCK ERROR * -36 LOCK NOT GRANTED * SKP DCB NOP ERR NOP NAME DEF ZERO OP DEF ZERO SC DEF ZERO LU DEF ZERO IBLK DEF ZERO * OPEN NOP ENTRY POINT JSB .ENTR TRANSFER PARAMETERS DEF DCB TO LOCAL AREA LDA N10 LDB NAME DID WE GET CPB DZERO ENOUGH PARAMETERS? JMP EXIT NO - ERROR EXIT * JSB CLOSE CLOSE DCB DEF *+2 JUST IN CASE DEF DCB,I IT'S OPEN SZA SKIP IF NO CPA N11 ERRORS OR IF CLE,RSS NOT OPEN ERROR JMP EXIT ELSE TAKE ERROR EXIT * * SET UP AND CALL D.RTR * LDA NAME,I GET NAME WORD 1 LDB OP,I AND OPTION WORD ERB EXCLUSIVE BIT TO E CME INVERT E AND RAL,ERA SET IN SIGN OF A STA NAME1 SET FOR CALL TO D.RTR ISZ NAME GET REST OF DLD NAME,I NAME TO STRING DST NAME1+1 BUFFER FOR D.RTR CALL LDA XEQT GET CURRENT PROGRAM ID CCE SET SIGN BIT TO INDICATE RAL,ERA AN OPEN REQUEST STA ID FOR D.RTR CALL * JSB EXEC SCHEDULE D.RTR DEF SCRTN WITH WAIT TO DEF .23 OPEN THE FILE DEF D.R DEF ID ID + SIGN BIT DEF OVRD. OVERRIDE BITS DEF LU,I LU OF FILE DEF SC,I SECURITY CODE DEF ZERO DEF NAME1 SEND 3-WORD STRING DEF .3 CONTAINING NAME * SCRTN JSB RMPAR GET RETURN PARAMETERS DEF *+2 DEF ID LDA ID GET ERROR WORD SSA IF D.RTR ERROR JMP EXIT JUST EXIT AND PASS IT ON * JSB EXEC RETREIVE STRING PASSED DEF *+5 BACK FROM D.RTR DEF .14 DEF .1 DEF DIR DEF .6 * * SAVE ON SYSTEM DISC INFORMATION FROM D.RTR AND CALL $OPEN TO SET UP DCB * CLB,CLE LDA DIR GET 1ST WORD OF STRING FROM D.RTR RAL,ERA CLEAR BIT 15 AND PUT IT IN E SEZ WAS BIT 15 SET? ON 2 OR 3? CCB YES - SET B TO -1 STB SCFLG IF ON 2 OR 3, SFLAG = -1, ELSE 0 STA DIR REPLACE WORD 1 WITH BIT 15 CLEARED DLD ID+1 SET UP FIRST TWO WORDS OF DST DCB,I THE DCB FROM D.RTR RETURNS CLO SET O LDA OP,I TO RAR,SLA,RAR INDICATE STO UPDATE OPTION ERA AND E FOR TYPE 1 OVER-RIDE STA LU SAVE SUBFUNCTION FLAG LDA DCB GET DCB ADDRESS LDB ADIR AND SECURITY CODE * JSB $OPEN GO SET UP THE DCB DEF IBLK,I ADDRESS OF BLOCK SIZE DEF ID+4 ADDRESS OF NO OF SECTORS PER TRACK JMP OPEN2 ERROR - CLOSE AND EXIT * * * MUST DECIDE WHETHER TO ALLOW WRITE ACCESS TO THIS FILE. WHEN * UNDER SESSION CONTROL, LU 2 AND 3 MAY BE ACCESSED ONLY FOR READS * UNLESS OVERRIDE CONDITION IS SET. * * A. NORMAL RESTRICTIONS FOR WRITE ACCESS * 1. SC IN DIRECTORY IS 0 OR * 2. SC IN DIRECTORY IS +X AND SC PASSED IN IS +X OR -X OR * 3. SC IN DIRECTORY IS -X AND SC PASSED IN IS -X * * B. TO SET SC BIT IN DCB WORD 7 * 1. IF NOT IN SESSION, ONE OF A MUST BE MET * 2. IF IN SESSION AND NOT ON LU 2 OR 3, ONE OF A MUST BE MET * 3. IF IN SESSION AND ON LU2 OR 3, * A. 1 OF A MUST BE MET AND * B. OVRD. MUST BE NONZERO OR CALLER MUST BE SYSTEM MANAGER * * JSB SESSN DEF *+2 DEF XEQT E=0 IF IN SESSION SEZ IN SESSION? JMP OPEN0 NO - GO DO REGULAR SECURITY CHECKING STB NAME1 YES - SAVE SESSION WORD (JUST TEMPORARY) * JSB ISMVE READ THE CALLER'S USER ID DEF *+5 INTO TEMP SPACE DEF NAME1 (SESSION WORD) DEF $SMID (OFFSET TO USER ID) DEF CODE (TEMP SPACE) DEF .1 (JUST ONE WORD) LDA CODE GET USER ID CPA B7777 CALLER THE SYSTEM MANAGER? JMP OPEN0 YES - DO REGULAR SECURITY CHECKING LDA SCFLG A(BIT 15) = 1 IF FILE ON LU 2 OR LU 3 LDB OVRD. B IS #0 IF OVERRIDE CONDITION IS SET SSA FILE ON 2 OR 3?? CLE,SZB YES - OVERRIDE? RSS NOT ON 2 OR 3 OR OVERRIDE IS SET JMP OPEN1 ON 2 OR 3 AND NO OVERRIDE SO READ ONLY ACCESS * * REGULAR SECURITY CHECKS * OPEN0 CLE LDB DIR+5 GET SC FROM DIRECTORY SZB ZERO? CPB SC,I OR = PASSED IN SC? JMP OP.0 YES - SET E FOR SC FLAG SSB IF NEGATIVE SECURITY CODE THEN NO JMP OPEN1 MORE CHECKS - DON'T MATCH ADB SC,I POSITIVE SC - TAKE CARE OF CASE WHERE CLE SC = +X AND -X WAS PASSED IN SZB,RSS (CLEAR E IN CASE GOT SET IN ADDITION) * * SET SC AND OM IN DCB * OP.0 CCE OPEN1 LDB DCB GET DCB ADDRESS ADB .7 POSITION TO WORD WITH SC FLAG LDA B,I RAL,ERA PUT E INTO BIT 15 STA B,I AND RESTORE WORD LDA SCFLG GET ON SYSTEM DISC FLAG ELA IF SET, SET E LDA B,I GET DCB WORD 7 AGAIN SEZ ON 2 OR 3? IOR BIT4 YES - SET BIT 4 STA B,I AND RESTORE JMP OPEN3 GOOD OPEN SO SKIP CLOSE * * CLOSE FILE - SET SUBFUNCTION CODE IF TYPE 0 * OPEN2 STA ID SAVE ERROR CODE JSB CLOSE ILLEGAL OPEN SO CLOSE DEF *+2 THE DEF DCB,I FILE OPEN3 LDA ID GET ERROR CODE LDB DCB POSITION TO TYPE ADB .2 WORD IN THE DCB SSA,RSS WAS THERE AN ERROR? LDA B,I NO - GET TYPE CODE SZA IF NOT TYPE ZERO JMP EXIT THEN EXIT LDB LU GET SUBFUNCTION WORD ERB GET SUBFUNCTION SET BIT IN E-REG * LDB DCB CALCULATE DCB SUB ADB .3 FUNCTION ADDRESS STB SC SAVE IT LDA OP,I GET THE OPTION SUB FUNCTION AND B3700 MASK IT OFF STA B AND SAVE IT LDA SC,I GET THE CURRENT SUBFUNCTION WORD AND B77 SAVE THE LU STA LU KEEP FOR LOCKING THE LU LATER ADA B ADD IN THE NEW SUB FUNCTION SEZ IF SUBFUNCTION BIT WAS'NT SET, DON'T STORE STA SC,I SET IT IN THE DCB * LDB DCB POSITION TO DCB15 WORD ADB .15 AND SAVE ADDRESS OF THIS STB SC POSITION CLA,INA PRESET TO DON'T DO AN STA SC,I UNLOCK (FOR CLOSE) LDA OP,I GET OPEN OPTION WORD SLA EXCLUSIVE OPEN? JMP EXOK NO - SO DON'T LOCK THIS DEVICE * JSB IFTTY SEE IF THIS LU IS DEF *+2 AN INTERACTIVE DEVICE DEF LU SSA INTERACTIVE?? JMP EXOK YES - DON'T LOCK IT * LDA BIT13 SET BIT13 ON LU WORD ADA LU SO 8 BITS WILL BE USED FOR STA LU LU IN THE RESULTING EXEC CALL. * JSB LURQ LOCK CALL DEF *+4 DEF OPTN OPTION - LOCK WITHOUT WAIT, NO ABORT DEF LU LU WITH BIT 13 SET DEF .1 ONE LU JMP EX18 ERROR ON LOCK SZA SUCCESSFUL LOCK? JMP EX36 NO - NO RN'S AVAILABLE OR ALREADY LOCKED STA SC,I STORE LOCK SUCCESSFUL (DO UNLOCK) JMP EXOK EXIT NO ERRORS * EX18 LDA N18 ERROR ON LURQ CALL JMP EXIT EX36 LDA N36 LOCK NOT GRANTED JMP EXIT EXOK CLA CLEAR A AND EXIT EXIT LDB DCB IF NO ERRORS, ADB .2 THEN RETURN SSA,RSS THE TYPE LDA B,I LDB DZERO RESET THE Y REP 5 DEFAULT STB NAME+*-Y PARAMETERS STA ERR,I SET THE ERROR CODE JMP OPEN,I AND RETURN * * SPC 2 SPC 3 DZERO DEF ZERO ZERO NOP * .1 DEC 1 .2 DEC 2 .3 DEC 3 .6 DEC 6 .7 DEC 7 .14 DEC 14 .15 DEC 15 .23 DEC 23 * N10 DEC -10 N11 DEC -11 N18 DEC -18 N36 DEC -36 * B77 OCT 77 B7777 OCT 7777 B3700 OCT 3700 BIT4 OCT 20 BIT13 OCT 20000 OPTN OCT 140001 * SCFLG NOP ID NOP NAME1 BSS 3 CODE NOP DIR BSS 6 ADIR DEF DIR SPC 3 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 3 END EQU * END