NEWOWN865
(George Source)
Macros used: ACROSS, BUDGINCR, BXE, BXGE, BXL, BXU, CHAIN, CLALLOC, CLOSBUDG, CLOSETOP, COMBRKIN, ENDCOM, ERRORX, FINDPEREC, FREECORE, FSHACCWK, FSHCODE, FSHENTRY, FSHSKIP, GEOERR, HUNT2, HUNT2OPT, INSERT, JALLOC, LOGACCESS, LONGON, LPROP, MASK, MENDAREA, MFREE, MFREEW, MHUNT, MTCHAR, MTHWSER, MTINFORM, NAME, NAMETOP, NOTALIEN, OPENBUDO, OPENDIR, OPENSYS, OUTPARAM, PAIR, READAGAIN, REPERR, REWIND, REWRITE, SDSEARCH, SEG, SEGENTRY, SETALLOC, SETNCORE, SPARANOX, SSCOR, SSEARCH, TAPEOPEN, TESTREP, TRACE, TRANSBEG, TRANSFIN, UNLOAD, USEROPEN, VFREEW
- NEWOWN865.txt
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