     .OUTPI ALFRES
     .ENTRY XARC,SPARTA,ARCXIT,CMDLIN
     .VIRT8 ZPAG
;The archive extractor, based on the XARC program and incorporating the
;AlfCrunch program as well

STAK *=*+1          OLD STACK VALUE
SPARTA .BYTE 0      1=SPARTA DOS
CMDLIN *=*+64       COPY OF SPARTA CMDL
ARCFIL *=*+90       INPUT FILENAME

TITLE  .BYTE 125,"V2.0   AlfCrunch   9/1/88",$9B,$9B,0
ASKI   .BYTE "Input Filename:",$9B,0

ERR001 .BYTE "Error Opening Archive",$9B,0
ERR002 .BYTE "Processing Ended With Errors",$9B,0
FINIT  .BYTE "Processing Complete",$9B,0

XARC   TSX     SAVE OLD STACK
       STX STAK
       LDA $0700
       CMP #$53
       BNE XARC01
       INC SPARTA   TURN SPARTA ON
       LDA $0A
       CLC
       ADC #63      POINT TO BUFFER
       STA ZPAG
       LDA $0B
       ADC #0
       STA ZPAG+1
       LDY #63
XARC00 LDA (ZPAG),Y
       STA CMDLIN,Y
       DEY
       BPL XARC00
XARC01 LDX #.LO.TITLE
       LDY #.HI.TITLE
       JSR SCRPRT
       LDX #D
       JSR CLOSE
       LDX #D2
       JSR CLOSE
       LDX #K
       LDA #.LO.KDEV
       LDY #.HI.KDEV
       JSR OPNIN
;Main loop starts here
XARC10 LDA SPARTA     CHECK CMD LINE?
       BEQ XARC11
       JSR GETARG     SEE IF IT'S THERE
       BCC XARC12
XARC11 LDX #.LO.ASKI
       LDY #.HI.ASKI
       JSR SCRPRT
       JSR GETLIN
XARC12 JSR CAPLIN
       LDA LINEL
       BNE XARC13
ARCXIT LDX #D
       JSR CLOSE
       LDX #D2
       JSR CLOSE
       LDX #K
       JSR CLOSE
       LDA ERRCNT
       BEQ ISOK
       LDX #.LO.ERR002
       LDY #.HI.ERR002
       JMP XMSG
ISOK   LDX #.LO.FINIT
       LDY #.HI.FINIT
XMSG   JSR SCRPRT
       LDX STAK
       TXS         RESTORE STACK
       LDA SPARTA
       BEQ ARCX1
       RTS         RETURN FOR SPARTA
ARCX1  JMP ($0A)

XARC13 JSR FQUAL   ADD DRIVE NUMBER
       JSR FXTN    ADD EXTENSION
       LDX LINEL
XARC14 LDA LINE,X COPY INPUT NAME
       STA ARCFIL,X
       DEX
       BPL XARC14
       LDA #.LO.ARCFIL
       LDY #.HI.ARCFIL
       LDX SPARTA
       BEQ XA15
       LDX #D
       JSR OPNIN     OPEN FILENAME
       BPL XARC15
       BMI XA16
XA15   LDX #D
       JSR OPNUPD
       BPL XARC15
XA16   LDX #.LO.ERR001
       LDY #.HI.ERR001
       JSR SCRPRT
       JMP ARCXIT
XARC15 JSR EXTARC    GO DO EXTRACTS
       JMP XARC10    NEXT FILE