SQOPEN867
(George Source)
Macros used: CAFSINFO, CAPCA, CHECKEXT, EXCHOFE, EXOFILE, FADDRESS, FPCACA, FREECORE, GEOERR, GETACTX, GETWORD, HLSXONCH, ILLEGALX, JDED, LADDP, LGEOG, LINKSET, MENDAREA, MFINDSU, MHUNTW, MONOUT, OUTPACK, OUTPARAM, PAIR, PLOCKSU, PROGBRKIN, PUTPERENT, RELST, ROLPA, RUNPROG, RV, SEGENTRY, SETNCORE, SMUSEST, STEPBACK, SUSEST, TESTREP2, TESTREPNOT, TRUSTED, TWAIT, UNLOCKSU, VFREE, WORDFIN
- SQOPEN867.txt
22FL ...#SEG SQOPEN70 [FRANK BLUNDELL 22KH ...# 22PD ...# COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 22T* ...# 22^= #LIS K0SQOPEN 23DW 8HSQOPEN 23YG # 24D6 # THIS ROUTINE DEALS WITH MODES #1600 AND #1700 OPEN 24XQ # THE MODES ARE ONLY AVAILABLE TO TRUSTED PROGRAMS 25CB # ON ENTRY X4 TYPE B0-B9 CHANNEL B14-23 25X2 # X5 COPY OF WORD 0 OF CONTROL AREA 26BL # XCA CONTROL AREA ADDRESS 26W= # THE CONTROL AREA IS FIVE WORDS LONG 27*W # 27TG # 28*6 SEGENTRY K1SQOPEN,QK1SQ 28SQ # 29#B STEN +10 29S2 XLINK PAIR PERION,1 2=?L XPER +JYPERFAIL 2=R= XNOC +JYNOCA 2?=W XINV +JYINVAL 2?QG XMOD +JYMODE 2#=6 # 2#PQ #DEF XCA=EVENT2 2*9B # 2*P2 # 2B8L # 2BN= QK1SQ 2C7W #SKI K6SQOPEN>199-199 [CHECK TYPE/MODE 2CMG ( 2D76 LDX 0 5 2DLQ SRL 0 15 2F6B ANDN 0 #377 2FL2 SBN 0 6 2G5L BZE 0 XCH1 2GK= SBN 0 1 2H4W BZE 0 XCH1 2HJG SBN 0 6 2J46 BZE 0 XCH1 2JHQ SBN 0 13 2K3B BNZ 0 XCH3 2KH2 XCH1 LDX 0 5 2L2L ANDX 0 XCHM(1) 2LG= SBN 0 #1600 2L^W BZE 0 XCH2 2MFG SBN 0 #100 2M^6 BZE 0 XCH2 2NDQ XCH3 GEOERR 1,SQOPEN 2NYB XCHM #71777 2PD2 XCH2 2PXL ) 2QC= LDX 6 4 2QWW LDX 4 XNOC(1) [C.A OUT OF RESERVATIONS 2RBG LDN 7 5 2RW6 CHECKEXT XCA(2),7,XVIOL,,W,XA,HLOCK1 [CHECK 5 WORDS 2S*Q XA SETNCORE GEXDLEN,3,EWDAS,GEXD [SET UP GEXD 2STB STOZ A1(3) [AND ZEROIZE 2T*2 ADN 3 A1 2TSL LDN 4 1(3) 2W#= MOVE 3 GEXDLEN-1 2WRW SBN 3 A1 32NW ANDN 6 #1777 338G STO 6 EXCHNL(3) [CHANNEL NO. 347Q LDX 7 5 34MB ANDN 5 #1777 [X5= MODE 3572 STO 5 EOPMODE(3) [STORE IN GEXD 35LL LDX 0 XCA(2) 366= STO 0 CNR(3) [SAVE CA ADDRESS 36KW SRL 7 10 375G ANDN 7 3 [X7 HOLDS ADDITIVE BITS 37K6 LDX 0 7 384Q ANDN 0 1 38JB LDX 4 XINV(1) 3942 BZE 0 XVIOL [ERROR NO SERIAL NO. SPECIFIED 39HL LDX 4 XMOD(1) 3=3= TRUSTED 2,XC,S [CHECK IF S-TRUSTED 3=GW LDCT 6 #400 [S-TRUSTED MARK 3?2G BRN XCC 3?G6 XC TRUSTED 2,XVIOL,Q [CHECK IF Q-TRUSTED-ERROR IF NOT 3?^Q LDN 6 0 [Q-TRUSTED MARK 3#FB XCC SBN 5 #1700 3#^2 BZE 5 XCB [JUMP IF OPEN MODE 1700 3*DL BZE 6 XVIOL [ERROR IF NOT S-TRUSTED AND OPEN 3*Y= XCB LDX 1 CNR(3) [MODE 1600 3BCW ADN 1 1 3BXG FADDRESS 2,1,HLOCK1 [GET OUT SERIAL NUMBER 3CC6 LDX 0 0(1) 3CWQ SMO FX1 3DBB LDX 4 XINV 3DW2 BZE 0 XVIOL 3F*L STO 0 ESERL(3) 3FT= SRL 0 18 3G#W BNZ 0 XVIOL [ERROR IF NOT 6 DIGITS 3GSG CAPCA EWDAS,GEXD [TO CPA TAKING GEXD 3G^M ... MHUNTW 3,EWDAS,GEXD 3H3B ... LDCT 4 6 [*DA 3H55 ... ADX 4 EXCHNL(3) [TYPE/UNIT NO 3H6S ... LDN 7 0 [BRKIN MARKER FOR BRKIN ROUTINE 3H8H ... HLSXONCH YD,4,YC [SEE IF OK WITH HLS TO CARRY ON 3H#6 MHUNTW 3,EWDAS,GEXD 3HDS ... BZE 5 XOF1 [J IF MODE #1700 3HGB ... LDN 1 CWRITE [MODE #1600 NEEDS WRITE TRAPS 3HHY ... BRN XOF2 3HKG ...XOF1 3HM4 ... LDN 1 CREAD [MODE #1700 NEEDS READ TRAPS 3HNL ...XOF2 3HX^ ... EXCHOFE DIR,ESERL(3),1,XOF3 3H^B ... MHUNTW 3,EWDAS,GEXD 3H^Y ... TESTREP2 OK,XOF5,NOFILE,XOF4 3J48 ... OUTPACK ESERL(3),1,CSN [REPLY OF NOTRAPS SO ILLEGAL 3J5K ... MONOUT EWSTUC 3J72 ... BRN YC 3J7B ...XOF4 3J7G ... LDX 0 EDSQ 3J7L ... BPZ 0 XOF3 [J IF FULL SECURITY NOT IN USE 3J7Q ... OUTPACK ESERL(3),1,CSN 3J7W ... MONOUT EWRARED [DIRECTORY FOR SU Z DOESNT EXIST 3J82 ... BRN YC 3J83 ...XOF5 3J84 ... BZE 5 XOF6 3J85 ... EXCHOFE DIR,ESERL(3),,XOF3,AW [D&T WRITTEN+ACCESSED FOR *DA DIR 3J86 ... BRN XOF7 3J87 ...XOF6 3J88 ... EXCHOFE DIR,ESERL(3),,XOF3,A [D&T ACCESSED FOR :DANNNNNN DIRECTO 3J89 ...XOF7 3J8= ... MHUNTW 3,EWDAS,GEXD 3J8C ...XOF3 3J?B SUSEST ESERL(3),XDA [CHECK IF UNIT ONLINE 3K=L YE MHUNTW 3,EWDAS,GEXD 3MNQ XD MFINDSU 1,ESERL(3) 3N8B LADDP HUNIT(1),1 3NN2 JDED 1,NA [OK IF DEDICATED 3P7L BZE 6 NA [OR Q TRUSTED 3PM= BRN NB [ELSE ERROR 3Q6W NA PLOCKSU ESERL(3),NC,ND [GET LOCK OUT 3R66 SETNCORE FDCELLS-A1+6,2,EWDAS,EXOF [GETCORE FOR EXOF 3RKQ MHUNTW 3,EWDAS,GEXD 3S5B MFINDSU 1,ESERL(3) 3SK2 STOZ EXMARK(2) 3T4L LDN 0 1 [SET UP EXOF BLOCK 3TJ= STO 0 COPEN(2) [COUNT OF OPENS=1 3W3W NGS 0 HOME(2) [HOME =-1 3WHG LDX 0 ESERL(3) 3X36 STO 0 ASUSN(2) [SERIAL NUMBER 3XGQ LDN 0 0 3Y2B STO 0 FIP(2) [ZEROISE FIP 3YG2 LDN 4 FIP(2) 3Y^L LDN 5 FIP+1(2) 3^F= MOVE 4 14 3^YW LDN 0 1 42DG STO 0 FBUK(2) 42Y6 STO 0 FIP+5(2) [NO.OF AREAS=1 43CQ STO 0 FIP+8(2) [BUCKET SIZE=1 43XB LDX 0 EOPMODE(3) 44C2 SBN 0 #1600 44WL BNZ 0 XE [JUMP IF NOT S-TRUSTED 45B= LDCT 0 #404 45TW STO 0 EXMARK(2) [OPEN TO S-TRUSTED FOR WRITING BITS 46*G XE LDX 0 ASUSN(2) [SET UP FILE DESCRIPTION CELL 46T6 STO 0 FDCELLS(2) [SERIAL NUMBER 47#Q LDX 0 HBLOCK(1) 47SB STO 0 FDCELLS+4(2) [SEGMENTS/SEEK AREA 48#2 LDX 0 HCYL(1) 48RL STO 0 FDCELLS+3(2) [CYLINDERS 49?= STOZ FDCELLS+2(2) [STARTING CYLINDER=0 49QW STOZ FDCELLS+1(2) [STARTING SEGMENT=0 4==G MPY 0 FDCELLS+4(2) 4=Q6 ADN 1 1 4?9Q STO 1 FDCELLS+5(2) [NUMBER OF BUCKETS 4?PB LDN 7 1 [UNIT IN USE BY S-TRUSTED 4#92 LDN 1 BCCB [CHECK IF UNIT IN USE BY S-TRUSTED 4#NL XG LDX 1 BPTR(1) 4*8= TXU 1 CXCC 4*MW BCC XF [JUMP IF END OF CHAIN 4B7G LDX 0 BACK2(1) 4BM6 BZE 0 XF [OR NO MORE EXOFS 4C6Q LDCT 0 4 4CLB ANDX 0 EXMARK(1) 4D62 BZE 0 XG [OR NOT S-TRUSTED 4DKL LDX 0 ASUSN(2) 4F5= TXU 0 ASUSN(1) [CHECK IF FIP UNIT THE SAME 4FJW BCC XH 4G4G LDEX 4 FIP+5(1) [NO OF AREAS 4GJ6 NGN 5 6 4H3Q XK ADN 5 6 4HHB SBN 4 1 4J32 BNG 4 XG [JUMP IF NO MORE AREAS 4JGL XJ SMO 5 4K2= TXU 0 FDCELLS(1) 4KFW BCS XK [JUMP IF DIFFERENT 4K^G [OTHERWISE ERROR 4LF6 XH LDX 4 ASUSN(2) 4LYQ SMO FX2 4MDB LDN 1 ACOMMUNE1 [CONVERT SERIAL NO. TO CHARS 4MY2 LDN 0 6 4NCL SLL 4 3 4NX= XHA SLC 4 6 4PBW DCH 4 0(1) 4PWG BCHX 1 £ 4QB6 SRL 4 3 4QTQ BCT 0 XHA 4R*B LDN 4 6 4RT2 OUTPARAM 4,ACOMMUNE1 4S#L MONOUT EWLOCKSU [S-TRUSTED BLOCK 4SS= MHUNTW 2,EWDAS,EXOF 4T?W FREECORE 2 [FREE EXOF 4TRG # 4W?6 MHUNTW 3,EWDAS,GEXD 4WQQ LDX 5 CNR(3) [SAVE CA ADDRESS 4X=B LDX 4 ESERL(3) [SAVE SERIAL NO. 4XQ2 LDCT 0 #400 4Y9L ORX 0 7 4YP= STO 0 A1(3) 4^8W LDN 6 1 4^NG BRN YB [JUMP TO SET REPLIS 5286 # 52MQ XF LDX 0 EOPMODE(3) [PASSED FIRST CHECK 537B SBN 0 #1700 53M2 BZE 0 XL [JUMP IF OPEN MODE=1700 546L LDN 7 7 [UNIT CANNOT BE OPENED SY S-TRUSTED 54L= LDN 1 BCCB 555W XN LDX 1 BPTR(1) [CHECK OUR UNIT NOT IN USE BY 55KG TXU 1 CXCC [ANYBODY ELSE 5656 BCC XM 56JQ LDX 0 BACK2(1) 574B BZE 0 XM 57J2 LDX 0 ASUSN(2) 583L TXU 0 ASUSN(1) 58H= BCC XH [JUMP IF FIP HOMES SAME 592W LDEX 4 FIP+5(1) [NO. OF FILE AREAS 59GG BZE 4 XN [JUMP IF NONE 5=26 LDN 5 0 5=FQ XP SMO 5 5=^B TXU 0 FDCELLS(1) [ 5?F2 BCC XH [JUMP IF UNIT IN USE 5?YL ADN 5 6 5#D= BCT 4 XP 5#XW BRN XN 5*CG XL LDN 1 BCCB [MODE #1700 -CHECK IF ALREADY OPEN 5*X6 XQ LDX 1 BPTR(1) 5BBQ TXU 1 CXCC 5BWB BCC XM [J.END OF CHAIN 5CB2 LDX 0 BACK2(1) 5CTL BZE 0 XM [OR NO MORE EXOFS 5D*= LDX 0 ASUSN(2) 5DSW TXU 0 ASUSN(1) [CHECK SERIAL NUMBER 5F#G BCS XQ [J. IF DIFFERENT 5FS6 LDX 0 HOME(1) 5G?Q TXU 0 HOME(2) 5GRB BCS XQ [J.IF DIFFERENT HOMES 5H?2 #SKI K6SQOPEN>199-199 5HQL ( 5J== LDCT 0 #404 5JPW ANDX 0 EXMARK(1) 5K9G BZE 0 XOK 5KP6 GEOERR 1,MODE1700 5L8Q XOK 5LNB ) 5M82 LDN 0 1 [UNIT ALREADY OPEN 5MML ADS 0 COPEN(1) [ADD 1 TO COUNT OF OPENS 5N7= LDX 6 1 [SAVE POINTER 5NLW FREECORE 2 [FREE OUR EXOF 5P6G BRN ZA 5PL6 XM LDX 6 2 [SAVE POINTER 5Q5Q EXOFILE 6 [CHAIN IN EXOF 5QKB ZA LDX 2 6 [RESTORE POINTER 5R52 LDX 0 BACK2(2) 5RJL STO 0 CEFN(3) [SAVE EXOFILE NUMBER. 5S4= # 5SHW # CONNECT FILE TO PROGRAM 5T3G # 5T4K ...#UNS CAFSINT 5T5N ...( 5T6R ...# FOR CAFS, THIS A POINT WHERE A REPORT ON AN EVENT OF INTEREST 5T7W ...# TO THE CAFS SUBSYSTEM IS REQUIRED. A FILE IS BEING OPENED 5T8^ ...# AND IT MAY BE OPENED UNCLEANLY 5T=4 ...# 5T?7 ... LDX 0 EOPMODE(3) [GET THE MODE OF OPENING OF THE FILE 5T#= ... SBN 0 #1700 5T** ... BNZ 0 NOTOFW [JIF NOT OPENING FOR WRITING 5TBD ... CAFSINFO OPENFILE,CEFN(3) [NOTIFY CAFS SUBSYSTEM 5TCH ...# 5TDL ...NOTOFW 5TFP ...) 5TH6 LDCT 4 AOLPT/8 [TYPE 5W2Q LDN 5 EXAOLPT [LENGTH 5WGB GETACTX 4,5,1 5X22 LDX 1 BPTR(2) [SET UP AOLPT 5XFL MHUNTW 3,EWDAS,GEXD 5XPC ... LDX 0 EXOTRAP(3) [TRANSFER EXOFILE ENTRY TRAPS 5XS2 ... STO 0 EXTRAPS(1) [FROM GEXD TO AOLPT 5X^= LDX 0 JOBNO(2) [JOB NUMBER 5YDW STO 0 JOBNO(1) 5^XQ LDX 0 GSIGN 62CB STO 0 FRECHADD(1) 62X2 STOZ CPRW1(1) [CLEAR 63BL STOZ CPRW2(1) [REPLY 63W= STOZ CPRSW(1) [WORDS 64*W MFINDSU 2,ESERL(3) 64TG ... LDX 4 HUNIT(2) 65*6 ... STO 4 CPPTR(1) [STO DL PTR 66#B LDX 0 EXCHNL(3) 66S2 STO 0 EWCHAN(1) [CHANNEL 67?L LDN 0 1 67R= STO 0 ATMARK(1) [MARKER FOR AOLPT TYPE 68=W LDCT 0 #400 68QG ORS 0 GIVE(1) [ GIVE MARKER OPEN ILLEGAL 69=6 LDX 0 CEFN(3) 69PQ STO 0 EXNUM(1) [EXOFILE NUMBER 6=9B LDX 2 FX1 6=P2 LINKSET 1,XLINK(2) [LINK TO K1PERION 6?8L LDX 0 EOPMODE(3) 6?N= STO 0 EXMODE(1) 6#7W SBN 0 #1700 6#MG BZE 0 ZB [JUMP IF 1700 6*76 LDCT 0 #200 6*LQ ORS 0 EXMAYBE(1) 6B6B ZB LDX 2 FX2 6BL2 FPCACA 2 [FIND PCA 6CMT ... VFREE ADATA,ASUP [ENSURE BLOCK DOESNT ALREADY EXIST 6D36 ... LDX 5 ESERL(3) [SUSN 6DBC ... LDX 6 EXCHNL(3) 6DPN ... LGEOG 4,4 [GEOG UNIT NO 6F4^ ... SETNCORE 3,3,ADATA,ASUP [NEW ADATA/ASUP BLOCK 6FD= ... LDN 0 6 6FRH ... STO 0 A1(3) [*DA 6G6S ... STO 4 A1+1(3) [GEOG UNIT NO 6GG5 ... STO 5 A1+2(3) [SUSN 6GTB ... LDCT 0 6 6H8M ... ORX 0 6 [TYPE/UNIT NO 6KYB LDCT 6 #400 [OFFLINE BIT 6LD2 PUTPERENT 0,6 [CONNECT CHANNEL 6MC= ROLPA [CHAIN IN OLPA 6NBG MHUNTW 3,EWDAS,GEXD 6NW6 ZC LDX 5 CNR(3) [SAVE CA ADDRESS 6P*Q LDX 4 ESERL(3) 6PTB STO 4 A1(3) 6Q*2 STOZ A1+1(3) 6QSL STOZ A1+2(3) 6R#= STOZ A1+3(3) 6RRW MFINDSU 1,A1(3) [FIND ASTUC 6S?G LDX 0 EOPMODE(3) 6SR6 SBN 0 #1700 6T=Q BZE 0 NOTS [DON'T SET 'SET' BIT IF #1700 6TQB LDCT 0 #100 6W=2 ORS 0 ASMARK(1) [UNIT SET BIT 6WPL NOTS 72LL LADDP HUNIT(1),2 [X2 PTR TO AIPA 736= LDX 0 BSUNIT1(2) 745G SRL 0 6 74K6 ANDN 0 #77 [COUNT OF SU'S 754Q SBN 0 1 75JB BZE 0 ZD [J. IF ONLY ONE 7642 LDCT 0 #400 76HL ORX 0 ASUBASE(1) [REPLY IF SPLIT 773= STO 0 A1+3(3) 77GW ZD LDN 6 4 [COUNT OF WORDS TO MOVE 782G YB UNLOCKSU 4 [UNLOCK UNIT 78G6 RELST 4 78^Q ...YBA 79FB ADN 5 1 79K5 ... LDN 4 A1 [ADDR IN GEXD 79NS ...ZADDR 79SH ... GETWORD 5,5,WRITE,7,6 [GEORGE ADDR OF OBJ PROG CA 79Y= ... TESTREPNOT OK,RV1 [GEOERR FOR FAILURE 7=3^ ... MHUNTW 3,EWDAS,GEXD 7=7N ... ADX 4 3 [X4=A1 OF GEXD 7=?C ... TXL 7 6 7=C6 ... BCC ZMOV [J IF MOVE CAN BE DONE IN ONE GO 7=GT ... SMO 7 7=LJ ... MOVE 4 0 [MOVE AS MANY AS ALLOWED 7=Q? ... LDX 5 CNR(3) 7=W2 ... ADN 5 1 7=^P ... ADX 5 7 [UPDATE AREA TO BE ACCESSSED 7?5D ... SBX 6 7 [DECREMENT NO OF WORDS REQUIRED 7?97 ... SMO 7 7?#W ... LDN 4 A1 [UPDATE POINTER IN GEXD 7?DK ... BRN ZADDR 7?J# ...ZMOV 7?N3 ... SMO 6 7?RQ ... MOVE 4 0 [MOVE IN REPLIES 7?XG FREECORE 3 [FREE GEXD 7#7# ... WORDFIN 7#C6 RUNPROG [AND RESTART PROGRAM. 7#WQ # 7*BB ...# UNIT NOT ONLINE-CHECK FOR ADDITIVE MODE #4000 7*W2 # OUTPUT REQUEST TO OPERATORS IF NECESSARY 7B*L # 7BT= XDA MHUNTW 3,EWDAS,GEXD 7C#W ANDN 7 2 7CSG BZE 7 YA [JUMP IF MODE #4000 NOT USED 7D#6 LDX 5 CNR(3) [SAVE CA ADDRESS 7DRQ LDCT 0 #400 7F?B ORN 0 6 [REPLY= UNIT NOT ONLINE 7FR2 STO 0 A1(3) 7G=L LDN 6 1 [1 WORD TO MOVE IN 7GQ= BRN YBA [JUMP TO SET REPLIES 7H9W YA SMUSEST ESERL(3),YC,YD [GET UNIT ONLINE 7HPG BRN YE 7J96 # 7JGG ...# 7JKL ...# IPB FAIL 7JNQ ...# 7JRW ...ND NGNC 7 1 7JX2 ...# 7K26 ...# BREAKIN 7K5= ...# 7K8B ...NC LDN 7 0 [X7=1 IF IPB FAIL;X7=0 FOR BREAKIN 7K?G ... MHUNTW 3,EWDAS,GEXD 7L7L RELST ESERL(3) 7M6W YD MHUNTW 3,EWDAS,GEXD [BREAKIN 7M=7 ... LDX 6 ESERL(3) [SUSN 7M?= ... FREECORE 3 7M#* ... STEPBACK [PUT ONR BACK ONE 7M*D ... BZE 7 NIPB [J IF BREAKIN 7MBH ... TWAIT 6,NIPB [WAIT FOR IPB 7MCL ... RUNPROG [..AND TRY AGAIN 7MDP ...NIPB PROGBRKIN [REPORT BREAKIN 7P5B # 7QJ= NB OUTPACK ESERL(3),1,CSN [CONVERT SERIAL NUMBER 7R3W MONOUT ENTIN35 7RHG MHUNTW 3,EWDAS,GEXD 7RPQ ... RELST ESERL(3) 7T2B YC MHUNTW 3,EWDAS,GEXD [CANTDO 7TG2 LDX 5 EXCHNL(3) [CONVERT CHANNEL NO. TO DECIMAL 7T^L ... LDCT 4 6 7WF= ... ADX 4 5 [DEVICE TYPE AND CHANNEL 82B= LDX 5 CNR(3) [SAVE CA ADDRESS 82TW FREECORE 3 83*G ...XPAR OUTPACK 4,1,PERINAME,XPAR 84#Q ADN 5 1 84SB ... GETWORD 5,5,WRITE 85#2 ... TESTREPNOT OK,RV1 85RL ... LDCT 4 #440 86?= SMO 5 86KM ... STO 4 0 86Y4 ... WORDFIN 87=G LDX 4 XPER(1) [ILLEGAL IDENTIFIER 87Q6 XVIOL ILLEGALX 4 889Q # 88PB # 8992 RV GEOERR 1,RESVIOL 89B8 ...RV1 89HB ... GEOERR 1,SDERV 89NL # 8=8= MENDAREA 30,K99SQOPEN 8=MW # 8?7G #END ^^^^ ...70231154000100000000