(George Source)
Macros used: BACKSPACE, BC, BS, CLOSETOP, ENDCOM, ERRORX, FINDFCB, FJOCA, FNORM, FSHCODE, FSHSKIP, GETDIR, JBS, LOGACCESS, MFREE, MHUNT, NAME, NAMETOP, OPENDIR, REPALLER, REWRITE, SEGENTRY, SETNCORE, SPARAPAS, TESTNAME, TESTREP, TESTREP2, TESTREPNOT, TRANSBEG, TRANSFIN
229S ...#OPT K0LOGCOM=K0ALLGEO 22FL ...#LIS K0LOGCOM>K0ALLGEO>K0GREATGEO>K0COMMAND 22^= ...#SEG LOGCOM863 [JOY THOMPSON-CENT 23DW ... 6HLOGCOM 23YG ... SEGENTRY K1LOGCOM,QENTRY1 24D6 ...# 24XQ ...# 25CB ...# K1LOGCOM(ENTRY POINT) 25X2 ...# ---------------------THIS SEGMENT IMPLEMENTS THE LOGACCESS AND 26BL ...# CANCEL LOGACCESS COMMANDS.A LOGGED ACCESS (LA) ENTRANT WILL BE 26W= ...# INDICATED BY HAVING B22 IN EINF1 (BELOGACC IN FILE/ENT) SET IN 27*W ...# ITS DIRECTORY ENTRY;THE CONVERSE IS TRUE FOR THE CANCEL LOGACCESS 27TG ...# COMMAND. 28*6 ...# 28G# ... FSHSKIP B 28MG ...( 28SQ ...# UNIVERSALS NEEDED FOR ERROR MESSAGES GENERATED WITHIN THIS SEGMENT 29#B ...XLAERR +JPARMIS [ERROR IN %A:PARAMETER MISSING 29S2 ...XFILER +ERWRONG [ERROR IN %B%A:ENTRANT IS OF THE 2=?L ...# [WRONG TYPE FOR THIS OPERATION 2=R= ...XOWNER +ERNOTOWN [ERROR %B IN %A;YOU DO NOT OWN %C 2?=W ...# 2?QG ...# 2#=6 ...# THIS SUBROUTINE PUTS OUT ERROR MESSAGES 2#PQ ...# 2*9B ...ONERR 2*P2 ... SBX 7 FX1 2B8L ... ERRORX 1 2BN= ... ADX 7 FX1 2C7W ... EXIT 7 0 2CMG ...# 2D76 ...# 2DLQ ...# 2F6B ...# THIS SUBROUTINE IS FOR CLEARING OR SETTING B22 IN EINF1(BELOGACC I 2FL2 ...# FILE/ENT) 2G5L ...# 2GK= ...RBITSET 2H4W ... SBX 7 FX1 2HJG ... MHUNT 3,FILE,ENT 2J46 ... JBS XCLA,2,EXCANISS [IF THIS BIT IS SET,IS CANCEL COMMAND 2JHQ ... BS 3,BELOGACC [IF LA-SET BIT 2K3B ... BRN XENT 2KH2 ...XCLA 2L2L ... BC 3,BELOGACC [IF CCLA-CLEAR BIT 2LG= ...XENT 2L^W ... NAME 3,FILE,FWB 2MFG ... LDEX 5 ECOPS(3) [(LAST 9 BITS OF ECOPS =0) 2M^6 ... BZE 5 XMT [DO NOT NEED THE BACKSPACE 2NDQ ... BACKSPACE 2NYB ...XMT 2PD2 ... REWRITE [COPY TO BACKING STORE 2PXL ... MHUNT 3,FILE,FWB 2QC= ... NAMETOP 3,FILE,ENT 2QWW ... BS 3,BELOGACC [SET BIT AGAIN FOR LOGACCESS MACRO 2RBG ... ADX 7 FX1 2RW6 ... EXIT 7 0 2S5Y ...) 2S*Q ...# ENTRY POINT HERE IN ORDER TO IMPLEMENT THE LA AND CCLA COMMANDS 2STB ...# 2T*2 ...# 2TSL ...QENTRY1 2W#= ... 2W*S ... FSHCODE B,XFSHBLOGCOM 2WCB ...( 2WDY ...# LOGACCES COMMANDS MUST BE OBEYED ON MACHINE A 2WGG ... TRANSBEG FSHLOGACCID,LOGCOM,1,CLB,,ACOMMUNE1 2WJ4 ... BRN XEND 2WKL ...XFSHBLOGCOM 2WM8 ...) 2WNQ ... FSHSKIP B 2WQ# ...( 2WRW ... STOZ AWORK3(2) [ZEROISE VALID PARAM MARKER 2X?G ...PARAMRD 2XR6 ... SPARAPAS 2Y=Q ... MHUNT 3,CPB,CUNI [READ PARAM INTO CPB/CUNI 2YQB ... LDX 5 ANUM(3) [IF NON-EXIST PARAM,ANUM IS -VE 2^=2 ... BNG 5 PAREND [J IF NON-EXIST PARAM 2^PL ... BZE 5 PARAMERR [J IF NULL PARAM(ANUM=0) 329= ... LDN 4 1 32NW ... STO 4 AWORK3(2) [SET MARKER SHOWING VALID PARAM READ 338G ... NAMETOP 3,FILE,FNAME [RENAME CPB/CUNI FOR FNORM 33N6 ... FNORM 1 [PUT PARAM DETAILS IN FILE/FABSNB 347Q ... MHUNT 3,FILE,FNAME 34MB ... NAMETOP 3,CPB,CUNI [RENAME FILE/FNAME FOR ERROR REPORTIN 3572 ... TESTREP2 NAMEFORM,WFERR1 [J IF INCORRECT FILENAME FORMAT 35LL ... MHUNT 3,FILE,FABSNB 366= ... JBS WFERR,3,BFABWORK [J IF WORKFILE 36KW ... BS 3,BFABANY [SET BIT TO SHOW ACCEPTABLE TO OPEN 375G ... OPENDIR (GEOERR),GENERAL,QUERY 37K6 ... TESTREP2 OK,REPOK1 [J IF FOUND FILE 384Q ... REPALLER 38JB ... BRN PARAMRD [REPORT ERRORS AND GET NXT PARAM 3942 ...REPOK1 39HL ... MHUNT 3,FILE,ENT 3=3= ... FJOCA 2 [J IF USERNAME OF JOB AND 3=GW ... TESTNAME 3,EUSE1(3),JUSER(2) [ENTRANT NAME ARE THE SAME 3?2G ... LDX 2 FX2 [IE IF THE ENTRANT TO BE LOGGED 3?G6 ... BNZ 7 REPOK2 [IS THE CURRENT DIRECTORY 3?^Q ... OWNERCHECK [FILE OWNED BY PROPER USER? 3#FB ... TESTREP OK,REPOK2 3#^2 ... CLOSETOP 3*DL ... LDX 1 XOWNER(1) 3*Y= ... CALL 7 ONERR [O/P ERROR IF DON'T OWN ENTRANT 3BCW ... BRN PARAMRD 3BXG ...REPOK2 3CC6 ... MHUNT 3,FILE,ENT 3CWQ ... JBS TEMPENT,3,BETEMP [J IF TEMP. ENTRANT 3DBB ... JBS RMULTI,3,BEMDF [J IF MULTIFILE 3DW2 ... CALL 7 RBITSET [SET BITS INDICATING LA OR CCLA 3F*L ... LDX 3 EUSE1(3) 3FT= ... BZE 3 XEOP2 [J IF FILE IS NOT A DIRECTORY 3G#W ... LDN 4 6 3GSG ... FINDFCB 4,3,NOCHAIN 3H#6 ... TESTREPNOT OK,XEOP2 3HRQ ... JBS XDIR,2,EXCANISS [J IF CC LA 3J?B ... BS 3,BFLOGACC [SET BIT IF DIRECTORY 3JR2 ... BRN XEOP2 3K=L ...XDIR 3KQ= ... BC 3,BFLOGACC [CLEAR THE BIT IF CC LA ON DIRECTORY 3L9W ...XEOP2 3LPG ... STOZ 6 3M96 ... LDN 3 1 3MNQ ... JBS XLOG,2,EXCANISS [J IF CCLA;CODE=1 3N8B ... STOZ 3 [IF LA;CODE=0 3NN2 ...XLOG 3P7L ... LOGACCESS 0(3),6 3PM= ... CLOSETOP 3Q6W ... MFREE FILE,FABSNB 3QLG ... MFREE CPB,CUNI 3R66 ... MFREE FILE,ENT 3RKQ ... BRN PARAMRD 3S5B ...RMULTI 3SK2 ... CALL 7 RBITSET [SET BITS IN MDF 3T4L ... SETNCORE 6,3,FILE,FLOCNB [SET UP FILE/FLOCNB 3TJ= ... MHUNT 2,FILE,ENT 3W3W ...# HERE WE COPY NAME,ETC FROM FILE/ENT TO FLOCNB 3WHG ... LDN 5 ELOC1(2) [SET UP POINTERS 3X36 ... LDN 6 A1(3) 3XGQ ... MOVE 5 5 [COPY NAME FROM ENT TO FLOCNB 3Y2B ... STOZ A1+3(3) [ZEROISE REEL NO IN FLOCNB 3YG2 ... LDX 4 ELAN(2) 3Y^L ... STO 4 A1+5(3) [COPY LANG CODE FROM ENT TO FLOCNB 3^F= ... LDEX 5 ESTREND(2) [FIND HGST FGN OF MULTIFILE FROM FILE 3^YW ... STO 5 A1+4(3) [AND STORE IT IN FLOCNB 42DG ...XNXTEL 42Y6 ... GETDIR 0 [PICK UP NXT MULTIFILE ELEMENT 43CQ ... TESTREP OK,WEXIST [J IF THE MULTIFILE ELEMENT EXISTS 43XB ... BRN XLOOP 44C2 ...WEXIST 44WL ... CALL 7 RBITSET [SET BITS IN MULTIFILE ELEMENT 45B= ... MFREE FILE,ENT 45TW ...XLOOP 46*G ... MHUNT 3,FILE,FLOCNB 46T6 ... LDN 5 1 47#Q ... SBS 5 A1+4(3) [SUBTRACT 1 FROM FGN IN FLOCNB 47SB ... LDX 4 A1+4(3) 48#2 ... BCT 4 XNXTEL [PICK UP NXT ELEMENT IF FGN NOT=1 48RL ... MFREE FILE,FLOCNB 49?= ... BRN XEOP2 [OTHERWISE,IF ALL MULTIFILE ELEMENTS 49QW ...# [GO TO PART2 AND PUT MESS. IN SJ 4==G ...# 4=Q6 ...# 4?9Q ...# THE FOLLOWING CODE MAY BE BRANCHED TO FROM THE FIRST PART OF 4?PB ...# LOGAXES 4#92 ...# IF THERE IS A NON-EXISTANT PARAM,CHECK IF ANY VALID PARAM'S HAVE 4#NL ...# BEEN READ-IF SO,END COMMAND. IF NOT,OUTPUT AN ERROR. 4*8= ...PAREND 4*MW ... LDX 5 AWORK3(2) 4B7G ... BNZ 5 PAREAD 4BM6 ... SMO FX1 4C6Q ... LDX 1 XLAERR [LOAD MESSAGE IDENTIFIER 4CLB ... CALL 7 ONERR [AND OUTPUT ERROR MESSAGE 4D62 ...PAREAD 4DKL ... MFREE CPB,CUNI [FREE BLOCKS AND END COMMAND 4DMJ ...) 4DPG ... FSHCODE A,XFSHAEND 4DRD ...( 4DTB ... TRANSFIN ,,ALIEN [RETURN TO M/C B IF ORIGINATED THERE 4DX# ...XFSHAEND 4D^= ...) 4F38 ...XEND 4F5= ... ENDCOM 4FJW ...# 4FQ4 ... FSHSKIP B 4FX= ...( 4G4G ...# 4GJ6 ...# IF IT IS A NULL PARAM-IGNORE;FREE BLOCKS AND PICK UP NXT PARAM 4H3Q ...PARAMERR 4HHB ... MFREE CPB,CUNI 4J32 ... BRN PARAMRD 4JGL ...# 4K2= ...# 4KFW ...# IF INCORRECT FILENAME (AFTER FNORM) OR IF WORKFILE,OUTPUT ERROR 4K^G ...# MESSAGE,FREE BLOCKS AND PICK UP NXT PARAM. 4LF6 ...WFERR 4LYQ ... SMO FX1 4MDB ... LDX 1 XFILER 4MY2 ... CALL 7 ONERR 4NCL ...WFERR1 4NX= ... MFREE CPB,CUNI 4PBW ... BRN PARAMRD 4PWG ...# 4QB6 ...# 4QTQ ...# IF THE FILE IS A TEMPORARY ENTRANT; OUTPUT ERROR MESSAGE, FREE BLOCKS, 4R*B ...# CLOSE DIRECTORY AND PICK UP NXT PARAM 4RT2 ...TEMPENT 4S#L ... SMO FX1 4SS= ... LDX 1 XFILER 4T?W ... CALL 7 ONERR 4TRG ... MFREE FILE,FABSNB 4W?6 ... MFREE CPB,CUNI 4WQQ ... CLOSETOP 4X=B ... BRN PARAMRD 4XG8 ...) 4XQ2 ...#END ^^^^ ...54552377000100000000