(George Source)
Macros used: BXU, CHAIN, CHANGEACT, CHANGEPER, CLOSETOP, COOR1, DCA, DELETE, DFJUMPS, DFLOAD, FREETAB, GEOERR, GETACT, GETDIR, GPERI, HUNT, HUNT2, INSERT, JOBLOCK, JWPR, KEEPREP, LGEOG, LOCK, LOCKC, LOGACCESS, MENDAREA, MFREE, MFREEW, MHUNT, MURDER, NAME, NAMETOP, OPENDIR, OPENSYS, PICKREP, PUTREP, READ, READAGAIN, REWIND, REWRITE, SDSEARCH, SEG, SEGENTRY, SETNCORE, SETREP, SETUPCORE, SETUPTAB, SSEARCH, TABSET, TABULATE, TESTREP, TRACE, UNLOCK, UP, UPPLUS, VFREE
22FL #OPT K0RENAMEMT=K0OLMT>K0ALLGEO 22^= #OPT K6RENAMEMT=K6OLMT>K6ALLGEO 23DW #LIS K0RENAMEMT 23JR ...[ 23NN ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 23SK ...[ 23YG SEG RENAMEMT,65,N.R.BOULT 24D6 SEGENTRY K1RENAMEMT,QK1RENAMEMT 24XQ SEGENTRY K2RENAMEMT,QK2RENAMEMT 25CB SEGENTRY K3RENAMEMT,QK3RENAMEMT 25X2 [THIS SEGMENT RENAMES A MAG TAPE & RECORDS THE CHANGES IN :SYSTEM.DOCUME 26BL [:SYSTEM.SERIAL AND THE APPROPRIATE USER DIRECTORY,IF ANY. 26W= [ 27*W [ON ENTRY THE CURRENT ACTIVITY IS THE CPA,AFTER WHICH THERE IS CHAINED 27TG [A BLOCK TYPE AONBS/GREN WHICH CONTAINS WORDS 1-7 OF THE PERI CONTROL 28*6 [AREA FOR MODE #500 IN WORDS A1-A1+6. 28SQ [ 29#B [ON EXIT THE CURRENT ACTIVITY IS STILL THE CPA,FOLLOWED BY THE AONBS/GRE 29S2 [A1 OF AONB/GREN IS SET TO THE TAPE SERIAL NO IF SUCCESSFUL, 2=?L [SET NEGATIVE IF FAILED. 2=R= SHDDR 4HHDDR 2?=W SLAN 4HC1 2?QG TACT [TYPE OF CPA 2#=6 #HAL CPAT,0 2#PQ # 2*9B # 2*P2 [ 2B8L [ENTRY POINT 2BN= [ 2C7W QK1RENAMEMT 2CMG STOZ AWORK1(2) 2D76 LDX 0 ACOMMUNE3(2) [WRITE/NOTWRITE HDDR MARKER 2DLQ STO 0 AWORK4(2) 2F6B STOZ AWORK3(2) [SET ENTRY MARKER 2FL2 BRN START 2G5L QK2RENAMEMT 2GK= STOZ AWORK1(2) 2H4W BRN Q1 2HJG QK3RENAMEMT 2J46 LDN 0 1 2JHQ STO 0 AWORK1(2) 2K3B Q1 2KH2 LDN 0 1 2L2L STO 0 AWORK3(2) [SET ENTRY MARKER 2LG= STOZ AWORK4(2) 2L^W START 2MFG LDX 5 ACOMMUNE2(2) 2M^6 STO 5 AWORK2(2) 2NDQ JWPR ,STAR1 [JUMP IF WRITE PERMIT RING FITTED 2NYB ...NOWPR UP 2PD2 STAR1 2PXL LDX 0 AWORK1(2) 2QC= BNZ 0 Q2 2QWW LDX 6 JOBNO(2) 2RBG GETACT AREWIND,,1 [GET ACTIVITY FROM WHICH TO CONTROL T 2RW6 LDX 3 BPTR(2) [LOAD POINTER TO NEW ACTIVITY 2S*Q STO 6 JOBNO(3) 2STB STO 5 AWORK2(3) 2T*2 LDX 6 AWORK3(2) 2TSL STO 6 AWORK3(3) 2W#= LDX 6 AWORK4(2) 2WRW STO 6 AWORK4(3) 2X?G STOZ AWORK1(3) 2XR6 CHANGEPER 3 [GIVE MT TO AREWIND ACTIVITY 2Y=Q HUNT 1,AONBS,GREN [LOOK FOR RENAME BLOCK 2YQB CHAIN 1,3 [CHAIN AFTER ACTIVITY 2^=2 CHANGEACT 3 [AND CHANGE INTO NEW ACTIVITY 2^PL Q2 329= LDN 6 0 [SET MARKER FOR STAGE 0-REWIND TAPE 32NW REWIND 32RF ... JWPR ,Q3CY 32W4 ... LDN 7 1 32YM ... BRN P6 333= ...Q3CY LDX 2 FX2 335T ... LDN 7 0 338G LDN 0 7 [REWIND MODE 33N6 DCA ,DLA,0,MODE 347Q PERI 34=W ... JWPR ,YPERI 34B2 ... LDN 7 1 34F6 ... BRN P6 34J= ...YPERI 34MB LOCKC 2,£ 3572 GPERI ,2 35LL COOR1 366= UNLOCK 2 36KW LDCH 4 CPRW1(2) [REPLY CHARACTER 375G #SKI K6RENAMEMT>199-199 37K6 TRACE 6,RNMTSWIT 384Q SMO 6 38JB BRN £ 3942 BRN P1 39HL NULL 3=3= BRN P3 3=GW BRN P4 3?2G BRN P5 3?G6 P1 3?^Q ANDN 4 4 3#FB BNZ 4 PFAIL [J TO EXIT IF FAILED 3#^2 LDX 4 AWORK2(2) 3*DL BNZ 4 P1A 3*Y= LDN 4 20 3BCW P1A 3BXG ... SETUPCORE 4,3,AONBS,GHDDR,1 3B^P ... STOZ A1(3) 3C3Y ... SBN 4 1 3C67 ... LDN 0 A1(3) 3C8B ... LDN 1 A1+1(3) 3C=K ... SMO 4 3C#S ... MOVE 0 0 3CC6 LDX 4 AWORK3(2) 3CWQ BNZ 4 P1B 3D*4 [ GET HEADER FROM :SYSTEM.DOCUMENT 3DRB OPENSYS XBRKIN,DOCUMENT,READ 3F9N SDSEARCH NOSD,CPPTR,CPPTR(2) 3FN2 READAGAIN 3G6# MHUNT 3,FILE,FRB 3GJL MHUNT 1,AONBS,GHDDR 3H2Y LDN 4 A1+1(3) 3HF= LDN 5 A1(1) 3HXJ MOVE 4 20 3J36 ... LDXC 4 A1+1(1) 3J6N ... BCS £ [TEST FOR XENOTAPE - REMOVE B0 3J== ... STO 4 A1+1(1) [RESTORE TSN 3J*W CLOSETOP 3JS8 BRN P3 3K=L P1B HUNT 1,AONBS,GREN 3KQ= LDN 4 A1+1(1) 3L9W LDN 5 A1+2(3) 3LPG MOVE 4 6 3M96 LDX 0 EDATE 3MNQ STO 0 A1+8(3) 3N8B SMO FX1 3NN2 LDX 0 SHDDR 3P7L STO 0 A1(3) 3PM= DFLOAD ,TSN,0 3Q6W BPZ 0 P1C [BRANCH UNLESS XENOTAPE 3QLG ERX 0 GSIGN 3R66 P1C 3RKQ STO 0 A1+1(3) 3S5B LDN 5 0 3SK2 BRN PA2A 3Y2B P3 3^F= SETNCORE 20,1,AONBS,HDRSAVE 3^YW HUNT 3,AONBS,GHDDR 42DG LDN 4 A1(3) 42Y6 LDN 5 A1(1) 43CQ MOVE 4 20 [PRESERVE OLD HEADDER NAME 43XB HUNT 1,AONBS,GREN 44C2 ... LDX 0 A1+1(3) 44WL STO 0 A1(1) [PUT TSN INTO RENAME BLOCK 45B= LDN 4 A1+1(1) 45TW LDN 5 A1+2(3) 46*G LDX 0 AWORK2(2) 46T6 BZE 0 P3A 47#Q SBN 0 2 47SB SMO 0 48#2 MOVE 4 0 48RL BRN P3B 49?= P3A 49QW MOVE 4 6 [PUT NEW NAME INTO HDDR BLOCK 4==G LDX 0 EDATE 4=Q6 STO 0 A1+8(3) [STORE TODAYS DATE IN HDDR BLOCK 4?9Q P3B 4?PB OPENSYS XBRKIN,SERIAL,READ 4#92 DFLOAD ,TSN,5 4#NL BNG 5 PA2 [J IF XENOTAPE 4*8= SSEARCH PA2,5 [LOOK FOR ENTRY IN :SYSTEM.SERIAL 4*MW LDCT 0 #200 4B7G ANDX 0 5(3) [PICK UP TEMPORARY BIT 4BM6 LDX 4 3(3) [LOAD USER NAME 4C6Q LDX 5 4(3) 4CLB LDX 3 2(3) 4D62 LDN 6 12 4DKL BZE 0 P3B1 [BRANCH UNLESS WORK TAPE 4F5= ADN 6 6 4FJW P3B1 4G4G CLOSETOP 4GJ6 SETUPCORE 6,2,FILE,FABSNB 4H3Q SBN 6 2 4HHB STO 6 HDREC(2) 4J32 STO 3 HDREC+1(2) [OWNERS NAME 4JGL STO 4 HDREC+2(2) 4K2= STO 5 HDREC+3(2) 4KFW SBN 6 10 4K^G BZE 6 P3B2 [BRANCH UNLESS WORK TAPE 4LF6 LDX 2 FX2 4LYQ JOBLOCK JOBNO(2),3 4MDB MHUNT 2,FILE,FABSNB 4MY2 LDN 4 JNAME(3) 4NCL LDN 5 HDREC+4(2) 4NX= MOVE 4 3 [JOB NAME 4PBW LDN 0 1 4PWG STO 0 HDREC+7(2) 4QB6 STO 0 HDREC+8(2) 4QTQ LDX 0 SLAN(1) 4R*B STO 0 HDREC+9(2) 4RT2 P3B2 4S#L SMO 6 4SS= LDN 3 HDREC+4(2) 4T?W LDN 4 1(3) 4TRG STOZ 0(3) 4W?6 MOVE 3 5 [ZERO LOCAL NAME 4WQQ NGN 0 1 4X=B STO 0 6(3) [NO RETENTION PERIOD 4XQ2 MHUNT 1,AONBS,GHDDR 4Y9L LDX 0 A1+1(1) 4YP= STO 0 7(3) [TSN 4^8W LDN 0 #2001 4^NG DSA 0 ATYPE(2) 5286 CALL 6 RENAME [CHANGE NAME IN DIRECTORY ENTRY 52MQ PICKREP 5 537B TESTREPN OK,OUT 53M2 BRN PA2A 546L PA2 54L= CLOSETOP 555W PA2A LDN 4 8 [ERASE MODE 55KG DCA ,DLA,4,MODE 5656 LDN 4 #3777 56JQ DCA ,STO,4,COUNT 574B LDN 6 3 [INDICATE ERASE TRANSFER 57J2 BRN PERI 583L P4 ANDN 4 4 58H= BNZ 4 PFA [J IF FAILURE 592W LDX 0 AWORK4(2) 5984 ...#UNS ILOGACC 59*= ... ANDN 0 1 59GG BNZ 0 P5A 5=26 HUNT 3,AONBS,GHDDR 5=FQ LOCKC 3,SERCHA 5=^B MHUNT 3,AONBS,GHDDR 5?F2 LDN 4 1 [WRITE MODE 5?YL DCA ,DLA,4,MODE 5#D= LDN 0 20 5#XW LDX 6 AWORK2(2) 5*CG BZE 6 P4A 5*X6 LDX 0 6 [LABEL LENGTH 5BBQ P4A 5BWB DCA ,STO,0,COUNT [HEAD 5CB2 LDN 4 A1(3) 5CTL DCA ,STO,4,CTSA [ADDRESS 5D*= LGEOG ,0 5DSW SLL 0 18 5F#G STO 0 A1+9(3) [SAVE GEOG NO IN CH 0 OF WD 9 5FS6 LDN 6 4 [INDICATE REWRITE HDDR TRANSFER 5G?Q BRN PERI 5GRB P5 UNLOCK 3 5H?2 ANDN 4 6 5HQL BNZ 4 PFA [J IF FAILURE 5J== P5A 5JPW DFJUMPS ,NONS,P5B [JUMP IF NON-STANDARD TAPE 5K9G # SYSTEM DOCUMENT IS NOT UPDATED IF THE TAPE IS NON-STANDAR 5KP6 OPENSYS XBRKIN,DOCUMENT,GENERAL 5L8Q PA5 SDSEARCH NOSD,CPPTR,CPPTR(2) 5LNB READAGAIN 5M82 HUNT 3,FILE,FRB 5MML HUNT 1,AONBS,GHDDR 5N7= LDN 4 A1(1) 5NLW LDN 5 A1+1(3) [MOVE NEW NAME ACROSS 5P6G MOVE 4 20 5PL6 NAME 3,FILE,FWB 5Q5Q REWRITE [REWRITE ENTRY IN SYS.DOC 5QKB CLOSETOP [CLOSE SYS.DOC 5R52 P5B 5RJL KEEPREP 5,OK [SET REPLY IF RENAME SUCCESSFUL 5S4= OUT 5SHW VFREE AONBS,GHDDR 5T3G VFREE AONBS,HDRSAVE 5T?# ...P6 5TH6 LDX 2 FX2 5W2Q LDX 0 AWORK1(2) 5WGB BNZ 0 Q3 5X22 CALL 0 SCA 5XFL CHANGEPER 3 [GIVE MT BACK TO CPA 5X^= HUNT 1,AONBS,GREN [FIND RENAME BLOCK 5YDW CHAIN 1,3 [CHAIN RENAME AFTER CPA 5YYG LDX 4 2 [REMEMBER ADDRESS OF REWIND BLOCK 5^D6 CHANGEACT 3 [CHANGE INTO CPA 5^XQ LOCK 4 62CB MURDER 4 [GET RID OF REWIND ACTIVITY 62M8 ... BNZ 7 NOWPR 62X2 Q3 63BL PUTREP 5 63W= TRACE 5,RENMTREP 64*W UPPLUS 1 64N? ...PFA BNZ 5 PFAIL [J IF INSECURE ENTRANT 652N DFLOAD ,TSN,0 657W BNG 0 PFAIL [J IF XENOTAPE 65*6 LDX 0 AWORK3(2) 65SQ BNZ 0 PFAIL 66#B MFREE AONBS,GHDDR 66S2 MHUNT 2,AONBS,HDRSAVE 67?L NAMETOP 2,AONBS,GHDDR 67R= CALL 6 RENAME [RESET NAME IN DIRECTORY ENTRY 68=W PFAIL 68QG KEEPREP 5,TAPEFAIL [SET REPLY IF TAPE FAILED 69=6 BRN OUT [J TO EXIT 69PQ XBRKIN 6=9B GEOERR 1,XBRKIN [GEOERR IF BREAKIN OCCURS 6=P2 NOSD GEOERR 1,NOSYSDOC 6?8L [SUBROUTINE WHICH SEARCHES FOR COMMAND ACTIVITY 6?N= SCA 6#7W LDX 3 2 [LOAD ADDRESS OF CURRENT ACTIVITY 6#MG SCA1 LDX 3 FPTR(3) [LOOK AT NEXT BLOCK 6*76 LDX 4 ATYPE(3) [TEST IF CPA 6*LQ SMO FX1 6B6B BXU 4 TACT,SCA1 [BRANCH IF NOT CPAT 6BL2 LDX 4 JOBNO(3) 6C5L TXU 4 JOBNO(2) [TEST IF CORRECT JOB NO 6CK= BCS SCA1 [IF NOT,J FOR NEXT 6D4W EXIT 0 0 [IF OK,EXIT 6DJG # SUBROUTINE TO CHANGE THE NAME IN THE DIRECTORY ENTRY 6F46 # TAPE SPECIFIED BY FILE/FABSNB (ZERO LOCAL NAME) 6FHQ # NEW NAME SPECIFIED BY AONBS/GHDDR 6G3B RENAME 6GH2 SBX 6 FX1 6H2L OPENDIR XBRKIN,GENERAL,ERASING,QUERY 6H43 ...#UNS FPGPT 6H5D ...( 6H6T ... MHUNT 3,FILE,ENT 6H8= ... LDX 0 EINCLOOK(3) 6H9M ... BPZ 0 PROC1 [J IF NOT IN USE BY DUMPER 6H?4 ... CLOSETOP 6H#F ... KEEPREP 5,DUMPTAPE 6H*W ... BRN OUT 6HC? ...PROC1 6HDN ...) 6HG= SETUPTAB 6H^W TABSET 6JFG SETNCORE 6,1,FILE,FLOCNB 6J^6 MHUNT 2,AONBS,GHDDR 6KDQ LDN 4 A1+2(2) 6KYB LDN 5 A1(1) 6LD2 MOVE 4 3 6LXL STOZ A1+3(1) 6MC= STOZ A1+4(1) 6MWW STOZ A1+5(1) 6NBG GETDIR 2 [IS NEW NAME IN USE BY FILE 6NW6 ... TESTREP NOFILE,S3,VRYWRONG,S3 6P*Q ...S3B CLOSETOP 6PTB MFREE FILE,FLOCNB 6Q*2 SETREP ALREADY 6QSL BRN S7 6R#= S3 6SR6 MHUNT 3,FILE,ENT 6TQB MHUNT 2,AONBS,GHDDR 6W=2 LDN 4 A1+2(2) 6WPL LDN 5 ELOC1(3) 6X9= MOVE 4 6 [PUT IN NEW NAME 6YN6 MHUNT 1,FILE,FLOCNB 6^7Q LDN 5 1 6^MB ORS 5 ATYPE(1) [SET MAG TAPE BIT 7272 LDN 5 A1(1) 72LL MOVE 4 5 [SET UP DETAILS FOR GETDIR 72^3 ... LDCT 0 #600 73?D ... ADN 0 #7777 73KW ANDX 0 A1+4(1) [GEN NO. 745G BNZ 0 S2F [J IF NOT ZERO OTHERWISE 74K6 LDCT 0 #100 [SET BIT INDICATING ZERO GEN. 754Q S2F STO 0 A1+4(1) 755D ... GETDIR 2 [CALCULATE NEW NAME BEFORE 7566 ... TESTREP OK,S2G,NOFILE,S2H [OLD ONE DELETED 756F ... TESTREP VRYWRONG,S3B 756S ... TESTREPN WRGEN,XGDER 757G ... CLOSETOP 7588 ... MFREE FILE,FLOCNB 758W ... SETREP WRGEN 759J ... BRN S7 75== ...XGDER 75=Y ... GEOERR 1,RENAMEGD 75?L ...S2G 75## ... MFREEW FILE,ENT 75*2 ...S2H 75*N ... TABULATE [GET BACK TO OLD ENTRY 75BB ... FREETAB 75C4 ... MHUNT 3,FILE,ENT 75CQ ... NAMETOP 3,FILE,FRB 75DD ... MHUNT 1,FILE,FLOCNB 75F6 ... MHUNT 2,AONBS,GHDDR [UPDATE GEN NO IN ENT & GHDDR 75FS ... LDX 0 A1+4(1) [FROM FLOCNB 75GG ... STO 0 EGEN(3) 75GM ... LDCT 4 #600 [ONLY UPDATE GEN. NO. 75GS ... ANDX 4 A1+6(2) [IN GHDDR IF RELATIVE 75G^ ... BZE 4 S2J [GEN. NO. GIVEN 75H8 ... STO 0 A1+6(2) 75HR ...S2J 75JB LDX 4 ENUSE(3) 7642 LDX 5 4 76HL ADN 5 1 773= BZE 4 S2C [J IF NO TRAP RECORDS 77GW S2A 782G READ [READ ENTRY 78G6 BCT 4 S2A 78^Q S2C 79FB LDX 4 5 79^2 S2B 7=DL DELETE [DELETE ENTRY 7=Y= BCT 4 S2B 7?2F ... MHUNT 1,FILE,FLOCNB 7?4N ... LDX 0 A1+4(1) [RESET GEN. NO. IN FLOCNB 7?6X ... BNZ 0 S2D [TO POSITION CORRECTLY 7?96 ... LDCT 0 #100 [IF GEN. 0 7??* ... STO 0 A1+4(1) 7?*J ...S2D 7?CW GETDIR 2 7?XG ... TESTREP OK,S4,NOFILE,S45 7#C6 GEOERR 1,RENAMEMT 7#WQ S4 7*25 ... MFREEW FILE,ENT 7*5D ...S45 7*8R ... MFREE FILE,FLOCNB 7*#8 ...#UNS ILOGACC 7**H ...( 7*BW ... LDX 4 5 7*D9 ...S45A HUNT2 2,FILE,FRB [LOCATE ENT 7*FJ ... BCT 4 S45A 7*GX ... NAMETOP 2,FILE,FWB 7*J= ... INSERT 7*KK ... TESTREP OK,S45B,FNEARLY,S45B 7*LY ... GEOERR 1,RENAMEMT 7*N? ...S45B MHUNT 1,FILE,FWB 7*PL ... NAMETOP 1,FILE,ENT [SAVE AS ENT 7*Q^ ... BCT 5 £ 7*S# ...) 7*W2 S4A LDX 4 5 7B*L S5 HUNT2 2,FILE,FRB 7BT= BCT 4 S5 7C#W NAMETOP 2,FILE,FWB 7CSG INSERT [PUT ENTRY IN NEW POSITION 7D#6 TESTREP OK,S6,FNEARLY,S6 7DRQ GEOERR 1,RENAMEMT 7F?B S6 7FR2 MFREE FILE,FWB 7G=L BCT 5 S4A 7G#* ...#UNS ILOGACC 7GB4 ...( 7GCR ... LDX 0 AWORK4(2) 7GFG ... BPZ 0 S6A 7GH9 ... LDN 5 CWRITE 7GJY ... LOGACCESS 2,5 7GLM ...S6A MFREE FILE,ENT 7GNB ...) 7GQ= CLOSETOP [CLOSE DIRECTORY 7H9W SETREP OK 7HPG S7 7J96 ADX 6 FX1 7JNQ EXIT 6 0 7K8B SERCHA 7KN2 HUNT 2,AONBS,GHDDR 7L7L EXIT 1 0 7LM= MENDAREA 50,K99RENAMEMT 7M6W #END ^^^^ ...33415765000200000000