; Продолжение для библиотеки TEAC

; Пишем записывающие ф-ии------------------------------
; 0- Стереть файл из каталога. Вход: FName
; 1- Создать файл.             Вход: FType FLen FName
;                              Вых.: MemAdrTS True/False
; 2- Переименовать файл.       Вход: NewFType NewFName 
;                                    LastFName
;
;
;
TF6
 jsr mul2
l055
 jsr secwvectors
 jsr plus
 jsr at

 jmp exec

; Вторичные вектора для операций записи
secwvectors
 jsr Var

l056
 dw  delfile
l057
 dw  makefile
l058
 dw  renamefile
 dw  drverr
 dw  drverr
 dw  drverr
       
; Выделим место по одному сектору BITMAP
; Вход:MemAdr4TS  QBlocks BitMapNo MemAdrWhereBitMap
; Вых.:MemAdr4TS' QBlocks' AllocWas/No
allocsect  
 jsr StackVrem
 jsr Pop
 sta Vrem+¤d
 sec
 sbc #¤1
 and #¤38
 sta Vrem+¤b
 jsr Pop
 sta Vrem+¤c
 jsr StackVrem2

 lda #¤0
 sta Vrem+7        Адрес байта относительно начала BITMAP
 sta Vrem+6        Было/Нет выделение( для UPDATE )
 
 ldy Vrem+¤b

allocdm
 lda #¤14
 sta Vrem+¤b

allocdm1
 lda #¤80
 sta Vrem+5
allocnext
 lda Vrem+5
 and (Vrem),y
 bne catchts
contalloc
 lda Vrem+¤c
 beq alldone1
 dec Vrem+¤b       Положение в sectore бита
 bmi nextsect
 clc
 ror Vrem+5
 bne allocnext
 inc Vrem+7
 iny  
 bne allocdm1

nextsect
 inc Vrem+7
 inc Vrem+7
 iny
 iny
 bne allocdm
 
alldone1
 jsr Vrem2Stack
 lda Vrem+¤c
 ldy #¤0
 jsr Push
 tya 
 sta (Vrem+2),y
 lda Vrem+6
 jmp PushNext
 
catchts
 eor (Vrem),y
 sta (Vrem),y
 sty Vrem+¤4
 ldy #¤1
 lda Vrem+¤b
 sta (Vrem+2),y

 pha        
 lda Vrem+7
 lsr a
 lsr a
 sta Vrem+¤e
 pla
 ora Vrem+¤e
 beq contalloc
 lda Vrem+¤e
 ldy Vrem+¤d
 clc      
l059
 adc TSPlus,y

 ldy #¤0
 sta (Vrem+2),y
 clc
 lda #¤2
 adc Vrem+2
 sta Vrem+2
 bcc exithere1
 inc Vrem+3
exithere1
 ldy Vrem+4
 dec Vrem+¤c
 inc Vrem+6
 bne contalloc
 
TSPlus
 dfb ¤0,¤32,¤72
 
; Основной модуль освобождения BITMAP
; Вход:TSAdr BitMapNo BitMapAdr
; Вых.:TSAdr Все_освоб./нет Были_освоб./нет
freesect
 jsr StackVrem    VREM+0,1 адрес где BITMAP
 jsr Pop
 sta Vrem+7       VREM+7 номер BITMAP
 sec
 sbc #¤1
 and #¤38
 sta Vrem+6       VREM+6 смещение от начала сектора
 jsr StackVrem2   VREM+2,3 адрес где TS список

 ldy #¤0
 sty Vrem+8       VREM+8  все освободили или нет
 sty Vrem+9       -!!-+9  были изменения
 sty Vrem+¤a      -!!-+10 общий счетчик TS списка
 
nexttsadr
 lda (Vrem+2),y   Конец списка?
 beq allfree?
 cmp #¤ff         Это пустой??
 beq cant
 inc Vrem+¤a      Увеличим счетчик TS
l083
 jsr FreeIfMay    Можем освободить?
 bcs cant         Если нет, то не было изменений
 inc Vrem+9
 inc Vrem+8       Число освобожденных TS
cant 
 iny              
 iny
 bne nexttsadr
 
allfree?
 inx
 inx
 ldy #¤0
 lda Vrem+¤9
 cmp Vrem+¤a      Все освободили?
 beq fflag
 dey
fflag
 tya
 jsr Push         Если да, то ЛОЖЬ

 lda Vrem+8
 ldy #¤0

 jmp PushNext     Положим на стек изменения
   
; Процедура "Освободим TS, если можем"
FreeIfMay
 sty Vrem+5
 ldy #¤2
findcont                                 
l084
 cmp TSPlus,y
 bcs low
 dey
 bpl findcont
cmp?
 sec
exxt
 ldy Vrem+5
 rts
 
low
 cpy Vrem+7
 bne cmp?
 sec                                     
l085
 sbc TSPlus,y
 clc
 asl a
 asl a
 sta Vrem+4       Выделим адрес до 4 байт

 ldy Vrem+5
 lda #¤ff
 sta (Vrem+2),y
 iny
 lda (Vrem+2),y
 pha
 clc  
 adc #¤3
 lsr a
 lsr a
 lsr a
 tay 
l0851
 lda Offs,y
 clc
 adc Vrem+4
 adc Vrem+6
 sta Vrem+4       Получим уже адрес битика
 pla
 and #¤7
 tay                                     
l086
 lda BitMask,y    Получим маску на битик
 ldy Vrem+4
 ora (Vrem),y     Установим его
 sta (Vrem),y     И запишем обратно
 clc
 bcc exxt

BitMask dfb ¤8,¤10,¤20,¤40,¤80,¤1,¤2,¤4
Offs    dfb ¤2,¤1,¤0

; Создадим или нет в текущем секторе каталога новый файл
; Вход:FType FName AdrCatSect
; Вых.:NewFileInMem/FName True/False
makenewfile
 jsr StackVrem
 jsr StackVrem2

 ldy #¤7
 sty Vrem+5   VREM+5 число файлов в секторе
 
 ldy #¤0
 lda (Vrem+2),y
 sta Vrem+4   VREM+4 длина имени 
 lda #¤b

nxtnmtst 
 clc
 adc Vrem
 sta Vrem
 bcc ncrr
 inc Vrem+1
ncrr
 lda (Vrem),y
 beq regnmm
 cmp #¤ff
 beq regnmm
nxtnm
 lda #¤23
 dec Vrem+5
 bne nxtnmtst
 inx
 inx
 jmp FalseFlag
 
regnmm
 lda #¤0
 sta (Vrem),y
 jsr Pop
 ldy #¤2
 sta (Vrem),y

 jsr VremStack
 ldy #¤1

cfile2cat
 lda (Vrem+2),y
 iny
 iny
 sta (Vrem),y
 dey
 dec Vrem+4
 bne cfile2cat

 lda #BLANK
 iny
 iny
clrnm
 sta (Vrem),y
 iny
 cpy #¤23
 bne clrnm
 jmp TrueFlag
 
; Сохраним из SYSBUF измененный BITMAP
; Вход:QBlockLeft BitMapChange?
updatebitmap
 jsr zbran
  dw nobitmapc-*-2

 jsr temp1
 jsr at
 jsr zero
 jsr store
 jsr sysbuf     Если получилось, то
 jsr zero
 jsr four
 jsr outd       Запишем измененный BITMAP
 
nobitmapc
 jsr ddup
 jsr nzbran
  dw nobitmapch-*-2
 jsr drop
 jsr zero
 jsr lev
 
nobitmapch
 jsr lev

 rts

; Для сектора BITMAP на стеке выделим место
; вход:MemAdr4TS QBlocks BitMapNo
;
allocfromsys
 jsr sysbuf
l060
 jsr allocsect  Попробуем резервировать текущий BITMAP
l087
 jsr updatebitmap
 
; Зарезервировать место на диске 
; на входе: MemAdr4TS QBlocks
allocdskspace
 jsr lit
  dw ¤11                                 
l061
 jsr rdzerosys
 jsr zero
l062
 jsr allocfromsys  Резервируем 0 BITMAP
    
 jsr lit
  dw ¤32
l063
 jsr rdzerosys
 jsr one
l064
 jsr allocfromsys  Резервируем 1 BITMAP

 jsr lit
  dw ¤72
l065
 jsr rdzerosys
 jsr two
l066
 jsr allocfromsys  Резервируем 2 BITMAP
 
 jsr swap

 jmp drop        Возвратим число зарезервированных блоков

; Освободим по TS списку DSK память( на одном BITMAP )
; Вход:AdrWhereTSList
freesys
 jsr sysbuf            
l088
 jsr freesect
l089
 jsr updatebitmap

; Освободим полностью память
; Вход:AdrWhereTSList( не SYSBUF ) TSListSect( TS adress )
freedskspace
 jsr over
 jsr twom
 jsr store     Удаляем также и текущий сектор
 jsr twom

 jsr lit
  dw ¤11               
l090
 jsr rdzerosys
 jsr zero
l091
 jsr freesys
 jsr drop

 jsr lit
  dw ¤32
l092
 jsr rdzerosys
 jsr one                
l093
 jsr freesys
 jsr drop

 jsr lit
  dw ¤72
l094
 jsr rdzerosys
 jsr two
l095
 jsr freesys
 jsr drop

 jsr lit
  dw FATERR

 jmp error

; Создадим TS список на диске. Вход:FLen
;                              Вых.:TSAdrInMem TSInDsk
maketsstr
l067
 jsr sysbuf1
 jsr lit
  dw ¤100
 jsr erase
l068
 jsr sysbuf1
 jsr lit
  dw ¤a
 jsr plus
 jsr dup
 jsr tor
 
 jsr swap
 jsr onep

l069
 jsr allocdskspace

 jsr zbran
  dw allocok-*-2

; Нет места на диске
 jsr fromr        Восстановим адрес начала TSLIST в памяти
 jsr dup
 jsr at
l070
 jsr freedskspace Очистим занятые сектора
 jsr lit
  dw NODSKMEM

 jmp error
 
allocok 
 jsr fromr       TSAdrInMem
 jsr dup         TSAdrInMem TSAdrInMem
 jsr at          TSAdrInMem TSAdrForTSList
 jsr over
 jsr zero
 jsr swap
 jsr store       Запишем 0 в первый элемент TS списка
 jsr swap
 jsr twop

 jmp swap        На выходе: TSAdrInMem+2 AdrForTSList

; Сохраним измененный сектор катлога
updatecat
 jsr temp1
 jsr at
 jsr zero
 jsr store
 jsr sysbuf
 jsr zero
 jsr four

 jmp outd        Запишем текущий сектор каталога
 
; Создадим файл в каталоге. Вход:FType FName
;                           Вых.:FileAdrInMem
makefilecat
 jsr lit
  dw ¤11
l072
 jsr rdzerosys

myreadcat
 jsr sysbuf
 jsr onep
 jsr at
 jsr ddup
 jsr zbran
  dw nomem4file-*-2
    
l073
 jsr rdzerosys
 jsr sysbuf
l074
 jsr makenewfile
 jsr zbran
  dw myreadcat-*-2

 rts

nomem4file
 jsr lit
  dw NODSKMEM

 jmp error
       
; Создадим новый файл. Вход:FType FName FLen
;                      Вых.:TSAdr 
makefile
 jsr dup
 jsr tor   
l075
 jsr maketsstr
 jsr tor
 jsr eight
 jsr store 
l076
 jsr makefilecat
 
 jsr i
 jsr over
 jsr store       Запомним TS адрес файла

 jsr srp         Восстановим длину файла
 jsr swap
 jsr lit
  dw ¤21
 jsr plus
 jsr store       Запомним длину файла

l096     
 jsr updatecat
 
 jsr fromr
 jsr lev
 
 jsr zero
 jsr store
l071
 jsr sysbuf1     TSAdrInMem
 jsr zero
 jsr four
 jsr outd        Запишем TS список на диск
         
 jsr eight

 jmp at

; Удалим файл по имени. Вход:FName
delfile
 jsr zero
 jsr lit
  dw ¤5
 jsr outd          Найдем файл
 jsr zbran
  dw nosuchf-*-2
        
 jsr tor
 jsr i
 jsr at
 jsr i
 jsr cat
 jsr i
 jsr lit
  dw ¤22
 jsr plus
 jsr cstor
 jsr true
 jsr fromr
 jsr cstor         Стерли файл из каталога
                   
l097
 jsr updatecat
    
l098
 jsr freedskspace

 jmp drop

nosuchf
 rts

; Переименуем файл. Вход:NewFType NewFName LastFName
renamefile
 rts
 
; Установим слотовые параметры для TEAC( на стеке адрес
;                                        слотовой области)
TFA
setsltpar                
 jsr Pop
 sta WorkSlt
 sty WorkSlt+1
 ldy #¤1
 lda (WorkSlt),y
 sta SW+3
 iny
 iny
 iny
w073
 lda (WorkSlt),y
 cmp CurrDevNo
 bne w074
 iny
 iny
 iny
 sty SW+2
 
 rts
 
w074
 iny
 lda (WorkSlt),y
 tay   
 bne w073 

 lda #FATERR
 ldy #¤0
 jsr Push
 
 jmp error

; Опишем связующую процедуру
teac
 jsr  Does
 
 dw   makechoice
; PFA+ 2
    
l019
 dw   TF0
l020
 dw   TF1
l021
 dw   TF2
l022
 dw   TF3
l038
 dw   TF4      Функция записи блока есть
l023
 dw   TF5      Операции чтения файла( чтение, фиктивное..)
l079
 dw   TF6   
;              ( запись, удаление, переименование и т.д. )
 dw   drverr   Чтение байта недоступно                    
 dw   drverr   Запись байта недоступна
 dw   drverr   Инициализации пока нет( форматирование )
l024
 dw   TFA      Установка параметров

; Моя обработка ошибок
myerr
 jsr  currdevno
 jsr  at
 jsr  zbran
  dw  notneedoff-*-2
 jsr  two
 jsr  outd
notneedoff
l030
 jsr  nexterr
 jsr  at

 jmp  exec
          
nexterr   
 jsr  Var

 dw   0

; Считаем файл по адресу в стеке-------------------------
; На стеке   AdrFileName MemAdr -
Readfile
 dfb ¤88
 asc "readfilE"
 dw  0

readfile
 jsr one
 jsr outd  
 jsr swap    на стеке MemAdr AdrFileName

; Найдем файл на диске на выходе адрес TS на диске
 jsr zero
 jsr lit
  dw ¤5
 jsr outd
 jsr zequ
 jsr lit
  dw NOFILE   Ошибка будет, если нет файла 
 jsr qerr
 jsr drop     Сотрем смещение

; Считаем по TS сам файл
 jsr three
 jsr outd

 jsr two

 jmp outd  Выключим устройство
 
; Запишем файл
; на входе: FromMemAdr FType FName FLen
Writefile
 dfb ¤89
 asc "writefilE"
 dw  0

writefile
 jsr one
 jsr outd

 jsr over
 jsr zero
 jsr lit
  dw ¤6
 jsr outd      Сотрем файл
 
 jsr one
 jsr lit
  dw ¤6
 jsr outd      Создадим файл

 jsr four
 jsr outd      Запишем файл
 
 jsr two

 jmp outd

; 1 системный буфер
Sysbuf1
 dfb ¤87
 asc "sysbuf1"
 dw  Teaclib
sysbuf1
 jsr Cons
 
 dw  SysBuf+¤100

; Чтение файла по имени за этим словом
Loadq
 dfb ¤c5
 asc ¤load"¤
 dw  0

loadq
 jsr lit
  dw KAVICHKI

 jsr state
 jsr at
 jsr zbran
  dw justload-*-2

 jsr comp 
l080
  dw loadf
 jsr word
 jsr here 
 jsr cat
 jsr onep

 jmp allot
    
justload
 jsr word
 jsr here
 jsr bran
  dw loadit-*-2
    
; Чтение файла по имени 
loadf
 jsr fromr
 jsr dup
 jsr dup
 jsr cat
 jsr onep
 jsr plus
 jsr tor

loadit                 
 jsr three
l0981
 jsr setid
 jsr one
l0982
 jsr alloc
 jsr zequ
 jsr lit
  dw ERRMEM
 jsr qerr
 jsr one
l0983
 jsr setmem

l081
 jsr bank5
l082
 jsr readfile
l0821
 jsr bank5
 jsr execfile
     
l0984
 jmp free

; Банковая память
Bank5
 dfb ¤85
 asc "bank5"
 dw  Loadq
bank5
 jsr Cons
 
 dw  ¤a000

 chn sys1.lib