seppdroid/Digital-Research-Source-Code
1
0
Fork 0
mirror of https://github.com/SEPPDROID/Digital-Research-Source-Code.git synced 2025-10-25 17:34:06 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity
Files
31738079c43b1cd3eae2815a0dfb36f71505257a
Digital-Research-Source-Code/MPM OPERATING SYSTEMS/MPM II/MPM II SOURCE/BNKBDOS/BNKBDOS.ASM
Sepp J Morris 31738079c4 Upload 
Digital Research
2020-11-06 18:50:37 +01:00

4763 lines
110 KiB
NASM
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

title 'Non-Resident Portion of Banked BDOS'
cseg
;***************************************************************
;***************************************************************
;** **
;** B a s i c D i s k O p e r a t i n g S y s t e m **
;** **
;** N o n - R e s i d e n t P o r t i o n **
;** B a n k e d B D O S **
;** **
;***************************************************************
;***************************************************************
;/*
; Copyright (C) 1978,1979,1980,1981,1982
; Digital Research
; P.O. Box 579
; Pacific Grove, CA 93950
;
; Version 2.1 Patch Release
; 12 Apr 82 by David K. Brown
;*/
on equ 0ffffh
off equ 00000h
MPM EQU ON
MPMENV EQU ON
BNKBDOS EQU ON
ctlc equ 03h ;control-c
cr equ 0dh ;carriage return
lf equ 0ah ;line feed
;
; BDOS call equates
dskinit equ 13
dskslct equ 14
dsksetDMA equ 26
setusercode equ 32
;
; Process Descriptor Offsets
pname equ 6
console equ 14
memseg equ 15
thread equ 18
disksetDMA equ 20
diskselect equ 22
diskparams equ 23
MULT$CNT$OFF EQU 50
PD$CNT$OFF EQU 51
;
; System Data Page Offsets
userstackflag equ 3
brkvctr equ 48
usrstkregion equ 80
;
;
; MP/M Data Page Offsets
rlros equ 5
thrdrt equ 17
msegtbl equ 150
;
;**************************************************
;* *
;**************************************************
;
org 0000h
base equ $
jmp bnkbdose
JMP BNKBDOSINIT
JMP REMOVE$FILES
XDMAAD: DW $-$
SYSDAT: DW $-$
BUFFA: DW $-$
bnkbdosinit:
pop h! push h! inx h! inx h! inx h
lxi d,extjmptbl! mvi c,24! xchg
CALL MOVE
;INITIALIZE OPEN FILE AND LOCKED RECORD LIST
LHLD SYSDAT! MVI L,187
MOV A,M! STA LOCK$MAX! INX H
MOV A,M! STA OPEN$MAX
INX H! MOV E,M! INX H! MOV D,M! INX H
PUSH D
MOV E,M! INX H! MOV D,M! XCHG! SHLD FREE$ROOT
POP D! DCX D! LXI B,10
ILIST:
PUSH D
MOV D,H! MOV E,L! DAD B! XCHG
MOV M,E! INX H! MOV M,D! XCHG
POP D! DCX D! MOV A,D! ORA E! JNZ ILIST
MOV M,A! DCX H! MOV M,A! RET
extjmptbl:
reboot: jmp $-$
rlr: jmp $-$
rlradr: jmp $-$
dsplynm: jmp $-$
xprint: jmp $-$
xcrlf: jmp $-$
conoutx: jmp $-$
getmemseg: jmp $-$
;
;************************************************
;* *
;************************************************
;
bnkbdose:
push d! push b
LXI H,DELETED$FILES
DI
MOV A,M! ORA A! MVI M,0
EI
CNZ DELETE$FILES
;perform the necessary BDOS parameter initialization
;disk set DMA
call rlr! SHLD PDADDR
lxi b,disksetDMA! dad b
mov e,m! inx h! mov d,m! push h! xchg! shld dmaad
mov b,h! mov c,l! call setdmaf
;disk select
pop h! inx h
mov a,m! rrc! rrc! rrc! rrc! ani 0fh! STA SELDSK
;set user code
mov a,m! ani 0fh! STA USRCODE
;copy local disk params
inx h! push h! lxi d,dcnt
XCHG! MVI C,2! CALL MOVE
LXI H,SEARCHL! LDAX D! MOV M,A
LXI H,MULT$CNT$OFF-DISKPARAMS-2! DAD D
MOV A,M! STA MULT$CNT
INX H! MOV A,M! ANI 0F0H! CMP M! JZ BNKBDOS1
ADI 10H! MOV M,A
BNKBDOS1:
STA PDCNT
;perform requested BDOS function
pop h! pop b! pop d! push h
call bdose
;save results
pop d! push h ; save results in HL
;copy disk params
lxi h,dcnt
XCHG! MVI C,2! CALL MOVE
LXI D,SEARCHL! LDAX D! MOV M,A
;return to non-banked bdos, will restore calling bank
; and release disk mutual exclusion message
pop h! ret
bdose:
xchg! shld info! xchg ;save parameter
mov a,e! sta linfo ;linfo = low(info) - don't equ
lxi h,0! shld aret ;return value defaults to 0000
SHLD RESEL ; RESEL,FCBDSK = 0
SHLD COMP$FCB$CKS ; COMP$FCB$CKS,SEARCH$USER0 = 0
SHLD MAKE$XFCB ; MAKE$XFCB,FIND$XFCB = 0
DAD SP! SHLD ENTSP ; SAVE STACK POSITION
lxi h,goback! push h ;fake return address
;compute disk function code address
mov a,c! STA FX! mov c,e! mov b,d
CPI NFUNCS+12! JNC HIGH$FXS
LXI H,DISKF-24! JMP BDOS$JMP
HIGH$FXS:
LXI H,XDISKF-200
BDOS$JMP:
mov e,a! mvi d,0 ;DE=func, HL=.diskf-24
dad d! dad d! mov e,m! inx h! mov d,m ;DE=functab(func)
LHLD INFO ;INFO IN DE FOR LATER EXCHANGE
xchg! pchl ;dispatched
;
; dispatch table for disk functions
diskf:
dw func12,func13,func14,func15
dw func16,func17,func18,func19
dw func20,func21,func22,func23
dw func24,func25,func26,func27
dw func28,func29,func30,func31
dw func32,func33,func34,func35
dw func36,func37,func38,func39
DW FUNC40,FUNC41,FUNC42,FUNC43
DW FUNC44,FUNC45,FUNC46,FUNC47
DW FUNC48,FUNC49,FUNC50
nfuncs equ ($-diskf)/2
XDISKF:
DW FUNC100,FUNC101,FUNC102,FUNC103
DW FUNC104,FUNC105,FUNC106,FUNC107
PERERR: DW PERSUB ;PERMANENT ERROR SUBROUTINE
RODERR: DW RODSUB ;RO DISK ERROR SUBROUTINE
ROFERR: DW ROFSUB ;RO FILE ERROR SUBROUTINE
SELERR: DW SELSUB ;SELECT ERROR SUBROUTINE
;
; error subroutines
PERSUB:
;report permanent error
lxi h,permsg! jmp report$err ;to report the error
;
SELSUB:
;report select error
lxi h,selmsg! jmp report$err ;wait console before boot
;
RODSUB:
;report write to read/only disk
lxi h,rodmsg! jmp report$err ;wait console
;
ROFSUB:
;report read/only file
lxi h,rofmsg ;drop through to wait for console
;
report$err:
;report error to console, message address in HL
push h ;stack msg address
;set D=console #
call rlr! lxi d,console! dad d! mov d,m
call xcrlf ;new line
LDA SELDSK! adi 'A'! sta dskerr ;current disk name
lxi b,dskmsg! call xprint ;the error message
pop b! call xprint ;error mssage tail
lda fx! mvi b,30h
lxi h,pr$fx1
cpi 100! jc rpt$err1
mvi m,31h! inx h! sui 100
rpt$err1:
sui 10! jc rpt$err2
inr b! jmp rpt$err1
rpt$err2:
mov m,b! inx h! adi 3ah! mov m,a
inx h! mvi m,20h
lxi h,pr$fcb! mvi m,0
lda resel! ora a! jz rpt$err3
mvi m,20h! push d
lhld info! inx h! xchg! lxi h,pr$fcb1
mvi c,8! call move! mvi m,'.'! inx h
mvi c,3! call move! pop d
rpt$err3:
call xcrlf
lxi b,pr$fx! call xprint
CALL GET$MEM$SEG
ORA A! JZ RTN$PHY$ERRS
INR A! JZ RTN$PHY$ERRS
LXI D,PNAME+5! CALL TEST$ERROR$MODE1! JNZ RTN$PHY$ERRS
jmp reboot ;terminate process
;ret
xerr$list:
dw xe3,xe4,xe5,xe6,xe7,xe8,xe9,xe10,xe11
xe3: db 'File Opened in Read/Only Mode',0
xe4: db 0
xe5: db 'File Currently Open',0
xe6: db 'Close Checksum Error',0
xe7: db 'Password Error',0
xe8: db 'File Already Exists',0
xe9: db 'Illegal ? in FCB',0
xe10: db 'Open File Limit Exceeded',0
xe11: db 'No Room in System Lock List',0
pr$fx: db 'Bdos Function: '
pr$fx1: db ' '
pr$fcb: db ' File: '
pr$fcb1:ds 12
db 0
fx: ds 1
;
;*****************************************************************
;*****************************************************************
;
; error messages
IF MPM
dskmsg: db 'Bdos Err On '
dskerr: db ' : ',0
permsg: db 'Bad Sector',0
selmsg: db 'Select',0
rofmsg: db 'File '
rodmsg: db 'R/O',0
ELSE
dskmsg: db 'Bdos Err On '
dskerr: db ' : $' ;filled in by errflg
permsg: db 'Bad Sector$'
selmsg: db 'Select$'
rofmsg: db 'File '
rodmsg: db 'R/O$'
XERROR: DB 'X/Err '
XERR$ID:DB ' $'
ENDIF
;
IF BNKBDOS
setlret1:
mvi a,1
sta$ret:
sta aret
func$ret:
ret
entsp: ds 2
ENDIF
;
;*****************************************************************
;*****************************************************************
;
; common values shared between bdosi and bdos
usrcode:db 0 ;current user number
info: ds 2 ;information address
aret: ds 2 ;address value to return
lret equ aret ;low(aret)
;
;*****************************************************************
;*****************************************************************
;** **
;** B a s i c D i s k O p e r a t i n g S y s t e m **
;** **
*****************************************************************
;*****************************************************************
;
dvers equ 30h ;version 3.0
; module addresses
;
; literal constants
true equ 0ffh ;constant true
false equ 000h ;constant false
enddir equ 0ffffh ;end of directory
byte equ 1 ;number of bytes for "byte" type
word equ 2 ;number of bytes for "word" type
;
; fixed addresses in low memory
tfcb equ 005ch ;default fcb location
tbuff equ 0080h ;default buffer location
;
; fixed addresses referenced in bios module are
; pererr (0009), selerr (000c), roderr (000f)
;
; error message handlers
;
;
rod$error: ;
;report read/only disk error
MVI B,2
JMP GOERR ;
;
rof$error: ;
;report read/only file error ;
MVI B,3
JMP GOERR
;
sel$error:
;report select error
MVI B,4
;
goerr:
;HL = .errorhandler, call subroutine
MOV H,B! MVI L,0FFH! SHLD ARET
IF MPM
call test$error$mode! jnz rtn$phy$errs
ELSE
LDA ERROR$MODE! ORA A! JNZ RTN$PHY$ERRS
ENDIF
MOV A,B! LXI H,PERERR-2! JMP BDOS$JMP
;
RTN$PHY$ERRS:
;
IF MPM
lda lock$shell! ora a! jnz lock$perr
ENDIF
LDA RETURN$FFFF! ORA A! JNZ GOBACK0
JMP GOBACK
;
IF MPM
test$error$mode:
lxi d,pname+4
test$error$mode1:
call rlr! dad d
mov a,m! ani 80h! ret
ENDIF
;
BDE$E$BDE$M$HL:
MOV A,E! SUB L! MOV E,A ;
MOV A,D! SBB H! MOV D,A ;
RNC! DCR B! RET
;
BDE$E$BDE$P$HL:
MOV A,E! ADD L! MOV E,A ;
MOV A,D! ADC H! MOV D,A ;
RNC! INR B! RET
;
SHL3BV:
INR C
SHL3BV1:
DCR C! RZ
DAD H! ADC A! JMP SHL3BV1
;
;*********************************************
; routines used by shell and lock/unlock
;*********************************************
incr$rr:
call get$rra
inr m! rnz
inx h! inr m! rnz
inx h! inr m! ret
;
save$rr:
call save$rr2! xchg
save$rr1:
mvi c,3! jmp move ;ret
save$rr2:
call get$rra! lxi d,save$ranr! ret
;
reset$rr:
call save$rr2! jmp save$rr1 ;ret
;
compare:
ldax d! cmp m! rnz
inx h! inx d! dcr c! rz
jmp compare
;****************************************************
;
;
; local subroutines for bios interface
;
move:
;move data length of length C from source DE to
;destination given by HL
inr c ;in case it is zero
move0:
dcr c! rz ;more to move
ldax d! mov m,a ;one byte moved
inx d! inx h ;to next byte
jmp move0
;
selectdisk:
;select the disk drive given by curdsk, and fill
;the base addresses curtrka - alloca, then fill
;the values of the disk parameter block
MVI A,0FFH! STA CURDSK ; IN CASE SELECT FAILS
LDA SELDSK! mov c,a ;current disk# to c
;lsb of e = 0 if not yet logged - in
call seldskf ;HL filled by call
;HL = 0000 if error, otherwise disk headers
mov a,h! ora l! rz ;return with 0000 in HL and z flag
;disk header block address in hl
mov e,m! inx h! mov d,m! inx h ;DE=.tran
shld cdrmaxa! inx h! inx h ;.cdrmax
shld curtrka! inx h! inx h ;HL=.currec
shld curreca! inx h! inx h ;HL=.buffa
INX H! SHLD DRVLBLA! INX H
;DE still contains .tran
xchg! shld tranv ;.tran vector
LXI H,DPBADDR ;DE= source for move, HL=dest
mvi c,addlist! call move ;addlist filled
;now fill the disk parameter block
lhld dpbaddr! xchg ;DE is source
lxi h,sectpt ;HL is destination
mvi c,dpblist! call move ;data filled
;now set single/double map mode
lhld maxall ;largest allocation number
mov a,h ;00 indicates < 255
lxi h,single! mvi m,true ;assume a=00
ora a! jz retselect
;high order of maxall not zero, use double dm
mvi m,false
retselect:
LDA SELDSK! STA CURDSK
IF NOT MPM
LHLD BUFFA! MOV A,H! ORA L! RNZ
LHLD DRVLBLA! MOV D,M! DCX H! MOV E,M
XCHG! SHLD BUFFA
ENDIF
INR A! RET ;select disk function ok
;
home:
;move to home position, then offset to start of dir
call homef ;move to track 00, sector 00 reference
;lxi h,offset ;mov c,m ;inx h ;mov b,m ;call settrkf ;
;first directory position selected
xra a ;constant zero to accumulator
lhld curtrka! mov m,a! inx h! mov m,a ;curtrk=0000
lhld curreca! mov m,a! inx h! mov m,a ;currec=0000
INX H! MOV M,A ;CURREC HIGH BYTE=00
LXI H,0! SHLD DBLK ; DBLK = 0000
;curtrk, currec both set to 0000
ret
;
PASS$ARECORD:
LXI H,ARECORD
MOV E,M! INX H! MOV D,M! INX H! MOV B,M
RET
;
rdbuff:
;read buffer and check condition
CALL PASS$ARECORD
call readf ;current drive, track, sector, dma
jmp diocomp ;check for i/o errors
;
wrbuff:
;write buffer and check condition
;write type (wrtype) is in register C
;wrtype = 0 => normal write operation
;wrtype = 1 => directory write operation
;wrtype = 2 => start of new block
CALL PASS$ARECORD
IF MPM
lda rem$drv! ora c! mov c,a
ENDIF
call writef ;current drive, track, sector, dma
diocomp: ;check for disk errors
ora a! rz ;
MOV B,A
CPI 3! JC GOERR
MVI B,1! JMP GOERR
;
seekdir:
;seek the record containing the current dir entry
;
LXI D,0FFFFH ; MASK = FFFF
LHLD DBLK! MOV A,H! ORA L! JZ SEEKDIR1
LDA BLKMSK! MOV E,A! XRA A! MOV D,A ; MASK = BLKMSK
LDA BLKSHF! MOV C,A! XRA A ;
CALL SHL3BV ; AHL = SHL(DBLK,BLKSHF)
SEEKDIR1:
PUSH H! PUSH A ; SAVE AHL
;
lhld dcnt ;directory counter to HL
mvi c,dskshf! call hlrotr ;value to HL
;
; ARECORD = SHL(DBLK,BLKSHF) + SHR(DCNT,DSKSHF) & MASK
;
MOV A,L! ANA E! MOV L,A ; DCNT = DCNT & MASK
MOV A,H! ANA D! MOV H,A
POP B! POP D! CALL BDE$E$BDE$P$HL ;
LXI H,ARECORD! MOV M,E! INX H! MOV M,D! INX H! MOV M,B
;
; jmp seek ;
;ret
;
;
seek:
;seek the track given by arecord (actual record)
;
LHLD CURTRKA! MOV C,M! INX H! MOV B,M ; BC = CURTRK
PUSH B ; S0 = CURTRK
LHLD CURRECA! MOV E,M! INX H! MOV D,M
INX H! MOV B,M ; BDE = CURREC
LHLD ARECORD! LDA ARECORD+2! MOV C,A ; CHL = ARECORD
SEEK0:
MOV A,L! SUB E! MOV A,H! SBB D! MOV A,C! SBB B
PUSH H ; SAVE LOW(ARECORD)
JNC SEEK1 ; IF ARECORD >= CURREC THEN GO TO SEEK1
LHLD SECTPT! CALL BDE$E$BDE$M$HL ; CURREC = CURREC - SECTPT
POP H! XTHL! DCX H! XTHL ; CURTRK = CURTRK - 1
JMP SEEK0
SEEK1:
LHLD SECTPT! CALL BDE$E$BDE$P$HL ; CURREC = CURREC + SECTPT
POP H ; RESTORE LOW(ARECORD)
MOV A,L! SUB E! MOV A,H! SBB D! MOV A,C! SBB B
JC SEEK2 ; IF ARECORD < CURREC THEN GO TO SEEK2
XTHL! INX H! XTHL ; CURTRK = CURTRK + 1
PUSH H ; SAVE LOW (ARECORD)
JMP SEEK1
SEEK2:
XTHL! PUSH H ; HL,S0 = CURTRK, S1 = LOW(ARECORD)
LHLD SECTPT! CALL BDE$E$BDE$M$HL ; CURREC = CURREC - SECTPT
POP H! PUSH D! PUSH B! PUSH H ; HL,S0 = CURTRK,
; S1 = HIGH(ARECORD,CURREC), S2 = LOW(CURREC),
; S3 = LOW(ARECORD)
XCHG! LHLD OFFSET! DAD D! MOV B,H! MOV C,L
CALL SETTRKF ; CALL BIOS SETTRK ROUTINE
; STORE CURTRK
POP D! LHLD CURTRKA! MOV M,E! INX H! MOV M,D
; STORE CURREC
POP B! POP D!
LHLD CURRECA! MOV M,E! INX H! MOV M,D
INX H! MOV M,B ; CURREC = BDE
POP B ; BC = LOW(ARECORD), DE = LOW(CURREC)
MOV A,C! SUB E! MOV C,A ; BC = BC - DE
MOV A,B! SBB D! MOV B,A ;
;
lhld tranv! xchg ;BC=sector#, DE=.tran
call sectran ;HL = tran(sector)
mov c,l! mov b,h ;BC = tran(sector)
jmp setsecf ;sector selected
;ret
;
; file control block (fcb) constants
empty equ 0e5h ;empty directory entry
lstrec equ 127 ;last record# on extent
recsiz equ 128 ;record size
fcblen equ 32 ;file control block size
dirrec equ recsiz/fcblen ;directory FCBS / record
dskshf equ 2 ;log2(dirrec)
dskmsk equ dirrec-1
fcbshf equ 5 ;log2(fcblen)
;
extnum equ 12 ;extent number field
maxext equ 31 ;largest extent number
ubytes equ 13 ;unfilled bytes field
modnum equ 14 ;data module number
;
MAXMOD equ 64 ;LARGEST MODULE NUMBER
;
fwfmsk equ 80h ;file write flag is high order modnum
namlen equ 15 ;name length
reccnt equ 15 ;record count field
dskmap equ 16 ;disk map field
lstfcb equ fcblen-1
nxtrec equ fcblen
ranrec equ nxtrec+1;random record field (2 bytes)
;
; reserved file indicators
rofile equ 9 ;high order of first type char
invis equ 10 ;invisible file in dir command
;
; utility functions for file access
;
dm$position:
;compute disk map position for vrecord to HL
lxi h,blkshf! mov c,m ;shift count to C
lda vrecord ;current virtual record to A
dmpos0:
ora a! rar! dcr c! jnz dmpos0
;A = shr(vrecord,blkshf) = vrecord/2**(sect/block)
mov b,a ;save it for later addition
mvi a,8! sub m ;8-blkshf to accumulator
mov c,a ;extent shift count in register c
lda extval ;extent value ani extmsk
dmpos1:
;blkshf = 3,4,5,6,7, C=5,4,3,2,1
;shift is 4,3,2,1,0
dcr c! jz dmpos2
ora a! ral! jmp dmpos1
dmpos2:
;arrive here with A = shl(ext and extmsk,7-blkshf)
add b ;add the previous shr(vrecord,blkshf) value
;A is one of the following values, depending upon alloc
;bks blkshf
;1k 3 v/8 + extval * 16
;2k 4 v/16+ extval * 8
;4k 5 v/32+ extval * 4
;8k 6 v/64+ extval * 2
;16k 7 v/128+extval * 1
ret ;with dm$position in A
;
GETDMA:
LHLD INFO! LXI D,DSKMAP! DAD D! RET
;
getdm:
;return disk map value from position given by BC
CALL GETDMA
dad b ;index by a single byte value
lda single ;single byte/map entry?
ora a! jz getdmd ;get disk map single byte
mov l,m! mvi h,0! ret ;with HL=00bb
getdmd:
dad b ;HL=.fcb(dm+i*2)
;double precision value returned
mov e,m! inx h! mov d,m! xchg! ret
;
index:
;compute disk block number from current fcb
call dm$position ;0...15 in register A
mov c,a! mvi b,0! call getdm ;value to HL
shld arecord! ret
;
allocated:
;called following index to see if block allocated
lhld arecord! mov a,l! ora h! ret
;
atran:
;compute actual record address, assuming index called
;
; ARECORD = SHL(ARECORD,BLKSHF)
;
LDA BLKSHF! MOV C,A
LHLD ARECORD! XRA A! CALL SHL3BV
SHLD ARECORD! STA ARECORD+2 ;
;
SHLD ARECORD1 ; SAVE LOW(ARECORD)
;
; ARECORD = ARECORD OR (VRECORD AND BLKMSK)
;
LDA BLKMSK! MOV C,A! LDA VRECORD! ANA C
LXI H,ARECORD! ORA M! MOV M,A! RET
;
GET$ATTS:
;GET VOLATILE ATTRIBUTES STARTING AT F'5
;INFO LOCATES FCB
LHLD INFO
LXI D,5! DAD D ; HL = .FCB(F'5)
MVI E,0111$1111B! MVI C,4
GET$ATTS$LOOP:
MOV A,M! PUSH A
RAL! MOV A,D! ADC A! MOV D,A
POP A! ANA E! MOV M,A
INX H! DCR C! JNZ GET$ATTS$LOOP
MOV A,D! ADD A! ADD A! ADD A! ADD A! RET
;
GET$S1:
;GET CURRENT S1 FIELD TO A
CALL GETEXTA! INX H! MOV A,M! RET ;
;
GET$RRA:
;GET CURRENT RAN REC FIELD ADDRESS TO HL
LHLD INFO! LXI D,RANREC! DAD D ;HL=.FCB(RANREC)
RET
;
getexta:
;get current extent field address to HL
lhld info! lxi d,extnum! dad d ;HL=.fcb(extnum)
ret
;
GETRCNTA:
;GET RECCNT ADDRESS TO HL
LHLD INFO! LXI D,RECCNT! DAD D! RET
;
getfcba:
;compute reccnt and nxtrec addresses for get/setfcb
CALL GETRCNTA! xchg ;DE=.fcb(reccnt)
lxi h,(nxtrec-reccnt)! dad d ;HL=.fcb(nxtrec)
ret
;
getfcb:
;set variables from currently addressed fcb
call getfcba ;addresses in DE, HL
mov a,m! sta vrecord ;vrecord=fcb(nxtrec)
xchg! mov a,m! sta rcount ;rcount=fcb(reccnt)
call getexta ;HL=.fcb(extnum)
lda extmsk ;extent mask to a
ana m ;fcb(extnum) and extmsk
sta extval
ret
;
setfcb:
;place values back into current fcb
call getfcba ;addresses to DE, HL
lda seqio
cpi 02! jnz setfcb1! xra a ;check ranfill
setfcb1:
mov c,a ;=1 if sequential i/o
lda vrecord! add c! mov m,a ;fcb(nxtrec)=vrecord+seqio
xchg! lda rcount! mov m,a ;fcb(reccnt)=rcount
ret
;
hlrotr:
;hl rotate right by amount C
inr c ;in case zero
hlrotr0: dcr c! rz ;return when zero
mov a,h! ora a! rar! mov h,a ;high byte
mov a,l! rar! mov l,a ;low byte
jmp hlrotr0
;
;
compute$cs:
;compute checksum for current directory buffer
mvi c,recsiz ;size of directory buffer
lhld buffa ;current directory buffer
xra a ;clear checksum value
computecs0:
add m! inx h! dcr c ;cs=cs+buff(recsiz-C)
jnz computecs0
ret ;with checksum in A
;
CHKSUM$FCB: ; COMPUTE CHECKSUM FOR FCB
; ADD 1ST 12 BYTES OF FCB + CURDSK +
; HIGH$EXT + XFCB$READ$ONLY + BBH
IF MPM
lxi h,pdcnt! mov a,m
inx h! add m ; Add high$ext
ELSE
LXI H,HIGH$EXT! MOV A,M
ENDIF
INX H! ADD M ; ADD XFCB$READ$ONLY
INX H! ADD M ; ADD CURDSK
ADI 0BBH ; ADD 0BBH TO BIAS CHECKSUM
LHLD INFO! MVI C,12! CALL COMPUTECS0
; SKIP EXTNUM
INX H
; ADD FCB(S1)
ADD M! INX H
; SKIP MODNUM
INX H
; SKIP FCB(RECCNT)
; ADD DISK MAP
INX H! MVI C,16! CALL COMPUTECS0
ORA A! RET ; Z FLAG SET IF CHECKSUM VALID
;
SET$CHKSUM$FCB:
CALL CHKSUM$FCB! RZ
MOV B,A! CALL GETS1
CMA! ADD B! CMA
MOV M,A! RET
;
RESET$CHKSUM$FCB:
XRA A! STA COMP$FCB$CKS
CALL CHKSUM$FCB! RNZ
CALL GET$S1! INR M! RET
;
CHEK$FCB:
LDA HIGH$EXT
; IF EXT & 0110$0000B = 0110$0000B THEN
; SET FCB(0) TO 0 (USER 0)
CPI 0110$0000B! JNZ CHEK$FCB1
LHLD INFO! XRA A! MOV M,A ; FCB(0) = 0
CHEK$FCB1:
JMP CHKSUM$FCB ;RET
;
CHECK$FCB:
IF MPM
xra a! sta check$fcb4
check$fcb1:
ENDIF
CALL CHEK$FCB! RZ
CHECK$FCB2:
;
IF MPM
ani 0fh! jnz check$fcb3
lda pdcnt! ora a! jz check$fcb3
call set$sdcnt! sta dont$close
call close1
lxi h,lret! inr m! jz check$fcb3
mvi m,0! call pack$sdcnt! mvi b,5
call search$olist! rz
check$fcb3:
;
ENDIF
POP H ; DISCARD RETURN ADDRESS
IF MPM
check$fcb4:
nop
ENDIF
MVI A,10! JMP STA$RET
;
SET$FCB$CKS$FLAG:
MVI A,0FFH! STA COMP$FCB$CKS! RET
;
hlrotl:
;rotate the mask in HL by amount in C
inr c ;may be zero
hlrotl0: dcr c! rz ;return if zero
dad h! jmp hlrotl0
;
;
set$cdisk:
;set a "1" value in curdsk position of BC
LDA SELDSK
SET$CDISK1:
push b ;save input parameter
mov c,a ;ready parameter for shift
lxi h,1 ;number to shift
call hlrotl ;HL = mask to integrate
pop b ;original mask
mov a,c! ora l! mov l,a
mov a,b! ora h! mov h,a ;HL = mask or rol(1,curdsk)
ret
;
nowrite:
;return true if dir checksum difference occurred
lhld rodsk!
;
TEST$VECTOR:
LDA SELDSK
TEST$VECTOR1:
mov c,a! call hlrotr
mov a,l! ani 1b! ret ;non zero if curdsk bit on
;
set$ro:
;set current disk to read only
lxi h,rodsk! mov c,m! inx h! mov b,m
call set$cdisk ;sets bit to 1
shld rodsk
;high water mark in directory goes to max
lhld dirmax! inx h! xchg ;DE = directory max
lhld cdrmaxa ;HL = .cdrmax
mov m,e! inx h! mov m,d ;cdrmax = dirmax
ret
;
check$rodir:
;check current directory element for read/only status
call getdptra ;address of element
;
check$rofile:
;check current buff(dptr) or fcb(0) for r/o status
CALL RO$TEST
rnc ;return if not set
jmp rof$error ;exit to read only disk message
;
RO$TEST:
LXI D,ROFILE! DAD D
MOV A,M! RAL! RET ;CARRY SET IF R/O
;
;
check$write:
;check for write protected disk
call nowrite! rz ;ok to write if not rodsk
jmp rod$error ;read only disk error
;
getdptra:
;compute the address of a directory element at
;positon dptr in the buffer
lhld buffa! lda dptr ;
addh:
;HL = HL + A
add l! mov l,a! rnc
;overflow to H
inr h! ret
;
;
getmodnum:
;compute the address of the module number
;bring module number to accumulator
;(high order bit is fwf (file write flag)
lhld info! lxi d,modnum! dad d ;HL=.fcb(modnum)
mov a,m! ret ;A=fcb(modnum)
;
clrmodnum:
;clear the module number field for user open/make
call getmodnum! mvi m,0 ;fcb(modnum)=0
ret
;
CLR$EXT:
;FCB EXT = FCB EXT & 1FH
CALL GETEXTA! MOV A,M! ANI 0001$1111B! MOV M,A!
RET
;
setfwf:
call getmodnum ;HL=.fcb(modnum), A=fcb(modnum)
;set fwf (file write flag) to "1"
ori fwfmsk! mov m,a ;fcb(modnum)=fcb(modnum) or 80h
;also returns non zero in accumulator
ret
;
;
compcdr:
;return cy if cdrmax > dcnt
lhld dcnt! xchg ;DE = directory counter
lhld cdrmaxa ;HL=.cdrmax
mov a,e! sub m ;low(dcnt) - low(cdrmax)
inx h ;HL = .cdrmax+1
mov a,d! sbb m ;hig(dcnt) - hig(cdrmax)
;condition dcnt - cdrmax produces cy if cdrmax>dcnt
ret
;
setcdr:
;if not (cdrmax > dcnt) then cdrmax = dcnt+1
call compcdr
rc ;return if cdrmax > dcnt
;otherwise, HL = .cdrmax+1, DE = dcnt
inx d! mov m,d! dcx h! mov m,e
ret
;
subdh:
;compute HL = DE - HL
mov a,e! sub l! mov l,a! mov a,d! sbb h! mov h,a
ret
;
newchecksum:
mvi c,true ;drop through to compute new checksum
checksum:
;compute current checksum record and update the
;directory element if C=true, or check for = if not
;drec < chksiz?
LHLD ARECORD! xchg! lhld chksiz
MOV A,H! ANI 7FH! MOV H,A ; MASK OFF PERMANENT DRIVE BIT
call subdh ;DE-HL
rnc ;skip checksum if past checksum vector size
;drec < chksiz, so continue
push b ;save init flag
call compute$cs ;check sum value to A
lhld checka ;address of check sum vector
xchg
LHLD ARECORD
dad d ;HL = .check(drec)
pop b ;recall true=0ffh or false=00 to C
inr c ;0ffh produces zero flag
jz initial$cs
IF MPM
inr c! jz test$dir$cs
ENDIF
;not initializing, compare
cmp m ;compute$cs=check(drec)?
rz ;no message if ok
;checksum error, are we beyond
;the end of the disk?
call compcdr
rnc ;no message if so
IF MPM
call nowrite! cz flush$file0
ENDIF
jmp set$ro ;read/only disk set
IF MPM
test$dir$cs:
cmp m! jnz flush$files
ret
ENDIF
initial$cs:
;initializing the checksum
mov m,a! ret
;
;
wrdir:
;write the current directory entry, set checksum
CALL CHECK$WRITE
call newchecksum ;initialize entry
call setdir ;directory dma
mvi c,1 ;indicates a write directory operation
call wrbuff ;write the buffer
jmp setdata ;to data dma address
;ret
;
rd$dir:
;read a directory entry into the directory buffer
call setdir ;directory dma
call rdbuff ;directory record loaded
; jmp setdata to data dma address
;ret
;
setdata:
;set data dma address
lxi h,dmaad! jmp setdma ;to complete the call
;
setdir:
;set directory dma address
lxi h,buffa ;jmp setdma to complete call
;
setdma:
;HL=.dma address to set (i.e., buffa or dmaad)
mov c,m! inx h! mov b,m ;parameter ready
jmp setdmaf
;
;
IF NOT MPM
dir$to$user:
;copy the directory entry to the user buffer
;after call to search or searchn by user code
lhld buffa! xchg ;source is directory buffer
lhld dmaad ;destination is user dma address
mvi c,recsiz ;copy entire record
jmp move
;ret
ENDIF
;
MAKE$FCB$INV: ; FLAG FCB AS INVALID
; RESET FCB WRITE FLAG
CALL SETFWF
; SET 1ST TWO BYTES OF DISKMAP TO FFH
INX H! INX H! MVI A,0FFH! MOV M,A! INX H! MOV M,A
RET
;
CHK$INV$FCB: ; CHECK FOR INVALID FCB
CALL GETDMA! JMP TEST$FFFF
;
TST$INV$FCB: ; TEST FOR INVALID FCB
CALL CHK$INV$FCB! RNZ
POP H! MVI A,9! JMP STA$RET! ; LRET = 9
;
end$of$dir:
;return zero flag if at end of directory, non zero
;if not at end (end of dir if dcnt = 0ffffh)
lxi h,dcnt
TEST$FFFF:
mov a,m ;may be 0ffh
inx h! cmp m ;low(dcnt) = high(dcnt)?
rnz ;non zero returned if different
;high and low the same, = 0ffh?
inr a ;0ffh becomes 00 if so
ret
;
set$end$dir:
;set dcnt to the end of the directory
lxi h,enddir! shld dcnt! ret
;
read$dir:
;read next directory entry, with C=true if initializing
lhld dirmax! xchg ;in preparation for subtract
lhld dcnt! inx h! shld dcnt ;dcnt=dcnt+1
;continue while dirmax >= dcnt (dirmax-dcnt no cy)
call subdh ;DE-HL
jnc read$dir0
;yes, set dcnt to end of directory
jmp set$end$dir ;
; ret ;
read$dir0:
;not at end of directory, seek next element
;initialization flag is in C
lda dcnt! ani dskmsk ;low(dcnt) and dskmsk
mvi b,fcbshf ;to multiply by fcb size
read$dir1:
add a! dcr b! jnz read$dir1
;A = (low(dcnt) and dskmsk) shl fcbshf
sta dptr ;ready for next dir operation
ora a! rnz ;return if not a new record
push b ;save initialization flag C
call seek$dir ;seek proper record
call rd$dir ;read the directory record
pop b ;recall initialization flag
jmp checksum ;checksum the directory elt
;ret
;
;
getallocbit:
;given allocation vector position BC, return with byte
;containing BC shifted so that the least significant
;bit is in the low order accumulator position. HL is
;the address of the byte for possible replacement in
;memory upon return, and D contains the number of shifts
;required to place the returned value back into position
mov a,c! ani 111b! inr a! mov e,a! mov d,a
;d and e both contain the number of bit positions to shift
;
MOV H,B! MOV L,C! MVI C,3 ; BC = BC SHR 3
CALL HLROTR ; HLROTR DOES NOT TOUCH D AND E
MOV B,H! MOV C,L
;
lhld alloca ;base address of allocation vector
dad b! mov a,m ;byte to A, hl = .alloc(BC shr 3)
;now move the bit to the low order position of A
rotl: rlc! dcr e! jnz rotl! ret
;
;
setallocbit:
;BC is the bit position of ALLOC to set or reset. The
;value of the bit is in register E.
push d! call getallocbit ;shifted val A, count in D
ani 1111$1110b ;mask low bit to zero (may be set)
pop b! ora c ;low bit of C is masked into A
; jmp rotr ;to rotate back into proper position
;ret
rotr:
;byte value from ALLOC is in register A, with shift count
;in register C (to place bit back into position), and
;target ALLOC position in registers HL, rotate and replace
rrc! dcr d! jnz rotr ;back into position
mov m,a ;back to ALLOC
ret
;
scandm:
;scan the disk map addressed by dptr for non-zero
;entries, the allocation vector entry corresponding
;to a non-zero entry is set to the value of C (0,1)
call getdptra ;HL = buffa + dptr
;HL addresses the beginning of the directory entry
lxi d,dskmap! dad d ;hl now addresses the disk map
push b ;save the 0/1 bit to set
mvi c,fcblen-dskmap+1 ;size of single byte disk map + 1
scandm0:
;loop once for each disk map entry
pop d ;recall bit parity
dcr c! rz ;all done scanning?
;no, get next entry for scan
push d ;replace bit parity
lda single! ora a! jz scandm1
;single byte scan operation
push b ;save counter
push h ;save map address
mov c,m! mvi b,0 ;BC=block#
jmp scandm2
scandm1:
;double byte scan operation
dcr c ;count for double byte
push b ;save counter
mov c,m! inx h! mov b,m ;BC=block#
push h ;save map address
scandm2:
;arrive here with BC=block#, E=0/1
mov a,c! ora b ;skip if = 0000
jz scanm3
lhld maxall ;check invalid index
mov a,l! sub c! mov a,h! sbb b ;maxall - block#
cnc set$alloc$bit ;
;bit set to 0/1
scanm3: ;
pop h! inx h ;to next bit position
pop b ;recall counter
jmp scandm0 ;for another item
;
GET$NALBS: ; GET # OF ALLOCATION VECTOR BYTES
LHLD MAXALL! MVI C,3
;number of bytes in alloc vector is (maxall/8)+1
CALL HLROTR! INX H! RET
;
IF MPM
test$dir:
call home
call set$end$dir
test$dir1:
mvi c,0feh! call read$dir
lda flushed! ora a! rnz
call end$of$dir! rz
jmp test$dir1
;
ENDIF
initialize:
;initialize the current disk
;lret = false ;set to true if $ file exists
;compute the length of the allocation vector - 2
IF MPM
lhld tlog! call test$vector! jz initialize1
lhld tlog! call remove$drive! shld tlog
xra a! sta flushed
; **** PATCH 2.1
; Always reinitialize if no open files exist on drive
CALL PATCH10
; Removed code:
; call test$dir
rz
initialize1:
ENDIF
CALL GET$NALBS ; get # of allocation vector bytes
mov b,h! mov c,l ;count down BC til zero
lhld alloca ;base of allocation vector
;fill the allocation vector with zeros
initial0:
mvi m,0! inx h ;alloc(i)=0
dcx b ;count length down
mov a,b! ora c! jnz initial0
;
LHLD DRVLBLA! MOV M,A ; ZERO OUT DRIVE DESC BYTE
;
;set the reserved space for the directory
lhld dirblk! xchg
lhld alloca ;HL=.alloc()
mov m,e! inx h! mov m,d ;sets reserved directory blks
;allocation vector initialized, home disk
call home
;cdrmax = 3 (scans at least one directory record)
lhld cdrmaxa! mvi m,3! inx h! mvi m,0
;cdrmax = 0000
call set$end$dir ;dcnt = enddir
;read directory entries and check for allocated storage
initial2:
mvi c,true! call read$dir
call end$of$dir! rz ;return if end of directory
;not end of directory, valid entry?
call getdptra ;HL = buffa + dptr
mvi a,empty! cmp m
jz initial2 ;go get another item
;
MVI A,20H! CMP M! JZ DRV$LBL
MVI A,70H! ANA M! JNZ INITIAL3
;
;now scan the disk map for allocated blocks
mvi c,1 ;set to allocated
call scandm
INITIAL3:
call setcdr ;set cdrmax to dcnt
jmp initial2 ;for another entry
;
DRV$LBL:
LXI D,EXTNUM! DAD D! MOV A,M
LHLD DRVLBLA! MOV M,A! JMP INITIAL3
;
;
copy$dirloc:
;copy directory location to lret following
;delete, rename, ... ops
lda dirloc! jmp sta$ret ;
; ret ;
;
compext:
;compare extent# in A with that in C, return nonzero
;if they do not match
push b ;save C's original value
push psw! lda extmsk! cma! mov b,a
;B has negated form of extent mask
mov a,c! ana b! mov c,a ;low bits removed from C
pop psw! ana b ;low bits removed from A
sub c! ani maxext ;set flags
pop b ;restore original values
ret
;
GET$DIR$EXT:
;COMPUTE DIRECTORY EXTENT FROM FCB
;SCAN FCB DISK MAP BACKWARDS
CALL GETFCBA ; HL = .FCB(VRECORD)
MVI C,16! MOV B,C! INR C! PUSH B
; B=DSKMAP POS (REL TO 0)
GET$DE0:
POP B ;
DCR C ;
XRA A ; COMPARE TO ZERO
GET$DE1:
DCX H! DCR B; DECR DSKMAP POSITION
CMP M! JNZ GET$DE2 ; FCB(DSKMAP(B)) ~= 0
DCR C! JNZ GET$DE1
;ALL BLOCKS = 0 IN FCB DISK MAP
GET$DE2:
LDA SINGLE! ORA A! MOV A,B ;
JNZ GET$DE3
RAR ; NOT SINGLE, DIVIDE BLK IDX BY 2
GET$DE3:
PUSH B! PUSH H ; SAVE DSKMAP POSITION & COUNT
MOV L,A! MVI H,0 ; HL = NON-ZERO BLK IDX
; COMPUTE EXT OFFSET FROM LAST NON-ZERO
; BLOCK INDEX BY SHIFTING BLK IDX RIGHT
; 7 - BLKSHF
LDA BLKSHF! MOV D,A! MVI A,7! SUB D ;
MOV C,A! CALL HLROTR! MOV B,L ;
; B = EXT OFFSET
LDA EXTMSK! CMP B! POP H! JC GET$DE0
; VERIFY COMPUTED EXTENT OFFSET <= EXTMSK
CALL GETEXTA! MOV C,M
CMA! ANI MAXEXT! ANA C! ORA B
;DIR EXT = (FCB EXT & (~ EXTMSK) & MAXEXT) | EXT OFFSET
POP B ; RESTORE STACK
RET ; A = DIRECTORY EXTENT
;
SEARCHI:
;SEARCH INITIALIZATION
lhld info! shld searcha ;searcha = info
SEARCHI1:
mvi a,0ffh! sta dirloc ;changed if actually found
lxi h,searchl! mov m,c ;searchl = C
RET
;
search:
;search for directory element of length C at info
CALL SEARCHI;
SEARCH1: ; ENTRY POINT USED BY RENAME
call set$end$dir ;dcnt = enddir
call home ;to start at the beginning
;(drop through to searchn) ;
;
searchn:
;search for the next directory element, assuming
;a previous call on search which sets searcha and
;searchl
;
IF MPM
lxi h,user0$pass! xra a! cmp m! mov m,a! cnz swap
ELSE
XRA A! STA USER0$PASS ;
ENDIF
;
mvi c,false! call read$dir ;read next dir element
call end$of$dir! jz search$fin ;skip to end if so
;not end of directory, scan for match
lhld searcha! xchg ;DE=beginning of user fcb
ldax d ;first character
cpi empty ;keep scanning if empty
jz searchnext
;not empty, may be end of logical directory
push d ;save search address
call compcdr ;past logical end?
pop d ;recall address
jnc search$fin ;artificial stop
searchnext:
call getdptra ;HL = buffa+dptr
lda searchl! mov c,a ;length of search to c
mvi b,0 ;b counts up, c counts down
;
MOV A,M! CPI EMPTY! CZ SAVE$DCNT$POS1
XRA A! STA SAVE$XFCB
MOV A,M! ANI 1110$1111B! CMP M! JZ SEARCH$LOOP
XCHG! CMP M! XCHG! JNZ SEARCH$LOOP
LDA FIND$XFCB! ORA A! JZ SEARCH$N
STA SAVE$XFCB! JMP SEARCHOK
;
searchloop:
mov a,c! ora a! jz endsearch
ldax d! cpi '?'! jz searchok ;? IN USER FCB
;scan next character if not ubytes
mov a,b! cpi ubytes! jz searchok
;not the ubytes field, extent field?
cpi extnum ;may be extent field
jz searchext ;skip to search extent
CPI MODNUM! LDAX D! CZ SEARCHMOD
sub m! ani 7fh ;mask-out flags/extent modulus
JNZ SEARCHNM ;skip if not matched
jmp searchok ;matched character
searchext:
LDAX D
;attempt an extent # match
push b ;save counters
;
IF MPM
push h
lhld sdcnt
inr h! jnz dont$save
lhld dcnt! shld sdcnt
lhld dblk! shld sdblk
dont$save:
pop h
ENDIF
mov c,m ;directory character to c
call compext ;compare user/dir char
;
MOV B,A
LDA USER0PASS! INR A! JZ SAVE$DCNT$POS2
; DISABLE SEARCH OF USER 0 IF ANY FCB
; IS FOUND UNDER THE CURRENT USER #
XRA A! STA SEARCH$USER0
DCR A! STA FCB$EXISTS
MOV A,B
;
pop b ;recall counters
ORA A ; SET FLAG
jnz searchn ;skip if no match
searchok:
;current character matches
inx d! inx h! inr b! dcr c
jmp searchloop
endsearch:
;entire name matches, return dir position
LDA SAVE$XFCB! ORA A! JZ ENDSEARCH1
LDA XDCNT+1! CPI 0FEH! CZ SAVE$DCNT$POS0
JMP SEARCHN
ENDSEARCH1:
STA DIRLOC ; DIRLOC = 0
lda dcnt! ani dskmsk! sta lret
;lret = low(dcnt) and 11b
;SUCCESSFUL SEARCH -
;RETURN WITH ZERO FLAG RESET
MOV B,A! INR B! RET
SEARCHMOD:
ANI 3FH! RET ; MASK OFF HIGH 2 BITS
search$fin:
;end of directory, or empty name
;
CALL SAVE$DCNT$POS1 ;
;
;SET DCNT = 0FFFFH
call set$end$dir ;may be artifical end
LRET$EQ$FF:
;UNSUCCESSFUL SEARCH -
;RETURN WITH ZERO FLAG SET
;LRET,LOW(ARET) = 0FFH
mvi a,255! MOV B,A! INR B! jmp sta$ret ;
;
SEARCHNM: ; SEARCH NO MATCH ROUTINE
MOV A,B! ORA A! JNZ SEARCHN ; FCB(0)?
MOV A,M! ORA A! JNZ SEARCHN ; DIR FCB(0)=0?
LDA SEARCH$USER0! ORA A! JZ SEARCHN
STA USER0$PASS
;
IF MPM
call swap
ENDIF
;
JMP SEARCHOK
;
IF MPM
swap: ; swap dcnt,sdblk with sdcnt0,sdblk0
push h! push d! push b
lxi d,sdcnt! lxi h,sdcnt0
mvi b,4
swap1:
ldax d! mov c,a! mov a,m
stax d! mov m,c
inx h! inx d! dcr b! jnz swap1
pop b! pop d! pop h!
ret
ENDIF
;
SAVE$DCNT$POS2:
; SAVE DIRECTORY POSITION OF MATCHING FCB
; UNDER USER 0 WITH MATCHING EXTENT # & MODNUM = 0
; A = 0 ON ENTRY
ORA B! POP B! LXI B,SEARCHN! PUSH B! RNZ
; CALL IF USER0PASS = 0FFH &
; DIR FCB(EXTNUM) = FCB(EXTNUM)
; DIR FCB(MODNUM) = 0
SAVE$DCNT$POS0:
CALL SAVE$DCNT$POS ; RETURN TO SEARCHN
SAVE$DCNT$POS1:
; SAVE DIRECTORY POSITION OF FIRST EMPTY FCB
; OR THE END OF THE DIRECTORY
PUSH H!
LHLD XDCNT! INR H! JNZ SAVE$DCNT$POS$RET ; RETURN IF H ~= 0FFH
SAVE$DCNT$POS:
LHLD DCNT! SHLD XDCNT ;
LHLD DBLK! SHLD XDBLK ;
SAVE$DCNT$POS$RET:
POP H! RET
;
INIT$XFCB$SEARCH:
MVI A,0FFH
INIT$XFCB$SEARCH1:
STA FIND$XFCB! MVI A,0FEH! STA XDCNT+1! RET
;
DOES$XFCB$EXIST:
LDA XDCNT+1! CPI 0FEH! RZ
CALL SET$DCNT$DBLK
XRA A! CALL INIT$XFCB$SEARCH1
LHLD SEARCHA! MOV A,M! ORI 10H! MOV M,A
MVI C,EXTNUM! CALL SEARCHI1! JMP SEARCHN
;
delete:
;delete the currently addressed file
call check$write ;write protected?
CALL GET$ATTS! STA ATTRIBUTES
CALL CHK$PWS! PUSH A
CALL INIT$XFCB$SEARCH
MVI C,EXTNUM! CALL SEARCH ;SEARCH THROUGH FILE TYPE
POP B! JZ DELETE2
MOV A,B! ORA A! JNZ CHK$PW1
LDA ATTRIBUTES! RAL! JC DELETE015
LHLD INFO! CALL CHK$WILD! JZ DELETE015
IF MPM
call tst$olist
ENDIF
CALL CHECK$RODIR! JMP DELETE0
;
DELETE01:
;LOOP WHILE DIRECTORY MATCHES
JZ DELETE02
DELETE015:
IF MPM
call tst$olist
ENDIF
CALL CHECK$RODIR
CALL SEARCHN! JMP DELETE01
DELETE02:
;
LDA ATTRIBUTES! RAL! JC DELETE2
mvi c,extnum! call search ;search through file type
delete0:
;loop while directory matches
JZ DELETE2
DELETE1:
;set each non zero disk map entry to 0
;in the allocation vector
IF MPM
call chk$olist
ENDIF
call getdptra ;HL=.buff(dptr)
MOV A,M! ANI 10H
mvi m,empty
mvi c,0! CZ SCANDM ;alloc elts set to 0
call wrdir ;write the directory
call searchn ;to next element
jmp delete0 ;for another record
DELETE2:
CALL DOES$XFCB$EXIST! JNZ DELETE1! JMP COPY$DIR$LOC
;
get$block:
;given allocation vector position BC, find the zero bit
;closest to this position by searching left and right.
;if found, set the bit to one and return the bit position
;in hl. if not found (i.e., we pass 0 on the left, or
;maxall on the right), return 0000 in hl
mov d,b! mov e,c ;copy of starting position to de
lefttst:
mov a,c! ora b! jz righttst ;skip if left=0000
;left not at position zero, bit zero?
dcx b! push d! push b ;left,right pushed
call getallocbit
rar! jnc retblock ;return block number if zero
;bit is one, so try the right
pop b! pop d ;left, right restored
righttst:
lhld maxall ;value of maximum allocation#
mov a,e! sub l! mov a,d! sbb h ;right=maxall?
jnc retblock0 ;return block 0000 if so
inx d! push b! push d ;left, right pushed
mov b,d! mov c,e ;ready right for call
call getallocbit
rar! jnc retblock ;return block number if zero
pop d! pop b ;restore left and right pointers
jmp lefttst ;for another attempt
retblock:
ral! inr a ;bit back into position and set to 1
;d contains the number of shifts required to reposition
call rotr ;move bit back to position and store
pop h! pop d ;HL returned value, DE discarded
ret
retblock0:
;cannot find an available bit, return 0000
mov a,c ;
ora b! jnz lefttst ;also at beginning
lxi h,0000h! ret
;
copy$dir:
;copy fcb information starting at C for E bytes
;into the currently addressed directory entry
MVI D,80H
COPY$DIR0:
CALL COPY$DIR2
INR C
COPY$DIR1:
DCR C! JZ SEEK$COPY
MOV A,M! ANA B! PUSH B
MOV B,A! LDAX D! ANI 7FH! ORA B! MOV M,A
POP B! INX H! INX D! JMP COPY$DIR1
COPY$DIR2:
push d ;save length for later
mvi b,0 ;double index to BC
lhld info ;HL = source for data
dad b! xchg ;DE=.fcb(C), source for copy
call getdptra ;HL=.buff(dptr), destination
pop b ;DE=source, HL=dest, C=length
RET
seek$copy:
;enter from close to seek and copy current element
call seek$dir ;to the directory element
jmp wrdir ;write the directory element
;ret
;
CHECK$WILD:
;CHECK FOR ? IN FILE NAME OR TYPE
LHLD INFO
CHECK$WILD0: ; ENTRY POINT USED BY RENAME
CALL CHK$WILD! RNZ
MVI A,9! POP H ; DISCARD RETURN ADDRESS
JMP SET$ARET
;
CHK$WILD:
MVI B,03FH! MVI C,11
CHK$WILD1:
INX H! MOV A,B! SUB M! ANA B! RZ
DCR C! JNZ CHK$WILD1! ORA A! RET
;
COPY$USER$NO:
LHLD INFO! MOV A,M! LXI B,DSKMAP
DAD B! MOV M,A! RET
;
rename:
;rename the file described by the first half of
;the currently addressed file control block. the
;new name is contained in the last half of the
;currently addressed file conrol block. the file
;name and type are changed, but the reel number
;is ignored. the user number is identical
;
;VERIFIES NEW FILE NAME DOES NOT EXIST
;ALSO VERIFIES THAT NO WILD CHARS EXIST
;IN EITHER FILENAME
; **** PATCH 2.1
; Patch to get attributes as well as check for r/o disk to
; prepare for test of interface attribute F5' if file to be
; renamed has an extended lock.
CALL PATCH15
; Replaced code:
; call check$write
;VERIFY NO WILD CHARS EXIST IN 1ST FILENAME
CALL CHECK$WILD
CALL CHK$PASSWORD
;
CALL INIT$XFCB$SEARCH
;
;COPY USER NUMBER TO 2ND FILENAME
CALL COPY$USER$NO
;VERIFY NEW FILENAME DOES NOT ALREADY EXIST
SHLD SEARCHA
;
;VERIFY NO WILD CHARS EXIST IN 2ND FILENAME
CALL CHECK$WILD0
;
MVI C,EXTNUM! CALL SEARCHI1! CALL SEARCH1
JNZ FILE$EXISTS ; NEW FILENAME EXISTS
CALL DOES$XFCB$EXIST! CNZ DELETE1
;
CALL COPY$USER$NO
CALL INIT$XFCB$SEARCH
;search up to the extent field
mvi c,extnum! call search
rz
CALL CHECK$RODIR ;MAY BE READ-ONLY FILE
IF MPM
call chk$olist
ENDIF
;copy position 0
rename0:
;not end of directory, rename next element
mvi c,dskmap! mvi e,extnum! call copy$dir
;element renamed, move to next
call searchn
JNZ RENAME0
RENAME1:
CALL DOES$XFCB$EXIST! JZ COPY$DIR$LOC
CALL COPY$USER$NO! JMP RENAME0
;
indicators:
;set file indicators for current fcb
; **** PATCH 2.1
; Save attributes to prepare for test of interface attribute F5'
; in case interface attribute has an extended lock.
CALL PATCH16
; Replaced code:
; CALL GET$ATTS
mvi c,extnum! call search ;through file type
RZ
IF MPM
call chk$olist
ENDIF
indic0:
;not end of directory, continue to change
mvi c,0! mvi e,extnum ;copy name
CALL COPY$DIR2! CALL MOVE! CALL SEEK$COPY
call searchn
JZ COPY$DIR$LOC
jmp indic0
;
open:
;search for the directory entry, copy to fcb
mvi c,namlen! call search
OPEN1:
rz ;return with lret=255 if end
;not end of directory, copy fcb information
open$copy:
;(referenced below to copy fcb info)
CALL SETFWF! MOV E,A! PUSH H! DCX H! DCX H
MOV D,M! PUSH D ; SAVE EXTENT# & MODULE# WITH FCB WRITE FLAG SET
call getdptra! xchg ;HL = .buff(dptr)
lhld info ;HL=.fcb(0)
mvi c,nxtrec ;length of move operation
push d ; save .buff(dptr)
call move ;from .buff(dptr) to .fcb(0)
;note that entire fcb is copied, including indicators
pop d! lxi h,extnum! dad d ;HL=.buff(dptr+extnum)
mov c,m ;C = directory extent number
; RESTORE MODULE # AND EXTENT #
POP D! POP H! MOV M,E! DCX H! DCX H! MOV M,D
;HL = .user extent#, C = dir extent#
;above move set fcb(reccnt) to dir(reccnt)
;if fcb ext < dir ext then fcb(reccnt) = fcb(reccnt) | 128
;if fcb ext = dir ext then fcb(reccnt) = fcb(reccnt)
;if fcb ext > dir ext then fcb(reccnt) = 0
;
SET$RC: ; HL=.FCB(EXT), C=DIREXT
MVI B,0
XCHG! LXI H,(RECCNT-EXTNUM)! DAD D
LDAX D! CMP C
; ***** MP/M 2.1
; Set record count to 128 if record count = 0 and the directory
; extent (as determined by allocated blocks) is not equal to zero.
JZ PATCH00
; Replaced code
; JZ SET$RC2
MVI A,0! JNC SET$RC1
MVI A,128! MOV B,M
SET$RC1:
MOV M,A
SET$RC2:
MOV A,B! STA ACTUAL$RC
RET
;
mergezero:
;HL = .fcb1(i), DE = .fcb2(i),
;if fcb1(i) = 0 then fcb1(i) := fcb2(i)
mov a,m! inx h! ora m! dcx h! rnz ;return if = 0000
ldax d! mov m,a! inx d! inx h ;low byte copied
ldax d! mov m,a! dcx d! dcx h ;back to input form
ret
;
RESTORE$RC:
; HL = .FCB(EXTNUM)
; IF ACTUAL$RC ~= 0 THEN RCOUNT = ACTUAL$RC
PUSH H
LDA ACTUAL$RC! ORA A! JZ RESTORE$RC1
LXI D,(RECCNT-EXTNUM)! DAD D
MOV M,A
RESTORE$RC1:
POP H! RET
;
close:
;locate the directory element and re-write it
xra a! sta lret ;
IF MPM
sta dont$close
ENDIF
call nowrite! rnz ;skip close if r/o disk
;check file write flag - 0 indicates written
call getmodnum ;fcb(modnum) in A
ani fwfmsk! rnz ;return if bit remains set
CLOSE1:
CALL SET$FCB$CKS$FLAG
; **** PATCH 2.1
CALL GET$DIR$EXT! MOV C,A
MOV B,M! PUSH B
CALL CLOSE$FCB
CALL GET$DIR$EXT! POP B
CMP B! JNZ CLOSE2
CMP C! RZ
CLOSE2:
MOV M,B! MOV C,A! JMP SET$RC
patch00:
call set$rc2 ; actual$rc = 0
mov a,m! ora a! rnz ; rc ~= 0
call get$dir$ext! cmp m! rc ; dir$ext < ext
mov a,c! ora a! rz ; no blocks in fcb
lda fx! jmp patch000
CLOSE$FCB:
CALL RESTORE$RC
MOV A,B! CMP C! MOV M,C! CNZ SET$RC
XRA A! STA ACTUAL$RC! NOP
; **** Replaced code:
; CALL GETEXTA MOV A,M STA SAVE$EXT
; CALL CLOSE$FCB
; CALL GETDPTRA LXI D,EXTNUM DAD D MOV C,M
; CALL GETEXTA LDA SAVE$EXT MOV M,A
; JMP SET$RC
;CLOSE$FCB:
; CALL GET$DIR$EXT ; HL = .FCB(EXT)
; MOV B,M MOV M,A INR A SUB B JNZ CLOSE3
; ORA C JZ CLOSE3
; PUSH H LXI D,(RECCNT-EXTNUM) DAD D
; MOV A,M ORA A JNZ CLOSE2
; MVI M,80H
;CLOSE2:
; POP H
; CALL RESTORE$RC ; RESTORE FCB(RECCNT)
mvi c,namlen! call search ;locate file
rz ;return if not found
;merge the disk map at info with that at buff(dptr)
lxi b,dskmap! call getdptra
dad b! xchg ;DE is .buff(dptr+16)
lhld info! dad b ;DE=.buff(dptr+16), HL=.fcb(16)
mvi c,(fcblen-dskmap) ;length of single byte dm
merge0:
lda single! ora a! jz merged ;skip to double
;this is a single byte map
;if fcb(i) = 0 then fcb(i) = buff(i)
;if buff(i) = 0 then buff(i) = fcb(i)
;if fcb(i) <> buff(i) then error
mov a,m! ora a! ldax d! jnz fcbnzero
;fcb(i) = 0
mov m,a ;fcb(i) = buff(i)
fcbnzero:
ora a! jnz buffnzero
;buff(i) = 0
mov a,m! stax d ;buff(i)=fcb(i)
buffnzero:
cmp m! jnz mergerr ;fcb(i) = buff(i)?
jmp dmset ;if merge ok
merged:
;this is a double byte merge operation
call mergezero ;buff = fcb if buff 0000
xchg! call mergezero! xchg ;fcb = buff if fcb 0000
;they should be identical at this point
ldax d! cmp m! jnz mergerr ;low same?
inx d! inx h ;to high byte
ldax d! cmp m! jnz mergerr ;high same?
;merge operation ok for this pair
dcr c ;extra count for double byte
dmset:
inx d! inx h ;to next byte position
dcr c! jnz merge0 ;for more
;end of disk map merge, check record count
;DE = .buff(dptr)+32, HL = .fcb(32)
lxi b,-(fcblen-extnum)! dad b! xchg! dad b
;DE = .fcb(extnum), HL = .buff(dptr+extnum)
ldax d ;current user extent number
;if fcb(ext) >= buff(fcb) then
;buff(ext) := fcb(ext), buff(rec) := fcb(rec)
cmp m! JNC DMSET0
XCHG ; UPDATE FCB IN MEMORY FROM DIR FCB
DMSET0:
IF MPM
push a
ENDIF
;fcb extent number >= dir extent number
mov m,a ;buff(ext) = fcb(ext)
;update directory record count field
lxi b,(reccnt-extnum)! dad b! xchg! dad b
;DE=.buff(reccnt), HL=.fcb(reccnt)
IF MPM
;under mp/m reccnt may have been extended
;by another process - if extents match, set
;both reccnt fields to the higher value
pop a
; **** PATCH 2.1
; This patch only updates fcb(rc) if in unlocked mode.
JMP PATCH0000
DMSET05:
; Replaced Code:
; jnz dmset1
ldax d! cmp m! jc dmset1
mov m,a ; fcb(reccnt)=buff(reccnt)
dmset1:
ENDIF
mov a,m! stax d ;buff(reccnt)=fcb(reccnt)
endmerge:
IF MPM
lda dont$close! ora a! rnz
ENDIF
;SET T3' OFF INDICATING FILE UPDATE
CALL GETDPTRA! LXI D,11! DAD D
MOV A,M! ANI 7FH! MOV M,A
CALL SETFWF
jmp seek$copy ;ok to "wrdir" here - 1.4 compat
; ret ;
mergerr:
;elements did not merge correctly
CALL MAKE$FCB$INV
lxi h,lret! dcr m ;=255 non zero flag set
ret
;
SET$XDCNT:
LXI H,0FFFFH! SHLD XDCNT! RET
;
SET$DCNT$DBLK:
LHLD XDCNT! MVI A,1111$1100B! ANA L
MOV L,A! DCX H! SHLD DCNT ;
LHLD XDBLK! SHLD DBLK ;
RET
;
IF MPM
sdcnt$eq$xdcnt:
lxi h,sdcnt! lxi d,xdcnt! mvi c,4
jmp move
ENDIF
;
make:
;create a new file by creating a directory entry
;then opening the file
;
LXI H,XDCNT! CALL TEST$FFFF! JZ LRET$EQ$FF
CALL SET$DCNT$DBLK
;
call check$write ;may be write protected
lhld info! push h ; save fcb address, look for e5
lxi h,efcb! shld info ; info = .empty
mvi c,1!
;
CALL SEARCHI! CALL SEARCHN
;
;zero flag set if no space
pop h ; recall info address
shld info ;in case we return here
rz ;return with error condition 255 if not found
;
; RETURN EARLY IF MAKING AN XFCB
LDA MAKE$XFCB! ORA A! RNZ
;clear the remainder of the fcb
;CLEAR S1 BYTE
LXI D,13! DAD D! MOV M,D! INX H
;CLEAR AND SAVE FILE WRITE FLAG OF MODNUM
MOV A,M! PUSH A! PUSH H! ANI 3FH! MOV M,A! INX H
mvi c,fcblen-namlen ;number of bytes to fill
make0:
MOV M,D! inx h! dcr c! jnz make0
call setcdr ;may have extended the directory
;now copy entry to the directory
MVI C,0! LXI D,FCBLEN! CALL COPY$DIR0
;AND RESTORE THE FILE WRITE FLAG
POP H! POP A! MOV M,A
;and set the FCB write flag to "1"
XRA A! STA ACTUAL$RC
jmp setfwf
;
open$reel:
;close the current extent, and open the next one
;if possible. RMF is true if in read mode
CALL GETMODNUM! STA SAVE$MOD
CALL GETEXTA
MOV A,M! MOV C,A ;
INR C! CALL COMPEXT ;
JZ OPEN$REEL3
PUSH H! PUSH B
CALL CLOSE
POP B! POP H
LDA LRET! INR A! RZ
MVI A,MAXEXT! ANA C! MOV M,A; INCR EXTENT FIELD
JNZ OPEN$REEL0 ; JMP IF IN SAME MODULE
;
open$mod:
;extent number overflow, go to next module
INX H! INX H ;HL=.fcb(modnum)
inr m ;fcb(modnum)=++1
;module number incremented, check for overflow
;
mov a,m! ANI 3FH! ;mask high order bits
;
JZ OPEN$R$ERR ;cannot overflow to zero
;otherwise, ok to continue with new module
open$reel0:
CALL SET$XDCNT ; RESET XDCNT FOR MAKE
IF MPM
call set$sdcnt
ENDIF
mvi c,namlen! call search ;next extent found?
jnz open$reel1
;end of file encountered
lda rmf! inr a ;0ffh becomes 00 if read
jz open$r$err ;sets lret = 1
;try to extend the current file
call make
;cannot be end of directory
;call end$of$dir
jz open$r$err ;with lret = 1
IF MPM
call fix$olist$item
ENDIF
CALL SET$FCB$CKS$FLAG
jmp open$reel2
open$reel1:
;not end of file, open
CALL SET$FCB$CKS$FLAG
call open$copy
open$reel2:
call getfcb ;set parameters
xra a! STA VRECORD! jmp sta$ret ;lret = 0 ;
; ret ;with lret = 0
open$r$err:
CALL GETMODNUM! LDA SAVE$MOD! MOV M,A
; **** PATCH 2.1
; This patch restores the FCB extent field to its value
; at entry to openreel.
dcx h! dcx h! mov a,m! dcr a! ani 1fh
; Replaced code:
; CALL GETEXTA LDA SAVE$EXT
MOV M,A! CALL SET$FCB$CKS$FLAG
;cannot move to next extent of this file
call setlret1 ;lret = 1
jmp setfwf ;ensure that it will not be closed
;ret
OPEN$REEL3:
MOV M,C ; INCREMENT EXTENT FIELD
CALL GET$DIR$EXT! MOV C,A
CALL RESTORE$RC
CALL SET$RC! JMP OPEN$REEL2
;
seqdiskread:
;sequential disk read operation
mvi a,1! sta seqio
;drop through to diskread
;
diskread: ;(may enter from seqdiskread)
CALL TST$INV$FCB ; CHECK FOR VALID FCB
mvi a,true! sta rmf ;read mode flag = true (open$reel)
IF MPM
sta dont$close
ENDIF
;read the next record from the current fcb
call getfcb ;sets parameters for the read
DISKREAD0:
lda vrecord! lxi h,rcount! cmp m ;vrecord-rcount
;skip if rcount > vrecord
jc recordok
IF MPM
call test$disk$fcb! jnz diskread0
lda vrecord
ENDIF
;not enough records in the extent
;record count must be 128 to continue
cpi 128 ;vrecord = 128?
JNZ SETLRET1 ;skip if vrecord<>128
call open$reel ;go to next extent if so
; xra a sta vrecord ;vrecord=00 (DONE BY OPEN$REEL)
;now check for open ok
lda lret! ora a! JNZ SETLRET1 ;stop at eof
recordok:
;arrive with fcb addressing a record to read
call index
;error 2 if reading unwritten data
;(returns 1 to be compatible with 1.4)
call allocated ;arecord=0000?
IF MPM
jnz recordok1
call test$disk$fcb! jnz diskread0
ENDIF
JZ SETLRET1
RECORDOK1:
;record has been allocated, read it
call atran ;arecord now a disk address
call seek ;to proper track,sector
call rdbuff ;to dma address
jmp setfcb ;replace parameter
IF MPM
;
test$unlocked:
lda high$ext! ani 80h! ret
;
test$disk$fcb:
call test$unlocked! rz
lda dont$close! ora a! rz
call close1
test$disk$fcb1:
pop d
lxi h,lret! inr m! mvi a,11! jz sta$ret
mvi m,0
push d
call getrcnta! mov a,m! sta rcount ; reset rcount
xra a! sta dont$close
inr a! ret
ENDIF
;
RESET$FWF:
call getmodnum ;HL=.fcb(modnum), A=fcb(modnum)
;reset the file write flag to mark as written fcb
ani (not fwfmsk) and 0ffh ;bit reset
mov m,a ;fcb(modnum) = fcb(modnum) and 7fh
RET
;
seqdiskwrite:
;sequential disk write
mvi a,1! sta seqio
;drop through to diskwrite
;
diskwrite: ;(may enter here from seqdiskwrite above)
mvi a,false! sta rmf ;read mode flag
;write record to currently selected file
call check$write ;in case write protected
;
LDA XFCB$READ$ONLY! ORA A
MVI A,3! JNZ SET$ARET
;
LDA HIGH$EXT! ANI 0100$0000B
; Z FLAG RESET IF R/O MODE
MVI A,3! JNZ SET$ARET
;
lhld info ;HL = .fcb(0)
call check$rofile ;may be a read-only file
;
CALL TST$INV$FCB ; TEST FOR INVALID FCB
call getfcb ;to set local parameters
lda vrecord! cpi lstrec+1 ;vrecord-128
JC DISKWRITE0
CALL OPEN$REEL ;VRECORD = 128, TRY TO OPEN NEXT EXTENT
LDA LRET! ORA A! RNZ ; NO AVAILABLE FCB
DISK$WRITE0:
;
IF MPM
mvi a,0ffh! sta dont$close
disk$write1:
ENDIF
;can write the next record, so continue
call index
call allocated
IF MPM
jz diskwrite2
;if file is unlocked, verify record is not locked
;record has to be allocated to be locked
call test$unlocked! jz not$unlocked
call atran! mov c,a
lda mult$cnt! mov b,a! push b
call test$lock! pop b
mov a,c! mvi c,0! push b
jmp diskwr10
not$unlocked:
inr a
ENDIF
mvi c,0 ;marked as normal write operation for wrbuff
jnz diskwr1
IF MPM
diskwrite2:
call test$disk$fcb! jnz diskwrite1
ENDIF
;not allocated
;the argument to getblock is the starting
;position for the disk search, and should be
;the last allocated block for this file, or
;the value 0 if no space has been allocated
call dm$position
sta dminx ;save for later
lxi b,0000h ;may use block zero
ora a! jz nopblock ;skip if no previous block
;previous block exists at A
mov c,a! dcx b ;previous block # in BC
call getdm ;previous block # to HL
mov b,h! mov c,l ;BC=prev block#
nopblock:
;BC = 0000, or previous block #
call get$block ;block # to HL
;arrive here with block# or zero
mov a,l! ora h! jnz blockok
;cannot find a block to allocate
mvi a,2! jmp sta$ret ;lret=2
blockok:
CALL SET$FCB$CKS$FLAG
;allocated block number is in HL
shld arecord
xchg ;block number to DE
lhld info! lxi b,dskmap! dad b ;HL=.fcb(dskmap)
lda single! ora a ;set flags for single byte dm
lda dminx ;recall dm index
jz allocwd ;skip if allocating word
;allocating a byte value
call addh! mov m,e ;single byte alloc
jmp diskwru ;to continue
allocwd:
;allocate a word value
mov c,a! mvi b,0 ;double(dminx)
dad b! dad b ;HL=.fcb(dminx*2)
mov m,e! inx h! mov m,d ;double wd
diskwru:
;disk write to previously unallocated block
mvi c,2 ;marked as unallocated write
diskwr1:
;continue the write operation of no allocation error
;C = 0 if normal write, 2 if to prev unalloc block
;lda lret ora a rnz ;stop if non zero returned value
;ABOVE LINE REMOVED - LRET CANNOT BE NON-ZERO
push b ;save write flag
call atran ;arecord set
diskwr10:
;
MOV D,A ; SAVE LOW BYTE OF ARECORD RETURNED
; IN REGISTER A FROM ATRAN
;
lda seqio! dcr a! dcr a! jnz diskwr11 ;
pop b! push b! mov a,c! dcr a! dcr a ;
jnz diskwr11 ;old allocation
;
PUSH D ; SAVE LOW BYTE OF ARECORD ON STACK
;
lhld buffa! mov d,a ;zero buffa & fill
fill0: mov m,a! inx h! inr d! jp fill0 ;
call setdir! lhld arecord1 ;
mvi c,2 ;
fill1: shld arecord! push b! call seek! pop b ;
call wrbuff ;write fill record ;
lhld arecord! ;restore last record
mvi c,0 ;change allocate flag
lda blkmsk! mov b,a! ana l! cmp b!inx h ;
jnz fill1 ;cont until cluster is zeroed
;
POP A! STA ARECORD ; RESTORE ARECORD LOW BYTE
;
call setdata ; restore dma
diskwr11: ;
call seek ;to proper file position
pop b ;
;
LDA VRECORD! MOV B,A ; LOAD AND SAVE VRECORD
;
push b ;restore/save write flag (C=2 if new block)
;
LXI H,BLKMSK! ANA M! JZ WRITE ;
MVI C,0 ; SET C TO ZERO IF VRECORD DOES NOT LOCATE
; FIRST RECORD OF NEW BLOCK
WRITE:
;
call wrbuff ;written to disk
pop b ;C = 2 if a new block was allocated, 0 if not
;increment record count if rcount<=vrecord
MOV A,B! lxi h,rcount! cmp m ;vrecord-rcount
jc diskwr2
;rcount <= vrecord
mov m,a! inr m ;rcount = vrecord+1
IF MPM
call test$unlocked! jz write1
;for unlocked files
; rcount = rcount & (~ blkmsk) + blkmsk + 1
lda blkmsk! mov b,a! inr b! cma! mov c,a
mov a,m! dcr a! ana c! add b! mov m,a
write1:
ENDIF
mvi c,2 ;mark as record count incremented
diskwr2:
;A has vrecord, C=2 if new block or new record#
dcr c! dcr c! jnz noupdate
CALL RESET$FWF
IF MPM
call test$unlocked! jz noupdate
lda rcount! call getrcnta! mov m,a
call close
call test$disk$fcb1
ENDIF
noupdate:
;
;SET FILE WRITE FLAG IF RESET
CALL GETMODNUM! ANI 0100$0000B! JNZ DISK$WRITE3
MOV A,M! ORI 0100$0000B! MOV M,A
;RESET FCB FILE WRITE FLAG TO ENSURE T3' GETS
;RESET BY THE CLOSE FUNCTION
CALL RESET$FWF
DISK$WRITE3:
jmp setfcb ;replace parameters
;ret
;
rseek:
;random access seek operation, C=0ffh if read mode
;fcb is assumed to address an active file control block
;(modnum has been set to 1100$0000b if previous bad seek)
xra a! sta seqio ;marked as random access operation
rseek1:
push b ;save r/w flag
lhld info! xchg ;DE will hold base of fcb
lxi h,ranrec! dad d ;HL=.fcb(ranrec)
mov a,m! ani 7fh! push psw ;record number
mov a,m! ral ;cy=lsb of extent#
inx h! mov a,m! ral! ani 11111b ;A=ext#
mov c,a ;C holds extent number, record stacked
;
MOV A,M! ANI 1111$0000B! INX H! ORA M ;
RRC! RRC! RRC! RRC! MOV B,A ;
; B HOLDS MODULE #
;
; CHECK HIGH BYTE OF RAN REC <= 3
MOV A,M
ANI 1111$1100B! POP H! MVI L,6! MOV A,H ;
;
;produce error 6, seek past physical eod
jnz seekerr
;otherwise, high byte = 0, A = sought record
lxi h,nxtrec! dad d ;HL = .fcb(nxtrec)
mov m,a ;sought rec# stored away
;arrive here with B=mod#, C=ext#, DE=.fcb, rec stored
;the r/w flag is still stacked. compare fcb values
;
;CHECK MODULE # FIRST
PUSH D! CALL CHK$INV$FCB! POP D! JZ RANCLOSE
lxi h,modnum! dad d! mov a,b ;B=seek mod#
;could be overflow at eof, producing module#
;of 90H or 10H, so compare all but fwf
sub m! ani 3fh! JNZ RANCLOSE ;same?
;MODULE MATCHES, CHECK EXTENT
lxi h,extnum! dad d
MOV A,M! CMP C! JZ SEEKOK1 ;EXTENTS EQUAL
CALL COMPEXT! JNZ RANCLOSE
;EXTENT IS IN SAME DIRECTORY FCB
; **** PATCH 2.1
; This patch intercepts attempts to read beyond written extents
; in the current dir fcb and returns error code 1 if so.
call patch0
mov m,c! mov c,a
; Removed code:
; MOV M,C ; FCB(EXT) = C
; CALL GET$DIR$EXT
; MOV C,A
; HL=.FCB(EXT),C=DIR EXT
CALL RESTORE$RC
CALL SET$RC
JMP SEEKOK1
ranclose:
push b! push d ;save seek mod#,ext#, .fcb
call close ;current extent closed
pop d! pop b ;recall parameters and fill
mvi l,3 ;cannot close error #3
lda lret! inr a
; **** PATCH 2.1
; No longer invalidate fcb.
jz seekerr
; Removed code:
; jz badseek
CALL SET$XDCNT ; RESET XDCNT FOR MAKE
IF MPM
call set$sdcnt
ENDIF
lxi h,extnum! dad d
; **** PATCH 2.1
; This patch keeps the fcb valid while returning
; the proper error code.
push h! mov d,m
mov m,c ;fcb(extnum)=ext#
INX H! INX H! MOV A,M
mov e,a! push d
ANI 040H! ORA B! MOV M,A
;fcb(modnum)=mod#
call open ;is the file present?
lda lret! inr a! jnz seekok ;open successful?
;cannot open the file, read mode?
pop d! pop h! pop b ;r/w flag to c (=0ffh if read)
push b! push h! push d ;everyone expects this item stacked
mvi l,4 ;seek to unwritten extent #4
inr c ;becomes 00 if read operation
jz badseek ;skip to error if read operation
;write operation, make new extent
call make
jmp patch01
; Removed code:
; mov m,c ;fcb(extnum)=ext#
; INX H INX H MOV A,M ANI 040H ORA B MOV M,A
; ;fcb(modnum)=mod#
; call open ;is the file present?
; lda lret inr a jnz seekok ;open successful?
; ;cannot open the file, read mode?
; pop b ;r/w flag to c (=0ffh if read)
; push b ;everyone expects this item stacked
; mvi l,4 ;seek to unwritten extent #4
; inr c ;becomes 00 if read operation
; jz badseek ;skip to error if read operation
; ;write operation, make new extent
; call make
; mvi l,5 ;cannot create new extent #5
; jz badseek ;no dir space
IF MPM
; call fix$olist$item
ENDIF
; ;file make operation successful
; seekok:
; CALL SET$FCB$CKS$FLAG
SEEKOK1:
pop b ;discard r/w flag
xra a! jmp sta$ret ;with zero set
badseek:
;fcb no longer contains a valid fcb, mark
;with 1100$000b in modnum field so that it
;appears as overflow with file write flag set
; **** PATCH 2.1
; No longer invalidate fcb.
pop d! xthl
mov m,d! inx h! inx h! mov m,e
pop h! nop
; Removed code:
; push h ;save error flag
; CALL SET$FCB$CKS$FLAG
; CALL MAKE$FCB$INV ; FLAG FCB AS INVALID
; pop h ;and drop through
seekerr:
pop b ;discard r/w flag
mov a,l! sta lret ;lret=#, nonzero
;setfwf returns non-zero accumulator for err
RET ; FOLLOWING LINE REMOVED
; jmp setfwf ;flag set, so subsequent close ok
;ret
;
randiskread:
;random disk read operation
mvi c,true ;marked as read operation
call rseek
cz diskread ;if seek successful
ret
;
randiskwrite:
;random disk write operation
mvi c,false ;marked as write operation
call rseek
cz diskwrite ;if seek successful
ret
;
compute$rr:
;compute random record position for getfilesize/setrandom
xchg! dad d
;DE=.buf(dptr) or .fcb(0), HL = .f(nxtrec/reccnt)
mov c,m! mvi b,0 ;BC = 0000 0000 ?rrr rrrr
lxi h,extnum! dad d! mov a,m! rrc! ani 80h ;A=e000 0000
add c! mov c,a! mvi a,0! adc b! mov b,a
;BC = 0000 000? errrr rrrr
mov a,m! rrc! ani 0fh! add b! mov b,a
;BC = 000? eeee errrr rrrr
lxi h,modnum! dad d! mov a,m ;A=XXmm mmmm
add a! add a! add a! add a ;cy=m A=mmmm 0000
;
ORA A! ADD B! MOV B,A! PUSH PSW ; SAVE CARRY
MOV A,M! RAR! RAR! RAR! RAR! ANI 0000$0011B ; A=0000 00mm
MOV L,A! POP PSW! MVI A,0! ADC L ; ADD CARRY
RET ;
;
getfilesize:
;compute logical file size for current fcb
;zero the receiving ranrec field
CALL GET$RRA! push h ;save position
mov m,d! inx h! mov m,d! inx h! mov m,d;=00 00 00
MVI C,EXTNUM! CALL SEARCH
getsize:
jz setsize
;current fcb addressed by dptr
call getdptra! lxi d,reccnt ;ready for compute size
call compute$rr
;A=0000 00mm BC = mmmm eeee errr rrrr
;compare with memory, larger?
pop h! push h ;recall, replace .fcb(ranrec)
mov e,a ;save cy
mov a,c! sub m! inx h ;ls byte
mov a,b! sbb m! inx h ;middle byte
mov a,e! sbb m ;carry if .fcb(ranrec) > directory
jc getnextsize ;for another try
;fcb is less or equal, fill from directory
mov m,e! dcx h! mov m,b! dcx h! mov m,c
getnextsize:
call searchn
MVI A,0! STA ARET
jmp getsize
setsize:
pop h ;discard .fcb(ranrec)
ret
;
setrandom:
;set random record from the current file control block
XCHG! lxi d,nxtrec ;ready params for computesize
call compute$rr ;DE=info, A=0000 00mm, BC=mmmm eeee errr rrrr
lxi h,ranrec! dad d ;HL = .fcb(ranrec)
mov m,c! inx h! mov m,b! inx h! mov m,a ;to ranrec
ret
;
TMPSELECT:
LXI H,SELDSK! MOV A,M! PUSH A! MOV M,E
CALL CURSELECT! POP A! STA SELDSK! RET
;
XCURSELECT:
MVI A,0FFH! STA RETURN$FFFF
CALL CURSELECT
XRA A! STA RETURN$FFFF! RET
;
CURSELECT:
LDA SELDSK!
LXI H,CURDSK! CMP M! JZ TEST$FF$DSK
;SKIP IF SELDSK = CURDSK, FALL INTO SELECT
;
select:
;select disk info for subsequent input or output ops
lhld dlog! CALL TEST$VECTOR
MOV E,A! PUSH D ;SEND TO SELDSK, SAVE FOR TEST BELOW
call selectdisk! pop h ;recall dlog vector
cz sel$error ;returns true if select ok
;is the disk logged in?
mov a,l! ORA A
IF MPM
jz select1
lhld rlog! call test$vector
sta rem$drv! ret ; set rem$drv & return
select1:
ELSE
rnz ;return if bit is set
ENDIF
;disk not logged in, set bit and initialize
lhld dlog! mov c,l! mov b,h ;call ready
call set$cdisk! shld dlog ;dlog=set$cdisk(dlog)
IF MPM
lxi h,chksiz+1! mov a,m! ral! mvi a,0! jc select2
lhld rlog! mov c,l! mov b,h
call set$cdisk! shld rlog ;rlog=set$cdisk(rlog)
mvi a,1
select2:
sta rem$drv
ENDIF
jmp initialize
;ret
;
TEST$FF$DSK:
INR A! JZ SEL$ERROR
RET
;
SET$SELDSK:
LDA LINFO! STA SELDSK! RET
;
RESELECTX:
XRA A! STA HIGH$EXT! JMP RESELECT1
reselect:
;check current fcb to see if reselection necessary
MVI A,80H! MOV B,A! DCR A! MOV C,A
LHLD INFO! LXI D,7! XCHG! DAD D
MOV A,M! ANA B! STA XFCB$READ$ONLY
MOV A,M! ANA C! MOV M,A
INX H! LXI D,4
MOV A,M! ANA C! CMP M! MOV M,A! MVI A,60H! JNZ RESELECT0
DAD D! MVI A,0E0H! ANA M
RESELECT0:
STA HIGH$EXT! CALL CLR$EXT
CALL GETRCNTA! MOV A,M! ANA B! JZ RESELECT1
MOV A,M! ANA C! MOV M,B
RESELECT1:
STA ACTUAL$RC
mvi a,true! sta resel ;mark possible reselect
lhld info! mov a,m ;drive select code
ani 1$1111b ;non zero is auto drive select
dcr a ;drive code normalized to 0..30, or 255
sta linfo ;save drive code
CPI 0FFH! JZ NOSELECT
;auto select function, save SELDSK
LDA SELDSK! sta olddsk ;olddsk=SELDSK
mov a,m! sta fcbdsk ;save drive code
ani 1110$0000b! mov m,a ;preserve hi bits
CALL SET$SELDSK
noselect:
CALL CURSELECT
;set user code
lda usrcode ;0...31
lhld info! ora m! mov m,a
ret
;
CHK$PASSWORD:
CALL GET$DIR$MODE! ANI 80H! JNZ CHK$PW! RET
;
GET$DIR$MODE:
LHLD DRVLBLA! MOV A,M! RET
;
CHK$PW: ; CHECK PASSWORD
CALL GET$XFCB! RZ ; A = XFCB OPTIONS
DCR A! CNZ CMP$PW! RZ
CHK$PW1: ; PASSWORD ERROR
POP H! MVI A,7! JMP SET$ARET
;
CMP$PW: ; COMPARE PASSWORDS
INX H! MOV B,M
MOV A,B! ORA A! JNZ CMP$PW2
MOV D,H! MOV E,L! INX H! INX H
MVI C,9
CMP$PW1:
INX H! MOV A,M! DCR C! RZ
ORA A! JZ CMP$PW1
CPI 20H! JZ CMP$PW1
XCHG
CMP$PW2:
LXI D,(23-UBYTES)! DAD D! XCHG
LHLD XDMAAD! MVI C,8
CMP$PW3:
LDAX D! XRA B! CMP M! JNZ CMP$PW4
DCX D! INX H! DCR C! JNZ CMP$PW3
RET
CMP$PW4:
DCX D! DCR C! JNZ CMP$PW4
INX D
IF MPM
call get$df$pwa! inr a! jnz cmp$pw5
inr a! ret
cmp$pw5:
ELSE
LXI H,DF$PASSWORD
ENDIF
MVI C,8! JMP COMPARE
;
IF MPM
get$df$pwa: ;A = FF => no df pwa
call rlr! lxi b,console
; **** PATCH 2.1
; This patch corrects an error associated with accessing and
; setting the default password when the current list device
; was non-zero. The list device number resides in the high
; order nibble of the console field in the process descriptor.
; In addition, the default password for consoles 14 and 15 have been
; removed to increase the patch area.
jmp patch00000
; Replaced code:
; dad b mov a,m
; cpi 16 mvi a,0ffh rnc mov a,m
; add a add a add a
; mvi h,0 mov l,a lxi b,dfpassword
; dad b
; ret
ENDIF
; PATCH 2.1
; This patch is part of the ranclose patch.
; stuck here because it fits
patch01:
mvi l,5 ;cannot create new extent #5
jz badseek ;no dir space
IF MPM
call fix$olist$item
ENDIF
;file make operation successful
seekok:
pop b! pop b
CALL SET$FCB$CKS$FLAG
jmp seekok1
;
SET$PW: ; SET PASSWORD IN XFCB
PUSH H ; SAVE .XFCB(EX)
LXI B,8 ; B = 0, C = 8
LXI D,(23-EXTNUM)! DAD D
XCHG! LHLD XDMAAD
SET$PW0:
XRA A! PUSH A
SET$PW1:
MOV A,M! STAX D! ORA A! JZ SET$PW2
CPI 20H! JZ SET$PW2
INX SP! INX SP! PUSH A
SET$PW2:
ADD B! MOV B,A
DCX D! INX H! DCR C! JNZ SET$PW1
POP A! ORA B! POP H! JNZ SET$PW3
MOV M,A ; ZERO XFCB(EX) - NO PASSWORD
SET$PW3:
INX D! MVI C,8
SET$PW4:
LDAX D! XRA B! STAX D! INX D! DCR C! JNZ SET$PW4
INX H! RET
;
GET$XFCB:
MVI B,0
GET$XFCB0:
LHLD INFO! MOV A,M! PUSH A
ORI 010H! MOV M,A! MVI C,EXTNUM
XRA A! CMP B! JNZ GET$XFCB00
CALL SEARCH! JMP GET$XFCB01
GET$XFCB00:
CALL SEARCHN
GET$XFCB01:
MVI A,0! STA LRET
LHLD INFO! POP B! MOV M,B! RZ
GET$XFCB1:
CALL GETDPTRA! XCHG
LXI H,EXTNUM! DAD D! MOV A,M! ANI 0E0H! ORI 1
RET
;
ADJUST$DMAAD:
PUSH H! LHLD XDMAAD! DAD D
SHLD XDMAAD! POP H! RET
;
INIT$XFCB:
CALL SETCDR ;MAY HAVE EXTENDED THE DIRECTORY
LXI B,1014H ; B=10H, C=20
INIT$XFCB0:
;B = FCB(0) LOGICAL OR MASK
;C = ZERO COUNT
PUSH B
CALL GETDPTRA! XCHG! LHLD INFO! XCHG
;ZERO EXTNUM AND MODNUM
LDAX D! ORA B! MOV M,A! INX D! INX H
MVI C,11! CALL MOVE! POP B! INR C
INIT$XFCB1:
DCR C! RZ
MVI M,0! INX H! JMP INIT$XFCB1
;
CHK$XFCB$PASSWORD:
CALL GET$XFCB1! DCR A
CHK$XFCB$PASSWORD1:
PUSH H! CNZ CMP$PW! POP H! RZ
JMP CHK$PW1
;
CHK$PWS:
CALL GET$DIR$MODE! ANI 80H! RZ
CALL GET$XFCB
CHK$PWS1:
RZ! DCR A
CNZ CMP$PW! RNZ
MVI B,1! CALL GET$XFCB0! JMP CHK$PWS1
;
STAMP1:
LXI B,24! JMP STAMP3
STAMP2:
LXI B,28!
STAMP3:
;
IF MPM
push b!
call get$stamp$add! xchg
pop b
ELSE
LXI D,STAMP
ENDIF
CALL GETDPTRA! DAD B
MVI C,4! JMP MOVE ;RET
;
IF MPM
;
pack$sdcnt:
;
;packed$dcnt = dblk(low 15 bits) || dcnt(low 9 bits)
;
; if sdblk = 0 then dblk = shr(sdcnt,blkshf+2)
; else dblk = sdblk
; dcnt = sdcnt & (blkmsk || '11'b)
;
; packed$dcnt format (24 bits)
;
; 12345678 12345678 12345678
; 23456789 .......1 ........ sdcnt (low 9 bits)
; ........ 9abcdef. 12345678 sdblk (low 15 bits)
;
lhld sdblk! mov a,h! ora l! jnz pack$sdcnt1
lda blkshf! adi 2! mov c,a! lhld sdcnt
call hlrotr
pack$sdcnt1:
dad h! xchg! lxi h,sdcnt! mvi b,1
lda blkmsk! ral! ora b! ral! ora b
ana m! sta packed$dcnt
lda blkshf! cpi 7! jnz pack$sdcnt2
inx h! mov a,m! ana b! jz pack$sdcnt2
mov a,e! ora b! mov e,a
pack$sdcnt2:
xchg! shld packed$dcnt+1
ret
;
;
;olist element = link(2) || atts(1) || dcnt(3) ||
; pdaddr(2) || opncnt(2)
;
; link = 0 -> end of list
;
; atts - 80 - open in locked mode
; 40 - open in unlocked mode
; 20 - open in read/only mode
; 10 - deleted item
; 0n - drive code (0-f)
;
; dcnt = packed sdcnt+sdblk
; pdaddr = process descriptor addr
; opncnt = # of open calls - # of close calls
; olist item freed by close when opncnt = 0
;
;llist element = link(2) || drive(1) || arecord(3) ||
; pdaddr(2) || .olist$item(2)
;
; link = 0 -> end of list
;
; drive - 0n - drive code (0-f)
;
; arecord = record number of locked record
; pdaddr = process descriptor addr
; .olist$item = address of file's olist item
;
search$olist:
lxi h,open$root! jmp srch$list0
search$llist:
lxi h,lock$root! jmp srch$list0
searchn$list:
lhld cur$pos
srch$list0:
shld prv$pos
;
;search$olist, search$llist, searchn$list conventions
;
; B = 0 -> return next item
; B = 1 -> search for matching drive
; B = 3 -> search for matching dcnt
; B = 5 -> search for matching dcnt + pdaddr
; if found then z flag is set
; prv$pos -> previous list element
; cur$pos -> found list element
; HL -> found list element
; else prv$pos -> list element to insert after
;
; olist and llist are maintained in drive order
;
srch$list1:
mov e,m! inx h! mov d,m! xchg
mov a,l! ora h! jz srch$list3
xra a! cmp b! jz srch$list6
inx h! inx h!
lxi d,curdsk! mov a,m! ani 0fh! mov c,a
ldax d! sub c! jnz srch$list4
mov a,b! dcr a! jz srch$list5
mov c,b! push h
inx d! inx h! call compare
pop h! jz srch$list5
srch$list2:
dcx h! dcx h
shld prv$pos! jmp srch$list1
srch$list3:
inr a! ret
srch$list4:
jnc srch$list2
srch$list5:
dcx h! dcx h
srch$list6:
shld cur$pos! ret
;
delete$item: ; HL -> item to be deleted
di
push d! push h
mov e,m! inx h! mov d,m
lhld prv$pos! shld cur$pos
;prv$pos.link = delete$item.link
mov m,e! inx h! mov m,d
;
lhld free$root! xchg
;free$root = .delete$item
pop h! shld free$root
;delete$item.link = previous free$root
mov m,e! inx h! mov m,d
pop d! ei! ret
;
create$item: ; HL -> new item if successful
; Z flag set if no free items
lhld free$root! mov a,l! ora h! rz
push d! push h! shld cur$pos
mov e,m! inx h! mov d,m
;free$root = free$root.link
xchg! shld free$root
;
lhld prv$pos
mov e,m! inx h! mov d,m
pop h
;create$item.link = prv$pos.link
mov m,e! inx h! mov m,d! dcx h
xchg! lhld prv$pos
;prv$pos.link = .create$item
mov m,e! inx h! mov m,d! xchg
pop d! ret
;
set$olist$item:
; A = attributes
; HL = olist entry address
inx h! inx h
mov b,a! lxi d,curdsk! ldax d! ora b
mov m,a! inx h! inx d
mvi c,5! call move
xra a! mov m,a! inx h! mov m,a! ret
;
set$sdcnt:
mvi a,0ffh! sta sdcnt+1! ret
;
tst$olist:
mvi a,0c9h! sta chk$olist05! jmp chk$olist0
chk$olist:
xra a! sta chk$olist05
chk$olist0:
lxi d,dcnt! lxi h,sdcnt! mvi c,4! call move
call pack$sdcnt! mvi b,3! call search$olist! rnz
; **** PATCH 2.1
; Part of following patch
NOP
; Replaced code:
; pop d ; pop return address
inx h! inx h
; **** PATCH 2.1
; If in compatibility mode F1', R/O mode is default open mode;
; otherwise default is locked mode. Branch to openx06
; if the open mode is not the default mode.
CALL GET$CMP$MODE! CALL PATCH3
; Replaced code:
; mov a,m ani 80h jz openx06
dcx h! dcx h
; **** PATCH 2.1
; Verify another process does not have the file open
; in case the default open mode is r/o as a result of
; comp att F1' = 1. Patch13 sets DE to the lock list item
; addr and HL to the lock list item opencnt field addr
; for PATCH14. The XTHL following CALL COMPARE$PDS
; restores HL and puts the address of the opencnt field
; on the stack.
PUSH H
CALL COMPARE$PDS! XTHL! JNZ OPENX06
CALL PATCH13
; Replaced code:
; push d push h
; call compare$pds pop h pop d jnz openx06
; push d
chk$olist05:
nop ; tst$olist changes this instr to ret
; **** PATCH 2.1
; This patch tests to see if the lock list item is
; extended and if the interface attribute requesting
; that the lock continue to be extended is set. If so,
; control is returned to the routine calling chk$olist.
; Otherwise, the lock item is deleted. If the lock item
; is not an extended lock, the process's PDCNT is advanced.
CALL PATCH14
; Replaced code:
; call delete$item
lda pdcnt
chk$olist1:
adi 16! jz chk$olist1
sta pdcnt
push a! call rlr
lxi b,pdcnt$off! dad b! pop a
mov m,a
ret
;
remove$files: ;BC = pdaddr
lhld cur$pos! push h
lhld prv$pos! push h
mov d,b! mov e,c! lxi h,open$root! shld cur$pos
remove$file1:
mvi b,0! push d! call searchn$list! pop d! jnz remove$file2
lxi b,6! call tst$tbl$lmt! jnz remove$file1
inx h! inx h! mov a,m! ori 10h! mov m,a
sta deleted$files
jmp remove$file1
remove$file2:
pop h! shld prv$pos
pop h! shld cur$pos
ret
;
delete$files:
lxi h,open$root! shld cur$pos
delete$file1:
mvi b,0! call search$nlist! rnz
inx h! inx h! mov a,m! ani 10h! jz delete$file1
dcx h! dcx h! call remove$locks! call delete$item
jmp delete$file1
;
flush$files:
lxi h,flushed! mov a,m! ora a! rnz
inr m
flush$file0:
lxi h,open$root! shld cur$pos
flush$file1:
mvi b,1! call searchn$list! rnz
push h! call remove$locks! call delete$item! pop h
lxi d,6! dad d! mov e,m! inx h! mov d,m
lxi h,pdcnt$off! dad d! mov a,m! ani 1! jnz flush$file1
mov a,m! ori 1! mov m,a
lhld pdaddr! mvi c,2! call compare! jnz flush$file1
lda pdcnt! adi 10h! sta pdcnt! jmp flush$file1
;
free$files:
; free$mode = 1 - remove curdsk files for process
; 0 - remove all files for process
lhld pdaddr! xchg! lxi h,open$root! shld curpos
free$files1:
lda free$mode! mov b,a
push d! call searchn$list! pop d! rnz
lxi b,6! call tst$tbl$lmt! jnz free$files1
push h! inx h! inx h! inx h
call test$ffff! jnz free$files2
call test$ffff! jz free$files3
free$files2:
mvi a,0ffh! sta incr$pdcnt
free$files3:
pop h! call remove$locks! call delete$item
jmp free$files1
;
remove$locks:
shld file$id
inx h! inx h! mov a,m! ani 40h! jz remove$lock3
push d! lhld prv$pos! push h
lhld file$id! xchg! lxi h,lock$root! shld cur$pos
remove$lock1:
mvi b,0! push d! call searchn$list! pop d
jnz remove$lock2
lxi b,8! call tst$tbl$lmt! jnz remove$lock1
call delete$item
jmp remove$lock1
remove$lock2:
pop h! shld prv$pos! pop d
remove$lock3:
lhld file$id! ret
;
tst$tbl$lmt:
push h! dad b
mov a,m! inx h! mov h,m
sub e! jnz tst$tbl$lmt1
mov a,h! sub d
tst$tbl$lmt1:
pop h! ret
;
create$olist$item:
mvi b,1! call search$olist
di
call create$item! lda attributes! call set$olist$item
ei
ret
;
count$opens:
xra a! sta open$cnt
lhld pdaddr! xchg! lxi h,open$root! shld curpos
count$open1:
mvi b,0! push d! call searchn$list! pop d! jnz count$open2
lxi b,6! call tst$tbl$lmt! jnz count$open1
lda open$cnt! inr a! sta open$cnt
jmp count$open1
count$open2:
lxi h,open$max! lda open$cnt! ret
;
count$locks:
xra a! sta lock$cnt
xchg! lxi h,lock$root! shld cur$pos
count$lock1:
mvi b,0! push d! call searchn$list! pop d! rnz
lxi b,8! call tst$tbl$lmt! jnz count$lock1
lda lock$cnt! inr a! sta lock$cnt
jmp count$lock1
;
check$free:
lda mult$cnt! mov e,a
mvi d,0! lxi h,free$root! shld cur$pos
check$free1:
mvi b,0! push d! call searchn$list! pop d! jnz check$free2
inr d! mov a,d! sub e! jc check$free1
ret
check$free2:
pop h! mvi a,14! jmp sta$ret
;
lock: ;record lock and unlock
call reselect! call check$fcb
call test$unlocked
rz ; file not opened in unlocked mode
lhld xdmaad! mov e,m! inx h! mov d,m
xchg! inx h! inx h
mov a,m! mov b,a! lda curdsk! sub b
ani 0fh! jnz lock8 ; invalid file id
mov a,b! ani 40h! jz lock8 ; invalid file id
dcx h! dcx h! shld file$id
lda lock$unlock! inr a! jnz lock1 ; jmp if unlock
call count$locks
lda lock$cnt! mov b,a
lda mult$cnt! add b! mov b,a
lda lock$max! cmp b
mvi a,12! jc sta$ret ; too many locks by this process
call check$free
lock1:
call save$rr! lxi h,lock9! push h! lda mult$cnt
lock2:
push a! call get$lock$add
lda lock$unlock! inr a! jnz lock3
call test$lock
lock3:
pop a! dcr a! jz lock4
call incr$rr! jmp lock2
lock4:
call reset$rr! lda mult$cnt
lock5:
push a! call get$lock$add
lda lock$unlock! inr a! jnz lock6
call set$lock! jmp lock7
lock6:
call free$lock
lock7:
pop a! dcr a! rz
call incr$rr! jmp lock5
lock8:
mvi a,13! jmp sta$ret ; invalid file id
lock9:
call reset$rr! ret
;
get$lock$add:
lxi h,0! dad sp! shld lock$sp
; **** PATCH 2.1
; This patch sets Reg. C to FFh
; for call to RSEEK
lxi h,lock$shell
mvi c,0ffh ! mov m,c ! push h
call rseek
pop h ! inr m
; Replaced code:
; mvi a,0ffh sta lock$shell
; call rseek
; xra a sta lock$shell
call getfcb
lhld aret! mov a,l! ora a! jnz lock$err
; **** PATCH 2.1
; Verify that block has not been allocated by another
; process before returning error code 1 (reading unwritten data)
CALL PATCH11! CALL PATCH12! JZ LOCK$ERR
CALL PATCH11! JMP LOCK$ERR
; Replaced code:
; call index call allocated
; lxi h,1 jz lock$err
; call atran
ret
;
lock$perr:
xra a! sta lock$shell
xchg! lhld lock$sp! sphl! xchg
lock$err:
pop d ; discard return address
pop b ; B = mult$cnt-# recs processed
lda mult$cnt! sub b
add a! add a! add a! add a
ora h! mov h,a! mov b,a
shld aret! ret
;
test$lock:
call move$arecord
mvi b,3! call search$llist! rnz
call compare$pds! rz
lxi h,8! jmp lock$err
;
set$lock:
call move$arecord
mvi b,1! call search$llist
di
call create$item
xra a! call set$olist$item
xchg! lhld file$id! xchg
mov m,d! dcx h! mov m,e
ei! ret
;
free$lock:
call move$arecord
mvi b,5! call search$llist! rnz
free$lock0:
call delete$item
mvi b,5! call searchn$list! rnz
jmp free$lock0
;
compare$pds:
lxi d,6! dad d
; **** PATCH 2.1
; Changed for chk$olist patch
NOP! LXI D,PDADDR
; Replaced code:
; xchg lxi h,pdaddr
mvi c,2! jmp compare
;ret
;
move$arecord:
lxi d,arecord! lxi h,packed$dcnt
mvi c,3! jmp move ;ret
;
fix$olist$item:
lxi d,xdcnt! lxi h,sdcnt
;is xdblk,xdcnt < sdblk,sdcnt
mvi c,4! ora a!
fix$ol1:
ldax d! sbb m! inx h! inx d! dcr c! jnz fix$ol1
rnc
;yes - update olist entry
call swap! call sdcnt$eq$xdcnt
lxi h,open$root! shld cur$pos
;find file's olist entry
fix$ol2:
call swap! call pack$sdcnt! call swap
mvi b,3! call searchn$list! rnz
;update olist entry with new dcnt value
push h! call pack$sdcnt! pop h
inx h! inx h! inx h! lxi d,packed$dcnt
mvi c,3! call move! jmp fix$ol2
;
hl$eq$hl$and$de:
mov a,l! ana e! mov l,a
mov a,h! ana d! mov h,a
ret
;
remove$drive:
xchg! lda curdsk! mov c,a! lxi h,1
call hlrotl
mov a,l! cma! ana e! mov e,a
mov a,h! cma! ana d! mov d,a
xchg! ret
;
diskreset:
lxi h,0! shld ntlog
xra a! sta set$ro$flag
lhld info
intrnldiskreset:
xchg! lhld open$root! mov a,h! ora l! rz
xchg! lda curdsk! push a! mvi b,0
dskrst1:
mov a,l! rar! jc dskrst3
dskrst2:
mvi c,1! call hlrotr! inr b
mov a,h! ora l! jnz dskrst1
pop a! sta curdsk
lhld ntlog! xchg! lhld tlog
mov a,l! ora e! mov l,a
mov a,h! ora d! mov h,a! shld tlog
; **** PATCH 2.1
; Patch to return with Z flag reset in all cases
INR B
; Replaced code:
; inr a
ret
dskrst3:
push b! push h! mov a,b
; **** PATCH 2.1
; compute shiftr(tlog,curdsk) and push result on stack
CALL PATCH8
; Replaced code:
; sta curdsk
lhld rlog! call test$vector1! push a
lhld rodsk! lda curdsk! call test$vector1! mov b,a
pop h! lda set$ro$flag! ora b! ora h
; **** PATCH 2.1
; ORA with shiftr(tlog,curdsk) value pushed on stack
; and store result in check$disk
CALL PATCH9
; Replaced code:
; sta check$disk
lxi h,open$root! shld cur$pos
dskrst4:
mvi b,1! call searchn$list! jnz dskrst6
lda check$disk! ora a! jz dskrst5
push h! call compare$pds! jz dskrst45
pop h! xra a! xchg! jmp dskrst6
dskrst45:
lhld ntlog! mov b,h! mov c,l
lda curdsk! call set$cdisk1! shld ntlog
pop h! jmp dskrst4
dskrst5:
lhld info! call remove$drive! shld info
ori 1
dskrst6:
pop h! pop b! jnz dskrst2
;error - olist item exists for another process
;for removable drive to be reset
pop a! sta curdsk! mov a,b! adi 41h ; A = ASCII drive
lxi h,6! dad d! mov c,m! inx h! mov b,m ; BC = pdaddr
push psw! call test$error$mode! pop d! jnz dskrst7
mov a,d
push b! push psw
call rlr! lxi d,console! dad d! mov d,m ;D = console #
lxi b,deniedmsg! call xprint
pop psw! mov c,a! call conoutx
mvi c,':'! call conoutx
lxi b,cnsmsg! call xprint
pop h! push h! lxi b,console! dad b
mov a,m! adi '0'! mov c,a! call conoutx
lxi b,progmsg! call xprint
pop h! call dsplynm
dskrst7:
pop h ;remove return addr from diskreset
lxi h,0ffffh! shld aret ;flag the error
ret
;
deniedmsg:
db cr,lf,'Disk reset denied, Drive ',0
cnsmsg:
db ' Console ',0
progmsg:
db ' Program ',0
;
;
ENDIF
;
; individual function handlers
func12:
;return version number
IF MPM
lxi h,0100h+dvers! jmp sthl$ret
ELSE
mvi a,dvers! jmp sta$ret ;lret = dvers (high = 00)
ENDIF
; ret ;jmp goback
;
func13:
IF MPM
; **** PATCH 2.1
; Test all drives, not just logged in drives, because
; some drives may be in TLOG state.
LXI H,0FFFFH
; Replaced code:
; lhld dlog
shld info
call diskreset! jz reset$all
call reset$37
jmp func13$cont
reset$all:
ENDIF
;reset disk system - initialize to disk 0
lxi h,0! shld rodsk! shld dlog
IF MPM
shld rlog! shld tlog
func13$cont:
ENDIF
xra a! STA SELDSK ;note that usrcode remains unchanged
DCR A! STA CURDSK
IF MPM
xra a! call getmemseg ;A = mem seg tbl index
ora a! rz
inr a! rz
call rlradr! lxi b,msegtbl-rlros! dad b
add a! add a! mov e,a! mvi d,0! dad d
mov h,m! mvi l,80h
jmp intrnlsetDMA
ELSE
lxi h,tbuff! shld dmaad ;dmaad = tbuff
JMP SETDATA ;to data dma address
ENDIF
;ret ;jmp goback
;
func14:
;select disk info
CALL SET$SELDSK ; SELDSK = LINFO
IF MPM
call curselect
call rlr! lxi b,diskselect! dad b
mov a,m! ani 0fh! rrc! rrc! rrc! rrc
mov b,a! lda seldsk! ora b! rrc! rrc! rrc! rrc
mov m,a! ret
ELSE
JMP CURSELECT
ENDIF
;ret ;jmp goback
;
func15:
;open file
call clrmodnum ;clear the module number
call reselect
IF MPM
xra a! sta make$flag
call set$sdcnt
lxi h,open$file! push h
mvi a,0c9h! sta check$fcb4
call check$fcb1
pop h! lda high$ext! cpi 060h! jnz open$file
call home! call set$end$dir
jmp open$user$zero
open$file:
lhld info! lda usrcode! mov m,a
call set$sdcnt
ENDIF
CALL RESET$CHKSUM$FCB ; SET INVALID CHECK SUM
CALL CHECK$WILD ; CHECK FOR WILD CHARS IN FCB
CALL GET$ATTS! ANI 1100$0000B ; A = ATTRIBUTES
IF MPM
cpi 1100$0000b! jnz att$ok
ENDIF
ANI 0100$0000B ; MASK OFF UNLOCK MODE
ATT$OK:
STA HIGH$EXT
IF MPM
mov b,a! ora a! rar! jnz att$set
mvi a,80h
att$set:
sta attributes! mov a,b
ENDIF
ANI 80H! JNZ CALL$OPEN
LDA USRCODE! ORA A! JZ CALL$OPEN
MVI A,0FEH! STA XDCNT+1! INR A! STA SEARCH$USER0
IF MPM
sta sdcnt0+1
ENDIF
;
CALL$OPEN:
CALL OPEN! CALL OPENX ; RETURNS IF UNSUCCESSFUL, A = 0
LXI H,SEARCH$USER0! CMP M! RZ
MOV M,A! LDA XDCNT+1! CPI 0FEH! RZ
;
; FILE EXISTS UNDER USER 0
;
IF MPM
call swap
ENDIF
CALL SET$DCNT$DBLK
MVI A,0110$0000B! STA HIGH$EXT
OPEN$USER$ZERO:
; SET FCB USER # TO ZERO
LHLD INFO! MVI M,0
MVI C,NAMLEN! CALL SEARCHI! CALL SEARCHN
CALL OPEN1 ; ATTEMPT REOPEN UNDER USER ZERO
CALL OPENX ; OPENX RETURNS ONLY IF UNSUCCESSFUL
RET
OPENX:
CALL END$OF$DIR! RZ
; OPEN SUCCESSFUL
POP H ; DISCARD RETURN ADDRESS
; WAS FILE OPENED UNDER USER 0 AFTER UNSUCCESSFUL
; ATTEMPT TO OPEN UNDER USER N
IF MPM
LDA HIGH$EXT! CPI 060H! JZ OPENX00 ;YES
; WAS FILE OPENED IN LOCKED MODE?
ORA A! JNZ OPENX0 ; NO
; DOES USER = ZERO?
LHLD INFO! ORA M! JNZ OPENX0 ; NO
; DOES FILE HAVE READ/ONLY ATTRIBUTE SET?
CALL ROTEST! JNC OPENX0 ; NO
; DOES FILE HAVE SYSTEM ATTRIBUTE SET?
INX H! MOV A,M! RAL! JNC OPENX0 ; NO
; FORCE OPEN MODE TO READ/ONLY MODE AND SET USER 0 FLAG
; IF FILE OPENED IN LOCKED MODE, USER = 0, AND
; FILE HAS READ/ONLY AND SYSTEM ATTRIBUTES SET
OPENX00:
ELSE
LDA HIGH_EXT! CPI 060H! JNZ OPENX0 ; NO
ENDIF
; IS FILE UNDER USER 0 A SYSTEM FILE ?
MVI A,20H! STA ATTRIBUTES
LHLD INFO! LXI D,10! DAD D
MOV A,M! ANI 80H! JNZ OPENX0 ; YES - OPEN SUCCESSFUL
; OPEN FAILS
STA HIGH$EXT! JMP LRET$EQ$FF
OPENX0:
CALL RESET$CHKSUM$FCB
;
;DOES DIR LBL EXIST?
IF MPM
call get$dir$mode! ora a! jz openx1
ELSE
CALL GET$DIR$MODE! ORA A! JZ SET$FCB$CKS$FLAG
ENDIF
;YES - IS FILE PASSWORD PROTECTED FOR OPEN?
PUSH A! CALL GET$XFCB! POP B
ANI 0C0H! JZ OPENX1
;YES - HAVE PASSWORDS BEEN ENABLES BY DIR LBL?
MOV C,A! MOV A,B! ANI 80H! JZ OPENX1
;YES - CHECK PASSWORD
PUSH B! CALL CMP$PW! POP B! JZ OPENX1
MOV A,C! ANI 40H! CZ CHK$PW1
MVI A,080H! STA XFCB$READ$ONLY
OPENX1:
;
IF MPM
; **** PATCH 2.1
; Set default open mode to R/O if in compatibility mode and
; if compatibility attribute F1' is set.
CALL PATCH1
; Replaced code:
; call pack$sdcnt
;is this file currently open?
mvi b,3! call search$olist! jz openx04
openx01:
;no - is olist full?
lhld free$root! mov a,l! ora h! jnz openx03
;yes - error
openx02:
mvi a,11! jmp set$aret
openx03:
;has process exceeded open file maximum?
call count$opens! sub m! jc openx035
;yes - error
openx034:
mvi a,10! jmp set$aret
openx035:
;create new olist element
call create$olist$item
jmp openx08
openx04:
;do file attributes match?
inx h! inx h
lda attributes! ora m! cmp m! jnz openx06
;yes - is open mode locked?
ani 80h! jnz openx07
;no - has this file been opened by this process?
lhld prv$pos! shld cur$pos
mvi b,5! call searchn$list! jnz openx01
openx05:
;yes - increment open file count
lxi d,8! dad d! inr m! jnz openx08
;count overflow
inx h! inr m! jmp openx08
openx06:
;error - file opened by another process in imcompatible mode
mvi a,5! jmp set$aret
openx07:
;does this olist item belong to this process?
dcx h! dcx h! push h
call compare$pds
pop h! jnz openx06 ; no - error
jmp openx05 ; yes
openx08:; open ok
;was file opened in unlocked mode?
lda attributes! ani 40h! jz openx09 ; no
;yes - return .olist$item in ranrec field of fcb
call get$rra
lxi d,cur$pos! mvi c,2! call move
openx09:
;
call set$fcb$cks$flag
lda make$flag! ora a! rnz
call get$dir$mode
ELSE
CALL SET$FCB$CKS$FLAG! MOV A,B
ENDIF
;IS FILE ACCESS STAMPING ENABLED BY DIR LBL?
ANI 40H! RZ
CALL ENDOFDIR! RZ
;YES - IS FILE READ/WRITE?
CALL NOWRITE! RNZ ; CANNOT STAMP IF DISK READ ONLY
;YES - UPDATE FCB ACCESS STAMP
OPENX2:
CALL STAMP1
JMP SEEK$COPY
;
func16:
;close file
call reselect
CALL GET$ATTS! STA ATTRIBUTES
IF MPM
lxi h,close00! push h
mvi a,0c9h! sta check$fcb4
call check$fcb1
pop h
close000:
call set$sdcnt
call getmodnum! ani 80h! jnz close01
call close! jmp close02
close00:
mvi a,6
; **** PATCH 2.1
; if comp att F3 = 0 then report close checksum error
; otherwise allow c1ose to proceed by jumping to close000
jmp patch5
; Removed code:
; jmp set$aret
close01:
mvi a,0ffh! sta dont$close! call close1
close02:
ELSE
CALL CHEK$FCB! MVI A,6! JNZ SET$ARET
CALL CLOSE
ENDIF
LDA LRET! INR A! RZ
CALL FUNC48 ; FLUSH BUFFERS
LDA ATTRIBUTES! ANI 1000$0000B! RNZ
IF MPM
call pack$sdcnt
;find olist item for this process & file
mvi b,5! call search$olist! jnz close03
;is open count = 0ffffh
; **** PATCH 2.1
; Default to partial close if comp att F2' = 1.
; If permanent close, dont delete lock list item
; if interface attribute F6' = 1.
CALL GET$CMP$MODE! RAL! RAL
;yes - remove file's olist entry
JC CLOSE03
PUSH H! LXI D,8! DAD D
MOV C,M! INX H! MOV B,M! DCX B
MOV M,B! DCX H! MOV M,C! POP D
INR B! JNZ CLOSE03
CALL PATCH4! CALL DELETE$ITEM
; Replaced code:
; push h lxi d,8 dad d
; mov a,m sui 1 mov m,a inx h
; mov a,m sui 0 mov m,a dcx h
; call test$ffff pop h jnz close03
; shld file$id call delete$item
; call reset$chksum$fcb
;if unlocked file, remove file's locktbl entries
call test$unlocked! jz close03
lhld file$id! call remove$locks
close03:
ENDIF
;
;HAS FILE BEEN WRITTEN TO SINCE IT WAS OPENED?
CALL GETMODNUM! ANI 40H! RZ
;YES - IS FILE UPDATE STAMPING ENABLED BY DIR LBL?
CALL GET$DIR$MODE! ANI 20H! RZ
;YES - DOES XFCB EXIST FOR FILE?
CALL GET$XFCB! RZ
;YES - UPDATE XFCB UPDATE STAMP
CALL STAMP2
JMP SEEK$COPY
;ret ;jmp goback
;
func17:
;search for first occurrence of a file
xchg! XRA A
CSEARCH:
PUSH A
mov a,m! cpi '?'! JNZ CSEARCH1 ; NO RESELECT IF ?
CALL CURSELECT! MVI C,0! JMP CSEARCH3
CSEARCH1:
CALL GETEXTA! MOV A,M! CPI '?'! JZ CSEARCH2
CALL CLR$EXT! CALL CLRMODNUM
CSEARCH2:
CALL RESELECTX
MVI C,NAMLEN
CSEARCH3:
POP A
IF NOT MPM
LXI H,DIR$TO$USER
PUSH H
ENDIF
JNZ SEARCHN
JMP SEARCH
;ret ;jmp goback
;
func18:
;search for next occurrence of a file name
IF MPM
xchg! shld searcha
ELSE
lhld searcha! shld info
ENDIF
;
ORI 1! JMP CSEARCH
;ret ;jmp goback
;
func19:
;delete a file
call reselectx
jmp delete
;ret ;jmp goback
;
func20:
;read a file
call reselect
; **** PATCH 2.1
; if comp att F4 = 1 then dont call check$fcb
CALL PATCH6
; replaced code:
; call check$fcb
jmp seqdiskread ;
;jmp goback
;
func21:
;write a file
call reselect
; **** PATCH 2.1
; if comp att F4 = 1 then dont call check$fcb
CALL PATCH6
; replaced code:
; call check$fcb
jmp seqdiskwrite
;jmp goback
;
func22:
;make a file
CALL GET$ATTS! STA ATTRIBUTES
XRA A! STA FCB$EXISTS
CALL CLR$EXT
call clrmodnum ; FCB MOD = 0
call reselect
CALL RESET$CHKSUM$FCB
CALL CHECK$WILD
CALL SET$XDCNT ; RESET XDCNT FOR MAKE
IF MPM
call set$sdcnt
ENDIF
CALL OPEN ; VERIFY FILE DOES NOT ALREADY EXIST
CALL RESET$CHKSUM$FCB
CALL END$OF$DIR! JNZ FILE$EXISTS ;
IF MPM
lda attributes! ani 80h! rrc! jnz makex00
mvi a,80h
makex00:
; **** PATCH 2.1
; Set the default open mode to R/O if in compatibility mode
; and attribute F1' is set.
CALL PATCH2
; Replaced code:
; sta make$flag
lda sdcnt+1! inr a! jz makex01
call pack$sdcnt
mvi b,3! call search$olist! jz make$x02
makex01:
lhld free$root! mov a,l! ora h! jz openx02
jmp makex03
makex02:
inx h! inx h
lda makeflag! ana m! jz openx06
dcx h! dcx h! call compare$pds! jz makex03
lda makeflag! ral! jc openx06
makex03:
ENDIF
;DO ANY FCBS FOR FILE EXIST IN THE DIRECTORY?
LDA FCB$EXISTS! ORA A! JZ MAKEX04
;YES - DOES DIR LBL REQUIRE PASSWORDS?
CALL GET$DIR$MODE! ANI 80H! JZ MAKEX04
;YES - DOES XFCB EXIST WITH MODE 1 OR 2 PASSWORD?
CALL GET$XFCB! ANI 0C0H! JZ MAKEX04
;YES - CHECK PASSWORD
CALL CHK$XFCB$PASSWORD1
MAKEX04:
;
CALL MAKE
CALL RESET$CHKSUM$FCB
CALL END$OF$DIR! RZ ; RETURN IF MAKE UNSUCCESSFUL
;
;DOES DIR LBL EXIST?
CALL GET$DIR$MODE! ORA A! JZ MAKE4
;YES - DOES XFCB ALREADY EXIST FOR FILE
CALL GET$XFCB! JNZ MAKE000
;NO - DOES DIR LBL INVOKE AUTO XFCB CREATE
CALL GET$DIR$MODE! ANI 10H! JZ MAKE4
MVI A,0FFH! STA MAKE$XFCB! CALL MAKE! JNZ MAKE00
MVI C,NAMLEN! CALL SEARCH
CALL DELETE0! JMP LRET$EQ$FF
MAKE000:
;YES - IS THIS FIRST FCB FOR FILE?
LDA FCB$EXISTS! ORA A! JNZ MAKE4
MAKE00:
CALL INIT$XFCB
MAKE1:
CALL SET$FCB$CKS$FLAG
;DID USER SET PASSWORD ATTRIBUTE
LDA ATTRIBUTES! ANI 40H! JZ MAKE3
XCHG! LHLD XDMAAD! LXI B,8! DAD B! XCHG
LDAX D! ANI 0E0H! JNZ MAKE2
MVI A,80H
MAKE2:
PUSH A! CALL GETXFCB1! POP A! MOV M,A
CALL SET$PW! MOV M,B
MAKE3:
CALL OPENX2
MAKE4:
IF MPM
lda make$flag! sta attributes
ani 40h! ral! sta high$ext
lda sdcnt+1! inr a! jnz makexx02
call sdcnt$eq$xdcnt! call pack$sdcnt
jmp openx03
makexx02:
call fix$olist$item! jmp openx1
ENDIF
JMP SET$FCB$CKS$FLAG
;ret ;jmp goback
FILE$EXISTS:
MVI A,8!
SET$ARET:
MOV C,A! STA ARET+1! CALL LRET$EQ$FF
IF MPM
call test$error$mode! jnz goback
ELSE
LDA ERROR$MODE! INR A! RZ
MVI A,40H! ADD C! STA XERR$ID
ENDIF
IF MPM
mov a,c! sui 3
mov l,a! mvi h,0! dad h
lxi d,xerr$list! dad d
mov e,m! inx h! mov d,m
xchg! jmp report$err
ELSE
LXI H,XERROR! JMP REPORT$ERR
ENDIF
;
func23:
;rename a file
call reselectx
jmp rename
;ret ;jmp goback
;
func24:
;return the login vector
lhld dlog! jmp sthl$ret ;
; ret ;jmp goback
;
func25:
;return selected disk number
LDA SELDSK! jmp sta$ret ;
; ret ;jmp goback
;
func26:
IF MPM
;save DMA address in process descriptor
lhld info
intrnlsetDMA:
xchg
call rlr! lxi b,disksetDMA! dad b
mov m,e! inx h! mov m,d
ENDIF
;set the subsequent dma address to info
xchg! shld dmaad ;dmaad = info
jmp setdata ;to data dma address
;
func27:
;return the login vector address
CALL XCURSELECT
lhld alloca! jmp sthl$ret
; ret ;jmp goback
;
IF MPM
func28:
;write protect current disk
;first check for open files on disk
mvi a,0ffh! sta set$ro$flag
lda seldsk! mov c,a! lxi h,0001h
call hlrotl! call intrnldiskreset
jmp set$ro
ELSE
func28: equ set$ro ;
;write protect current disk
;ret ;jmp goback
ENDIF
;
func29:
;return r/o bit vector
lhld rodsk! jmp sthl$ret ;
; ret ;jmp goback
;
func30:
;set file indicators
CALL CHECK$WRITE
CALL CHECK$WILD
call reselectx
CALL CHK$PASSWORD
call indicators
jmp copy$dirloc ;lret=dirloc
;ret ;jmp goback
;
func31:
;return address of disk parameter block
CALL XCURSELECT
lhld dpbaddr
sthl$ret:
shld aret
ret ;jmp goback
;
func32:
;set user code
lda linfo! cpi 0ffh! jnz setusrcode
;interrogate user code instead
lda usrcode! jmp sta$ret ;lret=usrcode
; ret ;jmp goback
setusrcode:
ANI 0FH! sta usrcode
IF MPM
push a
call rlr! lxi b,diskselect! dad b
pop b
mov a,m! ani 0f0h! ora b! mov m,a
ENDIF
ret ;jmp goback
;
func33:
;random disk read operation
call reselect
; **** PATCH 2.1
; if comp att F4 = 1 then dont call check$fcb
CALL PATCH6
; replaced code:
; call check$fcb
jmp randiskread ;to perform the disk read
;ret ;jmp goback
;
func34:
;random disk write operation
call reselect
; **** PATCH 2.1
; if comp att F4 = 1 then dont call check$fcb
CALL PATCH6
; replaced code:
; call check$fcb
jmp randiskwrite ;to perform the disk write
;ret ;jmp goback
;
func35:
;return file size (0-65536)
call reselect
CALL CHECK$WILD
jmp getfilesize
;ret ;jmp goback
;
func36: equ setrandom
;set random record
;ret ;jmp goback
func37:
;
IF MPM
call diskreset
reset$37:
lhld info
ELSE
XCHG
ENDIF
mov a,l! cma! mov e,a! mov a,h! cma
lhld dlog! ana h! mov d,a! mov a,l! ana e
mov e,a! lhld rodsk! xchg! shld dlog
IF MPM
push h! call hl$eq$hl$and$de
ELSE
mov a,l! ana e! mov l,a
mov a,h! ana d! mov h,a
ENDIF
shld rodsk!
;
IF MPM
pop h! xchg! lhld rlog! call hl$eq$hl$and$de! shld rlog
ENDIF
LHLD DLOG! LDA CURDSK! CALL TEST$VECTOR1
RNZ ; RETURN IF CURDSK NOT RESET
MVI A,0FFH! STA CURDSK
; FORCE SELECT CALL IN NEXT CURSELECT
RET
IF MPM
;
func38: ; access drive
lxi h,packed$dcnt! mvi a,0ffh
mov m,a! inx h! mov m,a! inx h! mov m,a
xra a! xchg! lxi b,16
acc$drv0:
dad h! adc b! dcr c! jnz acc$drv0
ora a! rz
sta mult$cnt! dcr a! push a
call acc$drv02
pop a! jmp openx02 ; insufficient free lock list items
acc$drv02:
call check$free! pop h ; discard return addr, free space exists
call count$opens! pop b! add b! jc openx034
sub m! jnc openx034 ; openmax exceeded
lhld info! lda curdsk! push a! mvi a,16
acc$drv1:
dcr a! dad h! jc acc$drv2
acc$drv15:
ora a! jnz acc$drv1
pop a! sta curdsk! ret
acc$drv2:
push a! push h! sta curdsk
call create$olist$item
pop h! pop a! jmp acc$drv15
;
func39: ; free drive
lhld open$root! mov a,h! ora l! rz
xra a! sta incr$pdcnt! inr a! sta free$mode
lhld info! mov a,h! cmp l! jnz free$drv1
inr a! jnz free$drv1
sta free$mode! call free$files! jmp free$drv3
free$drv1:
lda curdsk! push a! mvi a,16
free$drv2:
dcr a! dad h! jc free$drv4
free$drv25:
ora a! jnz free$drv2
pop a! sta curdsk
free$drv3:
lda incr$pdcnt! ora a! rz
lda pdcnt! jmp chk$olist1
free$drv4:
push a! push h! sta curdsk
call free$files
pop h! pop a! jmp free$drv25
ELSE
func38 equ func$ret
func39 equ func$ret
ENDIF
;
func40:
;random disk write with zero fill of unallocated block
call reselect
; **** PATCH 2.1
; if comp att F4 = 1 then dont call check$fcb
CALL PATCH6
; replaced code:
; call check$fcb
mvi a,2! sta seqio
mvi c,false
call rseek1
cz diskwrite ;if seek successful
ret
;
func41 equ func$ret ;test & write
IF MPM
func42: ;record lock
mvi a,0ffh! sta lock$unlock! jmp lock
func43: ;record unlock
xra a! sta lock$unlock! jmp lock
ELSE
func42 equ func$ret ;record lock
func43 equ func$ret ;record unlock
ENDIF
;
func44: ;set multi-sector count
mov a,e! ora a! jz lret$eq$ff
cpi 17! jnc lret$eq$ff
sta mult$cnt
IF MPM
mov d,a
call rlr! lxi b,mult$cnt$off! dad b
mov m,d
ENDIF
ret
;
func45: ;set BDOS error mode
IF MPM
call rlr! lxi b,pname+4! dad b
call set$pflag
mov m,a! inx h
call set$pflag
mov m,a! ret
;
set$pflag:
mov a,m! ani 7fh! inr e! rnz
ori 80h! ret
ELSE
mov a,e! sta error$mode
ENDIF
ret
;
func46: ;get free space
;perform temporary select of specified drive
call tmpselect
lhld alloca! xchg ; DE = alloc vector addr
call get$nalbs ; get # alloc blocks
; HL = # of allocation vector bytes
; count # of true bits in allocation vector
lxi b,0 ; BC = true bit accumulator
gsp1: ldax d
gsp2: ora a! jz gsp4
gsp3: rar! jnc gsp3
inx b! jmp gsp2
gsp4: inx d! dcx h
mov a,l! ora h! jnz gsp1
;HL = 0 when allocation vector processed
;compute maxall + 1 - BC
lhld maxall! inx h
mov a,l! sub c! mov l,a
mov a,h! sbb b! mov h,a
;HL = # of available blocks on drive
lda blkshf! mov c,a! xra a
call shl3bv
;AHL = # of available sectors on drive
;store AHL in beginning of current DMA
xchg! lhld xdmaad! mov m,e! inx h
mov m,d! inx h! mov m,a
ret
;
IF MPM
func47 equ func$ret
ELSE
func47: ;chain to program
;save user# and seldsk in location 0004h
lda usrcode
add a! add a! add a! add a! mov b,a
lda seldsk! ora b! sta base+0004h
mvi a,0ffh! sta chain$flg! jmp REBOOTX
ENDIF
;
func48: ;flush buffers
lxi h,diocomp! push h
lxi b,0ffffh! call setdmaf
pop h! jmp setdata
;
IF MPM
func49 equ func$ret
ELSE
func49: ;ccp chain query
lxi h,chain$flg! mov a,m! ora a! rz
mvi m,0! jmp lret$eq$ff
ENDIF
;
IF MPM
func50 equ func$ret
ELSE
func50: ;direct bios call
;DE -> function (1 byte)
; BC value (2 bytes)
; DE value (2 bytes)
xchg
mov a,m! inx h
mov c,m! inx h! mov b,m! inx h
mov e,m! inx h! mov d,m
mov l,a! add a! add l
lxi h,bios
add l! mov l,a!
mvi a,0! adc h! mov h,a! pchl
ENDIF
;
func100: ;set directory label
;DE -> .fcb
; drive location
; name & type fields user's discretion
; extent field definition
; bit 1 (80h): enable passwords on drive
; bit 2 (40h): enable file access
; bit 3 (20h): enable file update stamping
; bit 8 (01h): assign new password to dir lbl
call reselectx
call check$write
;does dir lbl exist on drive?
lhld info! mvi m,20h! mvi c,1
call set$xdcnt! call search! jnz sdl1
;no - make one
mvi a,0ffh! sta make$xfcb
call make! rz ;no dir space
call init$xfcb! call stamp1 ; create date & time stamp
sdl1:
;update date & time stamp
call stamp2
;verify password - new dir lbl falls through
call getxfcb1! call chk$xfcb$password1
lxi b,0! call init$xfcb0
;set dir lbl dta in extent field
ldax d! ori 1h! mov m,a
;low bit of dir lbl data set to indicate dir lbl exists
;update drive's dir lbl vector element
push h! lhld drvlbla! mov m,a! pop h
sdl2:
;assign new password to dir lbl or xfcb?
ldax d! ani 1! jz seek$copy
;yes - new password field is in 2nd 8 bytes of dma
lxi d,8! call adjust$dmaad
call set$pw! mov m,b
lxi d,-8! call adjust$dmaad
jmp seek$copy
;
func101: ;return directory label data
;perform temporary select of specified drive
call tmpselect
call get$dir$mode! jmp sta$ret
;
func102: ;read file xfcb
call reselectx
call check$wild
;does xfcb exist for file?
call getxfcb! mvi a,0ffh! jz sta$ret
;yes - copy xfcb to user's fcb
lhld info! mvi c,nxtrec! jmp move ;ret
;
func103: ;write or update file xfcb
call reselectx
call check$wild
;does xfcb exist for file?
call set$xdcnt
call getxfcb! jnz wxfcb1
;no - does dir lbl exist in directory?
call get$dir$mode
ora a! mvi a,0ffh! jz sta$ret
;yes - does file exist in directory?
sta make$xfcb
mvi c,extnum! call search! rz
;yes - attempt to make xfcb for file
call make! rz ; no dir space
;initialize xfcb
call init$xfcb
wxfcb1:
;verify password - new xfcb falls through
call chk$xfcb$password
;set xfcb options data
push h! call getexta! pop d! xchg
mov a,m! ora a! jnz wxfcb2
ldax d! ani 1! jz seek$copy
wxfcb2:
ldax d! ani 0e0h! jnz wxfcb3
mvi a,80h
wxfcb3:
mov m,a! jmp sdl2
;
func104: ;set current date and time
IF MPM
call get$stamp$add
call copy$stamp
mvi m,0! ret
ELSE
lxi h,stamp
jmp copy$stamp
ENDIF
;
func105: ;get current date and time
IF MPM
call get$stamp$add
ELSE
lxi h,stamp
ENDIF
xchg
copy$stamp:
mvi c,4! jmp move ;ret
;
IF MPM
get$stamp$add:
call rlradr! lxi b,-5! dad b
ret
ENDIF
;
func106: ;set default password
IF MPM
call get$df$pwa! inr a! rz
lxi b,7! dad b
ELSE
LXI H,DF$PASSWORD+7
ENDIF
xchg! lxi b,8! push h
jmp set$pw0
;
func107: ;return serial number
IF MPM
lhld sysdat! mvi l,181
ELSE
lxi h,serial
ENDIF
xchg! mvi c,6! jmp move
;
GOBACK0:
XRA A! STA RETURN$FFFF
LXI H,0FFFFH! SHLD ARET
goback:
;arrive here at end of processing to return to user
lda resel! ora a! jz retmon
;reselection may have taken place
LDA COMP$FCB$CKS! ORA A! CNZ SET$CHKSUM$FCB
LDA XFCB$READ$ONLY! ORA A! JZ GOBACK05
LHLD INFO! LXI D,7! DAD D
ORA M! MOV M,A
GOBACK05:
CALL GETEXTA! LDA HIGH$EXT! CPI 60H! JNZ GOBACK1
LXI D,-4! DAD D! MVI A,80H
GOBACK1:
ORA M! MOV M,A
LDA ACTUAL$RC! ORA A! JZ GOBACK2
CALL GETRCNTA! ORA M! MOV M,A
GOBACK2:
lhld info! mvi m,0 ;fcb(0)=0
lda fcbdsk! ora a! jz retmon
;restore disk number
mov m,a ;fcb(0)=fcbdsk
lda olddsk! STA SELDSK
;
; return from the disk monitor
retmon:
lhld entsp! sphl
lhld aret! mov a,l! mov b,h! ret
;
;
; data areas
;
; initialized data
efcb: db empty ;0e5=available dir entry
rodsk: dw 0 ;read only disk vector
dlog: dw 0 ;logged-in disks
IF MPM
rlog: dw 0 ;removeable logged-in disks
tlog: dw 0 ;removeable disk test login vector
ntlog: dw 0 ;new tlog vector
rem$drv: db 0 ;curdsk removable drive switch
;0 = permanent drive, 1 = removable drive
ENDIF
IF NOT BNKBDOS
xdmaad equ $
ENDIF
dmaad: dw tbuff ;initial dma address
IF NOT MPM
buffa: ds word ;pointer to directory dma address
ENDIF
;
; curtrka - alloca are set upon disk select
; (data must be adjacent, do not insert variables)
; (address of translate vector, not used)
cdrmaxa:ds word ;pointer to cur dir max value
curtrka:ds word ;current track address
curreca:ds word ;current record address
DRVLBLA:DS WORD ;CURRENT DRIVE LABEL BYTE ADDRESS
dpbaddr:ds word ;current disk parameter block address
checka: ds word ;current checksum vector address
alloca: ds word ;current allocation vector address
addlist equ $-DPBADDR ;address list size
;
; sectpt - offset obtained from disk parm block at dpbaddr
; (data must be adjacent, do not insert variables)
sectpt: ds word ;sectors per track
blkshf: ds byte ;block shift factor
blkmsk: ds byte ;block mask
extmsk: ds byte ;extent mask
maxall: ds word ;maximum allocation number
dirmax: ds word ;largest directory number
dirblk: ds word ;reserved allocation bits for directory
chksiz: ds word ;size of checksum vector
offset: ds word ;offset tracks at beginning
dpblist equ $-sectpt ;size of area
;
; local variables
RETURN$FFFF: DS BYTE ;SEL ERR FLAG FOR FXS 27 & 31
tranv: ds word ;address of translate vector
lock$unlock:
make$flag:
rmf: ds byte ;read mode flag for open$reel
incr$pdcnt:
dirloc: ds byte ;directory flag in rename, etc.
fcb$exists:
ds byte ;Make FCB exists flag
free$mode:
seqio: ds byte ;1 if sequential i/o
linfo: ds byte ;low(info)
dminx: ds byte ;local for diskwrite
searchl:ds byte ;search length
searcha:ds word ;search address
ACTUAL$RC:
DS BYTE ;DIRECTORY EXT RECORD COUNT
SAVE$XFCB:
DS BYTE ;SEARCH XFCB SAVE FLAG
single: ds byte ;set true if single byte allocation map
SELDSK: DS BYTE ;CURRENTLY SELECTED DISK
olddsk: ds byte ;disk on entry to bdos
rcount: ds byte ;record count in current fcb
extval: ds byte ;extent number and extmsk
SAVE$MOD:
DS BYTE ;OPEN$REEL MODULE SAVE FIELD
SAVE$EXT:
DS BYTE ;OPEN$REEL EXTENT SAVE FIELD
vrecord:ds BYTE ;current virtual record
arecord:ds word ;current actual record
DS BYTE
; SHELL FCB SAVE AREA
SAVE$RANR: DB 0,0,0 ;RANDOM RECORD SAVE AREA
arecord1: ds word ;current actual block# * blkmsk
IF NOT MPM
MULT$CNT: DB 1 ;MULTI-SECTOR COUNT
ERROR$MODE DB 0 ;BDOS ERROR MODE
ENDIF
ATTRIBUTES: DB 0 ;MAKE ATTRIBUTE HOLD AREA
IF NOT MPM
CHAIN$FLG: DB 0 ;CHAIN FLAG
STAMP: DB 0FFH,0FFH,0FFH,0FFH
ENDIF
;
;******** Following variable order critical *****************
IF MPM
mult$cnt: db 1 ;multi-sector count
pdcnt: db 0 ;process descriptor count
ENDIF
HIGH$EXT: DB 0 ;FCB HIGH EXT BITS
XFCB$READ$ONLY: DB 0 ;XFCB READ ONLY FLAG
CURDSK: DB 0 ;CURRENT DISK
IF MPM
; MP/M VARIABLES *
packed$dcnt: db 0,0,0 ;
pdaddr: dw 0 ;
;************************************************************
cur$pos: dw 0 ;
prv$pos: dw 0 ;
sdcnt: dw 0 ;
sdblk: dw 0 ;
sdcnt0: dw 0 ;
sdblk0: dw 0 ;
dont$close: db 0 ;
open$cnt: ;MP/M temp variaable for open
lock$cnt: dw 0 ;MP/M temp variable for lock
file$id: dw 0 ;MP/M temp variable for lock
deleted$files: db 0
lock$shell: db 0
lock$sp: dw 0
set$ro$flag: db 0
check$disk: db 0
flushed: db 0
fcb$cks$valid: db 0
; MP/M VARIABLES *
ENDIF
;
; local variables for directory access
dptr: ds byte ;directory pointer 0,1,2,3
XDCNT: DS WORD ;EMPTY DIRECTORY DCNT
XDBLK: DS WORD ;EMPTY DIRECTORY BLOCK
dcnt: ds word ;directory counter 0,1,...,dirmax
DBLK: DS WORD ;DIRECTORY BLOCK INDEX
USER0$PASS:
DS BYTE ;SEARCH USER 0 PASS FLAG
;
; local variables initialized by bdos at entry
;
resel: ds byte ;reselection flag
fcbdsk: ds byte ;disk named in fcb
COMP$FCB$CKS: DS BYTE ;COMPUTE FCB CHECKSUM FLAG
SEARCH$USER0: DS BYTE ;SEARCH USER 0 FOR FILE (OPEN)
MAKE$XFCB: DB BYTE ;MAKE & SEARCH XFCB FLAG
FIND$XFCB: DB BYTE ;SEARCH FIND XFCB FLAG
;
DF$PASSWORD: DW 0,0,0,0
IF MPM
dw 0,0,0,0
dw 0,0,0,0
dw 0,0,0,0
dw 0,0,0,0
dw 0,0,0,0
dw 0,0,0,0
dw 0,0,0,0
dw 0,0,0,0
dw 0,0,0,0
dw 0,0,0,0
dw 0,0,0,0
dw 0,0,0,0
dw 0,0,0,0
dw 0,0,0,0
dw 0,0,0,0
ENDIF
;
IF MPM
ds 192
last:
org (((last-base)+255) AND 0ff00h) - 279
; BNKBDOS patch area
patch00000:
dad b! mov a,m! ani 0fh
cpi 9! jnc lret$eq$ff! mov a,m
add a! add a! add a
mvi h,0! mov l,a! lxi b,dfpassword
dad b
ret
patch0000:
jnz dmset1
call test$unlocked! jz dmset1
jmp dmset05
patch000:
cpi 15! rz
call getrcnta! mvi m,128! ret ; rc = 128
patch0:
push b! call get$dir$ext! pop b! cmp c! rnc ; dir$ext > ext
call test$unlocked! rnz
pop d! xthl! mov b,l! inr b! xthl! push d! rnz ; write operation
inr b! pop d! pop d! jmp set$lret1 ; reading beyond written extent
get$cmp$mode: ; return PD compatibility
push h ; attribute in A
lhld pdaddr
lxi d,1dh
dad d
mov a,m
pop h
ret
patch1:
call pack$sdcnt
lxi h,attributes ; is open mode default?
mov a,m
ral
rnc ; no
call get$cmp$mode ; is comp att F1 = 1?
ral
rnc ; no
mvi m,20h ; set open mode to r/o
ret
patch2:
mov b,a ; is open mode default?
ral
jnc patch21 ; no
call get$cmp$mode ; is comp att F1 = 1
ral
jnc patch$21 ; no
mvi b,20h ; set open mode to r/o
patch21:
mov a,b
sta make$flag
ret
patch3:
ral ; is comp att F1 = 1
mov a,m
jnc patch31 ; no
ral
ral
patch31:
ral
jnc openx06 ; jump if not default open mode
ret
patch4:
mvi m,0ffh ; mark lock list item as closed
push d
call reset$chksum$fcb
pop h
shld file$id ; save addr of lock list item
lda high$ext ; is open mode default?
ora a
rnz ; no - delete lock list item
lda attributes ; has extended lock been requested?
ral
ral
rnc ; no - delete lock list item
pop h ; dont delete item
jmp close03
patch5:
mov b,a
call get$cmp$mode ; does comp att F3 = 1?
ani 20h
mov a,b
jz set$aret ; no - report close checksum error
jmp close000
patch6:
call get$cmp$mode ; if comp att F4 = 1 then
ani 10h ; dont check FCB checksum
jz check$fcb
ret
patch8:
sta curdsk ; push shiftr(tlog,curdsk) on stack
lhld tlog
call test$vector1
pop h
push a
lda curdsk
pchl
patch9:
pop h ; checkdisk includes tlog
pop d
ora d
sta check$disk
pchl
patch10:
mvi b,1 ; verify no open files exist on curdsk
call search$olist
jz test$dir ; open files exist
ret
patch11:
call index ; has block been allocated for this record?
call allocated
lxi h,1
rz ; no
pop h ; yes - pop return address
jmp atran ; return to get$lock$add caller
patch12:
dcr a ; go to directory to verify block
sta dont$close ; has not been allocated to the file
call test$disk$fcb ; by another process
lxi h,1
ret
patch13:
mvi b,3 ; is file opened by another process?
call search$nlist
jz openx06 ; yes - error
mvi b,3 ; redo search in case delete is required
call search$olist
xchg ; DE = address of lock list item
pop h
xthl ; HL = address of open cnt field
ret ; in lock list item
patch14:
pop b ; pop return address
inx h ; advance HL to opencnt high byte
lda attributes
ana m
rm ; return if F5' = 1 and opencnt+1 = FF
inr m ; is file lock an extended lock?
xchg
jz delete$item ; yes - delete lock item but dont
; advance PDCNT for process
push b
jmp delete$item ; delete and advance PDCNT
patch15:
call check$write ; check for r/o disk
patch16:
call getatts ; get interface atts f5' - F8'
sta attributes ; save
ret
free$root: dw $-$ ;
open$root: dw 0 ;
lock$root: dw 0 ;
lock$max: db 0 ;
open$max: db 0 ;
;
; bios access table
bios equ $ ;base of the bios jump table
bootf equ bios ;cold boot function
wbootf equ bootf+3 ;warm boot function
constf equ wbootf+3 ;console status function
coninf equ constf+3 ;console input function
conoutf equ coninf+3 ;console output function
listf equ conoutf+3 ;list output function
punchf equ listf+3 ;punch output function
readerf equ punchf+3 ;reader input function
homef equ readerf+3 ;disk home function
seldskf equ homef+3 ;select disk function
settrkf equ seldskf+3 ;set track function
setsecf equ settrkf+3 ;set sector function
setdmaf equ setsecf+3 ;set dma function
readf equ setdmaf+3 ;read disk function
writef equ readf+3 ;write disk function
liststf equ writef+3 ;list status function
sectran equ liststf+3 ;sector translate
;
ENDIF
end

Reference in New Issue View Git Blame Copy Permalink