LIBCOM867
(George Source)
Macros used: ACROSS, ALTLEND, BXE, BXU, CHECKOWNER, CJOBLOCK, CLOSETOP, COMBRKIN, COMERR, ENDCOM, ERROR, ERRORX, ERRTEST, FNORM, FREECORE, FSHENTRY, GEOERR, HUNT, HUNT2, HUNTW, JFREZFCB, MENDAREA, MFREE, MFREEW, MHUNT, MHUNTW, MTEXPROP, NAME, NAMETOP, OPEN, OPENSYS, PARANOT, PARANUMB, PARAPASS, PICKREP, PUTREP, SEG, SEGENTRY, SETNCORE, SETREP, SETUPCORE, SPARAPAS, SWITRACE, TESTREP, TOPFCB, VFREEW
- LIBCOM867.txt
22FL SEG LIBCOM,6,N.R.BOULT,LIBRARY 22LS ...[ 22S2 ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 22^= # 23DW SEGENTRY K1LIBCOM,QK1LIBCOM 23YG SEGENTRY K2LIBCOM,QK2LIBCOM 24D6 SEGENTRY K3LIBCOM,QK3LIBCOM 24XQ SEGENTRY K4LIBCOM,QK4LIBCOM 25CB SEGENTRY K5LIBCOM,QK5LIBCOM 25X2 SEGENTRY K7LIBCOM,QK7LIBCOM 26BL SEGENTRY K8LIBCOM,QK8LIBCOM 26LD ... FSHENTRY K9LIBCOM,QK9LIBCOM,,QK9LIBCOM 26W= # THIS SEGMENT DEALS WITH MOST OF THE ERROR REPORTING ON TH 27*W # PARAMETERS OF THE NEW, GET, RETURN, DEAD, TAPEWRING & 27TG # TAPERIGHT COMMANDS WHICH ENTER THE SEGMENT AT K1, K2, K3, K4 28*6 # K7 & K8 RESPECTIVELY. THE ERRORS REPORTED ON ARE:- 28SQ # NO PARAMETER 29#B # ERROR IN FORMAT OF NAME 29S2 # DEVICE TYPE QUALIFIER MISSING TO NAME 2=?L # DEVICE TYPE QUALIFIER NOT (*MT) 2=R= # NAME GIVEN (NEW,DEAD, TAPEWRING & TAPERIGHT ONLY) 2?=W # TAPE SERIAL NO. MISSING (AS FOR NAME GIVEN) 2?QG # PROPER USER DOES NOT OWN DIRECTORY (IN USER CONTEXT) 2#=6 # IF THERE IS NO ERROR THE SEGMENT OPENS :SYSTEM.SERIAL (EXCEP 2#PQ # GET, TAPEWRONG & TAPERIGHT) BEFORE GOING ACROSS TO THE 2*9B # RELEVANT COMMAND. NEW, TAPEWRONG & TAPERIGHT ARE TREATED 2*P2 # SPECIALLY AS THEY MAY HAVE MORE THEN ONE PARAMETER. 2B8L ZNEW +1 2BN= ZGET +2 2C7W ZRETURN +3 2CMG ZDEAD +4 2D76 ZREND +5 2DLQ ZTAPEWR +7 2F6B ZTAPERI +8 2FL2 WORK #67202020 2G5L POOL #60202020 2G89 ...#UNS JDUMPTW 2G=S ...( 2G*C ...XDUMP 4HDUMP 2GD2 ...XNDMP +4 2GGK ...) 2GK= # 2H4W # 2HJG # 2J46 QK1LIBCOM 2JHQ LDX 7 ZNEW(1) 2K3B BRN TCONA 2KH2 QK2LIBCOM 2L2L LDX 7 ZGET(1) 2LG= BRN SUF 2L^W QK3LIBCOM 2MFG LDX 7 ZRETURN(1) 2M^6 BRN SUF 2NDQ QK4LIBCOM 2NYB LDX 7 ZDEAD(1) 2PD2 TCONA 2PXL LDN 0 #12 [MOP AND NOUSER BITS 2QC= ANDX 0 CONTEXT(2) 2QWW BZE 0 SUG 2RBG ERN 0 #12 2RW6 BNZ 0 SUG 2S*Q COMERR JNOMANCON [COMMAND IN MOP AND NOUSER CONTEXT 2STB QK5LIBCOM 2T*2 LDX 7 ZREND(1) 2TSL BRN SUF 2W#= QK7LIBCOM 2WRW LDX 7 ZTAPEWR(1) 2WS? ...#UNS JDUMPTW 2WSN ...( 2WT5 ... STOZ AWORK1(2) 2WTG ... LDN 0 #20 2WTX ... ANDX 0 CONTEXT(2) 2WW# ... BZE 0 TCON 2WWP ...[ OPERATOR CONTEXT - IF TWDUMP ON THEN A DUMP PARAMETER MAY HAVE 2WX6 ...[ BEEN SPECIFIED 2WXH ... SEGENTRY K40LIBCOM 2WXY ... BRN SUG 2WY* ... PARANOT 1 2WYQ ... MHUNT 3,CPB,CUNI 2W^7 ... LDX 4 ANUM(3) 2W^J ... LDX 5 APARA(3) 2W^^ ... FREECORE 3 2X2B ... BZE 4 SUG 2X2R ... BNG 4 MISS 2X38 ... TXU 4 XNDMP(1) 2X3K ... BCS SUG 2X42 ... TXU 5 XDUMP(1) 2X4C ... BCS SUG 2X4S ...[ DUMP PARAMETER SPECIFIED - SET MARKER IN AWORK1 2X59 ...[ AND UPDATE PARAPASS POINTER PAST FIRST PARAMETER 2X5L ... LDN 0 1 2X63 ... STO 0 AWORK1(2) 2X6D ... PARAPASS 2X6T ... MFREE CPB,CUNI 2X7= ... LDN 4 0 2X7M ... PARANUMB 4,4 2X84 ... SBN 4 1 2X8F ... BZE 4 MISS 2X8W ... ADN 4 1 2X9? ... BRN SUGA 2X9N ...) 2X=5 ...#UNS JDUMPTW 2X=G ...#SKI 2X?G BRN TCON 2XR6 QK8LIBCOM 2Y=Q LDX 7 ZTAPERI(1) 2YQB TCON 2^=2 LDN 0 #21 2^PL ANDX 0 CONTEXT(2) 329= BNZ 0 SUG 32NW COMERR JOPUCON 32W4 ...#UNS JDUMPTW 333= ... SEGENTRY K41LIBCOM 338G SUG 33N6 LDN 4 0 347Q PARANUMB 4,4 [GET NO. OF PARAMETERS 34CJ ... BZE 4 MISS 34MB ADN 4 1 34SJ ...#UNS JDUMPTW 34^Q ...SUGA 3572 SETUPCORE 4,3,AONBS,GLIST [SET UP AN AONBS/GLIST BLOCK 35LL LDX 2 4 366= SUG1 36KW SMO 3 375G STOZ A1-1(2) [AND EMPTY IT 37K6 BCT 2 SUG1 384Q SUGL 38JB CALL 5 PARAM 3942 BRN NOMORE 39HL BRN SUGL 3=3= BRN SUGL [TRY AGAIN 3=GW MHUNT 1,AONBS,GLIST 3?2G MHUNT 2,CPB,CUNI 3?G6 MHUNT 3,FILE,FABSNB 3?^Q LDX 4 JPARNUM(2) 3#2Y ...#UNS JDUMPTW 3#46 ...( 3#5# ... SMO FX1 3#6G ... TXU 7 ZTAPEWR 3#7N ... BCS SUGL2 3#8W ... SMO FX2 3#=4 ... LDX 0 AWORK1 3#?= ... BZE 0 SUGL2 3##D ...[ IF TW DUMP USE ONE LESS THAN JPARNUM FOR PLACING TSN IN GLIST 3#*L ... SBN 4 1 3#BS ...SUGL2 3#D2 ...) 3#FB SMO A1(3) 3#^2 LDX 5 A1+1(3) [TAPE SERIAL NUMBER 3*DL SUG1A 3*Y= SBN 4 1 3BCW BZE 4 SUG1B 3BXG SMO 4 3CC6 BXU 5 A1(1),SUG1A 3CWQ ERROR ERALGIV [TSN ALREADY GIVEN 3DBB MHUNT 3,FILE,FABSNB 3DW2 BRN SUG2 3F*L SUG1B 3FFH ...#UNSET FTS1 3FKD ...#SKIP 3FP* ...( 3FT= SMO FX1 3G#W BXU 7 ZNEW,SUG1C [BRANCH IF NOT NEW 3GJN ...) 3GSG SMO FX2 3H#6 LDX 0 CONTEXT 3HRQ ANDN 0 1 3J?B BZE 0 SUG1B1 [BRANCH UNLESS USER CONTEXT 3JR2 CALL 6 OWNCHECK [PROPER USER OWNS DIR? 3K=L BRN SUGL [NO 3KQ= MHUNT 1,AONBS,GLIST 3L9W MHUNT 2,CPB,CUNI 3LPG MHUNT 3,FILE,FABSNB 3M96 SMO A1(3) 3MNQ LDX 5 A1+1(3) 3N8B BRN SUG1C 3NN2 SUG1B1 3NQK ...#UNSET FTS1 3NT8 ...( 3NXR ... SMO FX1 [NO USER CONTEXT - J IF 3P2B ... BXU 7 ZNEW,SUG1C [ANYTHING OTHER THAN NEW 3P4^ ...) 3P7L SMO A1(3) 3PM= LDCH 0 A1-6(3) [P OR W ? 3Q6W SBN 0 #60 3QLG BNZ 0 SUG1C 3R66 ORX 5 GSIGN [B0 SET IF POOL TAPE 3RKQ SUG1C 3RLM ...#UNS JDUMPTW 3RMJ ...( 3RNF ... LDX 4 JPARNUM(2) 3RPB ... SMO FX1 3RQ? ... TXU 7 ZTAPEWR 3RR8 ... BCS SUG2C 3RS5 ... SMO FX2 3RT2 ... LDX 0 AWORK1 3RTX ... BZE 0 SUG2C 3RWS ...[ IF TW DUMP USE ONE LESS THAN JPARNUM FOR PLACING TSN IN GLIST 3RXP ... SBN 4 1 3RYL ...SUG2C 3R^H ... SMO 4 3S2D ...) 3S3* ...#UNS JDUMPTW 3S4= ...#SKI 3S5B SMO JPARNUM(2) 3SK2 STO 5 A1(1) [STORE TSN 3T4L LDN 0 1 3TJ= ADS 0 A1(1) [ADD 1 TO NO. OF TAPES 3W3W SMO FX1 3WHG BXE 7 ZNEW,SUG3 3X36 SUG2 3XGQ FREECORE 3 3Y2B SUG3 3Y=8 ... VFREEW FILE,ADJUNCTS 3YG2 MFREE CPB,CUNI 3Y^L BRN SUGL 3^F= NOMORE 3^YW MHUNT 1,AONBS,GLIST 42DG LDX 0 A1(1) 42Y6 BZE 0 NULL 432P ...NOM1 435# ... HUNTW 1,FI,FUTILITY [ALL ADJUNCTS BLOCKS HAVE BEEN 437X ... BNG 1 XIT [DISGUISED IN ORDER NOT TO UPSET 43=G ... NAME 1,FILE,ADJUNCTS [FNORM - THEY MUST NOW BE RENAMED 43*5 ... BRN NOM1 [ADJUNCTS 43CQ XIT 43XB LDX 1 FX1 44C2 BXE 7 ZTAPEWR(1),XIT5 44WL BXE 7 ZTAPERI(1),XIT5 45B= BXE 7 ZNEW(1),XIT1 45TW BXE 7 ZGET(1),XIT2 46*G BXE 7 ZDEAD(1),XIT4 46R4 ...QK9LIBCOM 46T6 OPENSYS ZBRKIN,SERIAL,GENERAL 47#Q TESTREP OK,XIT3 47SB GEOERR 1,GLIBREP 48#2 XIT1 48CX ...[ 48HS ... SMO FX2 48MP ... LDX 0 CONTEXT 48RL ... ANDN 0 1 48XH ... BZE 0 XIT1A [J IF OPERATOR CONTEXT 493D ... ACROSS NEWOWN,1 497* ...XIT1A ACROSS NEWPW,1 49?= XIT2 49QW ACROSS GET,1 4==G XIT3 4=Q6 BXU 7 ZRETURN(1),XIT4A 4?9Q ACROSS RETURN,1 4?PB XIT4 4#92 ACROSS DEAD,1 4#NL XIT4A 4*8= ACROSS RENAMDIR,1 4*MW XIT5 4B7G ACROSS TAPERING,1 4BM6 ZBRKIN 4C6Q COMBRKIN 4CLB SUF 4D62 CALL 5 PARAM [GET NEXT ACCEPTABLE PARAMETER 4DKL BRN MISS 4F5= BRN NULL 4FJW BRN MISS 4G4G CALL 6 OWNCHECK 4GJ6 BRN NULL 4H3Q BRN XIT 4HHB MISS 4J32 COMERR JPARMIS 4JGL NULL 4K2= ENDCOM 4KFW # THIS SUBROUTINE PASSES THE NEXT PARAMETER IN A FILE/FABSNB BLOCK. 4K^G # ON ENTRY X5 IS LINK AND X7 HOLDS ENTRY POINT IDENTIFIER. 4LF6 # EXIT AT LINK ADDRESS+1 IF PARAMETER NULL OR UNSUITABLE. 4LYQ # EXIT AT LINK ADD.+2 IF PARAMETER PASSED (FILE/FABSNB & CPB/CUNI). 4MDB # EXIT AT LINK ADD. IF NO MORE PARAMETERS. 4MY2 PARAM 4NCL SBX 5 FX1 4NX= SPARAPAS [GET NEXT PARAMETER 4PBW MHUNT 3,CPB,CUNI 4PWG LDX 0 ANUM(3) 4QB6 BZE 0 PNULL [BRANCH IF NULL PARAMETER 4QTQ BNG 0 PEND [BRANCH IF NO MORE 4R*B NAMETOP 3,FILE,FNAME 4RT2 FNORM 7 4S#L MHUNT 3,FILE,FNAME 4SS= NAMETOP 3,CPB,CUNI 4T6M ... TESTREP NAMEFORM,PNAMEF [BRANCH IF FORMAT ERROR 4TF4 ... PICKREP 6 4TRG LDX 4 JPARNUM(3) 4W?6 BXE 7 ZGET(1),PARAM0B 4WQQ PARAM0 4X=B HUNT 3,FILE,FTRAP 4XQ2 BNG 3 PARAM0B 4Y9L BXU 7 ZNEW(1),PARAM0A 4YP= NAMETOP 3,AONBS,GROT [SAVE FOR APPROPRIATE MESSAGE 4^8W DSA 4 ATYPE(3) 4^NG BRN PARAM0 5286 PARAM0A 52MQ FREECORE 3 537B BRN PARAM0 53M2 PARAM0B 542P ... PUTREP 6 54BD ... TESTREPN ADJUNCTS,PERR1 54Q7 ... MHUNTW 3,FILE,ADJUNCTS 555W LDX 0 A1+2(3) 55KG SRL 0 15 5656 ... BZE 0 PERR1A 56JQ SBN 0 5 574B BNZ 0 PERR2 [BRANCH IF NOT *MT 57J2 LDX 0 A1+2(3) 583L ANDN 0 2 58H= BZE 0 PARAM0C [BRANCH IF NO PROPERTIES 592W BXE 7 ZNEW(1),PARAM0D 59GG BXE 7 ZGET(1),PARAM0D 5=26 BXE 7 ZREND(1),PARAM0D 5=FQ BRN PARAM0E 5=^B PARAM0D 5?F2 MTEXPROP TAPE [EXTRACT SPECIAL PROPERTIES 5?YL TESTREP ILLCOMB,PERR10,ILLMODE,PERR11 5#D= LDX 3 ACOMMUNE1(2) 5#XW SETNCORE 1,2,FLIB,FSPD 5*CG DSA 4 ATYPE(2) 5*X6 STO 3 A1(2) [STORE CHARACTERISTIC 5BBQ #SKI K6LIBCOM>199-199 5BWB SWITRACE 3,LBCMSPD 5CB2 PARAM0E 5CTL MFREE FILE,FPROPS 5D*= PARAM0C 5D*N ...#UNSET FTS1 5DB6 ...( 5DBJ ... SMO FX2 5DC2 ... LDX 2 CONTEXT 5DCD ... ANDN 2 1 [B23 = USER CONTEXT 5DCW ... BZE 2 PARAMNU [J IF NOT USER CONTEXT 5DD# ... MHUNT 2,FILE,FABSNB 5DDQ ... LDX 4 ATYPE(2) 5DF8 ... ANDN 4 #200 5DFL ... BNZ 4 PARAMNU [J IF WORKTAPE 5DG4 ... LDX 3 ALOGLEN(2) [SET X3=LENGTH OF FABSNB 5DGG ... SETUPCORE 3,2,FILE,FABSNB [CREATE DUPLICATE FABSNB 5DGY ... HUNT2 1,FILE,FABSNB,2 5DHB ... LDX 4 ATYPE(1) 5DHS ... STO 4 ATYPE(2) 5DJ= ... LDN 3 A1(1) 5DJN ... LDN 4 A1(2) 5DK6 ... SMO ALOGLEN(2) 5DKJ ... MOVE 3 0 5DL2 ... LDN 4 6 [ADJUST RECORD HEADERIN 5DLD ... SBS 4 A1(2) [FILE-FABSNB FOR OPENING 5DLW ... OPEN ZBRKIN,READ,QUERY [OF LOCAL USER DIRECTORY 5DM2 ...XFSHNBOPEN 5DM# ... MFREE FILE,FABSNB [FREE THE EXTENDED FABSNB 5DMQ ... TESTREP OK,PARAMFZ [OPEN OK? 5DN8 ... REPALLERR 5DNC ... VFREEW FILE,ADJUNCTS 5DNL ... BRN PNEXT 5DP4 ...PARAMFZ 5DPG ... TOPFCB 2 [X2 POINT TO FCB 5DPY ... JFREZFCB 2,PERR12 [CHECK FOR FROZEN QUALIFIER 5DQB ... CLOSETOP [CLOSE DIRECTORY 5DQS ...) 5DR= ...#UNSET FTS1 5DRN ...#SKIP 5DSW MFREE FILE,ADJUNCTS 5F24 ...PARAMNU 5F7= ... LDX 2 FX2 [RESTORE X2 5F#G MHUNT 3,FILE,FABSNB 5FS6 NGN 0 #101 5G?Q ANDS 0 ATYPE(3) [MAKE SURE LANGUAGE NOT GIVEN 5GRB LDX 4 ATYPE(3) 5H?2 ANDN 4 #2000 [TSN BIT 5HQL BZE 4 PARAM1 [BRANCH IF NO TSN 5J== SMO A1(3) 5JPW LDX 0 A1+1(3) 5K9G BNG 0 PERR5 [BRANCH IF XENOTAPE 5KP6 PARAM1 5L8Q BXE 7 ZRETURN(1),PARAM2B [BRANCH IF RETURN 5LNB BXU 7 ZGET(1),PARAM2 [BRANCH UNLESS GET COMMAND 5M82 BNZ 4 PERR6 [BRANCH IF TSN 5M?X ... LDX 0 ACES [OVERWRITE LANGUAGE CODE 5MCS ... SMO HDREC(3) [WITH SPACES 5MHP ... STO 0 A1-1(3) 5MML BRN PARAM2B 5N7= PARAM2 5NLW BZE 4 PERR3 [BRANCH IF NO TSN 5P6G LDX 0 ATYPE(3) 5PL6 ANDN 0 #200 5Q5Q BNZ 0 PERR8 [BRANCH IF WORKFILE 5QKB PARAM2B 5R52 LDX 0 ATYPE(3) 5RJL ANDN 0 #4000 5S4= BNZ 0 PERR8 [BRANCH IF STREAM 5SHW BXE 7 ZGET(1),PARAM4 5T3G BXE 7 ZRETURN(1),PARAM4 5TH6 BXE 7 ZNEW(1),PARAM2A 5W2Q BXE 7 ZREND(1),PARAM3 5WGB LDX 0 A1(3) 5X22 SBN 0 10 5XFL BNZ 0 PERR4 [BRANCH IF NAME GIVEN 5X^= LDX 0 A1+4(3) 5YDW BNZ 0 PERR4 [BRANCH IF NAME GIVEN 5YYG BRN PARAM4 5^D6 PARAM2A 5^XQ LDX 0 CONTEXT(2) 62CB ANDN 0 1 62X2 BNZ 0 PARAM4 [BRANCH IF USER CONTEXT 63BL LDX 0 A1(3) 63W= SBN 0 10 64*W BNZ 0 PERR9 64TG LDX 0 ATYPE(3) 65*6 ANDN 0 #4700 65SQ BNZ 0 PERR9 66#B LDX 0 A1+4(3) 66S2 BZE 0 PARAM4 [CODE OMITTED 67?L LDX 4 ATYPE(3) 67R= ANDN 4 #1000 68=W BZE 4 PERR9 68QG BXE 0 POOL(1),PARAM4 69=6 BXE 0 WORK(1),PARAM4 69PQ BRN PERR9 6=9B PARAM3 6=P2 LDX 0 ATYPE(3) 6?8L ANDN 0 #1000 6?N= BZE 0 PERR7 [BRANCH IF NOT GENERAL LOCAL NAME 6#7W PARAM4 6#MG ADX 5 FX1 6*76 EXIT 5 3 6*LQ # OUTPUT ERROR MESSAGE 6*RY ...PERR1A 6*^6 ... MFREEW FILE,ADJUNCTS 6B6B PERR1 [DEVICE TYPE QUALIFIER MISSING 6BL2 LDX 3 ZAMISS(1) 6C5L LDX 4 ZATYPEQ(1) 6CK= ... BRN PERX 6D4W PERR2 [DEVICE TYPE QUALIFIER IMPERMISSIBLE 6DJG LDX 3 ZIMPER(1) 6F46 LDX 4 ZATYPEQ(1) 6FHQ BRN PERR 6G3B PERR3 [TAPE SERIAL NUMBER MISSING 6GH2 LDX 3 ZAMISS(1) 6H2L LDX 4 ZERNOP(1) 6HG= BRN PERR 6H^W PERR4 [SHOULD BE TSN ONLY 6JFG LDX 3 ZAMTDESC(1) 6J^6 LDX 4 ZJTSN(1) 6KDQ BRN PERR 6KYB PERR5 6LD2 LDX 3 ZERXE(1) 6LXL NGN 4 1 6MC= BRN PERR 6MWW PERR6 [TSN GIVEN FOR GET COMMAND 6NBG LDX 3 ZAMTDESC(1) 6NW6 LDX 4 ZJNTSN(1) 6P*Q BRN PERR 6PTB PERR7 6Q*2 LDX 3 ZAMTDESC(1) 6QSL LDX 4 ZJLOCN(1) 6R#= BRN PERR 6RRW PERR8 6S?G LDX 3 ZERNAM(1) [FORMAT ERROR (+ OR ! IN MT DESC) 6SR6 NGN 4 1 6T=Q BRN PERR 6TQB PERR9 6W=2 LDX 3 ZCODEWR(1) 6WPL NGN 4 1 6X9= BRN PERR 6XNW PERR10 6Y8G LDX 3 ZPILL(1) 6YN6 NGN 4 1 6^7Q BRN PERR 6^MB PERR11 7272 LDX 3 ZPMOD(1) 72LL NGN 4 1 72N* ...#UNSET FTS1 72Q4 ...( 72RR ... BRN PERR 72TG ...PERR12 72X9 ... CLOSETOP [CLOSE DIRECTORY 72Y4 ... MFREEW FILE,ADJUNCTS 72YY ... ERRTEST 3,PNEXT,FROZEN,NOFPRIV [ERROR MESSAGE 732M ... GEOERR 1,LIBFRREP 734B ...) 736= PERR 73?D ... MFREEW FILE,ADJUNCTS 73DL ...PERX 73KW ERRORX 3,4 [OUTPUT APPROPRIATE ERROR MESSAGE 745G PNEXT 74K6 MFREE FILE,FABSNB 754Q MHUNT 3,CPB,CUNI 75JB PNEXT1 7642 ADN 5 1 76HL PEND 773= FREECORE 3 77GW ADX 5 FX1 782G EXIT 5 0 78G6 PNULL 78^Q ADN 5 1 79FB BRN PNEXT1 79K? ...PNAMEF 79P8 ... VFREEW FILE,ADJUNCTS [FNORM MAY LEAVE AN ADJUNCTS 79T5 ... BRN PNEXT1 [ EVEN THOUGH IT SHOULDN'T 79^2 # ERROR MESSAGE IDENTIFIERS 7=DL ZAMISS +AMISS 7=Y= ZATYPEQ +ATYPEQ 7?CW ZIMPER +IMPER 7?XG ZAMTDESC +AMTDESC 7#C6 ZJTSN +JTSN 7#WQ ZERNOP +ERNOP 7*BB ZERXE +ERXENOSER 7*W2 ZJNTSN +JNTSN 7B*L ZJLOCN +JLOCN 7BT= ZERNAM +ERNAMEFORM 7C#W ZCODEWR +ERCODEWR 7CSG ZPILL +ERILLCOMB 7D#6 ZPMOD +ERILLMODE 7DRQ # SUBROUTINE TO CHECK WHETHER PROPER USER OWNS ENTRANT 7F?B # EXIT AT LINK ADDRESS IF TAPE DOES NOT BELONG TO PROPER USER. 7FR2 # EXIT AT LINK ADDRESS+1 IF TAPE BELONGS TO PROPER USER. 7G=L # X6 IS THE LINK ACC. AND X7 IS NOT USED 7GQ= OWNCHECK 7H9W SBX 6 FX1 7HPG MHUNT 2,FILE,FABSNB 7J96 LDX 0 ATYPE(2) 7JNQ ANDN 0 #200 7K8B BNZ 0 OWN [BRANCH IF NAMED WORKTAPE 7KN2 LDX 0 A1(2) 7L7L SBN 0 10 7LM= BNZ 0 OWN1 [BRANCH IF LOCAL NAME OF DIR GIVEN 7M6W LDX 3 A1+1(2) [X3,4,5=NAME OF DIR 7MLG LDX 4 A1+2(2) 7N66 LDX 5 A1+3(2) 7NKQ CJOBLOCK 2 [FIND JOB BLOCK 7P5B TXU 3 JUSER(2) 7PK2 TXU 4 JUSER+1(2) 7Q4L TXU 5 JUSER+2(2) 7QJ= BCC OWN [BRANCH IF PROPER DIR 7R3W SETNCORE 4,2,FILE,FABSNB 7RHG LDN 0 4 7S36 STO 0 A1(2) 7SGQ STO 3 A1+1(2) 7T2B STO 4 A1+2(2) 7TG2 STO 5 A1+3(2) 7T^L CHECKOWNER 7WF= OWN2 7WYW TESTREP OK,OWN 7XDG TESTREPN NOFILE,OWN2A 7XY6 SETREP NAME 7YCQ OWN2A 7YXB TESTREPN NOTOWNER,OWN2C 7^C2 BXE 7 ZTAPEWR(1),OWN2B 7^WL BXE 7 ZTAPERI(1),OWN2B 82B= BXU 7 ZREND(1),OWN2C 82TW OWN2B 83*G ERROR ERNOTOWN 83T6 BRN OWN3 84#Q OWN2C 84M7 ... ERRTEST 3,OWN3,LOST,TEMPLOST,NAME,NOUSER,VRYWRONG,NOTOWNER,WRONG- 84^J ... ,NOINFACC,NOALLACC 85#2 GEOERR 1,LIBREP 85RL OWN3 86?= MFREE CPB,CUNI 86QW MFREE FILE,FABSNB 86W2 ...#UNSET FTS1 86^6 ...( 874= ... MFREEW FILE,ADJUNCTS 877B ...) 87=G ADX 6 FX1 87Q6 EXIT 6 0 [PROPER USER DOES NOT OWN ENTRANT 889Q OWN 88#W ...#UNSET FTS1 88D2 ...( 88DD ... LDX 1 FX1 88FQ ... BXE 7 ZRETURN(1),OWNYF [NO ADJUNCTS NEEDED FOR RETURN 88G8 ... BXU 7 ZREND(1),OWNNF [OR RENAMDIR 88GL ...OWNYF 88H4 ... MFREEW FILE,ADJUNCTS 88HG ... BRN OWNEND 88HY ...OWNNF 88JB ... BXE 7 ZGET(1),OWNEND 88JS ... MHUNTW 1,FILE,ADJUNCTS [WHERE MULTIPLE PARAMS ALLOWED 88K= ... NAME 1,FI,FUTILITY [ADJUNCTS NEEDS TEMPORARY DISGUISE 88KN ...OWNEND 88L= ...) 88PB ADX 6 FX1 8992 EXIT 6 1 [PROPER USER OWNS ENTRANT 89NL OWN1 8=8= LDN 0 6 8=MW SBS 0 A1(2) 8?7G OPEN ZBRKIN,READ,LEAVE,QUERY 8?M6 MHUNT 3,FILE,FABSNB 8#6Q LDN 0 6 8#LB ADS 0 A1(3) 8*62 TESTREPN OK,OWN2 8*KL MHUNT 1,FILE,ENT 8B5= MHUNT 2,FILE,FABSNB 8BJW ADN 1 EUSE1 8C4G LDX 0 A1(2) 8CJ6 LDN 3 10 8D3Q STO 3 A1(2) [NEW HEADER 8DHB ADN 2 A1+1 8F32 MOVE 1 3 [USER NAME 8FGL LDN 3 3(2) 8G2= SBN 2 7 8GFW ADX 2 0 8G^G MOVE 2 8 8HF6 SBN 1 EUSE1 8HYQ FREECORE 1 8JDB MHUNT 2,FILE,FABSNB 8JY2 ALTLEND 2,12,FILE,FABSNB 8KCL OWNERCHEC 8KX= PICKREP 3 8LBW CLOSETOP 8LWG PUTREP 3 8MB6 BRN OWN2 8MTQ MENDAREA 50,K99LIBCOM 8N*B #END ^^^^ ...06632676000300000000