From 4fc939ea71f1c4979525f2cb059da81a5e3fb07c Mon Sep 17 00:00:00 2001 From: Leo C Date: Fri, 20 May 2016 01:37:07 +0200 Subject: [PATCH] Add new driver: cfio --- cbios/Makefile | 2 +- cbios/cfio.180 | 787 ++++++++++++++++++++++++++++++++++++++++++++++ cbios/config.inc | 4 +- cbios/cpm3slr.lib | 10 +- cbios/drvtbl.180 | 25 +- cbios/gencpm.dat | 42 +-- 6 files changed, 833 insertions(+), 37 deletions(-) create mode 100644 cbios/cfio.180 diff --git a/cbios/Makefile b/cbios/Makefile index 39a747a..f6bad22 100644 --- a/cbios/Makefile +++ b/cbios/Makefile @@ -2,7 +2,7 @@ SRC := bioskrnl.180 boot.180 chario.180 drvtbl.180 SRC += move.180 time.180 mm.180 misc.180 utils.180 -SRC += msgbuf.180 conbuf.180 ascip.180 sdio.180 +SRC += msgbuf.180 conbuf.180 ascip.180 sdio.180 cfio.180 SRC += scb.180 INC := config.inc z180reg.inc z180.lib diff --git a/cbios/cfio.180 b/cbios/cfio.180 new file mode 100644 index 0000000..a76c9bd --- /dev/null +++ b/cbios/cfio.180 @@ -0,0 +1,787 @@ + TITLE 'compactflash disk handler' + +; CP/M-80 Version 3 -- Modular BIOS + + + ; Disk drive dispatching tables for linked BIOS + + public cf0,cf1,cf2,cf3 + + ; Variables containing parameters passed by BDOS + + extrn @xdph + extrn @adrv,@rdrv + extrn @trk,@sect,@cnt + extrn @dma,@dbnk,@cbnk + + ; System Control Block variables + + extrn @ermde ; BDOS error mode + + ; Utility routines in standard BIOS + + extrn ?wboot ; warm boot vector + extrn ?pmsg,pr.inln ; print message @, print inline message + extrn pr.crlf ; print + extrn phex2 + extrn pr.decl + extrn ?pderr ; print BIOS disk error header + extrn ?conin,?cono ; con in and out + extrn ?const ; get console status + extrn ?bnksl + + extrn bnk2phy ; + extrn add_hla + + + ; Port Address Equates + + include config.inc + include z180reg.inc + + ; CP/M 3 Disk definition macros + + maclib cpm3slr.lib + + ; Z180 macro library instruction definitions (ignored by slr180) + + include z180.lib + +DEBUG equ false ; not used +MULTIIO equ true ; Multi I/O currently not fully implemented. + + ; IDE Task File Register Definitions + +;IdeDOR equ IDEBASE+6 ; Digital Output Register +IDEDat equ IDEBASE+0 ; Data Register +IDEErr equ IDEBASE+1 ; Error Register +IDEFeat equ IDEBASE+1 ; Feature Register +IDESCnt equ IDEBASE+2 ; Sector Count +IDESNum equ IDEBASE+3 ; Sector Number +IDECLo equ IDEBASE+4 ; Cylinder Low +IDECHi equ IDEBASE+5 ; Cylinder High +IDESDH equ IDEBASE+6 ; Drive and Head +IDECmd equ IDEBASE+7 ; Command / Status + + ; IDE Hard disk commands: + +CmdHome equ 10h ; Recalibrate +CmdRd equ 20h ; Read Sector +CmdWr equ 30h ; Write Sector +CmdInit equ 91h ; Initialize Drive Params +CmdId equ 0ECh ; Read ID +CmdSF equ 0EFh ; Set Feature + + ; Partition Table Structures + +PART_TYPE equ 4 +PART_START equ 8 +PART_SIZE equ 12 + + ; Partition table id + ; (see http://www.win.tue.nl/~aeb/partitions/partition_types-1.html) + +PARTID1_FAT16 equ 00EH +PARTID2_FAT16 equ 006H +PARTID_CPM equ 052H + +MAXDISKS equ 4 + +; parttabl fields +PTAB_TYPE equ 0 ; 1 byte +PTAB_START equ 1 ; 4 byte (28 bit, max 128 GiB) +PTAB_SIZE equ 5 ; 4 byte (3 needed, 20 bit, max 512 MiB) +PTAB_SPT equ 9 ; 1 byte +PTAB_BSH equ 10 ; 1 byte + +PARTENTRY_SIZE equ 11 + + + ; common control characters + +cr equ 13 +lf equ 10 +bell equ 7 + +;------------------------------------------------------------------------------- + + ; Macro: wait while device is busy + +WAITNOTBUSY macro + local wait +wait: in a,(IdeCmd) + rla + jr c,wait + endm + + ; Macro: wait while device is busy + +WAITREADY macro + local wait +wait: in a,(IdeCmd) + xor 01000000b + and 11000000b + jr nz,wait + endm + + ; Macro: wait for DRQ signal + +WAITDRQ macro + local wait +wait: in a,(IdeCmd) + bit 3,a + jr z,wait + endm + +;------------------------------------------------------------------------------- + + dseg + + ; Extended Disk Parameter Headers (XPDHs) + + ; dph translate$table, - disk parameter header + ; disk$parameter$block, + ; checksum$size, (optional) + ; alloc$size (optional) + + dw cf$write + dw cf$read + dw cf$login + dw cf$init0 + db 0,0 ; relative drive zero +cf0: dph 0,dpbsimhd512,0 + + dw cf$write + dw cf$read + dw cf$login + dw cf$init1 + db 1,0 ; relative drive one +cf1: dph 0,dpbsimhd512,0 + + dw cf$write + dw cf$read + dw cf$login + dw cf$init2 + db 2,0 ; relative drive zero +cf2: dph 0,dpbsimhd512,0 + + dw cf$write + dw cf$read + dw cf$login + dw cf$init3 + db 3,0 ; relative drive one +cf3: dph 0,dpbsimhd512,0 + + cseg ; DPB must be resident + + ; dpb physical$sector$size, - disk parameter block + ; physical$sectors$per$track, + ; number$tracks, + ; block$size, + ; number$dir$entries, + ; track$offset, + ; checksum$vec$size (optional) + +dpbsimhd512: + dpb 512,8,2048,4096,1024,6,8000h + +;------------------------------------------------------------------------------- + + dseg ; rest is banked + +; Disk I/O routines for standardized BIOS interface + +; Initialization entry point. +; called for first time initialization. + +cf$init0: + call pr.inln ; + db 'cfio: CompactFlash Memory Card driver'cr,lf,0 + + ld hl,parttbl ; Clear partition table + ld b,PARTENTRY_SIZE*MAXDISKS +ini_clrtbl: + ld (hl),0 + inc hl + djnz ini_clrtbl + + call cf_init ; init ide interface / cf card + jr nz,pend + + call ident_read ; identify drive + jr nz,pend + + call prnt_info ; print device information + call ptab_read ; read the partition table + + ld c,0 ; number of found disks (paritions) + jr nz,pend + + ld hl,tmpsecbuf+512-1 ; Point to first byte of partition table + ld a,(hl) ; Test, if it has a valid MBR + cp 0AAH ; + jr nz,pend ; + dec hl + ld a,(hl) ; + cp 055H ; + jr nz,pend ; + + ; Search for valid Partitions + + ld hl,tmpsecbuf+512-2-64+PART_TYPE ; Point to partition type of first first partition table entry + ld de,parttbl ; + ld b,4 ; Max # of partition table entries +ploop: + ld a,(hl) ; Get Partitiontype + cp PARTID_CPM ; Test for CP/M Partition + ld a,16 ; Offset to next entry + jr nz,nextp + push bc + ld a,(hl) ; (Re)get Partitiontype + ld (de),a ; Save paritition type + inc de + inc hl ; Point to partition start (lba) + inc hl + inc hl + inc hl + ld bc,8 ; Copy partition start and size + ldir + rept PARTENTRY_SIZE-8-1 + inc de + endm + pop bc + inc c ; One more found + ld a,c + cp MAXDISKS + jr z,pend + ld a,4 +nextp: + call add_hla + djnz ploop +pend: + ;TODO: variable disk format: sectors per track, ... + + call prnt_ptab ; Print partition table info + ret + + +cf$init1: +cf$init2: +cf$init3: + ret ; all initialization done by drive 0 + +; Read ID from Hard Disk + +ident_read: + WAITREADY + ld a,0E0h ; assume unit 0, + out (IdeSDH),a ; + ld a,CmdId + out (IdeCmd),a ; command: read sector data + ld hl,tmpsecbuf + ld bc,IdeDat ; B = 0 (counter), C = I/O address + WAITDRQ ; wait for DRQ to become active + inir + inir ; read 512 data bytes (2 x 256) + WAITNOTBUSY + in a,(IdeCmd) ; check final drive status + and 10001001b ; Busy, DRQ, or Error? + ret z ; no: everything is ok + ld a,1 ; return with A=1 on error + ret + + +; Read partition table + +ptab_read: + WAITREADY + ld a,0E0h ; assume unit 0, lba mode + out (IdeSDH),a ; + xor a ; sector 0 (lba) + out (IdeSNum),a ; + out (IdeCLo),a + out (IdeCHi),a ; + inc a ; one sector to read + out (IdeSCnt),a ; set sector count + + ld a,CmdRd + out (IdeCmd),a ; command: read sector data + ld hl,tmpsecbuf + ld bc,IdeDat ; B = 0 (counter), C = I/O address + WAITDRQ ; wait for DRQ to become active + inir + inir ; read 512 data bytes (2 x 256) + WAITNOTBUSY + in a,(IdeCmd) ; check final drive status + and 10001001b ; Busy, DRQ, or Error? + ret z ; no: everything is ok + ld a,1 ; return with A=1 on error + ret + +cf_init: + WAITREADY + ld a,0E0h ; assume unit 0, lba mode + out (IdeSDH),a ; + ld a,1 ; Enable 8-bit data transfer. + out (IDEFeat),a + ld a,CmdSF + out (IdeCmd),a ; command: read sector data + WAITNOTBUSY + in a,(IdeCmd) ; check final drive status + and 10001001b ; Busy, DRQ, or Error? + ret z ; no: everything is ok + ld a,1 ; return with A=1 on error + ret + + +pr_char_nlbl: + bit 0,b + jr z,pr_char + cp ' ' + ret z + res 0,b + ; fall thru +pr_char: + push hl + push de + push bc + ld c,a + call ?cono + pop bc + pop de + pop hl + ret + +; Print an id string +; Remove leading and trailing spaces + +pr_id: + push hl ; Save string address + ld b,0 + add hl,bc + dec hl ; Point to last char. + ld a,' ' +prn_el: ; Reduce string len by number of trailing spaces + dec hl + cpi + jr nz,prn_el1 ; No more spaces + jp po,prn_el2 ; No more characters + cpd + dec hl + jr nz,prn_el1 + jp po,prn_el2 + jr prn_el +prn_el1: + inc c +prn_el2: + pop hl ; Restore beginning of string + ld a,c + or a ; Test number of remaining chars + ret z ; Done, if string was spaces only + + ld b,1 ; Flag, skip spaces +prn_lp: + inc hl ;Text is low byte high byte format + ld a,(hl) + call pr_char_nlbl + dec c + ret z + dec hl +prn_lp1: + ld a,(hl) + call pr_char_nlbl + dec c + ret z + inc hl + inc hl + jr prn_lp + +; Print divice information + +prnt_info: + call pr.inln + db ' Model: ',0 + ld hl,tmpsecbuf + 27*2 ; Model number + ld c,20*2 ; max character count + call pr_id ; + call pr.inln + db ', S/N: ',0 + ld hl,tmpsecbuf + 10*2 ; Serial number + ld c, 10*2 + call pr_id + call pr.inln + db ', Rev: ',0 + ld hl,tmpsecbuf + 23*2 ; Firmware revision + ld c, 4*2 + call pr_id + + call pr.inln + db cr,lf,' Size: ',0 + ld hl,(tmpsecbuf+60*2) ;Total Sectors Addressable in LBA Mode + ld de,(tmpsecbuf+61*2) ; + push hl + push de + ld bc,1 + call pr.decl + call pr.inln + db ' Sectors (',0 + pop de + pop hl + srl d + rr e + rr h + rr l + ld bc,1 + call pr.decl + call pr.inln + db ' KiB)',cr,lf,0 + ret + +; Print partition table info + +prnt_ptab: + ld ix,parttbl + ld c,0 +prp_lp: + ld a,c + cp 4 + ret z + ld a,(ix+PTAB_TYPE) + or a + ret z + + push bc + call pr.inln + db ' ',0 + ld a,(@adrv) + add a,c + add a,'A' + call pr_char + call pr.inln + db ': CP/M partition at: ',0 + ld l,(ix+PTAB_START+0) + ld h,(ix+PTAB_START+1) + ld e,(ix+PTAB_START+2) + ld d,(ix+PTAB_START+3) + ld bc,1 + call pr.decl + call pr.inln + db ', size: ',0 + ld l,(ix+PTAB_SIZE+0) + ld h,(ix+PTAB_SIZE+1) + ld e,(ix+PTAB_SIZE+2) + ld d,(ix+PTAB_SIZE+3) + srl d + rr e + rr h + rr l + ld bc,1 + call pr.decl + call pr.inln + db 'KiB',cr,lf,0 + ld bc,PARTENTRY_SIZE + add ix,bc + pop bc + inc c + jr prp_lp + +;------------------------------------------------------------------------------- + +; This entry is called when a logical drive is about to +; be logged into for the purpose of density determination. +; It may adjust the parameters contained in the disk +; parameter header pointed at by +; +; absolute drive number in @adrv (8 bits) +0 +; relative drive number in @rdrv (8 bits) +1 + +cf$login: + xor a + ld (residual),a ; just in case + + ld hl,parttbl + ld a,(@rdrv) + ld e,a + ld d,PARTENTRY_SIZE + mlt de + add hl,de + ld a,(hl) + or a + ret nz + ld hl,0 + ld (@xdph),hl + ret ; + +; disk READ and WRITE entry points. +; these entries are called with the following arguments: +; +; absolute drive number in @adrv (8 bits) +0 +; relative drive number in @rdrv (8 bits) +1 +; disk track address in @trk (16 bits) +2 +; disk sector address in @sect(16 bits) +4 +; multi sector count in @cnt (8 bits) +6 +; disk transfer address in @dma (16 bits) +7 +; disk transfer bank in @dbnk (8 bits) +9 +; pointer to XDPH in +; +; they transfer the appropriate data, perform retries +; if necessary, then return an error code in + +cf$read: + ld de,read$msg ; point at " Read " + ld bc,M_DIM1*256 + CmdRd ; Transfermode: i/o to memory++ + jr rw$common +cf$write: + ld de,write$msg ; point at " Write " + ld bc,0*256 + CmdWr ; Transfermode: memory++ to i/o +rw$common: + + if MULTIIO + ld hl,residual ; remainng sectors from last multi io? + ld a,(hl) + sub a,1 + jr c,rwc_new_sectors + + ld (hl),a + xor a + ret + endif + +rwc_new_sectors: + ld (operation$name),de ; save message for errors + in0 a,(dcntl) + and a,~(M_DMS1+M_DIM1+M_DIM0) + or b + out0 (dcntl),a + + ld b,1 ; assume 1 sector to transfer + if MULTIIO + ld a,(@cnt) + or a + jr z,rwc_doit + + ld b,a ; number of sectors to transfer + dec a ; save remaining + ld (hl),a + xor a ; reset multi sector count + ld (@cnt),a +rwc_doit: + endif + + ld iy,parttbl + ld a,(@rdrv) + ld e,a + ld d,PARTENTRY_SIZE + mlt de + add iy,de + +retry: + ld a,b + out (IdeSCnt),a ; set sector count + +; compute logical block number (lba) --> cf-controller + + ; TODO: sectors per track from dpb + ; lba = track * 8 + sector + + xor a + ld hl,(@trk) + add hl,hl + adc a,a ; *2 + add hl,hl + adc a,a ; *4 + add hl,hl + adc a,a ; *8 + ld de,(@sect) + add hl,de + adc a,0 + + push hl ; check, if block# fits in partition + ld e,(iy+PTAB_SIZE+0) + ld d,(iy+PTAB_SIZE+1) + sbc hl,de + ld l,a + sbc a,(iy+PTAB_SIZE+2) + ld a,l + pop hl + jr c,lba_ok + ld a,1 ; block# >= partition size, return error + ret + +lba_ok: + WAITREADY + ld e,a ; add partition start + ld a,(iy+PTAB_START+0) + add a,l + out (IdeSNum),a + ld a,(iy+PTAB_START+1) + adc a,h + out (IdeCLo),a + ld a,(iy+PTAB_START+2) + adc a,e + out (IdeCHi),a + ld a,(iy+PTAB_START+3) + adc a,0 + and 00FH + or 0E0H + out (IdeSDH),a + + ld hl,(@dma) + ld a,(@dbnk) + +; compute pysical transfer address --> DMA + + call bnk2phy ; phys. linear address + out0 mar1l,l + out0 mar1h,h + out0 mar1b,a + ld a,IdeDat + out0 iar1l,a + xor a + out0 iar1h,a + out0 iar1b,a + out0 bcr1l,a + ld a,c + out (IDECmd),a + push bc +nxt_sec: + ld a,2 + out0 bcr1h,a + WAITDRQ + ld a,M_DE1+M_NDWE0 + out0 (dstat),a +wait_dma: + in0 a,(dstat) + bit DE1,A + jr nz,wait_dma + + WAITNOTBUSY + in a,(IdeCmd) ; check final drive status + bit 0,a ; any error? + jr nz,err_out + djnz nxt_sec +err_out: + pop bc + ld e,a + and 10001001b ; Busy, DRQ, or Error? + ret z ; Return to BDOS if no error + +; suppress error message if BDOS is returning errors to application... + + ld a,(@ermde) + cp 0ffh + jr z,hard$error + + ; Had permanent error, print message like: + ; BIOS Err on d: T-nn, S-mm, , Retry ? + + call ?pderr ; print message header + + ld hl,(operation$name) + call ?pmsg ; last function (read or write) + + ld hl,msg$drq + bit 3,e + call nz,?pmsg + + bit 0,e + jr z,prompt + + in a,(IDEErr) + ld hl,error$table ; point at table of message addresses +errm1: + ld e,(hl) + inc hl + ld d,(hl) + inc hl ; get next message address + add a,a + push af ; shift left and push residual bits with status + ex de,hl + call c,?pmsg + ex de,hl ; print message, saving table pointer + pop af + jr nz,errm1 ; if any more bits left, continue + +prompt: + call pr.inln + db ' Retry (Y/N) ? ',0 + + call u$conin$echo ; get operator response + cp 'Y' + jp z,retry ; Yes, then retry + +hard$error: + ; otherwise, + xor a + ld (residual),a + + ld a,1 ; return hard error to BDOS + ret + +cancel: ; here to abort job + jp ?wboot ; leap directly to warmstart vector + + +; get console input, echo it, and shift to upper case + +u$conin$echo: + push bc +u$c0: + call ?const + or a + jr z,u$c1 ; see if any char already struck + call ?conin + jr u$c0 ; yes, eat it and try again +u$c1: + call ?conin + push af + ld c,a + cp ' '-1 + call nc,?cono + pop af + pop bc + cp 'a' + ret c + sub 'a'-'A' ; make upper case + ret + + ; error message components + +operation$name: + dw read$msg +read$msg: + db ', Read, ',0 +write$msg: + db ', Write, ',0 +msg$drq: + db 'DRQ, ',0 +error$table: + dw b7$msg + dw b6$msg + dw b5$msg + dw b4$msg + dw b3$msg + dw b2$msg + dw b1$msg + dw b0$msg + +b7$msg: db ' Bad Block detected,',0 +b6$msg: db ' Uncorrectable Data Error,',0 +b5$msg: db ' Media Changed,',0 +b4$msg: db ' Sector ID Not Found,',0 +b3$msg: db ' Media Change Requst,',0 +b2$msg: db ' Aborted Command,',0 +b1$msg: db ' Track 0 Not Found,',0 +b0$msg: db ' AM Not Found (or general error),',0 + + +residual: + db 0 + +parttbl: + ds PARTENTRY_SIZE*MAXDISKS + +tmpsecbuf: ;temporary sector buffer + ds 512 + + end diff --git a/cbios/config.inc b/cbios/config.inc index 4421478..bea6e05 100644 --- a/cbios/config.inc +++ b/cbios/config.inc @@ -3,8 +3,6 @@ FALSE equ 0 TRUE equ NOT FALSE -DEBUG equ true - banked equ true ;----------------------------------------------------- @@ -159,6 +157,8 @@ AVRINT5 equ 4Fh AVRINT6 equ 5Fh ;PMSG equ 80h +IDEBASE equ 60h + ;----------------------------------------------------- ; Definition of (logical) top 2 memory pages diff --git a/cbios/cpm3slr.lib b/cbios/cpm3slr.lib index 2414bf4..9d708af 100644 --- a/cbios/cpm3slr.lib +++ b/cbios/cpm3slr.lib @@ -49,10 +49,14 @@ dph macro ?trans,?dpb,?csize,?asize db 0 ; media flag dw ?dpb ; disk parameter block if not nul ?csize + if ?csize = 0 + dw 0 ; permanently mounted, no checksum vector + else dw ?csv ; checksum vector + endif else - dw 0FFFEh ; checksum vector allocated by - endif ; GENCPM + dw 0FFFEh ; checksum vector alloc'd by GENCPM + endif if not nul ?asize dw ?alv ; allocation vector else @@ -63,7 +67,9 @@ dph macro ?trans,?dpb,?csize,?asize db 0 ; hash bank if not nul ?csize + if ?csize <> 0 ?csv ds ?csize ; checksum vector + endif endif if not nul ?asize ?alv ds ?asize ; allocation vector diff --git a/cbios/drvtbl.180 b/cbios/drvtbl.180 index 52590e7..dc2d59c 100644 --- a/cbios/drvtbl.180 +++ b/cbios/drvtbl.180 @@ -1,12 +1,13 @@ - public @dtbl - extrn sd0,sd1,sd2,sd3 - extrn sd4,sd5,sd6,sd7 - - cseg - -@dtbl dw sd0,sd1,sd2,sd3 ; drives A-D - dw sd4,sd5,sd6,sd7 ; drives E-H - dw 0,0,0,0 ; drives I-L - dw 0,0,0,0 ; drives M-P - - end + public @dtbl + extrn sd0,sd1,sd2,sd3 + extrn sd4,sd5,sd6,sd7 + extrn cf0,cf1,cf2,cf3 + + cseg + +@dtbl dw sd0,sd1,sd2,sd3 ; drives A-D + dw sd4,sd5,sd6,sd7 ; drives E-H + dw cf0,cf1,cf2,cf3 ; drives I-L + dw 0,0,0,0 ; drives M-P + + end diff --git a/cbios/gencpm.dat b/cbios/gencpm.dat index bbd632b..605cd91 100644 --- a/cbios/gencpm.dat +++ b/cbios/gencpm.dat @@ -9,9 +9,11 @@ BNKSWT = Y COMBAS = F0 LERROR = Y NUMSEGS = 03 -MEMSEG00 = 50,4E,00 -MEMSEG01 = 10,E0,02 -MEMSEG02 = 01,EF,03 +==== BASE ==== +MEMSEG00 = 50,30,00 +MEMSEG01 = 10,B0,02 +MEMSEG02 = 01,BF,03 +==== BASE ==== MEMSEG03 = 00,C0,04 MEMSEG04 = 00,C0,05 MEMSEG05 = 00,C0,06 @@ -49,10 +51,10 @@ ALTBNKSE = N ALTBNKSF = N ALTBNKSG = N ALTBNKSH = N -ALTBNKSI = N -ALTBNKSJ = N -ALTBNKSK = N -ALTBNKSL = N +ALTBNKSI = Y +ALTBNKSJ = Y +ALTBNKSK = Y +ALTBNKSL = Y ALTBNKSM = N ALTBNKSN = N ALTBNKSO = N @@ -65,10 +67,10 @@ NDIRRECE = 00 NDIRRECF = 00 NDIRRECG = 00 NDIRRECH = 00 -NDIRRECI = 01 -NDIRRECJ = 01 -NDIRRECK = 01 -NDIRRECL = 01 +NDIRRECI = 00 +NDIRRECJ = 00 +NDIRRECK = 00 +NDIRRECL = 00 NDIRRECM = 01 NDIRRECN = 01 NDIRRECO = 01 @@ -81,10 +83,10 @@ NDTARECE = 00 NDTARECF = 00 NDTARECG = 00 NDTARECH = 00 -NDTARECI = 01 -NDTARECJ = 01 -NDTARECK = 01 -NDTARECL = 01 +NDTARECI = 00 +NDTARECJ = 00 +NDTARECK = 00 +NDTARECL = 00 NDTARECM = 01 NDTARECN = 01 NDTARECO = 01 @@ -98,9 +100,9 @@ ODIRDRVF = B ODIRDRVG = A ODIRDRVH = B ODIRDRVI = A -ODIRDRVJ = A +ODIRDRVJ = B ODIRDRVK = A -ODIRDRVL = A +ODIRDRVL = B ODIRDRVM = A ODIRDRVN = A ODIRDRVO = A @@ -114,9 +116,9 @@ ODTADRVF = B ODTADRVG = A ODTADRVH = B ODTADRVI = A -ODTADRVJ = A +ODTADRVJ = B ODTADRVK = A -ODTADRVL = A +ODTADRVL = B ODTADRVM = A ODTADRVN = A ODTADRVO = A @@ -155,4 +157,4 @@ OVLYDTAO = Y OVLYDTAP = Y CRDATAF = N DBLALV = Y - \ No newline at end of file + -- 2.39.2