ARCHIVE867
(George Source)
Macros used: ACROSS, BACKSPACE, BC, BITDEFS, BS, BXE, BXU, CHEKPRIV, CLOSETOP, DELETE, ELSE, ENDCOM, ERRORX, FC, FCBFIND, FI, FNORM, FREECORE, FULLBPAS, GEOERR, IF, JBC, JBS, JMBAC, JMBC, JMBS, LF, MENDAREA, MFREE, MFREEW, MHUNT, MHUNTW, MONOUT, NAME, NAMETOP, OFF, OPENDIR, OUTNUM, OUTPACKX, OUTPARAM, READ, READAGAIN, REPALLER, REWIND, REWRITE, SEG, SEGENTRY, SETNCORE, SPARAPAS, STEP, TESTNAMX, TESTREP, TESTREP2, THEN, TOPFCB, TREPN2, TRF, UNNORM
- ARCHIVE867.txt
225F ... SEG ARCHIVE,84,PETER CAMPBELL,DUMPSYS,G268 228Y ...[ 22#C ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 22CW ...[ THIS EXCLUDES CODE UNDER #SKI G268 22H* ...[ 22LS ...#OPT G268 = 0 22Q? ...#SKI G268&1 22TQ ...# WITH UGUG EDIT M268 (CHUCKOFF COMMAND) 22^= SEGENTRY K1ARCHIVE,X1ARCHIVE 23DW SEGENTRY K2ARCHIVE,X2ARCHIVE 23GD ... SEGENTRY K3ARCHIVE,X3ARCHIVE 23J2 ...#SKI G268&1 23KJ ...( 23M6 ...# 23NN ...# K3 ENTRY IMPLEMENTS THE READING VERSION OF CHUCKOFF (CK) 23Q= ...# WHICH CHECKS OWNERSHIP AS FOR THE ARCHIVE COMMAND AND CHECKS 23RS ...# IF THE FILE(S) MAY BE THROWN OFF AS BY THE BS UNJAMMER 23TB ...# RICHARD DANN 15AUG77 23WY ...) 23YG # 24D6 # THIS SEGMENT ENABLES A USER TO SPECIFY THAT CERTAIN OF HIS FILES 24XQ # SHOULD BE THROWN OFF-LINE WHEN THE BACKING-STORE UNJAMMER IS 25CB # BROUGHT IN.IT IS ALSO POSSIBLE TO "CANCEL" THIS SPECIFICATION. 25X2 # THE SEGMENT PICKS UP EACH PARAMETER OF THE "ARCHIVE" COMMAND IN 26BL # TURN,VALIDATES IT (WITH APPROPRIATE MESSAGES IF NOT VALID) AND 26W= # SETS BIT 9 IN WORD EINF2 OF THE DIRECTORY ENTRY FOR THE FILE 27*W # SPECIFIED (FOR ARCHIVE) OR UNSETS BIT9 FOR CANCEL ARCHIVE. 27TG # ALSO,ENABLES A USER HAVING "NOTOWNER" PRIVILEGE TO "ARCHIVE" AND 28*6 # "CANCEL ARCHIVE" FILES WHICH HE DOES NOT OWN ( BY SETTING AND 28SQ # UNSETTING B11 OF EINF2 RESPECTIVELY). IF SUCH A USER "ARCHIVES" OR 29#B # "CANCEL ARCHIVES" HIS OWN FILES, B9 AND B11 OF EINF2 ARE SET OR 29S2 # UNSET RESPECTIVELY. 2=?L # COMMAND ERRORS ARE GENERATED FOR ANY INVALID PARAMETERS BUT THE 2=R= # COMMAND IS FINISHED BEFORE THESE ARE DETECTED. 2?=W # 2?QG # THERE ARE TWO ENTRY POINTS: X1ARCHIVE FOR /ARCHIVE/ 2#=6 # X2ARCHIVE FOR /CANCEL ARCHIVE/ 2#PQ # 2*9B #SKI K6ARCHIVE 2*P2 # 2B8L # PRESET CONSTANTS NEEDED: 2BN= # 2C7W NOT 4HNOT 2CMG NOW 4HNOW 2G5L NOTOWNER 8HNOTOWNER 2HJG ONE +1 2J46 # 2JHQ # UNIVERSALS NEEDED FOR ERROR MESSAGES GENERATED WITHIN THIS SEGMENT: 2K3B # 2KH2 XARCHERX +ERNOTOWN [ERROR %B IN %A:YOU DO NOT OWN %C 2L2L XARCHERY +ERARCH [ERROR %B IN %A:%C MAY NOT BE ARCHIVE 2LG= XARCHERZ +JPARMIS [ERROR %A : PARAMETER MISSING 2L^W # SUBROUTINES USED ARE: 2MFG # "ONERR" - TO PUT OUT THE ABOVE ERROR MESSAGES 2M^6 # 2NDQ # "SUBPACKX" - TO OUTPUT A PARAMETER TO A GMON/ASET BLOCK 2NYB # 2PD2 # "RCHANGEBIT" - TO SET/UNSET BIT 9 OF EINF2 IN DIRECTORY ENTRY. 2PXL # 2QC= # ALL SUBROUTINES ARE CALLED ON X7 AND ALL COORDINATE. 2QWW # 2R44 BITDEFS AWORK2,0,XBMULTSPEC,XBMULTREAD,XBPARAMPRES,XBNOTOWNER 2R5R ...#SKI G268&1 2R7G ... BITDEFS AWORK2,4,XNOTYET 2R9= BITDEFS AWORK1,0,XBCCAR,XBAR 2R=6 ...#SKI G268&1 2R?2 ... BITDEFS AWORK1,2,XBCK 2R?W BITDEFS ATYPE,13,XBTAPE,,,XBWORK [SET IN FABSNB BY FNORM 2RBG ONERR 2RW6 SBX 7 FX1 2S*Q SMO FX1 2STB LDX 1 0(1) 2T*2 ERRORX 1 [PUT OUT ERROR MESSAGE & SET COMERR 2TSL ADX 7 FX1 2W#= EXIT 7 0 2WRW # 2X?G SUBPACKX 2XR6 SBX 7 FX1 2Y=Q OUTPACKX 4,5,6 2YQB ADX 7 FX1 2^=2 EXIT 7 0 2^PL # 329= RCHANGEBIT 32NW SBX 7 FX1 338G OWNERCHECK 33N6 MHUNTW 3,FILE,ENT 33Q* LDX 0 EINF2(3) 33SJ STO 0 AWORK3(2) 33WR LF 3,FEGMTRV,0 33^2 STO 0 AWORK4(2) 3439 # SRORE ORIGINAL VALUES OF BITS AND FIELD WHICH MAY BE CHANGED 345D # SO THAT IF THEY ARE NOT , THE BLOCKS NEED NOT BE RE WRITTEN 347Q TESTREP OK,ROK2 [J IF OWNS FILE 34=* #UNS FTS1 34#Y [ OR HAS ALLACC OR INFACC PRIVILEGE AND QUALIFER 34CH #UNS FTS1 34G6 #SKI 34JP ( 34MB JBC XLAB3,2,XBNOTOWNER 3572 # JUMP TO CE IF NOT PRIVILEGED 358? ) 359J #UNS FTS1 35=T ( 35#6 TESTREPN NOTOWNER,REPALLER [ J IF QUALIFER GIVEN IN ERROR 35*C JBS MANARCH,2,XBNOTOWNER [NOT OWNER JUMP IF HAS NOTOWNER PRI 35BN BRN XLAB3 [ ERROR YOU DO NOT OWN THIS FILE 35C^ REPALLER 35F= REPALLER [ GIVE ERROR REPLY 35GH BRN RCLOSED 35HS MANARCH 35K5 ) 35KK ...#SKI G268&1 35L5 ... JBS RUCHUCK,2,XBCK 35LL TRF 2,XBAR,3,BESYSARCH 366= # SET,CLEAR MANAGER ARCHIVE BIT 36KW BRN REST 36L8 ...#SKI G268&1 36LG ...( 36LS ...RUCHUCK 36M6 ... LDX 0 EALLOC(3) 36MD ... ANDN 0 #77 36MQ ... SBN 0 48 36N4 ... BPZ 0 XLAB4 36NB ... LDEX 0 ECOPS(3) 36NN ... BZE 0 RUOFFLINE [ALREADY OFFLINE 36P2 ... LDX 0 EINF2(3) 36P# ... BNG 0 RUWAIT [NOT YET - NOT DUMPED 36PL ...# SEE IF FILE IS IN USE 36PY ... FCBFIND 6,RULF 36Q= ... BRN RUWAIT [FOUND SO CANT CHUCK OFF 36QJ ...RULF 36QW ... LDX 0 EAUTOCOUNT(3) 36R8 ... BNZ 0 RUWAIT [NOT YET - BEING LISTED 36RG ... LDX 0 ESVCT(3) 36RS ... BNZ 0 RUWAIT [NOT YET - HLS SAVED 36S6 ...# OK TO CHUCK 36SD ... LDCT 4 #777 36SQ ... ANDX 4 ECOPS(3) [ X4 = FILE SIZE 36T4 ... IF BS,2,XBMULTSPEC 36TB ... THEN 36TN ... READ [ BLOCKS RECORD (MULTIFILE) 36W2 ... ELSE 36W# ... READAGAIN 36WL ... FI 36WY ... MHUNTW 1,FILE,FRB 36X= ... IF 4,NZ 36XJ ... THEN 36XW ... NAME 1,BSTB,FULLB 36Y8 ... FULLBPAS 1,2 [FREE THE BACKING STORE 36YG ... ELSE 36YS ... FREECORE 1 36^6 ... FI 36^D ... DELETE 36^Q ... MHUNTW 3,FILE,ENT 3724 ... LDCT 0 #777 372B ... ANDS 0 ECOPS(3) 372N ... BRN RUEX 3732 ...RUWAIT 373# ... BS 2,XNOTYET 373L ...RUOFFLINE [NO MESSAGE YET IF NOT ONLINE 373Y ... BRN REST 374= ...) 375G ROK2 37=N ...#SKI G268&1 37CW ... JBS RUCHUCK,2,XBCK 37K6 # OWS FILE SO SET,CLEAR ARCHIVE BIT 384Q TRF 2,XBAR,3,BEARCHIVE 38JB JMBAC REST,2,XBAR,XBNOTOWNER 3942 [ JUMP IF CC AR AND NOT PRIVILEGED 39HL JMBC RCLEAR,2,XBNOTOWNER,XBCCAR 39NS #UNS FTS1 39W2 TREPN2 OK,RCLEAR [ J IF OWNERACC QUALIFIER GIVEN 3=3= BC 3,BESYSARCH [ CC AR AND PRIVILEGED 3=GW RCLEAR 3?2G #SKI ARETRV 3?G6 ( 3?^Q JBC REST,2,XBAR 3#FB FC 3,FEGMTRV [ ARCHIVE SO CLEAR FIELD 3#^2 ) 3G#W REST 3GM? JBS RNOCOPIES,2,XBMULTSPEC 3G^N # JUMP IF JUST STEPPING THROUGH 3H#6 LDEX 4 ECOPS(3) 3HRQ BZE 4 RNOCOPIES [J IF NO ONLINE RECORDS 3J?B BACKSPACE [POSITION AS THOUGH JUST READ NAME 3JR2 MHUNTW 3,FILE,ENT 3K=L RNOCOPIES 3K*9 LF 3,FEGMTRV,4 3KCS LDX 0 EINF2(3) 3KGC TXU 0 AWORK3(2) [ SET C IF ARCHIVE BITS CHANGED 3KK2 TXU 4 AWORK4(2) [ OR FIELD CLEARED 3KMK BCC REXIT [ JUMP IF NO CHANGE 3KNF ...#SKI G268&1 3KP* ...RUEX 3KQ= NAMETOP 3,FILE,FWB 3L9W REWRITE [MAKE SURE RECORD IS WRITTEN BACK. 3LPG MHUNTW 1,FILE,FWB 3M96 NAMETOP 1,FILE,ENT 3MDY REXIT 3MNQ ADX 7 FX1 3N8B EXIT 7 0 3NN2 # 3P7L # AWORK1 .... USED TO DENOTE ARCHIVE(ZERO) OR CC ARCHIVE(NEGATIVE) 3PM= # AWORK2 .... B0 SET - PARAMETER SPECIFIED A MULTIFILE 3Q6W # B1 SET - AT LEAST ONE MULTIFILE COMPONENT HAS BEEN READ 3QLG # B2 SET - AT LEAST ONE PARAMETER PRESENT FOR THE COMMAND 3R66 # B3 SET - USER HAS THE "NOTOWNER" PRIV. 3RKQ # 3S5B # 3S6* ...#SKI G268&1 3S7# ...( 3S8? ...X3ARCHIVE [READING CHUCKOFF 3S9= ... STOZ AWORK1(2) 3S=9 ... BS 2,XBCK 3S?8 ... BRN RSTOZ 3S#7 ...) 3S*8 SEGENTRY K10ARCHIVE [FOR CSS ARCHIVE 3SK2 X1ARCHIVE 3SNF ...#SKI G268&1 3SRY ... STOZ AWORK1(2) 3SXC BS 2,XBAR [SET ARCHIVE BIT 3T9S BC 2,XBCCAR 3TJ= BRN RSTOZ 3TS4 SEGENTRY K20ARCHIVE [FOR CSS ARCHIVE 3W3W X2ARCHIVE 3W94 ...#SKI G268&1 3WB= ... STOZ AWORK1(2) 3WHG BC 2,XBAR [SHOW CNCEL ARCHIVE 3X36 BS 2,XBCCAR 3XGQ RSTOZ 3Y2B STOZ AWORK2(2) [UNSET ALL MARKERS 3YG2 CHEKPRIV JOB,NOTOWNER(1),RCOMMON,NOTOPEN 3Y^L BS 2,XBNOTOWNER [SHOW HAS NOTOWNER PRIVILEGS 3^F= RCOMMON 3^LD ...#SKI G268&1 3^RL ... BC 2,XNOTYET 3^YW BC 2,XBMULTSPEC [CLEAR MULTI FILE BIT 43CQ SPARAPAS [PICK UP A PARAMETER 43XB MHUNT 3,CPB,CUNI 44C2 LDX 5 ANUM(3) 44WL BNG 5 REND [J IF END OF PARAMETERS 45B= BS 2,XBPARAMPRES [ SHOW AL LEAST ONE PARAM READ 45TW BZE 5 RFREECUNI [J IF NULL PARAMETER 46*G NAMETOP 3,FILE,FNAME 46DL #UNS FTS1 46HQ FNORM 1 46LW #UNS FTS1 46Q2 #SKI 46T6 FNORM [PUT PARAM.DETAILS IN FILE/FABSNB 47#Q MHUNT 3,FILE,FNAME 47SB NAMETOP 3,CPB,CUNI 48#2 TESTREP2 NAMEFORM,RFREECUNI [J IF INCORRECT NAME FORMAT 48RL MHUNT 3,FILE,FABSNB 49?= JMBAC RNOTWORK,3,XBWORK,XBTAPE [JUMP IF WORKFILE OR TAPE 4==G LDN 1 XARCHERY 4=Q6 CALL 7 ONERR [MESSAGE "ERARCH". 4?9Q BRN RFREEFABSNB 4?PB RNOTWORK 4#92 OPENDIR XLAB2,GENERAL,QUERY 4#NL TESTREP2 OK,ROK1 [J IF FOUND FILE 4*8= REPAL 4*MW REPALLER [MESSAGES FOR UNEXPECTED REPLIES 4B7G BRN RFREECUNI 4BM6 ROK1 4C6Q MHUNTW 3,FILE,ENT [SET UP BY "OPENDIR" 4CLB LDX 0 ESER(3) 4D62 BNZ 0 XLAB4 [J IF A MAGNETIC TAPE 4DKL LDX 0 EUSE1(3) 4F5= BNZ 0 XLAB4 [J IF A DIRECTORY 4FJW JMBS XLAB4,3,BETEMP,BEONLINE,BEWORK 4FLD ...#SKI G268&1 4FN2 ...( 4FPJ ... JBS RMULTI,3,BEMDF 4FR6 ... IF BC,2,XBCK 4FSN ... THEN 4FW= ... JBS RMULTI,3,BEMULT 4FXS ... FI 4F^B ...) 4G2Y ...#SKI G268&1$1 4G4G JMBS RMULTI,3,BEMDF,BEMULT 4JGL CALL 7 RCHANGEBIT [SET/UNSET BIT 9 OF EINF2 4K2= BRN RMESSAGE 4KFW RMULTI 4K^G BS 2,XBMULTSPEC [SHOW MULTI FILE SPECIFIED BUT 4LF6 BC 2,XBMULTREAD [ NOT YET READ 4MY2 REWIND [BACK TO START OF DIRECTORY 4NCL RSTEP 4NX= STEP 4PBW BZE 3 RMESSAGE [J IF END OF DIRECTORY 4PWG LDX 0 ERES-A1(3) 4QB6 BNZ 0 RSTEP [J IF NOT NAME RECORD 4QTQ MHUNTW 1,FILE,ENT 4R*B TESTNAMX 3,ELOC1(1),ELOC1-A1(3),RDIFF [J IF NOT SAME LOCALNAME 4RT2 LDX 7 ELAN(1) 4S7C # DON'T GIVE UP LOOKING IF LANGUAGE CHANGES 4SFS BXU 7 ELAN-A1(3),RSTEP [J IF NOT SAME LANGUAGE 4SS= BS 2,XBMULTREAD 4T?W READAGAIN 4TRG MHUNTW 1,FILE,FRB 4W?6 NAME 1,FILE,ENT 4WQQ CALL 7 RCHANGEBIT [SET/UNSET BIT 9 OF EINF2 4X=B MFREE FILE,ENT 4XQ2 BRN RSTEP 4Y9L RDIFF 4YWD # BACK FOR MORE IF NOT READ 4YXP JBC RSTEP,2,XBMULTREAD 4Y^2 # DON'T STOP LOOKING UNTIL NAME KEY CHANGES 4^2? LDN 5 ELOC1(1) 4^3J SUM 4 3 [KEY FOR ORIGINAL ENTRANT 4^4T LDN 6 ELOC1-A1(3) 4^66 SUM 5 3 [KEY FOR THIS ENTRANT 4^7C BXE 4 5,RSTEP [KEEP LOOKING IF SAME KEY 4^8W RMESSAGE [A MULTIFILE COMPONENT 4^B4 ...#SKI G268&1 4^H= ... JBS RUMESS,2,XBCK 4^NG TOPFCB 3 5286 LDN 4 FME1(3) 52MQ LDN 5 3 537B LDN 6 JPDUSERNAME 53M2 CALL 7 SUBPACKX [OUTPUT USERNAME AS 1ST PARAMETER 546L MHUNTW 3,FILE,ENT 54L= LDN 4 ELOC1(3) 555W LDN 6 JPDLOCNAME 55KG CALL 7 SUBPACKX [OUTPUT LOCALNAME AS 2ND PARAMETER 5656 LDN 4 ONE(1) 56JQ LDN 5 1 574B LDN 6 JPDGENNUM 57J2 JBS RONE,2,XBMULTSPEC 583L MHUNTW 3,FILE,ENT 58H= LDN 4 EGEN(3) [RESET GENERATION NUMBER 592W RONE 59GG CALL 7 SUBPACKX [OUTPUT GEN.NO. AS 3RD PARAMETER 5=26 MHUNTW 3,FILE,ENT 5=FQ LDN 4 ELAN(3) 5=^B LDN 6 JPDLANGUAGE 5?F2 CALL 7 SUBPACKX [OUTPUT LANGUAGE AS 4TH PARAMETER 5?YL LDN 4 NOT(1) 5#D= JBC RNOT,2,XBAR [ JUMP IF CC AR 5*CG LDN 4 NOW(1) 5*X6 RNOT 5BBQ LDN 6 JPDVARCHAR 5BWB CALL 7 SUBPACKX [OUTPUT "NOT" OR "NOW" AS 5TH PARAM. 5CB2 MONOUT INCARCH [:%A.%B(%C/%D) %E ARCHIVED FILE 5CTL JBS RCLOSE,2,XBCCAR 5D*= # JUMP IF CC AR 5DSW MHUNTW 3,FILE,ENT 5F#G LDX 0 EALLOC(3) 5FS6 ANDN 0 #77 5G?Q LDX 6 0 [ AND IN X6 5GRB SRL 0 4 5H?2 SBN 0 3 5HQL BNG 0 RCLOSE [J IF NOT SPECIALLY ALLOCATED 5J== MHUNT 3,CPB,CUNI 5JPW LDEX 0 ANUM(3) 5K9G OUTPARAM 0,APARA,CPB,CUNI [FILENAME AS 1ST PARAMETER 5KP6 OUTNUM 6,0 [[ RES NO. AS 2ND PARAMETER 5L8Q MONOUT ARCHALLOC [ %A ARCHIVED BUT ALLOCATED TO 5LNB [ RESIDENCE %B 5M82 BRN RCLOSE 5M95 ...#SKI G268&1 5M=8 ...( 5M?? ...RUMESS 5M#B ... JBC RCLOSE,2,XNOTYET 5M*F ... SETNCORE 20,3,ADATA,CREADL [FOR UNNORM 5MBJ ... STOZ A1(3) 5MCM ... UNNORM TWO [GET FILENAME (AS IN RV MSG) 5MDQ ... MHUNTW 3,ADATA,CREADL 5MFT ... OUTPARAM A1(3),CPDATA,ADATA,CREADL 5MGY ... MONOUT JRUWAIT 5MJ3 ... MFREEW ADATA,CREADL 5MK6 ... BRN RCLOSE 5ML9 ...) 5MML XLAB2 5N7= GEOERR 1,NOT ARCH [BREAK-IN NOT ALLOWED 5NLW XLAB3 5P6G LDN 1 XARCHERX 5PL6 CALL 7 ONERR [MESSAGE "ERNOTOWN" 5Q5Q BRN RCLOSE 5QKB XLAB4 5R52 LDN 1 XARCHERY 5RJL CALL 7 ONERR [MESSAGE "ERARCH" 5S4= RCLOSE 5SHW CLOSETOP 5SRN RCLOSED 5T3G MFREEW FILE,ENT 5TH6 RFREEFABSNB 5W2Q MFREE FILE,FABSNB 5WGB RFREECUNI 5X22 MFREE CPB,CUNI 5XFL BRN RCOMMON [BACK FOR NEXT PARAMETER 5X^= REND 5Y?M JBS RSOME,2,XBPARAMPRES 5YL4 # JUMP IF AT LEAST ONE PARAM PRES 5YYG LDN 1 XARCHERZ 5^D6 CALL 7 ONERR [MESSAGE "JPARMIS" 5^XQ RSOME 62CB MFREE CPB,CUNI 62X2 ENDCOM 63BL MENDAREA 30,K99ARCHIVE 63FQ SEGENTRY K90ARCHIVE [FOR CSS ARCHIVE 63JW ACROSS ARCHIVNW,1 63N2 SEGENTRY K91ARCHIVE [FOR CSS ARCHIVE 63R6 ACROSS ARCHIVNW,2 63RJ ...#SKI G268 63S2 ...#SKI 63SD ...( 63SW ...X3ARCHIVE 63T# ... GEOERR 1,M268 OFF 63TQ ...) 63W= #END ^^^^ ...57024402000100000000