ASMB,C,Q  
      HED FCOPY: 91740-16034 REV 2001 (C) HEWLETT-PACKARD CO. 1980
      NAM FCOPY,7 91740-16034 REV 2001 791024 
      SPC 2 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS      *
*  * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY.   *
******************************************************************
      SPC 2 
      SPC 2 
****************************************************************
* 
*     NAME:         FCOPY 
*     SOURCE:       91740-18034 
*     RELOC:        91740-16034 
*     PGMR:         DAN GIBBONS 
* 
* 
*     MODIFIED BY:  D.GIBBONS: ADD OPT. DEST SECU. CODE PARAM (10/79) 
* 
* 
*************************************************************** 
      SPC 3 
*     FCOPY IS THE GENERAL FILE TRANSFER UTILITY. 
*     IT WILL TRANSFER ANY FILE WITH RECORD LENGTHS <= 128 WORDS
*     FROM ANY DISK IN THE NETWORK TO ANY OTHER DISK IN THE NETWORK.
* 
*     THE CALLING SEQUENCE IS : 
*     JSB FCOPY 
*     DEF *+6 TO *+12 
*     DEF ORIGIN FILE NAME
*     DEF ORIGIN CRN VECTOR 
*     DEF DESTINATION FILE NAME 
*     DEF DESTINATION CRN VECTOR
*     DEF IERR
*     DEF ORIGIN FILE SECU (OPTIONAL) 
*     DEF DEST FILE TYPE (OPTIONAL) 
*     DEF DEST FILE SIZE (OPTIONAL) 
*     DEF DEST FILE REC-SIZE (OPTIONAL) 
*     DEF TRANSFER MODE (OPTIONAL)
*     DEF DEST FILE SECU (OPTIONAL) 
* 
*     IN CASE OF DUPLICATE DESTINATION FILE NAME, 
*     THE FIRST 2 CHARACTERS OF THE NAME WILL BE CHANGED
*     TO "..". IF THIS NAME IS ALSO EXISTING THERE WILL BE
*     AN ERROR RETURN.
* 
*     NEGATIVE VALUES FOR DESTINATION FILE SIZE PARAMETER 
*     ARE NOT ALLOWED SINCE A LINE FAILURE BEFORE 
*     TRUNCATION AT 'DCLOS' TIME WOULD RESULT IN GOBBLING 
*     ALL THE REMAINING SPACE ON THE REMOTE DISC. A -6
*     ERROR CODE (NO ROOM) IS RETURNED IF THIS IS ATTEMPTED.
* 
*     IF TRANSFER MODE PARAMETER IS GIVEN AND IS NON- 
*     ZERO, THE DESTINATION FILE WILL BE CREATED AS USUAL 
*     BUT BOTH FILES WILL BE OPENED AS TYPE 1'S. THIS WILL
*     NORMALLY RESULT IN INCREASED LINE EFFICIENCY SINCE
*     VARIABLE RECORD LENGTH FILES WILL THEN BE TRANSFERRED 
*     IN 128 WORD DATA BLOCKS RATHER THAN RECORD BY RECORD. 
*                          !!!CAUTION!!!
*     THIS METHOD SHOULD BE USED ONLY IF THE SOURCE FILE
*     HAS NO EXTENTS. EXTENTS ARE NOT COPIED TO 
*     THE DESTINATION FILE WHEN FILES ARE OPENED AS TYPE 1
*     FILES. FAILURE TO OBSERVE THIS WARNING WILL NOT CAUSE 
*     A RETURNED ERROR CODE, BUT WILL NEVERTHELESS RESULT 
*     IN A CORRUPT DESTINATION FILE.
* 
* 
*     ERROR CODES : 
*                   IERR > 0 :WARNING 
*                   IERR = 0 :NO ERROR
*                   -100 < IERR >0 : DESTINATION ERROR
*                   IERR < -100 : ORIGIN ERROR
* 
*     WARNINGS :
*                   IERR = 1 DUPLICATE FILE NAME, CORRECTED 
* 
      SPC 3 
      ENT FCOPY 
      EXT .ENTR 
      EXT DCRET,DOPEN,DREAD,DWRIT,DCLOS 
      EXT DPURG 
      EXT DLOCF 
      EXT IFBRK 
      IFZ 
      EXT DBUG
      XIF 
      SPC 3 
      SUP 
* 
SRCFL NOP           SOURCE FILE NAME
SRCCR NOP           SOURCE CRN VECTOR 
DSTFL NOP           DESTINATION FILE NAME 
DSTCR NOP           DESTINATION CRN VECTOR
IERR  NOP           ERROR PARAMETER 
ISEC1 NOP           ORIGIN FILE SECU
ITYP2 NOP           DEST FILE TYPE
ISIZ2 NOP           DEST FILE SIZE
IREC2 NOP           DEST FILE REC-SIZE
IMODE NOP           TRANSFER MODE 
ISEC2 NOP           DESTINATION FILE SECU 
      SPC 2 
FCOPY NOP           ENTRY POINT 
      JSB .ENTR 
      DEF SRCFL 
* 
      IFZ 
      JSB DBUG      CALL DBUG IF ASKED FOR
      DEF *+1 
      XIF 
      SPC 2 
      CLA 
      STA IERR,I    CLEAR THE ERROR CODE
      LDA DSTFL,I   TRANSFER THE DESTINATION
      STA DSTFN      FILE NAME
      ISZ DSTFL       (WE DONT WANT TO CHANGE 
      DLD DSTFL,I      THE USER'S CODE EVEN IF WE 
      DST DSTFN+1       HAVE TO CHANGE THE DEST FILE NAME)
      LDA ISEC1     SET ISEC1 TO
      SZA            VALUE IF GIVEN,
      LDA A,I         ELSE TO 
      STA ISEC1        ZERO.
* 
      LDB D1        GET OPEN OPTION 
      JSB OPENO     OPEN ORIGIN FILE
* 
LOOK  JSB DLOCF     USE THIS TO FIND THE TYPE,
      DEF *+10       SIZE & RECORD SIZE OF THE FILE 
      DEF ODCB        TO BE TRANSFERED
      DEF YERR
      DEF NOP 
      DEF NOP 
      DEF NOP 
      DEF ISIZE     # OF SECTORS OF THE FILE RETURNED HERE
      DEF NOP 
      DEF FLTYP     FILE TYPE 
      DEF ISIZE+1   RECORD SIZE 
* 
      LDA ISIZ2 
      SZA,RSS       DEST SIZE GIVEN?
      JMP FC01      NO
      LDA A,I       YES, GET IT 
      SSA           NEGATIVE VALUES 
      JMP M6ERR      NOT ALLOWED. 
      ALS           CONVERT TO SECTORS
      SZA           IF NOT ZERO, OVERRIDE 
      STA ISIZE       ORIG FILE SIZE. 
* 
FC01  LDA IREC2 
      SZA,RSS       DEST REC-SIZE GIVEN?
      JMP FC02      NO
      LDA A,I       YES, GET IT 
      SZA           IF NOT ZERO, OVERRIDE 
      STA ISIZE+1    ORIG REC-SIZE. 
* 
FC02  LDB FLTYP     IF ITYP2 IS NOT 
      CLA            GIVEN OR IS ZERO,
      LDA ITYP2,I     DEFAULT TO ORIGIN TYPE. 
      SZA 
      LDB A 
      STB ITYP2 
* 
      LDA ISIZE     DCRET NEEDS # OF BLOCS, SO WE HAVE
      CLE,ERA       TO DIVIDE ISIZE BY 2
      SEZ           INCREMENT A IF ISIZE WAS ODD
      INA 
      STA ISIZE     SAVE THE # OF BLOCS 
* 
      CLA           (IN CASE ISEC2 NOT SPECIFIED) 
      LDA ISEC2,I   SET ISEC2 TO SPECIFIED VALUE
      STA ISEC2       OR TO 0.
* 
      JSB DCRET     CREATE THE DESTINATION FILE 
      DEF *+8 
      DEF DDCB      DESTINATION DCB 
      DEF YERR
      DEF DSTFN     DEST. FLAME 
      DEF ISIZE 
      DEF ITYP2     FILE TYPE 
      DEF ISEC2     DEST SECURITY CODE
      DEF DSTCR,I   DEST. CRN 
* 
      SSA,RSS       HOW WAS IT ?
      JMP CLOSE     OK, GO CLOSE BOTH FILES 
      CPA MD2       DUPLICATE FILE NAME ? 
      JMP RETRY     YES, TRY WITH ANOTHER NAME
      LDB D1        FILE CLOSE OPTION 
      JMP ERROR     GET OUT 
* 
CLOSE JSB CLOSO     CLOSE BOTH ORIG 
      JSB CLOSD      AND DEST FILES.
* 
* NOW OPEN BOTH FILES 
* 
      LDB D1        GET DEFAULT OPEN OPTION 
      CLA           PROTECT AGAINST IMODE = 0 
      LDA IMODE,I 
      SZA           IMODE GIVEN AND NON-ZERO? 
      LDB D5        YES, USE TYPE 1 OPEN OPTION 
      STB IMODE     SAVE OPEN OPTION
      JSB OPENO     OPEN ORIGIN FILE
* 
      LDB IMODE     GET OPEN OPTION BACK
      JSB OPEND     OPEN DEST FILE
* 
* IF ORIG IS TYPE 1, OR IF WE HAVE OPENED IT AS A TYPE 1, WE
* WANT A 128 WORD BUFFER. OTHERWISE, WE WANT A 129 WORD BUFFER
* SO WE CAN CHECK FOR BUFFER OVERFLOW.
* 
      LDA D129
      LDB FLTYP     GET ORIG TYPE 
      CPB D1        TYPE 1? 
      JMP DECR      YES 
      LDB IMODE     GET OPEN OPTION 
      CPB D5        TYPE 1 OPEN OPTION? 
DECR  ADA MD1       YES, USE 128 WORD BUFR LENGTH 
      STA BUFL      SET BUFL FOR DREAD CALL 
      SPC 3 
*     FILES SET UP, TRANSFER DATA 
* 
MOVE  JSB DREAD     READ FROM ORIGIN
      DEF *+6 
      DEF ODCB
      DEF YERR
      DEF BUF       DATA BUFFER 
      DEF BUFL      DATA BUFFER LENGTH
      DEF LEN 
* 
      SSA,RSS       HOW WAS IT ?
      JMP WRT       OK
      CPA MD12      NOT TOO GOOD. EOF ? 
      JMP EOF       YES 
      LDB D2        THIS MUST BE AN ERROR, CLOSE OPTION 
      ADA MD100     ORIGIN ERROR
      JMP ERROR     GET OFF 
* 
EOF   LDA MD1       FAKE LEN=-1 WITH NO ERROR 
      STA LEN 
* 
WRT   LDA LEN 
      CPA D129      BUFFER OVERFLOW?
      RSS           YES, ERROR
      JMP WRT1      NO, CONTINUE
      LDA MD104     SET ILLEGAL RECORD SIZE ERROR CODE
      LDB D2
      JMP ERROR     REPORT ERROR
* 
WRT1  JSB DWRIT            WRITE THE BUFFER INTO THE FILE 
      DEF *+5 
      DEF DDCB
      DEF YERR
      DEF BUF 
      DEF LEN       BUFFER LENGTH 
* 
      SZA,RSS       HOW WAS IT ?
      JMP TST       OK
ERR   LDB D2        CLOSE OPTION
      JMP ERROR 
* 
TST   JSB IFBRK     DOES THE
      DEF *+1         OPERATOR
      SSA               WANT OUT? 
      JMP BREAK     YES 
      LDA LEN       DID WE REACH
      INA           THE END 
      SZA           OF FILE 
      JMP MOVE      NO
      SPC 3 
* 
*     TRANSFER ALL DONE, CLOSE THE FILES AND GO BACK TO CLASS 
* 
      JSB CLOSD     FIRST CLOSE THE DEST FILE 
      JSB CLOSO     NOW CLOSE THE ORIG FILE 
      JMP EXIT      RETURN TO USER
      SPC 2 
M6ERR CLB           INDICATE THAT NO FILES ARE OPEN 
      LDA MD6       GIVE -6 ERROR 
      JMP ERROR 
      SPC 3 
*     BREAK SET. CLOSE ORIGIN FILE, PURGE DESTINATION.
* 
BREAK LDA MD100     SET "BREAK" ERROR CODE
      LDB D2
      SPC 3 
*     ERROR PROCESSING
* 
ERROR STB STATS     SAVE STATUS 
      STA IERR,I    SAVE ERROR VALUE
      SZB,RSS 
      JMP EXIT      NOTHING IS OPEN 
      JSB DCLOS     CLOSE ORIGIN
      DEF *+3 
      DEF ODCB
      DEF YERR
* 
* 
      ISZ STATS 
      RSS 
      JMP EXIT      ONLY THE ORIGIN WAS OPEN
* 
      JSB DPURG     DEST. ALSO CREATED, GET RID OF IT 
      DEF *+6 
      DEF DDCB
      DEF YERR
      DEF DSTFN     DEST FILE NAME
      DEF ISEC2     DEST FILE ISECU 
      DEF DSTCR,I   DEST CRN
* 
EXIT  CLB           CLEAR OPTIONAL
      STB ISEC1      PARAM ADR LOCS 
      STB ITYP2       FOR NEXT CALL 
      STB ISIZ2        AND EXIT.
      STB IREC2 
      STB IMODE 
      STB ISEC2 
      JMP FCOPY,I 
      SPC 3 
*     WE COME HERE IF THE DESTINATION FILE NAME IS A
*     DUPLICATE NAME. WE WILL TRY THE CREATION AGAIN
*     AFTER REPLACING THE FIRST TWO CHARACTERS OF THE 
*     REQUESTED FILE NAME BY "..". IF THIS NAME IS ALSO 
*     DUPLICATE, WE WILL QUIT.
* 
RETRY LDA ..
      STA DSTFN     BUILD THE NEW FILE NAME 
* 
      JSB DCRET 
      DEF *+8 
      DEF DDCB
      DEF YERR
      DEF DSTFN     NEW FILE NAME 
      DEF ISIZE 
      DEF ITYP2     FILE TYPE 
      DEF ISEC2     DEST ISECU
      DEF DSTCR,I   DEST ICR
* 
      SSA,RSS       HOW WAS IT ?
      JMP TELIT     THIS TIME IT'S OK 
      LDA MD2       STILL BAD, GIVE A DUPLICATE DESTINATION 
      LDB MD1       CLOSE OPTION
      JMP ERROR     FILE NAME ERROR RETURN
* 
TELIT LDA D1        WRNG  CODE FOR DUPLICATE FILE NAME
      STA IERR,I
      SPC 3 
*     ALL OK GO BACK TO WORK
* 
      JMP CLOSE 
      SPC 2 
* 
* OPEN ORIGIN FILE. ENTER WITH B = OPEN OPTION. 
* NO RETURN IF ERROR. 
* 
OPENO NOP 
      STB TEMP      SET OPEN OPTION 
* 
      JSB DOPEN     OPEN ORIGIN FILE
      DEF *+7 
      DEF ODCB      ORIGIN DCB
      DEF YERR
      DEF SRCFL,I   SOURCE FILE NAME
      DEF TEMP      OPEN OPTION 
      DEF ISEC1     ISECU FOR ORIGIN
      DEF SRCCR,I   SOURCE CRN
* 
      SSA,RSS       HOW WAS IT ?
      JMP OPENO,I   ALL OK
      ADA MD100     ORIGIN ERROR
      CLB           FILE CLOSE OPTION 
      JMP ERROR     GET OUT 
      SPC 2 
* 
* OPEN DESTINATION FILE. ENTER WITH B = OPEN OPTION.
* NO RETURN IF ERROR. 
* 
OPEND NOP 
      STB TEMP      SET OPEN OPTION 
* 
      JSB DOPEN     OPEN DEST FILE
      DEF *+7 
      DEF DDCB
      DEF YERR
      DEF DSTFN     DEST FILE NAME
      DEF TEMP      OPEN OPTION 
      DEF ISEC2     SECURITY CODE 
      DEF DSTCR,I   DEST CRN ARRAY
* 
      SSA           OK? 
      JMP ERR       NO, ERROR 
      JMP OPEND,I   YES, RETURN 
      SPC 2 
* 
* CLOSE DESTINATION FILE. NO RETURN IF ERROR. 
* 
CLOSD NOP 
* 
      JSB DCLOS     CLOSE THE DESTINATION FILE
      DEF *+3 
      DEF DDCB
      DEF YERR
* 
      SSA,RSS       HOW WAS IT ?
      JMP CLOSD,I   OK, CONTINUE
      LDB D2        CLOSE OPTION
      JMP ERROR 
      SPC 2 
* 
* CLOSE ORIGIN FILE. NO RETURN IF ERROR.
* 
CLOSO NOP 
* 
      JSB DCLOS     NOW CLOSE THE ORIGIN FILE 
      DEF *+3 
      DEF ODCB
      DEF YERR
* 
      SSA,RSS       HOW WAS IT ?
      JMP CLOSO,I   OK, RETURN
      LDB D1        CLOSE OPTION
      ADA MD100     ORIGIN ERROR
      JMP ERROR 
      SPC 2 
      SPC 3 
*     CONSTANTS AND BUFFERS 
* 
A     EQU 0 
B     EQU 1 
D1    DEC 1 
D2    DEC 2 
D5    DEC 5 
D129  DEC 129 
MD1   DEC -1
MD2   DEC -2
MD6   DEC -6
MD12  DEC -12 
MD100 DEC -100
MD104 DEC -104
ISIZE BSS 2         FILE-SIZE/RECORD-SIZE 
FLTYP NOP 
NOP   NOP 
LEN   NOP 
STATS NOP 
ODCB  BSS 4 
DDCB  BSS 4 
BUF   BSS 129 
BUFL  NOP 
..    ASC 1,..
YERR  NOP 
DSTFN REP 3 
      NOP 
TEMP  NOP 
      SPC 3 
      END 
                                                                                                                                    