(George Source)
Macros used: ACROSS, ADDMODE, BACKWAIT, BWNZ, CHAIN, CLOSE, CLOSEABANDON, CLOSEMULT, CLOSETOP, COMBRKIN, CORRUPTB, DOWN, ENDCOM, ERASE, ERASTREM, ERRORX, FILEMOVE, FILENUMB, FNORM, FREEBAX, FSHENTRY, GEOERR, HUNT, HUNT2, INCREAMBS, JBC, JBS, MBI, MENDAREA, MFREE, MFREEW, MHUNT, MHUNTW, MONOUT, MTCHECK, NAME, NAMETOP, OPEN, OUTPARAM, PARANUMB, READB, REPERR, REPERR2, SEG, SEGENTRY, SETMODE, SETUPMODE, SFCB, SFSTACK, SUBCUBS, TESTNAMX, TESTREP2, TESTRPN2, TOPFCA, TOPFCA2, TOPFCB, TRACE, TREP2, TREPN2, UNIFREE, USEROPEN, USEROPEX, VFREEW, WHATBACK, WRITEB
22#C ... SEG COPYA,8,FILE, USERCOMS 22LS ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 22^= [ 23DW [ 23YG SEGENTRY K1COPYA,QENTRY 24D6 SEGENTRY K2COPYA,QGAPPEND 24XQ SEGENTRY K3COPYA,QGNOAPPEND 25CB SEGENTRY K4COPYA,QMAPPEND 25X2 SEGENTRY K5COPYA,QMNOAPPEND 26BL SEGENTRY K13COPYA,XERROR3 26W= SEGENTRY K18COPYA,XERROR8 27*W SEGENTRY K19COPYA,XERROR9 27TG SEGENTRY K26COPYA,XBRK6 28*6 SEGENTRY K27COPYA,XBRK7 28SQ SEGENTRY K28COPYA,XBRK8 29#B SEGENTRY K31COPYA,XEND1 29S2 SEGENTRY K36COPYA,XEND6 2=?L SEGENTRY K39COPYA,XEND9 2=HD ... SEGENTRY K40COPYA,XERROR6 2=M* ... SEGENTRY K41COPYA,XERROR7 2=R= [ 2=YD ... FSHENTRY K45COPYA,XEND2FROMB,,XEND2FROMB 2?5L ... FSHENTRY K46COPYA,QMENDFROMB,,QMENDFROMB 2?=W [ 2?GN ... SEGENTRY K47COPYA,XEND2 2?QG [ 2#=6 [ THIS COMMAND SEGMENT COPIES AN EXISTING FILE TO A NEW FILE. THE 2#PQ [ FORMER WILL BE CALLED THE 'INFILE' & THE LATTER THE 'OUTFILE'. 2*9B [ THE SEGMENT BRANCHES INTO DIFFERENT PATHS DEPENDING ON WHETHER THE 2*P2 [ INFILE IS A GARDEN FILE, MULTIFILE, DIRECTORY, OR OFF-LINE. 2B8L [ 2BN= [ AWORK1 = NO. OF FILES OPEN AT K1COPY & ARE TO BE LEFT OPEN WHEN 2C7W [ LEAVING THE SEGMENT. 2CMG [ AWORK2 IS +VE IF NOT FIRST TIME THRU A LOOP 2D76 [ X6 AT XEND TIME => -VE IF BRKIN HAS OCCURRED AND GOES TO COMBRKIN 2DLQ [ B0-X5 = 1 => INFILE IS A MULT; B15-23 OF X5 SET => OUTFILE IS A MULT 2F6B [ B15-23 OF X5 ALSO = NO. OF NEW ELEMENTS (EXCLUDING MDF) 2FL2 [ AWORK3 -VE => OUTFILE IS A NEW FILE (TO BE ERASED IF INFILE NOT OK) 2FP6 ...#UNS FCYCOMM 2FS= ...[ AWORK4 = B0 SET => APPEND, B10 SET => GDR, B16 SET => COMMUNE 2FXB ...#UNS FCYCOMM 2G2G ...#SKI 2G5L [ AWORK4 = 0 => NOT APPEND (ADJUNCTS FREED, IF ANY); -VE => APPEND 2GK= [ 2H4W [ NOTE ON LIMITING ONLINE B. S. 2HJG [ IN THE NON-APPEND CASE (OVERWRITE, CREATE), DO INCREAMBS (BY THE SIZE 2J46 [ OF THE INFILE) AFTER INFILE OPENED & BEFORE OUTFILE OPENED, SINCE 2JHQ [ OUTFILE CANT BE LARGER THAN INFILE. OFF-LINE FILES ARE 2K3B [ EXCEPTIONS SINCE OUTFILE OPENED FIRST. FOR NON-*DA FILES THE 2KH2 [ OUTFILE SHOULD HAVE ZERO BLOX & INCREAMBS CANT BE DONE CORRECTLY. 2L2L [ SO GET INFILE SIZE (ECOPS), DOUBLE IT, & INCREAMBS--& MAY AS WELL 2LG= [ DO THIS BEFORE OUTFILE OPENED - IN CASE OF ERRORS. 2L^W [ IN APPEND CASE DO INCREAMBS AFTER BOTH FILES OPENED. IN EITHER CASE 2MFG [ IF INCREAMBS NOK, OUTFILE IS INTACT. THUS NO NEED FOR 2M^6 [ WRITEB WITH BRKIN LABEL. 2NDQ TCLUDGE +ACLUDGE 2PRP ...MEINF1 #56400020 [SER, MDF, MULTEL, MTFILE, PFCC 2Q7D ... [AND FHDIRMODE BITS OF EINF1 2QH7 ...MEINF1A #54400020 [NO MULTELEM -- FOR COPYING ELEMS 2R2R ...SYST 12HSYSTEM 2RGC ... 12HINCINDEX 2TSL [ 2W#= [ 2WRW [ 2X?G QENTRY [COMMAND ENTRY 2XR6 LDN 5 0 2Y=Q STOZ AWORK3(2) 2YQB STOZ AWORK2(2) 2^=2 STOZ AWORK4(2) 2^PL CALL 4 RFILENUMB 329= STO 3 AWORK1(2) [THIS NO. OF FILES LEFT OPEN AT END 32NW PARANUMB 3 338G SBN 3 2 33N6 BZE 3 PARA1 347Q BNG 3 XERROR1 [PARAM(S) MISSING 34MB BRN XERROR2 [TOO MANY PARAMS 3572 PARA1 35LL CALL 4 RSPARNORM1 [GET INFILE NAME 366= BRN XEND [NAMEFORM REPLY 36KW #SKI K6COPYA>599-599 375G ( 37K6 MHUNT 1,CPB,CUNI 384Q TRACE APARA(1),COPY 38JB ) 3=GW USEROPEN XBRK1,READR,LEAVE,STREAMS,NOWAIT,TERMDIR 3?2G TESTREP2 MAG,QMAG 3?G6 REPERR2 ROK 3?^Q BRN XEND 3#FB ROK 3#^2 TREP2 MULTFILE,QMULT [J IF MULTIFILE 3*DL TREP2 DIR,QDIR [J IF DIRECTORY 3*KS ... TOPFCA2 3 3*R2 ... JBS QDIR,3,BANOWAIT [TREAT SYS FILES CAREFULLY 3*Y= [ 3BCW [ 3BXG QGAR [PATH FOR GARDEN FILES 3CC6 [ THE INFILE IS A GARDEN FILE; IF THE OUTFILE IS A MULTIFILE THE 3CWQ [ PATH JUMPS TO THE QS-PATH. OTHERWISE A CHECK IS MADE FOR 3DBB [ ENUF SPACE IN THE OUTFILE IN THE APPEND CASE. 3DW2 [ 3F*L ... DOWN COPYB,4 [SET UP CREATE BLOCK 3FT= CALL 4 RTOPFCB 3G#W LDX 6 FBLMOD(2) [GET NO. OF BLKS FOR OUTFILE 3GSG SBN 6 FBLKS-A1 3GWP ... MHUNTW 3,FILE,CREATE 3GXS ... JBS SERMAX,2,BFSER [KEEP MAXIMUM SIZE IF SERIAL 3GYY ... LDX 0 FSIZE(2) [ENSURE EINF3(FSIZE) SET UP 3H37 ... DEX 0 CEINF3(3) [CORRECTLY FOR OUTFILE IF 3H5B ... [CREATING OR OVERWRITING. CANT 3H7K ... [RELY ON VALUE GOT FROM ENT 3H9S ... [IT MAY EASILY BE OUT OF DATE. 3H9^ ...SERMAX 3H=6 ... LDX 0 FENDBUCK(2) [DITTO: ENDBUCK AND VERSION DATA 3H=D ... STO 0 CEENDBUCK(3) 3H=Q ... LDX 0 FVERSION(2) 3H?4 ... STO 0 CEVERSION(3) 3H?B ... LDX 0 FETM(2) [EVEN TYPE.MODE CAN CHANGE 3H?N ... STO 0 CETM(3) 3H#6 CALL 4 RFREEW 3HRQ CALL 4 RSPARNORM2 3J?B BRN XEND2 3JR2 LDX 0 AWORK4(2) 3K=L BNG 0 QGUSEROP2 [J IF APPEND CASE 3KQ= CALL 4 RINCREAMBS 3L9W BRN XBRK2 3LPG QGUSEROP2 3M96 CALL 4 RWHATBACK 3MNQ #SKI K6COPYA>599-599 3N8B ( 3NN2 MHUNT 1,CPB,CUNI 3P7L TRACE APARA(1),CYQGAR 3PM= ) 3PQP ...#UNS FCYCOMM 3PW8 ...( 3P^M ... STOZ 4 [INITIALISE 2ND MODE WORD 3Q56 ... LDEX 0 AWORK4(2) 3Q8K ... BZE 0 NCOM [J IF COMMUNE NOT SPECIFIED 3Q#4 ... SETUPMODE 7,4,APPEND,COMMUNE,CREATE,EMPTY,GDR 3QCH ... ANDX 4 AWORK4(2) [ADD IN GDR IF SPECIFIED 3QH2 ... TOPFCA2 3 3QLF ... MBI 3,BAMREADR,BAMREAD [CHANGE OPEN MODE TO READ 3QPY ... BRN OPEN 3QTC ...NCOM 3QYW ... SETMODE 7,WRITE,CREATE,EMPTY,STREAMS 3R4* ...OPEN 3R7S ... USEROPEX XBRK2,7,4 [OPEN OUTPUT FILE 3R?? ...) 3RBQ ...#UNS FCYCOMM 3RG9 ...#SKI 3RKQ USEROPEN XBRK2,WRITE,CREATE,EMPTY,STREAMS 3S5B TESTREP2 CLUDGE,XERROR4 3SK2 QGREP 3T4L REPERR QGTREP 3TJ= BRN XEND2 3W3W QGTREP 3WHG TREP2 MULTFILE,QMULTEL [J IF MULTIFILE 3X36 CALL 4 RFREEW2 3XGQ LDX 0 AWORK4(2) [CHECK IF APPEND CASE 3Y2B BPZ 0 QGNOAPPEND 3YG2 QGAPPEND 3Y^L CALL 4 RINCREAMBS [FOR APPEND CASE 3^F= BRN XBRK2 3^HF ...#UNS FCYCOMM 3^KN ...( 3^MX ... LDX 0 BIT10 3^Q6 ... ANDX 0 AWORK4(2) 3^S* ... BNZ 0 QGFILLOUT [OMIT MAX SIZE CHECK IF GDR GIVEN 3^WJ ...) 3^YW CALL 4 RTOPFCB 42DG LDX 3 FBLMOD(2) [IF APPENDING, CHECK THAT OUTFILE 42N# ... SBX 3 FSIZE(2) 42Y6 LDN 0 1 [PLUS INFILE FBLMODS DO NOT EXCEED 43CQ ... CALL 4 RSFCB [MAXIMUM SIZE OF OUTPUT FILE 43XB ADX 3 FBLMOD(2) 44C2 ... SBN 3 FBLKS-A1*2+1 45B= BPZ 3 XERROR7 [J IF INFILE TOO BIG 45TW BRN QGFILLOUT 46*G QGNOAPPEND 46T6 CALL 4 RSUBCUBS 47#Q QGFILLOUT [LOOP WHICH READS FROM INFILE & 47B^ LDN 0 1 47F8 CALL 4 RSFCB [X2-> FCB OF INFILE 47HC LDX 7 FBLMOD(2) 47KL SBN 7 FBLKS-A1 47KY ... LDN 4 0 [NUMBER OF MT INDEX BLOCKS 47L= ... JBC TOXLOOP,2,BFMT [J UNLESS MTFILE 47LJ ... LDX 4 BULKMOD(2) [NUMBER OF INDEX BLOCKS 47LW ... LDN 3 0 [BULK FILE START ADDRESS 47M8 ... LDX 6 7 47MG ... SBX 6 4 [NUMBER OF BULK BLOCKS 47MK ...TOXLOOP 47PF ...#UNS FCYCOMM 47PJ ...( 47PM ... SMO FX2 47PQ ... LDEX 0 AWORK4 47PT ... BZE 0 XLOOP [J IF NOT COMMUNE 47QN ... ACROSS COPYB,3 47RH ...) 47RL ...XLOOP 47RP ... BZE 7 XEND2 [NO BLOCKS IN FILE 47SB READB 1 [WRITES TO OUTFILE 48#2 MHUNT 1,FILE,FRB 48RL LDX 0 ALOGLEN(1) 49?= BZE 0 XEND2 49QW NAME 1,FILE,FWB 49R5 ... BZE 4 NOMTCHECK [J UNLESS MT INDEX BLOCK 49R# ... MTCHECK FILE,FWB,3,6 [CHECK DATA 49RH ... LDX 3 ACOMMUNE1(2) [UPDATED BULK FILE ADDRESS 49RQ ... SBN 4 1 [DECREMENT INDEX BLOCK COUNT 49R^ ... BNZ 4 MOREINDEX [J IF MORE INDEX BLOCKS EXPECTED 49S8 ... TESTREP2 ENDFILE,NOMTCHECK [J IF BLOCK OK & CONTAINS END 49SC ...MTCORRUPT [CORRUPTION DETECTED: ABANDON COMMAND 49SL ... MHUNTW 1,FILE,FWB 49ST ... NAME 1,BSTB,BREAD [SO READFAIL CAN FIND IT 49T4 ... LDX 3 BACK1(1) [RESIDENCE NUMBER 49T? ... LDX 4 BACK2(1) [BLOCK NUMBER 49TG ... CORRUPTB 3,4 [REPORT CORRUPTION & ABANDON FILE 49TP ... CLOSEABANDON [OUTFILE 49TY ... BRN XEND2 49W7 ...[ 49WB ...MOREINDEX 49WK ... TESTRPN2 OK,MTCORRUPT [J IF CORRUPT OR UNEXPECTED EOF 49WS ...NOMTCHECK 49X6 SBN 7 1 4=3B LDN 0 0 4=7L SRC 70 2 4=?W BNZ 0 XNOWAIT 4=D6 BACKWAIT [WAIT FOR TRANSFER 4=JB LDN 0 0 4=NL XNOWAIT 4=SW SLC 70 2 4=^6 WRITEB ,XBRKX 4?5B BRN XLOOP 4?9Q [ 4?PB [ 4#92 QMULT [MULTIFILE PATH 4#NL [ IF EITHER THE INFILE OR THE OUTFILE OR BOTH ARE MULTIFILES 4*8= [ THE QM-PATH IS USED. IN THE APPEND CASE START WITH A NEW 4*MW [ ELEMENT. SO NO NEED TO CHECK SIZES OF ELEMENTS -- RATHER, 4B7G [ CHECK MADE ON NO. OF ELEMENTS IN OUTFILE. 4BM6 [ 4C6Q ORX 5 GSIGN [INFILE IS A MULTIFILE 4CLB CALL 4 RFREEW 4D62 QMULTNEXT 4DKL ... DOWN COPYB,4 [SET UP CREATE BLOCK 4F5= CALL 4 RTOPFCB 4FJW LDX 6 FSIZE(2) [GET MAX SIZE FOR MULTIFILES 4G4G MFREEW FILE,ENT 4GJ6 SMO FX2 4H3Q LDX 0 AWORK2 4HHB BNZ 0 QMNFIRSTIM [J IF NOT FIRST TIME 4J32 CALL 4 RSPARNORM2 4JGL BRN XEND2 4K2= LDX 0 AWORK4(2) 4KFW ... BNG 0 QMWB 4K^G CALL 4 RINCREAMBS 4LF6 BRN XBRK2 4LYQ ...QMWB 4TRG QMNFIRSTIM 4W?6 CALL 4 RWHATBACK 4WGY ... STOZ 4 [INITIALISE 2ND MODE WORD 4WQQ ... BWNZ AWORK2(2),QMN1ST [J IF NOT 1ST TIME 4WS3 ...#UNS FCYCOMM 4WT# ...( 4WWK ... SETMODE 7,WRITE,CREATE,EMPTY,STREAMS,STREAMONLY 4WXW ... LDEX 0 AWORK4(2) 4W^7 ... BZE 0 OPENMULT [J IF COMMUNE NOT SPECIFIED 4X2D ... ADDMODE 7,COMMUNE [ADD COMMUNE SO ERRORED BY USEROPEN 4X6? ...) 4X7J ...#UNS FCYCOMM 4X8T ...#SKI 4XNF ... SETMODE 7,WRITE,CREATE,EMPTY,STREAMS,STREAMONLY 4Y85 ... BRN OPENMULT 4YMP ...QMN1ST 4^7* ... SETUPMODE 7,4,WRITE,CREATE,FROZEN,STREAMCOMP 4^L^ ...OPENMULT 526K ... USEROPEX XBRK4,7,4 52L9 ... TESTREP2 CLUDGE,XERROR5 535T ...QMREP 53M2 ... REPERR QMULTEL 546L BRN XEND2 54L= QMULTEL 555W ADN 5 1 [INCREASE NO. OF NEW ELEMENTS 55KG LDX 0 AWORK2(2) 5656 BNZ 0 QMNOAPPEND [FILLING ELEMENT NO. > 2 56JQ LDN 0 1 574B STO 0 AWORK2(2) [HEREAFTER NOT FIRST TIME 57J2 TREPN2 NEWFILE,QMOLDFILE 583L LDX 0 GSIGN 58H= ORS 0 AWORK3(2) [MARK AS NEWFILE 592W QMOLDFILE 59GG CALL 4 RFREEW2 5=26 LDX 0 AWORK4(2) 5=FQ BPZ 0 QMNOAPPEND [J IF NOT APPEND CASE 5=^B QMAPPEND 5?F2 CALL 4 RINCREAMBS 5?YL BRN XBRK9 5#D= LDN 0 1 5#XW CALL 4 RSFCB [GET NO. OF ELEMENTS 5*CG LDEX 3 FSTREND(2) [OF OUTFILE FROM MDF 5*X6 SBN 3 1 [NEW ELEMENT NOT WRITTEN TO YET 5BBQ SEGENTRY K50COPYA [FOR TINYMULT MACRO 5BWB SBN 3 FMULTLEN 5CB2 BNG 5 QMINMULT [IF INFILE NOT MULT, ADD ONE 5CTL LDN 0 1 [TO NO. OF OUTFILE ELEMENTS 5D*= BRN QMLENCHEK [& CHECK IF LENGTH .LS. FMULTLEN 5DSW QMINMULT [IF INFILE IS MULT, GET ITS LENGTH 5F#G LDN 0 3 [FROM MDF, ADD TO OUTFILE LENGTH & 5FS6 CALL 4 RSFCB [CF. WITH FMULTLEN 5G?Q LDEX 0 FSTREND(2) 5GRB SBN 0 1 [SUBTRACT EXTRA MDF 5H?2 QMLENCHEK 5HQL ADX 0 3 5J== NGX 0 0 5JPW BNG 0 XERROR7 [J IF INFILE TOO BIG 5K9G QMNOAPPEND 5KP6 CALL 4 RSUBCUBS 5L8Q QMFILLOUT 5LNB READB 2 [ALWAYS READING AT LEVEL 2 5M82 MHUNT 1,FILE,FRB 5MML LDX 0 ALOGLEN(1) [NO CHECK FOR FILLED OUTFILE BCS 5N7= BZE 0 QMENDFILE [NOT APPENDING LIKE GARDEN FILES 5NLW NAME 1,FILE,FWB 5P6G WRITEB , XBRKX 5PL6 BRN QMFILLOUT 5Q5Q QMENDFILE [FINISH FILLING AN OUTFILE ELEMENT 5QKB BPZ 5 XEND2 [J IF INFILE NOT MULT 5R52 CLOSE [OUTFILE ELEMENT 5RJL LDN 1 0 5S4= LDN 2 2 5SHW CALL 4 RFILEMOVEX [OUTFILE MDF TO BELOW INFILE MDF 5T3G CLOSE [ELEMENT OF INFILE 5TH6 CALL 4 RCHAIN [INFILE MDF JUNK ABOVE OUTFILE 5X9R ... USEROPEN XBRK5,READR,STREAMCOMP,LEAVE,FROZEN 5X^= TESTREP2 ENDSTRM,XEND2 [IF ENDSTRM, INFILE MDF CLOSED 5YDW REPERR2 QMINELEMOK 5YYG BRN XEND2 5^D6 QMINELEMOK 5^XQ CALL 4 RCHAIN [OUTFILE MDF JUNK ABOVE INFILE'S 62CB LDN 1 2 62X2 LDN 2 0 63BL CALL 4 RFILEMOVEX [OUTFILE MDF TO ABOVE INFILE ELEM 63W= BRN QMULTNEXT [REPEAT WITH NEXT ELEMENT 64*W [ 64TG [ 65*6 QDIR 65SQ ACROSS COPYB,1 66#B QMAG 66B# ... LDEX 0 AWORK3(2) 66D= ... BZE 0 XACROSS [J IF NO NOWAIT QUALIFIER GIVEN 66G8 ... REPERR REPDAFT 66J6 ... BRN XEND2 [ ERROR REPORTED-FINISH OFF 66L4 ...REPDAFT 66N2 ... GEOERR 1,WOTREPLY 66PY ...XACROSS 66S2 ACROSS COPYB,2 67?L [ 67R= [ 6P*Q RCHAIN [ROUTINE WHICH RECHAINS JUNK TO 6PTB HUNT 1,CPB,CUNI [JUST BEHIND CURRENT ACTIVITY 6Q*2 HUNT2 1,CPB,CUNI 6QSL CHAIN 1,2 6R#= HUNT 1,FILE,FABSNB 6RRW HUNT2 1,FILE,FABSNB 6S?G CHAIN 1,2 6SR6 EXIT 4 0 6T=Q RWHATBACK 6TQB SBX 4 FX1 6TSK ... LDX 1 FX1 6TWS ... MHUNT 2,FILE,FABSNB 6T^3 ... TESTNAMX 6,SYST(1),A1+1(2),NOMATCH 6W3= ... WHATBACK 3,6,,,VSF 6W5F ... BRN XOUT 6W7N ...NOMATCH 6W=2 WHATBACK 3,6 6WFS ...XOUT 6WPL ADX 4 FX1 6X9= EXIT 4 0 6XNW RSUBCUBS [SETS FBLMOD TO MINIMUM/SUBCUBS 6Y8G CALL 1 REALTLENG 6YN6 LDX 0 FBLMOD(2) 6^7Q SBN 0 FBLKS-A1 6^MB BZE 0 RXX 7272 TOPFCA 2 [CANT USE X1 736= SUBCUBS 2,0,JOB 745G CALL 1 REALTLENG 74K6 LDN 0 FBLKS-A1 754Q STO 0 FBLMOD(2) 75JB RXX 7642 EXIT 4 0 76HL RINCREAMBS 773= SBX 4 FX1 77GW INCREAMBS RXBRK,6 782G TESTRPN2 OK,XERROR9 78G6 ADX 4 FX1 78^Q EXIT 4 1 79FB RXBRK 79^2 ADX 4 FX1 7=DL EXIT 4 0 7=Y= RSFCB 7?CW SFCB 0,2 7?XG EXIT 4 0 7#C6 RERRORX 7#WQ LDX 1 4 7*BB LDX 3 0(1) 7*W2 SBX 4 FX1 7B*L ERRORX 3 7BT= ADX 4 FX1 7C#W EXIT 4 1 7CSG RFILEMOVEX 7D#6 SBX 4 FX1 7DRQ FILEMOVE 0(1),0(2) 7F?B ADX 4 FX1 7FR2 EXIT 4 0 7G=L RERASELEM [ROUTINE WHICH ERASTREMS THE NEW 7GQ= [ ELEMENTS OF A MULTIFILE IN THE APPEND CASE 7H9W SBX 7 FX1 7HPG CALL 4 RTOPFCB [MDF 7J96 #SKI 7JNQ ( 7K8B [ MEDITATING ON K4/K7COMPOST CHANGE : NO UPDATE OF OHGN IN FSTREND 7KN2 [ IN K4 & UPDATE IF NOT CLOSESTRM IN K7 7L7L [ SO RETAIN THIS CODE 7LM= [ NEXT 10 LINES EXCHANGE NEW HIGHEST GEN. NO. & OHGN--FRIG TO 7M6W [ MAKE ERASTREM BELIEVE THAT OLD MULT OVERWRITTEN BY NEW SMALLER 7MLG LDCT 0 #377 7N66 ANDX 0 FSTREND(2) 7NKQ SLC 0 9 7P5B LDEX 1 FSTREND(2) 7PK2 DEX 0 FSTREND(2) 7Q4L SRC 1 9 7QJ= LDCT 0 #377 7R3W ANDX 0 FSTREND(2) 7RHG ERX 1 0 7S36 ERS 1 FSTREND(2) 7SGQ ) 7T2B [ WHEN APPENDING K4COMPOST UPDATES BOTH NHGN & OHGN IN FSTREND 7TG2 LDEX 0 FSTREND(2) 7T^L LDEX 1 5 7WF= SBX 0 1 [DECREASE NO. OF NEW ELEMS 7WYW DEX 0 FSTREND(2) 7XDG ERASTREM 7XY6 ADX 7 FX1 7YCQ EXIT 7 0 7YXB RFILENUMB 7^C2 FILENUMB 3 7^WL EXIT 4 0 82B= RSPARNORM2 82TW LDX 3 GSIGN 83*G RSPARNORM1 83T6 SBX 4 FX1 84#Q SPARAPASS 84SB MHUNT 1,CPB,CUNI 85#2 LDX 0 ANUM(1) 85RL BNZ 0 RXSP 86?= BNG 3 XEND1 86QW BRN XERROR3 87=G RXSP 87Q6 NAMETOP 1,FILE,FNAME 889Q FNORM 3 88PB MHUNT 1,FILE,FNAME 8992 NAMETOP 1,CPB,CUNI 89NL TESTREP2 NAMEFORM,RXIT 8=MW HUNT 1,FILE,ADJUNCTS 8?7G BNG 1 RNOADJ 8?94 ... HUNT 1,FILE,ADJUNCTS 8?=L ... BNG 1 RNOADJ [ J IF NO QUALIFIERS 8?#8 ... BNG 3 XPARAM2 8?*Q ... LDN 0 #40 8?C# ... ANDX 0 A1+1(1) 8?DW ... BZE 0 RNOADJ 8?GD ... ORS 0 AWORK3(2) [ NOWAIT QUALIFIER-SET B18 8?J2 ... BRN RNOADJ 8?KJ ...XPARAM2 8?M6 LDN 0 #7000 8#6Q ANDX 0 A1+1(1) 8#LB SBN 0 AAPPEND 8*62 ... BNZ 0 RNOAPP 8*KL LDX 0 GSIGN 8B5= STO 0 AWORK4(2) 8B6* ...RNOAPP 8B7D ...#UNS FCYCOMM 8B8H ...( 8B9L ... SEGENTRY K55COPYA [FOR COPYCOMM MACRO 8B=P ... BRN X56COPYA 8B?S ... LDN 0 ACOMMUNE [SET SWITCHES IN AWORK4 TO 8B#X ... ANDX 0 A1+1(1) [INDICATE IF COMMUNE AND 8BB2 ... ORS 0 AWORK4(2) [GDR QUALIFIERS SPECIFIED 8BC5 ... LDX 0 BIT10 [WITH OUTPUT FILE 8BD8 ... ANDX 0 A1+4(1) 8BF? ... ORS 0 AWORK4(2) 8BGB ... SEGENTRY K56COPYA 8BGX ...X56COPYA 8BHF ...) 8BJW RNOADJ 8C4G ADX 4 FX1 8CJ6 EXIT 4 1 8D3Q RXIT 8DHB ADX 4 FX1 8F32 EXIT 4 0 8FGL RFREEW 8G2= MFREEW FILE,ENT 8GFW RFREEW2 8G^G VFREEW FILE,ADJUNCTS 8HF6 LDX 1 FX1 8HYQ EXIT 4 0 8JDB RFREEJ 8JY2 UNIFREE 8KCL MFREE FILE,FABSNB 8KX= EXIT 4 0 8LBW RCLOSE 8LWG SBX 4 FX1 8MB6 CLOSETOP 8MTQ ADX 4 FX1 8N*B EXIT 4 0 8NT2 RTOPFCB 8P#L TOPFCB 2 8PS= EXIT 4 0 8Q?W REALTLENG [ROUTINE CALLED BY ALTLENG MACRO 8QRG TOPFCB 2 8R?6 EXIT 1 0 8RQQ [ 8S=B [ 8SQ2 XERROR1 8T9L CALL 4 RERRORX 8TP= +JPARMIS 8W8W BRN XEND 8WNG XERROR2 8X86 CALL 4 RERRORX 8XMQ +JTOOMANY 8Y7B BRN XEND 8YM2 XERROR3 8^6L CALL 4 RERRORX 8^L= +JPARNULL 925W BRN XEND 92KG XERROR4 [TESTS FOR CLUDGE & GIVES MESSAGE 9356 TOPFCA 2 93JQ LDX 0 FGENERAL1(2) 944B #SKI K6COPYA>599-599 94J2 TRACE 0,FCACLUDG 953L ANDX 0 TCLUDGE(1) 95H= BNZ 0 XERROR6 962W BRN QGREP 96GG XERROR6 9726 MHUNT 3,CPB,CUNI [OUTPUTS CLUDGE MESSAGE 97FQ LDEX 3 ANUM(3) 97^B OUTPARAM 3,APARA,CPB,CUNI 98F2 MONOUT AMONCOPY 98YL BRN XEND2 99D= XERROR5 99XW LDN 0 1 9=CG SFSTACK 0,2 9=X6 LDX 0 FGENERAL1(2) 9?BQ #SKI K6COPYA>599-599 9?WB TRACE 0,MDFCLUDG 9#B2 ANDX 0 TCLUDGE(1) 9#TL BNZ 0 XERROR6 9**= BRN QMREP 9*SW XERROR7 [NOT ENUF SPACE IN OUTFILE 9B#G CALL 4 RERRORX 9BS6 +ERTOOBIG 9C?Q LDEX 0 5 9CRB BZE 0 XEND2 [OUTFILE NOT MULT => NORMAL CLOSE 9D?2 CALL 4 RCLOSE 9DQL BRN XEND8 9F== XERROR8 [INFILE HAS TURNED INTO A MULT 9FPW CALL 4 RERRORX 9G9G +ERMULTI 9GP6 LDX 0 AWORK3(2) [IF OLDFILE, NORMAL CLOSE 9H8Q BPZ 0 XEND2 9HNB LDN 1 2 [OTHERWISE MOVE OUTFILE TO TOP 9J82 LDN 2 0 9JML CALL 4 RFILEMOVEX 9K7= ERASE [& ERASE IT (FABSNB ALREADY AT TOP) 9KLW BRN XEND2 [TO CLOSE INFILE 9L6G XERROR9 9LL6 CALL 4 RERRORX 9M5Q +EREXQUOTA 9MKB BRN XEND9 9N52 [ 9NJL XBRK1 9P4= COMBRKIN [ANY BREAKIN COMES HERE 9PHW XBRK2 9Q3G LDX 6 GSIGN [BRKIN HAS OCCURRED 9QH6 BRN XEND2 9R2Q 9RGB [ THIS PART REMOVES AN OUTFILE WHICH IS A NEW FILE. IT ALSO 9S22 [ REMOVES THE XTRA ELEMS OF THE OUTFILE WHICH HAVE BEEN 9SFL [ APPENED TO AN EXISTING OUTFILE. OTHERWISE NORMAL CLOSE. 9S^= 9TDW XBRK5 9TYG CALL 4 RFREEJ 9WD6 XBRK9 9WXQ CALL 4 RCLOSE 9XCB XBRK3 9XX2 LDX 6 GSIGN [BRKIN HAS OCCURRED 9YBL XEND8 9YW= LDX 7 AWORK3(2) 9^*W LDEX 0 5 9^TG BNZ 0 XBRK31 [J IF OUTFILE IS MULT =2*6 BPZ 7 XEND2 [J IF OLDFILE(SINGLE) =2SQ ERASE [SINGLE NEWFILE =3#B BRN XEND2 =3S2 XBRK31 =4?L BPZ 7 XBRK32 [J IF OLDFILE (MULT) =4R= CALL 4 RTOPFCB [MDF =5=W LDN 0 #1000 [TO-BE-ERASED BIT =5QG ORS 0 FSTREND(2) =6=6 ERASTREM [ERASE WHOLE MULT =6PQ BRN XEND2 =79B XBRK32 =7P2 LDX 0 AWORK4(2) =88L BPZ 0 XEND2 [J IF NOT APPENDING =8N= CALL 7 RERASELEM [ERASE NEW ELEMENTS =97W BRN XEND2 =9MG XBRK4 ==76 LDX 0 AWORK2(2) ==LQ BZE 0 XBRK2 [J IF 1ST TIME =?6B BRN XBRK3 =?L2 XBRK6 =#5L LDX 6 GSIGN =#K= BRN XEND6 =*4W XBRK7 =*JG CALL 4 RFREEJ =B46 XBRK8 =BHQ LDEX 0 5 =C3B BZE 0 XBRK3 =CH2 BRN XBRK9 =D2L XBRKX =DG= GEOERR 1,LOBSWRIT =D^W [ =FFG XEND1 =F^6 CALL 4 RERRORX =GDQ +JPARNULL =GYB XEND2 =HD2 CALL 4 RFILENUMB [XEND2 - XEND7 IS CLOSING ROUTINE =HXL SBX 3 AWORK1(2) [LEAVE CORRECT NO. OF FILES OPEN =JC= BZE 3 XEND6 [J IF NO CLOSE TO BE DONE =JWW XEND3 =KBG LDEX 0 5 =KW6 BZE 0 XEND4 [IF OUTFILE MULT, DO CLOSESTRM =L*Q CLOSEMULT [WILL REVERT TO FULL CLOSE IF NOT MDF =LTB BRN XEND5 =M*2 XEND4 =MSL CLOSE =N#= XEND5 =NRW BCT 3 XEND3 =P?G XEND6 =PR6 HUNT 1,BSTB,FULLB [MUST FREE B.S. SINCE NOT =Q=Q BNG 1 XEND7 [DONE BY ENDCOM =QQB FREEBAX =R=2 MFREE BSTB,EMPTYB =RPL XEND7 =S9= BNG 6 XBRK1 [J IF BRKIN =SNW XEND =T8G ENDCOM =TN6 XEND9 =W7Q LDEX 0 5 =WMB BZE 0 XEND8 =X72 CALL 4 RCLOSE =XLL BRN XEND8 =Y6= [ =YKW [ =^5G ... MENDAREA 20,K99COPYA ?24Q #END ^^^^ ...14461066000200000000