DELCOM5
(George Source)
Macros used: ALTLEND, DOWN, ENDCOM, FPCACA, FREECORE, HUNT, HUNT2, HUNTW, MONOUT, NAME, OUTBLOCK, OUTMILL, OUTNULL, OUTNUM, OUTPACKC, OUTPARAM, OUTPARN, PHOTO, SEGENTRY, SETUPCORE, SPARANOT, TESTMOVE, TRACE
- DELCOM5.txt
22FL #LIS K0DELCOM>K0ALLGEO>K0GREATGEO>K0COMMAND 22^= #SEG DELCOM5 [R.H.THOMPSON F6 23DW #OPT K6DELCOM=0 23YG 8HDELCOM 24D6 SEGENTRY K1DELCOM,XX1D 24XQ PDCATCH #77777700 [MASK 25CB ZMEM 12HIN MEMBER 25X2 #DEF XBLEN=3 [SO THAT APEDSP1+XBLEN IS A RELATIVE 26BL [POINTER TO MESSAGE IN APED BLOCK 26W= # 1 27*W # 1 THE DELCOM SEGMENT HANDLES THE COMMAND -DELETE-. THE ACTION TAKEN 27TG # 1 DEPENDS ON THE CONDITIONS UNDER WHICH THE DELETE WAS ISSUED 28*6 # 1 28SQ # 2 29#B # 2 INPUT - 1. CPB/CALAS BLOCK GENERATED BY THE COMMAND PROCESSOR. 29S2 # 2 2. X2 POINTS TO THE COMMAND ACTIVITY BLOCK. 2=?L # 2 2=R= # 3 2?=W # 3 OUTPUT - 1. OLD EVENT BLOCK DESTROYED (APED) 2?QG # 3 2. NEW APED BLOCK FORMED FOR -DELETE- 2#=6 # 3 3. CATEGORY BITS CHANGED TO 6 IF THE COMMAND WAS ISSUED 2#PQ # 3 AT BREAK-IN DURING THE RUNNING OF THE OBJECT PROGRAM. 2*9B # 3 2*P2 # 4 2B8L # 4 ERROR ACTION - 1. GEOERR (DELCNOIP) IF CPB/CALAS BLOCK NOT FOUND 2BN= # 4 2C7W # 4 NO CHECK IS MADE TO SEE WHETHER CATEGORY BITS 2CMG # 4 ARE ALREADY 6, INDICATING DUPLICATE COMMAND, 2D76 # 4 ON ENTRY 2DLQ # 4 2F6B # 7 FIXED STORE SEGMENTS CALLED - NONE EXCEPT VIA MACROS 2FL2 # 7 BACKING STORE SEGMENTS CALLED - DOWN PROSTART,11 IN ORDER 2G5L # 7 TO DELETE OBJECT CORE IMAGE. 2GK= # 7 2H4W XX1D 2HJG PDA1 2J46 #SKI K6DELCOM>699-699 2JHQ TRACE 1,PDA1 2K3B FPCACA 3,2 2KH2 LDX 7 ANM(3) 2L2L ANDN 7 3 2LG= STO 7 AWORK1(2) [STORE MEMBER NO. 2L^W LDEX 7 EXT+10(2) 2MFG #SKI G4 2M^6 ( 2NDQ HUNT2 3,BSTB,BSCB 2NYB LDX 4 AQUOTA(3) [QUOTA 2PD2 ANDN 4 #7777 2PXL LDX 5 ATSWAPS(3) [PAGETURNS 2QC= LDX 3 FX2 2QWW STO 4 AWORK3(3) 2RBG STO 5 AWORK4(3) 2RW6 ) 2S*Q LDX 4 CONTEXT(2) 2STB SLL 4 9 2T*2 BPZ 4 PDA4 [JUMP IF NOT BREAKIN 2TSL #SKI G3 2W#= LDX 3 FX2 2WRW PDA2 HUNT2 3,CPB,CALAS [FIND THE CALAS 2X?G LDEX 4 CPBCPLEV(3) [BLOCK AT FIRST 2XR6 TXU 4 7 [BRK-IN LEVEL 2Y=Q BCS PDA2 2YQB PDA3 2^=2 #SKI K6DELCOM>699-699 2^PL TRACE 1,PDA3 329= LDX 4 CPBFSD(3) [GET CATEGORY BITS 32NW #SKI K6DELCOM>699-699 338G TRACE 4,CATEGIN 33N6 LDX 5 4 [SAVE CATEGORY BITS 347Q ANDN 4 #77 [CLEAR ALL BUT LAST 6 BITS 34MB SBN 4 5 [ASSUME CATEGORY IS 5 3572 BNZ 4 PDA4 [DON'T TOUCH 35LL ANDX 5 PDCATCH(1) [MASK OUT LAST 6 BITS 366= ORN 5 #6 [SET TO 6 36KW STO 5 CPBFSD(3) [STOW BACK IN CPB 375G PDA4 37K6 #SKI K6DELCOM>699-699 384Q TRACE 1,PDA4 38JB DOWN PROSTART,17 [DELETE CURRENT CORE IMAGE 3942 # POSSIBLE CHECK TO SEE IF THIS WAS DONE 39HL LDN 3 ACOMMUNE4(2) 3=3= LDN 2 ZMEM(1) 3=GW MOVE 2 3 [PREPARE MESSAGE FOR OUTPARN 3?2G LDX 2 FX2 3?G6 HUNTW 3,APED,ANEVENT 3?^Q BNG 3 PDA42 [NONE FOUND 3#FB FREECORE 3 [BLOCK FOUND, SO FREE IT 3#^2 BRN PDA44 [ONE OR THE OTHER, NOT BOTH 3*DL PDA42 HUNTW 3,APED,ADELETE 3*Y= BNG 3 PDA44 [NONE FOUND 3BCW FREECORE 3 [BLOCK FOUND SO FREE IT 3BXG PDA44 3CC6 SPARANOT 1 [GET USER MESSAGE IF ANY 3CWQ HUNT 3,CPB,CUNI [FIND BLOCK FORMED BY PARA- MACRO 3DBB LDX 6 ANUM(3) [TEST FOR NO PARAMETERS 3DW2 BNG 6 PDA5 [IF NEGATIVE 3F*L BNZ 6 PDA6 [PARAMETER EXISTS 3FT= PDA5 3G#W #SKI K6DELCOM>699-699 3GSG TRACE 1,PDA5 3H#6 NAME 3,APED,ANEVENT [FROM CPB/CUNI TO APED/ANEVENT 3HRQ PHOTO 5 [FOR CHECK AGAINST MOVE 3J?B ALTLEND 3,XBLEN,APED,ANEVENT [JUST PREFACE LENGTH 3JR2 TESTMOVE 5,PDA55 [BRANCH IF NO HUNT NEEDED 3K=L PDA53 3KQ= #SKI K6DELCOM>699-699 3L9W TRACE 1,PDA53 3LPG HUNTW 3,APED,ANEVENT 3M96 PDA55 3MNQ #SKI K6DELCOM>699-699 3N8B TRACE 1,PDA55 3NN2 STOZ APEDSP1+2(3) [ZERO FOR CHARACTER COUNT 3P7L LDX 7 AWORK1(2) 3PM= STO 7 APEDSP1(3) [MEMBER NO. 3Q6W LDN 5 APEDDEL [CONTROL VALUE FOR IF COMMAND 3QLG STO 5 APEDSP1+1(3) 3R66 #SKI G4 3RKQ LDN 5 7 [NO. OF WDS. FOR PARAMS. +1 WORD EACH 3S5B #SKI G3 3SK2 LDN 5 3 [2-WORD TIME + 1 WORD EACH PARAM. 3T4L BZE 7 PDA57 3TJ= ADN 5 4 [3-WORD PARAM FOR MEMBER NO. + 1 WORD 3W3W PDA57 OUTBLOCK 5 [GET THE MONITORING FILE BLOCK 3WHG OUTMILL [TAG WITH THE TIME 3X36 #SKI G4 3XGQ ( 3Y2B #SKI JNLPACK 3YG2 ( 3Y^L LDX 4 AWORK3(2) 3^F= LDX 5 AWORK4(2) 3^YW OUTPACKC 4,1,QUOTA [OUTPUT QUOTA 42DG OUTPACKC 5,1,PAGETURN [OUTPUT PAGETURNS 42Y6 ) 43CQ #SKI JNLPACK<1$1 43XB ( 44C2 OUTNUM AWORK3(2),0 [OUTPUT QUOTA 44WL OUTNUM AWORK4(2),0 [OUTPUT PAGETURNS 45B= ) 45TW ) 46*G BZE 7 PDA10 [NO MEMBER NO. 46T6 LDX 3 GSIGN 47#Q ADX 3 2 47SB DCH 7 ACOMMUNE6(3) [APPEND MEMBER NO. TO CHAR. STRING 48#2 OUTPARN 11,ACOMMUNE4 [PREPARE PARAM FOR MEMBER NO. 48RL # NO MESSAGE 49?= BRN PDA10 [CARRY ON SERGEANT 49QW PDA6 4==G #SKI K6DELCOM>699-699 4=Q6 TRACE 1,PDA6 4?9Q LDEX 5 ANUM(3) [GET CHARACTER COUNT 4?PB SBN 5 41 [MAX. TO BE PASSED ON ANYWAY(+1) 4#92 BNG 5 PDA7 [40 OR LESS CHARACTERS 4#NL PDA65 4*8= #SKI K6DELCOM>699-699 4*MW TRACE 1,PDA65 4B7G LDN 5 40 [TRUNCATE TO 40 4BM6 BRN PDA8 [SKIP ROUND TO GET CORE 4C6Q PDA7 4CLB #SKI K6DELCOM>699-699 4D62 TRACE 1,PDA7 4DKL ADN 5 41 [CONFLUENCE OF CODE STREAMS 4F5= PDA8 4FJW #SKI K6DELCOM>699-699 4G4G TRACE 1,PDA8 4GJ6 LDX 6 5 [SAVE COUNT FOR GETTING CORE 4H3Q LDX 7 6 [AND AGAIN TO MOVE MESSAGE 4HHB ADN 5 XBLEN*4+3 [ROUND AND INCLUDE APED/ANEVENT 4J32 SRL 5 2 [REDUCE TO WORDS 4JGL SETUPCORE 5,5,APED,ANEVENT [GET SPACE FOR AND NAME NEW BLOCK 4K2= HUNT 3,CPB,CUNI [GET ESSAGE BLOCK BACK 4KFW LDX 4 5 [SAVE BLOCK START ADDRESS 4K^G ADN 7 3 [ROUND FOR WORD MOVE 4LF6 SRL 7 2 [REDUCE TO WORDS 4LYQ ADN 3 APARA [MOVE UP TO MESSAGE -FROM- 4MDB ADN 4 APEDSP1+XBLEN [MOVE UP TO MESSAGE -TO- 4MY2 SMO 7 [PURE PROCEDURE MODIFY 4NCL MOVE 3 0 [MOVE THE MESSAGE 4NX= LDX 3 5 [OTHER INITIALIZATION 4PBW PDA9 4PWG #SKI K6DELCOM>699-699 4QB6 TRACE 1,PDA9 4QTQ STO 6 APEDSP1+2(3) [CHARACTER COUNT 4R*B LDX 5 7 [SAVE MESSAGE WORD COUNT 4RT2 LDX 7 AWORK1(2) 4S#L STO 7 APEDSP1(3) [MEMBER NO. 4SS= LDN 4 APEDDEL [CONTROL VALUE FOR IF COMMAND 4T?W STO 4 APEDSP1+1(3) 4TRG #SKI G4 4W?6 ADN 5 9 [NO. OF WDS. FOR PARAMS. +1 WORD EACH 4WQQ #SKI G3 4X=B ADN 5 5 [2-WORD TIME + 1 WORD EACH PARAM. 4XQ2 BZE 7 PDA91 4Y9L ADN 5 3 [3-WORD PARAM 4YP= PDA91 OUTBLOCK 5 [GET MONITORING FILE BLOCK 4^8W OUTMILL 4^NG #SKI G4 5286 ( 52MQ #SKI JNLPACK 537B ( 53M2 LDX 4 AWORK3(2) 546L LDX 5 AWORK4(2) 54L= OUTPACKC 4,1,QUOTA [OUTPUT QUOTA 555W OUTPACKC 5,1,PAGETURN [OUTPUT PAGETURNS 55KG ) 5656 #SKI JNLPACK<1$1 56JQ ( 574B OUTNUM AWORK3(2),0 [OUTPUT QUOTA 57J2 OUTNUM AWORK4(2),0 [OUTPUT PAGETURNS 583L ) 58H= ) 592W BZE 7 PDA92 59GG LDX 3 GSIGN 5=26 ADX 3 2 5=FQ DCH 7 ACOMMUNE6(3) [APPEND MEMBER NO. TO CHAR.STRING 5=^B OUTPARN 11,ACOMMUNE4 [PREPARE PARAM FOR MEMBER NO. 5?F2 BRN PDA93 5?YL PDA92 OUTNULL [MEMBER NO. NOT APPLICABLE 5#D= PDA93 OUTPARAM 6,APEDSP1+XBLEN,APED,ANEVENT 5#XW PDA10 5*CG #SKI K6DELCOM>699-699 5*X6 TRACE 1,PDA10 5BBQ #SKI G4 5BWB MONOUT HUSHG4 5CB2 #SKI G3 5CTL MONOUT HUSH [SHOOT IT AWAY 5D*= # PRODUCES - TIME:DELETED IN MEMBER N: MESSAGE (N>0) 5DSW # OR - TIME:DELETED : MESSAGE (N=0) 5F#G PDA11 5FS6 #SKI K6DELCOM>699-699 5G?Q TRACE 1,PDA11 5GRB ENDCOM [RETURNS TO COMMAND PROCESSOR 5H?2 #GAP 20 5HQL #END ^^^^ ...46042631000100000000