{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: IPBTAPE867)}} ====== IPBTAPE867 ====== (George Source) **Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLENG|ALTLENG]], [[george:macro:FREECORE|FREECORE]], [[george:macro:HUNTW|HUNTW]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:SEGENTRY|SEGENTRY]] 22FL #SEG IPBTAPE [IPB - COMM 22^= [ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 23DW #LIS K0IPBTAPE>K0IPB>K0ALLGEO 23YG 8HIPBTAPE 24D6 # 24XQ SEGENTRY K1IPBTAPE,SK1IPBTAPE 25CB SALPH #74 25X2 SHIFT #76 26BL XA #41 26W= TYPTAB 27*W BRN TCT 27TG #10 28*6 BRN STLEG 28SQ #20 29#B BRN STRAL 29S2 #21 2=?L BRN TCT 2=R= #27 2?=W BRN STLEG 2?QG #30 2#=6 BRN SPACK 2#PQ #31 2*9B BRN TABEX 2*P2 #32 2B8L BRN TCT 2BN= #33 2C7W BRN STLEG 2CMG #35 2D76 BRN ZCAR 2DLQ #36 2F6B BRN STLEG 2FL2 #40 2G5L BRN TCT 2GK= #64 2H4W BRN TNATC 2HJG #70 2J46 BRN STLEG 2JHQ #73 2K3B BRN STRAL 2KH2 #74 2L2L BRN STLEG 2LG= #100 2L^W # 2MFG # SUBROUTINE TO RE-FIND BLOCK BEING LENGTHENED BY ALTLENG 2M^6 # 2NDQ REH MHUNTW 2,ADATA,CREADL 2NYB EXIT 1 0 2PD2 # 2PXL [ 2QC= [ K1 IPBTAPE 2QWW [ 2RBG SK1IPBTAPE 2RW6 # 2S*Q # INPUT FROM REMOTE TAPE READER ; NPU IS MAXIMUM OR UP TO ETX ; 2STB # CONVERSION COMPLETE AFTER 2000 CHARS OR NEWLINE OR ETX : STORE 2T*2 # RECORD IN FILE ; IN GRAPHIC MODE CONVERT PAIRS FROM LINE CODE 2TSL # 2W#= # CHANGE FROM BETA TO ALPHA SHIFT BETWEEN IDATSGS CAUSES ALPHA SHIFT 2WRW # TO BE LOST : MUST INSERT #74 IF MEET SHIFT SENSITIVE CHARACTER 2X?G # (I.E. A LETTER) BEFORE #75 IN NORMAL OR ALLCHARS MODE WHEN LAST 2XR6 # BLOCK ENDED IN BETA SHIFT ; OTHERWISE DISCARD REDUNDANT #75 2Y=Q # 2YQB MHUNTW 3,ADATA,CREADL 2^=2 MHUNTW 2,ADATA,INPUSG 2^PL LDX 1 FX2 2^^D ... STO 3 ACOMMUNE5(1) 329= LDEX 5 A1(3) 32NW LDX 6 A1(2) [ROOM LEFT IN PARTIALLY FULL OR 128 338G ANDN 6 #7777 [NO. CHARS IN INPUT SEG 33N6 ADX 3 ACOMMUNE6(1) [CPDATA OR DCH POINTER IF PART FULL 347Q ADX 2 ACOMMUNE4(1) [LDCH POINTER IF PART USED OR A1+2 34CJ ... SBS 2 ACOMMUNE4(1) 34MB TAPE LDN 7 #6000 3572 ANDX 7 AWORK4(1) [B12 SET IF DISCARDING DATA DUE 35LL SLL 7 12 [TO TAB OUT OF RANGE 366= TAR 36KW LDCT 4 #300 375G STO 2 ACOMMUNE7(1) [IN CASE JUMP TO RINRE 37K6 LDCT 0 1 384Q ANDX 4 AWORK4(1) [B1 SET IF ALLCHAR ; B2 IF GRAPHIC 38JB ANDX 0 AWORK4(1) 3942 SLC 4 2 [>0 IF ALL ; 0 IF NORMAL ; <0 IF GRAP 39HL ERS 0 AWORK4(1) [B8 SET IF LAST BLOCK INCOMPLETE AND 3=3= LDX 1 FX1 [ENDED WITH #76 3=GW BNZ 0 TPAIR [TEST FOR DELTA PAIR 3?2G SMO FX2 3?G6 LDEX 1 AWORK4 3?^Q BZE 1 TLOOP [NO OUTSTANDING TAB SPACES TO STORE 3#FB SMO FX2 3#^2 DEX 0 AWORK4 3*DL ADN 6 1 [COUNTERACT BCT AFTER TUD 3*Y= BRN RINRE [STORE SPACES OUTSTANDING 3BCW # 3BXG TLOOP LDCH 0 0(2) 3CC6 LDX 1 FX1 3CWQ BCHX 2 £ 3DBB TXL 0 SALPH(1) 3DW2 BCS TSEN [< #74 3F*L TXU 0 SHIFT(1) [#76 3FT= BCC TDEL [LOOK FOR DELTA PAIR NEXT CHAR 3G#W BNG 4 TCT [DISCARD SHIFT IF GRAPHIC 3GSG SMO FX2 3H#6 LDEX 1 AWORK3 [OLD SHIFT 3HRQ SMO FX2 3J?B STO 0 AWORK3 [NEW SHIFT 3JR2 BNG 7 TCT [TAB OUT OF RANGE : DISCARD SHIFT 3K=L TXU 0 1 3KQ= BCC TCT [NO CHANGE 3L9W PUT DCH 0 0(3) 3LPG BCHX 3 £ 3M96 TUD BCT 5 TCT 3MNQ SBN 6 1 3N8B BRN TALT [CREADL FULL : INCREASE LENGTH BY 32 3NN2 # 3P7L TSEN BNG 7 TCT 3PM= ADN 7 1 3Q6W SMO FX2 3QLG LDXC 1 AWORK3 3R66 BCC PUT 3RKQ SMO FX1 3S5B TXL 0 XA [#41 3SK2 BCS PUT [NOT SHIFT SENSITIVE I.E. ALPHABETIC 3T4L LDN 1 #74 3TJ= DCH 1 0(3) 3W3W SMO FX2 3WHG STO 1 AWORK3 [SHIFT CHANGED 3X36 BCHX 3 £ 3XGQ SBN 5 1 3Y2B BNZ 5 PUT 3YG2 SBN 7 1 [CANCEL ADN AT TSEN 3Y^L BCHX 2 TMOB [NOT ENOUGH ROOM : MOVE BACK 1 CHAR 3^F= # 3^YW TDEL DCH 0 0(3) 42DG BCT 6 TPAIR [TEST FOR DELTA PAIR IF NOT BLOCK END 42Y6 LDX 1 FX2 43CQ LDCT 0 1 43XB ORS 0 AWORK4(1) [INDICATE IDATSG ENDED WITH #76 44C2 BRN TLAT [TEST FOR DELTA PAIR LATER 44WL TPAIR LDCH 0 0(2) 45B= BCHX 2 £ 45TW TXU 0 SHIFT(1) 46*G BCC TDEL [#7676 : IGNORE SECOND #76 46T6 BNG 7 TENEL [TEST FOR END OF RECORD ONLY 47#Q ADN 1 TYPTAB [POINT TO TABLE 47SB TYPLP 48#2 TXL 0 1(1) 48RL BCS (1) [J WHEN FOUND CHARAVCTER RANGE 49?= BDX 1 TYPLP [TRY NEXT CHARACTER RANGE 49QW STRAL [STORE IF ALLCHAR 4==G BZE 4 TCT [IGNORE IF NORMAL 4=Q6 STLEG [STORE UNLESS GRAPHIC 4?9Q BPZ 4 STIT [STORE IF ALLCHAR 4?PB BRN TCT [ELSE IGNORE 4#92 ZCAR LDN 7 0 [ZEROISE TAB COUNT 4#NL BNG 4 TCT 4*8= BRN STORO 4*MW STIT BUX 7 STORO 4B7G TNATC ADN 7 1 4BM6 BNG 4 TGR [IF GRAPHIC CONVERT #7664 - #7667 4C6Q STORO BCHX 3 £ 4CLB BCT 5 PUT 4D62 LDCT 0 1 [CREADL FULL : INDICATE CHAR IS PART 4DKL SMO FX2 [OF DELTA PAIR (FOR LATER) 4F5= ORS 0 AWORK4 4FJW BCHX 2 TMOB [FORWARD 1 , BACK 2 : INVERSE BCHX 4G4G SPACK SBN 7 1 [BACKSPACE : DECREMENT TAB COUNT 4GJ6 BNG 4 TCT [DO NOT STORE IF GRAPHIC 4H3Q BRN STORO 4HHB TGR ADN 0 #10 [CONVERT FROM LINE CODE 4J32 BRN PUT 4JGL # 4K2= # EXPAND #7631 = HORIZ TAB INTO SPACES ACCORDING TO TAB FIELDS SPEC. 4KFW # 4K^G TABEX LDX 1 FX2 4LF6 STO 2 ACOMMUNE7(1) 4LYQ HUNTW 2,AINPAR,ATB 4MDB LDN 0 #31 4MY2 BNG 2 NOTAB [NO TABS PARAMETER : PASS ON 4NCL ADN 7 1 4NX= LDX 1 A1(2) [COUNT OF TAB FIELDS 4PBW TABAG TXL 7 A1+1(2) 4PWG BCS THIST [THIS IS THE RELEVANT FIELD 4QB6 ADN 2 1 4QTQ BCT 1 TABAG 4R*B ADN 5 1 [COUNTERACT BCT AT TUD 4RT2 LDN 0 #6000 4S#L LDCT 7 #600 [COUNT TOO BIG : IGNORE REST OF BLOCK 4SS= SMO FX2 4T?W ORS 0 AWORK4 [SET 'DISCARD REST OF BLOCK' MARKER 4TRG BRN ONLY1 4W?6 THIST LDX 1 A1+1(2) 4WQQ SBX 1 7 4X=B LDX 7 A1+1(2) [UPDATE TAB COUNT 4XQ2 SBN 7 1 4Y9L RINRE TXL 5 1 [REENTRY PT AFTER CREADL LENGTHENED 4YP= BCC ROMOK [ENOUGH ROOM IN CREADL FOR SPACES 4^8W SBX 1 5 4^NG SMO FX2 5286 DEX 1 AWORK4 [SPACES TO BE INSERTED AFTER ALTLEN 52MQ LDX 1 5 [STORE SPACES TO END OF CREADL 537B ROMOK LDN 0 #20 53M2 SBN 1 1 546L DCH 0 0(3) 54L= LDX 2 3 555W BCHX 3 £ 55KG BZE 1 ONLY1 [STORE ONLY ONE SPACE 5656 MVCH 2 0(1) [STORE REQUISITE SPACES 56JQ SBX 5 1 574B ONLY1 SMO FX2 57J2 LDX 2 ACOMMUNE7 [RETRIEVE INPUSG POINTER 583L BRN TUD 58H= NOTAB LDX 2 ACOMMUNE7(1) 592W BPZ 4 STORO [STORE IF NOT GRAPHIC 59GG LDN 0 #20 5=26 BRN PUT [ELSE STORE 1 SPACE 5=FQ # 5=^B TENEL SBN 0 #32 [TEST FOR END OF RECORD AFTER TAB 5?F2 BNZ 0 TCT [OUT OF RANGE 5?YL TGNL LDN 0 #20 [SPACE-FILL REMAINDER OF 5#D= SACE TXL 3 BITS22LS [LAST WORD 5#XW BCS TNLF [B0-1 ZERO : POINTING TO CHAR 0 5*CG DCH 0 0(3) 5*X6 BCHX 3 SACE 5BBQ TNLF SBN 6 1 5BWB LDX 1 FX2 5CB2 ADS 2 ACOMMUNE4(1) [LDCH POINTER IN INPUSG FOR NEXT MESS 5CTL SBX 2 ACOMMUNE4(1) 5D*= DSA 6 A1(2) 5DSW TUNS LDX 0 BITS22LS 5F#G ANDS 0 AWORK3(1) [UNSET SHIFT-SENS-SEARCH BIT FOR NOW 5FS6 BRN TEND 5G?Q # 5GRB TCT BCT 6 TLOOP [PICK UP NEXT CHARACTER 5H?2 TCT2 LDX 1 FX2 [<127 CHARS ; END OF NPU 5HQL TLAT LDX 7 3 5J== NGX 2 ACOMMUNE4(1) [START ADDRESS OF ADATA/INPUSG 5JPW LDX 0 A1(2) 5K9G BPZ 0 TGSA [J IF NOT END OF NPU 5KP6 BUX 6 TGNL [INCREASE X6 AS SBN 1 LATER 5L8Q TGSA 5LNB LDX 3 ACOMMUNE5(1) 5M82 DEX 5 A1(3) [ROOM LEFT FOR CONVERTING INTO 5MML SBX 7 3 5N7= STO 7 ACOMMUNE6(1) [DCH POINTER WRT START OF BLOCK 5NLW FREECORE 2 5P6G BRN SEA [GET NEXT IDATSG TO COMPLETE MESSAGE 5PL6 # 5Q5Q # ADATA/CREADL FULL : INCREASE BY 32 WORDS UP TO MAX. OF 500 5QKB # 5R52 TWOB ADN 6 1 5RJL TMOB SLC 2 2 5S4= SBN 2 2 [MOVE BACK 2 CHARACTERS 5SHW SRC 2 2 5T3G TALT LDX 1 FX2 5TH6 ADS 2 ACOMMUNE4(1) 5W2Q SBX 2 ACOMMUNE4(1) 5WGB DSA 6 A1(2) [REMAINDER COUNT OF CHARS TO CONVERT 5X22 LDX 2 ACOMMUNE5(1) [START ADDRESS OF ADATA/CREADL 5XFL LDX 4 ALOGLEN(2) 5X^= LDX 3 4 5YDW LDN 0 CPDATA+500-A1 5YYG TXL 4 0 5^D6 BCC TMAR [2000 CHARS STORED : APPEND RECORD 5^XQ ADN 4 32 62CB LDN 5 128 62X2 TXL 4 0 63BL BCS TALEN 63W= LDN 4 CPDATA+500-A1 [ALREADY 480+CPDATA-A1 64*W LDN 5 80 64TG TALEN ALTLENG 2,4,REH 65*6 MHUNTW 2,ADATA,CREADL 65SQ LDX 1 FX2 66#B STO 2 ACOMMUNE5(1) 66S2 ADN 3 A1(2) [ADDRESS FOR NEXT DCH 67?L MHUNTW 2,ADATA,INPUSG 67R= ADX 2 ACOMMUNE4(1) [ADDRESS FOR NEXT LDCH 68=W SBS 2 ACOMMUNE4(1) [START ADDRESS OF ADATA/INPUSG 68QG BZE 6 TLAT [ALSO END OF IDATSG 69=6 LDCT 0 1 69PQ ANDX 0 AWORK4(1) 6=9B BZE 0 TAR [OK : LAST CHAR STORED NOT DELTA CHAR 6=P2 SBN 3 1 [STEP DCH ADDR BACK 1 CHAR TO DELTA 6?8L ORX 3 CACT [FOR STORO TO STORE DELTA PAIR 6?N= ADN 5 1 [STEP BACK BCT AS WELL 6#7W BRN TAR 6#MG TMAR 6*76 ACROSS READBULK,3 [STORING 2000 CHARS RECORD 6*LQ TEND 6B6B ACROSS READBULK,4 [END OF MESSAGE 6BL2 SEA 6C5L ACROSS READBULK,5 [GET NEXT IDATSG TO COMPLETE MESSAGE 6CK= #END ^^^^ ...541245620002