TITLE 'CBIOS for Monroe "Monty" microcomputer and CP/M 2.2' ; ; written by Bruce R. Ratoff ; 26 Broad Street ; Cranford, NJ 07016 ; for Monroe Systems for Business ; The American Road ; Morris Plains, NJ 07950 ; ; Last change: 2/8/1983 WGW ; false equ 0 true equ not false ; version equ 2 revision equ 27 production equ true ; true if production run ; month equ 2 day equ 8 year equ 83 ; ; v2.27 WGW 256K support ; v2.26 WGW Hard disk support, printer etx/ack and timeout, clock ; v2.25 WGW Added xon/xoff support on list device ; v2.24 BRR First release version ; v2.23 BRR Experimental versions from v2.20 ; etxack equ true ; enable etx/ack code ulimit equ 81 ; upper block size limit (+1) ; for etx/ack mode llimit equ 77 ; lower block size limit ; for etx/ack mode w/esc seq. ; memorydisk equ true ; utilize top 64k as disk mdisk$base equ 60h ; uses top 4 bits in io$pmapa ; defaultpmapa equ 0 ; default program map A offset defaultpmapb equ 0 ; default program map B offset ; scanuser0 equ true ; ccp scan of user 0 on error mpmbdoscalls equ true ; enables mp/m bdos functions interrupts equ true ; enables timer interrupts coninterrupt equ true and interrupts ; enables console type ahead conbuffersize equ 64 ; size of console type ahead buffer eiconst equ true and interrupts ; puts an EI in lconst: todfunctions equ true and interrupts ; enable bdos tod functions displayclock equ true and todfunctions ; display tod clock on OC displayampm equ true and displayclock ; display as 12 hour AM/PM clockoff equ false ; disables default tod display ; clockattribute equ 0 ; see attributes below clockcolumn equ 65 ; clock display column ; ; Bit Description (Display Attribute) ; 7 (msb) no-op ; 6 Dim ; 5 Double width ; 4 Reverse video ; 3 Underline (or block graphics) ; 2 Blink ; 1-0 Select code ; 0 = Normal Character ; 1 = Double height bottom ; 2 = Double height top ; 3 = Graphics (Thin line or block) ; maxfloppy equ 4 ; 4 floppies maxharddisk equ 4 ; 2 hard disks (2 more for two 10M hard disks) ; if memorydisk maxdisk equ maxfloppy+maxharddisk+1 mdrive equ 8 ; |10| else maxdisk equ maxfloppy+maxharddisk mdrive equ -1 ; |10| endif ; ; istacksize equ 32 ; bytes allocated to interrupt stack ; maclib diskdef ;get table generation macros maclib z80 ;get z80 instruction set maclib montyio ;get Monty port definitions ; ; debug equ false ;true if trap "calc mode" key into Z80MON reloc equ true ;true if assembling for MOVCPM msize equ 64 ;cp/m memory size in kilobytes ; sys$ram EQU 41H ; SELECT 16K-32K-16K PARTITION sys$video EQU 45H ; SELECT VIDEO RAM AT 3000 HEX ; ; "bias" is address offset from 2C00H for memory systems ; larger than 21K (referred to as "b" throughout the text). ; Note: In "standard" systems, this is the offset from 3400H. ; bias equ (msize-21)*1024 ; if reloc ccp equ $ ;will be 0 w/o MAC +R switch, 100h with else ccp equ 2D00H+bias ;base of ccp endif bdosb equ ccp+800h ;base of bdos bdos equ ccp+806h ;entry to bdos bios equ ccp+1600h ;base of bios bdosaret equ bdosb+345h ;bdos function code return value ; cdisk equ 0004H ;current disk number 0=A,...,15=P iobyte equ 0003h ; i/o byte ; start$ctc3 equ 85h ; div 16 with time constant and interrupt oneslice equ 250 ; time constant onetick equ 15 ; sub-interval to get 20 msec onesecond equ 50 ; 20 msec clock tick, 50 ticks/second ; maxrtr equ 5 ;max retries on floppy error rate equ 1 ;seek rate select (12 ms) if interrupts montime equ 15 ; seconds by timer interrupt else montime equ 10 ;tick count for motor timeout endif ; ; --- ASCII character codes ----- ; etx equ 3 ack equ 6 bell equ 7 bs equ 8 lf equ 10 ff equ 12 cr equ 13 xon equ 17 ; control-q xoff equ 19 ; control-s esc equ 27 ; escape control equ 1fh ; control characters ; ; ---- Additional implemented BDOS function codes ----- ; settime equ 104 readtime equ 105 returnserial equ 107 readclock equ 155 ; ; ; ---- XEBEC COMMAND CONSTANTS ------ ; TSTDR EQU 0 RESTR EQU 1 RQSEN EQU 3 SEEK EQU 0BH RDSEC EQU 08 WRSEC EQU 0AH CHKTK EQU 05H FORBD EQU 07H SETDR EQU 0CH ; DRVSEL1 EQU 20H ; ; GORMAN INTERFACE STATUS ; CSTAT EQU 4 CDONE EQU 2 GCMD EQU 1 CBUSY EQU 80H ; DTAREQ EQU 40H ERHDK EQU 2 ; ; GORMAN-XEBEC PORT ASIGNMENTS ; HD$DATA EQU 78H STCS EQU 79H ENDMA EQU 7AH DISDMA EQU 7BH ENINT EQU 7CH DISINT EQU 7DH ; SEL EQU 79H ; DMAMSK EQU 0FCH DMAHD EQU 03 ; ; Macro to generate correct ORG statements for reloc or non-reloc sys rorg macro x if reloc org x-ccp else org x endif endm ; ; The following code generates the boot header sector required ; by the IPL ROM. ; It normally resides in track 0, sector 1 of a system disk. ; HORG equ CCP-100H ; Boot location rel. to CCP rorg HORG+0EH ; Set BIOS entry point db BIOS/256,BIOS and 0FFH rorg HORG+1EH dw 0FFFFH ; Flag this as a CP/M disk rorg HORG+82h ; Set load address db CCP/256,CCP and 0FFH if debug ; Set load length db code$size/256+7,code$size and 0FFH else db code$size/256,code$size and 0FFH endif ; ; ; The patches below cause the CCP to automatically search IPL drive ; for any .COM file not found on the current default drive. ; ccp$get$user equ ccp+113h ; ccp entry points ccp$set$user equ ccp+115h ; ccp$jnz$user0 equ ccp+6adh ; patch point ccp$user0 equ ccp+6c4h ccp$start$com equ ccp+6cdh ccp$jz$userer equ ccp+6dbh ; patch point ccp$jnz$load1 equ ccp+6ech ; patch point ccp$load1 equ ccp+701h ccp$userer equ ccp+76bh ccp$com$fcb equ ccp+7cdh ccp$sdisk equ ccp+7f0h ccp$end equ ccp+7f2h ; patch point ; ; rorg ccp$jz$userer jz ccppatch ; Taken if .COM not found ; ; if scanuser0 rorg ccp$jnz$user0 jnz ccp$jnz$user0$patch ; jump to patch location ; rorg ccp$jnz$load1 jnz ccp$load1$patch ; jump to patch location endif ; end of scan user 0 option ; ; rorg ccp$end ; top of ccp section (14 free bytes) ccp$patch: ; use unaccessed ccp section lda ccp$auto$retry ; a := ccp auto retry flag ora a ; see if zero jz ccp$userer ; error if retries not allowed jmp continue$ccp$patch ; ; This patch allows the SUBMIT file ($$$.SUB) to reside on the IPL drive ; rorg ccp+140h ; in READCOM was lda ipldsk ; lda cdisk nop ; ora a nop ; mvi a,0 nop db 0cdh ; cnz (now a call) ; rorg ccp+17dh ; in READCOM was lda ipldsk ; lda cdisk ora a ; ora a db 0cdh ; cnz ; rorg ccp+1e5h ; in DEL$SUB nop ; patches over: xra a call ccppat3 ; patches over: call select ; ; These patches force IPL drive to be selected after any BDOS error ; rorg bdosb+0a2h dw permerr ; rorg bdosb+0b8h dw permerr ; ; This patch changes the drive selected by the "disk reset" function ; to be the drive that the system was booted from, rather than A: ; rorg bdosb+0c8dh jmp rstpatch ; rorg bdosb+0df7h rstpatch: lda ipldsk sta bdosb+0342h jmp bdosb+0c90h ; ; This patch allows the mp/m bdos calls to be operable. ; if mpmbdoscalls rorg bdosb+33h ; place where bdos checks function code jmp bdospatch ; use internal check of limits bdosfunc: ; enter here if bdos function is ok endif ; ; ; rorg bios ;origin of this program ; ; jump vector for individual subroutines jmp boot ;cold start wboote: jmp wboot ;warm start xconst: jmp lconst ;console status xconin: jmp lconin ;console character in xco: jmp lconout ;console character out jmp llist ;list character out jmp lpunch ;punch character out jmp lreader ;reader character out jmp home ;move head to home position jmp seldsk ;select disk jmp settrk ;set track number jmp setsec ;set sector number jmp setdma ;set dma address jmp read ;read disk jmp write ;write disk jmp llistst ;return list status jmp sectran ;sector translate ; ; Physical driver variables: ; (Placed here in case maintenance utilities need them.) fpyctrl: ds 1 ;current select/control port value timecntr: ds 1 ;motor off delay count (0 if inactive) ipldsk: ds 1 ;IPL drive - default for warm boot bufptr: ds 2 ;used by COPY utility do not move |10| trktbl: db 255,255,255,255 ;current track on each drive fpycmd: ds 1 ;current floppy command timecntp: ds 2 ;motor off delay prescale count fpyrtry: ds 1 ;retry count for seek, read, write ; ; Default CTC and SIO divider control bytes for serial ports rbaud: db 78,0c4h ;modem baud rate control (300 baud) cbaud: db 10,44h ;aux console baud rate control (9600 baud) lbaud: db 78,44h ;printer baud rate control (1200 baud) ; ; Function key translate table pointer ukptr: dw uktbl ;reset to uktbl at every warm boot ; ; Sector translate table NOW FOR FLOPPY ONLY xltbl: db 0,1,8,9,16,17,24,25 db 2,3,10,11,18,19,26,27 db 4,5,12,13,20,21,28,29 db 6,7,14,15,22,23,30,31 ; enableetxack: db 0 ; 0ffh enables etx/ack printer support lsize: db 0 ; current line size with etx/ack mode ; ccp$auto$retry: db true ; ccp auto retry on .com file load ; logical$disk: ; logical to physical disk table db 0, 1, 2, 3 ; A:, B:, C:, D: (floppies) hd$drvs: ; |10| db 4, 5,-1,-1 ; E:, F:, G:, H: (hard disk) db -1,-1,-1,-1 ; I:, J:, K:, L: (not used) db mdrive,-1,-1,-1 ; M:, N:, O:, P: (memory disk) |10| ; pmapa$current: db defaultpmapa ; current value of io$pmapa pmapb$current: db defaultpmapb ; current value of io$pmapb sys$current: db sys$ram ; current value of io$sys cpm$system: db sys$ram ; current value while running cpm ; can be changed to sys$video to ; select video ram at 3000 hex cpm$video: db sys$video ; current value while running cpm to ; select video ram at 3000 hex ; ; second$interrupt: ; for system programs ONLY if displayclock if clockoff ret ; patch to jump to enable display dw displaytod ; possible jump location else jmp displaytod ; display time of day endif else ret ; Call made here each second. dw 0 ; Can be patched with a jump location ; Only three stack levels available, ; all 8080 registers saved endif ; inputpointer: db 0 ; console buffer input pointer outputpointer: db 0 ; console buffer output pointer ; mem$hcol: db 80h ; buzzer/hi-res/char video enable port copy ; lstsec: db 0ffh ; list time-out in seconds (0ffh is off)|14| lstcnt: db 0 ; list time-out counter |14| ; ; ; XEBEC CONTROL BLOCK DCB$CMD: DS 1 ;COMMAND SAVE BYTE. DCB$DRV: DS 1 ;DRIVE AND MS ADDR DCB$CTRK: DS 2 ;CURRENT LOGICAL ADDRESS DCB$NSEC: DB 1 ;NUMBER OF SECTORS TO XFER DCB$CTL: db 0 ;CONTROL BYTE |10| DCB$RSTA: DS 1 ;RETURNED STATUS DCB$RTRK: DS 3 ;RETURNED LOGICAL ADDRSS DCB$RTRY: DS 1 ;RETRY COUNTER ; ; if interrupts tod: dw 0 ; days since Jan. 1, 1978 todhours: db 0 ; hours (BCD) todminutes: db 0 ; minutes (BCD) todseconds: db 0 ; seconds (BCD) db onesecond todticks: db onetick ; ticks interruptsp: dw 0 ; sp during clock interrupt ds istacksize ; interrupt stack (see next label) if (low $) gt 0d0h ; interrupt vectors start at xx0dh rorg <1D0h+(0ff00h and $)> ; on next page else rorg <0d0h+(0ff00h and $)> ; on this page endif interruptstack: ; interrupt stack grows down vectortbl: dw doreti ; SIO B (D0) Transmit Ready (Auxillary) dw doreti ; Status Change dw doreti ; Receiver Ready dw doreti ; Special Reciver Condition � dw doreti ; SIO A (D8) Transmit Ready (Communication) dw doreti ; Status Change dw doreti ; Receiver Ready dw doreti ; Special Reciver Condition if coninterrupt dw consoleint ; Dart B (E0) Transmit Ready (Keyboard) dw consoleint ; Status Change dw consoleint ; Receiver Ready dw consoleint ; Special Reciver Condition else dw doreti ; Dart B (E0) Transmit Ready (Keyboard) dw doreti ; Status Change dw doreti ; Receiver Ready dw doreti ; Special Reciver Condition endif dw doreti ; Dart A (E8) Transmit Ready (Printer) dw doreti ; Status Change dw doreti ; Receiver Ready dw doreti ; Special Reciver Condition dw doreti ; Ctc 0 (F0) dw doreti ; Ctc 1 (F2) dw doreti ; Ctc 2 (F4) dw clockint ; Ctc 3 (F6) dw doreti ; PIO A (F8) dw doreti ; PIO B (FA) dw doreti ; not used (FC) dw doreti ; External (Maybe FE) ; if coninterrupt consoleint: sspd interruptsp ; save user sp lxi sp,interruptstack push psw ; save parameters push b push d push h in io$drtbd ; a := character entered mov c,a ; c := character entered lxi h,outputpointer ; hl := output pointer index mov d,m ; d := output pointer dcx h ; hl := input pointer index mov e,m ; l := current input pointer mov a,e ; a := current input pointer inr a ; increment pointer cpi conbuffersize ; check for pointer overflow jrc concheckbuffer sub a ; a := 0 (start of buffer) concheckbuffer: cmp d ; compare to output pointer jrz conrestore ; exit if buffer is full mov m,a ; update input pointer mvi d,0 ; de := current input pointer lxi h,conbuffer ; hl := base of console buffer dad d ; hl := buffer index mov m,c ; update buffer conrestore: pop h ; restore parameters pop d pop b pop psw lspd interruptsp ; restore user stack ei ; enable interrupts reti ; resume execution endif clockint: ; main timer interrupt for clock and timeout sspd interruptsp ; save user sp lxi sp,interruptstack push psw ; save state on interrupt stack push h lxi h,todticks ; hl := tod ticks index dcr m jrnz noclocktick ; check the rest of the clock each tick push b ; save user bc and de push d ; all primary registers saved call clocktick ; do real operation pop d ; restore user registers pop b noclocktick: pop h ; restore user regisers pop psw lspd interruptsp ; restore user stack doreti: ei ; turn on interrupts reti ; resume clocktick: mvi m,onetick ; update tick counter dcx h ; index slice counter dcr m ; decrement slice count rnz ; exit if not one second mvi m,onesecond ; update tick count if todfunctions ; select if mp/m bdos tod functions call updatetod ; update clock (hl = base of tod block) call second$interrupt ; possible user routine endif call chklist ; check list time-out every second jmp chkmotor ; check disk drive motor every second chklist: lxi h,lstcnt ; hl := list time-out counter index mov a,m ; a := list time-out counter ora a ; time-out occurred? rz ; exit on time-out inr a ; counter off? (a was 0ffh) rz ; exit if counter turned off dcr m ; else decrement counter ret if todfunctions updatetod: ; update time-of-day clock mvi e,60h ; e := seconds/minutes limit call checktoddigit ; check seconds cnc checktoddigit ; check minutes (skip if seconds < 60) mvi e,24h ; e := hours limit cnc checktoddigit ; check hours (skip if sec/min < 60) rc ; check days, exit if still today dcx h ; otherwise, increment day count dcx h ; index lsb of tod days inr m ; increment lsb rnz ; exit if no overflow inx h ; index msb of tod days inr m ; increment msb ret ; all done checktoddigit: dcx h ; index next digit mov a,m ; increment next digit(BCD) adi 1 daa mov m,a ; update next digit cmp e ; check for one minute rc ; return if less than limit mvi m,0 ; zero digit ret endif ; end of tod functions endif ; end of interrupts if mpmbdoscalls ; check for mp/m bdos function calls bdospatch: ; de = parameter cpi 29h ; number of normal cp/m bdos functions jc bdosfunc cpi returnserial ; check for mp/m return serial number function jrz returnserialnumber if (not todfunctions) ret ; return to bdos else ; else, check for tod bdos functions lxi h,tod ; hl := tod address, de = parameter cpi readtime ; check for mp/m read time function jrz copy4 cpi readclock ; check for mp/m read clock function jrz copy5 cpi settime ; check for mp/m set time function rnz ; exit if invalid function sub a ; a := 0 sta todseconds ; clear seconds xchg ; hl := source of time, de := tod copy4: lxi b,4 ; move in new tod ldir ret copy5: lxi b,5 ; copy 5 bytes ldir ret endif ; end of mp/m time-of-day bdos functions returnserialnumber: ; de = user destination lxi h,bdosb ; hl := source of serial number lxi b,6 ; 6 bytes in serial number ldir ; copy to user buffer ret ; all done endif ; ; ; --- Rest of ccppatches -------------------------------- ; ; continue$ccp$patch: ; fcb disk drive just tested for 0 lda ccp$sdisk ; a := current drive number ora a ; zero means default was taken if scanuser0 jrnz try$user0 ; try user 0 on ipl disk else jnz ccp$userer ; If nonzero, don't change it endif lda cdisk ; a := current disk/user number ani 0fh ; a := current disk mov b,a ; save current disk number lda ipldsk ; Get IPL drive cmp b ; compare ipl disk with current disk if scanuser0 jrz try$user0 ; try user 0 of ipl already selected else jz ccp$userer ; error if already ipl disk and user 0 endif inr a ; convert to base 1 sta ccp$sdisk ; update fcb disk number with ipl disk ccp$restart: lxi d,ccp$com$fcb+9 ; Setup for retry jmp ccp$start$com ; Go do it ; ; if scanuser0 ; scan ipl drive, user 0 if .com file ; not found on designated drive ccp$local$user: db 0 ; local user number ; ccp$jnz$user0$patch: call ccp$get$user ; a := local user number sta ccp$local$user ; save, restored by load1 or userer jmp ccp$user0 ; continue in the normal fashion ; ccp$load1$patch: push psw ; save load result call ccp$reset$user ; reset to original user code pop psw jmp ccp$load1 ; continue ccp load ; ccp$userer$patch: call ccp$reset$user ; reset to original user code jmp ccp$userer ; continue with the normal error code ; ccp$reset$user: lda ccp$local$user ; a := user number mov e,a ; e := user number jmp ccp$set$user ; set user number ; ; ; --- Alternatives to default disk ------------------------- ; try$user0: call ccp$get$user ; a := user code ora a jrz ccp$userer$patch ; error if user 0 already selected mvi e,0 ; e := user code call ccp$set$user ; set user 0 jmpr ccp$restart ; endif ; end of scan user 0 option ; ; ; --- Additional area for XUB patch ------------------------- ; ccppat3: ; select drive to delete $$$.sub lda ipldsk ; get ipl drive mov e,a mvi c,14 ; bdos select disk function code jmp bdos ; select the disk ; ; ; --- Video clock display routines ------------------------- ; if displayclock videodisplaytod equ 3000h+(24*160)+(2*clockcolumn) ; line 24 displaytod: lda cpm$video ; select video ram out io$sys lxi h,videodisplaytod ; hl := video display index lxi d,todhours ; de := tod index if displayampm mvi c,'A' ; c := AM/PM selection (AM default) ldax d ; a := hours (BCD) ora a ; check if hours = 0 jrnz notmidnight mvi a,12h ; set to midnight (2400 hours) jmpr displayam ; it is 12 AM in the morning notmidnight: cpi 12h ; see if it is AM jrc displayam ; skip if in the morning jrz displaypm ; skip if noon adi 88h ; adjust hours (subtract 12) daa ; adjust for BCD, now 1 to 11 displaypm: mvi c,'P' ; c := PM selected displayam: endif call display2a ; display hours call displaydot2 ; display minutes call displaydot2 ; display seconds if displayampm inx h ; add a space inx h ; two bytes per character mov a,c ; a := 'A' or 'P' call displaychar ; display it mvi a,'M' ; a := 'M' call displaychar ; display it too endif lda sys$current ; select previous value out io$sys ret displaydot2: ; display .dd call displaydot ; display a dot display2: ldax d ; a := 2 bcd digits display2a: push psw ; save for later rar rar rar rar ; a := ms digit call displaydigit pop psw ; a := 2 bcd digits call displaydigit inx d ; index next tod position ret displaydigit: ; display a digit ani 0fh ori '0' jmpr displaychar displaydot: mvi a,'.' displaychar: mvi m,clockattribute ; display attribute inx h mov m,a ; display character inx h ret endif ; ; ; ;Warm-boot entry point must re-load CCP and BDOS, ;then jump into CCP warm entry point. ; wboot: lxi sp,0100h ; use temporary stack for warm boot call wb$disk ; a := warm boot disk drive number lxi h,ccp+3 ; where to go on init gocpm: ; ccp and bdos loaded push h ; save ccp entry address ; mvi a,montime ; a := floppy disk motor timeout delay sta timecntr ; enable floppy disk motor timeout ; xra a ;0 to accumulator sta hstact ;host buffer inactive sta unacnt ;clear unalloc count ; mvi a,0c3h ;c3 is a jmp instruction sta 0 ;for jmp to wboot lxi h,wboote ;wboot entry point shld 1 ;set address field for jmp at 0 ; sta 5 ;for jmp to bdos lxi h,bdos ;bdos entry point shld 6 ;address field of jump at 5 to bdos ; lxi b,80h ;default dma address is 80h call setdma ; lxi h,hstbuf ;set host buffer address shld bufptr ;for deblocking reads and writes ; lxi h,uktbl ;reset function key pointer shld ukptr ;to built-in translate table ; lda iobyte ;is this 40-col screen ani 3 cpi 1 ;if so then modify DIR command for 2 cols. jrnz go2 sta ccp+4b2h go2: if interrupts ei ;enable the interrupt system endif lda cdisk ;get current disk number mov c,a ;send to the ccp ret ;go to cp/m for further processing ; wb$disk: if memorydisk lxi h,4000h+100h ; hl := base of ccp/bdos in mdisk lxi d,ccp ; de := ccp/bdos base lxi b,bios-ccp ; number of bytes to move mvi a,mdisk$base ; a := mapping value out io$pmapa ; select mdisk base ldir ; copy ccp and bdos lda pmapa$current ; select current value out io$pmapa ; select normal ram ret else lda ipldsk ; a := physical disk number ani 0fh ; make sure it there are only 16 devices mov e,a mvi d,0 ; de := logical disk number lxi h,logical$disk ; hl := logical disk table dad d ; hl := physical disk number index mov a,m ; a := physical disk number sta hstdsk ;select boot drive lxi h,0 shld hsttrk ;track 0 mvi a,1 ;sector 2 lxi h,ccp ;load ccp first wbloop: sta hstsec ;sector to read shld bufptr ;where to read it to call readhst ;perform read lda erflag ;was it successful? ora a jnz wboot ;retry boot on any read error lhld bufptr inr h ;bump pointer mov a,h cpi bios/256 ;done yet? rnc ;exit if yes lda hstsec ;else bump sector inr a cpi 16 ; time for seek yet? jrc wbloop ; loop back if not mvi a,1 ; else update track sta hsttrk sub a jmpr wbloop ;continue at track 1, sector 1 endif ; ; ; ;Print message at (HL) until null prmsg: mov a,m ;get char ora a ;test for 0 rz push h ;save pointer mov c,a call xco ;output char. pop h inx h ;bump pointer jmpr prmsg ;loop till all done ; ; ; Console drivers for Monroe 'Monty' microcomputer ; ; Entry point for normal sequential console output. ; Character to be output is passed in C reg. ; conout: sspd spsave ; Save caller's stack and set up our own lxi sp,loclstk ; so we can safely bank out low RAM lda cpm$video ; a := select byte for video ram sta sys$current ; update current value in ram out io$sys call point ; Remove existing cursor res 7,m call crtout ; Process new character call setcur ; Turn on new cursor lda cpm$system ; a := select byte while running cpm sta sys$current ; update current value in ram out io$sys ; Switch out VRAM lspd spsave ; restore user stack pointer ret ; Bye-bye ; ; Main CRT output routine ; crtout: lded ukop ; Are we loading a function key? mov a,d ora a ; we are if pointer is nonzero jrz notuko xchg ; put pointer in HL lded ukptr ; check for overflow push h dsbc d ; get offset from start of table mov a,l ; save low ord pop h ; and restore true pointer inr a ani 07h ; is pointer to last char of this key? jrnz nukov ; jump if not mvi c,0 ; if end of key, force terminating null nukov: mov m,c ; store key inx h ; bump pointer mov a,c ora a ; is this terminating null? jrnz ukoput ; no, skip lxi h,0 ; got terminating null...turn off key load ukoput: shld ukop ret ; bye bye notuko: lda escflg ; are we in an escape sequence? ora a jnz escseq ; yes, go process escape sequence mov a,c ; a := output character cpi ' ' ; Printable? jrc notprintable ; Try non-printing control characters ; ; If here, we got a printable character (we hope) ; putchar: lda attrib ; set attribute byte mov m,a ; to current attributes inx h ; Bump past attribute byte mov m,c ; Store character on screen curfwd: lda hpos ; a := hpos inr a ; Bump horizontal position lxi h,linlen ; and check for end-of-line cmp m sta hpos ; Else set new horiz pos. rc ; And exit if no wrap needed sub a ; Force HPOS back to 0 sta hpos ; hpos := 0 ; ; Here to advance one line ; lfout: lda vpos ; Get current line no. inr a ; Bump it cpi 24 ; Off the end? jnc rollup ; then go scroll sta vpos ; Else save new line no. ret ; and exit ; notprintable: cpi cr ; CR? jz crout cpi lf ; LF? jrz lfout cpi esc ; escape sequence? jz gotesc cpi bs ; BS? jz bsout cpi control and 'Z' ; control-Z? jz ehome ; Clear screen cpi 0bh ; VT? jz curup ; Cursor up cpi ff ; FF? jz curfwd ; Cursor right one space cpi bell ; BELL? jz beep cpi 11h ; DC1? jz eeos ; Erase EOS cpi 1eh ; ^^? jz vhome ; Home cursor ret ; ignore undecoded characters ; ; Develop address of current screen byte ; point: lda vpos ; Use current line # to get base addr add a ; a := 2 * line index (less than 47) mov e,a mvi d,0 ; de := 2 * line index (used below too) lhld ltabptr ; hl := pointer to line address table dad d ; hl := index to line address mov a,m inx h mov h,m mov l,a ; hl := address of current line lda hpos ; a := column index add a ; a := 2 * column index (less than 161) mov e,a ; de := 2 * column index (d = 0) dad d ; hl := character index ret ; ; Turn on cursor at current screen location ; setcur: call point ; Get screen address lda l80$40 ; Which machine is this? ora a jrnz setc40 ; Branch if 40-col version mvi a,14 out io$crta ; Reference hi-ord cursor loc mov a,h ; and store pointer/2 since there ani 0fh ; Keep within 4k range rar ; are two VRAM bytes per char. out io$crtd mvi a,15 out io$crta ; Now do low order mov a,l rar out io$crtd ret ; ; Here's the 40-col version ; setc40: setb 7,m ; Just set inverse flag on current char ret ; ; Delete line deline: lda vpos ; What line are we on? mov e,a ; e := current line index mvi d,0 ; de := current line index mvi a,23 sub e ; a := number of lines below mov b,a ; b := number of lines to roll up lhld ltabptr ; hl := line index table base dad d dad d ; hl := line index index (zero flag unchanged) ora a ; check number of lines to roll up jrnz rollx ; No, do delete sta hpos ; hpos := 0, Last line.... jmp eeol ; just clear it ; ; Scroll the whole screen up one line ; rollup: lda l80$40 ; a := machine type ora a ; test for 40/80 column version jrz fast$roll ; use fast scroll in 80 column version mvi b,23 ; Get # of lines lhld ltabptr ; Point to table of line addresses rollx: lda linlen ; Get # of columns add a ; a := 2 * columns/line (2 bytes/char) mov c,a ; c := bytes/line inx h ; adjust for DCX in loop rollnext: dcx h ; Point to destination line mov e,m ; and get its address inx h mov d,m ; de := destination line inx h mov a,m ; Get source line inx h push h ; Remember place in line address table mov h,m mov l,a ; hl := source line push b ; Remember line size mvi b,0 ; bc := bytes/line ldir ; Copy the line pop b ; restore loop count and line size pop h ; restore line pointer djnz rollnext ; repeat for 23 lines mov d,m ; get start of last line from table dcx h mov e,m ; de := start of last line xchg ; hl := start of last line jmpr eline ; Go clear it (bc := line size) ; fast$roll: ; for 80 column machine from bottom line lxi b,2*23*80 ; bc := number bytes to scroll lxi d,3000h ; de := destination (line 0) lxi h,3000h+(2*80) ; hl := source (line 1) ldir ; roll the screen xchg ; hl := first character of last line mvi c,2*80 ; c := number of characters to erase jmpr eline ; clear the last line (hl = last line) ; ; Backspace cursor ; bsout: lda hpos ; Get current column ora a ; Already 0? rz ; then ignore dcr a ; Else back up one sta hpos ret ; ; Make some noise in version-specific way ; beep: lda mem$hcol ; Turn on biz model beeper ori 1 ; turn on OC beeper bit out io$hcol lxi b,6cch ; Prepare for 6 bytes to port 0CCH lxi h,urrk ; Point to noise table for educ. model outir ; Send noise command bytes lxi b,0e24h ; Now kill some time beep1: djnz beep1 dcr c jrnz beep1 lda mem$hcol ; Turn off beeper ani 0feh ; turn off beeper control bit on OC out io$hcol mvi a,9fh ; For both machines out 0cch ret ; urrk: db 8eh,04h,92h,0bfh,0dfh,0ffh ; ; Clear the screen and home the cursor ; ehome: call vhome ; ; Erase from current cursor to end of screen ; eeos: lda linlen ; 40 or 80 chars per line add a ; convert to bytes/line mov c,a mvi b,23 ; do 23 lines lxi d,48 lhld ltabptr ; Point to last line of screen dad d eeosnext: dcx h ; Get line address mov d,m dcx h mov e,m xchg lda vpos ; Have we reached current line yet? cmp b jrz eeol ; Then only erase from cursor posn push b push d ; Else erase whole line call eline pop h pop b ; Restore pointer and counter djnz eeosnext ; Repeat as long as required ; ; Erase from current cursor to end of line ; eeol: call point ; Get screen address lda hpos mov c,a ; Figure out how many bytes left lda linlen ; from cursor to EOL sub c add a ; a := 2 * number of characters mov c,a ; c := 2 * number of characters eline: mvi b,0 ; Hi-ord count is 0 mov e,l mov d,h ; Source := destination inx d inx d ; de := index of second character mvi m,7 ; clear attribute byte inx h mvi m,' ' ; first char is a space dcx h dcr c ; Is that all? dcr c rz ; Yup, just one itty bitty character ldir ; Else copy blank to rest of line ret ; ; Insert line - Scroll from cursor to EOS down and clear cursor line. ; inslin: lda linlen ; Convert line length add a ; to byte count for line move mov c,a ; and save it mvi b,23 ; Max # of lines to move down lxi d,48 ; Get to end of lhld ltabptr ; line address table dad d insnext: dcx h ; point to destination line mov d,m dcx h ; fetch destination pointer mov e,m xchg ; xfer to HL in case this is last line lda vpos ; where is cursor? cmp b ; if this is cursor line, jrz eline ; then we're done, so just clear it xchg ; put dest back in DE where it belongs push h ; save position in line table dcx h mov a,m ; pick up source pointer dcx h mov l,m mov h,a push b ; save line counter mvi b,0 ; we only need char count (C) ldir ; copy line down pop b ; get back counter pop h ; get back line pointer djnz insnext ; go move next line dcx h ; we only get here for top line mov a,m dcx h ; set up to clear it mov l,m mov h,a jmpr eline ; go do it ; ; Delete character under cursor ; delchr: call point ; get screen address lda hpos add a ; get # bytes from cursor to eol mov c,a lda linlen add a sub c mov c,a mvi b,0 mov e,l ; copy cursorn addr to de mov d,h inx h ; hl --> next char pos inx h dcr c dcr c ; enuf bytes to move some? jrz delch1 ldir ; copy line left 2 bytes (1 char pos) delch1: xchg mvi m,7 ; make vacated position a space inx h mvi m,' ' ret ; ; Insert 1 space at cursor position ; inschr: lda vpos ; what line are we on? add a mov c,a mvi b,0 ; BC is offset into line address table lhld ltabptr dad b ; get entry from table mov e,m inx h mov d,m ; DE is addr of beg. of line lda linlen dcr a ; rightmost screen cursor address add a push psw ; save for later mov l,a mvi h,0 ; copy to HL dad d ; gives addr of rightmost char pos mov d,h mov e,l dcx h ; source is char to left of it dcx h lda hpos ; now get cursor posn add a ; convert to bytes mov c,a pop psw ; get back bytes per line - 2 sub c ; compute move count mov c,a mvi b,0 jrz delch1 ; skip move if at last byte lddr ; slide line right jmpr delch1 ; ; HOME the cursor to column 0, line 0 ; vhome: sub a ; Zap out line and column sta vpos ; ; Handle carriage return, cursor column 0 ; crout: sub a ; Just clear horizontal position sta hpos ret ; ; Cursor up one line ; curup: lda vpos dcr a ora a rm sta vpos ret ; ; Handle escape character ; gotesc: mvi a,1 ; Set escape flag sta escflg ret ; that's all ; ; Here to process character after escape escseq: dcr a ; flag=1? jnz cursph ; no, must be multi-key function sta escflg mov a,c ; check character after escape cpi esc ; function key load? jz escesc cpi '(' ; Dim off? jz dimoff cpi ')' ; dim on? jz dimon cpi '[' ; reverse off? jz revoff cpi ']' ; reverse on? jz revon cpi '{' ; underline off? jz undoff cpi '}' ; underline on? jz undon cpi '<' ; blink off? jz blioff cpi '>' ; blink on? jz blion cpi 'E' ; Insert line? jz inslin cpi 'F' ; Monroe attribute control? jz escf cpi 'G' ; ADM-31 attribute control? jz escg cpi 'R' ; Delete line? jz deline cpi 'T' ; Erase EOL? jz eeol cpi 'Y' ; Erase EOS? jz eeos cpi '*' ; Clear screen? jz ehome cpi 'W' ; delete char? jz delchr cpi 'Q' ; insert char? jz inschr if etxack cpi '+' ; Set Etx/Ack on for list device jz etxon cpi '-' ; Set Etx/Ack off jz etxoff endif cpi '=' ; Cursor address? rnz mvi a,3 ; flag waiting for cursor address escxit: sta escflg ; save flag value ret escesc: mvi a,6 jmpr escxit escg: mvi a,4 jmpr escxit escf: mvi a,5 jmpr escxit ; ; Process possible x coordinate cursph: dcr a ; was flag=2? jrnz curspv ; no, must be y coordinate mov a,c ; get coordinate sui 32 ; remove offset lxi h,linlen ; point to line length cursh1: cmp m ; make sure not out of range jrc cursh2 sub m ; adjust and re-check jmpr cursh1 cursh2: sta hpos ; save it zapesc: sub a ; clear escape flag jmpr escxit ; ; Process y coordinate curspv: dcr a ; was flag=3? jrnz escgv ; no, try attribute controls mov a,c ; get char ani 31 ; remove offset cursv1: cpi 24 ; range check jrc cursv2 sui 24 cursv2: sta vpos ; save new row number mvi a,2 ; change flag for column jmpr escxit ; ; Process ADM-31 attribute control (ESC G <0-7>) escgv: dcr a ; was escflg=4? jrnz escfv ; no, try Monroe attributes mov a,c sui '0' ; check for valid digit jrc zapesc cpi 8 ; must be 0-7 jrnc zapesc mov c,a ; look up correspinding attributes mvi b,0 lxi h,escgtbl ; in table dad b lda attrib ; get current attributes ani 40h ; preserve dim attribute ora m ; include new attributes stazap: sta attrib ; store new attribute byte jmpr zapesc ; and terminate escape sequence ; escgtbl:db 0,7,4,7,10h,17h,14h,17h ; ; Process Monroe attribute control (esc F ) escfv: dcr a ; was escflg = 5? jrnz uknum ; no, try next handler mov a,c ; this one's easy...just store jmpr stazap ; whole byte as attributes ; ; Process downloaded function key number ; (esc esc <0-7 text chars> nul) uknum: mov a,c ; get key # ani 3FH ; restrict range cpi 32+nfk jrnc zapesc mov l,a mvi h,0 lbcd ukptr ; base of table dad h dad h ; offset to this key dad h dad b shld ukop ; save pointer for next call jmpr zapesc ; now turn off escflg ; ; Enable dim character mode dimon: mvi c,40h ; select dim bit ; and fall thru ; Set an attribute bit atton: lda attrib ; get current attribute byte ora c ; and set appropriate bit sta attrib ret ; ; End dim character mode dimoff: mvi c,0bfh ; select dim bit ; and fall thru ; Clear an attribute bit attoff: lda attrib ; get attribute byte ana c ; and clear appropriate bit sta attrib ret ; ; Reverse on revon: mvi c,10h jmpr atton ; ; reverse off revoff: mvi c,0efh jmpr attoff ; ; underline on undon: mvi c,08h jmpr atton ; ; underline off undoff: mvi c,0f7h jmpr attoff ; ; blink on blion: mvi c,04h jmpr atton ; ; blink off blioff: mvi c,0fbh jmpr attoff ; if etxack ; ; Set etx/ack flag on etxon: mvi a,0ffh sta enableetxack ret ; ; Set etx/ack flag off etxoff: sub a sta enableetxack ret ; endif ; ; Define a macro to generate table of N addresses, starting ; with B, incrementing by L. This is what we need to build ; line address tables for screens. ADRTBL MACRO B,L,N @A SET B REPT N DW @A @A SET @A+L ENDM ENDM ; ; 80-Column line address table ; LTAB80: ADRTBL 3000H,160,24 ; ; 40-Column line address table ; LTAB40: ADRTBL 3000H,100H,8 ADRTBL 3050H,100H,8 ADRTBL 30A0H,100H,8 ; ; lconout: lda iobyte ; a := io byte ani 03 ; check current assignment cpi 02 jc conout ; TTY: or CRT: jz llist ; BAT: ; else must be UC1: uc1out: sub a ; a := 0 out io$siobc ; select status register in io$siobc ; a := status register ani 04 ; select output status bit jrz uc1out ; wait until ready mov a,c ; a := output character out io$siobd ; output character ret ; ; ; Console status routine -- returns 0FFH when char available, ; otherwise returns 00 ; lconst: if (interrupts and eiconst) ei ; enable interrupts endif if (not interrupts) call chkmotor ; do floppy motor timing endif lda iobyte ; dispatch to current console ani 03 cpi 02 jrc const ; builtin console jrz lrdrst ; batch (logical RDR in, logical LST out) uc1st: sub a ; aux port out io$siobc in io$siobc jmpr genst ; rest of code is common ; lrdrst: lda iobyte ; get iobyte ani 0ch ; get reader bits jrz rdrst ; it's physical reader (COMM port) cpi 08h ; check other possibilities jrc const ; CRT jrz uc1st ; AUX lptst: sub a ; PRI out io$drtac in io$drtac jmpr genst rdrst: sub a ; COM out io$sioac in io$sioac jmpr genst ; ; builtin console const: lhld ukip ; function key in progress? mov a,h ora a jrz const1 ; jump if not mov a,m ora a ; return true unless end of funct key jrnz const2 const1: if coninterrupt lxi h,inputpointer ; hl := console buffer pointer index mov a,m ; a := input pointer inx h ; hl := output pointer index sub m ; compare with output pointer jrnz const2 ; return true if not equal else sub a ; Select DART register 0 out io$drtbc in io$drtbc endif genst: ani 01h ; Check data-avail bit rz const2: mvi a,0ffh ret ; ; Console input routine -- waits for a char and returns it ; lconin: call lconst ;check ready and motor timing ora a jrz lconin lda iobyte ;now split to right routine ani 03 cpi 02 jrc conin jz lreader call uc1in ani 7fh ret ; ;AUX port driver uc1in: call uc1st jrz uc1in in io$siobd ret ; ; Built-in keyboard driver ; Note: high bit is not stripped, since it is used to ; signify one of the special keys on the system keyboard. conin: lhld ukip ; is function key active? mov a,h ora a jrz conin1 ; no, do physical read ukin: mov a,m ; get next byte of func key inx h ; bump pointer shld ukip ; save new pointer ora a ; is this terminating null? rnz ; return if not lxi h,0 ; got null, turn off function key shld ukip ; and fall into normal input conin1: call const ; Wait for data jrz conin1 if coninterrupt lda outputpointer ; a := output pointer mov l,a mvi h,0 ; hl := output pointer lxi d,conbuffer ; de := console buffer base dad d ; hl := character index mov c,m ; c := character inr a ; increment pointer cpi conbuffersize ; check for overflow jrc conin1a sub a ; a := 0 (start of buffer) conin1a: sta outputpointer ; update output pointer mov a,c ; get it else in io$drtbd ; Get it endif if debug cpi 0d4h ; monitor trap? jz 0f800h endif cpi 80h ; special key? rc ; if not, return lxi b,nfk*256+0a0h ; # of white function keys + first value lxi h,fktbl ; table of same fklup: cmp m ; do we have one? jrz gotfk ; jump if match inr c inx h ; point to next key djnz fklup ; loop till out of keys mov c,a ; use original key gotfk: mov a,c ; replace key with translated value cpi 0a0h+nfk rnc ; return if too big *** can't happen *** ani 3fh ; get table offset mov l,a mvi h,0 lbcd ukptr ; make pointer into user key table dad h dad h dad h dad b jmpr ukin ; now fetch from table ; ; "Hardwired" function key table (white keys) FKTBL: DB 0CAH ; insrt lock DB 0C1H ; char del DB 0D0H ; run DB 0C0H ; print scrn DB 0D4H ; calc mode DB 0C7H ; home DB 0C5H ; up arrow DB 0C6H ; down arrow DB 0C4H ; right arrow DB 0C3H ; left arrow DB 0C2H ; line del DB 0D1H ; load DB 0D2H ; cont DB 0D3H ; shft calc mode DB 0C8H ; clear DB 0B5H ; cntl up arrow DB 0B6H ; cntl down arrow DB 0B4H ; cntl right arrow DB 0B3H ; cntl left arrow DB 0FFH ; stop DB 0A8H ; cntl backspace DB 0A9H ; cntl tab NFK EQU $-FKTBL ; ; ;List device drivers llist: lda lstsec ; a := list time-out in seconds |14| sta lstcnt ; update list time-out counter |14| call llistwait lda iobyte ; dispatch to correct driver ani 0c0h ; get list field jrz list ; default (TTY:) cpi 80h jc conout ; CRT: jz punch ; LPT: (comm port) jmp uc1out ; UC1: (aux port) ; llistwait: call llistst ; a := llist status ora a ; ready? rnz ; exit when ready? lda lstcnt ; a := list time-out counter ora a ; time-out? jrnz llistwait ; loop until time-out or ready lxi h,lstmsg ; hl := print not ready message call prmsg ; print message llistlp: call llistst ; a := llist status ora a ; ready? jnz crlf ; terminate message and exit call xconst ; a := console status ora a ; character ready? jrz llistlp ; loop until ready or character entered call xconin ; a := console character cpi 3 ; control-c? jrnz llistlp ; loop if not control-c jmp wboot ; abort program ; lstmsg: db 7,13,10,'Printer not ready',0 ; ; ; Printer port driver ; ; For etx/ack protocol, if an ESC char is found when the length ; of the current output line is between llimit and ulimit, an Etx ; char is sent before sending the ESC char. Also when the length ; reaches the ulimit, Etx is sent. ; list: call listst ; check status jrz list ; wait until printer ready if etxack lda enableetxack ; check if etxack flag is set or not ora a ; 0 means not set jrz list2 lda lsize ; a := current line size inr a ; increment size sta lsize ; save size cpi llimit ; compare to lower limit jrc list2 ; send character if under lower limit cpi ulimit ; compare to upper limit jrnc sendetx ; send etx if over limit mov a,c ; a := character to be printed cpi esc ; Check for escape sequence jrz sendetx ; send etx if escape sequence list2: endif mov a,c ; a := character to send to printer out io$drtad ; send character to printer ret ; exit if etxack sendetx: ; send an etx character sub a ; a := 0 sta lsize ; current line size := 0 sta enablelist ; disable listing mvi a,etx out io$drtad ; output to printer jmpr list ; try again endif ; ; ; List device status returns a=0 if not ready, a=ff if ready llistst: lda iobyte ; a := io byte ani 0c0h jrz listst cpi 80h jrz punst jrc conost uc1ost: sub a ; a := 0 out io$siobc ; select status register in io$siobc ; a := io status byte jmpr genost ; return output status punst: sub a ; a := 0 out io$sioac ; select status register in io$sioac ; a := io status jmpr genost ; return output status conost: mvi a,0ffh ; return all ones ret ; ; Normal printer port status enablelist: db 0ffh ; initially enabled listst: sub a ; a := 0 out io$drtac ; select status port in io$drtac ; a := list status ani 01h ; get input status jrz list1 in io$drtad ; a := input character ani 07fh ; get an ASCII character cpi xon ; check for an xon jrz listxon cpi xoff ; check for an xoff jrz listxoff if etxack cpi ack ; check for an ack jrz listxon endif list1: lda enablelist ; check if an xoff has disabled the list device ora a rz ; return zero if not ready (due to xoff) SUB A ; a := 0 OUT IO$DRTAC ; select status port IN IO$DRTAC ; a := list status genost: ANI 04h rz ; return zero if not ready mvi a,0ffh ; return 0ffh (true) if ready ret listxoff: sub a ; a := 0 sta enablelist ; turn off the list device jmpr listst ; check again listxon: mvi a,0ffh ; a := 0ffh sta enablelist ; turn on the list device jmpr listst ; lpunch: ;punch character from register c lda iobyte ; a := io byte ani 30h ; see if punch selected jrz punch cpi 20h ; see if console selected jc conout ; console if less than 20h jz uc1out ; aux: if equal to 20h jmp list ; must be list device ; ; comm port output punch: sub a ; a := 0 out io$sioac ; select status port in io$sioac ; a := com: port status ani 4 ; check input status bit jrz punch ; wait until ready mov a,c ; a := outuput character out io$sioad ; output character ret ; exit ; ; lreader: ;read character into register a from reader device lda iobyte ; a := io byte ani 0ch ; get lower bits jrz reader ; check for physical device cpi 08h jc conin jz uc1in lptin: call lptst ; wait until ready jrz lptin in io$drtad ; output character ret ; reader: call rdrst ; wait for reader to become ready jrz reader in io$sioad ; output character ret ; ; ;***************************************************** ;* * ;* Sector Deblocking Algorithms for CP/M 2.2 * ;* * ;***************************************************** ; ; utility macro to compute sector mask smask macro hblk ;; compute log2(hblk), return @x as result ;; (2 ** @x = hblk on return) @y set hblk @x set 0 ;; count right shifts of @y until = 1 rept 8 if @y = 1 exitm endif ;; @y is not 1, shift right one position @y set @y shr 1 @x set @x + 1 endm endm ; ;***************************************************** ;* * ;* CP/M to host (Monty) disk constants * ;* * ;***************************************************** blksiz equ 2048 ;CP/M allocation size hstsiz equ 256 ;host disk sector size hstspt equ 16 ;host disk sectors/trk hstblk equ hstsiz/128 ;CP/M sects/host buff cpmspt equ hstblk * hstspt ;CP/M sectors/track secmsk equ hstblk-1 ;sector mask smask hstblk ;compute sector mask secshf equ @x ;log2(hstblk) ; ;***************************************************** ;* * ;* BDOS constants on entry to write * ;* * ;***************************************************** wrall equ 0 ;write to allocated wrdir equ 1 ;write to directory wrual equ 2 ;write to unallocated ; ;***************************************************** ;* * ;* Disk parameter blocks for drives: * ;* * ;***************************************************** ; logical$size: ; CP/M records/block (see diskdef) rept 4 ; floppy disks (4) db 16 ; 16 records (2048 bytes)/block endm rept 4 ; hard disks (4) db 16 ; 16 records (2048 bytes)/block endm rept 1 ; memory disk (1) db 8 ; 8 records (1024 bytes)/block endm rept 7 ; remaining logical disks (7) db 0 ; not used endm ; ; disks maxdisk ; CP/M disk parameter blocks ; ; Floppy disk constants ; diskdef 0,1,32,,2048,154,64,64,3 diskdef 1,0 diskdef 2,0 diskdef 3,0 ; ; Hard disk constants ; size is (19200/8)-(48/8)=2394 useable blks |10| ; diskdef 4,0,31,,2048,2394,512,0,3 diskdef 5,4 diskdef 6,4 diskdef 7,4 ; ; Memory disk constants. 'mdisk$dsm' is the address of the word which ; indicates the number of block (1K bytes/block in this case) less one. ; It should have a value of 64 in a 128K system and 180 in a 256K system. ; The 'mdisk$off' is the address of the word which indicates the number ; of offset tracks which should be used. It is 0 for a 128K system and ; 1 for a 256K system. ; if memorydisk mdisk$dsm equ $+5 ; |2.27.01| diskdef 8,0,63,,1024,180,32,0,1 ; |2.27.01| clearmemorydisk equ 16 ; number of 128 byte sectors to set to E5h ; should be number of directory entries/4 endif ; ; ;home the selected disk home: lda hstwrt ;check for pending write ora a jrnz homed sta hstact ;clear host active flag homed: lxi h,0 shld sektrk ret ; seldsk: ;select disk mov a,c ;selected disk number ani 0fh ; make sure it there are only 16 devices mov e,a mvi d,0 ; de := logical disk number lxi h,logical$size ; hl := logical disk block size table dad d ; hl := table index mov a,m ; a := logical (128 byte) records per block sta records$per$block lxi h,logical$disk ; hl := logical disk table dad d ; hl := physical disk number index mov a,m ; a := physical disk number sta sekdsk ;seek disk number lxi h,0 cpi maxdisk ;trap bad drive # rnc mov l,a ;disk number to HL rept 4 ;multiply by 16 dad h endm lxi d,dpbase ;base of parm block dad d ;hl=.dpb(curdsk) ret ; settrk: ;set track given by registers BC sbcd sektrk ;track to seek ret ; setsec: ;set sector given by register c mov a,c sta lac$sec ;sector to seek (with interlace applied) ret ; setdma: ;set dma address given by BC sbcd dmaadr ret ; sectran: ;translate sector number BC mov a,c sta sek$sec ;save un-interlaced sector for deblock logic LDA sekdsk ;check for hard disk CPI 4 JRC INTLC MOV L,C MVI H,0 RET ;NO INTERLACE FOR HARD DISK ; INTLC: lxi h,xltbl dad b ;look up interlaced sector mov l,m mvi h,0 ret ; ;***************************************************** ;* * ;* The READ entry point performs a 'logical' * ;* 128-byte read with deblocking. * ;* * ;***************************************************** read: ;read the selected CP/M sector if memorydisk lda sekdsk ; a := select disk number cpi mdrive ; |10| jz memoryread ; and see if it is the memory drive |10| endif mvi a,1 sta readop ;read operation sta rsflag ;must read data xra a ; a := 0 sta unacnt mvi a,wrual sta wrtype ;treat as unalloc jmpr rwoper ;to perform the read ; ;***************************************************** ;* * ;* The WRITE entry point does a 'logical' * ;* 128-byte write with blocking. * ;* * ;***************************************************** write: ;write the selected CP/M sector if memorydisk lda sekdsk ; a := select disk number cpi mdrive ; |10| jz memorywrite ; and see if it is the memory drive |10| endif xra a ;0 to accumulator sta readop ;not a read operation mov a,c ;write type in c sta wrtype cpi wrual ;write unallocated? jrnz chkuna ;check for unalloc ; ; write to unallocated, set parameters lda records$per$block ;next unalloc recs sta unacnt lda sekdsk ;disk to seek sta unadsk ;unadsk = sekdsk lhld sektrk shld unatrk ;unatrk = sectrk lda seksec sta unasec ;unasec = seksec ; chkuna: ;check for write to unallocated sector lda unacnt ;any unalloc remain? ora a jrz alloc ;skip if not ; ; more unallocated records remain dcr a ;unacnt = unacnt-1 sta unacnt lda sekdsk ;same disk? lxi h,unadsk cmp m ;sekdsk = unadsk? jrnz alloc ;skip if not ; ; disks are the same lxi h,unatrk call sektrkcmp ;sektrk = unatrk? jrnz alloc ;skip if not ; ; tracks are the same lda seksec ;same sector? lxi h,unasec cmp m ;seksec = unasec? jrnz alloc ;skip if not ; ; match, move to next sector for future ref inr m ;unasec = unasec+1 mov a,m ;end of track? cpi cpmspt ;count CP/M sectors jrc noovf ;skip if no overflow ; ; overflow to next track mvi m,0 ;unasec = 0 lhld unatrk inx h shld unatrk ;unatrk = unatrk+1 ; noovf: ;match found, mark as unnecessary read xra a ;0 to accumulator sta rsflag ;rsflag = 0 jmpr rwoper ;to perform the write ; alloc: ;not an unallocated record, requires pre-read xra a ;0 to accum sta unacnt ;unacnt = 0 inr a ;1 to accum sta rsflag ;rsflag = 1 ; ;***************************************************** ;* * ;* Common code for READ and WRITE follows * ;* * ;***************************************************** rwoper: ;enter here to perform the read/write xra a ;zero to accum sta erflag ;no errors (yet) lda lac$sec ;compute host sector rept secshf ora a ;carry = 0 rar ;shift right endm sta sekhst ;host sector to seek ; ; active host sector? lxi h,hstact ;host active flag mov a,m mvi m,1 ;always becomes 1 ora a ;was it already? jrz filhst ;fill host if not ; ; host buffer active, same as seek buffer? lda sekdsk lxi h,hstdsk ;same disk? cmp m ;sekdsk = hstdsk? jrnz nomatch ; ; same disk, same track? lxi h,hsttrk call sektrkcmp ;sektrk = hsttrk? jrnz nomatch ; ; same disk, same track, same buffer? lda sekhst lxi h,hstsec ;sekhst = hstsec? cmp m jrz match ;skip if match ; nomatch: ;proper disk, but not correct sector call checkwritehst ; check if host buffers needs to be written ; filhst: ;may have to fill the host buffer lda sekdsk sta hstdsk lhld sektrk shld hsttrk lda sekhst sta hstsec lda rsflag ;need to read? ora a cnz readhst ;yes, if 1 xra a ;0 to accum sta hstwrt ;no pending write ; match: ;copy data to or from buffer lda lac$sec ;mask buffer number ani secmsk ;least signif bits mov l,a ;ready to shift mvi h,0 ;double count rept 7 ;shift left 7 dad h endm ; hl has relative host buffer address lxi d,hstbuf dad d ;hl = host address lded dmaadr ;get/put CP/M data lxi b,128 ;length of move lda readop ;which way? ora a jrnz rwmove ;skip if read ; ; write operation, mark and switch direction mvi a,1 sta hstwrt ;hstwrt = 1 xchg ;source/dest swap ; rwmove: ;BC initially 128, HL is source, DE is dest ldir ; ; data has been moved to/from host buffer lda wrtype ;write type cpi wrdir ;to directory? lda erflag ;in case of errors rnz ;no further processing ; ; clear host buffer for directory write ora a ;errors? rnz ;skip if so xra a ;0 to accum sta hstwrt ;buffer written call writehst ; write buffer lda erflag ; a := result (error flag) ret ; ;***************************************************** ;* * ;* Utility subroutine for 16-bit compare * ;* * ;***************************************************** sektrkcmp: ;HL = .unatrk or .hsttrk, compare with sektrk xchg lxi h,sektrk ldax d ;low byte compare cmp m ;same? rnz ;return if not ; low bytes equal, test high 1s inx d inx h ldax d cmp m ;sets flags ret ; ;***************************************************** ;* * ;* WRITEHST performs the physical write to * ;* the host disk, READHST reads the physical * ;* disk. * ;* * ;***************************************************** dma$read equ 7dh dma$write equ 79h ; ; checkwritehst: lda hstwrt ;host written? ora a rz ; exit if host written 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 ; lxi b,(fcwri� shl 8)+wrsec � se� fd� command in b and XBC in C |10| lxi h,(dma$write shl 8)+05 ; DMA command and direction |10| jmpr rwhst ; go to common code ; readhst: ;hstdsk = host disk #, hsttrk = host track #, ;hstsec = host sect #. read "hstsiz" bytes ;into hstbuf and return error flag in erflag. ; lxi b,(fcread shl 8)+rdsec ; set fdc command in b and XBC in c |10| lxi h,(dma$read shl 8)+01 ; DMA command and direction |10| ; and fall thru to common code ; ;*************************************************** ;* * ;* Common code for physical read/write * ;* * ;*************************************************** ; rwhst: shld dmarw ;save the dma controller command |10| lda hstdsk ;look up the requested drive cpi maxfloppy jnc hdrw ;go to the hard disk driver ; ;this is the floppy driver ; if interrupts ei ; turn on timer interrupt just in case endif LXI H,fpycmd MOV M,B mov c,a ;for this drive mvi b,0 lxi h,trktbl dad b mov a,m out io$fdtrk ;pass it to fdc mov b,c inr b ;generate shift count sub a sta timecntr ;disable motor timeout stc nrbit: ;generate drive select bit adc a djnz nrbit mov e,a ;save select mask call motoron ;turn on motors jrnz wason ;skip delay if already on mvi c,0 mondly: xthl ;kill lots of time xthl xthl xthl djnz mondly dcr c jrnz mondly wason: in io$fdst ;see if drive is alive ani fsnrdy jrz fpy$seek ;skip if ready call drvnrdy ;else wait for user to fix it jmpr mondly-2 ;and give it some time to sync up fpy$seek: mvi a,maxrtr ;set retry count sta fpyrtry fpy$rsek: lda hstsec ;set desired sector inr a ;change 0-15 into 1-16 out io$fdsec lda hsttrk ;set track for seek operation ora a ;track 0? jrnz doseek ;skip if not call restore ;turn seek 0 into restore sub a doseek: lbcd hstdsk ;index into track table mvi b,0 lxi h,trktbl dad b cmp m ;compare to desired track jrz noseek ;skip seek if already there inr m ;255 means drive never accessed cz restore ;do restore if first access to drive lda hsttrk out io$fdata ;set track # for seek mov m,a ;store new track # in table cpi 52 ;time for precompensation? lda fpyctrl jrc noprec ;adjust command accordingly ori fdprec noprec: call newctrl ;send new control port bits mvi a,fcseek+fcverf+rate ;do seek with verify call xqt in io$fdst ;check status ani fscrc+fsrnf+fsnrdy ;check for errors jrz noseek call resterr ;if error, home and retry lda fpyrtry dcr a ;count down retries sta fpyrtry jrnz fpy$rsek fpy$erx: mvi a,1 ;giving up...too many errors jmpr hstexit ; ;come here when positioned to right track noseek: mvi a,maxrtr ;reset retry count sta fpyrtry fpy$rtr: ; |10| ;set up for floppy dma call MVI A,io$fdata ;port # for DMA command block MVI C,01 ;set up DMA channel mux select ; call loadmar ;set up z80-dma fpynxrw: lda fpycmd ;issue read or write command call xqt ; and wait for completion in io$fdst ani fsdlost+fscrc+fsrnf+fsnrdy+fswprot ;check for errors jrnz fpy$err ;jump if error sub a ;else clear error flag hstexit: sta erflag ;save error flag mvi a,montime ;set up motor timeout sta timecntr ret ;return to caller ; ;Here to home drive restore: mvi a,rate ;use normal rate jmpr restx ;share code with error recovery ; ;Here to recover from seek error resterr: mvi a,rate+1 ;use slower rate restx: lbcd hstdsk ;index into track table mvi b,0 lxi h,trktbl dad b mvi m,0 ;force track to 0 ;and fall into XQT to issue home command ; ;This routine issues fdc command and waits for IRQ xqt: out io$fdcmd ;send the command xqtl: in io$pioad ;look at irq line bit 4,a jrz xqtl ;loop till true ret ; ; ;Here to recover from read or write error fpy$err: lda fpyrtry ;check retry count dcr a ;bump it sta fpyrtry jnz fpy$rtr ;retry if not exhausted call resterr ;out of retries...home drive and quit jmp fpy$erx ; ; TITLE XEBEC-GORMAN WINCHESTER DISK ** ; 03/23/82 5 MEG COMPRESSED VERSION JRT ; 08/12/82 Multi-type disks configured from boot JRT ; =================================== ; hdrw: ;this is the hard disk XEBEC driver ; SELECT DRIVE ; A= the drive to select, codes 6-7 indicate multi-volume drvs |10| ; C= Command Read or Write ; ; we got here thru the logical to physical disk table and being ; not equal to Mdrive the only alternatives are 4,6=drive 0 5,7=drive 1 mov b,a ; |10| cpi maxfloppy+maxharddisk ; hard disk ? |15| mvi a,1 ; a := possible error result |15| rnc ; exit if not hard disk drive |15| mov a,b ; a := disk number |15| ani 1 ; resource as drive select lsb=drive |10| jrz sdrv0 mvi a,drvsel1 sdrv0: sta dcb$drv ;set the drive to select ; mov a,c sta dcb$cmd ;set the read or write command ; ;GET RANDOM ADDRESS. ; We are playing games with tracks and sectors/track ; to avoid possible interaction with deblocking vs the floppys. ; Even though we have 32 256 byte sectors/surface and 4 surfaces ; CPM sees it as 32 128 byte sectors and 2*4*152 tracks ; ; Xebec however sees only 1 type of address, a logical sector number ; so we must glue the tracks and sectors back together, fortunately ; sectors/track is a power of 2 ; ; The higher capacity drives are viewed as having multiple 5 Meg ; volumes, 6= second half of drive 0, 7=second half of drive 1 ; lhld hsttrk ; hl := host track rept 4 dad h ; hl := 16 * host track endm lda hstsec ;Deblock thinks there are 16 sects/track add l ; a := (16 * host track) + host sector mov l,a ; |10|--------- ; Test the size of the logical address xchg lxi h,-19199 ;the size of 5 Meg dad d jrc oversiz ; Multi volume drive? The drive select is in B xchg lxi d,19200 bit 1,b jrz notten dad d notten: mov a,l ; |10|--------- sta dcb$ctrk+1 ;MSB IS FIRST mov a,h sta dcb$ctrk ;XEBEC IS BACKWARDS ; ;Load the DMA using code common with floppy ; MVI C,DMAHD ;set up Dma mux select MVI A,HD$DATA ;Port address for Dma block ; CALL loadmar ; ; Number of sectors is always 1 and is a constant in the control block ; ; NOW COMMAND THE CONTROLLER ; CALL ACQUIRE JRC HDK$DOWN ; LXI H,DCB$CMD LXI B,600H+HD$DATA ;COUNT 6 BYTES TO DATA PORT HXQLP: IN STCS ANI GCMD+DTAREQ JRNZ HXQLP OUTI JRNZ HXQLP ; ; CONTROLLER NOW EXECUTES ENABLE DMA AND COMPLETION INTRPT ; OUT ENDMA ;ANY VALUE NOP ;DO NOT REMOVE XWAT: IN STCS ;CHECK IF DONE ANI CSTAT+DTAREQ JRNZ XWAT ;THIS IS THE NON INTERRUPT VERSION ; ; DO DISABLES AND CHECK STATUS OUT DISDMA CALL WBUSY ; ; IF ERROR READ STATUS BYTES TO DCB FOR DEBUG ; JRNZ HDK$ER ; ; HANDLE REQUEST COMPLETION. ; HDK$EXIT: STA erflag RET ;COMPLETE REQUEST. ; oversiz: HDK$DOWN: MVI A,1 STA erflag RET ; ; COMMON ERROR HANDLER ; HDK$ER: ;DO A REQUEST-SENSE TO GET INFO CALL ACQUIRE JRC HDK$DOWN MVI A,RQSEN CALL CKGCMD LDA DCB$DRV CALL CKGCMD CALL GIVCMD LXI B,400H+HD$DATA LXI H,DCB$RSTA RQDLP: IN STCS CPI 0FH ;DATA FROM CONTROLLER JRNZ RQDLP INI JRNZ RQDLP ; ; GET IN THE STATUS AND COMPLETION FOR RQSEN ; CALL WBUSY LDA DCB$RSTA SUI 98H ;ECC CORRECTED JR HDK$EXIT ;NZ=UNRECOVERABLE ERROR. ; ACQUIRE: IN STCS ;CHECK CONTROLLER ALREADY BUSY ANI CBUSY STC RZ ;low is busy MVI A,1 ;SELECT CONTROLLER 1 OUT SEL MVI B,0FFH ;AN ARBITRARY TIMEOUT RDYLP: IN STCS ANI CBUSY RZ ;RETURN OK DJNZ RDYLP STC RET ;DID NOT GO BUSY--ERROR ; ; WAIT FOR DONE ON SHORT COMMAND--TEST DRV AND GET SENSE ; WBUSY: IN STCS ;Test the interface status ANI CSTAT+DTAREQ JRNZ WBUSY IN HD$DATA ;Read in the completion status MOV B,A WDONE: IN STCS ANI CDONE+DTAREQ JRNZ WDONE IN HD$DATA ;Read in the Done Byte and discard MOV A,B ANI ERHDK ;Set the status for test after return RET ; ; GIVCMD: MVI A,0 MVI B,4 GCLP: CALL CKGCMD DJNZ GCLP RET ; CKGCMD: PUSH PSW CKGLP: IN STCS ANI GCMD+DTAREQ JRNZ CKGLP POP PSW OUT HD$DATA RET ; ;Routine to initialize z80-dma ; at entry C= DMA mux channel to select ; DMARW=Dma direction DMARW+1 =Read or Write DMA command, |10| ; A= >DCPORT= io$fdata or HD$DATA ; ; sets DCDIR= Direction A port or B port loadmar: STA DCPORT ;set the port address into the command tbl lhld bufptr ; |10| shld bptr ; bufptr is used by the copy utilities |10| lxi h,DMARW ; |10| mov a,m ; |10| inx h STA DCDIR ;in the command table ; in io$pioad ani DMAMSK ;throw dma switch to correct controller ora C out io$pioad lxi b,600h+io$dma ;send 6 resets to z80-dma mvi a,0c3h resdma: outp a djnz resdma ; mvi b,dmte-dmtb ;command+address+count+table |10|---------- outir ;send commands to z80-dma ret ; ; ;z80-dma read command table DMARW: ds 1 ;Temp for DCDIR ; dmtb: ds 1 ;Command read or write bptr: ds 2 ;put it here where we use it bufcnt: dw 256 ;the count constant |10|---------- db 14h ;port a mem, increment addresses db 28h ;port b i/o, fixed addresses db 85h ;byte mode, next port lower DCPORT: DS 1 ;io$fdata OR HD$DATA ;port address of fdc db 9ah ;ready active high db 0cfh ;load DCDIR: DS 1 ;source is b, transfer only ;01 FOR FPY->MEM, 05 FOR M->FPY db 0cfh ;load db 087h ;enable dma (start) dmte: ; ; ; Drive not ready error branches here DRVNRDY: LDA HSTDSK ; generate error message ANI 3 ADI 'A' ; with correct drive name STA DVNAME LXI H,NRDYMSG ; and print it CALL PRMSG WAITRDY: IN IO$FDST ; get floppy controller status byte ANI FSNRDY ; check ready status JRZ CRLF ; exit if it became ready CALL XCONST ; check console ORA A JRZ WAITRDY ; loop if not ready CALL XCONIN ; get response CALL CRLF PERMERR: LDA IPLDSK ; Get user 0/IPL drive STA CDISK ; force IPL drive selected JMP WBOOT ; branch out of error CRLF: LXI H,CRLFMSG JMP PRMSG ; do CR & LF ; RET ; and go continue disk I/O ; CRLFMSG: DB 13,10,0 NRDYMSG: DB 7,13,10,'Drive ' DVNAME DB 0 DB ' not ready',0 ; ; ; ;Turn on the floppy motors and test if they were already on motoron: lda fpy$ctrl ;look at current control bits ani 0b0h ;eliminate precomp and selects ora e ;get passed precomp and select ori fdenab ;make sure enable remains bit 5,a ;test motor on bit setb 5,a ;and force it on newctrl: sta fpy$ctrl ;save control byte out io$fdctl ;and send it ret ; ;Decrement motor delay count if pending...turn off if time ; chkmotor: lda timecntr ; first see if delay pending ora a rz ; nope if (not interrupts) lhld timecntp ; do prescale count dcx h ; if interrupts not available shld timecntp mov a,h ora l rnz ; quit unless prescale exhausted lda timecntr endif dcr a ;count down time sta timecntr jrz motoroff ;kill motors if time cpi montime/2 ;time to kill select light? rnz lda fpy$ctrl ;get current control byte ani 0f0h ;remove select bits jmpr newctrl ;send new control byte motoroff: lda fpy$ctrl ;get control byte res 5,a ;reset motor on bit jmpr newctrl ;go send it ; ; if memorydisk memoryread: call checkwritehst ; write out host buffer if necessary call memorybase ; hl := memory base, a := a-segment map offset lded bufptr ; de := host buffer index (destination) push d ; save for later call memorymove ; move into host buffer, reset write flag pop h ; hl := host buffer index (source) lded dmaadr ; de := dma buffer (destination) lxi b,128 ; bc := buffer size ldir ; copy into dma buffer jmpr memorydone ; done transfer |12| memorywrite: call checkwritehst ; write out host buffer if necessary lhld bufptr ; hl := host buffer index push h ; save for later xchg ; de := host buffer index (destination) lhld dmaadr ; hl := dma buffer (source) lxi b,128 ; bc := buffer size ldir ; copy into host buffer call memorybase ; hl := memory base, a := a-segment map offset xchg ; de := memory base (destination) pop h ; hl := host buffer index (source) memorymove: lxi b,128 ; bc := block size (size) di ; turn off interrupts out io$pmapa ; select memory disk into a-segment ldir ; copy memory lda pmapa$current ; a := current setting of io$pmapa out io$pmapa ; select default a-segment ei ; enable interrupts memorydone: ; succesful transfer |12| mvi a,mdrive ; a := mdrive |12| sta hstdsk ; mark mdrive use of host buffer |12| sub a ; a := 0 |12| sta hstwrt ; reset host write flag |12| sta hstact ; reset host active flag sta unacnt ; reset unallocated count |2.27.02| ret ; all done (return with not errors, a = 0) memorybase: ; return hl = memory index, a = map offset ; memory index := 4000h + (sector * 128) + (track * 8K) ; map offset := mdisk$base + (track * 8) ; lda lac$sec ; a := sector number (0 - 63) rrc ; a := rotate right (sector) mov h,a ; save in h ani 80h ; a := (sector mod 2) * 128 mov l,a ; l := (sector mod 2) * 128 mov a,h ; h := rotate right (sector) ani 1fh ; a := sector / 128 adi 40h ; add in a-segment base (4000 hex) mov h,a ; hl := memory index lda sektrk ; a := track ani 1fh ; make sure there are only 32 segments add a ; a := track * 2 add a ; a := track * 4 add a ; a := track * 8 add a ; a := track * 16 aci mdisk$base ; a := a-segment map offset |2.27.01| rnc ; exit if no carry generated |2.27.01| inr a ; add in carry |2.27.01| ret endif ; ; ; ; ;***************************************************** ;* * ;* Unitialized RAM data areas * ;* * ;***************************************************** ; ; ; Macro to generate a pre-loaded function key key macro str @a set $+8 db str db 0 if $ lt @a ds @a-$ endif endm ; ; ; Screen driver variables ; L80$40: ds 1 ; 40-column flag VPOS: ds 1 ; Vertical position (line) HPOS: ds 1 ; Horizontal position (column) ATTRIB: ds 1 ; current character attributes ESCFLG: ds 1 ; Nonzero if in escape sequence LTABPTR:ds 2 ; Pointer to start of line address table LINLEN: ds 1 ; Number of characters per line ukip: ds 2 ; Pointer to key string being read ukop: ds 2 ; Pointer to key string being loaded uktbl: ds 256 ; Storage for user func key strings (F1-F32) ; Pre-initialized function keys (white) key 'V'-40h ; insert lock key 'G'-40h ; del char key 'RUN' key 'P'-40h ; print screen key 0D4h ; calc mode key '^'-40h ; home key 'K'-40h ; up-arrow key 'J'-40h ; down-arrow key 'L'-40h ; right-arrow key 'H'-40h ; left-arrow key 'Y'-40h ; del line key 'LOAD' key 'CONT' key 0D3h ; shifted calc mode key 'Z'-40h ; clear key 'E'-40h ; cntl up arrow key 'X'-40h ; cntl down arrow key 'D'-40h ; cntl right arrow key 'S'-40h ; cntl left arrow key 'S'-40h ; stop key 7fh ; cntl backspace key 'F'-40h ; cntl tab ; SPSAVE: ds 2 ; Place to save caller's stk ptr ds 32 LOCLSTK EQU $ ; Local stack area ; ; ; Blocking/deblocking driver variables ; sekdsk: ds 1 ;seek disk number sektrk: ds 2 ;seek track number seksec: ds 1 ;seek sector number lacsec ds 1 ;interlaced sector number ; hstdsk: ds 1 ;host disk number hsttrk: ds 2 ;host track number hstsec: ds 1 ;host sector number ; sekhst: ds 1 ;seek shr secshf hstact: ds 1 ;host active flag hstwrt: ds 1 ;host written flag ; unacnt: ds 1 ;unalloc rec cnt unadsk: ds 1 ;last unalloc disk unatrk: ds 2 ;last unalloc track unasec: ds 1 ;last unalloc sector ; erflag: ds 1 ;error reporting rsflag: ds 1 ;read sector flag readop: ds 1 ;1 if read operation wrtype: ds 1 ;write operation type dmaadr: ds 2 ;last dma address hstbuf: ds hstsiz ;host buffer ; records$per$block: ds 1 ; CP/M (128 byte) records/block ; ; ENDEF ; generate bdos data areas if coninterrupt conbuffer: ds conbuffersize ; console interrupt buffer endif end$bios: ; last label in data area ; ; ;*********************************************************************** ;* * ;* Initialization section - the following code is used only * ;* during startup. It overlays the uninitialized data areas * ;* to save space. * ;* * ;*********************************************************************** ; ; rorg uktbl ; ; Routine to initialize the internal screen for use by CP/M CRT$INIT: PUSHIX MVI A,80H ; Enable text OUT IO$HCOL MVI A,15 ; Check for presence of 6845 OUT IO$CRTA ; to decide if we have 80 col. screen SUB A STA ESCFLG ; Not in escape sequence STA ATTRIB ; No attributes set STA L80$40 ; Assume 80 col. OUT IO$CRTD LXI H,LTAB80 SHLD LTABPTR MVI A,80 STA LINLEN IN IO$CRTD+2 ; Now see if there's a device on that port ORA A ; 0 means yes, 0FFH (open circuit) means no JRZ GOT80 ; Reset params for 40 col screen if displayclock lxi h,second$interrupt mvi m,0c9h ; put RET instruction in second$interrupt endif MVI A,0FFH STA L80$40 LXI H,LTAB40 SHLD LTABPTR MVI A,40 STA LINLEN GOT80: MVI A,5 ; Get VRAM OUT IO$SYS CALL EHOME ; Clear and home the screen MVI A,1 ; Kill VRAM OUT IO$SYS MVI A,10 OUT IO$CRTA ; Put up underscore cursor OUT IO$CRTD MVI A,11 OUT IO$CRTA OUT IO$CRTD CALL SETCUR ; Position cursor home MVI A,5 OUT IO$DRTBC ; Enable keyboard MVI A,0E8H OUT IO$DRTBC POPIX RET ; if reloc psize equ 0 else psize equ msize endif ; sgnmsg: db psize/10+'0',psize-psize/10*10+'0' db 'k CP/M vers ' db version+'0' db '.' db (revision/10)+'0' db (revision mod 10)+'0' db ' for Monroe ' sgnms1: db 'OC 8800' if production ne true db ' Experimental ' db (production/10)+'0' db (production mod 10)+'0' endif db ' ' db (month/10)+'0' db (month mod 10)+'0' db '/' db (day/10)+'0' db (day mod 10)+'0' db '/' db (year/10)+'0' db (year mod 10)+'0' db 0 ; end of text ; lstitb: db 0,30h,1,0,2,0e8h,3,0e1h,4 ; initialize list lstibaud: db 044h,5,0eah,0 ; reg 4 is baud rate lstitbsize equ $-lstitb ; ptritb: db 0,30h,1,0,2,0d8h,3,0c1h,4 ; initialize printer ptribaud: db 0c4h,5,0eah,0 ; reg 4 is baud rate ptritbsize equ $-ptritb ; uc1itb: db 0,30h,1,0,2,0d0h,3,0c1h,4 ; initialize user port uc1ibaud: db 044h,5,0eah,0 ; reg 4 is baud rate uc1itbsize equ $-uc1itb ; keyitb: db 0,30h,2,0e0h ; set interrupt vector if coninterrupt db 1,14h ; enable receiver interrupt w/status endif db 0 keyitbsize equ $-keyitb ; ;***************************************************************** ; rorg loclstk ; ; Print sign-on, and initialize all I/O devices and parameters. ; Register C contains the IPL drive number in the lower nibble. ; It also contains a flag in the ms bit: 0 = 128K machine ; 1 = 256K machine ; boot: lxi sp,0200H ; put stack in a safe place mov a,c ; a := machine flag/boot drive ani 80h ; 256k machine ? jnz is256k ; skip if 256k machine mvi a,55 ; a := sectors on mdisk for 128k machine sta mdisk$dsm ; update number of blocks in m-disk is256k: pushix ; save machine flag/boot drive pop b ; c := machine flag/boot drive mov a,c ; remember which drive was booted ani 7 ; |10| sta ipldsk sta cdisk ; select booted disk sub a ; a := 0 sta timecntr ; reset floppy motor timer mov a,b sta fpyctrl ;current drive control byte call crt$init ;initialize crt driver lda l80$40 ;look at 80/40 column flag ani 1 ;and leave in iobyte so applications sta iobyte ; know screen width jrz boot1 mvi a,'E' ;make signon reflect model number sta sgnms1 boot1: if interrupts di im2 : Vector table interrupt mode mvi a,vectortbl/256 ; load interrupt base register stai ; Interrupt page register := A mvi a,0f0h ; set CTC interrupt vector again out io$ctc0 mvi a,start$ctc3 out io$ctc3 mvi a,oneslice ; setup for 20 msec interrupt out io$ctc3 ; ei-- don't enable here get other things done first |10| endif lxi h,rbaud mvi a,45h out io$ctc0 ;set modem port baud rate mov a,m out io$ctc0 inx h mov a,m ;set sio divider also sta ptribaud ; |11| inx h mvi a,45h out io$ctc1 ;set AUX port baud rate mov a,m out io$ctc1 inx h mov a,m sta uc1ibaud ;set sio divider too |11| inx h mvi a,45h out io$ctc2 ;set printer baud rate mov a,m out io$ctc2 inx h mov a,m sta lstibaud ;set sio divider too |11| lxi b,(lstitbsize*256)+io$drtac ; |11| lxi h,lstitb ;init printer DART outir lxi b,(ptritbsize*256)+io$sioac ; |11| lxi h,ptritb ;init rdr/pun SIO outir lxi b,(uc1itbsize*256)+io$siobc ; |11| lxi h,uc1itb ;init alt. cons. SIO outir if interrupts lxi b,(keyitbsize*256)+io$drtbc lxi h,keyitb ;init keyboard interrupt vector outir endif lxi h,sgnmsg ;say hello to the nice folks call prmsg lxi h,0 shld ukip ;deactivate function keys shld ukop lxi d,7 ;init them to contain their own values lxi h,uktbl ;(7 chars + null per key) lxi b,32*256+80H ;32 keys, values 80h thru 9Fh zuklup: mov m,c ; store key value inx h mvi m,0 ; follow with null dad d ; point to next key inr c ; generate next key value djnz zuklup ; repeat 32 times if memorydisk ; |2.27.01| ----------------------- di ; initialize with interrupts off call initialize$mdisk ; initialize mdisk jmp mdisk$initialized ; finish rest of system initialization initialize$mdisk: lxi h,ccp ; hl := ccp base lxi d,4000h+100h ; de := sector 1 of track 0 (base 0) lxi b,bios-ccp ; bc := size of block to copy mov a,m ; a := byte to put into first position call move$to$memory$disk ; copy ccp and bdos to mdisk lxi h,6000h ; hl := base of directory (track 1) lxi d,6000h+1 ; de := second byte in directory lxi b,(clearmemorydisk*128)-1 ; bc := segment size to clear mvi a,0e5h ; a := byte to clear memory with move$to$memory$disk: sta first$mdisk$byte ; save first byte mvi a,mdisk$base ; swap in first memory disk segment out io$pmapa lda first$mdisk$byte ; a := first byte mov m,a ; set first byte ldir ; move remaining bytes lda pmapa$current ; a := current setting of io$pmapa out io$pmapa ; select default a-segment ret first$mdisk$byte: db 0 ; first byte to set in mdisk mdisk$initialized: ; all done with mdisk ; -------------------- |2.27.01| endif ; ;--|10|-- ; Set Cpm disk availability based on boot prom values ; Ms8type equ 1 Cpmtype equ 2 Untype equ 3 ;formatted but not allocated Ofltype equ 4 ;test drive says drive down at boot time hdtype0 equ 13h ;address of data passed from prom hdtype1 equ 23h ; for MP/M compat. these are not used after Coldst. ; ; First check nonexistant or allocated to MS-8 ; if value is 55 then old boot prom, use the defaults ; lxi h,hdtype0 lxi d,hd$drvs mov a,m ;the Os type byte inx h mov c,m ;control byte--same for both drives inx h cpi 55h jrz dskset ;the loaded image has constants in place ; mvi b,4 ;the first drive is always 4 call sethd ;sets the logical$disk for online and size lxi h,hdtype1 mov a,m inx h inx h ;skip cntl byte--this is a XEBEC mvi b,5 ;the second drive is always 5 call sethd ;last call has incremented DE ; ; Load the Drive type control bits to the DCB mov a,c sta DCB$CTL ; -------------------|10| dskset: lxi h,wboot ;prevent this code from being accessed again shld bios+1 ;by changing cold boot vector to warm lxi h,ccp ;select CCP cold entry point jmp gocpm ;initialize and go to cp/m ; |10|------------------- ; Set the Logical$disk table according to the sizes ; A 5 Meg drive system 0=E: 1=F: ; A 10 Meg drive system 0=E:+F: 1=G:+H: ; Future: A 15 Meg drive system 0=E:+F:+G: 1=H:+I:+J: sethd: cpi Cpmtype jrz settype cpi Untype jrz settype mvi b,0ffh ;mark it non-existant settype: mov a,b ;offline or drive # stax d ;mark this drive inx d inx h ;skip the size MSB mov a,m ;the middle byte of size cpi 04ah ;19200 rz ;can only set one partition on 5 meg ; mov a,b ori 2 ;4+2=6,5+2=7 ff+2=ff stax d ;set the second partition of drive inx d ret ; -----------|10| ; code$size equ $-ccp ; if $ lt end$bios ds end$bios-$ ; force MAC to show true size of BIOS endif ; end