{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: COPYB867)}}
====== COPYB867 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ADDMODE|ADDMODE]], [[george:macro:ALTLENG|ALTLENG]], [[george:macro:BS|BS]], [[george:macro:BWNZ|BWNZ]], [[george:macro:BXGE|BXGE]], [[george:macro:BXU|BXU]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CLOSEDIR|CLOSEDIR]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:CREATEB|CREATEB]], [[george:macro:FILEMOVE|FILEMOVE]], [[george:macro:FINDNAME|FINDNAME]], [[george:macro:FNORM|FNORM]], [[george:macro:FREEBAX|FREEBAX]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETBAX|GETBAX]], [[george:macro:HUNT|HUNT]], [[george:macro:HUNT2|HUNT2]], [[george:macro:HUNT2OPT|HUNT2OPT]], [[george:macro:INCREAMBS|INCREAMBS]], [[george:macro:JBC|JBC]], [[george:macro:JBS|JBS]], [[george:macro:JMBS|JMBS]], [[george:macro:LONGSET|LONGSET]], [[george:macro:LONGSTOP|LONGSTOP]], [[george:macro:MAPBIN|MAPBIN]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MFREEBAX|MFREEBAX]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MONOUT|MONOUT]], [[george:macro:NAME|NAME]], [[george:macro:NAMETOP|NAMETOP]], [[george:macro:OPEN|OPEN]], [[george:macro:OPENDIR|OPENDIR]], [[george:macro:OUTNUM|OUTNUM]], [[george:macro:REPERR2|REPERR2]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETMODE|SETMODE]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:SETUPMODE|SETUPMODE]], [[george:macro:SFCB|SFCB]], [[george:macro:STEP|STEP]], [[george:macro:STEPAGAIN|STEPAGAIN]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:TESTRPN2|TESTRPN2]], [[george:macro:TOPFCB|TOPFCB]], [[george:macro:TOPFCB2|TOPFCB2]], [[george:macro:TRACE|TRACE]], [[george:macro:TREP2|TREP2]], [[george:macro:TREPN2|TREPN2]], [[george:macro:UNIFREE|UNIFREE]], [[george:macro:UP|UP]], [[george:macro:USEROPEN|USEROPEN]], [[george:macro:USEROPEX|USEROPEX]], [[george:macro:VFREEW|VFREEW]], [[george:macro:WHATBACK|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<