SAVEBLOK65
(George Source)
Macros used: FCAJO, FREEBACK, FREECORE, GEOERR, JOBLOCK, LOCKC, MENDAREA, MURDER, SEGENTRY, STEP, TRACE, UP
- SAVEBLOK65.txt
22FL #LIS K0SAVEJOB>K0SAVEBLOK>K0HLS>K0GREATGEO>K0ALLGEO 22^= #SEG SAVEBLOK65 [RICHARD GRIMWADE 23DW 8HSAVEBLOK 23YG # THIS SEGMENT IMPLEMENTS THE SAVEBLK AND SAVECHN MACROS. 24D6 # SAVECHN USES THE SAVEBLOK CODE AS A S/R. 24XQ # SAVEBLOK SAVES THE LOCKED ACT BLOCK SPECIFIED OR THE IMMEDIATELY 25CB # FOLLOWING IT. 25X2 # SAVECHN SAVES ALL THE BLOCKS ASSOCIATED WITH A LOCKED ACT BLOCK. 26BL # WHEN IT FINDS THE NEXT ACT, THE PREVIOUS ONE IS MURDERED AND 26W= # A CHECK IS MADE AS TO WHETHER NEW ACTIVITY IS AN AOLPT WITH SAME 27*W # JOB NR - IF TRUE A NON-ZERO REPLY IS RETURNED TO SAVEJOB IN EXEC3; 27TG # SAVEJOB GEOERRS ON DETECTING THIS. IF THIS SEEMS ODD IT'S BECAUSE 28*6 # ITS A HANGOVER FROM THE BEGINNINGS OF AN ENHANCEMENT THAT HAS BEEN 28SQ # PUT OFF - INDEFINITELY. 29#B # 29S2 # NOTE:- AWORK1 IS SET TO 1 IF JOBLOCK BEING SAVED 2=?L # 0 IF CPAT BEING SAVED 2=R= # S/R TO REFIND BLOCK : CPAT 2?=W # LEAVES X3 -> RELEVANT BLOCK,X6 IS LINK 2?QG # MUST ALWAYS FOLLOW A CALL OF SJOBQ WITH ONE FOR SCPAT 2#=6 # 2#PQ SEGENTRY K3SAVEBLOK,XK3 2*9B SEGENTRY K10SAVEBLOK,XK10 2*P2 SEGENTRY K11SAVEBLOK,XK11 2B8L SEGENTRY K20SAVEBLOK,XK20 2BN= SEGENTRY K21SAVEBLOK,XK21 2C7W MENDAREA 25,K99SAVEBLOK 2CMG # 2D76 SCPAT FCAJO 3 2DLQ EXIT 6 0 2F6B SJOBQ JOBLOCK AWORK2(2),3 2FL2 SMO AWORK1(2) [EXIT +1 IF JOB BLOCK 2G5L EXIT 6 0 2GK= SCOM LDX 0 ACOM1(2) 2H4W STO 0 AWORK2(2) 2HJG EXIT 6 0 2J46 # 2JHQ X512 +512 2K3B XK11 2KH2 GEOERR 1,NEXTJBLK [ERROR IF BLOCK FOLLOWING JOBBLOCK 2L2L XK21 2LG= STOZ AWORK1(2) 2L^W CALL 6 SCOM 2MFG CALL 6 SJOBQ 2M^6 CALL 6 SCPAT [SKIPPED IF JOB BLOCK CASE 2NDQ LDX 3 FPTR(3) 2NYB #SKI K6SAVEBLOK>99-99 2PD2 TRACE 3,BLOCKSAV 2PXL LDN 7 0 [MARKER 2QC= BRN NOTSR 2QWW XK20 2RBG STOZ AWORK1(2) 2RW6 BRN PAST 2S*Q XK10 2STB LDN 0 1 2T*2 STO 0 AWORK1(2) 2TSL PAST 2W#= CALL 6 SCOM 2WRW CALL 6 SJOBQ 2X?G CALL 6 SCPAT 2XR6 LDX 7 FX1 [PREPARE FOR MARKER 2Y=Q SR1 2YQB SBX 7 FX1 2^=2 NOTSR LDX 4 ALOGLEN(3) 2^PL ADN 4 3 329= TXL 4 X512(1) 32NW BCS SHORT [J IF NOT 512 WORD BLOCK 338G GEOERR 1,LARGBLOK 33N6 SHORT LDX 0 BACK1(3) 347Q BZE 0 NOBSH [J IF NO BACKING STORE HOME 34MB FREEBACK BACK1(3) 3572 CALL 6 SJOBQ 35LL CALL 6 SCPAT 366= BZE 7 NOBSH 36KW LDX 3 FPTR(3) 375G NOBSH LDX 1 4 [BLOCK LENGTH 37K6 LDCH 5 ATYPE(3) 384Q SBN 5 BLINK/64 38JB BNZ 5 NBLNK [J IF NOT BLINK BLOCK 3942 LDX 5 4 39HL SBN 5 5 3=3= BZE 5 XFREE [DON'T SAVE 2 WORD BLINK BLOCKS 3=GW NBLNK LDCH 5 ATYPE(3) 3?2G SBN 5 BSTB+BFREEW 3?G6 BZE 5 XFREE 3?^Q LDX 5 ATYPE(3) [SAVE BLOCK TYPE 3#FB STEP ,0(1) [GET APPEND POINTE 3#^2 TESTREPN FILEFULL,ROK 3*DL GEOERR 1,FILEFULL 3*Y= ROK STO 5 2(3) [STORE TYPE 3BCW LDCT 0 #400 3BXG STO 0 1(3) [SAVED BLOCK BIT 3CC6 TXL 5 CACT 3CWQ BCS XIT 3DBB LDCT 0 #200 3DW2 ORS 0 1(3) [SET ACT BLOCK BIT 3F*L XIT LDN 5 3(3) 3FT= STO 4 0(3) [REC HEADER 3G#W CALL 6 SJOBQ [REFIND BLOCK 3GSG CALL 6 SCPAT 3H#6 BZE 7 NOTAL 3HRQ LDX 3 FPTR(3) 3J?B NOTAL LDX 1 ALOGLEN(3) 3JR2 LDN 4 A1(3) 3K=L MOVE 4 0(1) [MOVE IN INFORMATION 3KQ= LDCH 4 ATYPE(3) 3L9W SBN 4 JOBQE/64 3LPG BZE 4 UP 3M96 NOTJB LDX 4 ATYPE(3) 3MNQ TXL 4 CACT 3N8B BCC UP [J IF ACT BLOCK 3NN2 XFREE FREECORE 3 3P7L UP BNG 7 UP1 3PM= BNZ 7 XIT1 3Q6W UP1 3QLG UP 3R66 XIT1 ADX 7 FX1 3RKQ EXIT 7 0 3S5B # THIS SECTION IMPLEMENTS THE SAVECHN MACRO. IT EXPECTS ACOMMUNE1 3SK2 # TO CONTAIN THE JOB NUMBER. IT USES THE SAVEBLOK 3T4L # CODE AS A SUBROUTINE 3TJ= XK3 3W3W STOZ AWORK1(2) [SET FOR EXIT MARKER 3WHG CALL 6 SCOM 3X36 NXTBLK 3XGQ CALL 6 SJOBQ 3Y2B CALL 6 SCPAT 3YG2 LDX 2 3 3Y^L LDX 3 FPTR(2) [BLOCK FOLLOWING. 3^F= #SKI K6SAVEBLOK>99-99 3^YW TRACE ATYPE(3),SAVEBLTY 42DG LDX 6 ATYPE(3) 42Y6 SRL 6 12 437Y ... SBN 6 BSTB+BFREEW [FREE ANY BSTB/BFREEW BLOCKS 43MJ ... BNZ 6 NOTQ 44C2 FREECORE 3 [FREE ANY BSTB/FQBLK BLOCKS. 44WL BRN NXTBLK 45B= NOTQ SBN 6 #6000-BSTB-BFREEW 45TW BNG 6 SAVE [J IF NOT ACT BLOCK. 46*G SBN 6 AOLPT-#6000 46T6 BNZ 6 NOT [J IF NOT AOLPT. 47#Q LDX 6 JOBNO(3) 47SB SMO FX2 48#2 SBX 6 ACOMMUNE4 48RL BZE 6 NOT1 [J IF AOLPT OF SAME JOB. 49?= NOT LDN 3 0 49QW NOT1 LDX 7 3 4==G LOCKC 2,REFIND 4=Q6 CALL 1 REFIND 4?9Q MURDER 2 4?PB STO 7 EXEC3(2) [NON-ZERO (BUT VALUE NOT SIGNIFICANT) 4#92 UP [BLOCK IS AOLPT FOR SAME JOB - THIS WILL LEAD 4#NL [TO GEOERR-AOLPTSAV BACK IN SAVEJOB. 4*8= SAVE 4*MW CALL 7 SR1 [SAVE THE BLOCK. 4B7G BRN NXTBLK 4BM6 REFIND [SUBROUTINE TO REFIND CPAT FOR LOCKC 4C6Q LDX 5 1 4CLB CALL 6 SJOBQ 4D62 CALL 6 SCPAT 4DKL LDX 2 3 4F5= LDX 1 5 4FJW EXIT 1 0 4G4G #END ^^^^ ...53330441000600000000