(George Source)
Macros used: ALTLEN, CAPCA, CHECKEXT, CLOSETOP, COMERR, DFLOAD, DOWN, ENDCOM, ERROR, FSHCODE, FSHSKIP, GEOERR, GETWORD, HLSXONCH, ILLEGAL, JFREZFCB, LGEOG, MENDAREA, MFREE, MHUNT, MONOUT, MTHWSPD, OPEN, OUTMOVE, OUTPACK, OUTPAR, PICKREP, PROGBRKIN, PUTPERENT, PUTREP, RUNPROG, SEGENTRY, SETNCORE, SETUPMODE, SKIP, STEPBACK, TESTERR, TESTREP, TESTREPNOT, TOPFCB, TRACE, WORDFIN
22FL ...#LIS K0GETONA>K0LIBRARY>K0ALLGEO 22^= #SEG GETONA65 [N.R.BOULT 2357 ...[ 2394 ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 23#^ ...[ 23DW 8HGETONA 23YG # THIS SEGMENT CONTROLS IMPLEMENTATION OF 24D6 # UNANTICIPATED OPEN MODE PERI 24XQ [ MODE #400 25CB SEGENTRY K1GETONA,QK1GETONA 25X2 QK1GETONA 26BL [ENTRY POINT FOR MODE 400 UNANTICIPATED MT PERI 26W= ...#SKIP K6GETONA 27*W ... TRACE 2,GETONA2 27TG ANDX 4 REMPROP(1) 28*6 # SET UP FILE/FABSNB BLOCK AND FILL FROM OBJECT PROGRAM 28SQ SETNCORE 11,3,FILE,FABSNB 29#B LDN 6 9 29S2 CHECKEXT EVENT2(2),6,NOCA,,W,Q1,HLOCK1 2=?L Q2 2=R= LDN 7 A1+2(3) 2?=W OUTMOVE 2,EVENT2(2),7,6 2?QG LDX 7 EVENT2(2) [CONTROL AREA ADDRESS 2#=6 STO 4 AWORK1(2) 2#PQ STO 7 AWORK3(2) 2*9B MHUNT 3,FILE,FABSNB [TEST VALIDITY OF NEW NAME 2*P2 LDCH 0 A1+4(3) 2B8L SBN 0 #41 2BN= BNG 0 QILP [ERROR < A 2C7W SBN 0 #32 2CMG BPZ 0 QILP [ERROR > Z 2D76 LDN 1 11 [COUNT OF 11 2DLQ QVT1 BCHX 3 £ 2F6B LDCH 0 A1+4(3) 2FL2 SBN 0 #41 2G5L BPZ 0 QVT2 [J >= A 2GK= ADN 0 23 2H4W BNG 0 QVT [OK IF DIGIT 2HJG SBN 0 6 2J46 BZE 0 QVT [OK IF SPACE 2JHQ SBN 0 #15 2K3B BZE 0 QVT [OK IF HYPHEN 2KH2 BRN QILP 2L2L QVT2 SBN 0 #32 2LG= BPZ 0 QILP [ERROR > Z 2L^W QVT BCT 1 QVT1 [IF CHECK UNFINISHED,BACK FOR NEXT 2MFG BCHX 3 £ 2M^6 LDX 0 A1+4(3) 2NDQ SMO FX1 2NYB TXL 0 REELMAX 2PD2 BCC QILP [REEL NR OUT OF RANGE 2PXL LDN 0 #7777 2QC= ANDS 0 A1+5(3) [TRUNCATE GENERATION 2QWW LDX 3 EVENT3(2) 2RBG SRL 3 6 [PROPERTY CODE 2RW6 ANDN 3 #743 2S*Q LDN 6 0 2STB BZE 3 QPR9 [BRANCH IF NO PROPERTY SPECIFIED 2T*2 MTHWSPD 3,6 2TSL QPR9 2W#= # TRANSFER TO COMMAND ACTIVITY AND PREPARE TO GET TAPE 2WRW QVT3 2X?G CAPCA FILE,FABSNB 2XR6 HLSXONCH QBRKIN,AWORK1(2),QHLSIL [ASK HLS IF ANUVER TAPE ALLOWED 2Y=Q MHUNT 3,FILE,FABSNB 2YQB LDX 0 A1+9(3) 2^=2 STO 0 A1+10(3) [RETENTION PERIOD 2^PL STOZ A1+9(3) 329= LDN 0 CPREFIX(2) 32NW LDN 1 A1+1(3) 338G MOVE 0 3 [USER NAME 33N6 LDN 0 10 347Q STO 0 HDREC(3) [RECORD HEADER 34MB # CHECK OWNERSHIP OF TAPE 3572 LDX 0 ATYPE(3) 35LL ANDN 0 #200 366= BNZ 0 PO4 [BRANCH IF NAMED WORKTAPE 36KW LDX 0 HDREC(3) 375G SBN 0 10 37K6 BNG 0 PE1 384Q ADN 0 4 38JB STO 0 HDREC(3) [INSERT REDUCED LENGTH 3942 LDX 0 ACES 39HL SMO HDREC(3) 3=3= STO 0 A1+5(3) 3=GW NGN 0 #101 [REMOVE LANG CODE BIT 3?2G ANDS 0 ATYPE(3) 3?G6 PO1 3?^Q FSHCODE B,XFSHBOPEN 3#FB ( 3#^2 OPEN PG4,GENERAL,QUERY [OPEN DIRECTORY 3*DL XFSHBOPEN 3*Y= ) 3BCW FSHSKIP B,XFSHNBOPEN 3BXG ( 3CC6 OPEN PG4,READ,QUERY 3CWQ XFSHNBOPEN 3DBB ) 3DW2 TESTREP OK,P03 3F*L TESTERR NAME,TERR 3FT= TESTREP NOFILE,PE4 3G#W TESTREP VRYWRONG,PE4 3GSG TESTREP NOUSER,PE4 3H#6 GEOERR 1,REPLY 3HRQ P03 3J?B MHUNT 2,FILE,FABSNB [THE FABSNB NEEDS TO BE SET 3JR2 LDN 0 6 [TO CONTAIN :USER.LOCALNAME ONLY 3K=L ADS 0 A1(2) [THIS IS FOR LATER USE WHEN 3KQ= LDX 0 A1(2) [UPDATING BUDGETS 3L9W SBN 0 10 3LPG BZE 0 P02 3M96 LDX 3 2 3MNQ TOPFCB 1 3N8B ADN 1 FME1 3NN2 ADN 2 A1+1 3P7L MOVE 1 3 3PM= SMO A1(3) 3Q6W LDN 1 A1-6(3) 3QLG LDN 2 A1+4(3) 3R66 LDX 5 ALOGLEN(3) 3RKQ SBX 5 A1(3) 3S5B ADN 5 6 3SK2 SMO 5 3T4L MOVE 1 0 [MOVE LOCAL NAME UP FABSNB 3TJ= ADN 5 4 3W3W LDN 1 10 3WHG STO 1 A1(3) 3X36 ALTLEN 3,5,FILE,FABSNB 3XGQ P02 3Y2B TOPFCB 3 [X3 POINTS TO DIRECTORY'S FILE-FCB 3YG2 JFREZFCB 3,PERR3,NOADJ [TEST FOR FROZEN DIRS & OWNACC+INFACC 3Y^L OWNERCHECK NOADJ [CHECK OWNERSHIP;WITH PRIVS IF NECSRY 3^F= PICKREP 3 3^YW CLOSETOP [CLOSE DIRECTORY 42DG PUTREP 3 42Y6 TESTREP OK,P03D [OWNERSHIP OK? 43CQ LDX 0 5 43XB ANDX 0 MASKMON(1) 44C2 TXU 0 OWNMON(1) [OWN MONITORING REQUIRED? 44WL BCC Q4 [J TO SET B0 OF REPLY WORD ETC 45B= MONOUT ILACCFB [MF COMMENT - UNAUTHORISED ACCESS 45TW ... BRN Q7 [J FOR ILLEGAL MESSAGE 46*G P03D 46T6 MHUNT 3,FILE,FABSNB 47#Q PO4 47SB LDN 0 1 48#2 ORS 0 ATYPE(3) [NON-FILESTORE ENTRANT REQUIRED 48RL # GO TO GET TAPE 49?= LDX 1 FX1 49QW LDX 0 5 4==G ANDX 0 MASKMON(1) 4=Q6 TXU 0 OWNMON(1) 4?9Q BCS QN1 [NOT OWN MONITORING 4?PB SETUPMODE ,0,TAPEUP 4#92 BRN QN2 4#NL QN1 LDN 0 0 4*8= QN2 STO 0 AWORK2(2) [MODE 4*MW STO 6 ACOMMUNE1(2) [SPECIAL PROPERTY DESCRIPTION 4B7G DOWN GET,4 4BM6 BRN QBRKIN [J IF BREAKIN 4C6Q TESTREP OK,Q3 4CLB LDX 0 5 4D62 ANDX 0 MASKMON(1) 4DKL TXU 0 OWNMON(1) 4F5= BCC Q4 [J IF OWN MONITORING 4FJW TESTREP NOTAV,QN2A 4G4G TESTREPN NODECKS,PQ 4GJ6 QN2A 4H3Q NGN 4 1 4HHB BRN Q5 4J32 Q4 LDN 4 0 4JGL Q5 LDX 5 TFAIL(1) [FAIL REPLY 4K2= BRN Q6 4KFW Q1 MHUNT 3,FILE,FABSNB 4K^G BRN Q2 4LF6 NOCA MFREE FILE,FABSNB 4LYQ ILLEGAL NOCA 4MDB Q3 LDX 4 AWORK1(2) 4MY2 LDX 5 CPPTR(2) 4NCL PUTPERENT 4,5 4NX= OUTPAR TIMENOW 4PBW LGEOG 5,3 4PWG QSJ1 4QB6 OUTPACK 3,1,GEOPER,QSJ1 4QTQ QSJ2 4R*B OUTPACK 4,1,PERINAME,QSJ2 4RT2 DFLOAD 5,TSN,3 4S#L QSJ3 4SS= OUTPACK 3,1,TSN,QSJ3 4T?W QSJ4 4TRG MHUNT 3,FILE,FABSNB 4W?6 ADX 3 HDREC(3) 4WQQ OUTPACK A1-6(3),3,LOCNAME,QSJ4 4X=B QSJ5 4XQ2 MHUNT 3,FILE,FABSNB 4Y9L ADX 3 HDREC(3) 4YP= OUTPACK A1-2(3),1,GENNUM,QSJ5 4^8W QSJ6 4^NG MHUNT 3,FILE,FABSNB 5286 ADX 3 HDREC(3) 52MQ OUTPACK A1-3(3),1,REELNUM,QSJ6 537B OUTPAR SKIP 53M2 MONOUT JPER 546L DFLOAD 5,TSN,5 [LOAD TSN FOR REPLY TO PROG. 54L= LDN 4 0 555W Q6 LDX 7 AWORK3(2) 55KG ADN 7 1 5656 GETWORD 7,3,WRITE [SET REPLY 56JQ TESTREPNOT OK,PG2 574B STO 5 0(3) 57J2 WORDFIN 583L BNZ 4 Q7 58H= RUNPROG [RESTART PROGRAM 592W Q7 59GG LDX 4 AWORK1(2) 5=26 ANDN 4 #777 [PROGRAM UNIT UNUBER 5=FQ ... LDCT 0 5 5=^B ... ORX 4 0 5?F2 ... OUTPACK 4,1,PERINAME 5L8Q QPERF 5LNB ILLEGAL PERFAIL1 5M82 QILP ILLEGAL ILLINS 5MML # ERROR REPORTING 5N7= QHLSIL 5NLW MONOUT ERHLSMODE 5P6G LDX 0 5 5PL6 ANDX 0 MASKMON(1) 5Q5Q TXU 0 OWNMON(1) 5QKB BCC Q4 [J IF OWN MONITORING 5R52 BRN QN2A 5RJL PERR3 5S4= CLOSETOP 5SHW LDX 0 5 5T3G ANDX 0 MASKMON(1) 5TH6 TXU 0 OWNMON(1) [IF OWN MONITORING REQD - 5W2Q BCC Q4 [J TO SET B0 OF REPLY WORD ETC 5WGB MONOUT FROZDIRFB [ELSE GIVE MF COMMENT - DIR FROZEN 5WHR ... BRN Q7 [AND GIVE MT FAIL MESSAGE 5WK8 ...PQ 5WLK ... TESTREPN ODRAWN,PQ1 5WN2 ... ERROR BUDGODR,BUDGSPA 5WPC ...TERR ENDCOM 5WQS ...PQ1 5WS9 ... TESTREPN INCREASE,PQ2 5WTL ... ERROR BUDGINC,BUDGSPA 5WX3 ... BRN TERR 5WYD ...PQ2 5W^T ... TESTREP ALREADY,TERR 5X3= ... TESTERR NAME,TERR 5X4M ... TESTREP WRGEN,TERR 5X64 ... TESTREP VRYWRONG,TERR 5X7F ... TESTREP TEMP,TERR 5X8W ... TESTREP NODECKS,PE5 5X=? ... GEOERR 1,GETREP 5X?N ...PE1 COMERR AMTDESC,JLOCN [SERIAL NUMBER GIVEN 5X*5 ...PE4 5XBG ... COMERR ERNAME 5XCX ...PE5 COMERR ERNODECKS 5XFL # BREAKIN EXITS 5X^= QBRKIN 5YDW STEPBACK 5YYG MFREE FILE,FABSNB 5^D6 PROGBRKIN 5^XQ # CONSTANTS 62CB QTEN 100 62X2 QMT #55640000 64TG OWNMON #34000 65*6 MASKMON #76000 65SQ TFAIL #40000000 68=W REMPROP #77700077 68GN ...REELMAX +512 68QG # GEORGE ERRORS 69PQ PG2 GEOERR BRIEFPM,SHORTBLK 6=P2 PG4 GEOERR BRIEFPM,BREAKIN 6?8L MENDAREA 1023-0?,K99GETON 6?N= #END ^^^^ ...447373500001