* Archiver III 8/14/88

       DEF  START,SLAST,TMPEND

       AORG >A5CE

START  LWPI >8320         *** THIS GETS OVERWRITTEN... ONLY EXECUTES ONCE
       LI   R1,SREGV    SETUP REGS
SRGX2  MOV  *R1+,R0
       JEQ  SRGX
       BLWP @VWTR
       JMP  SRGX2
SRGX   MOVB @SREGV+1,@>83D4
       CLR  R0
       BLWP @VWTR
       BLWP @VMBRD     adjust char set
       DATA >900,>2000,>300
       BLWP @VMBWD
       DATA >100,>2000,>300
       BLWP @VMBWD
       DATA >3F8,DBAR,8
       BLWP @VMBWD
H7E    DATA >7E,CALFIL,8    CALL FILES(1)
       MOV  @H7E,@>8356
       MOVB @H202,@>834C
       BLWP @DSRLNK
       DATA >A
       BLWP @VMBWD
       DATA >7A,RENAM,4
       LI   R0,>0044
       MOVB R0,@>8C02
       SWPB R0
       MOVB R0,@>8C02
       LI   R1,'  '
       LI   R2,960
SCRNCL MOVB R1,@>8C00
       DEC  R2
       JNE  SCRNCL
       BLWP @VMBWD
       DATA >402,MS1,36
       BLWP @VMBWD
       DATA >42F,MS4,26
       BLWP @VMBWD
       DATA >450,BAR,40
       BLWP @VMBWD
       DATA >4A2,CREDIT,87
       BLWP @VMBWD
       DATA >572,CRD2,11
       BLWP @VMBWD
       DATA >59A,CRD2A,13
       BLWP @VMBWD
       DATA >5C2,CRD2B,22
       BLWP @VMBWD
       DATA >632,CRD3,78
       BLWP @VMBWD
       DATA >6D2,CRD4,156
       BLWP @VMBWD
       DATA >79B,CRD4A,33
       LI   R1,'  '
       LI   R0,>7BF
       BL   @KEYINB
       MOV  @H9E7E,@>8372
       LI   R0,MS4
       CLR  R1
DTHLP  AB   *R0+,R1
       CI   R0,CRD4A
       JNE  DTHLP
       CLR  @DEATHF
       CI   R1,>FD00
       JEQ  NODETH
       SETO @DEATHF
NODETH B    @MAIN
SREGV  DATA >01F0,>0400,>0201,>07F4,0
H9E7E  DATA >1414
RENAM  DATA >0112,>0113
CALFIL DATA >0116,>0110,>0114,>0115
DBAR   DATA 0,>FF00,>FF00,0
BAR    DATA >7F7F,>7F7F,>7F7F,>7F7F
       DATA >7F7F,>7F7F,>7F7F,>7F7F
       DATA >7F7F,>7F7F,>7F7F,>7F7F
       DATA >7F7F,>7F7F,>7F7F,>7F7F
       DATA >7F7F,>7F7F,>7F7F,>7F7F
MS1    TEXT 'Archiver III - Version 3.03g  8/5/89'  36
CRD2   EQU  $+15
MS4    TEXT 'Copyright 1989 Barry Boone' 26
CREDIT TEXT 'This program is FAIRWARE. If you use  '
       TEXT '  it, please send what it is worth to   '
       TEXT '  you to:'
CRD2A  TEXT 'P.O. Box 1233'
CRD2B  TEXT 'Sand Springs, OK  74063'
CRD3   TEXT '*NOTE* Copy fees paid to user groups  '
       TEXT '  do NOT count as payment to the author.'
CRD4   TEXT 'Users who have paid over $20.00 for   '
       TEXT '  Archiver II or III are not asked for  '
       TEXT '  payment, though a few dollars for the '
       TEXT '  update would be GREATLY appreciated!'
CRD4A  TEXT '*** Press any key to continue ***'

TMPEND EQU  $    should be >A8F0, end of temp area
SDD    DATA '_1'
ODD    DATA '_2'
MS2    TEXT '1) Archive Files'
MS3    TEXT '2) Extract Files'
MSC    TEXT '3) Catalog Disk'
MS5    TEXT '4) Catalog ArcFile'
MS6    TEXT '5) File Copy'
MS7    TEXT '6) File Rename'
MS8    TEXT '7) File Delete'
MS9    TEXT '8) File Un/Protect'
MSA    TEXT '9) List Text File'
MSB    TEXT '0) Load FW'
FIN    TEXT 'Finished. Press any key.'
PAKTS  TEXT 'BACK / REDO / Any Key to Begin' 30
SDRV   TEXT 'Source Drive (1-Z) :' 20
TDRV   TEXT 'Output Drive (1-Z) :'
SFIL   TEXT 'Source Filename    :'
TFIL   TEXT 'Output Filename    :'
SWAPD  TEXT 'Swap Disks? (Y/N)  :'
PROC   TEXT '         Processing...        '
PAKALL TEXT 'Pack all files? (Y/N):'
CMPRS$ TEXT 'Compress? (Y/N)    :'
EXTALL TEXT 'Extract all files? (Y/N):'
PRNT   TEXT 'Printout? (Y/N)    :'
PRNTD  TEXT 'Device:' 7
PROT   TEXT 'Protect? (Y/N)     :'
IOERR  TEXT 'I/O Error #'
NCLUD  TEXT 'Include            (Y/N)? '  26
CRFILP TEXT 'Current File: ' 14
INSSD  TEXT 'Insert Source Disk'  18
INSOD  TEXT 'Insert Output Disk'
NOTARC TEXT 'This is NOT an ArcFile'

PABOP  DATA >000A
PABPTR DATA 0,>8080,0
PABLEN DATA 0
PABDEV TEXT 'DSK'
DRVNUM TEXT 'x.'
FILNM  TEXT '          '
PRTDEV TEXT 'PIO                        '
STAB   DATA 16,16,15,18,12
       DATA 14,14,18,17,10,0
NMTAB  DATA MS2+3,MS3+3,MSC+3
       DATA MS5+3,MS6+3,MS7+3,MS8+3
       DATA MS9+3,MSA+3,MSB+3
VECTBL DATA COMP,DECOMP,DSKKAT,ARCCAT
       DATA CPYFIL,RENAME,DELETE,UPPROT
       DATA VIEWFL,FWEB
IFILNM TEXT '          '
OFILNM TEXT '          '

INSSRC LI   R1,INSSD
       MOV  R11,R10
       ABS  @WDRV
       JEQ  INSRTX
       CLR  @WDRV
       JMP  INSERT
INSTAR LI   R1,INSOD
       MOV  R11,R10
       ABS  @WDRV
       JNE  INSRTX
       SETO @WDRV
INSERT ABS  @SWPFLG
       JNE  INSRTX
       LI   R0,>7A3
       LI   R2,18
       BLWP @VMBW
       LI   R0,>7BF
       LI   R1,'  '
       BL   @KEYINB
       BLWP @VMBWD
       DATA >79D,PROC,30
INSRTX B    *R10

INCLUD MOV  R11,R10
       LI   R9,>A000
       BLWP @VMBWD
       DATA >5E7,NCLUD,26
INCLD1 MOV  R9,R1
       MOV  *R1,*R1
       JEQ  INCLD2
       LI   R0,>5EF
       LI   R2,10
       BLWP @VMBW
INCLD4 LI   R0,>602
       BL   @KEYIN
       CI   R1,'Y'*256
       JEQ  INCLD3
       CI   R1,'N'*256
       JNE  INCLD4
       SETO *R9
INCLD3 AI   R9,18
       JMP  INCLD1
INCLD2 CI   R9,>A000
       JEQ  INCLD5
       AI   R9,-18
       C    *R9,@HFFFF
       JNE  INCLD5
       CLR  *R9
       JMP  INCLD2
INCLD5 B    *R10

DFAOTG MOVB @ODRV,@>834C
       MOV  @H90,@>834E
       MOVB @HA,@>8350
       MOV  @H84,@>8356
       LI   R0,INSTAR
       JMP  DFACN

DFAING MOVB @IDRV,@>834C
       MOV  @H86,@>834E
       CLR  @>8350
       MOV  @H82,@>8356
       LI   R0,INSSRC
DFACN  MOV  R11,@DFARET+2
       BL   *R0
       BLWP @DSRLNK
       DATA >A
       MOVB @>8350,R0
       JNE  ERR2
DFARET B    @0

HA000  DATA >A000
H8000  DATA >8000
H80    DATA >80
H82    DATA >82
H84    DATA >84
H86    DATA >86
H90    DATA >90
H202   DATA >0202
H802   DATA >0802
D26    DATA 25
D52    DATA 50
D10    DATA 10
H19    DATA >19
DEATHF DATA 0
CURBLK DATA 0
GETDIR DATA 0
DCINSZ DATA 0
OTFSIZ DATA 0
PAKFLG DATA 0
ALLFLG DATA 0
SWPFLG DATA 0
WDRV   DATA 0
NOF9   DATA 0
DSKKTF DATA 0
ONE    BYTE 1
IDRV   BYTE 5
ODRV   BYTE 5
HA     BYTE >A
ERR2   SRL  R0,5
ERROR  ANDI R0,>700
       AI   R0,>3000
       BLWP @VMBWD
       DATA >7A6,IOERR,11
       MOVB R0,@>8C00
ERROR3 LI   R0,>7F6
       BLWP @VWTR
       ABS  @NOF9
       JEQ  CMDFN2
       CLR  @NOF9
       BLWP @LCCLS2
       JMP  CMDFN2
CMDFN3 LI   R0,>717
       BLWP @VWTR
CMDFIN BLWP @VMBWD
       DATA >7A0,FIN,24
CMDFN2 LI   R1,'  '
       LI   R0,>7BF
       BL   @KEYINB
MAIN
MAIN2  LI   R0,>07F4
       BLWP @VWTR
       BL   @CLS
       SETO @SWPFLG
       SETO @WDRV
       CLR  @NOF9
       CLR  @DSKKTF
       CLR  @PARSEF
       MOV  @H7C0,@INBUF
       MOV  @H21C0,@INBFEN
       MOV  @H21C0,@OTBUF
       MOV  @H3BC0,@OTBFEN
       LI   R0,>4AB
       LI   R1,MS2
       LI   R3,STAB
MENU   MOV  *R3+,R2
       JEQ  MENXIT
       BLWP @VMBW
       AI   R0,>50
       A    R2,R1
       JMP  MENU
MENXIT LI   R0,>7BF
       LI   R1,'  '
       BL   @KEYINB
       CI   R1,>8500
       JEQ  BLWZER
       CI   R1,>0500
       JNE  NBLWZE
BLWZER BLWP @0
NBLWZE CI   R1,>3000
       JL   MENXIT
       CI   R1,>3900
       JH   MENXIT
       BL   @CLS
       AI   R1,->3000
       JNE  NOTZ
       AI   R1,>A00
NOTZ   SWPB R1
       SLA  R1,1
       MOV  @STAB-2(R1),R2
       AI   R2,-3
       MOV  @VECTBL-2(R1),R3
       MOV  @NMTAB-2(R1),R1
       LI   R4,41
       S    R2,R4
       SRL  R4,1
       LI   R0,>4A0
       A    R4,R0
       BLWP @VMBW
       B    *R3
CTAB   DATA GSDRV,GODRV,GOFIL,QPKALL,QCOMPR
       DATA QSWAP,0
DTAB   DATA GSDRV,GSFIL,GODRV,QUPALL,QSWAP,0
DSKTAB DATA GSDRV,QPRINT,QPRTDV,0
DSATAB DATA GSDRV,GSFIL,QPRINT,QPRTDV,0
CPYTAB DATA GSDRV,GSFIL,GODRV,GOFIL,QSWAP,0
RTAB   DATA GSDRV,GSFIL,GOFIL,0
VDTAB  DATA GSDRV,GSFIL,0
FTAB   DATA GSDRV,0
PRTTAB DATA GSDRV,GSFIL,QPROTC,0

DSKKAT SETO @DSKKTF
       LI   R3,DSKTAB
       BL   @GETIN
       B    @TEST2

ARCCAT SETO @DSKKTF
       LI   R3,DSATAB
       BL   @GETIN
       JMP  DECP2

NONARC BLWP @VMBWD
       DATA >7A1,NOTARC,22
       B    @CMDFN2
DECOMP LI   R3,DTAB
       BL   @GETIN
DECP2  BLWP @VMBWD
       DATA >86,IFILNM,10
TEST4  CLR  @>834C
       BL   @DFAING
       MOV  @>8304,R0
       CB   @>8307,@H80+1 is reclen=128?
       JNE  NONARC
TEST5  COC  @H8000,R0  see if variable
       JEQ  NONARC
TEST6  MOV  @H7C0,@>8300
       COC  @H202,R0  check internal flag...
       JEQ  IF128
       B    @UNPAK
IF128  BLWP @LDINIT
       MOV  @D26,@>834C
       MOV  @D26,@DCINSZ
       CLR  @>8302
       BL   @DFAING
       BLWP @VMBRD
       DATA >7C0,TSTIN,>100
       CB   @TSTIN,@H8000
       JNE  NONARC
       SETO @GETDIR
       BLWP @LZPARS
       ABS  @DSKKTF
       JEQ  NOWH
       BL   @CLS
       B    @FILLST
NOWH   ABS  @ALLFLG
       JEQ  INCLDA
       BL   @CLSA
       BL   @INCLUD
INCLDA LI   R8,IFILNM
       BL   @NAMCHK
       LI   R9,>A000
       BL   @CLSA
       BLWP @VMBWD
       DATA >5E8,CRFILP,14
DCOML1 MOV  *R9,R0
       JEQ  EOLIST
       LI   R0,>90
       MOV  R9,R1
       LI   R2,10
       BLWP @VMBW
       C    *R9,@HFFFF
       JNE  DCML1A
       AI   R9,18
       MOV  @-6(R9),@PARSEF
       JEQ  DCOML1
       BLWP @GOTDIR
       JMP  DCOML1
DCML1A A    R2,R9
       LI   R0,>5F6
       BLWP @VMBW
       MOV  *R9+,@>830E
       MOV  *R9,R6
       MOV  *R9+,@>830C
       MOV  *R9+,@>8310
       MOV  *R9+,@>8312
       CLR  @>834C
       BL   @DFAOTG        allocate file
       CLR  R4
DCOML2 MOV  R6,R5
       JEQ  DCOML1
       CI   R6,25
       JLE  DCOML3
       LI   R5,25
DCOML3 S    R5,R6
       MOV  R5,@CURBLK
       SLA  5,8
       AI   5,>20C0
       MOV  5,@OTBFEN
       MOV  @H21C0,@OTBUF
       BLWP @GOTDIR
       MOV  @CURBLK,@>834C
       MOV  @H21C0,@>830A
       MOV  R4,@>830C
       BL   @DFAOTG
       A    @CURBLK,R4
       JMP  DCOML2
EOLIST B    @CMDFN3

UNPAK  MOV  @D10,@>834C
       CLR  @>8302
       BL   @DFAING
       BLWP @VMBRD
       DATA >7C0,>2000,>A00
       LI   R1,>2000
       LI   R9,>A000
       CLR  R4
UNPAK2 LI   R2,>FC
UNPAK0 MOV  *R1,R0
       JEQ  UNPKG
       LI   R3,18
UNPAK1 MOV  *R1+,*R9+
       DECT R3
       JNE  UNPAK1
       AI   R2,-18
       JNE  UNPAK0
       INC  R4
       C    @ENDM,*R1+
       JEQ  UNPAK3
       INCT R1
       JMP  UNPAK2
UNPKG  INC  R4
UNPAK3 CLR  *R9
       MOV  R4,@DCINSZ
       ABS  @DSKKTF
       JEQ  NOWH2
       BL   @CLS
       B    @FILLST
NOWH2  ABS  @ALLFLG
       JEQ  INCLDB
       BL   @CLSA
       BL   @INCLUD
INCLDB LI   R8,IFILNM
       BL   @NAMCHK
       LI   R9,>A000
       BL   @CLSA
       BLWP @VMBWD
       DATA >5E8,CRFILP,14
UPOML1 MOV  *R9,R0
       JEQ  EOLIST
       LI   R0,>90
       MOV  R9,R1
       LI   R2,10
       BLWP @VMBW
       C    *R9,@HFFFF
       JNE  UPML1A
       A    R2,R9
       INCT R9
       A    *R9,@DCINSZ
       AI   R9,6
       JMP  UPOML1
UPML1A A    R2,R9
       LI   R0,>5F6
       BLWP @VMBW
       MOV  *R9+,@>830E
       MOV  *R9,R6
       MOV  *R9+,@>830C
       MOV  *R9+,@>8310
       MOV  *R9+,@>8312
       CLR  @>834C
       BL   @DFAOTG        allocate file
       CLR  R4
UPOML2 MOV  R6,R5
       JEQ  UPOML1
       CI   R6,50
       JLE  UPOML3
       LI   R5,50
UPOML3 S    R5,R6
       MOV  R5,@>834C
       MOV  @H7C0,@>8300
       MOV  @DCINSZ,@>8302
       A    R5,@DCINSZ
       BL   @DFAING
       MOV  R5,@>834C
       MOV  @H7C0,@>830A   *** POSSIBLY NOT NEEDED
       MOV  R4,@>830C
       BL   @DFAOTG
       A    R5,R4
       JMP  UPOML2

GETFL2 DATA >8320,$+2
       MOV  @H7C0,@INBUF
       MOV  @H21C0,@INBFEN
       MOV  @H7C0,@>8300
       MOV  @D26,@>834C
       MOV  @DCINSZ,@>8302
       A    @D26,@DCINSZ
       BL   @DFAING
       RTWP

BLKOUT DATA >8320,$+2
       BL   @INSTAR
       MOV  @OTBFEN,R1
       S    @H21C0,R1
       SRL  R1,7              R1=size of buffer in sectors
       MOV  @H21C0,@PABPTR
BOUTLP BLWP @VMBWD
       DATA >10,PABOP,4
       MOV  @H19,@>8356
       BLWP @DSRLNK
       DATA 8
       JNE  NOOPER
NOOPR2 B    @ERROR
NOOPER A    @H80,@PABPTR
       DEC  R1
       JNE  BOUTLP
       MOV  @H21C0,@OTBUF
       RTWP
GETSEC MOV  R11,@GETSCX+2
       SETO @>834C
       MOVB @IDRV,@>834C
       MOV  @H7C0,@>834E
       MOV  R3,@>8350
       MOV  @H80,@>8356
       MOV  R1,@SAVR1+2
       BL   @INSSRC
       BLWP @DSRLNK
       DATA >A
       MOVB @>8350,R0
       JNE  NOOPR2
       LI   R0,>7C0
SAVR1  LI   R1,0
       LI   R2,>100
       BLWP @VMBR
GETSCX B    @0

COMP   LI   R3,CTAB
       BL   @GETIN
       MOVB @ODD+1,@DRVNUM
       LI   R0,FILNM
       LI   R1,OFILNM
       LI   R2,10
CMPML  MOVB *R1,*R0+
       CB   *R1+,@H20
       JEQ  OTCM
       DEC  R2
       JNE  CMPML
OTCM   AI   R2,-15
       ABS  R2
       MOV  R2,@PABLEN
       BLWP @VMBWD
       DATA >10,PABOP,26
       BLWP @VMBWD
       DATA >90,OFILNM,10
TEST2  MOVB @IDRV,@>834C
       CLR  R3
       LI   R1,>2000
       BL   @GETSEC
       INC  R3
       LI   R1,>2100
       BL   @GETSEC
       MOV  R1,R8
       LI   R9,>A000
DIREN0 MOV  *R8+,R3
       JEQ  DIREN
       LI   R1,>2200
       BL   @GETSEC
       LI   R2,10
DIREN1 MOV  *R1+,*R9+
       DECT R2
       JNE  DIREN1
       INCT R1
       MOV  *R1+,*R9+
       MOV  *R1+,*R9+
       MOV  *R1+,*R9+
       MOV  *R1,*R9+
       JMP  DIREN0
DIREN  CLR  *R9
       ABS  @DSKKTF
       JEQ  DIREXX
       B    @DSKCAT
DIREXX ABS  @ALLFLG
       JEQ  INCLDC
       BL   @CLSA
       BL   @INCLUD
INCLDC LI   R8,OFILNM
       BL   @NAMCHK
       LI   R9,>A000
       BL   @CLSA
       BLWP @VMBWD
       DATA >5E8,CRFILP,14
       LI   R3,>2000
DIREN5 LI   R2,>FC
DIREN2 MOV  *R9,R0
       JEQ  DIREN6
       C    *R9,@HFFFF
       JNE  DIREN3
       AI   R9,18
       JMP  DIREN2
DIREN3 LI   R1,18
DIREN4 MOV  *R9+,*R3+
       DECT R1
       JNE  DIREN4
       AI   R2,-18
       JNE  DIREN2
DIRENA MOV  *R9,R0
       JEQ  DIREN6
       CI   R0,>FFFF
       JNE  DIREN9
       AI   R9,18
       JMP  DIRENA
DIREN9 CLR  *R3+
       CLR  *R3+
       JMP  DIREN5
DIREN6 MOV  R2,R2
       JEQ  DIREN7
DIREN8 CLR  *R3+
       DECT R2
       JNE  DIREN8
DIREN7 MOV  @ENDM,*R3+
       MOV  @ENDM+2,*R3+
*
*  Directory now built...
*
       MOV  @H80,@>8310
       MOV  @H802,@>830E
       ABS  @PAKFLG
       JEQ  CMPRS
       B    @PACKFL
CMPRS  CLR  R1
       LI   R0,>10
       BLWP @VSBW
       SETO @NOF9
       MOV  @H19,@>8356
       BL   @INSTAR
       BLWP @DSRLNK
       DATA 8
       JNE  NOOPR3
       B    @ERROR
NOOPR3 LI   R1,>0300
       MOVB R1,@PABOP
       LI   R0,>7C0
       MOV  R0,@INBUF
       MOV  R0,@INBFEN
       LI   R1,>2000
       S    R1,R3
       MOV  R3,R2
       BLWP @VMBW
       A    R2,@INBFEN
       LI   R2,TSTIN
       LI   R3,>100
LODDIR MOV  *R1+,*R2+
       DECT R3
       JNE  LODDIR
       BLWP @LCINIT
       LI   R9,>A000        now lets parse the incoming files...
DDOML1 MOV  *R9,R0
       JEQ  EOLISD
       LI   R0,>86
       MOV  R9,R1
       LI   R2,10
       BLWP @VMBW
       C    *R9,@HFFFF
       JNE  DDML1A
       AI   R9,18
       JMP  DDOML1
DDML1A A    R2,R9
       LI   R0,>5F6
       BLWP @VMBW

* test code (Myarc ctrler fix?)
       AI   R9,8
       CLR  @>834C
       BL   @DFAING
       MOV  @>8302,R6
* end test code

*      MOV  *R9+,@>8304
*      MOV  *R9+,R6
*      MOV  *R9+,@>8306
*      MOV  *R9+,@>8308
       CLR  R4
DDOML2 MOV  6,6
       JEQ  DDOML1
       MOV  R6,R5
       CI   R6,25
       JLE  DDOML3
       LI   R5,25
DDOML3 S    R5,R6
       MOV  R5,@CURBLK
       SLA  5,8
       AI   5,>7C0
       MOV  5,@INBFEN
       MOV  @H7C0,@INBUF
       MOV  @CURBLK,@>834C
       MOV  @H7C0,@>8300
       MOV  R4,@>8302
       BL   @DFAING
       BL   @PRESCN
       A    @CURBLK,R4
       BLWP @LZCMP
       JMP  DDOML2
EOLISD BLWP @LCCLOS
       B    @CMDFN3

PACKFL LI   R9,>A000
       CLR  R6
PAKADD MOV  *R9,R0
       JEQ  PAKADX
       CI   R0,>FFFF
       JNE  PAKAD1
PAKAD2 AI   R9,18
       JMP  PAKADD
PAKAD1 A    @12(R9),R6
       JMP  PAKAD2
PAKADX LI   R1,>2000
       S    R1,R3
       MOV  R3,R2
       SRL  R3,8
       A    R3,R6
       MOV  R3,@OTFSIZ
       LI   R0,>7C0
       BLWP @VMBW
       MOV  R6,@>830C
       SWPB R6
       SLA  R6,1
       MOV  R6,@>8312
       SWPB R6
       SRL  R6,1
       CLR  @>834C
       BL   @DFAOTG      allocate d/f 128 file
       MOV  @H7C0,@>830A
       CLR  @>830C
       MOV  R3,@>834C
       BL   @DFAOTG      write out directory
       LI   R9,>A000        now lets parse the incoming files...
       MOV  R9,@DIRCUR
PKOML1 MOV  *R9,R0
       JEQ  PKLISD
       LI   R0,>86
       MOV  R9,R1
       LI   R2,10
       BLWP @VMBW
       C    *R9,@HFFFF
       JNE  PKML1A
       AI   R9,18
       JMP  PKOML1
PKML1A A    R2,R9
       LI   R0,>5F6
       BLWP @VMBW
       MOV  *R9+,@>8304
       MOV  *R9+,R6
       MOV  *R9+,@>8306
       MOV  *R9+,@>8308
       CLR  R4
PKOML2 MOV  6,6
       JEQ  PKOML1
       MOV  R6,R5
       CI   R6,50
       JLE  PKOML3
       LI   R5,50
PKOML3 S    R5,R6
       MOV  R5,@>834C
       MOV  @H7C0,@>8300
       MOV  R4,@>8302
       BL   @DFAING
       MOV  @OTFSIZ,@>830C
       MOV  @H7C0,@>830A
       MOV  R5,@>834C
       BL   @DFAOTG
       A    R5,@OTFSIZ
       A    R5,R4
       JMP  PKOML2
PKLISD B    @CMDFN3

CPYFIL LI   R3,CPYTAB
       SETO @SWPFLG
       SETO @WDRV
       BL   @GETIN
       BLWP @VMBWD
       DATA >86,IFILNM,20
       CLR  @>834C
       BL   @DFAING
       LI   R0,>8302
       LI   R1,>830C
       MOV  *R0+,*R1+
       MOV  *R0+,*R1+
       MOV  *R0+,*R1+
       MOV  *R0,*R1
       CLR  @>834C
       BL   @DFAOTG
       MOV  @>8302,R6
       CLR  R4
CPYFL2 MOV  R6,R6
       JEQ  CPYFLX
       MOV  R6,R5
       CI   R6,50
       JLE  CPYFL3
       LI   R5,50
CPYFL3 S    R5,R6
       MOV  R5,@>834C
       MOV  R4,@>8302
       MOV  @H7C0,@>8300
       BL   @DFAING
       MOV  R5,@>834C
       MOV  R4,@>830C
       MOV  @H7C0,@>830A
       BL   @DFAOTG
       A    R5,R4
       JMP  CPYFL2
CPYFLX BL   @CLSG
       JMP  CPYFIL
       MOV  @H7C0,@>830A
       BL   @DFAOTG
       A    R5,R4
       JMP  CPYFL2
CPYFLX BL   @CLSG
       JMP  CPYFIL
