{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: INRESTAR84)}}
====== INRESTAR84 ======
(George Source)
**Macros used:** [[george:macro:ALTLENG|ALTLENG]], [[george:macro:BS|BS]], [[george:macro:BXGE|BXGE]], [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:CLOSE|CLOSE]], [[george:macro:CLOSEABANDON|CLOSEABANDON]], [[george:macro:CLOSEMULT|CLOSEMULT]], [[george:macro:COOR1|COOR1]], [[george:macro:CREATEB|CREATEB]], [[george:macro:DCA|DCA]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GPERI|GPERI]], [[george:macro:HUNT|HUNT]], [[george:macro:INPUTFULL|INPUTFULL]], [[george:macro:ISITJOB|ISITJOB]], [[george:macro:LOCKC|LOCKC]], [[george:macro:LONGSET|LONGSET]], [[george:macro:LONGSTOP|LONGSTOP]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MONOUT|MONOUT]], [[george:macro:MONOUTX|MONOUTX]], [[george:macro:NAMETOP|NAMETOP]], [[george:macro:OUTPARAM|OUTPARAM]], [[george:macro:OUTPER|OUTPER]], [[george:macro:REPERR2|REPERR2]], [[george:macro:RESTART|RESTART]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETERR|SETERR]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:STEP|STEP]], [[george:macro:TESTMULT|TESTMULT]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:TOPFCB|TOPFCB]], [[george:macro:TRANSFORM|TRANSFORM]], [[george:macro:UNLOCK|UNLOCK]], [[george:macro:UNNORM|UNNORM]], [[george:macro:UP|UP]], [[george:macro:UPPLUS|UPPLUS]], [[george:macro:USEROPEN|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