(George Source)
Macros used: BACKSPACE, BC, BS, BWNZ, BWZ, BXE, CHEKPRIV, CLOSETOP, COMBRKIN, COMERR, DICTJL, DICTWELL, ENDCOM, ERROR, FINDFCB, FNORM, FREECORE, FSHCODE, FSHENTRY, FSHSKIP, GEOERR, GETJOB, JBC, JBS, LONGONALL, MENDAREA, MFREE, MFREEW, MHUNT, MHUNTW, NAME, NAMETOP, OPENDIR, OPENSYS, POP, READDICT, REPALLER, REWRITE, SEG, SEGENTRY, SETNCORE, SPARAPAS, STEPAGAIN, TESTRPN2, TRANCHKN, TRANSBEG, TRANSFIN, UNIFREE, VOP
22FL SEG FREEZE,84,MIKE PUTNAM,USERCOMS 22^= # 23DW # THIS SEGMENT IMPLEMENTS THE FREEZE AND CANCEL FREEZE 23YG # COMMANDS. ENTRY 1 = FREEZE, ENTRY 2= CC FREEZE. 24D6 # 24XQ SEGENTRY K1FREEZE,X1 25CB SEGENTRY K2FREEZE,X2 25M8 ... FSHENTRY K3FREEZE,X3,,X3 25X2 # 2648 ... FSHSKIP B 269B ...( 26BL PRIV 8HFREEZE 26C? ...USERJ 24HJOBLIST 00010001**** 26CY ...# 26DK ...SFABS MHUNT 2,FILE,FABSNB [SR TO LOCATE FABS FOR ALTLENG 26F= ... EXIT 1 0 26FX ...# 26GJ ...YJOBNO [SR TO PUT X0 JOBNO INTO FILE FINTER 26H9 ... [CALLED ON X2 26HW ... SMO FX2 26JH ... STO 2 ACOMMUNE1 [SAVE LINK 26K8 ... LDX 7 0 [MHUNT USES X0 26KT ... MHUNTW 2,FILE,FINTER 26LG ... LDX 0 A1(2) [COUNT OF NOS IN FINTER 26M7 ... SBN 0 199 [HAS IT OVERFLOWED 26MS ... BZE 0 STARTJOBS [J IF SO 26NF ... ADN 0 200 [RESTORE AND INCREMENT BY 1 26P6 ... SMO 0 26PR ... STO 7 A1(2) [STORE NUMBER 26QD ... STO 0 A1(2) [STORE UPDATED COUNT 26R5 ... SMO FX2 26RQ ... LDX 2 ACOMMUNE1 26SC ... EXIT 2 0 [EXIT 26T4 ...# 26TM ...) 26W= # 27*W X1 LDN 6 0 [SET K1 ENTRY MARKER 27TG MAINCODE [SEGMNT IS MOSTLY COMMON TO BOTH 27W9 ...# 27WY ...X3 27XM ...# 27YB ... FSHCODE B,XENDB1 27^5 ...( 27^S ...# THE FREEZE COMMAND IS AN 'A' MACHINE FUNCTION. SO TRANSFER TO 282H ...# 'A' IF WE ARE STARTED ON 'B' 283= ...# 283^ ... TRANSBEG FSHFZCOMID,FREEZE,3,CLB,,ACOMMUNE1 284N ...# 285C ... BRN XCOMBRK [BREAK-IN RETURN POINT 2866 ... ENDCOM [ENDCOM RETURN POINT 286T ...# 287J ...XCOMBRK 288? ... COMBRKIN 2892 ...# 289P ...XENDB1 28=D ...) 28?7 ... FSHSKIP B,XNOTBX 28?W ...( 28*6 CHEKPRIV ,PRIV,XPRIV [CHECK USER HAS FREEZE PRIV 28SQ LDN 7 0 [CLEAR PARAMS FOUND MARKER 29#B NEXTPAR 29S2 SPARAPAS 2=?L MHUNT 3,CPB,CUNI 2=R= LDX 0 ANUM(3) 2?=W BNG 0 THEEND [J IF NO MORE PARAMS 2?QG LDN 7 1 [SET PARAMS FOUND MARKER 2#=6 BZE 0 NULLPAR [NULL PARAMS NOT ALLOWED 2#PQ NAMETOP 3,FILE,FNAME [RENAME CPB CUNI FOR FNORM. 2*9B FNORM [NORMALIZE ENTRANT NAME 2*P2 MHUNT 3,FILE,FNAME 2B8L NAMETOP 3,CPB,CUNI [NAME IT BACK FOR ERROR MSSGE CODE 2BN= TESTRPN2 OK,NUNI [J IF NAME IN ERROR 2BRC ... 2BSD ... MHUNT 3,FILE,FABSNB 2BS^ ... LDN 0 #2200 [ERROR IF TSN OR WF FORMAT 2BTG ... ANDX 0 ATYPE(3) 2BW3 ... BNZ 0 XTSN 2BWJ ... BNZ 6 NFREEZE3 2B^P ...# 2C4W ...# IN THE FREEZE CASE WE MUST CHECK AND ERROR IF THE PARAMETER IS 2C83 ...# A DIRECTORY WITH STARTED JOBS RUNNING UNDER IT. WE TEST THIS BY 2C?8 ...# 2CB* ...# 1)OPENING THE SUPERIOR DIRECTORY AND CHECKING PARAM IS A DIR. 2CFG ...# 2CJM ...# 2)JUMPING INTO THE FREEZE CODE IF IT IS NOT. 2CMS ...# 2CQ^ ...# 3)WE SET UP A FILE/FINTER BLOCK AND ACCUMULATE A LIST OF JOBNOS 2CW6 ...# FOR THIS USER FROM THE JOB + HLS QUEUES (I.E. THE STARTED JOBS) 2C^? ...# IF THERE ARE NONE WE PROCEED WITH THE FREEZE. 2D4D ...# 2D7K ...# 4) WE OPEN :SYSTEM.JOBLIST(/B1) AND CHECK THAT ALL THE JOBS 2D=Q ...# MAY RUN UNDER A FROZEN USER. 2D*X ...# 2DF4 ...SEMWT POP SEMWT,,JWACCESS [LOCK OUT JOBWELL CODE 2DJ9 ... OPENDIR YBREAK,CLEAN,QUERY,NOWAIT[OPEN SUP DIR 2DMB ... TESTRPN2 OK,NOTOK [J IF NOTOK REPLY 2DQH ... MHUNTW 3,FILE,ENT 2DTN ... BWZ EUSE1(3),NOTDIR [J IF ITS NOT A DIRECTORY 2DYT ... LDX 4 EUSE2(3) [GET USERNAME OF THE DIR 2F42 ... LDX 5 EUSE3(3) 2F77 ... LDX 3 EUSE1(3) [FOR COMPARING WITH JOBQ BLOCKS 2F=# ... CLOSETOP [CLOSE DIRECTORY 2F*F ... MFREEW FILE,ENT 2FDL ...# 2FHR ...# WE SET UP A FILE/FINTER BLOCK AND ACCUMULATE A LIST OF JOBNOS OF 2FLY ...# JOBS UNDER THE USER WHICH ARE STARTED I.E. ARE IN THE JOB OR HSLQ. 2FQ5 ...# THE FORMAT OF THE BLOCK IS A1=COUNT OF JOBS, A1+1 ETC =JOBNOS 2FT= ...# WE DARE NOT COORDINATE DURING THE SEARCH SO WE MAKE THE CRUMMY 2FYC ...# BUT NOT UNREASONABLE ASSUMPTION THAT THERE WILL BE LESS THAN 200 2G3J ...# SUCH JOBS. IF THE FINTER OVERFLOWS WE MAKE THE EQUALLY CRUMMY 2G6P ...# ASSUMPTION THAT AT LEAST 1 OF THE 200 MUST BE UNPRIVILEGED TO 2G9W ...# RUN IN A FROZEN DIRECTORY 2G*3 ...# 2GD8 ... SETNCORE 200,2,FILE,FINTER 2GH* ... STOZ A1(2) 2GLG ... LDX 1 BJOBQ [X1->1ST BLOCK IN JOBQ 2GPM ...TESTJOB 2GSS ... BXE 1 CXJO,NDJOBQ [J IF END OF JOBQ 2GX^ ... LDX 0 ATYPE(1) 2H36 ... SRL 0 12 [CHECK ITS A BLOCK WE WANT 2H6? ... ERN 0 JOBQE 2H9D ... BNZ 0 NEXTJBLOCK [J IF NOT 2H#K ... TXU 3 JUSER(1) 2HCQ ... TXU 4 JUSER+1(1) 2HGX ... TXU 5 JUSER+2(1) [IS IT OUR USER 2HL4 ... BCS NEXTJBLOCK [J IF NOT 2HP9 ... LDX 0 JOBNUM(1) 2HSB ... CALL 2 YJOBNO [ADD JOBNO TO FINTER 2HXH ...NEXTJBLOCK 2J2N ... LDX 1 FPTR(1) [MOVE ONTO NEXTBLOCK 2J5T ... BRN TESTJOB [LOOP ROUND 2J92 ...NDJOBQ 2J#7 ... LDX 1 BHLSQ [NOW SEARCH THE HLSQ 2JC# ...TESTHLS 2JGF ... BXE 1 CXHL,NDHLSQ [J IF END OF HLSQ 2JKL ... LDX 0 ATYPE(1) 2JNR ... SRL 0 12 [CHECK ITS A BLOCK WE WANT 2JRY ... ERN 0 ADATA+JSWAP 2JX5 ... BNZ 0 NEXTHBLOCK [J IF NOT 2K2= ... TXU 3 HLSUNAM(1) 2K5C ... TXU 4 HLSUNAM+1(1) [IS IT OUR USER 2K8J ... TXU 5 HLSUNAM+2(1) 2K?P ... BCS NEXTHBLOCK [J IF NOT 2KBW ... LDX 0 HLSJONO(1) 2KG3 ... CALL 2 YJOBNO [PUT JOBNO IN FINTER 2KK8 ...NEXTHBLOCK 2KN* ... LDX 1 FPTR(1) [MOVE ONTO NEXT BLOCK 2KRG ... BRN TESTHLS 2KWM ...NDHLSQ 2K^S ... MHUNTW 3,FILE,FINTER 2L4^ ... LDX 5 A1(3) [COUNT OF STARTED JOBS 2L86 ... BZE 5 PROCEED [J IF NONE 2L?? ... OPENSYS YBREAK,JOBLIST,READ [OPEN JOBLIST 2LBD ... TESTRPN2 OK,(GEOERR) 2LFK ...NXSJREC 2LJQ ... MHUNTW 3,FILE,FINTER 2LMX ... SMO 5 2LR4 ... LDX 4 A1(3) [PICK UP NEXT JOB NO 2LW9 ... GETJOB 4,SYSTEM [LOCATE RECORD 2L^B ... TESTRPN2 OK,(GEOERR) 2M4H ... STEPAGAIN [X3->RECORD 2M7N ... ADX 3 JOBDATASIZE 2M=T ... JBC STARTJOBS,3,JLBFROZEN [J IF USER MAY NOT BE FROZEN 2MB2 ... BCT 5 NXSJREC [LOOP IF MORE JOBS TO CHECK 2MF7 ... CLOSETOP [CLOSE JOBLIST 2MJ# ...PROCEED 2MMF ... MFREEW FILE,FINTER 2MQL ...NOJOBS [PARAM IS DIRECTORY WITHOUT JOBS 2MTR ... [STARTED AND UNPRIVILEGED 2MYY ...# 2N45 ...# THE BASIC ACTION OF FZ AND CC FZ IS SIMPLE. WE OPEN THE SUP 2N7= ...# DIR, SET OR CLEAR THE FZ BIT, REWRITE THE RECORD AND CLOSE THE DIR. 2N=C ...# SOME FURTHER ACTIONS ARE NECESSARY FOR DIRECTORIES. 2N*J ...# 2NDP ...NFREEZE3 2NHW ... OPENDIR YBREAK,CLEAN,QUERY,NOWAIT [OPEN SUP DIR. 2NM3 ... TESTRPN2 OK,NOTOK [J IF NOT OK 2NQ8 ...NOTDIR 2NT* ... MHUNTW 3,FILE,ENT 2NYG ... JBS XMULTEL,3,BEMULT [NOT ALLOWED TO FREEZE ELEMS OF MULTS 2P3M ... JBS XTEMPDIR,3,BETEMP [OR TEMP DIRS 2P6S ... JBS XLIBENT,3,BELIB [OR TAPES 2P9^ ...REWRITE 2P*6 ... BZE 6 YFREEZE1 [J IF FREEZE COMMAND 2PD? ... BC 3,BEUSERFREZ [CANCEL SO CLEAR THE BIT 2PHD ... BRN NFREEZE1 2PLK ...YFREEZE1 2PPQ ... BS 3,BEUSERFREZ [SET THE BIT 2PSX ...NFREEZE1 2PY4 ... LDEX 0 ECOPS(3) 2Q39 ... BZE 0 NOBACK 2Q6B ... BACKSPACE [SKIP OVER BLOCKS REC IF ANY 2Q7Y ... MHUNTW 3,FILE,ENT 2Q9H ...NOBACK 2Q#N ... NAME 3,FILE,FWB 2QCT ... REWRITE 2QH2 ... MHUNTW 3,FILE,FWB 2QL7 ... NAME 3,FILE,ENT 2QP# ... BWNZ EUSE1(3),YDIR [J IF JUST FROZEN DIR 2QSF ...NDIR CLOSETOP [CLOSE THE UPDATED DIRECTORY 2QXL ...NENT MFREEW FILE,ENT 2R2R ...NFAB MFREE FILE,FABSNB 2R5Y ... BNZ 6 NUNI 2R95 ... VOP ,JWACCESS [IF FREEZE CASE RELEASE JW SEMA 2R#= ...NUNI UNIFREE 2RCC ... BRN NEXTPAR [J TO PROCESS NEXT PARAM 2RD8 ...# 2RD^ ...XNOTBX 2RFQ ...) 2RGJ ...# 2RKP ...X2 LDN 6 1 [SET X2 ENTRY MARKER 2RNW ... BRN MAINCODE 2RS3 ...# 2RT4 ... FSHSKIP B,XNOTBY 2RW5 ...( 2RX8 ...YBREAK 2S2* ... BNZ 6 NFREEZE6 2S5G ... VOP ,JWACCESS [IN FZ CASE RELEASE JWELL SEMA 2S8M ...NFREEZE6 2S8W ... FSHCODE A,XNOTB1 2S95 ...( 2S9# ...# SHARED FILESTORE: WE MUST RETURN TO 'B' IF WE STARTED THERE 2S9H ...# 2S9Q ... TRANCHKN FSHFZCOMID,EQUAL,XNOTB1,XNOTB1 2S9^ ...# 2S=8 ... LDN 3 0 [SET BREAK-IN OFFSET 2S=C ...# 2S=L ...XFIN TRANSFIN 3 [AND GO BACK TO 'B' 2S=T ...# 2S?4 ...XNOTB1 2S?? ...) 2S?S ... COMBRKIN [BREAKIN WHILE OPENING DIR OR JOBLIST 2SB^ ...# 2SG6 ... 2SK? ...# 2SND ...# THE FOLLOWING CODE IS NECESSARY WHEN FREEZENG/CC FZ ING A DIRECTORY. 2SRK ...# WE MUST UPDATE THE DICTIONARY AND INFORM THE JOB HANDLING CODE OF 2SWQ ...# THE USERS CHANGE OF STATE, SO IT CAN ADJUST THE RECORDS FOR ANY 2S^X ...# WELL JOBS BELONGING TO HIM. 2T54 ...# 2T89 ...YDIR 2T?B ... CLOSETOP [DIRECTORY 2TBH ... OPENSYS YBREAK,DICTIONARY,GENERAL 2TFN ... MHUNTW 3,FILE,ENT 2TJT ... READDICT ,EUSE1(3) [LOCATE AND READ DOWN USERS RECORD 2TN2 ... TESTRPN2 OK,REPLYQY 2TR7 ... MHUNT 3,FILE,ADICTENT [X3->TO RECORD 2TW# ... BNZ 6 NFREEZE4 [J IF CC FREEZE 2T^F ... BS 3,BFROZEN [SET BIT FOR FREEZE CASE 2W4L ... BRN YFREEZE4 2W7R ...NFREEZE4 2W=Y ... BC 3,BFROZEN [CLEAR BIT 2WB5 ...YFREEZE4 2WF= ... NAME 3,FILE,FWB 2WJC ... REWRITE [REWRITE THE RECORD 2WMJ ... MFREEW FILE,FWB 2WQP ... MHUNTW 3,FILE,ENT 2WTW ... JBS YFREEZE5,3,BNPSEUDO [DONT TELL JW ABOUT FZ ON PSEUDO 2W^3 ... BNZ 6 NFREEZE5 [J IF CC FREEZE 2X48 ... DICTWELL EUSE1(3),FREEZE,,ON [TELL JWELL USER IS FROZEN 2X7* ... BRN YFREEZE5 2X=G ...NFREEZE5 2X*M ... DICTWELL EUSE1(3),FREEZE,,OFF[TELL JWELL THE FREEZE IS CANCELLED 2XDS ...YFREEZE5 2XH^ ... CLOSETOP [DICTIONARY 2XM6 ...# 2XQ? ...# ALL THAT REMAINS TO DO IS THE SETTING OF THE BIT IN THE FCB IF IT 2XTD ...# IS IN CORE. 2XYK ...# 2Y3Q ... LDN 4 6 2Y=Q LDX 5 3 2YQB FINDFCB 4,3,NORC 2^=2 TESTRPN2 OK,NOTFOUND 2^PL BZE 6 YFREEZE2 [J IF ITS FREEZE 329= BC 3,BFUSERFREZ [CLEAR BIT IF CANCEL 32NW BRN NFREEZE2 338G YFREEZE2 33N6 BS 3,BFUSERFREZ [SET BIT 347Q NFREEZE2 34MB NOTFOUND 3572 LDX 3 5 35LL ... BRN NENT [BACK TO MAIN LINE CODE 366= # 36KW THEEND 375G BNZ 7 YPARS [ERROR IF NO PARAMS GIVEN 37K6 ERROR JPARMIS 37Q# ...YPARS 37XG ... DICTJL [ENSURE THAT ANY DICTWELLS ISSUED 384N ... [ARE FULLY IMLEMENTED 389W ... LONGONALL #6 [WAKE ALL ACTS WANTING FILES 38C4 ... LONGONALL #10 38J= ... LONGONALL #12 38JL ... FSHCODE A,XNOTB2 38K2 ...( 38KB ...# SHARED FILESTORE: AS WITH COMBRKIN ABOVE, WE MUST GO BACK TO 'B' 38KQ ...# IF THAT IS OUR HOME MACHINE 38L6 ...# 38LG ... TRANCHKN FSHFZCOMID,EQUAL,XNOTB2,XNOTB2 38LW ...# 38M= ... LDN 3 1 [SET THE ENDCOM RETURN OFFSET 38ML ... BRN XFIN 38N2 ...# 38NB ...XNOTB2 38NQ ...) 38PD ... ENDCOM 38WL ...# 3942 NULLPAR 39HL ERROR JPARNULL 3=3= BRN NUNI 3=GW # 3?2G NOTOK 3?G6 REPALLER 3?^Q ... BRN NFAB 3#FB # 3#H^ ...XTSN 3#LJ ... FREECORE 3 3#P7 ... ERROR ERVRYWRONG 3#RQ ... BRN NUNI 3#W* ...# 3#^2 XMULTEL 3*DL ERROR ERMULTEL 3*Y= ... BRN NDIR 3BCW # 3BXG XTEMPDIR 3CC6 ERROR ERTEMPDIR 3CWQ ... BRN NDIR 3DBB # 3DW2 XLIBENT 3F*L ERROR ERLIBENT 3FC3 ... BRN NDIR 3FDD ...STARTJOBS 3FFT ... CLOSETOP [JOBLIST 3FH= ... ERROR ERFZSTJBS 3FJM ... MFREEW FILE,FINTER 3FL4 ... BRN NFAB 3FMF ...# 3FNW ...REPLYQY 3FQ? ... GEOERR BRIEFPM,REPLYQY 3FRN ...# 3FT= # 3G#W XPRIV COMERR ERNOFPRIV 3GSG # 3H#6 MENDAREA 30,K99FREEZE 3HRQ # 3HYY ...XNOTBY 3J66 ...) 3J?B #END ^^^^ ...605223540001