{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: NEWOWN865)}}
====== NEWOWN865 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:BUDGINCR|BUDGINCR]], [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CLALLOC|CLALLOC]], [[george:macro:CLOSBUDG|CLOSBUDG]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:COMBRKIN|COMBRKIN]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:ERRORX|ERRORX]], [[george:macro:FINDPEREC|FINDPEREC]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FSHACCWK|FSHACCWK]], [[george:macro:FSHCODE|FSHCODE]], [[george:macro:FSHENTRY|FSHENTRY]], [[george:macro:FSHSKIP|FSHSKIP]], [[george:macro:GEOERR|GEOERR]], [[george:macro:HUNT2|HUNT2]], [[george:macro:HUNT2OPT|HUNT2OPT]], [[george:macro:INSERT|INSERT]], [[george:macro:JALLOC|JALLOC]], [[george:macro:LOGACCESS|LOGACCESS]], [[george:macro:LONGON|LONGON]], [[george:macro:LPROP|LPROP]], [[george:macro:MASK|MASK]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MTCHAR|MTCHAR]], [[george:macro:MTHWSER|MTHWSER]], [[george:macro:MTINFORM|MTINFORM]], [[george:macro:NAME|NAME]], [[george:macro:NAMETOP|NAMETOP]], [[george:macro:NOTALIEN|NOTALIEN]], [[george:macro:OPENBUDO|OPENBUDO]], [[george:macro:OPENDIR|OPENDIR]], [[george:macro:OPENSYS|OPENSYS]], [[george:macro:OUTPARAM|OUTPARAM]], [[george:macro:PAIR|PAIR]], [[george:macro:READAGAIN|READAGAIN]], [[george:macro:REPERR|REPERR]], [[george:macro:REWIND|REWIND]], [[george:macro:REWRITE|REWRITE]], [[george:macro:SDSEARCH|SDSEARCH]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETALLOC|SETALLOC]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SPARANOX|SPARANOX]], [[george:macro:SSCOR|SSCOR]], [[george:macro:SSEARCH|SSEARCH]], [[george:macro:TAPEOPEN|TAPEOPEN]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TRACE|TRACE]], [[george:macro:TRANSBEG|TRANSBEG]], [[george:macro:TRANSFIN|TRANSFIN]], [[george:macro:UNLOAD|UNLOAD]], [[george:macro:USEROPEN|USEROPEN]], [[george:macro:VFREEW|VFREEW]]
22FL ...#LIS K0NEWOWN>K0ALLGEO>K0GREATGEO>K0LIBRARY
22^= SEG NEWOWN,865,N.R.BOULT,LIBRARY
23DW SEGENTRY K1NEWOWN,QK1NEW
23YG ... FSHENTRY K2NEWOWN,,QK2NEW,QK2NEW
24D6 #
24XQ # ENTRY POINT FOR UNANTICIPATED CLOSEDOWN OF M/C 'B'
25CB #
25KL ... FSHENTRY K3NEWOWN,QK3NEW,,QK3NEW
25RW ... FSHENTRY K4NEWOWN,QK4NEW,,QK4NEW
2626 ... FSHENTRY K5NEWOWN,,QK5NEW,QK5NEW
268B ... FSHENTRY K7NEWOWN,,QK7NEW,QK7NEW
26BL #
26W= MASK #37777777
27*W MASK2 #77377777
27TG MASK3 #57377777
28*6 ZERAL +ERALKNOWN
28SQ ZTINUSE +ERTINUSE
29#B ZPARWRNG +ERPARWRNG
29S2 ZEROWN +EROWN
2=?L ZFAILMAG +FAILMAG
2=R= ZOPWRONG +EROPWRONG
2?=W ZUSWRONG +ERUSWRONG
2?QG ZNOTAV +ERNOTAV
2#=6 POOLHD 0
2#PQ 4HPOOL
2*9B 4H TAP
2*P2 4HE
2B8L 0
2BN= 0
2C7W 0
2CMG ... FSHCODE AORB
2D76 (
2DLQ #
2F6B # LINK FOR UNANTICIPATED CLOSEDOWN
2FL2 #
2G5L SCDLINK
2GK= PAIR NEWOWN,3
2H4W #
2H=4 ...S2CDLINK
2HC= ... PAIR NEWA,5
2HJG )
2J46 QK1NEW
2JHQ SETNCORE 1,3,FLIB,FMES
2K3B LDX 0 CPPTR(2)
2KH2 STO 0 A1(3)
2L2L STOZ CPPTR(2)
2L3F ... FSHCODE B,XNOTINB
2L4# ...(
2L57 ... TRANSBEG FSHNEWID,NEWOWN,4,CLB,,ACOMMUNE1
2L62 ... BRN TEND
2L6T ... BRN YBRKIN
2L7N ...XNOTINB
2L8H ...)
2L9B ... FSHCODE A,XNOTINA
2L=9 ...(
2L?4 ...QK4NEW
2L?X ... NOTALIEN XNOTINA
2L#Q ... SETNCORE 1,3,FLIB,FMES
2L*K ... LDX 0 CPPTR(2)
2LBD ... STO 0 A1(3)
2LC? ... STOZ CPPTR(2)
2LD6 ...XNOTINA
2LD^ ...)
2LG= NEWK1
2MFG STOZ AWORK2(2)
2M^6 STOZ AWORK3(2)
2PD2 LDN 3 0
2PXL NEXTP
2QC= ADN 3 1
2QWW MHUNT 1,AONBS,GLIST
2RBG BXE 3 ALOGLEN(1),TEND [BR IF NO MORE PARAMETERS TO END CMD
2RL# ... STOZ AWORK1(2)
2RW6 STOZ AWORK4(2) [USED TO INDICATE IF CNT OF REQ. UPDATED
2S*Q STO 3 AWORK2(2) [PARAM. NO.
2STB SMO 3
2T*2 LDX 7 A1(1) [LOAD NEXT TSN
2TSL BZE 7 NEXTP [NOTHING TO DO IF PARAM ZERO
2TXQ ... LDX 0 AWORK3(2)
2W2W ... BNZ 0 NEXTP1
2W62 ... CALL 5 OPENFLS [OPEN SYS.DOC.&SYS.SER.
2W96 ...NEXTP1
2W#= CALL 5 SSEARCH [SEARCH SYS.SERIAL FOR TAPE AND BR
2WRW BRN TAPENEW [TO TAPENEW IF ENTRY FOR TSN NOT FOUN
2X?G #
2XR6 # ENTRY FOUND IN SYS.SERIAL SO TSN MUST BE QUERY STATUS,
2Y=Q # THOUGHT TO BE A POOL TAPE,AND NOT WRONGED,FOR USER TO
2YQB # BE ABLE TO CLAIM IT
2^28 ...NEXTP2
2^=2 CALL 5 STACH [CALL STACH TO CHECK ENTRY
2^PL BRN UNCL1 [TAPE CANNOT BE CLAIMED
329= # TAPE CAN BE CLAIMED - TAPE MUST NOW BE LOADED
32NW # AND HEADER LABEL NAME CHECKED FOR AGREEMENT WITH
338G # LABEL NAME SUPPLIED IN PARAMETER
33N6 READAGAIN [READ SYS.SERIAL AGAIN TO GET FILE/FR
347Q MHUNT 3,FILE,FRB [BLOCK TO UPDATE CNT OF REQUESTERS
34MB LDN 0 1
3572 ADS 0 A1+5(3) [INCREMENT CNT OF REQUESTERS
35LL STO 0 AWORK4(2) [INDICATE CNT UPDATED
366= CALL 5 XREWR [REWRITE UPDATED RECORD
36KW CALL 5 SYSCLOSE [CLOSE SYS SER AND SYS DOC
36LX ... FSHCODE A,X2NOTINA
36MY ...(
36N^ ...[ MUST CARRY OUT TAPEOPEN IN HOME MACHINE
36Q2 ... NOTALIEN X2NOTINA
36R3 ... SETNCORE 2,3,FSH,FSHAMBLES
36S4 ... LDX 0 S2CDLINK(1)
36T5 ... STO 0 FSHCDLINK(3)
36W6 ... STO 7 FSHWORK(3)
36X7 ... TRANSBEG FSHNEWID,NEWOWN,5,NOBLOCKS,,ACOMMUNE1,UNCL
36Y8 ... BRN NEXTP3
36^9 ... BRN ZBRKIN
372= ...X2NOTINA
373? ...)
374# ...QK5NEW
375G TAPEOPEN ZBRKIN,7,,NOTOL,NOQUERY,NOSS
378T ... MFREE CPAR,GPERCON
37#8 ...NEXTP3
37CH ... FSHCODE B,X4NOTINB
37GW ...(
37L9 ... BRN TRFN2
37PJ ...X4NOTINB
37SX ...)
37Y= ... FSHCODE AORB
383K ...(
386Y ... VFREEW FSH,FSHAMBLES
38=? ... LDX 1 FX1
38*L ... LDX 2 FX2
38D^ ...)
38JB TESTREPN OK,TORPNOK [BR IF REPLY NOT OK TO FLAG ERRORS
3942 [+ TIDY UP
3998 ... CALL 5 OPENFLS
39HL #
3=3= # RECHECK ENTRY IN SYS.SER AS IT MAY HAVE BEEN ALTERED
3=GW # WHILE TAPEOPEN EXECUTED
3?2G #
3?G6 CALL 5 SSEARCH [SEARCH SYS.SERIAL
3?^Q BRN NOMORE [ENTRY NO LONGER IN SYS.SER - BR TO
3#FB ... [ ALLOCATE IT TO THE USER
3*DL CALL 5 STACH [CHECK IF ENTRY CAN BE CLAIMED
3*Y= BRN UNCL [ENTRY PRESENT BUT CANNOT BE CLAIMED
3BCW CALL 5 SDSEARCH [SEARCH SYS.DOC
3BXG BRN NOSD [BR IF NO ENTRY FOUND TO FLAG SYS ERR
3CC6 CALL 5 SEEKFAB [FIND FILE/FABSNB BLOCK
3CWQ #
3DBB # CHECK THAT NAME,GEN NO. AND RTN PER. CORRESPOND
3DW2 # IN HEADER LABEL IN SYS. DOC. AND IN FILE/FABSNB
3F*L ADX 1 A1(1) [X1 NOW POINTS TO RETENTION PERIOD
3FT= LDX 0 7(3) [GEN NO FROM HEADER IN SYS. DOC
3G#W ANDN 0 #7777 [TRUNCATE
3GSG LDX 5 A1-2(1) [GEN NO FROM FABSNB
3H#6 ANDN 5 #7777 [TRUNCATE
3HRQ BXU 5 0,PRONG [BR IF NOT EQUAL
3J?B LDX 0 A1-3(1) [REEL NO FROM FABSNB
3JR2 ANDN 0 #777
3K=L BXU 0 6(3),PRONG [BR IF NOT EQUAL TO REEL NO IN HDR
3KQ= LDN 2 3
3L9W PARCH1
3LPG SMO 2
3M96 LDX 0 A1-7(1)
3MNQ SMO 2
3N8B BXU 0 2(3),PRONG [BRANCH IF PARAMETER WRONG
3NN2 BCT 2 PARCH1
3P7L # THIS TAPE CAN NOW BE CLAIMED BY THE USER
3PM= CALL 5 USERENT [SET UP DIR ENT
3Q6W BRN UNCL
3QLG CALL 5 UPLSD
3R66 READAGAIN
3RKQ MHUNT 3,FILE,FRB
3S5B CALL 5 NAME
3SK2 LDN 2 A1+2(3)
3T4L MOVE 1 3 [USER NAME
3TJ= SMO FX1
3W3W LDX 0 MASK2
3WHG ANDS 0 A1+5(3) [REMOVE Q STATUS
3X36 CALL 5 XREWR [REWRITE ALTERED RECORD
3XGQ UNCL
3Y2B SMO FX2
3YG2 LDX 0 AWORK4
3Y^L BZE 0 UNCL1
3^F= READAGAIN
3^YW MHUNT 3,FILE,FRB
42DG SSCOR A1(3),DEC [DECREASE COUNT OF REQUESTERS
42Y6 LDX 4 A1+5(3)
43CQ CALL 5 XREWR [REWRITE ALTERED RECORD
43XB UNCL1
44C2 CALL 5 SYSCLOSE [CLOSE SYS SER AND SYS DOC
44DJ ... FSHCODE A,X8NOTINA
44G6 ...(
44HN ...[ UNLOAD THE TAPE FROM THE HOME MACHINE
44K= ... NOTALIEN X8NOTINA
44LS ... TRANSBEG FSHNEWID,NEWOWN,7,NOBLOCKS,,ACOMMUNE1,TSUB
44NB ... BRN TSUB
44PY ...X8NOTINA
44RG ...)
44T4 ...QK7NEW
44WL LDX 0 CPPTR(2)
45B= BZE 0 TSUB [BRANCH IF TAPE NOT ALLOCATED
45TW LDN 3 0
46*G UNLOAD ,3,4,AUT,RET [FREE DECK FROM T IS ACTIVITY
46T6 BRN TSUB
47#Q NOMORE
47SB ...[ MARK TAPE LOADED BY TAPEOPEN
48#2 ... LDN 0 1
48RL ... STO 0 AWORK1(2)
49?= ... BRN TDIR
4F5= #
4FJW #
4G4G # ENTRY NOT FOUND IN SYS.SERIAL SO TAPE CAN BE 'NEWED' IN F
4GJ6 # USER IF HIS BUDGET ALLOWS
4H3Q #
4HHB #
4J32 # FIRST CHECK IF TAPE IS LOADED AND ALLOCATE IF POSS.
4JGL TAPENEW
4JJ* ... FSHCODE A,X4NOTINA
4JL4 ...(
4JMR ...[ ONLY GO TO THE SLAVE IF WE HAVE TO - SEARCH :SYSTEM.DOCUMENT FIRST
4JPG ... CALL 5 SDSEARCH
4JR9 ... BRN TDIR
4JSY ... REWIND 1
4JWM ...X4NOTINA
4JYB ...)
4K2= CALL 5 SFINDPER [SEE IF TAPE LOADED
4KFW FSHSKIP
4K^G BNG 3 TDIR
4LF6 ... FSHCODE A,THISMACH
4LYQ (
4MDB BPZ 3 THISMACH [ J. IF LOADED IN THIS M/C
4MY2 SETNCORE 1,2,FSH,FSHAMBLES [
4NCL LDX 0 SCDLINK(1) [ (JUST IN CASE 'B' GOES DOWN WHILE
4NX= STO 0 FSHCDLINK(2) [ WE'RE THERE !!!!)
4PBW ... TRANSBEG FSHNEWID,NEWA,7,NOBLOCKS,,ACOMMUNE1,TOTHERDOWN,SUP
4PWG [ ELSE CHECK IF LOADED IN OTHER M/C
4QB6 BRN TINUSE [ TRANSFIN +0 IF IN USE IN OTHER M/C
4QTQ TOTHERDOWN
4R*B BRN TDIR [ TRANSFIN +1 IF NOT LOADED IN OTHER
4RT2 [ M/C - OR IF UNLOADED (NOT ALLOC'D)
4S#L THISMACH
4SS= )
4T?W JALLOC 3,TINUSE
4TRG SETALLOC 3
4W?6 STO 3 CPPTR(2)
4WQQ TDIR
4X=B ... FSHCODE A,X5NOTINA
4XQ2 (
4Y9L VFREEW FSH,FSHAMBLES [ NOW SAFE FROM 'B' GOING DOWN
4YFD ...X5NOTINA
4YP= )
4^8W # CREATE DIRECTORY ENTRY
4^NG CALL 5 USERENT [CREATE DIRECTORY ENTRY
5286 BRN TDEAL
52MQ LDX 3 AWORK2(2)
537B SPARANOX 3 [PASS PARAMETER
53M2 MHUNT 3,CPB,CUNI
546L LDX 4 ANUM(3)
54L= ANDN 4 #7777
555W OUTPARAM 4,APARA,CPB,CUNI
55KG MFREE CPB,CUNI
5656 MTINFORM GNEW
56JQ # UPDATE THE PERIPHERAL LIST AND :SYSTEM.DOCUMENT
574B TSEROP
57J2 CALL 5 UPLSD
583L # APPEND RECORD TO :SYSTEM.SERIAL
58H= LDCT 4 #200
592W CALL 5 SAP [APPEND RECORD TO :SYSTEM.SERIAL
59GG TDEAL
5=26 LDX 2 FX2
5=63 ...[ IF OPENED BY TAPEOPEN GO TO UNLOAD TAPE
5=9Y ... LDX 0 AWORK1(2)
5=*T ... BNZ 0 UNCL1
5=FQ LDX 3 CPPTR(2)
5=^B BZE 3 TSUB [BRANCH IF TAPE NOT ALLOCATED
5?F2 CLALLOC 3 [DE-ALLOCATE DECK
5?YL STOZ CPPTR(2)
5#D= LONGON #61,7 [WAKE UP ACTS. WAITING FOR TAPE
5#XW LONGON #61
5*CG TSUB
5*FP ... FSHCODE B,X3NOTINB
5*HY ...(
5*L7 ...TRFN2 LDN 4 0
5*NB ...TRFIN TRANSFIN 4
5*QK ...X3NOTINB
5*SS ...)
5*X6 CALL 5 SEEKFAB
5BBQ FREECORE 1
5BWB LDX 3 AWORK2(2) [PARAM. NO.
5CB2 BRN NEXTP [BR BACK TO DEAL WITH NEXT ENTRY
5CTL # END OF COMMAND
5D*= TEND
5DSW CALL 5 SYSCLOSE [CLOSE SYS SER AND SYS DOC
5F#G MHUNT 1,FLIB,FMES
5FS6 LDX 0 A1(1)
5G?Q STO 0 CPPTR(2)
5GRB FREECORE 1
5GT^ ... FSHCODE A,X10NOTINA
5GYJ ...(
5H37 ... TRANSFIN ,,ALIEN
5H5Q ...X10NOTINA
5H8* ...)
5H?2 ENDCOM
5HQL #
5J== # ERROR PATHS
5JPW #
5K9G TINUSE
5KP6 ... FSHCODE A,X7NOTINA
5L8Q (
5LNB VFREEW FSH,FSHAMBLES [ NOW SAFE FROM 'B' GOING DOWN
5LY8 ...X7NOTINA
5M82 )
5MML SMO FX1
5N7= LDX 4 ZTINUSE [TAPE IN USE
5NLW CALL 5 ZERROR [OUTPUT ERROR MESSAGE
5P6G BRN TSUB
5PL6 TORPNOK
5Q5Q LDX 4 ZNOTAV(1)
5QKB TESTREP NOTAV,TAPREP
5R52 LDX 4 ZEROWN(1)
5RJL TAPREP
5S4= CALL 5 ZERROR
5S9D ...[ HAVE TO UPDATE :SYSTEM.SERIAL ENTRY
5SBL ...TPRP2 CALL 5 OPENFLS
5SHS ... CALL 5 SSEARCH
5SP2 ... BRN UNCL1
5SW8 ... BRN UNCL
5T3G NOSD
5TH6 GEOERR 1,NOSYSDOC
5W2Q PRONG
5WGB SMO FX1
5X22 LDX 4 ZPARWRNG [NAME WRONG
5XFL CALL 5 ZERROR
5X^= BRN UNCL
5YDW # SPACEMT BUDGET OVERDRAWN OR ZERO
5YYG ODRAWN
5^D6 ACROSS NEWA,1
5^XQ # BREAKIN
62CB ZBRKIN
62FK ... FSHCODE B,X5NOTINB
62HS ...(
62L3 ... LDN 4 1
62N= ... BRN TRFIN
62QF ...X5NOTINB
62SN ...)
62X2 ACROSS NEWA,2
62Y? ... FSHCODE B,X2NOTINB
62^J ...(
632T ...[ TERMINATE IN THE SLAVE AFTER BREAKIN
6346 ...YBRKIN
635C ... MHUNT 1,FLIB,FMES
636N ... LDX 0 A1(1)
637^ ... STO 0 CPPTR(2)
639= ... FREECORE 1
63=H ... COMBRKIN
63?S ...X2NOTINB
63*5 ...)
63BL #
63W= # SUBROUTINES
64*W #
64TG # APPEND RECORD TO :SYSTEM.SERIAL
65*6 SAP
65SQ SBX 5 FX1
66#B LDX 6 5
66S2 SETNCORE 6,3,FILE,FWB
67?L LDN 0 6
67R= STO 0 A1(3) [RECORD HEADER
68=W STO 7 A1+1(3) [TSN
68QG CALL 5 NAME [USER NAME
69=6 LDN 2 A1+2(3)
69PQ MOVE 1 3
6=9B STOZ A1+5(3)
6=P2 LDX 2 FX2
6?8L LDX 1 FX2
6?N= SAP2A
6#7W LDX 1 FPTR(1)
6#MG LDX 0 ATYPE(1)
6*76 BXGE 0 CACT,SAP2D
6*LQ SRL 0 12
6B6B SBN 0 FLIB+FSPD
6BL2 BNZ 0 SAP2A
6C5L LDX 0 ATYPE(1)
6CK= ANDN 0 #7777
6D4W BXU 0 AWORK2(2),SAP2A
6DJG LDX 0 A1(1)
6F46 STO 0 ACOMMUNE1(2)
6FHQ MTCHAR
6FMM ...#UNS JMODGCR
6FRJ ...#SKI
6FXF ...(
6G3B LDX 2 ACOMMUNE1(2)
6GH2 BNG 2 SAP2D [JUMP IF NO TRACK PROPERTIES
6H2L LDX 1 2
6HG= ANDN 2 3
6H^W ERN 1 #200
6JFG BZE 1 SAP2D [JUMP IF TRACK9
6J^6 SRL 1 5
6KDQ ADX 2 1
6KYB ... BRN SAP2B [FSPD USED TO UPDATE PROPS
6L63 ...)
6L?N ...#UNS JMODGCR
6LF* ...(
6LM2 ... LDX 0 ACOMMUNE1(2)
6LSM ... BNG 0 SAP2D
6M2# ... LDX 1 0
6M7^ ... ERN 1 HWPTRACK9
6M*L ... BZE 1 SAP2D
6MH? ... BRN SAP2F
6MNY ...)
6MWW SAP2D
6NBG LDX 2 FX2
6NW6 LDX 0 CPPTR(2)
6P*Q BZE 0 SAP2C [J TAPE NOT LOADED
6PC# ...#UNS JMODGCR
6PDW ...(
6PGD ... LPROP ,0
6PJ2 ...SAP2F
6PKJ ... MTHWSER 0,2
6PM6 ...)
6PNN ...#UNS JMODGCR
6PQ= ...#SKI
6PRS ...(
6PTB LPROP ,5 [TAPE LOADED SO PROPERTIES CAN BE
6Q*2 LDN 2 4 [DETERMINED
6QSL LDX 0 5
6R#= ANDN 0 #200
6RRW BZE 0 SAP2B
6S?G LDX 2 5
6SR6 ANDN 2 3
6T2Y ...)
6T=Q SAP2B
6TCY ...#UNS JMODGCR
6TK6 ...#SKI
6TQB SLL 2 13
6W28 ... MHUNT 3,FILE,FWB
6W=2 ORS 2 A1+5(3)
6WPL SAP2C
6X9= #SKI K6NEW>199-199
6XNW (
6Y8G TRACE A1+1(3),NEWSAP1
6YN6 TRACE A1+2(3),NEWSAP2
6^7Q TRACE A1+5(3),NEWSAP5
6^MB )
7272 CALL 5 SSEARCH [LOCATE ENTRY IN SS
72LL BRN SAP2E
736= GEOERR 1,REC PRES
73KW SAP2E
745G INSERT [PUT ENTRY IN SERIAL
74K6 TESTREP OK,SAP3,FNEARLY,SAP3
754Q GEOERR 1,FILEFULL
75JB SAP3
7642 MFREE FILE,FWB
76HL ADX 6 FX1
773= EXIT 6 0
77GW SSEARCH
782G #
78G6 # SUBROUTINE TO LOCATE ENTRIAS IN :SYSTEM.SERIAL
78^Q # X5 = LINK ; X7 = TSN ; EXIT +0 IF NOT FOUND ELSE EXIT +1
79FB #
79^2 SBX 5 FX1
7=DL SSEARCH NOTSNINSER,7
7=Y= ADN 5 1
7?CW NOTSNINSER
7?XG ADX 5 FX1
7#C6 EXIT 5 0
7#WQ #
7*BB # SUBROUTINE TO SEE IF THE TAPE IS LOADED
7*W2 # X5 = LINK ; X7 = TSN ; X3 REQUIRED => DEVICE LIST
7B*L #
7BT= SFINDPER
7C#W FINDPEREC 3,APTSER,7
7CSG EXIT 5 0
7D#6 #
7DRQ # SUBROUTINE TO LOCATE ENTRY IN :SYSTEM.DOCUMENT
7F?B # X5 = LINK ; X7 = TSN ; EXIT +0 IF NOT FOUND ELSE +1
7FR2 #
7G=L SDSEARCH
7GQ= SBX 5 FX1
7GTB ... FSHCODE AORB
7GYG ...(
7H3L ...[ IF SHFS SEARCH ON BOTH MACHINES
7H6Q ... SDSEARCH NONTRY2,TSN,7,1,BOTH
7H9W ...)
7H*2 ... FSHSKIP
7HD6 ...(
7HH= ... SDSEARCH NONTRY2,TSN,7,1
7HLB ...)
7HPG ADN 5 1 [ ADJUST LINK IF FOUND
7J96 NONTRY
7JNQ ADX 5 FX1
7K8B EXIT 5 0 [ ELSE EXIT
7K#? ...NONTRY2
7KD8 ... REWIND 1
7KJ5 ... BRN NONTRY
7KN2 #
7L7L # SUBROUTINE TO REWRITE AND FREE A FILE/FRB
7LM= # X5 = LINK ; EXPECTS X3 => FILE/FRB
7M6W #
7MLG XREWR
7N66 SBX 5 FX1
7NKQ NAMETOP 3,FILE,FWB
7P5B REWRITE
7PK2 MFREE FILE,FWB
7Q4L ADX 5 FX1
7QJ= EXIT 5 0
7R3W #
7RHG #
7S36 # SUBROUTINE TO SET POOL/WORKTAPE BIT IN PERIPHERAL LIST
7SGQ # AND UNSET INSECURE BIT IN :SYSTEM.DOCUMENT
7T2B # X5=LINK
7TG2 # X7 = TSN
7T^L UPLSD
7WF= SBX 5 FX1
7WYW LDX 4 5 [PRESERVE LINK
7YXB CALL 5 SDSEARCH
7^C2 ... BRN SAP5
7^WL READAGAIN 1
82B= MHUNT 3,FILE,FRB
82TW LDX 0 MASK3(1)
83*G ANDS 0 A1+21(3)
83T6 NAMETOP 3,FILE,FWB
84#Q REWRITE 1
84SB MFREE FILE,FWB
85#2 SAP4A
85RL REWIND 1
86?= SAP5
86QW LDX 5 4 [RESTORE LINK
87=G ADX 5 FX1
87Q6 EXIT 5 0
889Q # SUBROUTINE TO FIND THE FILE/FABSNB BLOCK FOR THE TSN IN X7
88PB # X5 IS THE LINK AND X2,3,4,6 ARE UNUSED
8992 SEEKFAB
89NL LDX 1 FX2
8=8= SEEK1
8=MW LDX 1 FPTR(1)
8?7G LDX 0 ATYPE(1)
8?M6 BXL 0 CACT,SEEK2
8#6Q GEOERR 1,FAB LOST
8#LB SEEK2
8*62 SRL 0 12
8*KL SBN 0 FILE+FABSNB
8B5= BNZ 0 SEEK1
8BJW SMO A1(1)
8C4G BXU 7 A1+1(1),SEEK1
8CJ6 #SKI K6NEW>299-299
8D3Q TRACE 7,NEWSEEK
8DHB EXIT 5 0
8F32 # SUBROUTINE TO OUTPUT AN ERROR MESSAGE
8FGL # IDENTIFIER IS IN X4 AND X5 HOLDS THE LINK
8G2= ZERROR
8GFW SBX 5 FX1
8G^G SMO FX2
8HF6 LDX 3 AWORK2
8HYQ SPARANOX 3 [PASS PARAMETER WHOSE NO. IS IN X3
8JDB ERRORX 4
8JY2 MFREE CPB,CUNI
8KCL ADX 5 FX1
8KX= EXIT 5 0
8LBW #
8LWG # SUBROUTINE TO OPEN SYSTEM SERIAL AND SYSTEM DOCUMENT
8MB6 #
8MTQ OPENFLS
8N*B SBX 5 FX1
8NT2 OPENSYS ZBRKIN,DOCUMENT,GENERAL
8P#L LDN 0 1
8PS= ADS 0 AWORK3(2)
8Q?W ... TESTREPN OK,OPENSER0
8RQQ OPENSYS ZBRKIN,SERIAL,GENERAL
8S=B LDN 0 1
8SQ2 ADS 0 AWORK3(2)
8T9L TESTREP OK,OPENSER1
8TFD ...OPENSER0
8TP= GEOERR 1,NEWREP
8W8W OPENSER1
8WNG ADX 5 FX1
8X86 EXIT 5 0
8XMQ #
8Y7B # SUBROUTINE TO CLOSE ANY OPEN FILES
8YM2 # X5 HOLDS THE LINK. ON EXIT X1=FX1, X2=FX2
8^6L SYSCLOSE
8^L= SBX 5 FX1
925W SCL1 SMO FX2
92KG LDX 0 AWORK3
9356 BZE 0 SCLZ
93JQ CLOSETOP
944B LDN 0 1
94J2 SBS 0 AWORK3(2)
953L BRN SCL1
95H= SCLZ ADX 5 FX1
962W EXIT 5 0
96GG #
9726 # SUBROUTINE TO UPDATE OR REUPDATE BUDGET
97FQ #
97^B UPBUDG
98F2 LDN 4 1
98YL BRN UPBUD1
99D= REBUDG
99XW NGN 4 1
9=CG UPBUD1
9=X6 SBX 5 FX1
9?BQ SETNCORE 4,2,FILE,FABSNB [SET UP FABSNB IN ORDER TO
9?WB HUNT2 1,FILE,FABSNB,2 [GET THE APPROPRIATE DICT ENT
9#B2 LDN 0 4
9#TL STO 0 A1(2)
9**= LDX 0 A1(1)
9*SW SBN 0 10
9B#G BZE 0 UPBUD1A
9BS6 ADX 1 A1(1)
9C?Q SBN 1 12
9CRB UPBUD1A
9D?2 ADN 1 A1+1
9DQL ADN 2 A1+1
9F== MOVE 1 3
9FPW OPENBUDO UPBUD6 [GET DICT ENT
9G9G UPBUD2
9GP6 BUDGINCR GSPACEMT,4
9H8Q TESTREP OK,UPBUD4
9HNB TESTREP NOMORE,UPBUD4
9J82 TESTREP ODRAWN,UPBUD3
9JML TESTREP INCREASE,UPBUD3
9K7= GEOERR 1,NEWREP
9KLW UPBUD3
9L6G BNG 4 UPBUD4
9LL6 NGX 4 4
9M5Q BRN UPBUD2
9MKB UPBUD4
9N52 ADX 5 4
9NJL CLOSBUDG
9P4= UPBUD5
9PHW ADX 5 FX1
9Q3G EXIT 5 1
9QH6 UPBUD6
9R2Q GEOERR 1,NOUSERNE
9RGB # SUBROUTINE TO SET UP A DIRECTORY ENTRY AND UPDATE THE BUDGETS
9S22 USERENT
9SFL SBX 5 FX1
9S^= LDX 6 5
9TDW CALL 5 SEEKFAB [FIND FILE/FABSNB BLOCK
9TYG LDN 0 1
9WD6 ORS 0 ATYPE(1)
9WXQ LDX 3 BPTR(1)
9XCB USENTA1
9XX2 LDX 0 ATYPE(3) [LOCATE THE ADJUNCTS BLOCK WHICH
9YBL BXGE 0 CACT,USENTNA [GOES WITH OUR FABSNB
9YW= SRL 0 12 [I.E. THE 1ST ADJUNCT FOUND IN A
9^*W SBN 0 FILE+ADJUNCTS [SEARCH TOWARDS THE CPAT BETWEEN
9^TG BZE 0 USENTA2 [OUR FABSNB AND NEXT ONE OR CPAT
=2*6 ADN 0 ADJUNCTS-FABSNB
=2SQ BZE 0 USENTNA [ERROR IF FABSNB FOUND FIRST
=3#B LDX 3 BPTR(3)
=3S2 BRN USENTA1
=4?L USENTA2
=4R= LDX 2 FX2
=5=W CHAIN 1,2 [RECHAIN AFTER ACTIVITY BLOCK
=5QG CHAIN 3,2
=6=6 CALL 5 UPBUDG [UPDATE BUDGETS
=6PQ BRN ODRAWN
=79B BRN ZBRKIN
=7P2 LDX 5 AWORK2(2)
=88L USENT0
=8N= HUNT2OPT 2,AONBS,GROT
=97W BNG 2 USENT0A
=9MG LDX 0 ATYPE(2)
==76 ANDN 0 #7777
==LQ BXU 0 5,USENT0
=?6B NAME 2,FILE,FTRAP
=?L2 BRN USENT0
=#5L USENT0A
=#K= SMO FX2
=*4W LDX 3 AWORK2
=*JG SPARANOX 3
=B46 #UNSET FTS1
=BHQ #SKIP
=C3B USEROPEN USENT2,CREATE,REPLY [SET UP DIRECTORY ENTRY
=CH2 #UNSET FTS1
=D2L USEROPEN USENT2,CREATE,REPLY,FROZEN [DET UP DIRECTORY ENTRY
=DG= REPERR USENT2A
=D^W USENT1
=FFG CALL 5 REBUDG
=F^6 BRN USENT3
=GDQ BRN USENT1
=GYB USENT2
=HD2 CALL 5 REBUDG
=HXL BRN ZBRKIN
=JC= BRN USENT2
=JWW USENT2A
=KBG #UNS ILOGACC
=KW6 (
=L*Q ...[ THIS CODE SHOULD NOW ONLY BE OBEYED IN THE MASTER
=PR6 OPENDIR (GEOERR),READ,QUERY [OPEN DIR FOR LOGACCESS
=R=2 TESTREP OK,USENT2B
=RPL GEOERR 1,NEWLOG
=S9= USENT2B
=SNW LOGACCESS 8
=T8G CLOSETOP
=TN6 )
=W7Q ADN 6 1
=WMB USENT3
=X72 MFREEW FILE,ADJUNCTS
=XLL MFREE CPB,CUNI
=Y6= ADX 6 FX1
=YKW EXIT 6 0
=^5G USENTNA
=^K6 GEOERR 1,NEWNOADJ
?24Q # SUBROUTINE TO SET X1= ADDRESS OF DIRECTORY NAME
?2JB NAME
?342 LDX 2 5
?3HL CALL 5 SEEKFAB
?43= LDX 0 A1(1)
?4GW SBN 0 10
?52G BZE 0 NAME1
?5G6 ADX 1 A1(1)
?5^Q SBN 1 12
?6FB NAME1
?6^2 ADN 1 A1+1
?7DL EXIT 2 0
?7Y= STACH
?8CW LDX 1 FX1
?8XG LDX 4 ZERAL(1)
?9C6 LDX 0 5(3)
?9WQ SLL 0 6
?=BB BPZ 0 STACHERR [NOT QUERY STATUS
?=W2 LDX 4 ZEROWN(1)
??*L LDX 0 2(3)
??T= BNZ 0 STACHERR [OWNED TAPE
?##W LDX 4 ZOPWRONG(1)
?#SG LDX 0 5(3)
?*#6 SLL 0 5
?*RQ BNG 0 STACHERR [OPERATOR WRONGED
?B?B EXIT 5 1 [OK - QUERY STATUS THOUGHT TO BE POOL
?BR2 STACHERR
?C=L LDX 6 5
?CQ= SBX 6 FX1
?D9W CALL 5 ZERROR
?DPG ADX 6 FX1
?F96 EXIT 6 0
?FNQ #
?G8B # ENTRY POINT TO CHECK IF TAPE LOADED IN 'OTHER MACHINE' FOR
?GN2 # FOR SHARED FILESTORE ONLY.
?H7L #
?JLG QK2NEW
?K66 ... [ MOVED TO K7NEWA FOR REASONS OF SPACE
?KKQ ... FSHCODE AORB
?L5B ...(
?QG2 #
?Q^L # ENTRY FOR UNANTICIPATED CLOSEDOWN
?RF= #
?RYW QK3NEW
?SDG FSHACCWK [ RECOVER THE DUMPED 'ACC' + 'AWORK'
?SY6 BRN TDIR [ AND CARRY ON LIKE NOTHING HAPPENED
?TCQ #
?TXB )
?WC2 MENDAREA 1023-0?,K99NEW
?WWL #END
^^^^ ...372512560013