0001  TITL FILE COPY"VERSION 77.08.26
0002 *
0003 *
0004 *
0005 *                 *** FILE TO FILE COPY ***
0006 *
0007 *
0008 *        COPY <outfile>,<infile>,<s=options>
0009 *             <o=outfile>,<s=options>,<infile,infile,....>
0010 *
0011 *       options:  +/-A   =APPEND TO END OF OUTFILE
0012 *                 -1-9   =APPEND TO END OF OUTFILE -{n}
0013 *                 +/-E   =END OUTPUT FILE AFTER COMPLETE
0014 *
0015 *
0016  COPY NPTDEFS
0017 *
0018 *
0019  ORG 100H
0020  XEQ 100H
0021 *
0022 COPSIZ EQU 04C0H  COPY BLOCK SIZE
0023 *
0024 *
0025 *
0026 FCOPY CALL FIFIL  GET INPUT FILE
0027  CC F1ER  ERROR IN FIELD ONE
0028  CALL DELCK  CHECK IF END OF COMMAND WAS READ
0029  CZ ARGEX  ERROR IF SO
0030 *
0031  CPI '='  TYPE 2 OF THE COPY?
0032  JNZ FCOP1  IF IT WAS A REAL NAME
0033  LDA USER  GET FIRST CHARACTER
0034  CPI 'O'  OUTPUT OPTION?
0035  CNZ F1ER  MUST BE!!
0036 *
0037 *
0038 *   PROCESS THE TYPE 2 COPY
0039 *
0040  CALL FOFIL  GET OUTPUT FILE
0041  CC F1ER
0042  CALL DELCK
0043  CZ ARGEX
0044  CALL FOPTN  GET THE OPTIONS IF NONE THEN EXPECT FILE
0045  CC F2ER
0046  JNZ FCO2B
0047  CALL DELCK  CHECK FOR ; OR CR
0048  CZ ARGEX
0049 *
0050 *
0051 *     LOOP HERE FOR EACH INFILE
0052 *
0053 FCOP2 CALL FIFIL  GET INPUT FILE NO OPTIONS
0054  CC NAMER  THIRD FIELD NAME
0055 FCO2A CALL DCOPY
0056  LDA FDLMT  GET DELIMITER
0057  CPI ','
0058  JZ FCOP2
0059 *
0060  CALL DELCK  MUST END IN PROPER DELIMETER
0061  CNZ NAMER  MUST BE FUNNY CHAR IN NAME
0062 *
0063 *  THE COPY IS COMPLETE END,CLOSE AND GO BACK
0064 *
0065 FCEND LDA NEOF  GET END OF FILE FLAG

066  ORA A
0067  CZ FCENF  END FILE THE OUTPUT FILE
0068  LDA OUNUM  GET OUTPUT FILE NUMBER
0069  CALL SYS  CLOSE THE FILE
0070  DB CLOOP
0071  CALL PTDER  ERROR RETURN
0072  CALL SYS
0073  DB RETOP  ALL DONE, RETURN
0074 *
0075 *  END FILE THE OUTPUT FILE
0076 *
0077 FCENF LDA OUNUM
0078  CALL SYS
0079  DB EOFOP
0080  CALL PTDER
0081  RET
0082 *
0083 *
0084 *  NO OPTIONS SET THE INFILE NUMBER
0085 *
0086 FCO2B CALL FIFI1
0087  JMP FCO2A
0088 *
0089 *
0090 *   PROCESS THE TYPE 1 COPY
0091 *
0092 FCOP1 CALL FOFIL  GET THE OUTPUT FILE
0093  CC F2ER  FIELD TWO ERROR
0094  CALL DELCK  CHECK FOR CR OR ;
0095  JZ FCO1A  SKIP OPTIONS IF SO
0096  CALL FOPTN  IF NOT SEE IF OPTIONS
0097  CC ILLOP  ILLEGAL FIELD
0098  CNZ OPTER  NAME INSTEAD OF OPTIONS FOUND
0099  CALL DELCK
0100  CNZ ILLOP  OPTIONS SHOULD END IN CR OR ;
0101 *   DO THE COPY AND QUIT
0102 FCO1A CALL DCOPY  DO THE COPY
0103  JMP FCEND   AND QUIT
0104 *
0105 *
0106 *   NOW TRY FOR THE NEXT FIELD, EITHER NAME OR "S="
0107 *
0108 FOPTN CALL DELCK  CHECK THE LAST DELIMITER
109  RZ
0110  CALL FCNAM  GET NAME OR OPTIONS
0111 *
0112  RC .  FIELD THREE ERROR
0113  MOV A,E  CHECK IF FILE OPENED
0114  CPI 0FFH
0115  CMC .  IF SO THEN CARRY WILL NOW BE CLEAR
0116  RNZ .  ZERO FLAG NOT SET MEANS NAME FOUND AND OPENED
0117  LDA FDLMT  GET BACK THE DELIMITER
0118  CPI '='
0119  STC
0120  RNZ .  IF NOT THE RIGHT ONE
0121 *
0122 *   SCAN OPTIONS HERE
0123 *
0124 FOPT1 CALL FPSCA  GET 1 CHAR
0125  RC .  ERROR
0126  CPI ','
0127  RZ .  PROPER TERMINATOR
0128  CPI 'A'  APPEND?
0129  JZ SAPN1
0130  CPI 'E'  DO DEFAULT?
0131  JZ SEND
0132  CPI '-'  NO END OF FILE
0133  JZ FOPT2
0134  CPI ';'
135  RZ
0136  CPI 0DH
137  RZ
0138  CPI '+'
0139  CNZ ILLOP  SHOULD HAVE BEEN ONE OF THEM
0140  JMP FOPT1
0141 *
0142 FOPT2 CALL FPSCA
0143  RC .
0144  CPI 'A'
0145  JZ SAPN  DON'T APPEND
0146  CPI '0'
0147  CC ILLOP  ERROR IF < '0'
0148  CPI '9'+1
0149  JC SPAC
0150  CPI 'E'
0151  CNZ ILLOP
0152 *
0153 *
0154 *  SET END OF FILE OPTIONS
0155 *
0156  DB 3EH  THIS IS MVI A,XRA A=0AFH
0157 SEND XRA A
0158  STA NEOF  END OF FILE OPTION
0159  JMP FOPT1
0160 *
0161 *   SET SPACE BACKWARDS OPTION
0162 *
0163 SPAC SUI '0'  REMOVE ASCII BIAS
0164  STA SPACP
0165 *
0166 *
0167 *  SET APPEND OPTIONS
0168 *
0169 SAPN1 DB 03EH  MVI A,NEXT BYTE
0170 SAPN XRA A
0171  STA APND  SET APPEND
0172  JMP FOPT1
0173 *
0174 *   GET AN INPUT FILE NUMBER
0175 *
0176 FIFIL MVI A,NAMO  GET THE NAME
0177  CALL FCNA1
0178  RC .  PASS THE CARRY BACK
0179 *
0180 FIFI1 PUSH PSW  SAVE THE DELIMITER
0181  LDA FCINT
0182  STA INNUM  SAVE IN NUMBER
0183  POP PSW
0184  RET
0185 *
0186 *
0187 *   GET OUTPUT FILE NUMBER
0188 *
0189 FOFIL CALL FCNAM
0190  RC .  PASS ON THE CARRY
0191 FOFI1 STC .  IN CASE OF NO FILE NUMBER
0192  RZ .  TESTS IF NONE
0193  CMC .  UNDO WHAT WAS DONE
0194  PUSH PSW
0195  LDA FCINT  GET THE NUMBER
0196  STA OUNUM  SAVE AS OUTPUT NUMBER
0197  POP PSW
0198  RET
0199 *
0200 *
0201 *  SCAN OFF INPUT FILE NAME
0202 *
0203 FCNAM MVI A,NAMOC  OPEN, CREATE IF NOT ALREADY THERE
0204 FCNA1 LXI D,USER  THE BUFFER
0205  CALL PSCAN  THE INTERNAL PSCANNER
0206  STA FDLMT
0207  JC PSCER  ERROR RETURN
0208  STC .  JUST IN CASE OF NO CHARS
0209  RZ .  IF NONE
0210  MOV A,D  CHECK FOR FILE NUMBER TOO BIG

211  ORA A
0212  STC .  ERROR
0213  RNZ .  D MUST BE 0
0214  CMC .  UNDOIT
0215  MOV A,E  GET FILE NUMBER
0216  STA FCINT  SET INPUT FILE
0217  INR A  SET FLAGS, TEST "FF"
0218  LDA FDLMT  GET DELIMITER
0219  RNZ .  IT WAS A GOOD FILE NUMBER
0220  CPI '='
221  RZ
0222  STC .  WILL ONLY ACCEPT EQUAL OR ELSE ERROR
0223  RET
0224 *
0225 *
0226 PSCER MOV A,E  TEST TYPE OF ERROR

227  ORA A
0228  CNZ GENER  DO A PTDOS ERROR RETURN
0229  STC .  PSCAN ERROR.  RETURN TO CALLING ROUTINE.
0230  RET
0231 *
0232 *
0233 *   GET ONE CHR FROM PSCAN
0234 *
0235 *
0236 FPSCA MVI A,CHRON  CHARACTER ONLY
0237  CALL PSCAN
0238  RC .  ON ERROR
0239  STA FDLMT
0240  RET
0241 *
0242 *
0243 *
0244 *     COPY DATA
0245 *
0246 *
0247 DCOPY XRA A  CLEAR END OF TRANSFER FLAG
0248  STA TCFLG
0249  LDA SPACP  IF BACK SPACE WANTED THEN ASSUME APPEND

250  ORA A
0251  JNZ DCOP2
0252  LDA APND  SEE IF APPEND IS WANTED

253  ORA A
0254  JZ FTRAN  NOPE
0255 *
0256 *  SPACE TO END OF FILE
0257 *
0258 DCOP2 LDA OUNUM  GET OUTFILE NUMBER
0259  MVI D,-1   SPACE TO END OPERATION
0260  CALL SYS
0261  DB SPAOP
0262  CALL PTDER
0263  XRA A   NO NEED TO SPACE TO END ANY MORE(CAN'T HURT THO)
0264  STA APND
0265 *
0266 *  SEE IF SPACE BACKWARDS IS WANTED
0267 *
0268 FTRA LDA SPACP  GET PARAMETER

269  ORA A
0270  JZ FTRAN  DON'T SPACE BACK
0271  MOV C,A  SPACE BACKWARDS 'A' AMOUNT
0272  MVI B,0
0273  LDA OUNUM  GET OUTPUT FILE NUMBER
0274  MVI D,128
0275  CALL SYS
0276  DB SPAOP  DO THE SPACE
0277  CALL PTDER  ERROR RETURN
0278 *
0279 FTRAN CALL INTST
0280  LDA INNUM  GET FILE #1 NUMBER
0281  LXI B,COPSIZ  COUNT
0282  LXI D,FCBUF  THE BUFFER
0283  CALL SYS
0284  DB RBLOP
0285  CALL ERTST  TEST IF WE HIT THE EOF
0286 *
0287 TWRAN LXI B,COPSIZ
0288 TWRA1 CALL INTST
0289  LXI D,FCBUF
0290  LDA OUNUM  OUTFILE NUMBER
0291  CALL SYS
0292  DB WBLOP
0293  CALL PTDER
0294  LDA TCFLG  TRANSFER COUNT

295  ORA A
0296  JZ FTRAN  NO
0297 *
0298 *  DONE
0299 *
0300  LDA INNUM
0301  CALL SYS  CLOSE THE INPUT FILE
0302  DB CLOOP
0303  CALL PTDER
0304  RET
0305 *
0306 *
0307 ERTST CPI EREOF  EOF?
0308  JNZ PTDER  NO, OTHER ERROR
0309  STA TCFLG  SET TRANSFER COMPLETE FLAG
0310  POP H  GET RID OF RETURN ADDRESS
0311  LXI H,FCBUF
0312 *  DE HAS LAST READ ADDRESS
0313  MOV A,E

314  SUB L
0315  MOV C,A
0316  MOV A,D

317  SBB H
0318  MOV B,A
0319  JMP TWRA1
0320 *
0321 *
0322 *  INTST
0323 *
0324 INTST PUSH B  SAVE BC
0325  CALL CONTST  CHECK CONSOLE
0326  JZ BPOP  NO KEY PRESSED
0327  CALL CONIN  GET CHAR
0328  ANI 7FH  CHECK FOR QUIT
0329  JZ QUIT  YES!
0330  CALL RETCHAR  PUT UNUSED CHAR BACK.
0331 BPOP POP B  NO QUIT
0332  RET
0333 *
0334 RETCHAR LHLD SYSGLO
0335  LXI D,GLFLG  SET CHAR WAITING FLAG.

336  DAD D
0337  MOV M,A  WE KNOW THAT CHAR IS NON-ZERO.
0338  RET
0339 *
0340 QUIT LXI D,QUITM
0341  JMP MESG
0342 QUITM ASC 'QUIT: FILES STILL OPEN AND NOT ENDFILED'
0343  DB 0
0344 *
0345 *  DELCK - CHECK LAST DELIMETER READ FOR ';' OR CR
0346 *
0347 DELCK LDA FDLMT
0348  CPI ';'
349  RZ
0350  CPI 0DH
351  RZ
0352  RET .  ZERO FLAG NOT SET: NON-FINAL DELIMETER
0353 *
0354 *
0355 *  ERROR ROUTINES
0356 *
0357 GENER STA ERMCD
0358  JMP NOCOD
0359 *
0360 PTDER STA ERMCD  STORE ERROR # FOR UTILITY
0361  CALL CLOSE
0362  POP H  GET RETURN ADDRESS
0363  DCX H  MOVE TO COMMAND OP

364  DCX H

365  DCX H

366  DCX H
0367  MOV A,M  GET OP
0368  STA COMCD  STORE FOR ERROR UTILITY
0369 NOCOD LXI H,COPYMESG  PRINT 'CALLED FROM COPY'
0370  MVI A,02H  UTILITY OP
0371  CALL UTIL  CALL UTILITY HANDLER
0372  DB UXOP
0373  JMP ABORT
0374 COMCD DB -1
0375 ERMCD DB -1
0376 ABORT CALL SYS
0377  DB ABTOP
0378 *
0379 COPYMESG ASC "COPY"
0380  DB 0
0381 *
0382 OPTER LDA FCINT  NAME INSTEAD OF OPTIONS FOUND
0383  CALL SYS  SO CLOSE NAME OPENED
0384  DB CLOOP
0385  NOP .  IGNORE ERROR
0386  NOP
0387  NOP
0388 ILLOP LXI D,OPERR
0389  JMP ERMES
0390 OPERR ASC 'OPTION ERROR'
0391  DB 0
0392 *
0393 F1ER LXI D,F1ERM
0394  JMP ERMES
0395 F1ERM ASC 'ERROR IN FIRST ARGUMENT'
0396  DB 0
0397 *
0398 F2ER LXI D,F2ERM
0399  JMP ERMES
0400 F2ERM ASC 'ERROR IN SECOND ARGUMENT'
0401  DB 0
0402 *
0403 ARGEX LXI D,AREXM
0404  JMP ERMES
0405 AREXM ASC 'ARGUMENT EXPECTED'
0406  DB 0
0407 *
0408 NAMER LXI D,NMERM
0409  JMP ERMES
0410 NMERM ASC 'ERROR IN NAME'
0411  DB 0
0412 *
0413 *
0414 CLOSE LDA INNUM  SEE IF INPUT FILE IS OPEN
0415  CPI -1
0416  JZ OCLOS  NOPE
0417  CALL SYS  CLOSE INPUT FILE
0418  DB CLOOP
0419  NOP .  IGNORE ERROR NOW
0420  NOP
0421  NOP
0422 OCLOS LDA OUNUM  SEE IF OUTPUT FILE IS OPEN
0423  CPI -1
0424  RZ .  NOPE
0425  CALL SYS
0426  DB CLOOP
0427  NOP .  IGNORE ERROR
0428  NOP
0429  NOP
0430  RET
0431 *
0432 ERMES CALL CLOSE
0433 MESG LHLD SYSGLO  GET CI OUTPUT FILE NUMBER
0434  LXI B,GLCOF

435  DAD B
0436  MOV A,M  GOT FILE #
0437  MVI L,0  DELIMITER FOR WRITE
0438  LXI B,0FFH  MAX TRANSFER COUNT
0439  CALL SYS  WRITE OUT MESSAGE
0440  DB DWROP
0441  CALL PTDER
0442  LXI D,CRLF  FINISH MESSAGE WITH CR AND LF
0443  LXI B,2
0444  CALL SYS
0445  DB WBLOP
0446  CALL PTDER
0447  CALL SYS  RESET RETURN
0448  DB RESOP
0449 CRLF DW 0A0DH
0450 *
0451 *
0452 *   PARAMETERS
0453 *
0454 APND DB 0  NON ZERO FOR APPEND
0455 NEOF DB 0  NON ZERO FOR NO END OF FILE
0456 SPACP DB 0  ZERO THROUGH NINE FOR BACKWARDS SPACE
0457 FCINT DB 0
0458 FDLMT DB 0
0459 INNUM DB -1  FF MEANS NO FILE OPEN
0460 OUNUM DB -1  "    "   "   "    "
0461 TCFLG DB 0
0462 *
0463 *  BUFFERS
0464 *
0465  DB '.'+80H  FILE TYPE
0466 BLKSZ DW 4C0H
0467  DB 0  ATTRIBUTES
0468 USER DS 25
0469 FCBUF DS COPSIZ
0470 POTTS EQU $
0471 *
0472 *
0473 *          EQUATES
0474 *
0475 NAMO EQU 1  OPEN FILE
0476 NAMOC EQU 0  OPEN, CREATE AS NECESSARY
0477 CHRON EQU 20H  CHARACTER RETURN ONLY
0478 *
0479 *
0480  END
0481 *