(George Source)
Macros used: ALTLENG, BS, BXGE, BXL, BXU, CLOSE, CLOSEABANDON, CLOSEMULT, COOR1, CREATEB, DCA, FREECORE, GEOERR, GPERI, HUNT, INPUTFULL, ISITJOB, LOCKC, LONGSET, LONGSTOP, MENDAREA, MFREEW, MHUNT, MONOUT, MONOUTX, NAMETOP, OUTPARAM, OUTPER, REPERR2, RESTART, SEG, SEGENTRY, SETERR, SETNCORE, STEP, TESTMULT, TESTREP2, TOPFCB, TRANSFORM, UNLOCK, UNNORM, UP, UPPLUS, USEROPEN
22FL ... SEG INRESTAR,74,M VELLACOTT,USERCOMS 22^= [ 23DW [ 23YG SEGENTRY K1INRESTAR,Z1INRESTAR 24D6 SEGENTRY K2INRESTAR,Z2INRESTAR 24XQ SEGENTRY K3INRESTAR,Z3INRESTAR 25CB # 25X2 # 26BL # K1 ENTRY: CONTROLS RESTART DURING INPUT 26W= # K2 ENTRY: EXPANDS TABS 2764 ...# K3 ENTRY : INPUT FULL CASE 27*W # 27TG XJOVER +JOVER 28*6 QMASK #777777 28SQ # 29#B # 29S2 Z1INRESTAR 2=?L LDX 0 FINISH [TEST IF 'FINISH' COMMAND 2=R= SLL 0 2 2?=W BNG 0 WRECK [J IF 'FINISH NOW' 2?QG LDN 0 127 2#=6 DCA ,STO,0,COUNT [COUNT=127 2#PQ REP LOCKC 2,£ [LOCK UP CPAT 2*9B GPERI ,2 2*P2 COOR1 2B8L UNLOCK 2 [UNLOCK CPAT 2BN= LDX 2 AWORK3(2) [PTR TO BUFFER 2C7W SBN 2 A1+2 2CMG UNLOCK 2 [UNLOCK BUFFER 2D76 RESTART YTM1,WRECK,REP1 2DLQ CALL 3 RESADD [RESTORE BUFFER/PERI ADDRESSES 2F6B LDX 0 CPRW1(2) [REPLY WORD 2FL2 ANDX 0 QMASK(1) 2G5L DCA ,LDX,3,CTSA [PERI ADDRESS 2GK= SBN 3 A1+2 [PTR TO ADATA/ALINE 2H4W DCA ,LDX,7,COUNT [PERI COUNT 2HJG SBX 7 0 [N/CH IN RECORD 2J46 SRC 7 2 2JHQ LDCT 0 #600 2K3B ANDX 0 7 2KH2 LDCH 4 AWORK4(2) [LAST SHIFT 2L2L SLL 4 6 2LG= ORX 0 4 2L^W STO 0 A1+1(3) [2ND WORD OF RED TAPE 2MFG SLC 7 2 2M^6 LDX 0 7 [N/CH IN REC. 2NDQ ADN 0 11 2NYB SRL 0 2 [N/W IN REC+RED TAPE 2PD2 STO 0 A1(3) [RECORD HEADER 2PXL LDN 1 #22 [ALPHA 2QC= LDN 2 #26 [PREVIOUS 2QWW STOZ 6 2RBG NAMETOP 3,ADATA,ACONV 2RW6 TRANSFORM 1,2 [CONVERT RECORD TO PREVIOUS 2S*Q TESTREP2 SHIFT,SHIFT1 [J IF RECORD CONVERTED 2STB NGN 6 1 [SWITCH 2T*2 SHIFT1 2TSL NAMETOP 3,ADATA,ALINE 2W#= LDX 0 A1(3) [N/W IN NEW REC. 2WRW SBN 0 2 [-RED TAPE 2X?G SLL 0 2 2XR6 LDX 4 A1+1(3) 2Y=Q SLC 4 2 2YQB ANDN 4 3 [N/CH IN LAST WORD 2^=2 BZE 4 OK 2^PL SBN 0 4 329= ADX 0 4 [X0=N/CH IN RECORD 32NW OK ADN 7 1 [N/CH IN OLD REC.+1 338G SBX 7 0 [SUBTRACT N/CH IN NEW RECORD 33N6 ADS 7 CPRW1(2) [CORRECT REPLY WORD 347Q LDN 0 128 34MB DCA ,STO,0,COUNT [RESTORE PERI COUNT 3572 STO 6 ACOMMUNE1(2) [SET UP SWITCH 35LL UP 366= YTM1 UPPLUS 1 [UP IF BREAK IN 36KW WRECK UPPLUS 2 [UP IF CANTDO 375G # 37K6 REP1 CALL 3 RESADD [RESTORE BUFFER/PERI ADDRESSES 384Q BRN REP 38JB # 3942 RESADD 39HL SBX 3 FX1 3=3= MHUNT 1,ADATA,ALINE 3=GW LOCKC 1,SALINE [LOCK UP BUFFER 3?2G MHUNT 1,ADATA,ALINE 3?G6 ADN 1 A1+2 [BUFFER PTR 3?^Q SBX 1 AWORK3(2) 3#FB BZE 1 NOMOV [BUFFER HAS NOT BEEN MOVED 3#^2 ADX 1 AWORK3(2) 3*DL STO 1 AWORK3(2) [UPDATE BUFFER ADDRESS 3*Y= DCA ,STO,1,CTSA [UPDATE PERI ADDRESS 3BCW NOMOV LDX 1 FX1 3BXG ADX 3 1 3CC6 EXIT 3 0 3CWQ # 3DBB SALINE 3DW2 MHUNT 2,ADATA,ALINE 3F*L EXIT 1 0 3FT= # 3G#W SATB 3GSG MHUNT 2,AINPAR,ATB 3H#6 EXIT 1 0 3HRQ # 3J?B # 3JR2 # R O U T I N E T O E X P A N D T A B S 3K=L # 3KQ= Z2INRESTAR 3L9W HUNT 1,AINPAR,ATB [TABS BLOCK 3LPG LDX 6 1 3M96 ADX 6 ALOGLEN(1) 3MNQ ADN 6 A1-2 [ABOUT THE END OF THE ATB 3N8B ADN 1 A1 [PTR TO HEADER 3NN2 STO 1 AWORK4(2) [N/CH IN RCD + RT 3NXS ... SMO 7 3P7L ... LDX 5 A1 [NO. OF WORDS IN ALINE RECORD 3PCD ... SLL 5 2 [CONVERT TO CHARACTERS 3PG3 ... SMO 7 3PJL ... LDX 0 A1+1 3PM9 ... SLC 0 2 3PPS ... ANDN 0 3 [NO CHARS IN LAST WORD 3PSC ... BZE 0 XOK 3PX2 ... SBN 5 4 3P^K ... ADX 5 0 [X5=N/CH IN RECORD 3Q48 ...XOK STO 5 AWORK2(2) 3Q6W SBN 5 8 [-RED TAPE 3QLG LDX 3 0(1) [N/TABS 3R66 ADN 3 1(1) [PTR FOR INF IN AINPAR/ATB 3RKQ BZE 5 RCEND [J IF EMPTY RECORD 3S5B STOZ 4 [N/CH IN GRAPHIC 3SK2 LDX 2 7 [PTR TO ADATA/ALINE 3T4L ADN 2 A1+2 [PTR TO RCD 3TJ= NXTCH LDCH 0 0(2) [LOAD CHAR 3W3W SBN 0 #74 3WHG BPZ 0 SHIFT [J IF A SHIFT 3X36 UPDT ADN 4 1 [N/CH GRAP 3XGQ UPDAT BCHX 2 £ [UPDATE PTR 3Y2B BCT 5 NXTCH 3YG2 BRN RCEND [J IF NO MORE CHARS IN RCD 3Y^L SHIFT SBN 0 2 3^F= BNZ 0 UPDAT [J IF NOT DELTA 3^YW SHDEL BCHX 2 £ 42DG BCT 5 SUCS [J TO TEST SUCCESOR 42Y6 BRN RCEND [J IF NO MORE RECORDS 43CQ SUCS LDCH 0 0(2) [LOAD SUCCESOR 43XB SBN 0 #30 44C2 BZE 0 XBSP [J IF BACKSPACE 44WL SBN 0 1 45B= BZE 0 XTAB [J IF TAB 45TW SBN 0 4 46*G BZE 0 XCRET [J IF CAR.RETURN 46T6 SBN 0 3 47#Q BPZ 0 UPDT [J IF CHAR 47SB BRN UPDAT [NOT CHAR. 48#2 XBSP SBN 4 1 48RL BRN UPDAT 49?= XCRET STOZ 4 49QW BRN UPDAT 4==G XTAB BCHX 2 £ 4=Q6 BCT 5 SPACE [J TO INSERT SPACES 4?9Q #SKI 4?PB BRN RCEND 4#92 SPACE SMO FX2 4#NL LDX 1 AWORK4 [PTR TO N/TABS 4*8= LDX 7 0(1) [N/TABS 4*MW TESTB LDX 0 1(1) [TAB 4B7G SBX 0 4 [TAB-N/GRAP.CHAR 4BM6 SBN 0 1 4C6Q BZE 0 NXTAB [J IF NO SPACES TO INSERT 4CLB BPZ 0 SPIN [J TO INSERT SPACES 4D62 NXTAB ADN 1 1 [UPDATE PTR 4DKL BCT 7 TESTB [J TO TEST NEXT TAB 4F5= ...# THIS TAB POSITION CANNOT BE MATCHED WITH 4FJW ...# A TAB IN THE TABS BLOCK, SO WE DEFAULT TO ONE SPACE. 4G4G ... 4GJ6 ... LDN 0 1 [ NUMBER OF SPACES = 1 4K2= [ THE SECTION UP TO OKTABLEN LENGTHENS THE AINPAR/ATB IF THERE 4KFW [ ARE MORE TAB CHARACTERS, '^)', IN A RECORD THAN THERE ARE TAB 4K^G [ POSITIONS SPECIFIED IN THE 'TABS' QUALIFIER UNLESS THE ATB 4LF6 [ IS ALREADY LONG ENUF (BECAUSE OF SOME PREVIOUS ALTLENG). 4LYQ SPIN 4MDB LDX 7 6 4MY2 SBX 7 3 [CHECK IF X3 NOT BEYOND END OF ATB 4NCL BPZ 7 OKTABLEN [J IF ATB IS LONG ENUF 4NX= LDX 1 FX2 4PBW STO 2 ACOMMUNE4(1) [SAVE X2 4PWG STO 0 ACOMMUNE5(1) [SAVE X0 4QB6 LDX 2 AWORK4(1) [PTR TO HEADER 4QTQ LDX 7 0(2) [N/TABS 4R*B MHUNT 1,AINPAR,ATB 4RT2 SLL 7 2 [MULTIPLY BY 4 4S#L ADX 7 ALOGLEN(1) 4SS= ALTLENG 1,7,SATB 4T?W MHUNT 1,AINPAR,ATB 4TRG LDX 6 1 4W?6 ADX 6 ALOGLEN(1) 4WQQ ADN 6 A1-2 [NEAR THE END OF NEW ATB 4X=B ADN 1 A1 4XQ2 SBX 1 AWORK4(2) [GET AMOUNT MOVED BY HEADER 4Y9L ADS 1 AWORK4(2) [READJUST PTR TO HEADER OF ATB 4YP= ADX 3 1 [READJUST PTR FOR NEXT SET OF TAB POS 4^8W LDX 0 ACOMMUNE5(2) [RESTORE ORIGINAL X0 4^NG LDX 2 ACOMMUNE4(2) [AND X2 5286 OKTABLEN 52MQ STO 2 0(3) [STORE PTR AFTER TAB 537B STO 0 1(3) [STORE N/SPACES 53M2 ADX 4 0 [UPDATE N/CH IN GRAPHIC 546L SBN 0 2 [SUBTRACT 2 CHARS ^) 54L= SMO FX2 555W ADS 0 AWORK2 [UPDATE N/3H IN NEW RCD 55KG ADN 3 2 [UPDATE PTR 5656 #SKI 1 56JQ BNZ 5 NXTCH [J TO SEARCH NEXT TABS 574B #SKI 57J2 BRN NXTCH [J TO SEARCH TABS 583L RCEND LDX 2 FX2 58H= STOZ 0(3) [PUT ZERO INTO AININF 592W TABEX LDN 3 503 59GG LDX 4 AWORK2(2) [N/CH IN NEW RECORD 5=26 ADN 4 3 5=FQ SRL 4 2 [N/W IN NEW RECORD 5=^B BXL 4 3,OKL [TEST LENGTH OF NEW RCD 5?F2 LDN 4 2008 [RCD MAX 5?YL STO 4 AWORK2(2) [CHANGE RECORD LENGTH 5#D= LDN 4 502 [USE MAX LENGTH 5#XW OKL LDCH 0 AWORK1(2) 5*CG SBN 0 #44 5*X6 BNZ 0 STEP1 [J IF NOT GRAPHIC INPUT 5BBQ SETUPCOR 4,3,ADATA,ACONV [SET UP BLOCK FOR CONVERSION 5BWB ADN 3 A1 [PTR TO RED TAPE 5CB2 BRN RECMV [J TO MOVE RECORD 5CTL STEP1 LDX 3 4 5D*= STEP 0,0(3) 5DSW TESTREP2 FILEFULL,YTMX,APPWAIT,WAITSTEP1 5F#G RECMV LDX 6 AWORK3(2) 5FS6 SBN 6 2 [PTR TO ADATA/ALINE 5G?Q LDX 7 3 [PTR TO FURB 5GRB MHUNT 1,AINPAR,ATB 5H?2 ADX 1 A1(1) 5HQL ADN 1 A1+1 5J== LDX 0 0(1) [PICK UP PTR 5JPW BNZ 0 TEX4 [J IF TABS TO EXPAND 5K9G SMO 4 5KP6 MOVE 6 0 [MOVE RCD INTO FURB 5L8Q BRN NEWRT [J TO UPDATE RED TAPE 5LNB TEX4 LDX 4 AWORK2(2) [N/CH IN NEW RCD 5M82 TEX LDX 5 0(1) [PTR TO TAB 5MML BZE 5 TBFIN 5N7= SLC 5 2 5NLW SLC 6 2 5P6G SBX 5 6 [N/CH+TAB 5PL6 SRC 6 2 5Q5Q SBN 5 2 [N/CH TO MOVE 5QKB TNCH LDN 2 511 5R52 BXGE 5 2,PPART [J TO MOVE PER PARTES 5RJL BZE 5 NOMV [J IF NO CHARS TO MOVE 5S4= LDX 2 5 [N/CH TO MOVE 5SHW PPART SBX 4 2 [N/CH IN RCD 5T3G SBX 5 2 [N/CH TO MOVE 5TH6 MVCH 6 0(2) 5W2Q BRN TNCH [TEST IF MORE CHARS TO MOVE 5WGB NOMV LDX 5 1(1) [N/SPACES 5X22 LDN 0 #20 [LOAD SPACE 5XFL LDX 2 7 [PTR FOR SPACE 5X^= DCH 0 0(2) [INSERT SPACE 5YDW SBN 5 1 5YYG SBN 4 1 [- 1 CHAR 5^D6 LDX 0 7 5^XQ BCHX 0 £ 62CB SPEX LDN 2 511 62X2 BXGE 5 2,PERP [J IF N/SPACES>510 63BL BZE 5 ONESP [J IF ALL SPACES EXPANDED 63W= LDX 2 5 [N/SPACES TO EXPAND 64*W PERP SBX 4 2 [N/CH IN RCD-N/SP EXPANDED 64TG SBX 5 2 [TOTAL N/SP-NSP EXPANDED 65*6 MVCH 7 0(2) [EXPAND SPACES 65SQ BRN SPEX [J TO EXPAND SPACES 66#B ONESP BCHX 7 £ 66S2 ADN 1 2 [UPDATE PTR IN AININF 67?L BCHX 6 £ 67R= BCHX 6 £ [IGNORE ^) 68=W BRN TEX 68QG TBFIN BZE 4 NEWRT [NO CHARS TO MOVE 69=6 SMO 4 69PQ MVCH 6 0 [MOVE REST OF RCD 6=9B # 6=P2 # ROUTINE TO UPDATE THE RED TAPE AND CONVERT THE RECORD MODE 6?8L # TO GRAPHIC IF NECESSARY 6?N= # X3=PTR TO RCD RED TAPE 6#7W # AWORK2=N/CH IN RCD 6#MG NEWRT 6*76 LDX 2 FX2 6*LQ LDX 1 AWORK2(2) [N/CH IN RECORD 6B6B NGX 0 1 6BL2 SRC 1 2 6C5L LDN 4 #7777 6CK= ANDS 4 1(3) [CLEAR B0,B1 6D4W LDCT 4 #600 6DJG ANDX 4 1 6F46 ORS 4 1(3) [UPDATE N/CH IN LAST WORD 6FHQ ANDN 0 #3 6G3B BZE 0 WF 6GH2 LDN 4 #20 [SPACE 6H2L STOR1 SMO 3 6HG= DCH 4 0(1) [SPACEFILL 6H^W BCHX 1 £ 6JFG BCT 0 STOR1 6J^6 WF STO 1 0(3) [RECORD LENGTH 6KDQ LDCH 0 AWORK1(2) 6KYB SBN 0 #44 6LD2 BNZ 0 RESTO [J IF NOT GRAPHIC 6LXL LDN 1 #26 6MC= LDN 2 #10 6MWW TRANSFORM 1,2 [CONVERT THE RECORD TO GRAPHIC 6NBG NEWSTEP 6NW6 MHUNT 2,ADATA,ACONV 6P*Q LDX 3 A1(2) 6PTB STEP 0,0(3) 6Q*2 TESTREP2 FILEFULL,YTMX,APPWAIT,WAITNEW 6QSL MHUNT 2,ADATA,ACONV 6R#= ADN 2 A1 [RECORD PTR 6RRW LDX 1 0(2) [N/W IN THE RECORD 6S?G MOVE 2 0(1) [MOVE RCD INTO FURB 6SR6 SBN 2 A1 6T=Q FREECORE 2 [FREE ACONV BLOCK 6TQB RESTO UP 6W=2 [ 6WPL WAITSTEP1 6X9= CALL 7 WAIT 6XNW BRN STEP1 6Y8G WAITNEW 6YN6 CALL 7 WAIT 6^7Q BRN NEWSTEP 6^MB WAIT SBX 7 FX1 6^X8 LONGSET IWTDEST,XGEOERR 7272 LONGSTOP XBRK,, 72LL ADX 7 FX1 736= EXIT 7 0 73KW [ 745G YTMX 74K6 [ FILEFULL-HANDLING MACRO 754Q INPUTFULL XBRK,ROK,JOVER 75JB UPONE 7642 UPPLUS 1 [IF NON-MULTIFILE IS FULL 76HL XBRK 773= UPPLUS 2 [BREAK-IN 77GW ROK 782G LDCH 0 AWORK1(2) 78G6 SBN 0 #44 78^Q BNZ 0 STEP1 [J IF NOT GRAPHIC 79FB BRN NEWSTEP [J IF 79^2 # 7=DL Z3INRESTAR 7=Y= LDX 3 ACOMMUNE1(2) 7?CW STO 3 AWORK1(2) [ STORE JOVER,JOVER1 7?XG TESTMULT XMULT [ J IF MULT 7#C6 ISITJOB NOTJOB [ J IF NOT JOB 7#WQ CLOSEABANDON 7*BB SETERR [ SET ERROR FLAG FOR C.P. 7*W2 SETUP SETNCORE 10,3,ADATA,CREADL [ SET UP BLOCK FOR ERROR REPORT 7B*L STOZ A1(3) 7BT= UNNORM TWO [ USE FABSNB FROM USEROPEN 7C54 ... MHUNT 3,ADATA,CREADL [ REHUNT BLOCK AFTER COORDINATION. 7C#W LDX 3 A1(3) [ X3= NO. OF CHARS. 7CSG OUTPARAM 3,CPDATA,ADATA,CREADL 7D#6 MFREEW ADATA,CREADL 7DRQ LDX 3 AWORK1(2) [ CONTAINS IDENT. FOR MONOUTX 7F?B ... BXU 3 XJOVER(1),MONOUT [ J IF JOVER1 7FR2 OUTPER 7G=L MONOUT 7GQ= MONOUTX AWORK1(2) [ FILE HAS OVERFLOWED 7H9W UPPLUS 3 7HPG XMULT CLOSE [ CLOSE ELEMENT OF M,F 7J96 CREATEB 3 [ SET UP CREATE BLOCK 7JNQ TOPFCB 1 [ GET FCB 7K8B LDX 5 FETM(1) 7KN2 STO 5 CETM(3) [ GET FILE MODE FROM FCB 7L7L BS 3,CESERIAL [ SERIAL FILE 7LM= BS 3,CEMULT [ MULTIFILE 7M6W ISITJOB XOVER [ J IF NOT JOB 7MLG BS 3,CETEMP [ TEMPORARY FILE 7N66 XOVER 7N7H ...#UNS FTS1 7NBJ ... USEROPEN XBRKIN,APPEND,CREATE,EMPTY,STREAMCOMP,FROZEN 7NFB ...#UNS FTS1 7NGR ...#SKI 7Q4L USEROPEN XBRKIN,APPEND,CREATE,EMPTY,STREAMCOMP 7QJ= REPERR2 REPOK [ GOOD REPLY 7R3W BRN SETUP [ REPORT ERROR 7RHG REPOK UPPLUS 2 7S36 XBRKIN 7SGQ CLOSEMULT [ MDF STILL OPEN 7T2B UPPLUS 1 7TG2 NOTJOB 7T^L CLOSE 7WF= BRN SETUP 7WLD XGEOERR 7WRL GEOERR 1,LONGSET? 7WYW SEGENTRY K99INRESTAR 7XDG MENDAREA 50,K99INRESTAR 7XY6 # 7YCQ #END ^^^^ ...17113000000500000000