(George Source)
Macros used: ACROSS, ADDMODE, ALTLENG, BS, BWNZ, BXGE, BXU, CHAIN, CLOSEDIR, CLOSETOP, CREATEB, FILEMOVE, FINDNAME, FNORM, FREEBAX, GEOERR, GETBAX, HUNT, HUNT2, HUNT2OPT, INCREAMBS, JBC, JBS, JMBS, LONGSET, LONGSTOP, MAPBIN, MENDAREA, MFREE, MFREEBAX, MFREEW, MHUNT, MHUNTW, MONOUT, NAME, NAMETOP, OPEN, OPENDIR, OUTNUM, REPERR2, SEG, SEGENTRY, SETMODE, SETUPCORE, SETUPMODE, SFCB, STEP, STEPAGAIN, TESTREP, TESTREP2, TESTRPN2, TOPFCB, TOPFCB2, TRACE, TREP2, TREPN2, UNIFREE, UP, USEROPEN, USEROPEX, VFREEW, WHATBACK
22#C ... SEG COPYB,8,FILE, USERCOMS 22LS ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 22^= [ 23DW [ 23YG SEGENTRY K1COPYB,QDIR 24D6 SEGENTRY K2COPYB,QMAG 24MY ... SEGENTRY K3COPYB,QCOMM 24RT ... SEGENTRY K4COPYB,QCREATE 24XQ [ 25CB [ 25X2 [ THIS SEGMENT HANDLES COPYING DIRECTORIES AND OFF-LINE FILES. 26BL [ 26W= [ 27*W [ AWORK1 = NO. OF FILES OPEN AT K1COPY & ARE TO BE LEFT OPEN WHEN 27TG [ LEAVING THE SEGMENT. 28*6 [ AWORK2 IS +VE IF NOT FIRST TIME THRU A LOOP 28SQ [ X6 AT XEND TIME => -VE IF BRKIN HAS OCCURRED AND GOES TO COMBRKIN 29#B [ B0-X5 = 1 => INFILE IS A MULT; B15-23 OF X5 SET => OUTFILE IS A MULT 29S2 [ B15-23 OF X5 ALSO = NO. OF NEW ELEMENTS (EXCLUDING MDF) 2=?L [ AWORK3 -VE => OUTFILE IS A NEW FILE (TO BE ERASED IF INFILE NOT OK) 2=BQ ...#UNS FCYCOMM 2=FW ...[ AWORK4 = B0 SET => APPEND, B10 SET => GDR, B16 SET => COMMUNE 2=K2 ...#UNS FCYCOMM 2=N6 ...#SKI 2=R= [ AWORK4 = 0 => NOT APPEND (ADJUNCTS FREED, IF ANY); -VE => APPEND 2?=W [ 2?QG TCLUDGE +ACLUDGE 2*9B MEINF1 #56400020 [SER, MDF, MULTEL, MTFILE, PFCC 2*HR ... [AND FHDIRMODE BITS 2*W8 ...MEINF1A #54400020 [NO MULTELEM -- FOR COPYING ELEMS 2F6B [ 2FL2 [ 2G5L [ 2GK= QDIR [DIRECTORY PATH 2H4W [ THE INFILE IS A DIRECTORY. THE DIRECTORY IS CLOSED BEFORE A 2HJG [ WHATBACK IS DONE TO GET B.S. FOR THE OUTFILE. THE WHATBACK 2J46 [ PARAM IS INCREASED BY 2**N (N INCREASING BY 1 EACH TIME 2JHQ [ ANOTHER GETBAX IS TO BE DONE), IN CASE THE DIRECTORY 2K3B [ INCREASES IN SIZE. WHEN OUTFILE EXISTS, DIR IS REOPENED. IF 2KH2 [ NOT OK, MUST ERASE OUTFILE IF IT IS A NEWFILE -- OTHERWISE 2L2L [ LEFT EMPTY UNLESS APPENDING. IF OK CHECK THAT OUTFILE HAS ENUF 2LG= [ SPACE. IF ENUF J TO APPROPRIATE APPEND/NOAPPEND PATHS IN COPYA. 2L^W [ IF NOT ENUF GETBAX MORE, APPEND XTRA BS TO 2MFG [ OUTFILE FCB & REOP DIRECTORY AGAIN. 2M^6 [ 2NDQ CALL 4 RCREATE 2NYB CALL 4 RFREEW 2PD2 LDN 7 2 2PXL CALL 4 RTOPFCB 2QC= LDX 6 FBLMOD(2) 2QWW SBN 6 FBLKS-A1 2RBG LDX 4 7 [GET ADDITIONAL BLKS 2RW6 QDBSINCRE 2S*Q LDN 0 FILESIZE [LOOP: INCREASE WHATBACK/GETBAX PARAM 2STB QDBSINCREA 2T*2 BXGE 6 0,QDENUFBS [AT MOST BY 2**N (N = NO. OF TIMES 2TSL ADN 6 1 [WHATBACK/GETBAX IS DONE + 1) BUT 2W#= BCT 4 QDBSINCREA [TOTAL NOT EXCEEDING FILESIZE 2WRW QDENUFBS 2X?G #SKI K6COPYB>199-199 2XR6 TRACE 6,CYWHATBK 2Y=Q LDX 2 FX2 2YQB LDX 0 AWORK2(2) 2^=2 BZE 0 QDFIRSTCLOS 2^PL BZE 5 QDIRLEVEL1 329= LDN 1 2 [IN MULT (OUTFILE) CASE, DIR IS AT 32NW LDN 2 1 [LEVEL 2; SO MOVE IT TO LEVEL 1 338G CALL 4 RFILEMOVEX 33N6 QDIRLEVEL1 347Q CLOSEDIR [NOT 1ST TIME => DIR AT LEVEL 1 34MB SETUPCORE 6,1,BSTB,EMPTYB [FOR GETBAX 3572 QDREGETBAX 35LL STO 6 A1(1) [[6] - 2 BLKS + 2 FOR REC HDR 366= CALL 4 RTOPFCB [OUTFILE 36KW LDX 3 BSPRE(2) [BS MUST BE IN SAME FILE AS OUTFILE 375G STO 3 A1+1(1) 37K6 #SKI K6COPYB>199-199 384Q TRACE 6,CYGETBAX 38JB SMO FX2 3942 LDX 0 AWORK4 39HL BNG 0 QDNOINCRE 3=3= CALL 4 RINCREAMBS 3=GW BRN XBRK8 3?2G QDNOINCRE 3?G6 GETBAX 3?^Q MHUNT 1,BSTB,FULLB 3#FB SBX 3 A1+1(1) [IF BS NOT IN SAME FILE, REPEAT 3#^2 BZE 3 QDALTFCB 3*DL FREEBAX [BSTB/EMPTYB LEFT, SO NO NEED TO 3*Y= MHUNT 1,BSTB,EMPTYB [SETUPCORE ANOTHER 3BCW BRN QDREGETBAX 3BXG QDALTFCB 3CC6 SBN 6 2 [FOR REC HDR 3CDN ... CALL 4 RTOPFCB [OUTFILE 3CG= ... LDX 0 FUSEBL(2) 3CKB ... ADX 0 6 3CNG ... SBN 0 FBLKS-A1+FILESIZE+1 [X0 -VE UNLESS INFILE WONT FIT 3CRL ... BPZ 0 XERROR7 [WITHOUT MAKING FILE>FILESIZE 3DBB LDX 4 ALOGLEN(2) [SAVE OLD ALOGLEN 3DL8 ... BZE 6 NMAPBIN [J IF NO BLOCKS TO ADD 3DW2 ADX 4 6 [XTRA BLKS 3F*L ALTLENG 2,4,REALTLENG 3FT= SBX 4 6 [GET OLD ALOGLEN 3G#W MHUNTW 1,BSTB,FULLB [GETBAX LEFT ONE 3GSG TOPFCB 2 [OUTFILE; CANT USE CALL 4 RTOPFCB 3H#6 LDN 0 A1+2(1) 3HRQ SMO FUSEBL(2) 3J?B LDN 1 A1(2) 3JR2 LDX 3 6 3K=L MOVE 0 0(3) [XTRA BLKS INTO FCB 3KGD ... LDX 4 FUSEBL(2) [SAVE OLD VALUE FOR LATER USE 3KQ= ADS 3 FUSEBL(2) 3KST ... BS 2,BFALTB 3KXD ... JBC NMAPBIN,2,BFCARE [J UNLESS CAREFUL UPDATING TO DO 3L23 ... SBN 4 FBLKS-A1-1 3L4L ... MAPBIN 4,,3 [DO CAREFUL UPDATING 3L79 ...NMAPBIN 3L9W MFREE BSTB,FULLB 3LPG BRN QDREOPDIR 3M96 QDFIRSTCLOS 3MNQ CALL 4 RCLOSE [DIR BEFORE WHATBACK 3N8B LDN 0 1 3NN2 STO 0 AWORK2(2) [MARKER: 'NOT FIRST TIME' 3P7L CALL 4 RSPARNORM2 3PM= BRN XEND6 3PPT ...#UNS FCYCOMM 3PSD ...( 3PX3 ... LDEX 0 AWORK4(2) 3P^L ... BNZ 0 XILLACC [ERROR IF COMMUNE SPECIFIED 3Q49 ...) 3Q6W LDX 0 AWORK4(2) 3QLG BNG 0 QDUSEROP2 3R66 CALL 4 RINCREAMBS 3RKQ BRN XBRK6 3S5B QDUSEROP2 3SK2 CALL 4 RWHATBACK 3T4L #SKI 1 3TJ= ( 3W3W LDX 0 AWORK4(2) 3WHG BPZ 0 QDUSEROPING [J IF NOT APPEND CASE 3X36 MHUNT 3,BSTB,FULLB 3XGQ NAME 3,FILE,FINTER [STOPS USEROPEN FROM FREEING IT 3Y2B QDUSEROPING 3YG2 ) 3Y^L #SKI K6COPYB>599-599 3^F= ( 3^YW MHUNT 1,CPB,CUNI 42DG TRACE APARA(1),CYQDIR 42Y6 ) 44WL USEROPEN XBRK6,WRITE,CREATE,EMPTY,STREAMS 45B= REPERR2 QDTREP 45TW BRN XEND6 46*G QDTREP 46T6 TREPN2 NEWFILE,QDOLDFILE 47#Q LDX 0 GSIGN 47SB STO 0 AWORK3(2) 48#2 QDOLDFILE 48RL TREPN2 MULTFILE,QDREP [J IF NOT MULTIFILE 49?= LDN 5 1 [REMEMBER IF OUTFILE IS MULT 49QW QDREP 4==G CALL 4 RFREEW2 4=Q6 QDREOPDIR 4?9Q CALL 4 RCHAIN [DIR JUNK ABOVE OUTFILE JUNK 4?D2 ... USEROPEN XBRK7,READR,TERMDIR,FROZEN 4#92 [ NO NEED TO DO FNORM TO GET AND FREE 4#NL [ ADJUNCTS (IF ANY) SINCE USEROP ON FABSNB & ANY WAS FREED ABOVE 4*8= [ TERMDIR PERMITS ACCESS TO DIRECTORIES IF USER IS NOT :MANAGER 4*MW REPERR2 QDREOPOK 4B7G CALL 4 RFREEJ 4BM6 BRN XEND9 4C6Q QDREOPOK 4CLB CALL 4 RCHAIN [OUTFILE JUNK ABOVE DIR JUNK 4D62 BZE 5 QDOUTGARD 4DKL LDN 1 0 4F5= LDN 2 2 4FJW CALL 4 RFILEMOVEX [DIR TO BELOW OUTFILE MDF 4G4G BRN QDCHEKLEN 4GJ6 QDOUTGARD 4H3Q LDN 1 0 4HHB LDN 2 1 4J32 CALL 4 RFILEMOVEX [DIR TO BELOW OUTFILE 4JGL QDCHEKLEN 4K2= [ CHECK IF OUTFILE SIZE .GE. DIR SIZE. CHECK FOR WHETHER SUM OF 4KFW [ THESE SIZES EXCEEDS [FSIZE] IS DONE IN COPYA 4K^G CALL 4 RTOPFCB [OUTFILE 4LF6 LDX 1 FUSEBL(2) [AMOUNT OF USEABLE BLOCKS IN FILE 4LYQ LDX 3 FBLMOD(2) [AMOUNT OF BLOCKS CURRENTLY USED 4MDB LDN 0 1 4MY2 BPZ 5 QDCHEKGAR 4NCL LDN 0 2 [DIR AT LEVEL 2 IF OUTFILE IS MULT 4NX= QDCHEKGAR 4PBW CALL 4 RSFCB [DIR 4PWG [ BECAUSE DISGUISING A BSTB/FULLB OVER TWO USEROPENS IS NOT 4QB6 [ VERY EFFICIENT, ONE SOLUTION IS TO PAST THE USEROPEN 'OFFSET' 4QTQ [ (I.E., APPEND) MODE TO OPENREL WHICH WOULD APPEND THE FULLB 4R*B [ BLOCKS TO THE OUTFILE FCB AND UPDATE FUSEBL (NOT FBLMOD). 4RT2 LDX 6 FBLMOD(2) 4S#L #SKI 1 4SS= ( 4T?W SMO FX2 4TRG LDX 0 AWORK4 4W?6 BPZ 0 QDNOAPPEND [J IF NOT APPEND CASE 4WQQ SBX 1 3 [CHEK IF ENUF BLOX APPENDED TO OUTFIL 4X=B BZE 1 QDNORMAL [J IF NO BLOX APPENDED 4XQ2 BPZ 1 QDCOMPARE [J IF SOME XTRA BLOX 4Y9L GEOERR 1,RONGUSBL [ [FUSEBL] SHDNT BE LS [FBLMOD] 4YP= QDCOMPARE 4^8W SBX 1 6 [CHEK IF DIRECTORY SIZE IN X6 CAN 4^NG [ BE ACCOMODATED BY THE XTRA BLOX IN THE OUTFILE FCB 5286 BNG 1 QDNORMAL [J IF DIR TOO LARGE 52MQ MHUNT 1,FILE,FINTER 537B BNG 1 QDSIZOK [J IF NO DISGUISED FULLB 53M2 NAME 1,BSTB,FULLB 546L MFREEBAX [RETURN UNUSED BS 54L= BRN QDSIZOK 555W QDNORMAL 55KG SBN 6 FBLKS-A1 [NORMALIZE TO NO. OF BLKS 5656 MHUNT 3,FILE,FINTER [RENAMED ABOVE 56JQ BPZ 3 QDRENAME 574B BRN QDGETMORE 57J2 QDRENAME 583L NAME 3,BSTB,FULLB 58H= ... LDX 4 A1(3) 592W ... SBN 4 2 [RECORD HEADER 59GG ... SBX 4 6 5=26 ... BNG 4 QDIRLARGER [J IF DIR INCREASED IN SIZE 5=FQ CALL 1 REALTLENG [FCB OF OUTFILE 5=JW ... ADX 4 6 [X4= NO OF BLOCKS TO BE ADDED 5=N2 ... ADX 4 FUSEBL(2) 5=R6 ... SBN 4 FBLKS-A1+FILESIZE+1 [X4 -VE UNLESS INFILE TOO BIG ALREADY 5=W= ... BPZ 4 XERROR7 5=^B LDX 0 BSPRE(2) [GET LOGICAL FILE NO. 5?F2 SBX 0 A1+1(3) 5?YL BNZ 0 QDWRONGFILE [J IF NOT IN SAME FILE 5#D= LDX 3 A1(3) 5#XW SBN 3 2 [NO. OF BLKS 5*CG LDX 4 ALOGLEN(2) 5*M# ... BZE 3 NMAPBIN2 [J IF NO BLOCKS TO ADD 5*X6 ADX 4 3 [ADD XTRA NO. OF BLKS 5BBQ ALTLENG 2,4,REALTLENG 5BWB SBX 4 3 5CB2 CALL 1 REALTLENG 5CTL MHUNTW 1,BSTB,FULLB 5D*= LDN 0 A1+2(1) 5DSW SMO FUSEBL(2) 5F#G LDN 1 A1(2) 5FS6 MOVE 0 0(3) [XTRA BLKS INTO FCB 5G3Y ... LDX 4 FUSEBL(2) 5G?Q ADS 3 FUSEBL(2) 5GB* ... BS 2,BFALTB 5GDY ... JBC NMAPBIN2,2,BFCARE [J UNLESS CAREFUL UPDATING TO DO 5GHH ... SBN 4 FBLKS-A1-1 5GL6 ... MAPBIN 4,,3 [CARRY OUT NECESSARY CAREFUL UPDATING 5GNP ...NMAPBIN2 5GRB MFREEW BSTB,FULLB 5H?2 QDSIZOK 5HQL BZE 5 QGAPPEND [J IF NOT MULT 5J== BRN QMAPPEND 5JPW QDIRLARGER 5K9G ... NGX 6 4 5KP6 ADX 6 A1(3) [ADD XTRA BLKS TO BE GOTTEN 5L8Q QDWRONGFILE 5LNB FREEBAX [OLD BLOKS 5M82 MFREEW BSTB,EMPTYB 5MML BRN QDGETMORE [NEW BLKS 5N7= QDNOAPPEND 5NLW ) 5P6G SBX 1 6 5PL6 BPZ 1 QDNONEED [J IF ENUF BS 5Q5Q NGX 6 1 [X6 CONTAINS THE DIFFERENCE 5QKB BRN QDGETMORE 5R52 QDNONEED 5RJL BZE 5 QGNOAPPEND 5S4= BRN QMNOAPPEND 5SHW QDGETMORE 5T3G BZE 5 QDGARBS [IN GARDEN CASE GET SUFFICIENT AMOUNT 5TH6 LDN 6 FILESIZE+FBLKS-A1 [MULT CASE: GET MAXIMUM BS 5W2Q CALL 4 RTOPFCB [OUTFILE 5WGB SBX 6 ALOGLEN(2) [DECREMENT EXISTING BS OF OUTFILE 5X22 BRN QDENUFBS 5XFL QDGARBS 5X^= SLL 7 1 [DOUBLE BS TO BE GOTTEN 5YDW LDX 4 7 5YYG BRN QDBSINCRE [& GO GET IT 5^D6 [ 5^XQ [ 62CB QMAG [MAG REPLY PATH 62X2 [ A 'MAG' REPLY GIVEN WHEN USEROP ON INFILE. SO USEROP ON 63BL [ OUTFILE BEFORE DOING (LENGTHY) RETRIEVE FOR INFILE (I.E., 63W= [ REOPEN BUT WITHOUT 'NOWAIT' MODE). IF OFF-LINE INFILE TURNS 64*W [ INTO A MULTIFILE OR DISAPPEARS AFTER OUTFILE OPENED, LATTER IS 64TG [ ERASED IF IT IS A NEWFILE; OTHERWISE LEFT EMPTY. IF OK, J TO QG 65*6 [ OR QM PATHS IN COPYA. 65SQ [ SINCE CANT GET 'MAG' WHEN OPENING MDF (IT'S EMPTY) 66#B [ TWO ENT BLOX MEANS OFF-LINE MULTIFILE 66S2 [ CANT SIMPLY CHECK MULTIFILE BITS IN EINF1 BECAUSE COULD 67?L [ BE CY MULT(2/),NEWFILE 67R= [ 68=W MHUNTW 1,FILE,ENT 68QG HUNT2OPT 3,FILE,ENT,1 69=6 BNG 3 QMNOTMULT [J IF NO MDF ENT 69PQ LDX 5 GSIGN [INFILE IS MULT 6=9B LDEX 6 EINF3(1) [GET MAX SIZE FOR MULTIFILE 6=P2 [ RESET GEN. NO. OF INFILE FABSNB = 1 (FASTER THAN 'GEN. NO.' = 0 6?8L [ FOR GETDIR). COMPOST/USEROPEN HAS SET GEN. NO. = 2. 6?N= MHUNT 1,FILE,FABSNB 6#7W LDN 0 1 6#MG SMO A1(1) 6*76 STO 0 A1-6+4(1) [GEN. NO. = 1 6*LQ QMNOTMULT 6B6B CALL 4 RCREATE 6BL2 BNZ 5 QMNOCOPS [J IF MULT CASE 6C5L LDX 6 ECOPS(1) [GET BLKS SIZE 6CK= SRL 6 15 6D4W QMNOCOPS 6DJG CALL 4 RFREEW 6F46 [ IF MULT CASE, THE FILE/ENT FREED HERE IS THE ONE FOR THE ELEMENT 6F9# ... FINDNAME [EXPAND FILENAME FOR LATER COMPARISIO 6FBG ... [WITH OUTPUT FILENAME 6FHQ CALL 4 RSPARNORM2 6G3B BRN XEND6 6G3W ...# 6G4B ...# THE FOLLOWING IS NEEDED TO PREVENT AN OFFLINE FILE BEING COPIED TO 6G4W ...# ITSELF IN ERROR BEING EMPTIED BEFORE THE ERROR IS FOUND. 6G5B ...# IF THE OUTFILE EXISTS WE EXPAND BITH FILENAMES TO A FULL 6G5W ...# FORM AND COMPARE THEM 6G6B ...# 6G6W ... MHUNT 3,FILE,FABSNB 6G7B ... JMBS NOTSAME,3,BFABTSN,BFABWORK 6G7W ... FINDNAME [EXPAND OUTFILE FABSNB FOR COMPARISIO 6G8B ... OPENDIR (GEOERR),READ,QUERY 6G8W ... TESTRPN2 OK,NOTSAME 6G9B ... CLOSETOP 6G9W ... MHUNTW 1,FILE,ENT 6G=6 ... MHUNT 3,FILE,FABSNB 6G=B ... BWNZ EUSE1(1),NOUPDATE [IF USER HAS MISTAKENLY GIVEN A DIR 6G=L ... [FOR THE OUTFILE THE NEXT STEP IS 6G=W ... [LEFT OUT AS IT MIGHT RESULT IN 6G?6 ... [A CORRUPT FABSNB. 6G?B ... LDX 0 EREEL(1) [OTHERWISE WE UPDATE THE REEL NO IN 6G?L ... SMO A1(3) [IN THE FABSNB (OPENDIR DOESNT). 6G?W ... STO 0 A1-3(3) 6G#6 ...NOUPDATE 6G#B ... MFREEW FILE,ENT 6G#W ... HUNT2 1,FILE,FABSNB,3 6G*B ... LDX 2 A1(3) 6G*W ... BXU 2 A1(1),NOTSAME [OK IF DIFFERENT LENGTH FABS 6GBB ...MCOMPARE 6GBW ... SMO 2 6GCB ... LDX 0 A1-1(3) 6GCW ... SMO 2 6GDB ... BXU 0 A1-1(1),NOTSAME [OK IF WORDS DIFFER IN FABS 6GDW ... BCT 2 MCOMPARE 6GFB ... ACROSS COPYA,40 6GFW ...NOTSAME 6GGB ...# 6GH2 LDX 0 AWORK4(2) 6H2L BNG 0 QMUSEROP2 6HG= SLL 6 1 [DOUBLE AMT OF BS INCREASE 6H^W [ SINCE INFILE IS NOT OPEN HERE 6JFG CALL 4 RINCREAMBS 6J^6 BRN XBRK6 6KDQ SRL 6 1 [CORRECT AMT OF BS 6KYB QMUSEROP2 6LD2 CALL 4 RWHATBACK 6LXL #SKI K6COPYB>599-599 6MC= ( 6MWW MHUNT 1,CPB,CUNI 6NBG TRACE APARA(1),CYQMAG 6NW6 ) 6P2X ...#UNS FCYCOMM 6P7N ...( 6P#F ... STOZ 4 [INITIALISE 2ND MODE WORD 6PF= ... LDEX 0 AWORK4(2) 6PL3 ... BZE 0 NCOM 6PQS ... SETUPMODE 7,4,APPEND,COMMUNE,CREATE,EMPTY,GDR 6PXK ... ANDX 4 AWORK4(2) [ADD IN GDR IF SPECIFIED 6Q4B ... BRN OPEN 6Q97 ...NCOM 6Q*Y ...) 6QGP ... SETMODE 7,WRITE,EMPTY,CREATE,STREAMS 6QMG ...OPEN 6QSL BPZ 5 QMOPEX 6R#= ... ADDMODE 7,STREAMONLY 6YN6 MFREEW FILE,ENT [OF MDF 6^7Q QMOPEX 6^#Y ...#UNS FCYCOMM 6^G6 ...#SKI 6^M# ... USEROPEX XBRK6,7 6^SG ...#UNS FCYCOMM 6^^Q ... USEROPEX XBRK6,7,4 7272 REPERR2 QMTREP 72LL BRN XEND6 736= QMTREP 73KW TREPN2 NEWFILE,QMOLDFILE 745G LDX 0 GSIGN 74K6 STO 0 AWORK3(2) 754Q QMOLDFILE 75JB TREPN2 MULTFILE,QMREP [J IF NOT MULTIFILE 7642 LDN 5 1 [REMEMBER OUTFILE IS MULT 76HL QMREP 773= CALL 4 RFREEW2 77GW CALL 4 RCHAIN [MAG JUNK ABOVE OUTFILE JUNK 77LW ...#UNS FCYCOMM 77QW ...( 77WW ... LDEX 0 AWORK4(2) 782W ... BZE 0 NOCOMM [J IF NOT COMMUNE 78=W ... USEROPEN XBRK7,READ,STREAMS,TERMDIR,FROZEN 78QW ... BRN NOWOP 78WW ...NOCOMM 792W ...) 799H ... USEROPEN XBRK7,READR,STREAMS,TERMDIR,FROZEN 79P8 ...NOWOP 79^2 REPERR2 QMRTRVOK 7=DL CALL 4 RFREEJ 7=Y= BRN XEND9 7?CW QMRTRVOK 7?XG TREP2 MULTFILE,QMSTREAM 7#C6 TREPN2 DIR,QMFILE 7#WQ GEOERR 1,DIROFFLI [DIR NOT ALLOWED OFF-LINE 7*BB QMFILE 7*W2 CALL 4 RCHAIN [OUTFILE JUNK ABOVE MAG JUNK 7B*L BNZ 5 QMSTRMOUT [J IF OUTFILE IS MULT 7BDQ ... TOPFCB2 2 7BHW ... JMBS NOTDA,2,BFSER,BFMT 7BM2 ... LDX 7 FSIZE(2) [REMEMBER MAXSIZE FOR DA FILE 7BQ6 ...NOTDA 7BT= LDN 1 0 7C#W LDN 2 1 7CSG CALL 4 RFILEMOVEX [MAG FILE TO BELOW OUTFILE 7D38 ... LDX 2 FX2 7D9W ... TOPFCB2 3 7DDJ ... JMBS NDA,3,BFSER,BFMT 7DM= ... STO 7 FSIZE(3) [UPDATE MAXIMUM FILE SIZE 7DTY ...NDA 7F4L ... LDX 0 AWORK4(2) [APPENDING? 7F?B BNG 0 QGAPPEND 7FR2 BRN QGNOAPPEND 7G=L QMSTRMOUT 7GQ= LDN 1 0 7H9W LDN 2 2 7HPG CALL 4 RFILEMOVEX [MAG FILE TO BELOW MDF (OUTFILE) 7J96 BRN QMGOTOSTR 7JNQ QMSTREAM 7K8B ORX 5 GSIGN [INFILE IS MULT 7KN2 CALL 4 RCHAIN [OUTFILE JUNK ABOVE MAG JUNK 7L7L LDEX 0 5 7LM= BNZ 0 QMBOTHMULT 7M6W BRN XERROR8 [OUTFILE NOT MULT WHILE INFILE IS 7MLG QMBOTHMULT 7N66 LDN 1 0 7NKQ LDN 2 3 7P5B CALL 4 RFILEMOVEX [MAG FILE ELEM TO BELOW OUTFILE MDF 7PK2 LDN 1 0 7Q4L LDN 2 3 7QJ= CALL 4 RFILEMOVEX [MAG FILE MDF TO BELOW MAG FILE ELEM 7T2B LDN 0 1 7TG2 STO 0 AWORK2(2) 7T^L QMGOTOSTR 7WF= SMO FX2 7WYW LDX 0 AWORK4 [APPENDING? 7XDG BNG 0 QMAPPEND [YES 7XY6 BRN QMNOAPPEND 7YCQ [ 7YCW ...[ ENTRY FROM COPYA TO SET UP CREATE BLOCK 7YD2 ...[ 7YD6 ...QCREATE 7YD= ... CALL 4 RCREATE 7YDB ... UP 7YDG ...[ 7YDL ...#UNS FCYCOMM 7YFG ...( 7YGB ...QCOMM 7YH= ...[ THE OUTPUT FILE IS OPEN COMMUNALLY SO THE COPYING MUST BE DONE 7YJ6 ...[ RECORD BY RECORD INSTEAD OF BLOCK BY BLOCK 7YK2 ...[ 7YKW ... STOZ 7 [INITIALISE RECORD COUNT 7YLQ ...YSTEP 7YML ... STEP 1 [READ A RECORD FROM INFILE 7YNG ... BZE 3 XEND2 [J IF END OF FILE 7YPB ...YAPAG 7YQ= ... STO 3 6 7YR6 ... LDEX 1 0(3) [NO. OF WORDS TO APPEND 7YS2 ... STEP ,0(1),XBRK2 [GET POINTER IN OUTFILE 7YSW ... TESTREP APPWAIT,WAIT,FILEFULL,XFULL,COORED,YSAG,FNEARLY,YSAG 7YTQ ... LDEX 1 0(3) 7YWL ... LDX 2 6 [PICK UP READ POINTER 7YXG ... MOVE 2 0(1) [COPY RECORD ACROSS TO OUTFILE 7YYB ... ADN 7 1 [INCREMENT RECORD COUNT 7Y^= ... BRN YSTEP 7^26 ...YSAG 7^32 ... STEPAGAIN 1 [REGAIN READ POINTER 7^3W ... BRN YAPAG 7^4Q ...XFULL [FILEFULL REACHED ON OUTPUT FILE 7^5L ... OUTNUM 7,0 [NO. OF RECORDS COPIED 7^6G ... MONOUT FCYFULL [OUTPUT INFORMATORY MESSAGE 7^7B ... BRN XEND2 7^8= ...WAIT [WAITING TO APPEND A RECORD 7^96 ... LONGSET IWTDEST,XGEOERR 7^=2 ... LONGSTOP XBRK2 7^=W ... BRN YSAG [TRY AGAIN 7^?Q ...XGEOERR 7^#L ... GEOERR 1,LONGSET? 7^*G ...) 7^C2 RCREATE [ROUTINE WHICH SETS UP FILE/CREATE 7^WL SBX 4 FX1 [GET INFO FROM ENT BLK 82B= CREATEB 82TW MHUNTW 2,FILE,CREATE 83*G MHUNTW 1,FILE,ENT 83T6 LDX 0 ERET(1) 84#Q STO 0 CERET(2) 84SB LDX 0 ETM(1) 85#2 STO 0 CETM(2) 85RL LDX 0 EINF1(1) 86?= BNZ 5 RCOMP 86QW SMO FX1 87=G ANDX 0 MEINF1A 87Q6 BRN RNCOMP 889Q RCOMP 88PB SMO FX1 8992 ANDX 0 MEINF1 89NL RNCOMP 8=8= STO 0 CEINF1(2) 8=MW LDX 0 EINF3(1) 8?7G STO 0 CEINF3(2) 8?M6 LDX 0 EFLOW(1) 8#6Q STO 0 CEFLOW(2) 8#LB LDX 0 EORG(1) 8*62 STO 0 CEORG(2) 8*KL JBS RINDEX,1,BEINDEX [IF INFILE INDEXED, OUTFILE NOT 8B5= LDX 0 EKEY(1) 8BJW STO 0 CEKEY(2) 8C4G RINDEX 8CJ6 LDX 0 EENDBUCK(1) 8D3Q STO 0 CEENDBUCK(2) 8DHB LDX 0 EVERSION(1) 8F32 STO 0 CEVERSION(2) 8F66 ... JBC NOTSERIAL,2,CESERIAL[IF ITS SERIAL SET MAXSIZE 8F9= ... LDN 0 FILESIZE [=MAX AS INFILE COULD BE SJFILE WITH 8F#B ... DEX 0 CEINF3(2) [MAXSIZE<<MAX. 8FCG ...NOTSERIAL 8FGL ADX 4 FX1 8G2= EXIT 4 0 8GFW RCHAIN [ROUTINE WHICH RECHAINS JUNK TO 8G^G HUNT 1,CPB,CUNI [JUST BEHIND CURRENT ACTIVITY 8HF6 HUNT2 1,CPB,CUNI 8HYQ CHAIN 1,2 8JDB HUNT 1,FILE,FABSNB 8JY2 HUNT2 1,FILE,FABSNB 8KCL CHAIN 1,2 8KX= EXIT 4 0 8LBW RWHATBACK 8LWG SBX 4 FX1 8MB6 WHATBACK 3,6 8MTQ ADX 4 FX1 8N*B EXIT 4 0 8NT2 RINCREAMBS 8P#L SBX 4 FX1 8PS= INCREAMBS RXBRK,6 8Q?W TESTRPN2 OK,XERROR9 8QRG ADX 4 FX1 8R?6 EXIT 4 1 8RQQ RXBRK 8S=B ADX 4 FX1 8SQ2 EXIT 4 0 8T9L RSFCB 8TP= SFCB 0,2 8W8W EXIT 4 0 8WNG RFILEMOVEX 8X86 SBX 4 FX1 8XMQ FILEMOVE 0(1),0(2) 8Y7B ADX 4 FX1 8YM2 EXIT 4 0 8^6L RSPARNORM2 8^L= LDX 3 GSIGN 925W RSPARNORM1 92KG SBX 4 FX1 9356 SPARAPASS 93JQ MHUNT 1,CPB,CUNI 944B LDX 0 ANUM(1) 94J2 BNZ 0 RXSP 953L BNG 3 XEND1 95H= BRN XERROR3 962W RXSP 96GG NAMETOP 1,FILE,FNAME 9726 FNORM 3 97FQ MHUNT 1,FILE,FNAME 97^B NAMETOP 1,CPB,CUNI 98F2 TESTREP2 NAMEFORM,RXIT 98YL BPZ 3 RNOADJ 99D= HUNT 1,FILE,ADJUNCTS 99XW BNG 1 RNOADJ 9=CG LDN 0 #7000 9=X6 ANDX 0 A1+1(1) 9?BQ SBN 0 AAPPEND 9?WB ... BNZ 0 RNOAPP 9#B2 LDX 0 GSIGN 9#TL STO 0 AWORK4(2) 9#WP ...RNOAPP 9#XS ...#UNS FCYCOMM 9#YX ...( 9*22 ... SEGENTRY K55COPYB [FOR COPYCOMM MACRO 9*35 ... BRN X56COPYB 9*48 ... LDN 0 ACOMMUNE [SET SWITCHES IN AWORK4 TO 9*5? ... ANDX 0 A1+1(1) [INDICATE IF COMMUNE AND 9*6B ... ORS 0 AWORK4(2) [GDR QUALIFIERS SPECIFIED 9*7F ... LDX 0 BIT10 [WITH OUTPUT FILE 9*8J ... ANDX 0 A1+4(1) 9*9M ... ORS 0 AWORK4(2) 9*=Q ... SEGENTRY K56COPYB 9*?? ...X56COPYB 9*?T ...) 9**= RNOADJ 9*SW ADX 4 FX1 9B#G EXIT 4 1 9BS6 RXIT 9C?Q ADX 4 FX1 9CRB EXIT 4 0 9D?2 RFREEW 9DQL MFREEW FILE,ENT 9F== RFREEW2 9FPW VFREEW FILE,ADJUNCTS 9G9G LDX 1 FX1 9GP6 EXIT 4 0 9H8Q RFREEJ 9HNB UNIFREE 9J82 MFREE FILE,FABSNB 9JML EXIT 4 0 9K7= RCLOSE 9KLW SBX 4 FX1 9L6G CLOSETOP 9LL6 ADX 4 FX1 9M5Q EXIT 4 0 9MKB RTOPFCB 9N52 TOPFCB 2 9NJL EXIT 4 0 9P4= REALTLENG [ROUTINE CALLED BY ALTLENG MACRO 9PHW TOPFCB 2 9Q3G EXIT 1 0 9QH6 [ 9QK* ...#UNS FCYCOMM 9QMJ ...( 9QPR ...XILLACC [ILLEGAL ACCESS TO SYSTEM FILE 9QS2 ... MONOUT ASYSFAIL 9QW9 ... BRN XEND6 9QYD ...) 9R2Q [ 9RGB QGAPPEND 9S22 ACROSS COPYA,2 9SFL QGNOAPPEND 9S^= ACROSS COPYA,3 9TDW QMAPPEND 9TYG ACROSS COPYA,4 9WD6 QMNOAPPEND 9WXQ ACROSS COPYA,5 9XCB XERROR3 9XX2 ACROSS COPYA,13 9Y26 ...XERROR7 9Y5= ... FREEBAX 9Y8B ... MFREEW BSTB,EMPTYB 9Y?G ... ACROSS COPYA,41 9YBL XERROR8 9YW= ACROSS COPYA,18 9^*W XERROR9 9^TG ACROSS COPYA,19 =2*6 XBRK6 =2SQ ACROSS COPYA,26 =3#B XBRK7 =3S2 ACROSS COPYA,27 =4?L XBRK8 =4R= ACROSS COPYA,28 =5=W XEND1 =5QG ACROSS COPYA,31 =5S9 ...#UNS FCYCOMM =5TY ...( =5XM ...XBRK2 =5^B ... LDX 6 GSIGN [BREAKIN HAS OCCURRED =635 ...XEND2 =64S ... ACROSS COPYA,47 =66H ...) =68= ... =6=6 XEND6 =6PQ ACROSS COPYA,36 =79B XEND9 =7P2 ACROSS COPYA,39 =88L [ =8N= [ =97W ... MENDAREA 20,K99COPYB ==76 #END ^^^^ ...32765156000100000000