PAGE
         SBTL  'DISK - VGP][   (C) DIGISOLVE LTD 1984'
                          ; PROGRAMMED BY ALAN COAKER 
                          ; DATE 4/APRIL/84
                          ;
         ORG   $4000
                          ; 
BELL     EQU   $87        ; BELL CHARACTER
                          ; 
                          ; ZPAGE DEFINITIONS
                          ; 
PTR      EQU   $0         ; WORK POINTER
BUFP     EQU   $2         ; BUFFER POINTER
EBYTE    EQU   $4
A1L      EQU   $3C        ; MONITOR POINTER
A2L      EQU   $3E        ; MONITOR POINTER
                          ; 
JUMP2    EQU   $9E        ; POINTER INTO PROGRAM DATA 
JUMP3    EQU   JUMP2+1    
                          ;
XMASK    EQU   $55        ; BIT MASK FOR COLOUR TEST
DOTS     EQU   $56        ; TEMP STORE TO COUNT SAME COLOUR DOTS 
TXPAGE   EQU   $57        ; VGP][ PAGE FOR DISK 
                          ;
VBASE    EQU   $A0        ; BASE POINTER TO VGP
VBASE1   EQU   $A2        ; BASE FOR VGP COLOUR
BCOUNT   EQU   $A8        ; BUFFER POINTER
BPTR     EQU   $AA        ; SUM OF BCOUNT + JUMP2
SAVCOL   EQU   $FA        ; COLOUR SAVE
DCOUNT   EQU   $FB        ; LENGTH SAVE
                          ;
                          ; OTHER ADDRESSES
                          ; 
DOSWRM   EQU   $3D0       DOS WARMSTART ADDRESS
DOSERR   EQU   $A702      PRINT DOS ERROR
ERRRTS   EQU   $A6EF      RETURN TO BASIC VIA DOS 
LOCRPL   EQU   $3E3       LOCATE RWTS PARMLIST SUBRTN
LOCFPL   EQU   $3DC       LOCATE FILE MGR PARMLIST SUB 
FM       EQU   $3D6       FILE MANAGER ENTRY POINT
                          ; 
                          ; FILE MANAGER PARMLIST DEFINITION 
                          ; 
         DSECT
FMOCOD   DS    1          OPERATION CODE
FMOCOP   EQU   $01         OPEN
FMOCCL   EQU   $02         CLOSE
FMOCRD   EQU   $03         READ
FMOCWR   EQU   $04         WRITE
FMOCDE   EQU   $05         DELETE
FMOCCA   EQU   $06         CATALOG
FMOCLO   EQU   $07         LOCK
FMOCUN   EQU   $08         UNLOCK
FMOCRE   EQU   $09         RENAME
FMOCPO   EQU   $0A         POSITION
FMOCIN   EQU   $0B         INIT
FMOCVE   EQU   $0C         VERIFY
FMSBCD   DS    1          SUBCODE
FMSBNO   EQU   $00         NO OPERATION
FMSBON   EQU   $01         READ/WRITE ONE BYTE
FMSBRA   EQU   $02         READ/WRITE RANGE OF BYTES
FMSBPO   EQU   $03         POSITION AND DO ONE BYTE
FMSBPR   EQU   $04         POSTION AND DO RANGE
FMPRMS   DS    8          SPECIFIC PARAMETERS
                          ; 
                          ; OPEN PARMS
         ORG   FMPRMS
FMRCLN   DS    2          RECORD LENGTH
FMVOL    DS    1          VOLUME
FMDRV    DS    1          DRIVE
FMSLT    DS    1          SLOT
FMTYPE   DS    1          TYPE
FMTYPT   EQU   0           TEXT
FMTYPI   EQU   1           INTEGER
FMTYPA   EQU   2           APPLESOFT
FMTYPB   EQU   4           BINARY
FMNAME   DS    2          ADDRESS OF FILENAME
                          ; 
                          ; READ/WRITE PARMS
         ORG   FMPRMS
FMRCNM   DS    2          RECORD NUMBER
FMOFFS   DS    2          BYTE OFFSET
FMRALN   DS    2          RANGE LENGTH
FMRAAD   DS    2          RANGE ADDRESS
FMDATA   EQU   FMRAAD     DATA BYTE READ/WRITTEN
                          ; 
                          ; RENAME PARMS
         ORG   FMPRMS
FMNNAM   DS    2          ADDRESS OF NEW NAME
                          ; 
                          ; INIT PARMS
         ORG   FMPRMS
FMPAGE   EQU   FMSBCD     FIRST PAGE OF DOS IMAGE
                          ; 
                          ; COMMON PARMS
         ORG   FMPRMS+8
FMRC     DS    1          RETURN CODE
FMRCOK   EQU   0           NO ERRORS
FMRCBO   EQU   2           BAD SUBCODE
FMRCBS   EQU   3           BAD SUBCODE
FMRCWP   EQU   4           WRITE PROTECTED
FMRCED   EQU   5           END OF DATA
FMRCNF   EQU   6           FILE NOT FOUND 
FMRCBV   EQU   7           BAD VOLUME
FMRCIO   EQU   8           I/O ERROR 
FMRCDF   EQU   9          DISK FULL
FMRCLK   EQU   10          FILE LOCKED
         DS    1          NOT USED
FMFMWA   DS    2          FILE MANAGER WORKAREA POINTER
FMTSL    DS    2          T/S LIST PTR
FMBUFF   DS    2          DATA BUFFER POINTER
         DEND
                          ; 
                          ; OFFSETS FOR VGP 
                          ; 
BASE     EQU   0          ; VGP REGISTER BASE ADDRESS
BASE1    EQU   0          ; REGISTERS EXTERNAL TO VGP
STATUS   EQU   BASE       ; STATUS: READ ONLY
CMD      EQU   BASE       ; CMD: WRITE ONLY
XMSB     EQU   BASE+8     ; X MSB
XLSB     EQU   BASE+9     ; Y LSB POSITION
YMSB     EQU   BASE+10    ; Y MSB
YLSB     EQU   BASE+11    ; Y LSB POSITION
CTRL4    EQU   BASE1      ; VGP CTRL4 REGISTER
                          ; 
                          ; START
                          ;
START:   LDA   #>VSLOT    ; 1ST BYTE DATA LSB
         STA   JUMP2
         LDA   #<VSLOT    ; 1ST BYTE DATA MSB 
         STA   JUMP3
         JMP   DISKOP     ; SKIP OVER TEMP STORAGE
                          ;
VSLOT:   DFB   4          ; VGP SLOT NO.
FORMAT:  DFB   1          ; 0:USA 1:UK
INTERL:  DFB   1          ; 0:NON 1:INTERLACED
COLOUR:  DFB   1          ; 0:MONO 1:COLOUR
RDWR:    DFB   0          ; 0:WRITE TO FILE 1:READ
DRIVE:   DFB   1          ; DISK DRIVE
FNAME:   ASC   'VGPIMAGE                      '
BUFFER:  DS    512        ; BYTE BUFFER FROM DISK 
                          ;
VSLOTO   EQU   0          ; OFFSETS FROM JUMP2 
FORMO    EQU   1          
INTRO    EQU   2          
COLRO    EQU   3          
RDWRO    EQU   4          
DRIVEO   EQU   5          
FNAMEO   EQU   6          
BUFFRO   EQU   36         
                          ; 
DISKOP:  JSR   LOCFPL     FIND PARMLIST
         STY   PTR        SET UP POINTER TO IT
         STA   PTR+1
                          ; 
                          ; OPEN FILE
                          ; 
         LDY   #FMNAME    STORE FILE NAME
         LDA   #FNAMEO    PTR IN LIST
         CLC
         ADC   JUMP2
         STA   (PTR),Y
         INY
         LDA   JUMP3      
         ADC   #0
         STA   (PTR),Y
         LDY   #FMTYPE    STORE FILE TYPE
         LDA   #FMTYPB    BINARY FILE TYPE (FOR NOW)
         STA   (PTR),Y
                          ;
                          ; OPEN: COMPLETE PARMLIST AND OPEN FILE
                          ; 
OPEN     LDA   DOSWRM+2   FIND DOS ENTRY
         STA   BUFP+1
         LDY   #0
         STY   BUFP       POINT AT BUFFER CHAIN
                          ; 
                          ; SCAN DOS BUFFERS FOR A FREE ONE
                          ; 
GBUF0    LDA   (BUFP),Y   LOCATE NEXT DOS BUFFER
         TAX   
         INY
         LDA   (BUFP),Y
         STA   BUFP+1
         STX   BUFP
         ORA   BUFP       
         BNE   GBUF       BUFFER FOUND 
         LDX   #12        ; NO BUFFER RETURN CODE
         JSR   DOSERR     ; DISPLAY ERROR
         JMP   ERRRTS     ; RETURN TO BASIC
                          ; 
GBUF     LDY   #0         LOOK AT FILENAME
         LDA   (BUFP),Y
         BEQ   GOTBUF     NONE THERE, FREE BUFFER
         LDY   #36        IT'S NOT FREE
         BNE   GBUF0      GO GET NEXT ONE
                          ; 
GOTBUF   LDA   #1
         STA   (BUFP),Y   MARK BUFFER IN USE
                          ; 
                          ; FINISH COMPLETING OPEN LIST
                          ; 
         LDY   #FMOCOD
         LDA   #FMOCOP
         STA   (PTR),Y    SET OPCODE TO OPEN
         LDA   #0
         LDY   #FMRCLN
         STA   (PTR),Y    SET RECORD LENGTH TO 0
         INY
         STA   (PTR),Y
         LDY   #FMVOL
         STA   (PTR),Y    AND VOLUME (ANY VOL)
         JSR   LOCRPL     FIND RWTS PARMS
         STY   A1L
         STA   A1L+1
         LDY   #1
         LDA   (A1L),Y    GET SLOT*16
         LSR   A
         LSR   A
         LSR   A
         LSR   A          SLOT=SLOT/16
         LDY   #FMSLT
         STA   (PTR),Y    STORE IN LIST
         LDY   #DRIVEO    ; GET DRIVE NO
         LDA   (JUMP2),Y
         BNE   FDRIVE     ; IF NZ THEN FIXED
         LDY   #2         ; ELSE GET OLD DRIVE NO 
         LDA   (A1L),Y    GET DRIVE
FDRIVE:  LDY   #FMDRV
         STA   (PTR),Y    AND SLOT
         LDY   #RDWRO
         LDA   (JUMP2),Y
         TAX              ; REG X HOLDS READ OR WRITE
                          ; 
         LDY   #30
         LDA   (BUFP),Y   GET THREE BUFFER PTRS
         LDY   #FMFMWA    
         STA   (PTR),Y    COPY THEM TO FM LIST
         LDY   #31        
         LDA   (BUFP),Y   
         LDY   #FMFMWA+1
         STA   (PTR),Y    
         LDY   #32        
         LDA   (BUFP),Y   
         LDY   #FMFMWA+2  
         STA   (PTR),Y    
         LDY   #33        
         LDA   (BUFP),Y   
         LDY   #FMFMWA+3  
         STA   (PTR),Y    
         LDY   #34        
         LDA   (BUFP),Y   
         LDY   #FMFMWA+4  
         STA   (PTR),Y    
         LDY   #35        
         LDA   (BUFP),Y   
         LDY   #FMFMWA+5  
         STA   (PTR),Y    
         JSR   FM         CALL FILE MANAGER
         BCC   REWIND     OPENED OK
         LDY   #RDWRO     
         LDA   (JUMP2),Y
         BNE   ERROR1     ; IF WRITE AND FILE ERROR
         LDY   #FMRC
         LDA   (PTR),Y
         CMP   #FMRCNF    FILE NOT FOUND?
         BEQ   REWIND     ; IF FILE JUST ALLOCATED 
                          ;
ERROR1:  LDY   #0         ; FILL ERROR
         TYA
         STA   (BUFP),Y   ; RELEASE DOS BUFFER
         LDY   #FMRC      ; GET RETURN CODE
         LDA   (PTR),Y
         TAX              ; PUT IN X FOR DOSERR
         JSR   DOSERR     ; DISPLAY ERROR
         JMP   ERRRTS     ; RETURN TO BASIC
                          ; 
                          ; REWIND: POSITION TO START OF FILE
REWIND   LDY   #FMRCNM
         LDA   #0
REWLP    STA   (PTR),Y    ZERO RECORD NUMBER AND..
         INY
         CPY   #FMOFFS+2  BYTE OFFSET
         BCC   REWLP
         LDY   #FMOCOD
         LDA   #FMOCPO
         STA   (PTR),Y
         LDX   #1         ; SET X FOR FM
                          ; 
         LDY   #30
         LDA   (BUFP),Y   GET THREE BUFFER PTRS
         LDY   #FMFMWA    
         STA   (PTR),Y    COPY THEM TO FM LIST
         LDY   #31        
         LDA   (BUFP),Y   
         LDY   #FMFMWA+1
         STA   (PTR),Y    
         LDY   #32        
         LDA   (BUFP),Y   
         LDY   #FMFMWA+2  
         STA   (PTR),Y    
         LDY   #33        
         LDA   (BUFP),Y   
         LDY   #FMFMWA+3  
         STA   (PTR),Y    
         LDY   #34        
         LDA   (BUFP),Y   
         LDY   #FMFMWA+4  
         STA   (PTR),Y    
         LDY   #35        
         LDA   (BUFP),Y   
         LDY   #FMFMWA+5  
         STA   (PTR),Y    
         JSR   FM         CALL FILE MANAGER
         BCS   ERROR1     CHECK FOR ERRORS
                          ;
         LDY   #VSLOTO    ; SET UP VGP BASE POINTER
         LDA   (JUMP2),Y  ; GET SLOT NO.
         AND   #7
         ORA   #$C0
         STA   VBASE1+1
         ASL   A
         ASL   A
         ASL   A
         ASL   A          ; MULTIPLY SLOT * 16
         ADC   #$80       ; ADD #$80 FOR VGP BASE
         STA   VBASE
         LDA   #$C0
         STA   VBASE+1    ; VBASE MSB
         LDA   #0
         STA   VBASE1     ; VBASE1 LSB
                          ;
                          ; SAVE VGP POSITION ON THE STACK
                          ; AND SET TXPAGE TO MSB OF X
                          ;
         LDY   #0
DREADY:  LDA   (VBASE),Y  ; WAIT UNTIL VGP READY
         AND   #4
         BEQ   DREADY
         LDY   #11        ; SAVE POSITION
         LDX   #3
SAVLOP:  LDA   (VBASE),Y
         PHA
         DEY
         DEX
         BPL   SAVLOP
         AND   #2         ; SAVE PAGE NUMBER
         STA   TXPAGE     ; (MSB OF X POSITION)
                          ;
                          ; SET VGP Y POSITION ACCORDING TO
                          ; INTERLACED AND FORMAT PARAMETERS
                          ; UK INT - 512
                          ; UK NON - 256
                          ; US INT - 416
                          ; US NON - 208
                          ;
         LDY   #FORMO     ; GET FORMAT
         LDA   (JUMP2),Y
         TAX
         LDY   #INTRO     ; GET INTERLACED
         LDA   (JUMP2),Y
         BEQ   NONINT
         LDA   #2
         DEX
         BEQ   STOREY     
         LDX   #160
UKNON:   LDA   #1
         BNE   STOREY
NONINT:  DEX
         BEQ   UKNON
         LDX   #208
STOREY:  LDY   #10
         STA   (VBASE),Y
         INY
         TXA
         STA   (VBASE),Y
                          ;
         LDY   #RDWRO
         LDA   #0
         SEC
         SBC   (JUMP2),Y  ; GET READ/WRITE
         STA   DCOUNT     ; 0:WR FF:RD 
         STA   DOTS
         STA   BCOUNT
         STA   BCOUNT+1
                          ;
MAINLP:  LDY   #YLSB
         LDA   (VBASE),Y  ; DEC Y POSITION
         SEC
         SBC   #1
         STA   (VBASE),Y
         DEY
         LDA   (VBASE),Y
         SBC   #0
         STA   (VBASE),Y
         BCC   FILEN1     ; IF END OF SCREEN
         DEY
         LDA   #0         ; SET X POSITION TO TXPAGE
         STA   (VBASE),Y
         DEY
         LDA   TXPAGE
         STA   (VBASE),Y
         LDA   #1         ; INIT XMASK FOR LS DOT
         STA   XMASK
                          ;
FLOOP:   LDY   #XMSB
         LDA   (VBASE),Y  ; OFF RHS OF SCREEN ?
         EOR   TXPAGE
         AND   #2
         BNE   MAINLP     ; IF SO , GOTO NEXT LINE
                          ;
         LDA   BCOUNT+1   ; BUFFER FULL/EMPTY
         CMP   #2
         BCS   FILER1     ; IF SO , PUT/GET DATA
                          ;
         LDY   #RDWRO     ; READ OR WRITE
         LDA   (JUMP2),Y
         BEQ   WRIT10
                          ;
READ10:  LDA   JUMP2      ; GET BYTE FROM BUFFER
         CLC
         ADC   BCOUNT
         STA   BPTR
         LDA   JUMP3
         ADC   BCOUNT+1
         STA   BPTR+1
         LDY   #BUFFRO
         LDA   (BPTR),Y
         INC   BCOUNT
         BNE   READ11
         INC   BCOUNT+1
READ11:  LDX   DOTS       ; GET OLD BYTE
         STA   DOTS       ; SAVE NEW ONE
         CPX   #$40       ; VALID OLD ONE ?
         BCC   RDPAIR     ; YES IF < $40
         CMP   #$40       ; IS NEW BYTE SINGLE ?
         BCC   FLOOP      ; IF NOT GET NEXT ONE
         TAX              ; SAVE COLOUR
         ROL   A
         ROL   A
         ROL   A          ; SHIFT 2 MS TO 2 LS
         AND   #3         ; MASK FOR 2 LS (LENGTH)
RDPAIR:  SEC              ; A IS LENGTH
         SBC   #1
         LDY   #5         ; STORE LENGTH - 1 IN DELTAX
         STA   (VBASE),Y
         SEC
         ROR   DOTS       ; OLD BYTE NOW INVALID
         TXA              ; COLOUR IN ACC
         ROL   A
         AND   #2
         ORA   #8         ; FOR BLACK BORDER
         LDY   #1
         STA   (VBASE1),Y ; SET RED PLANE
         LDY   #COLRO     ; COLOUR VGP][
         LDA   (JUMP2),Y
         BEQ   READ14     ; IF NOT
         TXA              ; YES , SET GREEN/BLUE
         ASL   A
         ASL   A
         ASL   A
         AND   #$20
         STA   DCOUNT     ; TEMP SAVE BLUE
         TXA
         AND   #2         ; GET GREEN
         ORA   DCOUNT     ; ADD BLUE
         ORA   #$88       ; BLACK BORDER
         LDY   #$12
         STA   (VBASE),Y
         BNE   READ14     ; SKIP JUMPS
                          ;
FILEN1:  BCC   FILEN2
FILER1:  BCS   FILER2
FLOOP3:  BNE   FLOOP
                          ;
READ14:  LDY   #CMD
         LDA   #$10       ; PLOT ALONG X AXIS
         STA   (VBASE),Y
RDWAIT:  LDA   (VBASE),Y
         AND   #4
         BEQ   RDWAIT     ; WAIT UNTIL DONE
         LDY   #XLSB      ; INCREMENT X POSITION
         LDA   (VBASE),Y
         CLC
         ADC   #1
         STA   (VBASE),Y
         DEY
         LDA   (VBASE),Y
         ADC   #0
         STA   (VBASE),Y
         ORA   #1         ; SET NE FOR BRANCH
                          ;
         BNE   FLOOP3     
                          ;
WRIT10:  LDA   DCOUNT     ; BYTE LEFT OVER ?
         BNE   WRIT30     ; YES , STORE IT
WRIT11:  LDY   #STATUS    ; GET NEW COLOUR
         LDA   #15
         STA   (VBASE),Y
WRWAIT:  LDA   (VBASE),Y  ; WAIT UNTIL DONE
         AND   #4
         BEQ   WRWAIT
         TAY
         LDA   (VBASE1),Y ; GET RED PLANE
         AND   XMASK
         BEQ   WRIT12
         LDA   #1
WRIT12:  TAX              ; REG X HOLDS COLOUR
         LDY   #COLRO     ; COLOUR VGP][ ?
         LDA   (JUMP2),Y
         BEQ   WRIT13
         LDY   #$11       ; IF SO GET GREEN PLANE
         LDA   (VBASE),Y
         AND   XMASK
         BEQ   WRIT14
         TXA
         ORA   #2
         TAX
WRIT14:  DEY
         LDA   (VBASE),Y  ; GET BLUE PLANE
         AND   XMASK
         BEQ   WRIT13
         TXA
         ORA   #4
         TAX
WRIT13:  LDA   DOTS       ; OK GET COLOUR
         BEQ   WRIT15     ; 1ST DOT THIS COLOUR ?
         CPX   SAVCOL     ; IF NOT, SAME AS PREVIOUS
         BEQ   WRIT16     ; IF YES
WRIT19:  LDA   DOTS
         CMP   #4         ; SINGLE BYTE (UP TO 3)
         BCS   WRIT17     ; NO , STORE TWO BYTES
         ROR   A
         ROR   A
         ROR   A          ; SHIFT TO 2 MS BITS
         AND   #$C0
         ORA   SAVCOL     ; COLOUR IN LS 6
         BNE   WRTBYT     ; BRANCH ALWAYS
                          ;
FILEN2:  BCC   FILEND
FILER2:  BCS   FILER
FLOOP2:  BNE   FLOOP3
WRIT30:  BNE   WRIT20
                          ;
WRIT15:  STX   SAVCOL     ; 1ST DOT OF NEW COLOUR
                          ;
WRIT16:  INC   DOTS       ; SAME COLOUR , INC COUNT
         BEQ   WRIT17     ; IF 256 DOTS THE SAME 
                          ;
         ASL   XMASK      ; ELSE SHIFT X MASK FOR NEXT DOT
         BCC   WRIT21
         ROL   XMASK
WRIT21:  LDY   #XLSB      ; AND INC X POSITION
         CLC
         LDA   (VBASE),Y
         ADC   #1
         STA   (VBASE),Y
         DEY
         LDA   (VBASE),Y
         ADC   #0
         STA   (VBASE),Y
         EOR   TXPAGE     ; OFF RHS OF SCREEN ?
         AND   #2         
         BEQ   WRIT11     ; LOOP IF NOT
         BNE   WRIT19
                          ;
WRIT17:  STA   DCOUNT     ; STORE 2ND BYTE
         LDA   SAVCOL     ; SEND COLOUR FIRST
         BPL   WRTBYT
                          ;
WRIT20:  LDX   #0         ; 1ST BYTE STORED 
         STX   DCOUNT     ; MUST CLEAR DCOUNT
WRTBYT:  TAX
         LDA   JUMP2      ; CALCULATE BUFFER ADDRESS
         CLC
         ADC   BCOUNT
         STA   BPTR
         LDA   JUMP3
         ADC   BCOUNT+1
         STA   BPTR+1
         LDY   #BUFFRO    ; STORE BYTE IN BUFFER
         TXA
         STA   (BPTR),Y
         LDA   #0
         STA   DOTS       ; CLEAR COUNTER
         INC   BCOUNT
         BNE   FLOOP2     
         INC   BCOUNT+1   ; INC BUFFER POINTER
                          ;
FLOOP1:  BNE   FLOOP2
                          ;
FILEND:  LDY   #RDWRO     ; READ OR WRITE ?
         LDA   (JUMP2),Y
         BNE   RESCRD
         LDA   BCOUNT     ; IF WRITE IS THERE
         ORA   BCOUNT+1   ; DATA IN THE BUFFER ?
         BEQ   RESCRD     ; IF SO , STORE IT
                          ;
                          ; FILER READS AND WRITES 512 BYTE BLOCK TO DISK
                          ;
FILER:   LDY   #RDWRO
         LDA   (JUMP2),Y
         SEC
         SBC   #1
         LDY   #FMRALN    ; SET BUFFER LENGTH
         STA   (PTR),Y    
         INY
         CLC
         ADC   #2
         STA   (PTR),Y    ; TO 512 BYTES
                          ;
         INY
         LDA   JUMP2      ; SET BUFFER ADDRESS
         CLC
         ADC   #BUFFRO
         STA   (PTR),Y
         INY
         LDA   JUMP3
         ADC   #0
         STA   (PTR),Y
                          ;
         LDY   #RDWRO     ; SET OPERATION CODE
         SEC
         LDA   #FMOCWR
         SBC   (JUMP2),Y
         LDY   #FMOCOD
         STA   (PTR),Y
                          ;
         LDY   #FMSBCD    ; SET RANGE OF BYTES
         LDA   #FMSBRA
                          ; 
         LDY   #30
         LDA   (BUFP),Y   GET THREE BUFFER PTRS
         LDY   #FMFMWA    
         STA   (PTR),Y    COPY THEM TO FM LIST
         LDY   #31        
         LDA   (BUFP),Y   
         LDY   #FMFMWA+1
         STA   (PTR),Y    
         LDY   #32        
         LDA   (BUFP),Y   
         LDY   #FMFMWA+2  
         STA   (PTR),Y    
         LDY   #33        
         LDA   (BUFP),Y   
         LDY   #FMFMWA+3  
         STA   (PTR),Y    
         LDY   #34        
         LDA   (BUFP),Y   
         LDY   #FMFMWA+4  
         STA   (PTR),Y    
         LDY   #35        
         LDA   (BUFP),Y   
         LDY   #FMFMWA+5  
         STA   (PTR),Y    
         JSR   FM         CALL FILE MANAGER
         BCS   ERROR2
                          ;
         LDA   #0         ; RESET BUFFER POINTER
         STA   BCOUNT
         STA   BCOUNT+1
                          ;
         LDY   #YMSB
         LDA   (VBASE),Y  ; END OF OPERATION ?
         CMP   #15
         BNE   FLOOP1
                          ;
RESCRD:  LDX   #3
         LDY   #XMSB
RESPOS:  PLA
         STA   (VBASE),Y  ; RESTORE VGP POSITION
         INY
         DEX
         BPL   RESPOS
                          ;
CLOSE:   LDY   #FMOCOD    ; CLOSE FILE
         LDA   #FMOCCL
         STA   (PTR),Y
                          ; 
         LDY   #30
         LDA   (BUFP),Y   GET THREE BUFFER PTRS
         LDY   #FMFMWA    
         STA   (PTR),Y    COPY THEM TO FM LIST
         LDY   #31        
         LDA   (BUFP),Y   
         LDY   #FMFMWA+1
         STA   (PTR),Y    
         LDY   #32        
         LDA   (BUFP),Y   
         LDY   #FMFMWA+2  
         STA   (PTR),Y    
         LDY   #33        
         LDA   (BUFP),Y   
         LDY   #FMFMWA+3  
         STA   (PTR),Y    
         LDY   #34        
         LDA   (BUFP),Y   
         LDY   #FMFMWA+4  
         STA   (PTR),Y    
         LDY   #35        
         LDA   (BUFP),Y   
         LDY   #FMFMWA+5  
         STA   (PTR),Y    
         JSR   FM         CALL FILE MANAGER
                          ;
ERROR2:  LDY   #0
         TYA
         STA   (BUFP),Y   ; FREE DOS BUFFER
         BCC   FINISH     ; RETURN NORMALLY IF NO ERROR
         LDY   #FMRC      ; GET RETURN CODE
         LDA   (PTR),Y
         TAX
         JSR   DOSERR     ; DISPLAY IT
         JMP   ERRRTS     ; RETURN THRO ERROR HANDLER
                          ;
FINISH:  RTS