{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: LIBCOM867)}}
====== LIBCOM867 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLEND|ALTLEND]], [[george:macro:BXE|BXE]], [[george:macro:BXU|BXU]], [[george:macro:CHECKOWNER|CHECKOWNER]], [[george:macro:CJOBLOCK|CJOBLOCK]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:COMBRKIN|COMBRKIN]], [[george:macro:COMERR|COMERR]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:ERROR|ERROR]], [[george:macro:ERRORX|ERRORX]], [[george:macro:ERRTEST|ERRTEST]], [[george:macro:FNORM|FNORM]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FSHENTRY|FSHENTRY]], [[george:macro:GEOERR|GEOERR]], [[george:macro:HUNT|HUNT]], [[george:macro:HUNT2|HUNT2]], [[george:macro:HUNTW|HUNTW]], [[george:macro:JFREZFCB|JFREZFCB]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MTEXPROP|MTEXPROP]], [[george:macro:NAME|NAME]], [[george:macro:NAMETOP|NAMETOP]], [[george:macro:OPEN|OPEN]], [[george:macro:OPENSYS|OPENSYS]], [[george:macro:PARANOT|PARANOT]], [[george:macro:PARANUMB|PARANUMB]], [[george:macro:PARAPASS|PARAPASS]], [[george:macro:PICKREP|PICKREP]], [[george:macro:PUTREP|PUTREP]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETREP|SETREP]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:SPARAPAS|SPARAPAS]], [[george:macro:SWITRACE|SWITRACE]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TOPFCB|TOPFCB]], [[george:macro:VFREEW|VFREEW]]
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