Block Move Routines for the 6545 CRT Controller. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1 ;*************************************************************************** ;* 12-8-1983 V1.9E * ;* DELETED RESTORE & RETRY INSERTED IN V1.9d * ;*************************************************************************** ;* 10-24-1983 V1.9e WM03 * ;* CHANGED SCREEN SIZE IN 'clear2' TO 800H TO ELMINATE THE PHANTOM CURSOR * ;* ATTRIBUTE. COMMENTED & LEFT ORIGINAL CALCULATION FOR DOCUMENTATION.* ;*************************************************************************** ;* 10-22-1983 V1.9d WM02 * ;* INSERTED hrestore_&retry before call nz,wrt.err & rd.err; THE ROUTINE * ;* WILL RESTORE DRIVE AND RETRY FUNCTION BEFORE GOING TO ERROR ROUTINE* ;* CHANGED 18 JP'S TO JR'S, ADDED 16 BYTES, NET GAIN = 2 BYTES * ;*************************************************************************** ;* 10-21-1983 V 1.9c * ;* ISOLATED HARD DISK CONTROLLER RESET FROM HARD DISK RESET, MODIFIED ROM * ;* SO THAT THE HARD DISK CONTROLLER RESET IS ONLY PERFORMED AT POWER-UP * ;* OR RESET. FIXED A BUG IN HARD DISK READY ROUTINE THAT WAS TURNING * ;* ON THE FLOPPY DRIVE MOTOR AND SETTING ALL BITPORT BITS HIGH. ALSO * ;* CHANGED THE SEEK SPEED OF FLOPPY RESTORE TO MATCH THE SEEK TIME (6ms). * ;* (M. Sherman, 21-Oct-83) * ;*************************************************************************** ;* 10-10-1983 V 1.9b WM01 * ;* CHANGED 12 JP'S TO JR AND ADDED A 4 SEC DELAY TO HARD DISK INITIAL RESET* ;* HARD DISK RESET STATE HAS BEEN COMPLEMENTED TO BE COMPATABLE * ;* WITH THE IMPROVED WD 1002 CONTROLLER BOARD. * ;* IN 'seekcmd' STEP RATE CHANGED TO BE 6mS, THE SAME AS THE II & THE IV. * ;* range of program 0000 - 0FFEH, added 11 bytes, net gain = 1 byte. * ;*************************************************************************** ; ;*************************************************************************** ;* INLINE ASSEMBLY OF BIOS MODULES W. MCKINLEY 8-12-83 16:00 * ;*************************************************************************** ; IF1 .PRINTX / 12-08-83 INLINE BIOS MODIFIED FOR IMPROVED WD-1002 CONTROLLER, SEEK = 6mS / .PRINTX / VERSION 1.9E / ENDIF ; IF2 .PRINTX / PASS 2 / ENDIF ; title System scratch RAM used by ROM software and OVL. (C) 1983 By NLS .comment % ######################################################## ## ## ## KAYPRO 10 System ## ## ## ## By G. Ohnysty ## ## ## ## System scratch RAM used by ROM & OVL software ## ## ## ## Copyright (C) 1983 By Non-Linear Systems, Inc ## ## No warranty is made, expressed or implied. ## ## ## ######################################################## System scratch RAM used by ROM software and OVL. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-1 ## Date: 04/14/83 [01] ## ######################################################## % .z80 EE00 ovlram equ 0EE00H ; overlay ram EE00 wrt.err equ ovlram ; write sector error handler EE03 rd.err equ wrt.err+3 ; read sector error handler EE06 pixon equ rd.err+3 ; plot a pixel EE09 pixoff equ pixon+3 ; erase a pixel EE0C lineon equ pixoff+3 ; draw a line EE0F lineoff equ lineon+3 ; erase a line F700 ramscratch equ 0F700H ; scratch ram F700 dsktyp equ ramscratch ;hard or floppy disk currently selected flag F701 adsk equ dsktyp+1 ;hard or floppy is A: flag F702 sectrk equ adsk+1 ;sectors per track F703 @sekdsk equ sectrk+1 ;seek disk number F704 @sektrk equ @sekdsk+1 ;seek track number F706 @seksec equ @sektrk+2 ;seek sector number F707 @hstdsk equ @seksec+1 ;host disk number F708 @hsttrk equ @hstdsk+1 ;host track number F70A @hstsec equ @hsttrk+2 ;host sector number F70B @sekhst equ @hstsec+1 ;seek shr secshf F70C @hstact equ @sekhst+1 ;host active flag F70D @hstwrt equ @hstact+1 ;host written flag F70E @unacnt equ @hstwrt+1 ;@unalloc rec cnt F70F @unadsk equ @unacnt+1 ;last @unalloc disk F710 @unatrk equ @unadsk+1 ;last @unalloc track F712 @unasec equ @unatrk+2 ;last @unalloc sector F713 @erflag equ @unasec+1 ;error reporting F714 @rsflag equ @erflag+1 ;read sector flag F715 @readop equ @rsflag+1 ;1 if read operation F716 @wrtype equ @readop+1 ;write operation type F717 @dmaadr equ @wrtype+1 ;last dma address F719 @hstbuf equ @dmaadr+2 ;host buffer F919 @move equ @hstbuf+512 ;move routine for deblocking F928 @dirbuf equ @move+15 ;directory buffer for hard disk F9A8 @alva equ @dirbuf+128 ; alocation map for hd A FA4A @alvb equ @alva+162 ; alocation map for hd B FAEC @dpha equ @alvb+162 ; dph for hd A FAFC @dphb equ @dpha+16 ; dph for hd B FB0C @dpbh equ @dphb+16 ; dpb for hd FB1B sekdsk equ @dpbh+15 ;seek disk number FB1C sektrk equ sekdsk+1 ;seek track number FB1E seksec equ sektrk+2 ;seek sector number FB1F hstdsk equ seksec+1 ;host disk number FB20 hsttrk equ hstdsk+1 ;host track number FB22 hstsec equ hsttrk+2 ;host sector number FB23 sekhst equ hstsec+1 ;seek shr secshf FB24 hstact equ sekhst+1 ;host active flag FB25 hstwrt equ hstact+1 ;host written flag FB26 unacnt equ hstwrt+1 ;unalloc rec cnt System scratch RAM used by ROM software and OVL. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-2 FB27 unadsk equ unacnt+1 ;last unalloc disk FB28 unatrk equ unadsk+1 ;last unalloc track FB2A unasec equ unatrk+2 ;last unalloc sector FB2B erflag equ unasec+1 ;error reporting FB2C rsflag equ erflag+1 ;read sector flag FB2D readop equ rsflag+1 ;1 if read operation FB2E wrtype equ readop+1 ;write operation type FB2F dmaadr equ wrtype+1 ;last dma address FB31 hstbuf equ dmaadr+2 ;host buffer FD31 dsk equ hstbuf+512 ; current disk drive FD32 sidflg equ dsk+1 ; single/double sided flag FD33 csva equ sidflg+1 ; directory check FD43 alva equ csva+16 ; allocation map FD5C leadflg equ alva+25 ; video graphics data storage FD5C vidram equ leadflg ; initialization pointer FD5D crow equ leadflg+1 FD5E ccol equ crow+1 FD5F vatt equ ccol+1 FD60 cursor equ vatt+1 FD62 vrbase equ cursor+2 FD64 esccmd equ vrbase+2 FD65 precur equ esccmd+1 000C ramlen equ 12 ; number of bytes to initialize FD67 col equ precur+2 FD68 col2 equ col+1 FD69 row equ col2+1 FD6A row2 equ row+1 FD6B onoff equ row2+1 FD6C newc equ onoff+1 FD6D pix equ newc+1 FD6E saddr equ pix+1 FD70 xoff equ saddr+2 FD71 yoff equ xoff+1 FD72 difx equ yoff+1 FD73 dify equ difx+1 FD74 vgb1 equ dify+1 FD75 dpha equ vgb1+1 ; DPH for A FD85 $dpb equ dpha+16 ; single density dpb FD94 adrbuf equ $dpb+15 ; read address buffer FD9A move equ adrbuf+6 ; move logical sector from hstbuf FDA9 rd128 equ move+15 ; routine to read 128 byte sector FDB0 rd512 equ rd128+7 ; routine to read 512 byte sector FDBA wrt128 equ rd512+10 ; routine to write 128 byte sector FDC1 wrt512 equ wrt128+7 ; routine to wrtie 512 byte sector FE3A rdwrtend equ rd128+145 ; end of read and write routines FE3B dirbuf equ rdwrtend+1 ; bdos directory buffer FFFF stack equ 0FFFFH ; boot up stack space title Cold start routines. (C) 1983 By NLS .comment % ######################################################## ## ## ## KAYPRO 10 System ## ## ## ## By G. Ohnysty ## Cold start routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-3 ## ## ## Cold start routine, reset and configure ## ## system for power up condition. ## ## ## ## Copyright (C) 1983 By Non-Linear Systems, Inc ## ## No warranty is made, expressed or implied. ## ## ## ######################################################## ## Date: 04/14/83 [01] ## ######################################################## # # # Modified for proper error handling on first # # attempts to load the overlay (which has the # # error message reporting calls in it.) # # (M. Sherman, 17-Jun-83) # # Modified for proper response to the floppy # # on power-up/reset by M. Sherman on 8-Jun-83 # # # ######################################################### % ; EE00 ovlram equ 0EE00H ; load address for overlay 0000 hdsel equ 0 ; hard disk is A: flag FFFF fsel equ -1 ; floppy is A: flag 0010 status equ 10H ; floppy status port (to look for index) .z80 ; ROM master jump table 0000' C3 004B' jp start ; start up computer 0003' C3 029B' jp diskinit ; disk initialize 0006' C3 0927' jp vidinit ; video initialize 0009' C3 0181' jp devinit ; device initialize 000C' C3 0228' jp home_dispatch ; home selected disk drive 000F' C3 025F' jp seldsk ; select a disk drive 0012' C3 0233' jp settrk ; seek a track 0015' C3 023E' jp setsec ; set sector number to read 0018' C3 0293' jp setdma ; set dma address 001B' C3 0249' jp read ; read logical sector 001E' C3 0254' jp write ; write logical sector 0021' C3 07AD' jp sectran ; xlate sector number 0024' C3 07CC' jp diskon ; turn on disk 0027' C3 02A1' jp diskoff ; turn off disk 002A' C3 0194' jp kbdstat ; KeyBoarD character ready 002D' C3 019E' jp kbdin ; input from keyboard 0030' C3 01A9' jp kbdout ; output to keyboard (used to ring bell) 0033' C3 01ED' jp ttystat ; status of serial input port 0036' C3 01F3' jp ttyin ; serial input 0039' C3 01FB' jp ttyout ; serial output 003C' C3 020B' jp liststat ; list output status (Centronics) 003F' C3 0215' jp list ; list output 0042' C3 0205' JP TTYOSTAT ;TESTSTATUS OF SERIAL OUTPUT 0045' C3 09CA' jp vidout ; video output Cold start routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-4 0048' C3 07E4' jp thnsd ; short delay 004B' F3 start: di ; stop interupts while setup 004C' 31 FFFF ld sp,stack ; rom stack point 004F' 06 14 ld b,20 ; a delay to let the hardware stabilize 0051' CD 07E4' call thnsd ; 20 milli-seconds worth. 0054' CD 0181' call devinit ; init device sub-system 0057' CD 0927' call vidinit ; init video sub-system 005A' CD 02D6' call hdcinit ; hard disk controller initialization 005D' CD 029B' call diskinit ; init disk sub-system 0060' 18 05 jr bootsys ; boot system org 66H ; nmi vector 0066' C9 ret ; return from "halt", NMI sequence when in rom page Cold start routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-5 ; boot system, the first sector (1) of the first track (0) ; hold system boot information. It does NOT hold a short boot routine! ; the image is: ; self: jr self ; hang if booted and run ; defw loadpt ; where to load the opsys image ; defw bios ; where to go after booting system ; defw length ; length of image in 128 byte sectors ; (* the rest of the sector is not used *) ; ; This sector image is loaded and inspected at 0FA00H during the boot process 001B esc equ 1BH ; ascii esc 0067' CD 0CCB' bootsys:call print 006A' 1B 3D 2A 3F defb esc,'=',20H+10,20H+31 006E' 2A 20 4B 41 defb '* KAYPRO 10 v 1.9E *',0 0072' 59 50 52 4F 0076' 20 31 30 20 007A' 76 20 31 2E 007E' 39 45 20 2A 0082' 00 ; DEFB ' BETA TEST ROM V 1.7a',0 0083' CD 0107' doagain:call check ; is floppy alive? 0086' 3E 00 ld a,hdsel ; parms for hard disk 0088' 32 F701 ld (adsk),a 008B' 3E 44 ld a,68 008D' 32 F702 ld (sectrk),a 0090' 28 0A jr z,loadit 0092' 3E FF ld a,fsel ; parms for floppy 0094' 32 F701 ld (adsk),a 0097' 3E 28 ld a,40 0099' 32 F702 ld (sectrk),a 009C' CD 0127' loadit: call ovload ; load overlay 009F' 0E 00 boot: ld c,0 00A1' CD 025F' call seldsk ; select disk, set density, do home after diskinit 00A4' 01 0000 ld bc,0 ; set track 00A7' CD 0233' call settrk 00AA' 0E 00 ld c,0 ; read the first sector 00AC' CD 023E' call setsec 00AF' 01 FA00 ld bc,0FA00H ; header sector to go here 00B2' CD 0293' call setdma 00B5' CD 0249' call read ; read sector to FA00 00B8' F3 di ; read does EI upon exit 00B9' B7 or a ; trouble reading? 00BA' 20 C7 jr nz,doagain ; tell crt 00BC' ED 4B FA02 ld bc,(0FA02H) ; where to load system image 00C0' 79 ld a,c ; system image? 00C1' FE E5 cp 0E5H 00C3' 28 BE jr z,doagain 00C5' ED 43 F717 ld (@dmaadr),bc 00C9' ED 43 FB2F ld (dmaadr),bc 00CD' ED 4B FA04 ld bc,(0FA04H) ; where to go after loading system 00D1' C5 push bc ; save for latter use 00D2' ED 4B FA06 ld bc,(0FA06H) ; length of system in 128 byte sectors Cold start routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-6 00D6' 41 ld b,c ; reg B holds # of sectors to load 00D7' 0E 01 ld c,1 ; initial sector (0 was header sector) 00D9' C5 cb1: push bc ; save sector count and current sector 00DA' CD 023E' call setsec ; select sector 00DD' CD 0249' call read 00E0' F3 di ; read does EI upon exit 00E1' C1 pop bc 00E2' B7 or a 00E3' 20 9E jr nz,doagain ; bad read of sector 00E5' 2A F717 ld hl,(@dmaadr) ; update dma address for next sector 00E8' 11 0080 ld de,128 ; new dma address 00EB' 19 add hl,de 00EC' 22 F717 ld (@dmaadr),hl 00EF' 22 FB2F ld (dmaadr),hl 00F2' 05 dec b 00F3' C8 ret z ; done booting goto system 00F4' 0C inc c ; bump sector count 00F5' 3A F702 ld a,(sectrk) ; over sectors/track? 00F8' B9 cp c 00F9' 20 DE jr nz,cb1 ; fetch another sector 00FB' 0E 10 ld c,16 ; first sector to read on next track 00FD' C5 push bc ; save counts 00FE' 01 0001 ld bc,1 ; set for next track 0101' CD 0233' call settrk 0104' C1 pop bc 0105' 18 D2 jr cb1 0107' CD 0116' check: call fndidx ; find index pulse 010A' C8 ret z ; no index, abort 010B' 06 08 ld b,8 ; delay while waiting for index to go away 010D' CD 07E4' call thnsd ; 8 MS 0110' DB 10 in a,(status) 0112' 2F cpl 0113' CB 4F bit 1,a ; 0=no floppy, 1=floppy 0115' C9 ret 0116' CD 05F1' fndidx: call $home ; home floppy 0119' 21 9000 ld hl,9000H 011C' DB 10 lp1: in a,(status) ; index pulse? 011E' CB 4F bit 1,a 0120' C0 ret nz ; index is nz, return if true 0121' 2B dec hl ; enough tries? 0122' 7C ld a,h 0123' B5 or l 0124' 20 F6 jr nz,lp1 0126' C9 ret 0127' CD 0130' ovload: call filhdr ; set up bogus error reporting system 012A' 3A F701 ld a,(adsk) ; is it possible to load overlay? 012D' B7 or a ; is not possible if hard disk is drive B: 012E' 28 11 jr z,loadovl ; go load overlay from hard disk 0130' 21 EE00 filhdr: ld hl,ovlram ; base of overlay, fill with no.op 0133' 06 10 ld b,16 ; *16 [or a, nop, ret] 0135' 36 B7 lp2: ld (hl),0B7H ; [or a] 0137' 23 inc hl Cold start routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-7 0138' 36 00 ld (hl),0 ; [nop] 013A' 23 inc hl 013B' 36 C9 ld (hl),0C9H ; [ret] 013D' 23 inc hl 013E' 10 F5 djnz lp2 0140' C9 ret 0141' 0E 01 loadovl:ld c,1 ; select drive B: 0143' CD 025F' call seldsk 0146' 01 0000 ld bc,0 ; track = 0 0149' CD 0233' call settrk 014C' 21 EE00 ld hl,ovlram ; set dma address 014F' 22 F717 ld (@dmaadr),hl 0152' 01 0000 ld bc,0 ; sector # 0155' C5 ldlp: push bc 0156' CD 023E' call setsec 0159' CD 0249' call read ; read sector 015C' C1 pop bc 015D' B7 or a 015E' 20 D0 jr nz,filhdr ; fault, set up bogus overlay, exit. 0160' 2A F717 ld hl,(@dmaadr) ; update dma address 0163' 11 0080 ld de,128 0166' 19 add hl,de 0167' 22 F717 ld (@dmaadr),hl 016A' 0C inc c 016B' 79 ld a,c 016C' FE 10 cp 16 ; load 2K sec# 0-15 016E' 20 E5 jr nz,ldlp 0170' 3A EE00 ld a,(ovlram) ; check for a jp inst 0173' FE C3 cp 0C3H 0175' 20 B9 jr nz,filhdr ; bad data in ram, fill header with default 0177' C9 ret title System device I/O routines. (C) 1983 By NLS .comment % ######################################################## ## ## ## KAYPRO 10 System ## ## ## ## By G. Ohnysty ## ## ## ## System device I/O routines ## ## ## ## Copyright (C) 1983 By Non-Linear Systems, Inc ## ## No warranty is made, expressed or implied. ## ## ## ######################################################## ## Date: 04/14/83 [01] ## ######################################################## % .z80 public kbdstat, kbdin, kbdout, ttystat, ttyin, ttyout, TTYOSTAT public liststat, list, devinit System device I/O routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-8 ;*************** ;* sio equates * ;*************** 0004 sio equ 04H ; base address of sio 0006 sioa0 equ sio+2 ; channel a command/status 0004 sioa1 equ sio+0 ; channel a data 0007 siob0 equ sio+3 ; channel b command/status 0005 siob1 equ sio+1 ; channel b data 000E sioc0 equ sio+10 ; channel a command/status 000C sioc1 equ sio+8 ; channel a data 000F siod0 equ sio+11 ; channel b command/status 000D siod1 equ sio+9 ; channel b data ; write registers 0-7 and control bits ; init registers in the following order 0,2,4,3,5,1 0000 WR0 equ 0 ; command register, crc reset, reg pointer ; bits 0-2 are register pointers to WRx and RRx ; bits 3-5 and commands as given bellow 0000 null equ 0 ; null command 0010 extrset equ 10H ; reset ext/status interrupts 0018 reset equ 18H ; channel reset 0020 ienrc equ 20H ; Enable Int on Next Rx Character 0028 rtip equ 28H ; disable transmitter (prevents buffer empty int.) ; and enable break (prevents under-run int.) ; (note: since the transmitter is disabled, ; no break characters are transmitted.) ; (also note: Transmitter output is High-Z, ; which is neither high nor low (niether 'Mark' ; nor all zero's. Value dependent upon pullup ; or pull down resistors or other external loading ; factors.) ) ; (note: Auto Turnaround is also enabled.) 0030 errset equ 30H ; error reset 0001 WR1 equ 1H ; interrupt enable and Wait/Ready modes 0001 esie equ 1H ; external/status interrupt enable 0002 tie equ 2H ; transmitter interrupt enable 0000 tid equ 0 ; transmitter interrupt disable 0004 statav equ 4H ; Status affects vector (z80 mode 2) (see WR2) ; bits 3-4 affect receive interrupt mode 0000 rid equ 0 ; receive interrupts disabled 0008 rifc equ 8H ; receive interrupt on first char only 0010 riep equ 10H ; recv interrupts enabled, parity err Special Recv Cond 0018 rie equ 18H ; same as riep but parity error not Special Recv Cond 0002 WR2 equ 2 ; interrupt vector address/pointer (chan b only) ; interrupt address (z80 reg I+WR2=interrupt address) ; returned as is if not statav above in wr1 ; if statav then bits 1-3 are modified as bellow: ; 000 ch b transmit buffer empty ; 001 ch b external/status change ; 010 ch b receive char available ; 011 ch b special receive condition (parity error, Rx overrun, ; framing error, end of frame(sdlc) ) System device I/O routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-9 ; 1xx ch a (* same vectors as for channel b above *) 0003 WR3 equ 3 ; receiver logic control and parameters 0001 re equ 1 ; receiver enable 0020 autoe equ 20H ; auto enable (use dcd and cts to enable recv and xmt ; bits 6-7 are receiver bits/character 0000 rbits5 equ 0 ; 5 bits/character 0040 rbits7 equ 40H ; 7 bits/character 0080 rbits6 equ 80H ; 6 bits/character 00C0 rbits8 equ 0C0H ; 8 bits/character 0004 WR4 equ 4 ; control bits that affect both xmt and recv 0001 pon equ 1 ; enable parity (parity on) 0002 pstate equ 2 ; parity even not pstate = parity odd ; bits 2-3 are number of stop bits 0000 syncmd equ 0 ; sync mode is to be selected 0004 sbits1 equ 4 ; 1 stop bit 0008 sbits5 equ 8H ; 1.5 stop bits 000C sbits2 equ 0CH ; 2 stop bits ; bits 6-7 control clock rate 0000 cr1 equ 0 ; data rate x1=clock rate 0040 cr16 equ 40H ; x16 0080 cr32 equ 80H ; x32 000C cr64 equ 0CH ; x64 0005 WR5 equ 5 ; control bits that affect xmt 0008 te equ 8H ; transmit enable 0010 break equ 10H ; send break ; bits 5-6 are number of bits/character to transmit 0000 tbits5 equ 0 ; 5 or less bits/character 0020 tbits7 equ 20H ; 7 bits/character 0040 tbits6 equ 40H ; 6 bits/character 0060 tbits8 equ 60H ; 8 bits/character 0002 rts equ 2 ; RTS output 0080 dtr equ 80H ; DTR output 0006 WR6 equ 6 ; sdlc transmit sync character 0007 WR7 equ 7 ; sdlc receive sync character ; read registers 0-2 and status bits 0000 rr0 equ 0 ; general recv and xmt status 0001 rca equ 1 ; receive character available 0002 intped equ 2 ; interrupt pending (ch a only) 0004 tbe equ 4 ; transmit buffer empty 0010 synhnt equ 10H ; sync/hunt 0008 dcd equ 8H ; DCD input 0020 cts equ 20H ; CTS input 0040 xmtundr equ 40H ; transmit underrun/ EOM 0080 brk equ 80H ; break/abort status 0001 rr1 equ 1 ; Special Receive conditions and Residue codes ; bits 4-7 are special receive conditions 0010 rpe equ 10H ; parity error 0020 rovr equ 20H ; Rx overrun error 0040 framerr equ 40H ; framing error System device I/O routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-10 0002 rr2 equ 2 ; interrupt vector address/pointer 0018 pdat equ 24 ; cent out data port (8 bit latch) 0014 bitport equ 20 ; system bit port for status and control ;0 floppy drive 0 select: 0=select, 1=deselect. ;1 floppy drive 1 select / hard disk controller reset: ; 0=floppy drive 1 select / hard disk controller reset, ; 1=floppy drive 1 deselect / hard disk controller enable, ;2 floppy drive side select line: 0=side 1, 1=side 0. ;3 parallel port output line, used (for example) for centronics data strobe. ;4 floppy motor control: 0=motor off, 1=motor on. ;5 floppy controller density select, 0=double density, 1=single density. ;6 parallel port input line, used (for example) for centronics busy line. ;7 bank select: 0=64K ram only, 1=rom, video ram and upper 32k ram select. ;*************** ;* baud rate * ;*************** 0000 bauda equ 00H ; baud rate generator for serial chan a (modem) 0008 baudb equ 08H ; baud rate generator for serial chan b (printer) ; baud rate factors, output to baudx to select baud rate 0002 baud10 equ 02H ; 110 baud rate 0005 baud30 equ 05H ; 300 baud rate 0007 baud12 equ 07H ; 1200 baud rate 000A baud24 equ 0AH ; 2400 baud rate 000C baud48 equ 0CH ; 4800 baud rate 000E baud96 equ 0EH ; 9600 baud rate 000F baud19k equ 0FH ; 19.2k baud rate subttl I/O configuration tables page System device I/O routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-11 I/O configuration tables 0178' 18 iotbint:defb reset ; reset sio channel 0179' 04 defb wr4 017A' 44 defb sbits1 or cr16 ; one stop bit, 16x clock 017B' 03 defb wr3 017C' C1 defb re or rbits8 ; recv enable, 8 bits/char 017D' 05 defb wr5 017E' E8 defb te or tbits8 or dtr ; xmt enable, 8bits/char, assert dtr 017F' 01 defb wr1 0180' 00 defb tid or rid ; xmt & recv interrupts disabled 0181' iotbend: 0009 tblen equ iotbend-iotbint ; table length 0181' 3E CF devinit:ld a,0cfh ; reset hard disk controller CF=(1100111) 0183' D3 14 out (bitport),a ; initialize bitport ^ 0185' 0E 07 ld c,siob0 0187' CD 018C' call tblout ; initialize channel 018A' 0E 0E ld c,sioc0 018C' 21 0178' tblout: ld hl,iotbint 018F' 06 09 ld b,tblen 0191' ED B3 otir 0193' C9 ret subttl Device I/O handlers page System device I/O routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-12 Device I/O handlers 0194' DB 07 kbdstat:in a,(siob0) ; kbd char avail? 0196' E6 01 and rca 0198' 3E 00 comout: ld a,0 019A' C8 ret z ; 0=no char 019B' 3E FF ld a,0FFH ; FF=char avail 019D' C9 ret 019E' CD 0194' kbdin: call kbdstat ; loop till char avail 01A1' 28 FB jr z,kbdin 01A3' DB 05 in a,(siob1) ; get char 01A5' CD 01B3' call kbdmap ; map out funny chars of vector pad and #'s 01A8' C9 ret 01A9' DB 07 kbdout: in a,(siob0) ; xmit buffer empty? 01AB' E6 04 and tbe 01AD' 28 FA jr z,kbdout 01AF' 79 ld a,c ; out character 01B0' D3 05 out (siob1),a 01B2' C9 ret 01B3' 21 01C8' kbdmap: ld hl,mapin ; input map table 01B6' 01 0013 ld bc,mapout-mapin ; table length 01B9' ED B1 cpir ; search table 01BB' C0 ret nz ; not found 01BC' 11 01C8' ld de,mapin ; make hl=table index 01BF' B7 or a ; hl-mapin=index 01C0' ED 52 sbc hl,de 01C2' 11 01DA' ld de,mapout-1 ; index 01C5' 19 add hl,de 01C6' 7E ld a,(hl) ; get char from mapout 01C7' C9 ret 01C8' F1 F2 F3 F4 mapin: defb 0F1H, 0F2H, 0F3H, 0F4H ; up, down, left, right arrows 01CC' B1 C0 C1 C2 defb 0B1H, 0C0H, 0C1H, 0C2H ; 0,1,2,3 01D0' D0 D1 D2 E1 defb 0D0H, 0D1H, 0D2H, 0E1H ; 4,5,6,7 01D4' E2 E3 E4 D3 defb 0E2H, 0E3H, 0E4H, 0D3H ; 8,9, '-', ',' 01D8' C3 B2 defb 0C3H, 0B2H ; return, '.' 01DA' FF defb 0FFH ; end of mapin table 01DB' 80 81 82 83 mapout: defb 80H, 81H, 82H, 83H ; vector pad, xlate in bios 01DF' 84 85 86 87 defb 84H, 85H, 86H, 87H 01E3' 88 89 8A 8B defb 88H, 89H, 8AH, 8BH 01E7' 8C 8D 8E 8F defb 8CH, 8DH, 8EH, 8FH 01EB' 90 91 defb 90H, 91H 01ED' DB 0E ttystat:in a,(sioc0) ; serial port status input 01EF' E6 01 and rca 01F1' 18 A5 JR COMOUT 01F3' CD 01ED' ttyin: call ttystat ; is a char ready? 01F6' 28 FB jr z,ttyin 01F8' DB 0C in a,(sioc1) 01FA' C9 ret 01FB' DB 0E ttyout: in a,(sioc0) ; output a char to serial port System device I/O routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-13 Device I/O handlers 01FD' E6 04 and tbe 01FF' 28 FA jr z,ttyout ; xmit buffer full? 0201' 79 ld a,c 0202' D3 0C out (sioc1),a ; xmit character 0204' C9 ret ; 0205' TTYOSTAT: ;TEST STATUS OF SERIAL OUTPUT 0205' DB 0F IN A,(SIOD0) 0207' E6 04 AND TBE ;TX BUF FULL ? 0209' 18 8D JR COMOUT ; ; list port centronics equates 0006 pready equ 6 ; bit in bit port 0003 pstrob equ 3 ; bit in bit port 020B' DB 14 liststat:in a,(bitport) ; centronics printer port status 020D' CB 77 bit pready,a 020F' 3E 00 ld a,0 0211' C0 ret nz ; 00=busy 0212' 3E FF ld a,0FFH ; FF=ready 0214' C9 ret 0215' CD 020B' list: call liststat ; is printer busy? 0218' 20 FB jr nz,list 021A' 79 ld a,c 021B' D3 18 out (pdat),a ; output char to printer 021D' DB 14 in a,(bitport) ; strb. printer 021F' CB 9F res pstrob,a 0221' D3 14 out (bitport),a 0223' CB DF set pstrob,a 0225' D3 14 out (bitport),a 0227' C9 ret title Dispatch to hard disk or floppy drive. (C) 1983 By NLS .comment % ######################################################## ## ## ## KAYPRO 10 System ## ## ## ## By G. Ohnysty ## ## ## ## Dispatch to hard disk or floppy drive ## ## ## ## Copyright (C) 1983 By Non-Linear Systems, Inc ## ## No warranty is made, expressed or implied. ## ## ## ######################################################## ## Date: 04/14/83 [01] ## ######################################################## % .z80 FFFF fsel equ -1 Dispatch to hard disk or floppy drive. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-14 Device I/O handlers dispatch macro x, y .xlist ld a,(dsktyp) cp hdsel jp z,x jp y .list endm 0228' home_dispatch: dispatch @home,$home 0233' settrk: dispatch @settrk,$settrk 023E' setsec: dispatch @setsec,$setsec 0249' read: dispatch @read,$read 0254' write: dispatch @write,$write 025F' 3A F701 seldsk: ld a,(adsk) ; hard disk = A:? 0262' FE 00 cp hdsel 0264' 20 16 jr nz,s2 ; if not then floppy=A:, hd=B: & C: 0266' CB 49 bit 1,c ; selecting hard of floppy 0268' 20 08 jr nz,s1 026A' 3E 00 ld a,hdsel ; set hard disk as selected drive 026C' 32 F700 ld (dsktyp),a 026F' C3 030A' jp @seldsk 0272' 3E FF s1: ld a,fsel ; set floppy as selected drive 0274' 32 F700 ld (dsktyp),a 0277' AF xor a 0278' 4F ld c,a 0279' C3 05DB' jp $seldsk 027C' 79 s2: ld a,c ; selecting floppy or hard 027D' B7 or a 027E' 28 0B jr z,s3 ; floppy 0280' D6 01 sub 1 ; hard disk is B: or C: xlate to 0,1 0282' 4F ld c,a 0283' 3E 00 ld a,hdsel ; set hard disk as selected drive 0285' 32 F700 ld (dsktyp),a 0288' C3 030A' jp @seldsk 028B' 3E FF s3: ld a,fsel ; set floppy disk as selected drive 028D' 32 F700 ld (dsktyp),a 0290' C3 05DB' jp $seldsk 0293' C5 setdma: push bc ; save dmaadr 0294' CD 0322' call @setdma ; set hd dmaadr 0297' C1 pop bc 0298' C3 05E7' jp $setdma ; now go do floppy 029B' CD 02EC' diskinit:call @diskinit ; do hd 029E' C3 05B9' jp $diskinit ; now floppy 02A1' CD 0482' diskoff:call @diskoff ; do hd 02A4' C3 07DB' jp $diskoff ; now floppy title Hard disk support routines. (C) 1983 By NLS .comment % ######################################################## ## ## ## KAYPRO 10 System ## Hard disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-15 Device I/O handlers ## ## ## By G. Ohnysty & M. Sherman ## ## ## ## Disk support routines (Deblocking hard disk) ## ## ## ## Copyright (C) 1983 By Non-Linear Systems, Inc ## ## No warranty is made, expressed or implied. ## ## ## ######################################################## ## Date: 04/14/83 [01] ## ######################################################## # # # Current revision: 1.9 20-Jun-83 # # Previous revision: 1.8 17-Jun-83 # # Previous revision: 1.7a 13-Jun-83 # # Previous revision: 1.7 08-Jun-83 # # Previous revision: 1.5 15-May-83 # # # # Changes: SEKOK tests drive ready as well as # # seek complete. G. Ohynsty, revision 1.9 # # Changes: SEKOK inserted into READY, which was # # the only routine using it. 4 bytes saved. # # M. Sherman, revision 1.8. # # Changes: DISKOFF now de-selects the hard disk # # by using a drive select mask on HDSEL to # # select drive 0, instead of using an "or 10h" # # to select drive 3. Reasons: Drive 3 is the # # floppy controller on the WD 1002 board, which # # isn't installed and always returns a 'drive # # ready" status. This messes up DISKOFF, which # # then tells the WD 1002 board to seek the floppy# # to track 305 (which it does) and wait until # # it's done, about .75 seconds later. # # Drive 0 was selected as the alternate because:# # 1) We try not to use that drive for reliability # # purposes, and # # 2) We can't get a cable over that connector on # # the WD 1002 board, anyway. (M. Sherman, # # version 1.7a) # # Changes: SEKOK modified to call HDBSY first, # # ( status bits are invalid if the controller # # is busy ) DISKOFF modified to call HDBSY # # instead of SEKOK. (M. Sherman, version 1.7) # # Changes: DISKINIT now re-enables the hard # # disk controller immediately after resetting # # it. ( A potential problem was discovered with # # holding the board in a reset state for long # # periods of time ) # # # ######################################################### % .z80 public @home, @seldsk, @settrk, @setsec, @setdma, @read, @write public @diskinit, @diskoff Hard disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-16 Device I/O handlers 0014 bitport equ 20 ; bit port (m80 does not support extrn bytes) 00C9 retcod equ 0C9H ; return op code 0066 nmivec equ 0066H ; non-maskable interupt vector (used in rd/wt loop) ; Hard Disk Definitions: ;ports: 0080 hdbase equ 80h 0080 hddata equ hdbase ; data register 0081 hdetyp equ hdbase+1 ; error type register 0081 hdwrtp equ hdbase+1 ; write precomp cylinder/4 0082 hdscnt equ hdbase+2 ; number of sectors count 0083 hdsec equ hdbase+3 ; first sector to read/write 0084 hdclo equ hdbase+4 ; cylinder number low byte 0085 hdchi equ hdbase+5 ; cylinder number high byte 0086 hdsdh equ hdbase+6 ; size/drive/head register 0087 hdcmd equ hdbase+7 ; command register 0087 hdstat equ hdbase+7 ; status register ;commands: 0002 longrw equ 00000010b ; long read/write bit 0004 multrw equ 00000100b ; multiple read/write bit 0008 hddmam equ 00001000b ; dma mode on read bit 0000 rt35uS equ 00000000b ; 035 uS step rate (fastest) 0001 rt05mS equ 00000001b ; 0.5 mS step rate (rest in inc. of this one) 0002 rt10mS equ rt05mS*2 ; 1.0 mS step rate 0006 rt30mS equ rt05mS*6 ; 3.0 mS step rate 000C rt60mS equ rt05mS*12 ; 6.0 mS step rate 000F rt75mS equ rt05mS*15 ; 7.5 mS step rate (slowest) 0080 eccmod equ 10000000b ; error correcting mode 0020 sec512 equ 00100000b ; 512 byte sector size 00A8 hdselh equ 10101000b ; select hard disk drive 00E7 hdsmsk equ 11100111b ; drive select mask 001C hdinir equ 00010000b+rt60mS ; restore used for initialization 0011 hdrstr equ 00010000b+rt05mS ; restore used for normal home command 0070 hdseek equ 01110000b+rt35uS ; fast seek 0020 hdred equ 00100000b ; read sector 0022 hdredl equ 00100000b+longrw ; long read (sector + ECC bytes) 0030 hdwrt equ 00110000b ; write sector 0032 hdwrtl equ 00110000b+longrw ; long write (sector + ECC bytes) ; hard disk info 0131 lzone equ 305 ; safety zone 0131 maxcyl equ 305 ; same as safety zone (see dsm) ; for use with bitport 0002 hdcres equ 00000010b ; hard disk controller reset mask wm01 00FD hdcsel equ 11111101b ; hard disk controller select bit wm01 page Hard disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-17 Device I/O handlers ; This section defines the disk parameters (dph's are images @moved to RAM) 02A7' 0000 0000 dph0h: defw 0,0,0,0 ; dph for unit A: 02AB' 0000 0000 02AF' F928 FB0C defw @dirbuf,@dpbh ; directory buffer, Disk Parameter Block 02B3' 0000 F9A8 defw 0, @alva ; check sum pointer, allocation map pointer 02B7' 0000 0000 defw 0,0,0,0 ; dph for unit B: 02BB' 0000 0000 02BF' F928 FB0C defw @dirbuf,@dpbh ; directory buffer, Disk Parameter Block 02C3' 0000 FA4A defw 0, @alvb ; check sum pointer, allocation map pointer ;@dpbh: 02C7' 0044 defw 68 ; (spt) sectors per track 02C9' 05 defb 5 ; (bsh) block shift factor 02CA' 1F defb 31 ; (blm) block mask 02CB' 01 defb 1 ; (exm) extent mask 02CC' 0465 defw 1125 ; (dsm) max logical block # (max 1282) ; dsm is 1125 to allow for safety zone 02CE' 03FF defw 1023 ; (drm) max directory # 02D0' FF defb 0FFH ; (al0) directory allocation map 02D1' 00 defb 00H ; (al1) 02D2' 0000 defw 0 ; (cks) size of directory check vector 02D4' 0004 defw 4 ; (off) reserved tracks 02D6' enddphh: subttl Logical BIOS entry points & Deblocking page Hard disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-18 Logical BIOS entry points & Deblocking .8080 ;***************************************************** ;* Logical BIOS entry points * ;* Sector Deblocking Algorithms * ;***************************************************** 1000 blksizh equ 4096 ;CP/M allocation size 0200 hstsiz equ 512 ;host disk sector size 0011 hstspth equ 17 ;host disk sectors/trk 0004 hstblk equ hstsiz/128 ;CP/M sects/host buff 0044 cpmspth equ hstblk * hstspth ;CP/M sectors/track 0003 secmsk equ hstblk-1 ;sector mask 0002 secshf equ 2 ;log2(hstblk) sector mask 0000 wrall equ 0 ;write to allocated 0001 wrdir equ 1 ;write to directory 0002 wrual equ 2 ;write to unallocated .z80 02D6' hdcinit: ; reset hard disk controller on power-up and hold it there ; until the controller is properly powered up (100 milliseconds ; to 2 seconds) and the hard disk unit is stabilized (1 to 3 seconds) 02D6' DB 14 in a,(bitport) ; reset controller 02D8' F6 02 or hdcres ; reset if bit 1 = 1 wm01 02DA' D3 14 out (bitport),a 02DC' F5 push af ; save a wm01 ; ;decrement b's A0h and dec b through [100H = (256)] - (02 - first dec) time ; 02DD' 01 A002 ld bc,0A002H ; delay four seconds [(01x100H)+A0H)] wm01 02E0' CD 07E4' delay4: call thnsd ; delay loop (each b bit = .001 sec) wm01 02E3' 0D dec c ; done wm01 02E4' 20 FA jr nz,delay4 ; jif not done wm01 02E6' F1 pop af ; retrieve acc wm01 02E7' E6 FD and hdcsel ; select if bit 1 = 0 wm01 02E9' D3 14 out (bitport),a ; select controller 02EB' C9 ret 02EC' @diskinit: ;enter here on system boot to initialize 02EC' 21 057C' ld hl,ioimageh ;@move rd/wrt routines into RAM 02EF' 11 F919 ld de,@move 02F2' 01 000F ld bc,image_length 02F5' ED B0 ldir 02F7' 21 02A7' ld hl,dph0h ; set dph's 02FA' 11 FAEC ld de,@dpha 02FD' 01 002F ld bc,enddphh-dph0h 0300' ED B0 ldir .8080 0302' AF xra a ;0 to accumulator 0303' 32 F70C sta @hstact ;host buffer inactive 0306' 32 F70E sta @unacnt ;clear unalloc count 0309' C9 ret 030A' @seldsk: ;select disk 030A' 79 mov a,c ;selected disk number Hard disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-19 Logical BIOS entry points & Deblocking 030B' 32 F703 sta @sekdsk ;seek disk number 030E' 21 0000 lxi h,0 ;does disk exist? 0311' FE 02 cpi 2 0313' D0 rnc 0314' 21 FAEC lxi h,@dpha ;dph for drive a 0317' B7 ora a 0318' C8 rz 0319' 21 FAFC lxi h,@dphb ;dph for drive b 031C' C9 ret 031D' @setsec: ;set sector given by register c 031D' 79 mov a,c 031E' 32 F706 sta @seksec ;sector to seek 0321' C9 ret .z80 0322' ED 43 F717 @setdma: ld (@dmaadr),bc ;set dma address given by BC 0326' C9 ret 0327' ED 43 F704 @settrk: ld (@sektrk),bc ;set track given by registers BC .8080 032B' C9 ret 032C' 3A F70D @home: lda @hstwrt ; (patch by DRI) host written flag 032F' B7 ora a ; written ? .z80 0330' 20 03 jr nz,homedh ; jif not written wm01 .8080 0332' 32 F70C sta @hstact ; else store in host active 0335' C3 046F' homedh: jmp dohomeh ; go do home disk drive 0338' @read: ;read the selected CP/M sector 0338' AF xra a ; a patch by DRI 0339' 32 F70E sta @unacnt 033C' 3E 01 mvi a,1 033E' 32 F715 sta @readop ;read operation 0341' 32 F714 sta @rsflag ;must read data 0344' 3E 02 mvi a,wrual 0346' 32 F716 sta @wrtype ;treat as unalloc .z80 0349' 18 64 jr rwoperh ;to perform the read wm01 .8080 034B' @write: ;write the selected CP/M sector 034B' AF xra a ;0 to accumulator 034C' 32 F715 sta @readop ;not a read operation 034F' 79 mov a,c ;write type in c 0350' 32 F716 sta @wrtype 0353' FE 02 cpi wrual ;write unallocated? .z80 0355' 20 17 jr nz,chkunah ;check for unalloc wm01 .8080 ; write to unallocated, set parameters 0357' 3E 20 mvi a,blksizh/128 ;next unalloc recs 0359' 32 F70E sta @unacnt Hard disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-20 Logical BIOS entry points & Deblocking 035C' 3A F703 lda @sekdsk ;disk to seek 035F' 32 F70F sta @unadsk ;@unadsk = @sekdsk 0362' 2A F704 lhld @sektrk 0365' 22 F710 shld @unatrk ;@unatrk = sectrk 0368' 3A F706 lda @seksec 036B' 32 F712 sta @unasec ;@unasec = @seksec 036E' chkunah: ;check for write to unallocated sector 036E' 3A F70E lda @unacnt ;any unalloc remain? 0371' B7 ora a .z80 0372' 28 33 jr z,alloch ;skip if not wm01 .8080 ; more unallocated records remain 0374' 3D dcr a ;@unacnt = @unacnt-1 0375' 32 F70E sta @unacnt 0378' 3A F703 lda @sekdsk ;same disk? 037B' 21 F70F lxi h,@unadsk 037E' BE cmp m ;@sekdsk = @unadsk? .z80 037F' 20 26 jr nz,alloch ;skip if not wm01 .8080 ; disks are the same 0381' 21 F710 lxi h,@unatrk 0384' CD 0443' call @sektrkcmp ;@sektrk = @unatrk? .z80 0387' 20 1E jr nz,alloch ;skip if not wm01 .8080 ; tracks are the same 0389' 3A F706 lda @seksec ;same sector? 038C' 21 F712 lxi h,@unasec 038F' BE cmp m ;@seksec = @unasec? .z80 0390' 20 15 jr nz,alloch ;skip if not wm01 .8080 ; match, @move to next sector for future ref 0392' 34 inr m ;@unasec = @unasec+1 0393' 7E mov a,m ;end of track? 0394' FE 44 cpi cpmspth ;count CP/M sectors .z80 0396' 38 09 jr c,noovfh ;skip if no overflow .8080 ; ; overflow to next track 0398' 36 00 mvi m,0 ;@unasec = 0 039A' 2A F710 lhld @unatrk 039D' 23 inx h 039E' 22 F710 shld @unatrk ;@unatrk = @unatrk+1 03A1' noovfh: ;match found, mark as unnecessary read Hard disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-21 Logical BIOS entry points & Deblocking 03A1' AF xra a ;0 to accumulator 03A2' 32 F714 sta @rsflag ;@rsflag = 0 .z80 03A5' 18 08 jr rwoperh ;to perform the write wm02 .8080 03A7' alloch: ;not an unallocated record, requires pre-read 03A7' AF xra a ;0 to accum 03A8' 32 F70E sta @unacnt ;@unacnt = 0 03AB' 3C inr a ;1 to accum 03AC' 32 F714 sta @rsflag ;@rsflag = 1 ;* Common code for READ and WRITE follows *; 03AF' rwoperh: ;enter here to perform the read/write 03AF' AF xra a ;zero to accum 03B0' 32 F713 sta @erflag ;no errors (yet) 03B3' 3A F706 lda @seksec ;compute host sector 03B6' B7 ora a ;carry = 0 03B7' 1F rar ;shift right 03B8' B7 ora a ;carry = 0 03B9' 1F rar ;shift right 03BA' 32 F70B sta @sekhst ;host sector to seek ; active host sector? 03BD' 21 F70C lxi h,@hstact ;host active flag 03C0' 7E mov a,m 03C1' 36 01 mvi m,1 ;always becomes 1 03C3' B7 ora a ;was it already? .z80 03C4' 28 21 jr z,filhsth ;fill host if not wm02 .8080 ; host buffer active, same as seek buffer? 03C6' 3A F703 lda @sekdsk 03C9' 21 F707 lxi h,@hstdsk ;same disk? 03CC' BE cmp m ;@sekdsk = @hstdsk? .z80 03CD' 20 11 jr nz,nomatchh ;wm02 .8080 ; same disk, same track? 03CF' 21 F708 lxi h,@hsttrk 03D2' CD 0443' call @sektrkcmp ;@sektrk = @hsttrk? .z80 03D5' 20 09 jr nz,nomatchh ;wm02 .8080 ; same disk, same track, same buffer? 03D7' 3A F70B lda @sekhst 03DA' 21 F70A lxi h,@hstsec ;@sekhst = @hstsec? 03DD' BE cmp m .z80 03DE' 28 24 jr z,matchh ;skip if match wm02 Hard disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-22 Logical BIOS entry points & Deblocking .8080 03E0' nomatchh: ;proper disk, but not correct sector 03E0' 3A F70D lda @hstwrt ;host written? 03E3' B7 ora a 03E4' C4 0456' cnz writehsth ;clear host buff 03E7' filhsth: ;may have to fill the host buffer 03E7' 3A F703 lda @sekdsk 03EA' 32 F707 sta @hstdsk 03ED' 2A F704 lhld @sektrk 03F0' 22 F708 shld @hsttrk 03F3' 3A F70B lda @sekhst 03F6' 32 F70A sta @hstsec 03F9' 3A F714 lda @rsflag ;need to read? 03FC' B7 ora a 03FD' C4 044F' cnz readhsth ;yes, if 1 0400' AF xra a ;0 to accum 0401' 32 F70D sta @hstwrt ;no pending write 0404' matchh: ;copy data to or from buffer 0404' 3A F706 lda @seksec ;mask buffer number 0407' E6 03 ani secmsk ;least signif bits 0409' 6F mov l,a ;ready to shift 040A' 26 00 mvi h,0 ;double count 040C' 29 dad h ;shift left 7 040D' 29 dad h 040E' 29 dad h 040F' 29 dad h 0410' 29 dad h 0411' 29 dad h 0412' 29 dad h ; hl has relative host buffer address .z80 0413' 11 F719 ld de,@hstbuf 0416' 19 add hl,de ;hl = host address 0417' ED 5B F717 ld de,(@dmaadr) ;de = dma address 041B' 01 0080 ld bc,128 ;length 041E' 3A F715 ld a,(@readop) ;which way? 0421' B7 or a 0422' 20 06 jr nz,rw@move ;skip if read ; write operation, mark and switch direction 0424' 3E 01 ld a,1 0426' 32 F70D ld (@hstwrt),a ;@hstwrt = 1 0429' EB ex de,hl ;source/dest swap 042A' CD F919 rw@move: call @move ;@move a logical sector to/from buffer .8080 ; data has been @moved to/from host buffer 042D' 3A F716 lda @wrtype ;write type 0430' FE 01 cpi wrdir ;to directory? Hard disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-23 Logical BIOS entry points & Deblocking 0432' 3A F713 lda @erflag ;in case of errors 0435' C0 rnz ;no further processing ; clear host buffer for directory write 0436' B7 ora a ;errors? 0437' C0 rnz ;skip if so 0438' AF xra a ;0 to accum 0439' 32 F70D sta @hstwrt ;buffer written 043C' CD 0456' call writehsth 043F' 3A F713 lda @erflag 0442' C9 ret ;* Utility subroutine for 16-bit compare *; 0443' @sektrkcmp: ;HL = .@unatrk or .@hsttrk, compare with @sektrk ; .z80 ; ld bc,(@sektrk) ; or a ; clear carry ; sbc hl,bc ; hl=hl-bc ; ret ; return status 0443' EB xchg 0444' 21 F704 lxi h,@sektrk 0447' 1A ldax d ;low byte compare 0448' BE cmp m ;same? 0449' C0 rnz ;return if not ; low bytes equal, test high 1s 044A' 13 inx d 044B' 23 inx h 044C' 1A ldax d 044D' BE cmp m ;sets flags 044E' C9 ret .z80 044F' CD 045D' readhsth:call hstcomh 0452' CD 0540' call hdread 0455' C9 ret 0456' CD 045D' writehsth:call hstcomh 0459' CD 04EE' call hdwrite 045C' C9 ret 045D' CD 04C3' hstcomh:call readyh 0460' ED 4B F708 ld bc,(@hsttrk) 0464' CD 049E' call trkseth 0467' 3A F70A ld a,(@hstsec) 046A' 4F ld c,a 046B' CD 04BF' call secseth 046E' C9 ret 046F' CD 04C3' dohomeh:call readyh 0472' AF xor a ; seek cyl 0 0473' D3 84 out (hdclo),a 0475' D3 85 out (hdchi),a 0477' 3E 70 ld a,hdseek 0479' D3 87 out (hdcmd),a ; set future (implied) seek speed Hard disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-24 Logical BIOS entry points & Deblocking 047B' DB 87 hdbsy: in a,(hdstat) ; controller busy? 047D' E6 80 and 80h 047F' 20 FA jr nz,hdbsy 0481' C9 ret 0482' DB 87 @diskoff:in a,(hdstat) ; is it not busy and ready? 0484' CB 7F bit 7,a 0486' C0 ret nz ; controller busy, exit. 0487' CB 77 bit 6,a 0489' C8 ret z ; selected disk not ready, exit. 048A' 3E 31 ld a, low lzone ; seek lzone 048C' D3 84 out (hdclo),a 048E' 3E 01 ld a, high lzone 0490' D3 85 out (hdchi),a 0492' 3E 70 ld a,hdseek 0494' D3 87 out (hdcmd),a 0496' CD 047B' call hdbsy ; wait till controller is finished issuing seek, 0499' 3E A0 ld a,hdselh and hdsmsk ; de-select drive 049B' D3 86 out (hdsdh),a 049D' C9 ret ; system is on tracks 0 and 1 ; spares are on tracks 2 and 3 ; the dir is on 4,6,8,10 ; dup dir is on 5,7,9,11 ; and data starts on 12 049E' 21 0004 trkseth:ld hl,4 ; track >7 then +4 04A1' 79 ld a,c 04A2' E6 F8 and 0F8H 04A4' B0 or b 04A5' 20 0C jr nz,.set 04A7' 21 0000 ld hl,0 ; then rest are +0 04AA' 79 ld a,c 04AB' FE 04 cp 4 ; track <4 then no change 04AD' 38 04 jr c,.set 04AF' D6 04 sub 4 ; form 4,6,8,10 04B1' 81 add a,c 04B2' 4F ld c,a 04B3' 09 .set: add hl,bc ; hl is track number 04B4' CB 3C srl h ; msb is head select 04B6' CB 1D rr l 04B8' 7D ld a,l 04B9' D3 84 out (hdclo),a ; to controller 04BB' 7C ld a,h 04BC' D3 85 out (hdchi),a 04BE' C9 ret 04BF' 79 secseth:ld a,c 04C0' D3 83 out (hdsec),a 04C2' C9 ret 04C3' DB 14 readyh: in a,(bitport) 04C5' E6 FD and hdcsel ; select controller, clear reset 04C7' D3 14 out (bitport),a 04C9' CD 047B' call hdbsy ; controller busy? Hard disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-25 Logical BIOS entry points & Deblocking 04CC' 3E A8 ld a,hdselh ; select drive 04CE' D3 86 out (hdsdh),a 04D0' CD 047B' sekok: call hdbsy ; make sure controller isn't busy first 04D3' DB 87 in a,(hdstat) ; seek done? 04D5' 2F cpl ; ones' complement, 04D6' E6 50 and 01010000b ; are drive ready and seek complete true? 04D8' 20 F6 jr nz,sekok ; no, keep waiting, else - 04DA' 3A F708 ld a,(@hsttrk) ; select head 04DD' E6 01 and 1 04DF' F6 A8 or hdselh 04E1' C5 push bc ; save conts of bc 04E2' 47 ld b,a 04E3' 3A F707 ld a,(@hstdsk) ; select heads 0-1, or 2-3 04E6' 17 rla ; using disk # 04E7' E6 02 and 2 04E9' B0 or b 04EA' C1 pop bc ; restore bc 04EB' D3 86 out (hdsdh),a 04ED' C9 ret 04EE' CD 0517' hdwrite:call hrdwrt ; write sector 04F1' C4 EE00 call nz,wrt.err ; if error try to recover 04F4' 32 F713 ld (@erflag),a ; set error flag to proper status 04F7' DB 85 in a,(hdchi) ; do dup write? 04F9' B7 or a 04FA' C0 ret nz ; dup write on cly<6 only 04FB' DB 84 in a,(hdclo) 04FD' FE 06 cp 6 04FF' D0 ret nc 0500' DB 86 in a,(hdsdh) ; get head 0502' EE 01 xor 1 ; flip to other side 0504' D3 86 out (hdsdh),a 0506' CD 0517' call hrdwrt ; do write 0509' C4 EE00 call nz,wrt.err ; if error try to recover 050C' 08 ex af,af ; save error flag of 2nd write 050D' 3A F713 ld a,(@erflag) ; was 1st an error? 0510' B7 or a 0511' C8 ret z ; no so ret ok! (avoid giving cp/m a bad sec) 0512' 08 ex af,af ; else return status of 2nd write 0513' 32 F713 ld (@erflag),a ; as it MAY be ok. 0516' C9 ret 0517' DB 84 hrdwrt: in a,(hdclo) 0519' D3 84 out (hdclo),a ; clear data request line. 051B' 01 0080 ld bc,0000h+hddata 051E' 21 F719 ld hl,@hstbuf 0521' 3E 30 ld a,hdwrt ; that's right, you 0523' D3 87 out (hdcmd),a ; issue the command 0525' ED B3 otir ; before the data. 0527' ED B3 otir 0529' CD 047B' call hdbsy 052C' E6 01 and 01 ; error flag 052E' 3E FF ld a,0FFH ; write ok? 0530' C0 ret nz ; return if not 0531' 3E 20 ld a,hdred ; do read after write verify 0533' D3 87 out (hdcmd),a Hard disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-26 Logical BIOS entry points & Deblocking 0535' CD 047B' call hdbsy 0538' DB 87 in a,(hdstat) ; get status of read 053A' E6 01 and 1 053C' C8 ret z 053D' 3E FF ld a,0FFH 053F' C9 ret 0540' CD 0563' hdread: call hdrd ; read sector 0543' C4 EE03 call nz,rd.err ; if error try to recover 0546' 32 F713 ld (@erflag),a 0549' C8 ret z ; read op ok 054A' DB 85 in a,(hdchi) ; try other side of platter? 054C' B7 or a 054D' C0 ret nz ; cly # to big 054E' DB 84 in a,(hdclo) 0550' FE 06 cp 6 0552' D0 ret nc 0553' DB 86 in a,(hdsdh) ; flip to other side 0555' EE 01 xor 1 0557' D3 86 out (hdsdh),a 0559' CD 0563' call hdrd 055C' C4 EE03 call nz,rd.err ; error, try to recover 055F' 32 F713 ld (@erflag),a 0562' C9 ret 0563' 3E 20 hdrd: ld a,hdred ; read a sector 0565' D3 87 out (hdcmd),a 0567' 01 0080 ld bc,0000h+hddata 056A' 21 F719 ld hl,@hstbuf 056D' CD 047B' call hdbsy 0570' ED B2 inir ; get bytes before checking status 0572' ED B2 inir ; so that even if sector is bad 0574' DB 87 in a,(hdstat) ; some of it may be recovered 0576' E6 01 and 01 0578' C8 ret z ; no error 0579' 3E FF ld a,0FFH ; error flag 057B' C9 ret ; 057C' ioimageh: ;@move: ; block memory @move, turn rom on/off 057C' DB 14 in a,(bitport) ; turn rom off 057E' CB BF res 7,a 0580' D3 14 out (bitport),a 0582' ED B0 ldir ; @move logical sector from @hstbuf 0584' DB 14 in a,(bitport) ; turn rom back on 0586' CB FF set 7,a 0588' D3 14 out (bitport),a 058A' C9 ret ; back to rom 000F image_length equ $-ioimageh ; length of this image title Floppy disk support routines. (C) 1983 By NLS .comment % ######################################################## ## ## ## KAYPRO 10 System ## ## ## Floppy disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-27 Logical BIOS entry points & Deblocking ## By G. Ohnysty ## ## ## ## Disk support routines (Deblocking for floppy) ## ## ## ## Copyright (C) 1983 By Non-Linear Systems, Inc ## ## No warranty is made, expressed or implied. ## ## ## ######################################################## ## Date: 04/14/83 [01] ## ######################################################## % .z80 public $home, $seldsk, $settrk, $setsec, $setdma, $read, $write, sectran public $diskinit, diskon, $diskoff, thnsd 0014 bitport equ 20 ; bit port (m80 does not support extrn bytes) 00FE drvmask equ 0FEH ; drive select mask 00DF denmask equ 0DFH ; density bit mask 0000 driveA equ 00H ; drive A select bit 0000 ddbit equ 00H ; double density bit 0020 sdbit equ 20H ; single density bit 00FB sidmask equ 0FBH ; side select mask 0004 sid0 equ 4H ; side 0 bit 0000 sid1 equ 0H ; side 1 bit 0010 control equ 16 ; I/O port of disk controller 0010 status equ control+0 ; status register 0010 cmnd equ control+0 ; command register 0011 track equ control+1 ; track register 0012 sector equ control+2 ; sector register 0013 data equ control+3 ; data register 00D0 ficmd equ 11010000B ; force interrupt (Abort current command) 0088 rdcmd equ 10001000B ; read command 00AC wrtcmd equ 10101100B ; write command ;*************************************************************************** ;* seek time at a clock rate of 1 MHZ WM01 * ;* * ;* bits 1 0 seek time * ;* 0 0 6 ms * ;* 0 1 12 ms * ;* 1 0 20 ms * ;* 1 1 30 ms * ;*************************************************************************** 0010 seekcmd equ 00010000B ; seek command WM01 0000 rstcmd equ 00000000B ; home (restore) command 00C4 adrcmd equ 11000100B ; read track address 009C rdmask equ 10011100B ; read status mask 00FC wrtmask equ 11111100B ; write status mask 0002 tries1 equ 2 ; re-home on bad sector # of tries+1 0005 tries2 equ 5 ; re-read/write # of retries+1 00C2 ssmblk equ 194 0184 dsmblk equ ssmblk*2 00C9 retcod equ 0C9H ; return op code 0066 nmivec equ 0066H ; non-maskable interupt vector (used in rd/wt loop) page Floppy disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-28 Logical BIOS entry points & Deblocking ; This section defines the disk parameters (dph's are images moved to RAM) 058B' 0000 0000 dph0: defw 0,0,0,0 ; dph for unit A: 058F' 0000 0000 0593' FE3B FD85 defw dirbuf,$dpb ; directory buffer, Disk Parameter Block 0597' FD33 FD43 defw csva, alva ; check sum pointer, allocation map pointer ;dpb ;( double density ); 059B' 0028 defw 40 ; (spt) sectors per track 059D' 03 defb 3 ; (bsh) block shift factor 059E' 07 defb 7 ; (blm) block mask 059F' 00 defb 0 ; (exm) extent mask 05A0' 00C2 defw 194 ; (dsm) max logical block # 05A2' 003F defw 63 ; (drm) max directory # 05A4' F0 defb 0F0H ; (al0) directory allocation map & BIOS space 05A5' 00 defb 00H ; (al1) 05A6' 0010 defw 16 ; (cks) size of directory check vector 05A8' 0001 defw 1 ; (off) reserved tracks 05AA' enddph: 05AA' dpb: ;( double sided double density ); 05AA' 0028 defw 40 ; (spt) sectors per track 05AC' 04 defb 4 ; (bsh) block shift factor 05AD' 0F defb 15 ; (blm) block mask 05AE' 01 defb 1 ; (exm) extent mask 05AF' 00C4 defw 196 ; (dsm) max logical block # 05B1' 003F defw 63 ; (drm) max directory # 05B3' C0 defb 0C0H ; (al0) directory allocation map & BIOS space 05B4' 00 defb 00H ; (al1) 05B5' 0010 defw 16 ; (cks) size of directory check vector 05B7' 0001 defw 1 ; (off) reserved tracks subttl Logical BIOS entry points & Deblocking page Floppy disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-29 Logical BIOS entry points & Deblocking .8080 ;***************************************************** ;* Logical BIOS entry points * ;* Sector Deblocking Algorithms * ;***************************************************** 0400 blksiz equ 1024 ;CP/M allocation size 0200 hstsiz equ 512 ;host disk sector size 000A hstspt equ 10 ;host disk sectors/trk 0004 hstblk equ hstsiz/128 ;CP/M sects/host buff 0028 cpmspt equ hstblk * hstspt ;CP/M sectors/track 0003 secmsk equ hstblk-1 ;sector mask 0002 secshf equ 2 ;log2(hstblk) sector mask 0000 wrall equ 0 ;write to allocated 0001 wrdir equ 1 ;write to directory 0002 wrual equ 2 ;write to unallocated 05B9' $diskinit: ;enter here on system boot to initialize .z80 05B9' 21 0867' ld hl,ioimage ;move rd/wrt routines into RAM 05BC' 11 FD9A ld de,move 05BF' 01 0087 ld bc,imaglen 05C2' ED B0 ldir 05C4' 21 058B' ld hl,dph0 ; set dph's 05C7' 11 FD75 ld de,dpha 05CA' 01 001F ld bc,enddph-dph0 05CD' ED B0 ldir .8080 05CF' AF xra a ;0 to accumulator 05D0' 32 FB24 sta hstact ;host buffer inactive 05D3' 32 FB26 sta unacnt ;clear unalloc count 05D6' 2F cma 05D7' 32 FD31 sta dsk ;clear disk number 05DA' C9 ret 05DB' $seldsk: ;select disk 05DB' 79 mov a,c ;selected disk number 05DC' 32 FB1B sta sekdsk ;seek disk number 05DF' C3 0714' jmp dsksel ;physical disk select (If needed to check den) 05E2' $setsec: ;set sector given by register c 05E2' 79 mov a,c 05E3' 32 FB1E sta seksec ;sector to seek 05E6' C9 ret .z80 05E7' ED 43 FB2F $setdma: ld (dmaadr),bc ;set dma address given by BC 05EB' C9 ret 05EC' ED 43 FB1C $settrk: ld (sektrk),bc ;set track given by registers BC .8080 05F0' C9 ret 05F1' 3A FB25 $home: lda hstwrt ; patch by DRI 05F4' B7 ora a Floppy disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-30 Logical BIOS entry points & Deblocking .z80 05F5' 20 03 jr nz,homed ; wm02 .8080 05F7' 32 FB24 sta hstact 05FA' C3 076C' homed: jmp dohome ; go do home disk drive 05FD' $read: ;read the selected CP/M sector 05FD' AF xra a ; a patch by DRI 05FE' 32 FB26 sta unacnt 0601' 3E 01 mvi a,1 0603' 32 FB2D sta readop ;read operation 0606' 32 FB2C sta rsflag ;must read data 0609' 3E 02 mvi a,wrual 060B' 32 FB2E sta wrtype ;treat as unalloc .z80 060E' 18 64 jr rwoper ;to perform the read wm02 .8080 0610' $write: ;write the selected CP/M sector 0610' AF xra a ;0 to accumulator 0611' 32 FB2D sta readop ;not a read operation 0614' 79 mov a,c ;write type in c 0615' 32 FB2E sta wrtype 0618' FE 02 cpi wrual ;write unallocated? .z80 061A' 20 17 jr nz,chkuna ;check for unalloc wm02 .8080 ; write to unallocated, set parameters 061C' 3E 08 mvi a,blksiz/128 ;next unalloc recs 061E' 32 FB26 sta unacnt 0621' 3A FB1B lda sekdsk ;disk to seek 0624' 32 FB27 sta unadsk ;unadsk = sekdsk 0627' 2A FB1C lhld sektrk 062A' 22 FB28 shld unatrk ;unatrk = sectrk 062D' 3A FB1E lda seksec 0630' 32 FB2A sta unasec ;unasec = seksec 0633' chkuna: ;check for write to unallocated sector 0633' 3A FB26 lda unacnt ;any unalloc remain? 0636' B7 ora a .z80 0637' 28 33 jr z,alloc ;skip if not wm02 .8080 ; more unallocated records remain 0639' 3D dcr a ;unacnt = unacnt-1 063A' 32 FB26 sta unacnt 063D' 3A FB1B lda sekdsk ;same disk? 0640' 21 FB27 lxi h,unadsk 0643' BE cmp m ;sekdsk = unadsk? .z80 0644' 20 26 jr nz,alloc ;skip if not wm02 .8080 Floppy disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-31 Logical BIOS entry points & Deblocking ; disks are the same 0646' 21 FB28 lxi h,unatrk 0649' CD 0708' call sektrkcmp ;sektrk = unatrk? .z80 064C' 20 1E jr nz,alloc ;skip if not wm02 .8080 ; tracks are the same 064E' 3A FB1E lda seksec ;same sector? 0651' 21 FB2A lxi h,unasec 0654' BE cmp m ;seksec = unasec? .z80 0655' 20 15 jr nz,alloc ;skip if not wm02 .8080 ; match, move to next sector for future ref 0657' 34 inr m ;unasec = unasec+1 0658' 7E mov a,m ;end of track? 0659' FE 28 cpi cpmspt ;count CP/M sectors .z80 065B' 38 09 jr c,noovf ;skip if no overflow wm02 .8080 ; overflow to next track 065D' 36 00 mvi m,0 ;unasec = 0 065F' 2A FB28 lhld unatrk 0662' 23 inx h 0663' 22 FB28 shld unatrk ;unatrk = unatrk+1 0666' noovf: ;match found, mark as unnecessary read 0666' AF xra a ;0 to accumulator 0667' 32 FB2C sta rsflag ;rsflag = 0 .z80 066A' 18 08 jr rwoper ;to perform the write wm02 .8080 066C' alloc: ;not an unallocated record, requires pre-read 066C' AF xra a ;0 to accum 066D' 32 FB26 sta unacnt ;unacnt = 0 0670' 3C inr a ;1 to accum 0671' 32 FB2C sta rsflag ;rsflag = 1 ;* Common code for READ and WRITE follows *; 0674' rwoper: ;enter here to perform the read/write 0674' AF xra a ;zero to accum 0675' 32 FB2B sta erflag ;no errors (yet) 0678' 3A FB1E lda seksec ;compute host sector 067B' B7 ora a ;carry = 0 067C' 1F rar ;shift right 067D' B7 ora a ;carry = 0 067E' 1F rar ;shift right 067F' 32 FB23 sta sekhst ;host sector to seek Floppy disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-32 Logical BIOS entry points & Deblocking ; active host sector? 0682' 21 FB24 lxi h,hstact ;host active flag 0685' 7E mov a,m 0686' 36 01 mvi m,1 ;always becomes 1 0688' B7 ora a ;was it already? .z80 0689' 28 21 jr z,filhst ;fill host if not wm02 .8080 ; host buffer active, same as seek buffer? 068B' 3A FB1B lda sekdsk 068E' 21 FB1F lxi h,hstdsk ;same disk? 0691' BE cmp m ;sekdsk = hstdsk? .z80 0692' 20 11 jr nz,nomatch ; wm02 .8080 ; same disk, same track? 0694' 21 FB20 lxi h,hsttrk 0697' CD 0708' call sektrkcmp ;sektrk = hsttrk? .z80 069A' 20 09 jr nz,nomatch ; wm02 .8080 ; same disk, same track, same buffer? 069C' 3A FB23 lda sekhst 069F' 21 FB22 lxi h,hstsec ;sekhst = hstsec? 06A2' BE cmp m .z80 06A3' 28 24 jr z,match ;skip if match wm02 .8080 06A5' nomatch: ;proper disk, but not correct sector 06A5' 3A FB25 lda hstwrt ;host written? 06A8' B7 ora a 06A9' C4 07F8' cnz writehst ;clear host buff 06AC' filhst: ;may have to fill the host buffer 06AC' 3A FB1B lda sekdsk 06AF' 32 FB1F sta hstdsk 06B2' 2A FB1C lhld sektrk 06B5' 22 FB20 shld hsttrk 06B8' 3A FB23 lda sekhst 06BB' 32 FB22 sta hstsec 06BE' 3A FB2C lda rsflag ;need to read? 06C1' B7 ora a 06C2' C4 0836' cnz readhst ;yes, if 1 06C5' AF xra a ;0 to accum 06C6' 32 FB25 sta hstwrt ;no pending write 06C9' match: ;copy data to or from buffer 06C9' 3A FB1E lda seksec ;mask buffer number Floppy disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-33 Logical BIOS entry points & Deblocking 06CC' E6 03 ani secmsk ;least signif bits 06CE' 6F mov l,a ;ready to shift 06CF' 26 00 mvi h,0 ;double count 06D1' 29 dad h ;shift left 7 06D2' 29 dad h 06D3' 29 dad h 06D4' 29 dad h 06D5' 29 dad h 06D6' 29 dad h 06D7' 29 dad h ; hl has relative host buffer address .z80 06D8' 11 FB31 ld de,hstbuf 06DB' 19 add hl,de ;hl = host address 06DC' ED 5B FB2F ld de,(dmaadr) ;de = dma address 06E0' 01 0080 ld bc,128 ;length 06E3' 3A FB2D ld a,(readop) ;which way? 06E6' B7 or a 06E7' 20 06 jr nz,rwmove ;skip if read ; write operation, mark and switch direction 06E9' 3E 01 ld a,1 06EB' 32 FB25 ld (hstwrt),a ;hstwrt = 1 06EE' EB ex de,hl ;source/dest swap 06EF' CD FD9A rwmove: call move ;move a logical sector to/from buffer .8080 ; data has been moved to/from host buffer 06F2' 3A FB2E lda wrtype ;write type 06F5' FE 01 cpi wrdir ;to directory? 06F7' 3A FB2B lda erflag ;in case of errors 06FA' C0 rnz ;no further processing ; clear host buffer for directory write 06FB' B7 ora a ;errors? 06FC' C0 rnz ;skip if so 06FD' AF xra a ;0 to accum 06FE' 32 FB25 sta hstwrt ;buffer written 0701' CD 07F8' call writehst 0704' 3A FB2B lda erflag 0707' C9 ret ;* Utility subroutine for 16-bit compare *; 0708' sektrkcmp: ;HL = .unatrk or .hsttrk, compare with sektrk 0708' EB xchg 0709' 21 FB1C lxi h,sektrk 070C' 1A ldax d ;low byte compare 070D' BE cmp m ;same? 070E' C0 rnz ;return if not ; low bytes equal, test high 1s 070F' 13 inx d 0710' 23 inx h 0711' 1A ldax d 0712' BE cmp m ;sets flags Floppy disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-34 Logical BIOS entry points & Deblocking 0713' C9 ret subttl Physical disk routines page Floppy disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-35 Physical disk routines .z80 ; select disk drive, C=drive number 0=A:, 1=B: ; return HL=dph for selected drive, or HL=0 for non-existent drive 0714' 21 0000 dsksel: ld hl,0 ; hl = 0 for non-existent drive 0717' 79 ld a,c 0718' B7 or a 0719' C0 ret nz ; drive number >B: 071A' 21 FD75 ld hl,dpha ; select proper dph for drive 071D' 3A FD31 ld a,(dsk) ; selecting disk already selected? 0720' B9 cp c 0721' C8 ret z ; yes, no further action needed 0722' AF xor a ; set sid flag 0723' 32 FD31 ld (dsk),a ; only valid drive is A: 0726' 32 FD32 ld (sidflg),a ; single sided flag 0729' E5 push hl ; save pointer to dph 072A' CD 076C' call dohome ; trk=0, dd-den, sid0, drvA 072D' DB 14 in a,(bitport) ; select side 1 072F' E6 FB and sidmask 0731' F6 00 or sid1 0733' D3 14 out (bitport),a 0735' CD 0753' call dcheck ; can read? 0738' E1 pop hl ; if nz then can't 0739' C0 ret nz 073A' 3A FD96 ld a,(adrbuf+2) ; get sector number of side 1 073D' FE 0A cp 10 ; on other side? (side 1 sectors 10 to 19) 073F' D8 ret c ; if c then no 0740' E5 push hl 0741' 11 FD85 ld de,$dpb ; adjust dpb in ram 0744' 21 05AA' ld hl,dpb 0747' 01 000F ld bc,15 074A' ED B0 ldir 074C' 3E FF ld a,0FFH ; double sided flag 074E' 32 FD32 ld (sidflg),a 0751' E1 pop hl ; pointer to dph 0752' C9 ret 0753' E5 dcheck: push hl ; save hl and bc 0754' C5 push bc 0755' 21 FD94 ld hl,adrbuf ; buffer space 0758' 01 0613 ld bc,6*256+data ; read 6 bytes from data port 075B' 3E C4 ld a,adrcmd 075D' D3 10 out (cmnd),a 075F' 76 dchk1: halt ; wait for drq 0760' ED A2 ini 0762' 20 FB jr nz,dchk1 0764' CD 07F0' call busy ; wait for intrq 0767' CB 67 bit 4,a ; test rnf flag 0769' C1 pop bc 076A' E1 pop hl 076B' C9 ret ; home disk head ( set trk=0, drv=A, sid=0, motor=on) 076C' CD 07B8' dohome: call ready ; make sure drive is on and ready 076F' DB 14 in a,(bitport) Floppy disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-36 Physical disk routines 0771' E6 FB and sidmask 0773' F6 04 or sid0 0775' D3 14 out (bitport),a ; select side 0 0777' 3E 00 ld a,rstcmd ; restore command 0779' D3 10 out (cmnd),a ; issue command 077B' 18 73 jr busy ; test and wait for not busy ; seek track #, BC=Track # 077D' CD 07B8' trkset: call ready ; make sure drive is on and ready 0780' DB 14 in a,(bitport) ; set proper sense to side 0782' E6 FB and sidmask 0784' 47 ld b,a ; save in b 0785' 3A FD32 ld a,(sidflg) ; check flag 0788' B7 or a 0789' 3E 04 ld a,sid0 ; side 0 bit 078B' 28 06 jr z,outtrk 078D' CB 39 srl c ; double sided trk=trk/2 078F' 30 02 jr nc,outtrk ; if lsb=0 then side 0 0791' 3E 00 ld a,sid1 ; else side 1 0793' B0 outtrk: or b ; or in conts of bitport 0794' D3 14 out (bitport),a 0796' 79 ld a,c 0797' D3 13 out (data),a ; issue req. track to controller 0799' 3E 10 ld a,seekcmd ; seek command 079B' D3 10 out (cmnd),a ; issue command 079D' 18 51 jr busy ; test and wait for not busy ; select sector #, BC=Sector # 079F' DB 14 secset: in a,(bitport) ; single or double sided? 07A1' E6 04 and not sidmask 07A3' FE 04 cp sid0 07A5' 79 ld a,c ; pure sector number in a 07A6' 28 02 jr z,secx ; single sided 07A8' C6 0A add a,10 ; double sided sector disp. 07AA' D3 12 secx: out (sector),a ; to controller register 07AC' C9 ret ; perform logical to physical sector translation. ; logical sector number in BC, table address in DE ; return physical sector number in HL 07AD' 7A sectran:ld a,d ; table address 0? 07AE' B3 or e 07AF' 60 ld h,b ; if so no xlate 07B0' 69 ld l,c 07B1' C8 ret z 07B2' EB ex de,hl ; table address in hl 07B3' 09 add hl,bc ; index by logical sector number 07B4' 6E ld l,(hl) 07B5' 26 00 ld h,0 07B7' C9 ret ; ready disk drive, perform physical disk select, set density bit 07B8' E5 ready: push hl ; save hl 07B9' D5 push de ; and de 07BA' C5 push bc 07BB' 3E D0 ld a,ficmd ; abort any controller action Floppy disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-37 Physical disk routines 07BD' D3 10 out (cmnd),a 07BF' DB 14 in a,(bitport) ; select drive 07C1' E6 DE and denmask and drvmask ;both or driveA ;are 0 or ddbit 07C3' D3 14 out (bitport),a ; to bit port 07C5' CD 07CC' call diskon ; turn drive motor on 07C8' C1 pop bc 07C9' D1 pop de 07CA' E1 pop hl 07CB' C9 ret ; turn disk motor on, delay for drive speed 07CC' DB 14 diskon: in a,(bitport) ; get current drive motor status 07CE' CB 67 bit 4,a ; is motor on? 07D0' C0 ret nz ; motor on, do nothing 07D1' CB E7 set 4,a ; motor on bit 07D3' D3 14 out (bitport),a ; turn motor on 07D5' 06 32 ld b,50 ; delay 07D7' CD 07E4' call thnsd 07DA' C9 ret ; turn disk motor off, de-select drive 07DB' DB 14 $diskoff:in a,(bitport) 07DD' CB A7 res 4,a ; motor off bit 07DF' CB C7 set 0,a 07E1' D3 14 out (bitport),a 07E3' C9 ret ; delay for B th's @ 4Mhz (each call <=> one hundredh of a sec.) 07E4' 11 0686 thnsd: ld de,1670 07E7' 1B tlp: dec de 07E8' 7A ld a,d 07E9' B3 or e 07EA' C2 07E7' jp nz,tlp 07ED' 10 F5 djnz thnsd 07EF' C9 ret ; check status of controller, wait for command to finish executing 07F0' 76 busy: halt ; wait for command done 07F1' DB 10 bsy: in a,(status) ; now wait for not busy 07F3' CB 47 bit 0,a 07F5' 20 FA jr nz,bsy 07F7' C9 ret subttl Writehst and Readhst logical to Physical routines page Floppy disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-38 Writehst and Readhst logical to Physical routines ;* WRITEHST performs the physical write to *; ;* the host disk, READHST reads the physical *; ;* disk. *; 07F8' writehst:;hstdsk = host disk #, hsttrk = host track #, ;hstsec = host sect #. write "hstsiz" bytes ;from hstbuf and return error flag in erflag. ;return erflag non-zero if error 07F8' 2E 03 ld l,3 ; read after write retries 07FA' 11 0205 chk0: ld de,tries1*256+tries2 ; retry error counts 07FD' E5 wrthst: push hl 07FE' D5 push de ; save error counts 07FF' CD 0851' call hstcom ; set track and sector 0802' CD FDC1 call wrt512 ; read sector 0805' D1 pop de ; restore error flags 0806' E1 pop hl ; restore r/w error count 0807' 28 0D jr z,wrtchk ; do read after write 0809' 1D dec e ; retry count 080A' 20 F1 jr nz,wrthst ; try again 080C' 15 dec d ; home and reseek count 080D' 28 1C jr z,chk3 ; can't recover 080F' CD 076C' call dohome ; re seek 0812' 1E 05 ld e,tries2 ; reset retry count 0814' 18 E7 jr wrthst 0816' 06 00 wrtchk: ld b,0 ; dummy read loop to check sector 0818' 3E 88 ld a,rdcmd 081A' D3 10 out (cmnd),a 081C' 76 chk1: halt 081D' DB 13 in a,(data) 081F' 10 FB djnz chk1 0821' 76 chk2: halt 0822' DB 13 in a,(data) 0824' 10 FB djnz chk2 0826' CD 07F0' call busy ; get status 0829' E6 9C and rdmask 082B' 32 FB2B chk3: ld (erflag),a ; error return flag 082E' C8 ret z 082F' 2D dec l 0830' 20 C8 jr nz,chk0 ; try again 0832' 3E FF ld a,0ffh ; bail out, error 0834' 18 F5 jr chk3 0836' readhst:;hstdsk = host disk #, hsttrk = host track #, ;hstsec = host sect #. read "hstsiz" bytes ;into hstbuf and return error flag in erflag. 0836' 11 0205 ld de,tries1*256+tries2 ; retry error counts 0839' D5 rdhst: push de ; save error counts 083A' CD 0851' call hstcom ; set track and sector 083D' CD FDB0 call rd512 ; read sector 0840' 32 FB2B ld (erflag),a ; error return flag 0843' D1 pop de ; restore error flags 0844' C8 ret z ; good op 0845' 1D dec e ; retry count 0846' 20 F1 jr nz,rdhst ; try again Floppy disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-39 Writehst and Readhst logical to Physical routines 0848' 15 dec d ; home and reseek count 0849' C8 ret z ; can't recover 084A' CD 076C' call dohome ; re seek 084D' 1E 05 ld e,tries2 ; reset retry count 084F' 18 E8 jr rdhst 0851' 3A FB1F hstcom: ld a,(hstdsk) ; select disk 0854' 4F ld c,a 0855' CD 0714' call dsksel 0858' ED 4B FB20 ld bc,(hsttrk) ; set track to hsttrk 085C' CD 077D' call trkset ; physical seek 085F' 3A FB22 ld a,(hstsec) ; set physical sector 0862' 4F ld c,a ; c=sector 0863' CD 079F' call secset 0866' C9 ret subttl Physical disk I/O, RAM image page Floppy disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-40 Physical disk I/O, RAM image 0867' ioimage: ;move: ; block memory move, turn rom on/off 0867' DB 14 in a,(bitport) ; turn rom off 0869' CB BF res 7,a 086B' D3 14 out (bitport),a 086D' ED B0 ldir ; move logical sector from hstbuf 086F' DB 14 in a,(bitport) ; turn rom back on 0871' CB FF set 7,a 0873' D3 14 out (bitport),a 0875' C9 ret ; back to rom ;rd128: 0876' 2A FB2F ld hl,(dmaadr) ; address of operation 0879' 06 01 ld b,1 ; read a 128 byte sector 087B' 18 05 jr rd ;rd512: 087D' 21 FB31 ld hl,hstbuf 0880' 06 04 ld b,4 ; read a 512 byte sector ; read a sector, return A=0 for no errors, A=1 for non-recoverable error ; if b=1 128, b=2 256, b=3 384, b=4 512 bytes/sector 0882' 11 9C88 rd: ld de,rdmask*256+rdcmd ; d=read status mask, e=read command 0885' 18 0F jr action ;wrt128: 0887' 2A FB2F ld hl,(dmaadr) 088A' 06 01 ld b,1 ; write a 128 byte sector 088C' 18 05 jr wrt ;wrt512: 088E' 21 FB31 ld hl,hstbuf 0891' 06 04 ld b,4 ; write a 512 byte sector ; write a sector, return as per read 0893' 11 FCAC wrt: ld de,wrtmask*256+wrtcmd ; d=status mask, e=write command ;fall through to action 0896' CD 07B8' action: call ready ; make sure drive is on and ready 0899' F3 di ; no interrupts during disk I/O operations 089A' DB 14 in a,(bitport) ; turn rom off 089C' CB BF res 7,a 089E' D3 14 out (bitport),a 08A0' E5 push hl ; save address of disk buffer 08A1' 21 0066 ld hl,nmivec ; set up nmi vector 08A4' 7E ld a,(hl) ; save current contents 08A5' 08 ex af,af' 08A6' 36 C9 ld (hl),retcod ; this is a return after HALT in loop 08A8' E1 pop hl ; hl = dma address 08A9' 78 ld a,b ; sector multiple 08AA' 01 8013 ld bc,128*256+data ; b=sector length, c=data port 08AD' CB 47 bit 0,a ; if 0 then 256 or 512 bytes/sector 08AF' 20 02 jr nz,actn ; b set for 128 or 384 bytes/sector 08B1' 06 00 ld b,0 ; b set for 256 or 512 bytes/sector 08B3' FE 01 actn: cp 1 ; compute entry point 1st or 2nd loop 08B5' F5 push psw ; save as Z flag 08B6' 7B ld a,e ; i/o command 08B7' FE AC cp wrtcmd ; a write? Floppy disk support routines. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-41 Physical disk I/O, RAM image 08B9' 28 11 jr z,wstart ; start write command 08BB' D3 10 out (cmnd),a ; fall through to read loop 08BD' F1 pop psw 08BE' 28 05 jr z,rl2 08C0' 76 rl1: halt ; wait for controller 08C1' ED A2 ini 08C3' 20 FB jr nz,rl1 08C5' 76 rl2: halt 08C6' ED A2 ini 08C8' 20 FB jr nz,rl2 08CA' 18 0F jr done ; read loop done, exit 08CC' D3 10 wstart: out (cmnd),a ; write loop 08CE' F1 pop psw 08CF' 28 05 jr z,wl2 08D1' 76 wl1: halt 08D2' ED A3 outi 08D4' 20 FB jr nz,wl1 08D6' 76 wl2: halt 08D7' ED A3 outi 08D9' 20 FB jr nz,wl2 08DB' 08 done: ex af,af' ; byte at nmi vector address 08DC' 32 0066 ld (nmivec),a ; restore it 08DF' DB 14 in a,(bitport) ; turn rom back on 08E1' CB FF set 7,a 08E3' D3 14 out (bitport),a 08E5' FB ei ; turn interrupts on 08E6' CD 07F0' call busy ; get status when contoller not busy 08E9' A2 and d ; status mask 08EA' C8 ret z ; no bit set, return operation ok 08EB' 3E 01 ld a,1 ; cp/m error return 08ED' C9 ret 0087 imaglen equ $-ioimage ; length of this image title Video driver routines for the KAYPRO-10 (C) 1983 By NLS. .comment % ######################################################## ## ## ## KAYPRO 10 System ## ## ## ## By M. Sherman ## ## ## ## Video driver routines for the KAYPRO-10 ## ## and the 6545 video controller chip. ## ## ## ## Copyright (C) 1983 By Non-Linear Systems, Inc ## ## No warranty is made, expressed or implied. ## ## ## ######################################################## ## Date: 04/14/83 [01] ## ######################################################## % Video driver routines for the KAYPRO-10 (C) 1983 By NLS. MACRO-80 3.44 09-Dec-81 PAGE 1-42 Physical disk I/O, RAM image ; routines for everyone else to use public vidout, vidinit, regrst, dtwait, clrdis, clreol, carret, putcur public getc, putc, getatt, putatt, print .Z80 ; conditional assembly equates FFFF TRUE equ 0ffffh 0000 FALSE equ NOT TRUE ; video controller locations 001C vcbase equ 1ch ; video controller base address 001C vccmd equ vcbase ; register select port 001C vcstat equ vcbase ; status port 001D vcrdat equ vcbase+1 ; register data port 001F vcdata equ vcbase+3 ; video controller data port ; command format, video controller commands: ; high byte = register to select, low byte = base addr. (register select) 0E1C curcmd equ 0e1ch ; place cursor command 121C rwcmd equ 121ch ; read/write command 001F strcmd equ 01fh ; strobe, or "tickle", command 0C1C scrcmd equ 0c1ch ; set start of display address command ; ("scroll" command) 0012 hiadd equ 12h ; high byte register #, video mem. address, 0013 loadd equ 13h ; low byte register #, video mem. address. 000A cstart equ 0ah ; cursor starting row count, cursor def. reg # 000B cstop equ 0bh ; cursor ending row count. 0060 csron equ 60h ; cursor on, blinking at 1/32, starting row=0 0020 csroff equ 20h ; no cursor, starting row=0 (irrelevant) ; special character equates 0020 space equ 020h 0000 nrmlatt equ 00h ; single character control codes 0007 belli equ 07h ; bell code to video driver, 0004 bello equ 04h ; bell code to keyboard. 000D cr equ 0dh ; carriage return 000A lf equ 0ah ; line feed 0018 ceol equ 18h ; clear to end of line 0017 ceos equ 17h ; clear to end of screen 001A clrscr equ 1ah ; clear screen 001E homec equ 1eh ; home cursor 0008 lcur equ 08h ; left cursor (backspace) 000C rcur equ 0ch ; right cursor (forespace) 000B ucur equ 0bh ; up cursor 001B esc equ 1bh ; escape code, initiates multi- ; -character control sequences Video driver routines for the KAYPRO-10 (C) 1983 By NLS. MACRO-80 3.44 09-Dec-81 PAGE 1-43 Physical disk I/O, RAM image ; two-character commands 0052 dline equ 'R' ; delete line 0045 iline equ 'E' ; insert line ; three-character commands 0042 atton equ 'B' ; set attribute 0043 attoff equ 'C' ; clear attribute ; four-character commands 002A setpix equ '*' ; set pixel 0020 clrpix equ ' ' ; clear pixel 003D lodcur equ '=' ; load cursor address (cursor positioning) ; six-character commands 004C lindraw equ 'L' ; draw a line 0044 lineras equ 'D' ; erase a line ; video driver equates 0050 linesiz equ 80 ; characters per line 0018 linesps equ 24 ; number of lines in the normal display 0019 statlin equ linesps+1 ; line number, status line 0730 lastlin equ (linesps-1)*linesiz ; address, first chara last ; normal display line ; (the line above the status line) ;################################################ ;# # ;# video drivers # ;# # ;################################################ ; clear to end of line 08EE' CD 0917' clreol: call caleol ; calculate end of line count 08F1' 18 6B jr clrdis ; clear to end of screen 08F3' 0E 17 clreos: ld c,linesps-1 08F5' 3A FD5F ld a,(vatt) 08F8' E6 20 and 20h 08FA' 20 01 jr nz,ceos22 08FC' 0C inc c 08FD' 3A FD5D ceos22: ld a,(crow) 0900' 91 sub c 0901' 30 EB jr nc,clreol ; clear to end of line if on last legal line 0903' ED 44 neg ; two's complement, number of lines to erase 0905' 47 ld b,a 0906' 11 0050 ld de,linesiz 0909' 21 0000 ld hl,0 090C' 19 clresl: add hl,de 090D' 10 FD djnz clresl 090F' E5 push hl Video driver routines for the KAYPRO-10 (C) 1983 By NLS. MACRO-80 3.44 09-Dec-81 PAGE 1-44 Physical disk I/O, RAM image 0910' CD 0917' call caleol 0913' C1 pop bc 0914' 09 add hl,bc ; total count in hl 0915' 18 47 jr clrdis ; do it 0917' 21 0050 caleol: ld hl,linesiz 091A' ED 5B FD60 ld de,(cursor) 091E' 3A FD5E ld a,(ccol) 0921' 4F ld c,a 0922' AF xor a ; clear a, clear flags (especially carry!) 0923' 47 ld b,a ; clear b 0924' ED 42 sbc hl,bc ; hl=number of bytes to move 0926' C9 ret 0927' vidinit:; Video hardware/software initialization routine. Will set ; video driver ram storage to reset/restart values, ; reprogram the video controller chip, ; clear the screen and place the cursor in the upper right corner. ; 0927' 21 FD5C ramini: ld hl,vidram ; first, initialize the ram. 092A' 06 0C ld b,ramlen 092C' AF xor a 092D' 77 rinilp: ld (hl),a 092E' 23 inc hl 092F' 10 FC djnz rinilp 0931' 21 09BA' ctrini: ld hl,ctrtbl ; then initialize the controller, 0934' 01 101D ld bc,ctblen*256+vcbase+1 0937' AF xor a ; first register,=00 0938' 0D cinilp: dec c ; c:=base 0939' ED 79 out (c),a ; select register 093B' 3C inc a ; a:=register to program 093C' 0C inc c ; c:=data port 093D' ED A3 outi ; (hl):=program data, out to (c) 093F' 20 F7 jr nz,cinilp ; until b:=0 0941' 3E 1F ld a,strcmd 0943' D3 1C out (vccmd),a ; start video chip processing. ; fall through to clear screen 0945' CD 09AC' clear: call home ; home cursor 0948' 3A FD5F clear2: ld a,(vatt) 094B' E6 F0 and 0f0h ; clear ordinary attributes 094D' 32 FD5F ld (vatt),a ; clear attribute byte 0950' ED 5B FD60 ld de,(cursor) ; same as vrbase, now 0954' 21 0800 ld hl,800h ; new screen size to eliminate phantom cursor wm03 ;****************************************************************************** ;* ld hl,statlin*linesiz ; screen size = 7d0H * ;****************************************************************************** 0957' E6 20 and 20h 0959' 28 03 jr z,clrdis 095B' 21 0780 ld hl,linesps*linesiz ; fall through to clrdis... 095E' clrdis: ; clear display and associated attributes. ; de := start address, hl := number of locations to clear ; all registers affected... ; Video driver routines for the KAYPRO-10 (C) 1983 By NLS. MACRO-80 3.44 09-Dec-81 PAGE 1-45 Physical disk I/O, RAM image 095E' 01 1213 ld bc,hiadd*100h+loadd 0961' DB 1C cdislp: in a,(vcstat) 0963' B7 or a 0964' F2 0961' jp p,cdislp ; wait until ready, 0967' 78 ld a,b ; high address byte register number, 0968' D3 1C out (vccmd),a ; select it 096A' 7A ld a,d ; get high byte, new address, 096B' E6 07 and 07h ; qualify address, 096D' 57 ld d,a ; put it back, 096E' D3 1D out (vcrdat),a ; output it. 0970' 79 ld a,c ; select 0971' D3 1C out (vccmd),a ; low address byte register, 0973' 7B ld a,e ; get low address byte, 0974' D3 1D out (vcrdat),a ; output it. 0976' 3E 1F ld a,strcmd 0978' D3 1C out (vccmd),a ; start a new cycle, 097A' DB 1C cdislp3:in a,(vcstat) ; wait until it's ready, 097C' B7 or a 097D' F2 097A' jp p,cdislp3 0980' 3E 20 ld a,20h ; clear data byte, 0982' D3 1F out (vcdata),a 0984' 13 inc de ; set up for attr., next byte 0985' DB 1C cdislp2:in a,(vcstat) ; go do attributes 0987' B7 or a 0988' F2 0985' jp p,cdislp2 ; jif until finished 098B' 78 ld a,b ; high address byte register number, 098C' D3 1C out (vccmd),a ; select it 098E' 7A ld a,d ; get high byte, new address, 098F' F6 08 or 08h ; qualify address, 0991' D3 1D out (vcrdat),a ; output it. 0993' 79 ld a,c ; select 0994' D3 1C out (vccmd),a ; low address byte register, 0996' 7B ld a,e ; get low address byte, 0997' D3 1D out (vcrdat),a ; output it. 0999' 3E 1F ld a,strcmd 099B' D3 1C out (vccmd),a ; start a new cycle, 099D' DB 1C cdislp4:in a,(vcstat) ; wait until finished. 099F' B7 or a 09A0' F2 099D' jp p,cdislp4 ; jif until finished 09A3' AF xor a ; clear attribute byte 09A4' D3 1F out (vcdata),a 09A6' 2B dec hl 09A7' 7C ld a,h 09A8' B5 or l 09A9' 20 B6 jr nz,cdislp 09AB' C9 ret 09AC' AF home: xor a 09AD' 32 FD5E ld (ccol),a ; reset column count 09B0' 32 FD5D ld (crow),a ; reset row count 09B3' 2A FD62 ld hl,(vrbase) 09B6' EB ex de,hl 09B7' C3 0A60' jp putcur ; place cursor and exit ; video controller initialization table, currently for a 25 by 80 display. ; Video driver routines for the KAYPRO-10 (C) 1983 By NLS. MACRO-80 3.44 09-Dec-81 PAGE 1-46 Physical disk I/O, RAM image 09BA' 6A ctrtbl: db 6ah ; reg00 total char/sweep including retrace, clocks 09BB' 50 db 50h ; reg01 total displayed, cclks 09BC' 56 db 56h 09BD' 99 db 99h 09BE' 19 db 19h 09BF' 0A db 0ah 09C0' 19 db 19h 09C1' 19 db 19h 09C2' 78 db 78h 09C3' 0F db 0fh 09C4' 60 db 60h 09C5' 0F db 0fh 09C6' 00 db 00h 09C7' 00 db 00h 09C8' 00 db 00h 09C9' 00 db 00h 0010 ctblen equ $-ctrtbl ; table length ; main entry point. 09CA' 3A FD5C vidout: ld a,(leadflg) ; set by escape sequences 09CD' B7 or a 09CE' C2 0C16' jp nz,escseq ; an escape sequence is in progress 09D1' 79 ld a,c 09D2' B7 or a 09D3' C8 ret z ; ignore nulls (requested by tech support) 09D4' FA 09F9' jp m,vgmod ; video mode set? find out if negative (>80h) 09D7' FE 20 cp space 09D9' DA 0C8F' jp c,spechar ; special characters 09DC' 79 spcexe: ld a,c 09DD' ED 5B FD60 ld de,(cursor) ; special character re-entry if non-control 09E1' CD 0BE3' call putc 09E4' CD 0BEF' call puta ; place attribute 09E7' 3A FD5E vgmexe: ld a,(ccol) 09EA' 3C inc a 09EB' FE 50 cp linesiz 09ED' 30 53 jr nc,crlf ;wm01 09EF' 32 FD5E ld (ccol),a ; save new count 09F2' ED 5B FD60 ld de,(cursor) 09F6' 13 inc de 09F7' 18 67 jr putcur ; reposition cursor and exit wm01 09F9' 3A FD5F vgmod: ld a,(vatt) 09FC' E6 10 and 10h 09FE' 28 DC jr z,spcexe ; not video graphics mode if not zero 0A00' 3A FD74 ld a,(vgb1) 0A03' E6 40 and 40h 0A05' 28 07 jr z,vgmod2 0A07' 79 ld a,c 0A08' E6 01 and 01 0A0A' 32 FD74 ld (vgb1),a 0A0D' C9 ret 0A0E' 3A FD74 vgmod2: ld a,(vgb1) 0A11' B7 or a 0A12' 79 ld a,c 0A13' 28 01 jr z,vgmod5 Video driver routines for the KAYPRO-10 (C) 1983 By NLS. MACRO-80 3.44 09-Dec-81 PAGE 1-47 Physical disk I/O, RAM image 0A15' 2F cpl 0A16' F6 80 vgmod5: or 80h 0A18' ED 5B FD60 ld de,(cursor) 0A1C' CD 0BE3' call putc 0A1F' 3A FD74 ld a,(vgb1) 0A22' 4F ld c,a 0A23' 3A FD5F ld a,(vatt) 0A26' B1 or c 0A27' CD 0BF2' call putatt 0A2A' 3E 40 ld a,40h 0A2C' 32 FD74 ld (vgb1),a ; set first 0A2F' 18 B6 jr vgmexe ; move the cursor to the beginning of the line 0A31' 2A FD60 carret: ld hl,(cursor) 0A34' 3A FD5E ld a,(ccol) 0A37' 5F ld e,a 0A38' AF xor a ; clear flags,a 0A39' 57 ld d,a 0A3A' 32 FD5E ld (ccol),a ; reset line count to zero 0A3D' ED 52 sbc hl,de ; hl = beginning of line 0A3F' EB ex de,hl ; de = beginning of line 0A40' 18 1E jr putcur ; place cursor and exit ; crlf places the cursor at the beginning of the next line and sets the ; character column count, ccol, to zero. 0A42' CD 0A31' crlf: call carret ; carriage return ; fall through to linefeed... ; move the cursor down one line, scroll if necc. 0A45' 3A FD5D linefd: ld a,(crow) ; character row count 0A48' FE 17 cp linesps-1 ; lines per screen 0A4A' 38 08 jr c,linef2 ; not last line if carry, 0A4C' FE 18 cp statlin-1 ; status line? 0A4E' C8 ret z ; if so, don't scroll 0A4F' CD 0AD5' call scroll ; else is last line, scroll screen 0A52' 18 04 jr linef3 ; don't update character row count. 0A54' 3C linef2: inc a ; update character row count, 0A55' 32 FD5D ld (crow),a 0A58' 2A FD60 linef3: ld hl,(cursor) ; move the cursor down one line. 0A5B' 11 0050 ld de,linesiz 0A5E' 19 add hl,de 0A5F' EB ex de,hl ; fall through to putcur... ; place cursor, new cursor address in de 0A60' 7A putcur: ld a,d 0A61' E6 07 and 07h 0A63' 57 ld d,a 0A64' EB ex de,hl 0A65' 22 FD60 ld (cursor),hl Video driver routines for the KAYPRO-10 (C) 1983 By NLS. MACRO-80 3.44 09-Dec-81 PAGE 1-48 Physical disk I/O, RAM image 0A68' ED 4B FD62 ld bc,(vrbase) 0A6C' ED 42 sbc hl,bc 0A6E' 30 04 jr nc,putcr2 0A70' 11 0800 ld de,0800h 0A73' 19 add hl,de 0A74' 09 putcr2: add hl,bc 0A75' EB ex de,hl 0A76' 01 0E1C ld bc,curcmd 0A79' C3 0BCC' jp regrst 0A7C' 3A FD5D upcur: ld a,(crow) 0A7F' FE 18 cp statlin-1 0A81' C8 ret z ; no cursor up from status line, 0A82' B7 or a 0A83' C8 ret z ; or from top line 0A84' 3D dec a 0A85' 32 FD5D ld (crow),a ; update row count 0A88' 2A FD60 ld hl,(cursor) 0A8B' 11 0050 ld de,linesiz 0A8E' ED 52 sbc hl,de 0A90' EB ex de,hl ; put new value in de 0A91' 18 CD jr putcur 0A93' 3A FD5E lfcur: ld a,(ccol) 0A96' B7 or a 0A97' 20 0F jr nz,lcur2 0A99' 3A FD5D ld a,(crow) 0A9C' B7 or a 0A9D' C8 ret z ; no way can do 0A9E' FE 18 cp statlin-1 ; on status line? 0AA0' 28 11 jr z,lcur3 0AA2' 3D dec a 0AA3' 32 FD5D ld (crow),a ; update row count 0AA6' 3E 50 ld a,linesiz 0AA8' 3D lcur2: dec a 0AA9' 32 FD5E ld (ccol),a ; update column count 0AAC' ED 5B FD60 ld de,(cursor) 0AB0' 1B dec de 0AB1' 18 AD jr putcur ; place and exit 0AB3' 3E 4F lcur3: ld a,linesiz-1 0AB5' 32 FD5E ld (ccol),a ; going to the end of the line 0AB8' 2A FD60 ld hl,(cursor) 0ABB' 11 004F ld de,linesiz-1 0ABE' 19 add hl,de 0ABF' EB ex de,hl 0AC0' 18 9E jr putcur 0AC2' 3A FD5E rtcur: ld a,(ccol) 0AC5' FE 4F cp linesiz-1 0AC7' D2 0A42' jp nc,crlf ; do a cr, do a lf if not status line 0ACA' ED 5B FD60 ld de,(cursor) 0ACE' 13 inc de 0ACF' 3C inc a 0AD0' 32 FD5E ld (ccol),a ; reset column count 0AD3' 18 8B jr putcur Video driver routines for the KAYPRO-10 (C) 1983 By NLS. MACRO-80 3.44 09-Dec-81 PAGE 1-49 Physical disk I/O, RAM image 0AD5' C3 0CD9' scroll: jp movsts ; fast scroll 0AD8' 21 FD5F setatr: ld hl,vatt 0ADB' 79 ld a,c 0ADC' D6 30 sub 30h 0ADE' 28 16 jr z,revid ; set reverse video on 0AE0' 3D dec a 0AE1' 28 18 jr z,redint ; set reduced intensity on 0AE3' 3D dec a 0AE4' 28 1A jr z,sblink ; set blinking on 0AE6' 3D dec a 0AE7' 28 1C jr z,sunlin ; set underlining on 0AE9' 3D dec a 0AEA' 28 1E jr z,setcur ; set cursor on 0AEC' 3D dec a 0AED' 28 25 jr z,setvid ; set video mode on 0AEF' 3D dec a 0AF0' 28 30 jr z,savcur ; save current cursor location 0AF2' 3D dec a 0AF3' 28 34 jr z,savsts ; save contents of status line during scroll 0AF5' C9 ret ; illegal, exit ; set attributes 0AF6' 7E revid: ld a,(hl) 0AF7' F6 01 or 01h 0AF9' 77 ld (hl),a 0AFA' C9 ret 0AFB' 7E redint: ld a,(hl) 0AFC' F6 02 or 02h 0AFE' 77 ld (hl),a 0AFF' C9 ret 0B00' 7E sblink: ld a,(hl) 0B01' F6 04 or 04h 0B03' 77 ld (hl),a 0B04' C9 ret 0B05' 7E sunlin: ld a,(hl) 0B06' F6 08 or 08h 0B08' 77 ld (hl),a 0B09' C9 ret 0B0A' 0E 60 setcur: ld c,csron ; cursor on, 1/16 blink 0B0C' 3E 0A setcr2: ld a,cstart ; cursor select register 0B0E' D3 1C out (vccmd),a 0B10' 79 ld a,c 0B11' D3 1F out (vcdata),a ; turn on cursor, 1/16 blink 0B13' C9 ret 0B14' 3A FD5F setvid: ld a,(vatt) ; turn on video mode. 0B17' F6 10 or 10h ; (GB1,GB2 graphics pairs) 0B19' 32 FD5F ld (vatt),a 0B1C' 3E 40 ld a,40h 0B1E' 32 FD74 ld (vgb1),a 0B21' C9 ret 0B22' 2A FD5D savcur: ld hl,(crow) ; save, or 'remember', current cursor position 0B25' 22 FD65 ld (precur),hl 0B28' C9 ret Video driver routines for the KAYPRO-10 (C) 1983 By NLS. MACRO-80 3.44 09-Dec-81 PAGE 1-50 Physical disk I/O, RAM image 0B29' 3A FD5F savsts: ld a,(vatt) ; turn on status line preservation, 0B2C' F6 20 or 00100000b ; protect it from scrolling. 0B2E' 32 FD5F ld (vatt),a 0B31' C9 ret ; clear attributes 0B32' 21 FD5F clratr: ld hl,vatt 0B35' 79 ld a,c 0B36' D6 30 sub 30h 0B38' 28 16 jr z,nrmvid ; set normal video on 0B3A' 3D dec a 0B3B' 28 18 jr z,nrmint ; set normal intensity on 0B3D' 3D dec a 0B3E' 28 1A jr z,cblink ; set blinking off 0B40' 3D dec a 0B41' 28 1C jr z,cunlin ; set underlining off 0B43' 3D dec a 0B44' 28 1E jr z,clrcur ; set cursor off 0B46' 3D dec a 0B47' 28 1F jr z,clrvid ; set video mode off 0B49' 3D dec a 0B4A' 28 21 jr z,rstcur ; restore cursor to last loc. 0B4C' 3D dec a 0B4D' 28 30 jr z,scrsts ; scroll contents of status line during scroll 0B4F' C9 ret ; illegal, exit ; clear attributes: 0B50' 7E nrmvid: ld a,(hl) ; set to non-inverted display mode. 0B51' E6 FE and 11111110b 0B53' 77 ld (hl),a 0B54' C9 ret 0B55' 7E nrmint: ld a,(hl) ; set to normal intensity 0B56' E6 FD and 11111101b 0B58' 77 ld (hl),a 0B59' C9 ret 0B5A' 7E cblink: ld a,(hl) ; set to no blinking. 0B5B' E6 FB and 11111011b 0B5D' 77 ld (hl),a 0B5E' C9 ret 0B5F' 7E cunlin: ld a,(hl) ; set to no underlining. 0B60' E6 F7 and 11110111b 0B62' 77 ld (hl),a 0B63' C9 ret 0B64' 0E 20 clrcur: ld c,csroff ; turn cursor off 0B66' 18 A4 jr setcr2 0B68' 7E clrvid: ld a,(hl) ; turn off video mode 0B69' E6 EF and 11101111b 0B6B' 77 ld (hl),a 0B6C' C9 ret 0B6D' 2A FD65 rstcur: ld hl,(precur) ; return cursor to last remembered location. 0B70' 7C ld a,h ; ccol 0B71' C6 20 add a,space 0B73' 32 FD67 ld (col),a Video driver routines for the KAYPRO-10 (C) 1983 By NLS. MACRO-80 3.44 09-Dec-81 PAGE 1-51 Physical disk I/O, RAM image 0B76' 7D ld a,l 0B77' C6 20 add a,space 0B79' 32 FD69 ld (row),a 0B7C' C3 0B88' jp curpos ; restore previously saved cursor 0B7F' 3A FD5F scrsts: ld a,(vatt) ; turn off status line preservation, 0B82' E6 DF and 11011111b ; scroll status line on scrolls 0B84' 32 FD5F ld (vatt),a 0B87' C9 ret ; X,Y cursor positioning routine ; 0B88' 21 0000 curpos: ld hl,0 0B8B' 4D ld c,l ; set c to zero, too. 0B8C' 3A FD69 ld a,(row) 0B8F' D6 20 sub space 0B91' D8 ret c ; error, exit 0B92' 47 ld b,a 0B93' 28 09 jr z,curpo3 0B95' FE 19 cp statlin ; lines per screen 0B97' D0 ret nc ; error, exit 0B98' 11 0050 ld de,linesiz 0B9B' 19 curpo2: add hl,de 0B9C' 10 FD djnz curpo2 0B9E' 5F curpo3: ld e,a ; save row count 0B9F' 3A FD67 ld a,(col) 0BA2' D6 20 sub space 0BA4' D8 ret c ; error, exit 0BA5' FE 50 cp linesiz 0BA7' D0 ret nc ; error, exit 0BA8' 4F ld c,a 0BA9' 32 FD5E ld (ccol),a ; new column count 0BAC' 7B ld a,e 0BAD' 32 FD5D ld (crow),a ; new row count 0BB0' 09 add hl,bc 0BB1' ED 5B FD62 ld de,(vrbase) 0BB5' 19 add hl,de 0BB6' EB ex de,hl 0BB7' C3 0A60' jp putcur ; place cursor 0BBA' 01 121C dtwait: ld bc,rwcmd 0BBD' CD 0BCC' rgwait: call regrst 0BC0' 0D dec c ; return c to original value 0BC1' 3E 1F ld a,strcmd ; tickle the dummy 0BC3' ED 79 out (c),a 0BC5' ED 78 rgwt2: in a,(c) 0BC7' B7 or a 0BC8' F2 0BC5' jp p,rgwt2 0BCB' C9 ret 0BCC' ED 41 regrst: out (c),b 0BCE' 0C inc c 0BCF' ED 51 out (c),d 0BD1' 0D dec c 0BD2' 04 inc b 0BD3' ED 41 out (c),b 0BD5' 0C inc c Video driver routines for the KAYPRO-10 (C) 1983 By NLS. MACRO-80 3.44 09-Dec-81 PAGE 1-52 Physical disk I/O, RAM image 0BD6' ED 59 out (c),e 0BD8' C9 ret 0BD9' 7A getc: ld a,d 0BDA' E6 07 and 07h 0BDC' 57 ld d,a 0BDD' CD 0BBA' getc2: call dtwait 0BE0' DB 1F in a,(vcdata) 0BE2' C9 ret 0BE3' F5 putc: push af ; save data 0BE4' 7A ld a,d 0BE5' E6 07 and 07h 0BE7' 57 ld d,a 0BE8' CD 0BBA' putc2: call dtwait 0BEB' F1 pop af 0BEC' D3 1F out (vcdata),a 0BEE' C9 ret 0BEF' 3A FD5F puta: ld a,(vatt) ; video attribute 0BF2' E5 putatt: push hl ; save hl 0BF3' F5 push af 0BF4' CD 0C0A' call addatt 0BF7' CD 0BBA' call dtwait 0BFA' F1 pop af 0BFB' D3 1F out (vcdata),a 0BFD' EB ex de,hl 0BFE' E1 pop hl 0BFF' C9 ret 0C00' E5 getatt: push hl 0C01' CD 0C0A' call addatt 0C04' CD 0BDD' call getc2 0C07' EB ex de,hl 0C08' E1 pop hl 0C09' C9 ret 0C0A' 21 0801 addatt: ld hl,801h ; video attribute offset 0C0D' 19 add hl,de 0C0E' 7C ld a,h 0C0F' E6 07 and 07h ; 00000000 to 00000111 0C11' F6 08 or 08h ; 00001000 to 00001111 0C13' 67 ld h,a 0C14' EB ex de,hl 0C15' C9 ret 0C16' 21 FD5C escseq: ld hl,leadflg 0C19' 36 00 ld (hl),0 ; clear flag 0C1B' FE 01 cp 1 0C1D' 20 19 jr nz,esc2 0C1F' 79 ld a,c 0C20' E6 7F and 07fh 0C22' FE 52 cp dline ; delete line? 0C24' CA 0E52' jp z,dltlin 0C27' FE 45 cp iline ; insert line? 0C29' CA 0EE8' jp z,inslin Video driver routines for the KAYPRO-10 (C) 1983 By NLS. MACRO-80 3.44 09-Dec-81 PAGE 1-53 Physical disk I/O, RAM image 0C2C' FE 41 cp 'A' ; Kaypro-II display lower case? 0C2E' C8 ret z ; yes, ignore 0C2F' FE 47 cp 'G' ; Kaypro-II display greek? 0C31' C8 ret z ; yes, ignore 0C32' 32 FD64 ld (esccmd),a ; set command 0C35' 36 02 ld (hl),2 0C37' C9 ret 0C38' FE 02 esc2: cp 2 0C3A' 20 14 jr nz,esc3 0C3C' 3A FD64 ld a,(esccmd) 0C3F' FE 42 cp atton 0C41' CA 0AD8' jp z,setatr ; set attribute command 0C44' FE 43 cp attoff 0C46' CA 0B32' jp z,clratr ; clear attribute 0C49' 79 ld a,c 0C4A' 32 FD69 ld (row),a 0C4D' 36 03 ld (hl),3 0C4F' C9 ret 0C50' FE 03 esc3: cp 3 0C52' 20 19 jr nz,esc4 0C54' 79 ld a,c 0C55' 32 FD67 ld (col),a 0C58' 3A FD64 ld a,(esccmd) 0C5B' FE 3D cp lodcur 0C5D' CA 0B88' jp z,curpos ; cursor positioning 0C60' FE 2A cp setpix 0C62' CA EE06 jp z,pixon ; pixel on 0C65' FE 20 cp clrpix 0C67' CA EE09 jp z,pixoff ; pixel off 0C6A' 36 04 ld (hl),4 0C6C' C9 ret 0C6D' FE 04 esc4: cp 4 0C6F' 20 07 jr nz,esc5 0C71' 79 ld a,c 0C72' 32 FD6A ld (row2),a 0C75' 36 05 ld (hl),5 0C77' C9 ret 0C78' 79 esc5: ld a,c 0C79' 32 FD68 ld (col2),a 0C7C' 3A FD64 ld a,(esccmd) 0C7F' FE 4C cp lindraw 0C81' CA EE0C jp z,lineon 0C84' FE 44 cp lineras 0C86' CA EE0F jp z,lineoff 0C89' C9 ret ; illegal command, exit. 0C8A' 0E 04 bell: ld c,bello ; put keyboard bell chara in c reg., 0C8C' C3 01A9' jp kbdout ; ring bell 0C8F' FE 0D spechar:cp cr 0C91' CA 0A31' jp z,carret ; carriage return 0C94' FE 0A cp lf 0C96' CA 0A45' jp z,linefd ; line feed 0C99' FE 07 cp belli Video driver routines for the KAYPRO-10 (C) 1983 By NLS. MACRO-80 3.44 09-Dec-81 PAGE 1-54 Physical disk I/O, RAM image 0C9B' 28 ED jr z,bell ; bell 0C9D' FE 18 cp ceol 0C9F' CA 08EE' jp z,clreol ; clear to end of line 0CA2' FE 17 cp ceos 0CA4' CA 08F3' jp z,clreos ; clear to end of screen 0CA7' FE 1A cp clrscr 0CA9' CA 0945' jp z,clear ; clear screen 0CAC' FE 08 cp lcur 0CAE' CA 0A93' jp z,lfcur ; left cursor 0CB1' FE 0C cp rcur 0CB3' CA 0AC2' jp z,rtcur ; right cursor 0CB6' FE 0B cp ucur 0CB8' CA 0A7C' jp z,upcur ; up cursor 0CBB' FE 1E cp homec 0CBD' CA 09AC' jp z,home ; home cursor 0CC0' FE 1B cp esc 0CC2' C2 09DC' jp nz,spcexe ; not a control character, write it 0CC5' 3E 01 ld a,1 0CC7' 32 FD5C ld (leadflg),a ; set escape in progress 0CCA' C9 ret ; print routine 0CCB' E1 print: pop hl 0CCC' 7E ld a,(hl) 0CCD' 23 inc hl 0CCE' E5 push hl 0CCF' B7 or a 0CD0' C8 ret z 0CD1' 4F ld c,a 0CD2' CD 09CA' call vidout 0CD5' 18 F4 jr print 0CD7' 0000 defw 0000h title Block Move Routines for the 6545 CRT Controller. (C) 1983 By NLS .comment % ######################################################## ## ## ## KAYPRO 10 System ## ## ## ## By M. Sherman ## ## ## ## block move routines for the 6545 ## ## ## ## Copyright (C) 1983 By Non-Linear Systems, Inc ## ## No warranty is made, expressed or implied. ## ## ## ######################################################## ## Date: 03/28/83 [77] ## ######################################################## Current revision: 7.7 28-Mar-83 Previous revision: 7.6 11-Mar-83 Prev. working rev.: 7.5 14-Feb-83 Changes: Attempt to add insert line. Block Move Routines for the 6545 CRT Controller. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-55 Physical disk I/O, RAM image (revision 7.5) Changes: Updated scrolling (movsts), insert line (revision 7.6) Changes: Final modifications and debugging prior to shipping (version 7.7) includes the following routines: MOVSTS: move status line (if preserved=true), scroll screen MDIR: move data with attributes (emulates Z-80 LDIR) MDDR: move data with attributes (emulates Z-80 LDDR) DLTLIN: delete the current cursor line. INSLIN: insert a line at the current cursor location. % page Block Move Routines for the 6545 CRT Controller. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-56 Physical disk I/O, RAM image public mdir, mddr, movsts, dltlin, inslin 001F vcdata equ 1fh ; video ram data port 001C vccmd equ 1ch ; register select port 001C vcstat equ 1ch ; vc status port 0C1C scrcmd equ 0c1ch ; used with regrst to alter base address 121C rwcmd equ 121ch ; used with regrst to set up data address 001F strcmd equ 1fh ; 'tickle', 'dummy' or strobe register. 0730 lastlin equ 0730h ; beginning address of last line (except stat) 0050 linesiz equ 80 ; line length in counting numbers 0050 bufsiz equ linesiz ; buffer size, if any 0012 hiadd equ 12h ; high byte of data address port 0013 loadd equ 13h ; low byte of data address port 001D vcrdat equ vccmd+1 ; video controller register data port 0018 linesps equ 24 .Z80 page Block Move Routines for the 6545 CRT Controller. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-57 Physical disk I/O, RAM image ; move status line and scroll ; 0CD9' 3A FD5F movsts: ld a,(vatt) ; first, check to see if the status line 0CDC' E6 20 and 20h ; is to be preserved or not. 0CDE' 28 36 jr z,mvsts2 ; if bit 5 is zero, no. else... ; status line preservation is TRUE. Move the status line before doing ; anything else. ; 0CE0' 2A FD62 mvsts: ld hl,(vrbase) 0CE3' 11 0780 ld de,lastlin+linesiz 0CE6' 01 0050 ld bc,linesiz ; amount to move 0CE9' 19 add hl,de ; hl=source, de=statline 0CEA' 7C ld a,h ; qualify it 0CEB' E6 07 and 07h 0CED' 67 ld h,a 0CEE' 54 ld d,h ; copy it into de, 0CEF' 5D ld e,l ; de=source. 0CF0' 09 add hl,bc ; de=source, hl=destination 0CF1' 7C ld a,h ; qualify it 0CF2' E6 07 and 07h 0CF4' 67 ld h,a 0CF5' EB ex de,hl ; hl=source, de=destination 0CF6' E5 push hl ; save status line address 0CF7' CD 0D3D' call mdir ; if so, move it 0CFA' D1 pop de ; status line address in de 0CFB' 21 0050 ld hl,linesiz ; amount to clear 0CFE' CD 095E' call clrdis ; clear it 0D01' 2A FD62 ld hl,(vrbase) 0D04' 11 0050 ld de,linesiz 0D07' 19 add hl,de 0D08' 7C ld a,h 0D09' E6 07 and 07h 0D0B' 67 ld h,a 0D0C' 22 FD62 ld (vrbase),hl 0D0F' EB ex de,hl 0D10' 01 0C1C ld bc,scrcmd 0D13' C3 0BCC' jp regrst ; scroll screen and exit ; enter here for scroll if status line preservation IS NOT enabled. ; MVSTS2 scrolls the screen, then clears the status line. ; 0D16' 2A FD62 mvsts2: ld hl,(vrbase) 0D19' 11 0050 ld de,linesiz 0D1C' 19 add hl,de 0D1D' 7C ld a,h 0D1E' E6 07 and 07h 0D20' 67 ld h,a 0D21' 22 FD62 ld (vrbase),hl ; new base address 0D24' EB ex de,hl 0D25' 01 0C1C ld bc,scrcmd 0D28' CD 0BCC' call regrst 0D2B' 2A FD62 ld hl,(vrbase) Block Move Routines for the 6545 CRT Controller. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-58 Physical disk I/O, RAM image 0D2E' 11 0780 ld de,linesps*linesiz ; starting addr., status line 0D31' 19 add hl,de 0D32' 7C ld a,h 0D33' E6 07 and 07h 0D35' 67 ld h,a 0D36' EB ex de,hl 0D37' 21 0050 ld hl,linesiz 0D3A' C3 095E' jp clrdis ; clear status line, exit. ; move a block of data, source in hl, destination in de, count in bc. ; (just like a Z-80 block move, or LDIR, command, only slower.) ; 0D3D' 78 mdir: ld a,b 0D3E' E6 07 and 07h ; qualify the upper byte, 0D40' B1 or c ; qualify the count 0D41' C8 ret z ; not 65,535 please! 0D42' C5 mdir2: push bc ; save the count 0D43' DB 1C rdlopx: in a,(vcstat) 0D45' B7 or a 0D46' F2 0D43' jp p,rdlopx ; wait until ready to begin 0D49' 01 1213 ld bc,hiadd*100H+loadd ; address register numbers ; change the data update address register: 0D4C' 78 ld a,b ; high address byte register, UA, 0D4D' D3 1C out (vccmd),a ; select it. 0D4F' 7C ld a,h ; get high byte, new address, 0D50' D3 1D out (vcrdat),a ; put it in high byte, UA. 0D52' 79 ld a,c ; low address byte, UA, 0D53' D3 1C out (vccmd),a ; select it. 0D55' 7D ld a,l ; new low address byte, 0D56' D3 1D out (vcrdat),a ; set it. 0D58' 3E 1F ld a,strcmd ; strobe register 0D5A' D3 1C out (vccmd),a ; start a new cycle 0D5C' DB 1C rdlop1: in a,(vcstat) ; get status 0D5E' B7 or a ; set flags 0D5F' F2 0D5C' jp p,rdlop1 ; wait until vc is ready 0D62' DB 1F in a,(vcdata) ; get a data byte 0D64' 08 ex af,af' ; save it 0D65' 78 ld a,b ; change address, 0D66' D3 1C out (vccmd),a 0D68' 7A ld a,d 0D69' D3 1D out (vcrdat),a 0D6B' 79 ld a,c 0D6C' D3 1C out (vccmd),a 0D6E' 7B ld a,e 0D6F' D3 1D out (vcrdat),a 0D71' 3E 1F ld a,strcmd 0D73' D3 1C out (vccmd),a 0D75' 08 ex af,af' 0D76' D3 1F out (vcdata),a 0D78' 13 inc de 0D79' 23 inc hl 0D7A' 7A ld a,d 0D7B' E6 07 and 7h 0D7D' 57 ld d,a 0D7E' 7C ld a,h Block Move Routines for the 6545 CRT Controller. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-59 Physical disk I/O, RAM image 0D7F' E6 07 and 7h 0D81' 67 ld h,a ; and now for the attributes 0D82' DB 1C rdlop2: in a,(vcstat) 0D84' B7 or a 0D85' F2 0D82' jp p,rdlop2 0D88' 78 ld a,b ; change address, 0D89' D3 1C out (vccmd),a 0D8B' 7C ld a,h 0D8C' F6 08 or 08h ; go to attribute ram 0D8E' D3 1D out (vcrdat),a 0D90' 79 ld a,c 0D91' D3 1C out (vccmd),a 0D93' 7D ld a,l 0D94' D3 1D out (vcrdat),a 0D96' 3E 1F ld a,strcmd 0D98' D3 1C out (vccmd),a 0D9A' DB 1C rdlop3: in a,(vcstat) 0D9C' B7 or a 0D9D' F2 0D9A' jp p,rdlop3 0DA0' DB 1F in a,(vcdata) 0DA2' 08 ex af,af' 0DA3' 78 ld a,b ; change address, 0DA4' D3 1C out (vccmd),a 0DA6' 7A ld a,d 0DA7' F6 08 or 08h ; attribute ram 0DA9' D3 1D out (vcrdat),a 0DAB' 79 ld a,c 0DAC' D3 1C out (vccmd),a 0DAE' 7B ld a,e 0DAF' D3 1D out (vcrdat),a 0DB1' 3E 1F ld a,strcmd 0DB3' D3 1C out (vccmd),a 0DB5' 08 ex af,af' 0DB6' D3 1F out (vcdata),a 0DB8' C1 pop bc 0DB9' 0B dec bc 0DBA' 78 ld a,b 0DBB' B1 or c 0DBC' 20 84 jr nz,mdir2 ;wm01 0DBE' C3 0E4B' jp mdexlp ; make sure last byte got moved ; move a block of data, source in hl, destination in de, count in bc. ; (just like a Z-80 block move, or LDDR, command, only slower.) ; 0DC1' 78 mddr: ld a,b 0DC2' E6 07 and 07h ; qualify the upper byte, 0DC4' B1 or c ; qualify the count 0DC5' C8 ret z ; not 65,535 please! 0DC6' C5 mddr2: push bc ; save the count 0DC7' DB 1C ddlopx: in a,(vcstat) 0DC9' B7 or a 0DCA' F2 0DC7' jp p,ddlopx ; wait until ready to begin 0DCD' 01 1213 ld bc,hiadd*100H+loadd ; address register numbers ; change the data update address register: Block Move Routines for the 6545 CRT Controller. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-60 Physical disk I/O, RAM image 0DD0' 78 ld a,b ; high address byte register, UA, 0DD1' D3 1C out (vccmd),a ; select it. 0DD3' 7C ld a,h ; get high byte, new address, 0DD4' E6 07 and 07h ; qualify it 0DD6' D3 1D out (vcrdat),a ; put it in high byte, UA. 0DD8' 79 ld a,c ; low address byte, UA, 0DD9' D3 1C out (vccmd),a ; select it. 0DDB' 7D ld a,l ; new low address byte, 0DDC' D3 1D out (vcrdat),a ; set it. 0DDE' 3E 1F ld a,strcmd ; strobe register 0DE0' D3 1C out (vccmd),a ; start a new cycle 0DE2' DB 1C ddlop1: in a,(vcstat) ; get status 0DE4' B7 or a ; set flags 0DE5' F2 0DE2' jp p,ddlop1 ; wait until vc is ready 0DE8' DB 1F in a,(vcdata) ; get a data byte 0DEA' 08 ex af,af' ; save it 0DEB' 78 ld a,b ; change address, 0DEC' D3 1C out (vccmd),a 0DEE' 7A ld a,d 0DEF' E6 07 and 07h 0DF1' D3 1D out (vcrdat),a 0DF3' 79 ld a,c 0DF4' D3 1C out (vccmd),a 0DF6' 7B ld a,e 0DF7' D3 1D out (vcrdat),a 0DF9' 3E 1F ld a,strcmd 0DFB' D3 1C out (vccmd),a 0DFD' 08 ex af,af' 0DFE' D3 1F out (vcdata),a 0E00' 13 inc de 0E01' 23 inc hl 0E02' 7A ld a,d 0E03' E6 07 and 7h 0E05' 57 ld d,a 0E06' 7C ld a,h 0E07' E6 07 and 7h 0E09' 67 ld h,a ; and now for the attributes 0E0A' DB 1C ddlop2: in a,(vcstat) 0E0C' B7 or a 0E0D' F2 0E0A' jp p,ddlop2 0E10' 78 ld a,b ; change address, 0E11' D3 1C out (vccmd),a 0E13' 7C ld a,h 0E14' F6 08 or 08h ; go to attribute ram 0E16' D3 1D out (vcrdat),a 0E18' 79 ld a,c 0E19' D3 1C out (vccmd),a 0E1B' 7D ld a,l 0E1C' D3 1D out (vcrdat),a 0E1E' 3E 1F ld a,strcmd 0E20' D3 1C out (vccmd),a 0E22' DB 1C ddlop3: in a,(vcstat) 0E24' B7 or a 0E25' F2 0E22' jp p,ddlop3 0E28' DB 1F in a,(vcdata) Block Move Routines for the 6545 CRT Controller. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-61 Physical disk I/O, RAM image 0E2A' 08 ex af,af' 0E2B' 78 ld a,b ; change address, 0E2C' D3 1C out (vccmd),a 0E2E' 7A ld a,d 0E2F' F6 08 or 08h ; attribute ram 0E31' D3 1D out (vcrdat),a 0E33' 79 ld a,c 0E34' D3 1C out (vccmd),a 0E36' 7B ld a,e 0E37' D3 1D out (vcrdat),a 0E39' 3E 1F ld a,strcmd 0E3B' D3 1C out (vccmd),a 0E3D' 08 ex af,af' 0E3E' D3 1F out (vcdata),a 0E40' C1 pop bc 0E41' 2B dec hl 0E42' 2B dec hl 0E43' 1B dec de 0E44' 1B dec de 0E45' 0B dec bc 0E46' 78 ld a,b 0E47' B1 or c 0E48' C2 0DC6' jp nz,mddr2 0E4B' DB 1C mdexlp: in a,(vcstat) 0E4D' B7 or a 0E4E' F2 0E4B' jp p,mdexlp 0E51' C9 ret 0E52' CD 0A31' dltlin: call carret ; do a carriage return 0E55' 3A FD5D ld a,(crow) 0E58' B7 or a 0E59' 28 3F jr z,dscroll ; special scroll wm01 0E5B' ED 5B FD60 ld de,(cursor) 0E5F' 21 0050 ld hl,linesiz 0E62' FE 17 cp 23 0E64' D2 095E' jp nc,clrdis ; clear last line or status line, exit 0E67' FE 0B cp 11 0E69' 30 44 jr nc,dltl1a ; normal delete line, lines 11-22 0E6B' EB ex de,hl ; de=linesiz, hl=cursor 0E6C' 01 004F ld bc,linesiz-1 0E6F' 09 add hl,bc ; hl=end of current line=dest 0E70' 7C ld a,h 0E71' E6 07 and 07h ; qualify it 0E73' 67 ld h,a ; hl=dest. 0E74' 44 ld b,h 0E75' 4D ld c,l ; bc=dest. 0E76' ED 52 sbc hl,de ; hl=source 0E78' 7C ld a,h 0E79' E6 07 and 7h ; qualify it 0E7B' 67 ld h,a ; source in hl 0E7C' E5 push hl ; save source 0E7D' ED 5B FD62 ld de,(vrbase) 0E81' ED 52 sbc hl,de ; hl=source-vrbase 0E83' 30 23 jr nc,dltl2b ; true count if no carry 0E85' 21 0800 ld hl,0800h 0E88' B7 or a ; clear carry Block Move Routines for the 6545 CRT Controller. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-62 Physical disk I/O, RAM image 0E89' ED 52 sbc hl,de 0E8B' D1 pop de ; source in de 0E8C' 19 add hl,de ; count in hl 0E8D' 7C ld a,h 0E8E' E6 07 and 07h 0E90' 60 ld h,b 0E91' 47 ld b,a 0E92' 7D ld a,l 0E93' 69 ld l,c 0E94' 4F ld c,a 0E95' EB ex de,hl ; hl=source, de=dest., bc=count 0E96' 03 dscrla: inc bc ; count=count-1 0E97' CD 0DC1' call mddr 0E9A' CD 0CE0' dscroll:call mvsts ; scroll, saving status line 0E9D' 2A FD60 ld hl,(cursor) 0EA0' 11 0050 ld de,linesiz 0EA3' 19 add hl,de 0EA4' EB ex de,hl ; new cursor position in de 0EA5' C3 0A60' jp putcur ; place cursor and exit 0EA8' 50 dltl2b: ld d,b 0EA9' 59 ld e,c ; de=dest. 0EAA' 44 ld b,h 0EAB' 4D ld c,l ; bc=count 0EAC' E1 pop hl ; hl=source 0EAD' 18 E7 jr dscrla ; go do it 0EAF' 19 dltl1a: add hl,de ; source = linesiz+destination 0EB0' 7C ld a,h 0EB1' E6 07 and 7h ; qualify it, 0EB3' 57 ld d,a 0EB4' 5D ld e,l ; put source in de. 0EB5' 2A FD62 ld hl,(vrbase) 0EB8' 01 0780 ld bc,lastlin+linesiz 0EBB' 09 add hl,bc ; lastpos=vrbase+(lastlin+linesiz) 0EBC' 7C ld a,h 0EBD' E6 07 and 07h ; qualify it, 0EBF' 67 ld h,a ; put it back in hl, 0EC0' 47 ld b,a 0EC1' 4D ld c,l ; save lastpos in bc. 0EC2' ED 52 sbc hl,de ; hl=lastpos-source 0EC4' 30 07 jr nc,dltl3a ; valid if no carry, 0EC6' 21 0800 ld hl,0800h ; else put boundry in hl, 0EC9' B7 or a ; clear carry 0ECA' ED 52 sbc hl,de ; hl=boundry-source 0ECC' 09 add hl,bc ; +lastpos 0ECD' 44 dltl3a: ld b,h ; put count in bc 0ECE' 4D ld c,l 0ECF' 2A FD60 ld hl,(cursor) ; dest 0ED2' EB ex de,hl ; in de, source in hl 0ED3' CD 0D3D' call mdir ; move it. 0ED6' 2A FD62 ld hl,(vrbase) 0ED9' 11 0730 ld de,lastlin 0EDC' 19 add hl,de 0EDD' 7C ld a,h 0EDE' E6 07 and 07h Block Move Routines for the 6545 CRT Controller. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-63 Physical disk I/O, RAM image 0EE0' 57 ld d,a 0EE1' 5D ld e,l ; last line in de 0EE2' 21 0050 ld hl,linesiz 0EE5' C3 095E' jp clrdis ; clear the last line ; insert a line 0EE8' 3A FD5D inslin: ld a,(crow) 0EEB' FE 0C cp 12 0EED' D2 0F99' jp nc,insln2 ; 'normal' insert line 0EF0' 2A FD62 ld hl,(vrbase) ; source 0EF3' 11 0050 ld de,linesiz 0EF6' B7 or a ; clear carry 0EF7' ED 52 sbc hl,de ; hl = new vrbase 0EF9' 7C ld a,h 0EFA' E6 07 and 07h ; qualify it 0EFC' 67 ld h,a 0EFD' EB ex de,hl ; dest in de, 0EFE' 01 0C1C ld bc,scrcmd ; scroll 0F01' CD 0BCC' call regrst 0F04' 2A FD60 ld hl,(cursor) 0F07' ED 4B FD62 ld bc,(vrbase) 0F0B' B7 or a 0F0C' ED 42 sbc hl,bc 0F0E' 30 0F jr nc,insl2a ; hl=amount 0F10' 21 0800 ld hl,0800h 0F13' B7 or a ; clear carry flag 0F14' ED 42 sbc hl,bc ; hl=800h-source 0F16' 7C ld a,h 0F17' E6 07 and 07h 0F19' 67 ld h,a 0F1A' ED 4B FD60 ld bc,(cursor) 0F1E' 09 add hl,bc 0F1F' 7C insl2a: ld a,h 0F20' E6 07 and 07h 0F22' 47 ld b,a 0F23' 4D ld c,l ; amount in bc ; test 0F24' 21 0080 ld hl,80+48 0F27' 09 add hl,bc 0F28' 7C ld a,h 0F29' E6 07 and 07h 0F2B' 47 ld b,a 0F2C' 4D ld c,l ; 0F2D' 2A FD62 ld hl,(vrbase) ; source in hl ; test 0F30' 11 0730 ld de,23*linesiz 0F33' 19 add hl,de 0F34' 7C ld a,h 0F35' E6 07 and 07h 0F37' 67 ld h,a 0F38' EB ex de,hl 0F39' 21 0050 ld hl,80 0F3C' 19 add hl,de ; source in hl, dest in de 0F3D' 7C ld a,h Block Move Routines for the 6545 CRT Controller. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-64 Physical disk I/O, RAM image 0F3E' E6 07 and 07h 0F40' 67 ld h,a ; 0F41' CD 0D3D' call mdir 0F44' 2A FD60 ld hl,(cursor) 0F47' 01 0050 ld bc,linesiz 0F4A' B7 or a ; clear carry 0F4B' ED 42 sbc hl,bc 0F4D' 7C ld a,h 0F4E' E6 07 and 07h 0F50' 67 ld h,a ; qualify address 0F51' EB ex de,hl ; put in de 0F52' 3A FD5E ld a,(ccol) 0F55' 4F ld c,a 0F56' 06 00 ld b,0 0F58' 21 0050 ld hl,linesiz 0F5B' ED 42 sbc hl,bc ; hl=amount 0F5D' D5 push de ; save new cursor address 0F5E' E5 push hl 0F5F' CD 095E' call clrdis ; clear to end of inserted line 0F62' C1 pop bc ; amount 0F63' C5 push bc 0F64' 2A FD60 ld hl,(cursor) 0F67' 3A FD5E ld a,(ccol) 0F6A' 5F ld e,a 0F6B' 16 00 ld d,0 0F6D' B7 or a 0F6E' ED 52 sbc hl,de 0F70' 7C ld a,h 0F71' E6 07 and 07h 0F73' 57 ld d,a 0F74' 5D ld e,l ; dest in de 0F75' 2A FD60 ld hl,(cursor) ; source in hl 0F78' CD 0D3D' call mdir 0F7B' C1 pop bc ; amount 0F7C' 21 0050 ld hl,linesiz 0F7F' B7 or a 0F80' ED 42 sbc hl,bc 0F82' C4 095E' call nz,clrdis 0F85' 2A FD62 ld hl,(vrbase) 0F88' 01 0050 ld bc,linesiz 0F8B' B7 or a 0F8C' ED 42 sbc hl,bc 0F8E' 7C ld a,h 0F8F' E6 07 and 07h 0F91' 67 ld h,a 0F92' 22 FD62 ld (vrbase),hl ; new vr base, 0F95' D1 pop de 0F96' C3 0A60' jp putcur ; put cursor and exit 0F99' D6 16 insln2: sub 22 0F9B' 28 2A jr z,inl33 0F9D' D2 08EE' jp nc,clreol 0FA0' ED 44 neg ; two's complement, number of lines to move 0FA2' F5 push af 0FA3' 2A FD62 ld hl,(vrbase) Block Move Routines for the 6545 CRT Controller. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE 1-65 Physical disk I/O, RAM image 0FA6' 11 072F ld de,79+22*80 ; source 0FA9' 01 0050 ld bc,80 0FAC' 19 add hl,de 0FAD' 7C ld a,h 0FAE' E6 07 and 07h 0FB0' 57 ld d,a 0FB1' 5D ld e,l 0FB2' 09 add hl,bc ; destination 0FB3' 7C ld a,h 0FB4' E6 07 and 07h 0FB6' 67 ld h,a 0FB7' EB ex de,hl ; hl:=source, de:=dest. 0FB8' F1 pop af 0FB9' E5 push hl 0FBA' 21 0000 ld hl,0 0FBD' 09 inl22: add hl,bc 0FBE' 3D dec a 0FBF' 20 FC jr nz,inl22 0FC1' 44 ld b,h 0FC2' 4D ld c,l ; bc=amount 0FC3' E1 pop hl ; restore source to hl 0FC4' CD 0DC1' call mddr ; move them 0FC7' 2A FD60 inl33: ld hl,(cursor) ; source in de, 0FCA' 54 ld d,h 0FCB' 5D ld e,l 0FCC' 3A FD5E ld a,(ccol) 0FCF' 4F ld c,a ; amount to clear, next line 0FD0' 3E 50 ld a,80 0FD2' 91 sub c ; amount to move and distance to go 0FD3' 4F ld c,a 0FD4' 06 00 ld b,0 0FD6' 09 add hl,bc ; dest. in hl, 0FD7' 7C ld a,h 0FD8' E6 07 and 07h 0FDA' 67 ld h,a 0FDB' EB ex de,hl ; now hl=source, de=dest, bc=amount 0FDC' CD 0D3D' call mdir ; move the rest to beginning of next line 0FDF' 3A FD5E ld a,(ccol) 0FE2' 6F ld l,a 0FE3' 26 00 ld h,0 0FE5' B7 or a 0FE6' C4 095E' call nz,clrdis ; clear to the end of the next line, 0FE9' C3 08EE' jp clreol ; clear to the end of this one. 0FEC' 0000 defw 0000h end Block Move Routines for the 6545 CRT Controller. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE S Physical disk I/O, RAM image Macros: DISPATCH Symbols: 05B9I' $DISKINIT 07DBI' $DISKOFF FD85 $DPB 05F1I' $HOME 05FDI' $READ 05DBI' $SELDSK 05E7I' $SETDMA 05E2I' $SETSEC 05ECI' $SETTRK 0610I' $WRITE 04B3' .SET F9A8 @ALVA FA4A @ALVB F928 @DIRBUF 02ECI' @DISKINIT 0482I' @DISKOFF F717 @DMAADR FB0C @DPBH FAEC @DPHA FAFC @DPHB F713 @ERFLAG 032CI' @HOME F70C @HSTACT F719 @HSTBUF F707 @HSTDSK F70A @HSTSEC F708 @HSTTRK F70D @HSTWRT F919 @MOVE 0338I' @READ F715 @READOP F714 @RSFLAG F703 @SEKDSK F70B @SEKHST F706 @SEKSEC F704 @SEKTRK 0443' @SEKTRKCMP 030AI' @SELDSK 0322I' @SETDMA 031DI' @SETSEC 0327I' @SETTRK F70E @UNACNT F70F @UNADSK F712 @UNASEC F710 @UNATRK 034BI' @WRITE F716 @WRTYPE 0896' ACTION 08B3' ACTN 0C0A' ADDATT FD94 ADRBUF 00C4 ADRCMD F701 ADSK 066C' ALLOC 03A7' ALLOCH FD43 ALVA 0043 ATTOFF 0042 ATTON 0020 AUTOE 0002 BAUD10 0007 BAUD12 000F BAUD19K 000A BAUD24 0005 BAUD30 000C BAUD48 000E BAUD96 0000 BAUDA 0008 BAUDB 0C8A' BELL 0007 BELLI 0004 BELLO 0014 BITPORT 0400 BLKSIZ 1000 BLKSIZH 009F' BOOT 0067' BOOTSYS 0010 BREAK 0080 BRK 07F1' BSY 0050 BUFSIZ 07F0' BUSY 0917' CALEOL 0A31I' CARRET 00D9' CB1 0B5A' CBLINK FD5E CCOL 0961' CDISLP 0985' CDISLP2 097A' CDISLP3 099D' CDISLP4 0018 CEOL 0017 CEOS 08FD' CEOS22 0107' CHECK 07FA' CHK0 081C' CHK1 0821' CHK2 082B' CHK3 0633' CHKUNA 036E' CHKUNAH 0938' CINILP 0945' CLEAR 0948' CLEAR2 0B32' CLRATR 0B64' CLRCUR 095EI' CLRDIS 08EEI' CLREOL 08F3' CLREOS 090C' CLRESL 0020 CLRPIX 001A CLRSCR 0B68' CLRVID 0010 CMND FD67 COL FD68 COL2 0198' COMOUT 0010 CONTROL 0028 CPMSPT 0044 CPMSPTH 000D CR 0000 CR1 0040 CR16 0080 CR32 000C CR64 0A42' CRLF FD5D CROW 0020 CSROFF 0060 CSRON 000A CSTART 000B CSTOP FD33 CSVA 0010 CTBLEN 0931' CTRINI 09BA' CTRTBL 0020 CTS 0B5F' CUNLIN 0E1C CURCMD 0B9B' CURPO2 0B9E' CURPO3 0B88' CURPOS FD60 CURSOR 0013 DATA 0008 DCD 0753' DCHECK 075F' DCHK1 0000 DDBIT 0DE2' DDLOP1 0E0A' DDLOP2 0E22' DDLOP3 0DC7' DDLOPX 02E0' DELAY4 00DF DENMASK 0181I' DEVINIT FD72 DIFX FD73 DIFY FE3B DIRBUF Block Move Routines for the 6545 CRT Controller. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE S-1 Physical disk I/O, RAM image 029B' DISKINIT 02A1' DISKOFF 07CCI' DISKON 0052 DLINE 0EAF' DLTL1A 0EA8' DLTL2B 0ECD' DLTL3A 0E52I' DLTLIN FB2F DMAADR 0083' DOAGAIN 076C' DOHOME 046F' DOHOMEH 08DB' DONE 05AA' DPB 058B' DPH0 02A7' DPH0H FD75 DPHA 0000 DRIVEA 00FE DRVMASK 0E96' DSCRLA 0E9A' DSCROLL FD31 DSK 0714' DSKSEL F700 DSKTYP 0184 DSMBLK 0080 DTR 0BBAI' DTWAIT 0080 ECCMOD 05AA' ENDDPH 02D6' ENDDPHH FB2B ERFLAG 0030 ERRSET 001B ESC 0C38' ESC2 0C50' ESC3 0C6D' ESC4 0C78' ESC5 FD64 ESCCMD 0C16' ESCSEQ 0001 ESIE 0010 EXTRSET 0000 FALSE 00D0 FICMD 0130' FILHDR 06AC' FILHST 03E7' FILHSTH 0116' FNDIDX 0040 FRAMERR FFFF FSEL 0C00I' GETATT 0BD9I' GETC 0BDD' GETC2 0080 HDBASE 047B' HDBSY 0085 HDCHI 02D6' HDCINIT 0084 HDCLO 0087 HDCMD 0002 HDCRES 00FD HDCSEL 0080 HDDATA 0008 HDDMAM 0081 HDETYP 001C HDINIR 0563' HDRD 0540' HDREAD 0020 HDRED 0022 HDREDL 0011 HDRSTR 0082 HDSCNT 0086 HDSDH 0083 HDSEC 0070 HDSEEK 0000 HDSEL 00A8 HDSELH 00E7 HDSMSK 0087 HDSTAT 04EE' HDWRITE 0030 HDWRT 0032 HDWRTL 0081 HDWRTP 0012 HIADD 09AC' HOME 001E HOMEC 05FA' HOMED 0335' HOMEDH 0228' HOME_DISPATCH 0517' HRDWRT FB24 HSTACT 0004 HSTBLK FB31 HSTBUF 0851' HSTCOM 045D' HSTCOMH FB1F HSTDSK FB22 HSTSEC 0200 HSTSIZ 000A HSTSPT 0011 HSTSPTH FB20 HSTTRK FB25 HSTWRT 0020 IENRC 0045 ILINE 000F IMAGE_LENGTH 0087 IMAGLEN 0FBD' INL22 0FC7' INL33 0F1F' INSL2A 0EE8I' INSLIN 0F99' INSLN2 0002 INTPED 0867' IOIMAGE 057C' IOIMAGEH 0181' IOTBEND 0178' IOTBINT 019EI' KBDIN 01B3' KBDMAP 01A9I' KBDOUT 0194I' KBDSTAT 0730 LASTLIN 0008 LCUR 0AA8' LCUR2 0AB3' LCUR3 0155' LDLP FD5C LEADFLG 000A LF 0A93' LFCUR 004C LINDRAW 0A54' LINEF2 0A58' LINEF3 0A45' LINEFD EE0F LINEOFF EE0C LINEON 0044 LINERAS 0050 LINESIZ 0018 LINESPS 0215I' LIST 020BI' LISTSTAT 0013 LOADD 009C' LOADIT 0141' LOADOVL 003D LODCUR 0002 LONGRW 011C' LP1 0135' LP2 0131 LZONE 01C8' MAPIN 01DB' MAPOUT 06C9' MATCH 0404' MATCHH 0131 MAXCYL 0DC1I' MDDR 0DC6' MDDR2 0E4B' MDEXLP 0D3DI' MDIR 0D42' MDIR2 FD9A MOVE 0CD9I' MOVSTS 0004 MULTRW 0CE0' MVSTS 0D16' MVSTS2 FD6C NEWC 0066 NMIVEC 06A5' NOMATCH 03E0' NOMATCHH 0666' NOOVF 03A1' NOOVFH 0B55' NRMINT 0000 NRMLATT Block Move Routines for the 6545 CRT Controller. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE S-2 Physical disk I/O, RAM image 0B50' NRMVID 0000 NULL FD6B ONOFF 0793' OUTTRK 0127' OVLOAD EE00 OVLRAM 0018 PDAT FD6D PIX EE09 PIXOFF EE06 PIXON 0001 PON 0006 PREADY FD65 PRECUR 0CCBI' PRINT 0002 PSTATE 0003 PSTROB 0BEF' PUTA 0BF2I' PUTATT 0BE3I' PUTC 0BE8' PUTC2 0A74' PUTCR2 0A60I' PUTCUR 0927' RAMINI 000C RAMLEN F700 RAMSCRATCH 0000 RBITS5 0080 RBITS6 0040 RBITS7 00C0 RBITS8 0001 RCA 000C RCUR 0882' RD EE03 RD.ERR FDA9 RD128 FDB0 RD512 0088 RDCMD 0839' RDHST 0D5C' RDLOP1 0D82' RDLOP2 0D9A' RDLOP3 0D43' RDLOPX 009C RDMASK FE3A RDWRTEND 0001 RE 0249' READ 0836' READHST 044F' READHSTH FB2D READOP 07B8' READY 04C3' READYH 0AFB' REDINT 0BCCI' REGRST 0018 RESET 00C9 RETCOD 0AF6' REVID 0BBD' RGWAIT 0BC5' RGWT2 0000 RID 0018 RIE 0010 RIEP 0008 RIFC 092D' RINILP 08C0' RL1 08C5' RL2 0020 ROVR FD69 ROW FD6A ROW2 0010 RPE 0000 RR0 0001 RR1 0002 RR2 FB2C RSFLAG 0000 RSTCMD 0B6D' RSTCUR 0001 RT05MS 0002 RT10MS 0006 RT30MS 0000 RT35US 000C RT60MS 000F RT75MS 0AC2' RTCUR 0028 RTIP 0002 RTS 042A' RW@MOVE 121C RWCMD 06EF' RWMOVE 0674' RWOPER 03AF' RWOPERH 0272' S1 027C' S2 028B' S3 FD6E SADDR 0B22' SAVCUR 0B29' SAVSTS 0004 SBITS1 000C SBITS2 0008 SBITS5 0B00' SBLINK 0C1C SCRCMD 0AD5' SCROLL 0B7F' SCRSTS 0020 SDBIT 0020 SEC512 0003 SECMSK 079F' SECSET 04BF' SECSETH 0002 SECSHF 0012 SECTOR 07ADI' SECTRAN F702 SECTRK 07AA' SECX 0010 SEEKCMD FB1B SEKDSK FB23 SEKHST 04D0' SEKOK FB1E SEKSEC FB1C SEKTRK 0708' SEKTRKCMP 025F' SELDSK 0AD8' SETATR 0B0C' SETCR2 0B0A' SETCUR 0293' SETDMA 002A SETPIX 023E' SETSEC 0233' SETTRK 0B14' SETVID 0004 SID0 0000 SID1 FD32 SIDFLG 00FB SIDMASK 0004 SIO 0006 SIOA0 0004 SIOA1 0007 SIOB0 0005 SIOB1 000E SIOC0 000C SIOC1 000F SIOD0 000D SIOD1 0020 SPACE 09DC' SPCEXE 0C8F' SPECHAR 00C2 SSMBLK FFFF STACK 004B' START 0004 STATAV 0019 STATLIN 0010 STATUS 001F STRCMD 0B05' SUNLIN 0000 SYNCMD 0010 SYNHNT 0004 TBE 0000 TBITS5 0040 TBITS6 0020 TBITS7 0060 TBITS8 0009 TBLEN 018C' TBLOUT 0008 TE 07E4I' THNSD 0000 TID 0002 TIE 07E7' TLP 0011 TRACK 0002 TRIES1 0005 TRIES2 Block Move Routines for the 6545 CRT Controller. (C) 1983 By NLS MACRO-80 3.44 09-Dec-81 PAGE S-3 Physical disk I/O, RAM image 077D' TRKSET 049E' TRKSETH FFFF TRUE 01F3I' TTYIN 0205I' TTYOSTAT 01FBI' TTYOUT 01EDI' TTYSTAT 000B UCUR FB26 UNACNT FB27 UNADSK FB2A UNASEC FB28 UNATRK 0A7C' UPCUR FD5F VATT 001C VCBASE 001C VCCMD 001F VCDATA 001D VCRDAT 001C VCSTAT FD74 VGB1 09E7' VGMEXE 09F9' VGMOD 0A0E' VGMOD2 0A16' VGMOD5 0927I' VIDINIT 09CAI' VIDOUT FD5C VIDRAM FD62 VRBASE 08D1' WL1 08D6' WL2 0000 WR0 0001 WR1 0002 WR2 0003 WR3 0004 WR4 0005 WR5 0006 WR6 0007 WR7 0000 WRALL 0001 WRDIR 0254' WRITE 07F8' WRITEHST 0456' WRITEHSTH 0893' WRT EE00 WRT.ERR FDBA WRT128 FDC1 WRT512 0816' WRTCHK 00AC WRTCMD 07FD' WRTHST 00FC WRTMASK FB2E WRTYPE 0002 WRUAL 08CC' WSTART 0040 XMTUNDR FD70 XOFF FD71 YOFF No Fatal error(s)