{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: SAVEBLOK65)}}
====== SAVEBLOK65 ======
(George Source)
**Macros used:** [[george:macro:FCAJO|FCAJO]], [[george:macro:FREEBACK|FREEBACK]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:JOBLOCK|JOBLOCK]], [[george:macro:LOCKC|LOCKC]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MURDER|MURDER]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:STEP|STEP]], [[george:macro:TRACE|TRACE]], [[george:macro:UP|UP]]
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