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