(George Source)
Macros used: ALTLEN, BUDGINCR, BXU, CLOSBUDG, CLOSETOP, COMBRKIN, COMERR, CONSERNO, DFLOAD, DOWN, ENDCOM, ERROR, FJOCA, GEOERR, GETDIR, HUNT, HUNT2, MENDAREA, MFREE, MHUNT, MONOUT, MTINFORM, NAME, OPEN, OPENBUDO, OUTPACK, OUTPARAM, PICKREP, PUTREP, RESET, SEG, SEGENTRY, SETNCORE, SETREP, SETUPCORE, TESTERR, TESTREP, UNLOAD, UP, UPPLUS, VFREEW
22FL SEG GET,6,N.R.BOULT,LIBRARY 22^= # 23DW SEGENTRY K1GET,QK1GET 23YG SEGENTRY K2GET,QK2GET 24D6 SEGENTRY K3GET,QK3GET 24XQ SEGENTRY K4GET,QK4GET 25CB # THIS SEGMENT WILL FETCH A MAGNETIC TAPE FROM THE POOL & W 25X2 # PUT AN ENRTY IN THE USERS DIRECTORY FOR THE TAPE, UPDATING T 26BL # ENTRY IN SYSTEM.SERIAL TO SHOW THE NEW OWNER . IT WIL OUT 26W= # VIA LIBREQ A REQUEST FOR THE TAPE TO BE LOADED & WHEN IT IS 27*W # THE HEADER LABEL WILL BE WRITTEN ACCORDING TO THE NEW ENTRY 27TG # THE DIRECTORY R ENTRY. THERE ARE TWO ENTRIES:- 28*6 # K1GET IS THE ENTRY FROM THE COMMAND VIA LIBCOM 28SQ # K2GET IS FROM THE GET MACRO (USED BY DOUMPER) 29#B # 29S2 WORK 12HWORK TAPE 2=?L 0,0 2=R= ZANUM #30021 2?=W ZDET 8H(/C1) 2?QG # 2#=6 # 2#PQ # 2*9B QK4GET 2*P2 LDN 7 1 [ENTRY MARKER 2B8L LDX 0 ACOMMUNE1(2) [SPECIAL PROPERTY DESCRIPTION 2BN= STO 0 AWORK3(2) 2C7W BRN PGO5 2CMG QK3GET 2D76 LDN 7 1 [ENTRY MARKER 2DLQ LDX 0 ACOMMUNE1(2) [SPECIAL PROPERTY DESCRIPTION 2F6B STO 0 AWORK3(2) 2FL2 BRN PGO6 2G5L QK2GET 2GK= NGN 7 1 [MARKER FOR THIS ENTRY 2H4W STOZ AWORK2(2) [INDICATE NO MODE 2HJG STOZ AWORK3(2) [NO SPECIAL PROPERTY DESCRIPTION 2J46 BRN T3 2JHQ QK1GET [COMMAND ENTRY 2K3B LDN 7 0 [MARKER FOR COMMAND 2KH2 LDN 4 0 2L2L HUNT 3,FLIB,FSPD 2LG= BNG 3 PGO6A 2L^W LDX 4 A1(3) 2MFG PGO6A 2M^6 STO 4 AWORK3(2) 2NDQ PGO6 2NYB STOZ AWORK2(2) [INDICATE NO MODE 2PD2 HUNT 3,FILE,FABSNB 2PXL LDX 0 ATYPE(3) 2QC= ANDN 0 #2000 [CHECK BIT TSN 2QWW BNZ 0 TSN [ERROR IF PRESENT 2RBG LDX 0 A1+4(3) [FIRST WORD OF LOCAL NAME 2RW6 BZE 0 NOLOCN [ERROR IF NO LOCAL NAME 2S*Q LDN 0 #777 2STB SMO HDREC(3) 2T*2 ANDS 0 A1-3(3) [TRUNCATE REEL NUMBER 2TSL PGO5 2W#= HUNT 3,FILE,FABSNB 2WRW LDX 0 ATYPE(3) 2X?G ANDN 0 #200 2XR6 BNZ 0 T3 [BRANCH IF WORKTAPE NAME 2Y=Q LDX 4 HDREC(3) 2YQB SBN 4 6 2^=2 SETUPCORE 4,3,FILE,FABSNB 2^PL LDN 0 0 329= DSA 0 ATYPE(3) [INDICATE FILE WANTED 32NW LDN 5 HDREC(3) 338G HUNT2 3,FILE,FABSNB 33N6 LDN 4 HDREC(3) 347Q LDX 3 HDREC(3) 34MB SBN 3 6 3572 MOVE 4 0(3) 35LL HUNT 3,FILE,FABSNB 366= LDN 0 6 36KW SBS 0 HDREC(3) 375G OPEN ZBRKIN,READ,QUERY [DIRECTORY 37K6 MFREE FILE,FABSNB 384Q TESTREPN OK,PGOX 38JB SETNCORE 6,3,FILE,FLOCNB [SET UP LOCAL NAME BLOCK 3942 HUNT 2,FILE,FABSNB 39HL SMO HDREC(2) 3=3= LDN 5 A1-6(2) 3=GW LDN 6 A1(3) 3?2G MOVE 5 3 3?G6 STOZ A1+3(3) [ZEROISE REEL NO 3?^Q STOZ A1+4(3) [GENERATION NO 3#FB STOZ A1+5(3) [LANGUAGE CODE 3#^2 LDN 0 0 [INDICATE FILE WANTED 3*DL DSA 0 ATYPE(3) 3*Y= GETDIR 3BCW TESTREP VRYWRONG,PGX [MAGTAPE OF THIS NAME PRESENT 3BXG PICKREP 5 3CC6 CLOSETOP [DIRECTORY 3CWQ PUTREP 5 3DBB MFREE FILE,FLOCNB 3DW2 TESTREP NOFILE,PGX4 [NO FILE OF THIS NAME PRESENT 3F*L TESTREPN OK,PGO5B [OK-THERE IS A FILE OF THIS NAME 3FT= SETREP ALREADY [A FILE OF THIS NAME 3G#W PGO5B 3GSG TESTERR ALREADY,PGO5C 3H#6 TESTERR WRGEN,PGO5C 3HRQ PGOX TESTREPN NOUSER,S1 3J?B SETREP NAME 3JR2 S1 3K=L TXU 7 ONE(1) 3KQ= BCC PGO5D [J IF GETONLINE 3L9W TESTERR NAME,PGO5C 3LPG PGO5C BZE 7 PGO9 3M96 PGO5D UPPLUS 1 3MNQ PGX4 HUNT 3,FILE,FABSNB 3N8B SMO HDREC(3) 3NN2 LDX 5 A1-2(3) [ILEGAL GENERATION NO 3P7L BPZ 5 PGO5A [IF NEGATIVE RELATIVE FGN SPECIFIED 3P#S ... SLL 5 1 3PG2 ... BZE 5 PGX4A [J IF -0 3PM= SETREP WRGEN 3Q6W BRN PGO5B 3Q9F ...[ MAKE -0 = +0 IF NO GENERATION EXISTS 3Q#4 ...PGX4A LDCT 5 #200 3QBM ... SMO HDREC(3) 3QF= ... STO 5 A1-2(3) 3QHT ... BRN PGO5A 3QLG PGX HUNT 3,FILE,FABSNB 3R66 LDCT 5 #600 3RKQ SMO HDREC(3) 3S5B ANDX 5 A1-2(3) [RELATIVE FGN SPECIFIED 3SK2 BNZ 5 RLGN [J. IF YES 3T4L CLOSETOP 3TJ= MFREE FILE,FLOCNB 3W3W BRN PGO5A 3WHG RLGN HUNT 2,FILE,FLOCNB 3X36 SMO HDREC(3) 3XGQ LDN 5 A1-6(3) [SET UP LOCAL NAME 3Y2B LDN 6 A1(2) [REEL NO AND FGN 3YG2 MOVE 5 5 3Y^L STOZ A1+5(2) 3^F= LDN 5 1 [INDICATE MAG TAPE WANTED 3^YW ORS 5 ATYPE(2) 42DG GETDIR 42Y6 PICKREP 5 43CQ CLOSETOP 43XB PUTREP 5 44C2 MFREE FILE,FLOCNB 44WL TESTREP OK,PGO5A [ALREADY A TAPE OF THIS NAME 45B= TESTREP WRGEN,PGO5B [ILLEGAL GENERATION NO 45TW TESTREPN NOFILE,PGEO [NO TAPE OF THIS NAME 46*G # UPDATE THE SPACEMT BUDGET 46T6 PGO5A 46YK ... SETNCORE 4,2,FILE,FABSNB 4744 ... HUNT2 1,FILE,FABSNB,2 477H ... LDN 0 4 47?2 ... STO 0 A1(2) 47BF ... ADN 1 A1+1 47FY ... ADN 2 A1+1 [COPY USERNAME TO FABSNB USED TO 47KC ... MOVE 1 3 [GET DICT ENT 47NW ... OPENBUDO PGERR 47SB LDN 5 1 48#2 BUDGINCR GSPACEMT,5 48RL TESTREP OK,PGO7 49?= TESTREP NOMORE,PGO7 [JUST TAKEN LAST ONE 49QW PICKREP 3 [KEEP ANY OTHER REPLY 4==G NGN 5 1 [RESET BUDGET 4=Q6 BUDGINCR GSPACEMT,5 4?9Q CLOSBUDG 4?PB PUTREP 3 4#92 TESTREP ODRAWN,T0 4#NL TESTREP INCREASE,T2 4*8= GEOERR BRIEFPM,BUDGREP 4*D4 ...PGERR GEOERR 1,NOUSERGT 4*MW T0 4B7G BZE 7 PGO1A [J IF GET COMMAND 4BM6 PGO2 PUTREP 3 4C6Q UPPLUS 1 [FINISH IF GETONLINE 4CLB T2 4D62 BNZ 7 PGO2 4DKL ERROR BUDGINC,BUDGSPA 4F5= BRN PGO1 4FJW PGO1A 4G4G ERROR BUDGODR,BUDGSPA 4GJ6 PGO1 ENDCOM [FINISH IF GET COMMAND 4H3Q PGO7 4HHB CLOSBUDG 4J32 # 4JGL T3 HUNT 3,FILE,FABSNB 4K2= LDX 4 HDREC(3) 4KFW LDX 5 ALOGLEN(3) 4K^G SBX 5 4 4LF6 ADN 4 2 4LYQ ALTLEN 3,4,FILE,FABSNB [EXTEND ABSNK TO CONTAIN TSN 4MDB BNZ 5 T5 [BRANCH IF BLOCK HOLDS RET. PERIOD 4MY2 HUNT 3,FILE,FABSNB 4NCL NGN 4 1 [RETENTION PERIOD = -1 4NX= SMO HDREC(3) 4PBW STO 4 HDREC(3) 4PWG T5 4QB6 LDN 4 0 4QTQ MHUNT 3,FILE,FABSNB 4R*B LDX 0 ATYPE(3) 4RT2 ANDN 0 #200 4S#L BZE 0 T5B [BRANCH UNLESS NAMED WORKTAPE 4SS= ORN 4 1 4T?W T5B 4TRG BXU 7 ONE(1),TFC [BRANCH UNLESS GETON 4W?6 ORN 4 2 4WQQ TFC 4X=B LDX 2 FX2 4XQ2 LDX 0 AWORK3(2) 4Y9L STO 0 ACOMMUNE1(2) 4YP= DOWN LIBREQC,1 [FIND A TAPE 4^8W BRN XBRKIN 4^NG TESTREPN OK,T4 5286 PGO11 52CY ... VFREEW FILE,ADJUNCTS 52MQ HUNT 3,FILE,FABSNB 537B SMO HDREC(3) [PICK UP SERIAL NUMBER OF 'GOT' TAPE 53M2 LDX 6 HDREC+1(3) 546L CONSERNO 6 [CONVERT SERIAL NUMBER TO CHARACTERS 54L= MHUNT 3,FILE,FABSNB 555W LDX 0 ATYPE(3) 55KG ANDN 0 #200 5656 BNZ 0 TFC2 [BRANCH IF NAMED WORKTAPE 56JQ HUNT 3,FLIB,FTSN 574B OUTPARAM A1(3),A1+1,FLIB,FTSN 57J2 MTINFORM GGET 583L TFC2 58H= MFREE FLIB,FTSN 592W BNZ 7 TFC1A 59GG DFLOAD ,TSN,3 5=26 TSJ1 5=FQ OUTPACK 3,1,TSN,TSJ1 5=^B TSJ2 5?F2 MHUNT 3,FILE,FABSNB 5?YL LDX 0 ATYPE(3) 5#D= ANDN 0 #200 5#XW BNZ 0 TSJ5 [J IF NAMED WORKTAPE 5*CG ADX 3 A1(3) 5*X6 OUTPACK A1-6(3),3,LOCNAME,TSJ2 5BBQ TSJ3 5BWB MHUNT 3,FILE,FABSNB 5CB2 ADX 3 A1(3) 5CTL OUTPACK A1-2(3),1,GENNUM,TSJ3 5D*= TSJ4 5DSW MHUNT 3,FILE,FABSNB 5F#G ADX 3 A1(3) 5FS6 OUTPACK A1-3(3),1,REELNUM,TSJ4 5G?Q BRN TSJ8 5GRB TSJ5 5H?2 LDX 2 FX1 5HQL OUTPACK WORK(2),3,LOCNAME,TSJ5 5J== TSJ6 5JPW LDX 2 FX1 5K9G OUTPACK WORK+4(2),1,GENNUM,TSJ6 5KP6 TSJ7 5L8Q LDX 2 FX1 5LNB OUTPACK WORK+3(2),1,REELNUM,TSJ7 5M82 TSJ8 5MML MONOUT FUSEDMT 5N7= TFC1A 5NLW TXU 7 ONE(1) 5P6G BCC PGO3 5PL6 LDN 3 0 5Q5Q UNLOAD ,3,3,AUT,RET 5QKB BNZ 7 T10 [BRANCH IF NOT A COMMAND 5R52 ENDCOM [END OF COMMAND 5RJL T10 SETREP OK [END OF MACRO 5S4= UP 5SHW PGO3 5T3G SETREP OK 5TH6 UPPLUS 1 5W2Q # NO POOL TAPES AVAILABLE 5WGB T14 5X22 BNG 7 T12 [BRANCH IF OPTIONAL GET 5XFL CALL 5 RESET [RESET BUDGETS UNLESS WORKTAPE 5X^= BZE 7 T14A 5YDW PUTREP 6 5YYG UPPLUS 1 5^D6 T14A 5^G* ... HUNT 3,FILE,FABSNB 5^JJ ... LDCT 0 #200 5^LR ... ANDX 0 ATYPE(3) 5^P2 ... BZE 0 POOL 5^R9 ... COMERR JNWTA 5^TD ...POOL 5^XQ COMERR JNPT [MESSAGE SAYING THERE ARE NO POOL TAP 62CB T12 HUNT 3,FILE,FABSNB [MACRO 62X2 LDX 4 HDREC(3) 63BL SMO 4 63W= LDX 0 HDREC(3) 64*W ADN 0 1 64TG BZE 0 T13 65*6 ADN 4 1 65SQ T13 66#B ALTLEN 3,4 [RESTORE BLOCK TO ORIGINAL LENGTH 66S2 SETREP NOTAV [NOTHING AVAILABLE 67?L UP 67R= # 68=W # ERROR REPORTS 68QG TSN 69=6 BZE 7 TSN1 69PQ SETREP TSN 6=9B UPPLUS 1 6=P2 TSN1 6?8L COMERR AMTDESC,JNTSN [SERIAL NUMBER GIVEN 6?N= NOLOCN 6#7W BZE 7 NOLOCN1 6#MG SETREP NOLOCN 6*76 UPPLUS 1 6*LQ NOLOCN1 6B6B COMERR AMTDESC,JLOCN [LOCAL NAME NOT GIVEN 6BL2 T4 6C5L PICKREP 6 6CK= TESTREP NOTAV,T14 6D4W TESTREP NOTUP,PGO4 6DJG TESTREP ALREADY,PGO4 6F46 TESTREP WRGEN,PGO4 6FHQ TESTREP VRYWRONG,PGO4 6G3B TESTERR NAME,PGO4 6GH2 TESTREP TEMP,T41 6H2L TESTREP NODECKS,TNOD 6HG= GEOERR 1,GET 6H^W T41 6JFG SETNCORE 7,3,CPB,CUNI 6J^6 FJOCA 2,2 6KDQ LDN 4 JNAME(2) 6KYB LDN 5 APARA(3) 6LD2 MOVE 4 3 6LXL LDN 4 ZDET(1) 6MC= ADN 5 3 6MWW MOVE 4 2 6NBG LDN 0 1 6NW6 ADX 0 7 6P*Q DSA 0 ATYPE(3) 6PTB STO 0 JPARNUM(3) 6Q*2 LDX 0 ZANUM(1) 6QSL STO 0 ANUM(3) 6R#= ERROR ERALREX 6RRW MFREE CPB,CUNI 6S?G PGO4 6SR6 BNG 7 T701 6T=Q CALL 5 RESET [RESET BUDGETS UNLESS WORKTAPE 6TQB BZE 7 PGO9 6W=2 PUTREP 6 6WPL UPPLUS 1 6X9= T701 6XNW PUTREP 6 6Y8G UP 6YN6 PGO9 6^7Q ENDCOM 6^MB TNOD 7272 BNG 7 TNOD2 72LL CALL 5 RESET 736= BZE 7 TNOD1 73KW PUTREP 6 745G UPPLUS 1 74K6 TNOD1 754Q COMERR ERNODECKS 75JB TNOD2 7642 PUTREP 6 76HL UP 773= # BREAKIN 77GW XBRKIN [BROKEN IN BEFORE POOL TAPE GOT 782G BNG 7 ZBRKIN [BRANCH IF GET MACRO 78G6 CALL 5 RESET [RESET BUDGETS UNLESS WORKTAPE 78^Q ZBRKIN 79FB BZE 7 PGO10 79^2 UP 7=DL PGO10 7=Y= COMBRKIN 7?CW RESET 7?XG SBX 5 FX1 7#C6 MHUNT 3,FILE,FABSNB 7#WQ LDX 0 ATYPE(3) 7*BB ANDN 0 #200 7*W2 BNZ 0 RES1 7*Y4 ... SETNCORE 4,2,FILE,FABSNB 7B26 ... HUNT2 1,FILE,FABSNB,2 7B48 ... LDN 0 4 7B6= ... STO 0 A1(2) 7B8# ... LDX 0 A1(1) 7B=B ... SBN 0 10 7B#D ... BZE 0 RES2 7BBG ... ADX 1 A1(1) 7BDJ ... SBN 1 12 7BGL ...RES2 7BJN ... ADN 1 A1+1 7BLQ ... ADN 2 A1+1 [SET UP USERNAME IN FABSNB TO 7BNS ... MOVE 1 3 [GET DICT ENT 7BR3 ... OPENBUDO RES1 7BT= NGN 3 1 7C#W BUDGINCR GSPACEMT,3 7CSG CLOSBUDG 7D#6 RES1 7DRQ ADX 5 FX1 7F?B EXIT 5 0 7FR2 PGEO 7G=L GEOERR 1,GETDIR [UNEXPECTED REPLY FROM GETDIR 7GQ= ONE +1 7H9W MENDAREA 50,K99GET 7HPG #END ^^^^ ...01303037000500000000