RESTBLOK850
(George Source)
Macros used: CHANBLOK, ENRING, FREECORE, GEOERR, GETACTX, MENDAREA, READHUNT, SEGENTRY, STEPAGAIN, TRACE, UP, UPPLUS
- RESTBLOK850.txt
22FL #LIS K0SAVEJOB>K0RESTBLOK>K0HLS>K0GREATGEO>K0ALLGEO 22^= #SEG RESTBLOK50 [RICHARD GRIHWADE 23DW 8HRESTBLOK 23YG # 24D6 # CONTAINS THE THREE MACROS RESTBLOK,RESTBLOKR,RESTCHN 24XQ # THESE MACROS RESTORE BLOCKS FROM BLOCK CATEGORY RECORDS 25CB # IN A SAVING FILE 25X2 # 26BL SEGENTRY K1RESTBLOK,XK1 26W= SEGENTRY K2RESTBLOK,XK2 27*W SEGENTRY K3RESTBLOK,XK3 27TG # 28*6 # ENTRY FOR RESTBLOK MACRO 28SQ XK1 29#B LDX 7 FX1 [MARK NOT S/R 29S2 SRB1 SBX 7 FX1 [ENTRY FOR SUBROUTINE 2=?L SRB12 2=R= STEPAGAIN 2?=W BRN XJOIN 2?QG # ENTRY FOR RESTBLOKR MACRO 2#=6 XK2 2#PQ LDX 7 FX1 [MARK NOT S/R 2*9B SRB2 SBX 7 FX1 2*P2 SRB22 2B8L READHUNT UP 2BN= XJOIN 2C7W #SKIP K6RESTBLOK>99-99 2CMG TRACE FRH+2(3),RESTBLOK 2D76 LDX 4 FRH+1(3) 2DLQ BPZ 4 XPLUS [J IF NOT A BLOCK RECORD 2F6B SLL 4 1 2FL2 BNG 4 XACT [J IF ACTIVITY BLOCK 2G5L LDCH 4 FRH+2(3) [BLOCK TYPE 2GK= SBN 4 BLINK/64 2H4W BZE 4 SPEC 2HJG LDX 4 FRH+2(3) 2J46 SRL 4 12 2K3B SBN 4 BSTB+BQBLK 2KH2 ... BNZ 4 XCHAN 2L^W SPEC 2MFG CHANBLOK 1,2 2M^6 BRN XPLUS2 2NDQ XCHAN 2NYB CHANBLOK 2PD2 BRN XPLUS2 2PXL XACT 2QC= LDX 4 FRH+2(3) 2QWW LDX 5 FRH(3) 2RBG SBN 5 3 [GET THE LENGTH 2RW6 GETACTX 4,5 [GET ACTIVITY BLOCK 2S*Q STEPAGAIN 2STB SMO BPTR(2) 2T*2 LDX 0 ACTNUM 2W#= LDN 4 ACC3-A1+FRH+3(3) 2WRW SMO BPTR(2) 2X?G LDN 5 ACC3 2XR6 LDEX 1 FRH(3) 2Y=Q SBN 1 ACC3+3-A1 2YQB MOVE 4 0(1) [MOVE REST OF ACTIVITY BLOCK 2YRY ... LDX 2 BPTR(2) 2YTG ... LDX 4 ALINK1(2) 2YX4 ... SRL 4 12 2YYL ... BNZ 4 PLUS6 [J IF FORMAT OF CPAT OK 2^28 ... LDN 4 ALINK1+2(2) 2^3Q ... LDN 5 ALINK1+1(2) 2^5# ... MOVE 4 15 [ADJUST FOR 1WORD LINK 2^6W ...PLUS6 STO 0 ACTNUM(2) 2^8D ... LDX 2 FX2 2^=2 XPLUS2 2^PL BZE 7 PLUS2 329= ADX 7 FX1 32NW EXIT 7 0 338G PLUS2 33N6 UPPLUS 2 [NORMAL EXIT FOR ACTIVITY BLOCK 347Q XPLUS UPPLUS 1 34MB UP UP 3572 # 35LL # ENTRY FOR RESTCHN MACRO 366= # 36KW XK3 375G #SKIP K6RESTBLOK>99-99 37K6 TRACE ACOMMUNE1(2),RESTCHN 384Q LDX 6 ACTRING+1(2) 38JB SBN 6 ACTRING 3942 CALL 7 SRB1 39HL XLOOP LDX 6 ACTRING+1(2) 3=3= SBN 6 ACTRING 3=GW LDX 3 BPTR(2) 3?2G LDX 5 ATYPE(3) 3?G6 TXL 5 CACT 3?^Q BCC XPLUS [J IF ACT BLOCK 3#FB XNOTACT 3#^2 SRL 5 12 3*DL SBN 5 BLINK 3*Y= BNZ 5 XNOTLINK 3BCW SMO 6 3BXG LDN 2 ALINKRING 3CC6 # IF THERE IS A LINK BLOCK LEFT BY RESTACTF WE MUST FREE IT 3CWQ SMO 6 3DBB TXU 2 ALINKRING 3DW2 BCC NEEDLESS 3F*L LDX 2 0(2) [X2 -> BLINK 3FT= SBN 2 BLINKRING [X2 -> START OF BLOCK 3G#W LDX 0 ALOGLEN(2) 3GSG SBN 0 2 3H#6 BZE 0 PHREE [ERROR IF SOME LINKS LEFT 3HRQ GEOERR 1,UNSAVELK 3J?B PHREE FREECORE 2 3JR2 SMO 6 3K=L LDN 2 ALINKRING 3KQ= NEEDLESS 3L9W LDN 1 BLINKRING(3) 3LPG ENRING 1,2 [RING INTO LINK RING 3M96 XNOTLINK 3MNQ CALL 7 SRB2 3N8B BRN XLOOP [CARRY ON 3NN2 MENDAREA 30,K99RESTBLOK 3P7L #END ^^^^ ...37143254000300000000