{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: COPYA867)}}
====== COPYA867 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ADDMODE|ADDMODE]], [[george:macro:BACKWAIT|BACKWAIT]], [[george:macro:BWNZ|BWNZ]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CLOSE|CLOSE]], [[george:macro:CLOSEABANDON|CLOSEABANDON]], [[george:macro:CLOSEMULT|CLOSEMULT]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:COMBRKIN|COMBRKIN]], [[george:macro:CORRUPTB|CORRUPTB]], [[george:macro:DOWN|DOWN]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:ERASE|ERASE]], [[george:macro:ERASTREM|ERASTREM]], [[george:macro:ERRORX|ERRORX]], [[george:macro:FILEMOVE|FILEMOVE]], [[george:macro:FILENUMB|FILENUMB]], [[george:macro:FNORM|FNORM]], [[george:macro:FREEBAX|FREEBAX]], [[george:macro:FSHENTRY|FSHENTRY]], [[george:macro:GEOERR|GEOERR]], [[george:macro:HUNT|HUNT]], [[george:macro:HUNT2|HUNT2]], [[george:macro:INCREAMBS|INCREAMBS]], [[george:macro:JBC|JBC]], [[george:macro:JBS|JBS]], [[george:macro:MBI|MBI]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MONOUT|MONOUT]], [[george:macro:MTCHECK|MTCHECK]], [[george:macro:NAME|NAME]], [[george:macro:NAMETOP|NAMETOP]], [[george:macro:OPEN|OPEN]], [[george:macro:OUTPARAM|OUTPARAM]], [[george:macro:PARANUMB|PARANUMB]], [[george:macro:READB|READB]], [[george:macro:REPERR|REPERR]], [[george:macro:REPERR2|REPERR2]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETMODE|SETMODE]], [[george:macro:SETUPMODE|SETUPMODE]], [[george:macro:SFCB|SFCB]], [[george:macro:SFSTACK|SFSTACK]], [[george:macro:SUBCUBS|SUBCUBS]], [[george:macro:TESTNAMX|TESTNAMX]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:TESTRPN2|TESTRPN2]], [[george:macro:TOPFCA|TOPFCA]], [[george:macro:TOPFCA2|TOPFCA2]], [[george:macro:TOPFCB|TOPFCB]], [[george:macro:TRACE|TRACE]], [[george:macro:TREP2|TREP2]], [[george:macro:TREPN2|TREPN2]], [[george:macro:UNIFREE|UNIFREE]], [[george:macro:USEROPEN|USEROPEN]], [[george:macro:USEROPEX|USEROPEX]], [[george:macro:VFREEW|VFREEW]], [[george:macro:WHATBACK|WHATBACK]], [[george:macro:WRITEB|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